Refactor

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
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
    )
  )