aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xdune2
-rwxr-xr-xevents/timer.ml39
-rwxr-xr-xevents/timer.mli6
-rwxr-xr-xpath/draw.ml (renamed from draw/draw.ml)48
-rwxr-xr-xpath/dune (renamed from draw/dune)2
-rwxr-xr-xpath/point.ml (renamed from draw/point.ml)12
-rwxr-xr-xpath/point.mli (renamed from draw/point.mli)2
-rwxr-xr-xscript.ml104
-rwxr-xr-xshapes/bezier.ml (renamed from curves/bezier.ml)40
-rwxr-xr-xshapes/bezier.mli (renamed from curves/bezier.mli)2
-rwxr-xr-xshapes/bspline.ml (renamed from curves/bspline.ml)0
-rwxr-xr-xshapes/bspline.mli (renamed from curves/bspline.mli)4
-rwxr-xr-xshapes/dd_splines.pdf (renamed from curves/dd_splines.pdf)bin184248 -> 184248 bytes
-rwxr-xr-xshapes/dune (renamed from curves/dune)2
-rwxr-xr-xworker/dune2
15 files changed, 162 insertions, 103 deletions
diff --git a/dune b/dune
index 36edb56..314dc63 100755
--- a/dune
+++ b/dune
@@ -10,7 +10,7 @@
messages_json
worker
draw
- curves
+ shapes
tools
events
)
diff --git a/events/timer.ml b/events/timer.ml
index def9a81..0a75e12 100755
--- a/events/timer.ml
+++ b/events/timer.ml
@@ -1,24 +1,41 @@
-type t = Brr.G.timer_id ref * unit Note.E.send
+open Brr_note_kit
+
+type t =
+ { mutable id : Brr.G.timer_id
+ ; send : float Note.E.send
+ ; mutable counter : Time.counter
+ }
let create
- : unit -> (t * unit Note.E.t)
+ : unit -> (t * Brr_note_kit.Time.span Note.E.t)
= fun () ->
- let event, send = Note.E.create () in
- (ref (-1), send), event
+ let event, send = Note.E.create ()
+ and counter = (Time.counter ()) in
+ {id = (-1); send; counter}, event
let stop
: t -> unit
- = fun (id, _) ->
- Brr.G.stop_timer !id
+ = fun {id; _} ->
+ Brr.G.stop_timer id
let start
: t -> float -> unit
- = fun (id, send) d ->
+ = fun t d ->
+ let {id; send; _} = t in
+ t.counter <- Time.counter ();
+
- Brr.G.stop_timer !id;
+ Brr.G.stop_timer id;
let timer_id = Brr.G.set_interval
~ms:(int_of_float @@ d *. 1000.)
- (fun () -> send ()) in
- ignore @@ Brr.G.set_timeout ~ms:0 send;
- id:= timer_id;
+ (fun () ->
+
+ let span = Time.counter_value t.counter in
+ t.counter <- Time.counter ();
+ send span) in
+ ignore @@ Brr.G.set_timeout ~ms:0 (fun () -> send 0.);
+ t.id <- timer_id
+
+let delay : t -> float
+ = fun t -> Time.counter_value t.counter
diff --git a/events/timer.mli b/events/timer.mli
index 4bf8a9b..0509ad0 100755
--- a/events/timer.mli
+++ b/events/timer.mli
@@ -1,7 +1,11 @@
+open Brr_note_kit
+
type t
-val create : unit -> t * unit Note.E.t
+val create : unit -> t * Time.span Note.E.t
val start: t -> float -> unit
val stop: t -> unit
+
+val delay : t -> float
diff --git a/draw/draw.ml b/path/draw.ml
index 12a1abc..757c778 100755
--- a/draw/draw.ml
+++ b/path/draw.ml
@@ -32,11 +32,11 @@ let three_points
let p0 = Point.get_coord p0
and p1 = Point.get_coord p1
and p2 = Point.get_coord p2 in
- let bezier = Curves.Bezier.three_points_quadratic p0 p1 p2
- |> Curves.Bezier.quadratic_to_cubic in
- let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0
- and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1
- and x, y = translate_point ~area bezier.Curves.Bezier.p1 in
+ let bezier = Shapes.Bezier.three_points_quadratic p0 p1 p2
+ |> Shapes.Bezier.quadratic_to_cubic in
+ let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0
+ and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1
+ and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in
Path.ccurve_to path
~cx ~cy
@@ -54,12 +54,12 @@ let multi_points
let points = List.map ~f:Point.get_coord points in
- let* beziers = Curves.Bspline.to_bezier ?connexion1:connexion points in
+ let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points in
Array.iter beziers
~f:(fun bezier ->
- let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0
- and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1
- and x, y = translate_point ~area bezier.Curves.Bezier.p1 in
+ let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0
+ and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1
+ and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in
Path.ccurve_to path
~cx ~cy
@@ -84,7 +84,7 @@ type path =
| Empty
| Line of Point.t * Point.t
| Three_point of Point.t * Point.t * Point.t
- | Curve of Curves.Bezier.t array
+ | Curve of Shapes.Bezier.t array
type t =
{ id : int
@@ -102,7 +102,7 @@ let move_to
| Curve beziers ->
try
let bezier = Array.get beziers 0 in
- let x, y = translate_point ~area bezier.Curves.Bezier.p0 in
+ let x, y = translate_point ~area bezier.Shapes.Bezier.p0 in
Path.move_to canvaPath ~x ~y
with _ -> ()
@@ -124,9 +124,9 @@ let draw
Array.iter beziers
~f:(fun bezier ->
- let cx, cy = translate_point ~area bezier.Curves.Bezier.ctrl0
- and cx', cy' = translate_point ~area bezier.Curves.Bezier.ctrl1
- and x, y = translate_point ~area bezier.Curves.Bezier.p1 in
+ let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0
+ and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1
+ and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in
Path.ccurve_to canvaPath
~cx ~cy
@@ -156,7 +156,7 @@ let go_back
let last = Array.get beziers ((Array.length beziers) -1) in
let x, y =
- last.Curves.Bezier.p1
+ last.Shapes.Bezier.p1
|> translate_point' vect ~area in
Path.line_to canvaPath ~x ~y;
@@ -166,23 +166,19 @@ let go_back
let i = (Array.length beziers) - i in
let bezier = Array.get beziers i in
- let cx, cy = translate_point' vect ~area bezier.Curves.Bezier.ctrl1
- and cx', cy' = translate_point' vect ~area bezier.Curves.Bezier.ctrl0
- and x, y = translate_point' vect ~area bezier.Curves.Bezier.p0 in
+ let cx, cy = translate_point' vect ~area bezier.Shapes.Bezier.ctrl1
+ and cx', cy' = translate_point' vect ~area bezier.Shapes.Bezier.ctrl0
+ and x, y = translate_point' vect ~area bezier.Shapes.Bezier.p0 in
Path.ccurve_to canvaPath
~cx ~cy
~cx' ~cy'
~x ~y
done;
- let x, y =
- (Array.get beziers 0).Curves.Bezier.p0
- |> translate_point' vect ~area in
- Path.line_to canvaPath ~x ~y;
| _ -> ()
-type quick_path = Point.t list * Curves.Bezier.t list
+type quick_path = Point.t list * Shapes.Bezier.t list
let id = ref 0
@@ -206,7 +202,7 @@ let to_path
let points' = List.map ~f:Point.get_coord points in
- let* beziers = Curves.Bspline.to_bezier points' in
+ let* beziers = Shapes.Bspline.to_bezier points' in
{id; path=Curve beziers}
end
| _ ->
@@ -216,10 +212,10 @@ let to_path
| _ -> {id; path=Curve (Array.of_list beziers)} in
let connexion = match beziers with
- | hd::_ -> Some hd.Curves.Bezier.p1
+ | hd::_ -> Some hd.Shapes.Bezier.p1
| _ -> None in
- let* beziers' = Curves.Bspline.to_bezier
+ let* beziers' = Shapes.Bspline.to_bezier
?connexion1:connexion
(List.map points ~f:Point.get_coord) in
diff --git a/draw/dune b/path/dune
index 1791604..c9eff46 100755
--- a/draw/dune
+++ b/path/dune
@@ -3,6 +3,6 @@
(libraries
gg
brr
- curves
+ shapes
)
)
diff --git a/draw/point.ml b/path/point.ml
index 150bc8e..91b68c2 100755
--- a/draw/point.ml
+++ b/path/point.ml
@@ -25,11 +25,11 @@ let get_coord'
t.p + trans
let return_segment
- : Curves.Bezier.t -> Curves.Bezier.t list -> Curves.Bezier.t list
+ : Shapes.Bezier.t -> Shapes.Bezier.t list -> Shapes.Bezier.t list
= fun bezier beziers ->
(* We gave the points in reverse order, so we have to revert the
curve *)
- let bezier' = Curves.Bezier.reverse bezier in
+ let bezier' = Shapes.Bezier.reverse bezier in
bezier'::beziers
@@ -46,11 +46,11 @@ let get_new_segment connexion0 p5 p4 p3 p2 p1 =
; p3'
; p4'
; p5' ] in
- Curves.Bspline.to_bezier ?connexion0 points_to_link
+ Shapes.Bspline.to_bezier ?connexion0 points_to_link
let add_point_in_path
- : float -> float -> t list -> Curves.Bezier.t list -> t list * Curves.Bezier.t list
- = fun x y path beziers ->
+ : float * float -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list
+ = fun (x, y) path beziers ->
let lastClick = create x y in
let (let*) v f =
match v with
@@ -64,7 +64,7 @@ let add_point_in_path
in
let connexion0 = match beziers with
- | hd::_ -> Some hd.Curves.Bezier.p1
+ | hd::_ -> Some hd.Shapes.Bezier.p1
| _ -> None in
match path with
diff --git a/draw/point.mli b/path/point.mli
index 8e3f5aa..068f4c1 100755
--- a/draw/point.mli
+++ b/path/point.mli
@@ -7,7 +7,7 @@ val get_coord : t -> Gg.v2
val create: float -> float -> t
val add_point_in_path
- : float -> float -> t list -> Curves.Bezier.t list -> t list * Curves.Bezier.t list
+ : (float * float) -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list
val get_coord'
: t -> Gg.v2
diff --git a/script.ml b/script.ml
index f97eed2..9cd8a22 100755
--- a/script.ml
+++ b/script.ml
@@ -12,7 +12,7 @@ type mode =
type current =
{ points : Point.t list (* The list of points to draw *)
- ; beziers : Curves.Bezier.t list (* All the points already fixed *)
+ ; beziers : Shapes.Bezier.t list (* All the points already fixed *)
}
type state =
@@ -30,7 +30,7 @@ type canva_events =
type events =
[ canva_events
- | `Point of float * float ]
+ | `Point of float * (float * float) ]
type canva_signal = Point.t
@@ -70,10 +70,10 @@ let do_action
: events -> state -> state
= fun event state ->
match event, state.mode with
- | `Point (x, y), Edit ->
+ | `Point (_delay, point), Edit ->
(* Add the point in the list *)
let points, beziers = Point.add_point_in_path
- x y
+ point
state.current.points
state.current.beziers in
@@ -83,13 +83,39 @@ let do_action
| `Click _, Out ->
Timer.start state.timer 0.3;
{ state with mode = Edit }
- | `Out (x, y), _ ->
+ | `Out p, Edit ->
Timer.stop state.timer;
(* Add the point in the list *)
+
+ let points, beziers = match state.current.points, state.current.beziers with
+ | hd::(tl), beziers ->
+
+ let open Gg.V2 in
+ let p' = of_tuple p
+ and hd' = Point.get_coord hd in
+ if (norm (hd' - p' )) < 0.05 then
+ (Point.create (fst p) (snd p))::tl
+ , beziers
+ else (
+ Point.add_point_in_path
+ p
+ state.current.points
+ state.current.beziers
+ )
+ | _ ->
+ Point.add_point_in_path
+ p
+ state.current.points
+ state.current.beziers
+ in
+
+
+(*
let points, beziers = Point.add_point_in_path
- x y
+ p
state.current.points
state.current.beziers in
+*)
let beziers = Draw.to_path (points, beziers) in
let paths = beziers::state.paths
@@ -131,7 +157,7 @@ let draw_path area points beziers =
let open Brr_canvas.C2d in
let connexion = match beziers with
| [] -> None
- | hd ::_ -> Some hd.Curves.Bezier.p1 in
+ | hd ::_ -> Some hd.Shapes.Bezier.p1 in
(* Firt draw all the points most recent points *)
let path = draw ?connexion ~area points in
@@ -140,9 +166,9 @@ let draw_path area points beziers =
~init:path
~f:(fun path bezier ->
- let cx, cy = Draw.translate_point ~area bezier.Curves.Bezier.ctrl0
- and cx', cy' = Draw.translate_point ~area bezier.Curves.Bezier.ctrl1
- and x, y = Draw.translate_point ~area bezier.Curves.Bezier.p1 in
+ let cx, cy = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl0
+ and cx', cy' = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl1
+ and x, y = Draw.translate_point ~area bezier.Shapes.Bezier.p1 in
Path.ccurve_to path
~cx ~cy
@@ -178,38 +204,48 @@ let on_change canva mouse_position state =
let pos = S.rough_value mouse_position in
let points =
match state.mode, pos with
- | Edit, Some (x, y) -> (Point.create x y)::state.current.points
- | _ -> state.current.points in
+ | Edit, Some (x, y) ->
+ (Point.create x y)::state.current.points
+ | _ ->
+ set_image_smoothing_enabled context true;
+ set_image_smoothing_quality context Image_smoothing_quality.high;
+ state.current.points in
let path = draw_path area (points) state.current.beziers in
stroke context path;
List.iter state.paths
~f:(fun path ->
- let p = Path.create () in
- Draw.move_to ~area p path.Draw.path;
- Draw.draw ~area p path.Draw.path;
- Draw.go_back ~area p path.Draw.path;
- fill ~fill_rule:Fill_rule.nonzero context p;
-(*
+ (* This is ugly, and probably non efficient, but is an appropriate solution for
+ the cases of overlapping path *)
match path.Draw.path with
- | Curve c ->
- let c' = Array.init
- (Array.length c)
- ~f:(fun i ->
- Curves.Bezier.reverse @@ Array.get c ((Array.length c) -i - 1)
- )
- in
- let p' = Draw.Curve c' in
- Draw.move_to ~area p p';
- Draw.draw ~area p p';
- Draw.go_back ~area p p';
- fill ~fill_rule:Fill_rule.nonzero context p;
- ()
- | _ -> ()
-*)
+ | Draw.Curve beziers ->
+
+ Array.iter beziers
+ ~f:(fun bezier ->
+
+ let b = Draw.Curve [|bezier|] in
+ let p = Path.create () in
+ Draw.move_to ~area p b;
+ Draw.draw ~area p b;
+ Draw.go_back ~area p b;
+ Path.close p;
+ fill context p;
+ stroke context p
+
+
+ )
+
+ | _ ->
+ let p = Path.create () in
+ Draw.move_to ~area p path.Draw.path;
+ Draw.draw ~area p path.Draw.path;
+ Draw.go_back ~area p path.Draw.path;
+ Path.close p;
+ fill context p;
+ stroke context p
);
()
@@ -236,7 +272,7 @@ let page_main id =
let tick_event =
S.sample_filter mouse_position
~on:tick
- (fun pos () -> Option.map (fun p -> `Point p) pos ) in
+ (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in
(* The first evaluation is the state. Which is the result of all the
successives events to the initial state *)
diff --git a/curves/bezier.ml b/shapes/bezier.ml
index 3dedc70..bf7aaaa 100755
--- a/curves/bezier.ml
+++ b/shapes/bezier.ml
@@ -166,26 +166,32 @@ let slice
; p1 } )
-let rec get_closest_point
- : Gg.v2 -> t -> Gg.v2
+let get_closest_point
+ : Gg.v2 -> t -> float * Gg.v2
= fun point t ->
- (* First devide the curve in two *)
- let seq_0, seq_1 = slice 0.5 t in
- let p0 = t.p0
- and p1 = t.p1
- and p01 = seq_0.p1 in (* seq_0.p1 = seq_1.p0 *)
+ let rec f min max t =
- let open Gg.V2 in
- let center0 = mix p0 p01 0.5
- and center1 = mix p01 p1 0.5 in
-
- if Tools.Utils.equal_point 0.001 p0 p1 then
- p01
- else if (norm (point - center0)) < (norm (point - center1)) then
- get_closest_point point seq_0
- else
- get_closest_point point seq_1
+ (* First devide the curve in two *)
+ let seq_0, seq_1 = slice 0.5 t in
+ let avg = (min +. max) /. 2. in
+
+ let p0 = t.p0
+ and p1 = t.p1
+ and p01 = seq_0.p1 in (* seq_0.p1 = seq_1.p0 *)
+
+ let open Gg.V2 in
+ let center0 = mix p0 p01 0.5
+ and center1 = mix p01 p1 0.5 in
+
+ if Tools.Utils.equal_point 0.001 p0 p1 then
+ avg, p01
+ else if (norm (point - center0)) < (norm (point - center1)) then
+ f min avg seq_0
+ else
+ f avg max seq_1
+
+ in f 0. 1. t
let reverse
: t -> t
diff --git a/curves/bezier.mli b/shapes/bezier.mli
index e90163c..2f5bbcf 100755
--- a/curves/bezier.mli
+++ b/shapes/bezier.mli
@@ -35,6 +35,6 @@ val slice
(** Return the closest point to the curve by approximation *)
val get_closest_point
- : Gg.v2 -> t -> Gg.v2
+ : Gg.v2 -> t -> float * Gg.v2
val reverse: t -> t
diff --git a/curves/bspline.ml b/shapes/bspline.ml
index bb60227..bb60227 100755
--- a/curves/bspline.ml
+++ b/shapes/bspline.ml
diff --git a/curves/bspline.mli b/shapes/bspline.mli
index 074658d..a36aa22 100755
--- a/curves/bspline.mli
+++ b/shapes/bspline.mli
@@ -18,7 +18,7 @@ type err =
*)
val to_bezier
- : ?connexion0:Gg.v2
- -> ?connexion1:Gg.v2
+ : ?connexion0:Gg.v2
+ -> ?connexion1:Gg.v2
-> Gg.v2 list
-> (Bezier.t array, [> err]) Result.t
diff --git a/curves/dd_splines.pdf b/shapes/dd_splines.pdf
index 2618162..2618162 100755
--- a/curves/dd_splines.pdf
+++ b/shapes/dd_splines.pdf
Binary files differ
diff --git a/curves/dune b/shapes/dune
index 34c87fb..d03a217 100755
--- a/curves/dune
+++ b/shapes/dune
@@ -1,5 +1,5 @@
(library
- (name curves)
+ (name shapes)
(libraries
tools
matrix
diff --git a/worker/dune b/worker/dune
index 9f95cf8..508055e 100755
--- a/worker/dune
+++ b/worker/dune
@@ -4,6 +4,6 @@
gg
brr
note
- curves
+ shapes
)
)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 00:28:03 +0000