Local point configuration

8 files changed, 181 insertions, 83 deletions

diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 3ed1c3c..2ee96e4 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -46,11 +46,14 @@ module Make(Repr: Repr.PRINTER) = struct
          recent point  *)
       let delay =
         ((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1))
-        *. 100. /. 3.
+        *. 20.
       in
-      for i = 0 to (Int.of_float delay) do
-        let bezier', _ = Shapes.Bezier.slice (0.1 *. (Float.of_int i)) bezier in
-        let point = Path.Point.copy p1 bezier'.Shapes.Bezier.p1 in
+      for i = 0 to ((Int.of_float delay) -1) do
+        let ratio = (Float.of_int i) /. delay in
+        let bezier', _ = Shapes.Bezier.slice ratio bezier in
+
+        let point = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0 p1 in
+
         path := Repr.move_to (Path.Point.get_coord point) !path;
         path := Repr.line_to (Path.Point.get_coord' point) !path;
       done;
diff --git a/path/fixed.ml b/path/fixed.ml
index cb2c27f..2d42566 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -6,6 +6,8 @@ module type P = sig
 
   val get_coord : t -> Gg.v2
 
+  val id : t -> int
+
 end
 
 module Make(Point:P) = struct
@@ -24,7 +26,6 @@ module Make(Point:P) = struct
     ; ctrl1:Gg.v2 } (* The control point *)
 
   type path =
-    | Empty
     | Line of Point.t * Point.t
     | Curve of bezier
 
@@ -74,7 +75,8 @@ module Make(Point:P) = struct
     let get
       : int * path list -> path array
       = fun (n, t) ->
-        let res = Array.make n Empty in
+
+        let res = Obj.magic (Array.make n 0) in
         List.iteri t
           ~f:(fun i elem -> Array.set res (n - i - 1) elem );
         res
@@ -106,7 +108,6 @@ module Make(Point:P) = struct
           ~init:(true, repr)
           ~f:(fun (first, path) element ->
               match element with
-              | Empty -> (true, path)
               | Line (p0, p1) ->
 
                 let path =  if first then
@@ -133,7 +134,6 @@ module Make(Point:P) = struct
       Array.fold_left beziers.path
         ~init:None
         ~f:(fun res -> function
-            | Empty -> None
             | Line (p0, p1) ->
               let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
               begin match Gg.Box2.mem point box with
@@ -164,7 +164,6 @@ module Make(Point:P) = struct
     = fun {id; path} f ->
       let path = Array.map path
           ~f:(function
-              | Empty -> Empty
               | Line (p1, p2) -> Line (f p1, f p2)
               | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
             ) in
@@ -175,7 +174,6 @@ module Make(Point:P) = struct
     = fun {path; _} ~f ->
       Array.iter path
         ~f:(function
-            | Empty -> ()
             | Line (p1, p2) -> f p1; f p2
             | Curve bezier -> f bezier.p0 ; f bezier.p1
           )
@@ -193,14 +191,13 @@ module Make(Point:P) = struct
           ~f:(fun element ->
 
               let res = match element with
-                | Empty -> false
                 | Line (p0, p1)
                 | Curve {p0;p1;_} ->
-                  if p0 = point then (
+                  if (Point.id p0) = (Point.id point) then (
                     idx := Some (!counter) ;
                     true
-                  ) else if p1 = point then (
-                    idx := Some (!counter +1) ;
+                  ) else if (Point.id p1) = (Point.id point) then (
+                    idx := Some (!counter+1) ;
                     true
                   ) else
                     false
@@ -213,25 +210,47 @@ module Make(Point:P) = struct
       | Some 0 ->
         (* Remove the first point *)
         let path' = Array.init
-            ((Array.length path) -1)
-            ~f:( fun i -> Array.get path (i + 1)) in
-        {id; path=path'}
+            ((Array.length path)-1)
+            ~f:( fun i -> Array.get path (i+1)) in
+        { id
+        ; path = path'
+        }
       | Some n when n = (Array.length path) ->
         (* Remove the last point *)
         let path' = Array.init
-            ((Array.length path) -1)
+            ((Array.length path)-1)
             ~f:( fun i -> Array.get path i) in
-        {id; path=path'}
+        { id
+        ; path=path'
+        }
       | Some n ->
         let path' = Array.init
-            ((Array.length path) -1)
+            ((Array.length path)-1)
             ~f:(fun i ->
-                if i < (n -1) then
+                if i < (n-1) then
                   Array.get path (i)
+                else if i = (n-1) then
+                  (* We know that the point is not the first nor the last one.
+                     So it is safe to call n-1 or n + 1 point
+
+                     We have to rebuild the point and set that
+                     point_(-1).id = point_(+1).id
+                  *)
+                  let previous_p1 =
+                    match Array.get path (i-1) with
+                    | Line (_, p1) -> p1
+                    | Curve c -> c.p1
+                  in
+
+                  match Array.get path (i+1) with
+                  | Line (_, p1) -> Line (previous_p1, p1)
+                  | Curve c -> Curve {c with p0 = previous_p1}
+
                 else
-                  Array.get path (i +1)
+                  Array.get path (i+1)
               ) in
-        {id; path=path'}
+        { id
+        ; path=path'}
 
   let update
     : t -> path array -> t
diff --git a/path/fixed.mli b/path/fixed.mli
index f91ffc6..1f12006 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -4,6 +4,8 @@ module type P = sig
 
   val get_coord : t -> Gg.v2
 
+  val id : t -> int
+
 end
 
 module Make(Point:P) : sig
@@ -51,7 +53,6 @@ module Make(Point:P) : sig
     ; ctrl1:Gg.v2 } (* The control point *)
 
   type path =
-    | Empty
     | Line of Point.t * Point.t
     | Curve of bezier
 
diff --git a/path/point.ml b/path/point.ml
index d49d655..4c34899 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -1,8 +1,11 @@
+let internal_id = ref 0
+
 type t =
   { p: Gg.v2
   ; size : float
   ; angle: float
   ; stamp : float
+  ; id : int
   }
 
 let empty =
@@ -10,17 +13,23 @@ let empty =
   ; size = 0.
   ; angle = 0.
   ; stamp = 0.
+  ; id = 0
   }
 
 let create ~angle ~width ~stamp ~x ~y =
+
+  incr internal_id;
   { p = Gg.V2.v x y
   ; size = width
   ; angle = Gg.Float.rad_of_deg (180. -. angle )
   ; stamp
+  ; id = !internal_id
   }
 
 let copy point p =
-  { point with p }
+  { point with
+    p
+  }
 
 let set_angle p angle =
   { p with angle = Gg.Float.rad_of_deg (180. -. angle) }
@@ -49,6 +58,7 @@ let get_coord'
 let mix
   : float -> Gg.v2 -> t -> t -> t
   = fun f point p0 p1 ->
+    incr internal_id;
     let angle0 = p0.angle
     and angle1 = p1.angle
     and width0 = get_width p0
@@ -61,4 +71,8 @@ let mix
     { p = point
     ; size = width
     ; angle
-    ; stamp }
+    ; stamp
+    ; id = !internal_id
+    }
+
+let id { id; _} = id
diff --git a/path/point.mli b/path/point.mli
index fab42d2..fe4cb45 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -1,5 +1,9 @@
 type t
 
+(** Return the point id. Each id is unique *)
+val id 
+  : t -> int
+
 val empty : t
 
 val (+): t -> Gg.v2 -> t
@@ -10,6 +14,12 @@ val get_stamp : t -> float
 
 val create: angle:float -> width:float -> stamp:float -> x:float -> y:float -> t
 
+(** Return a copy of the point at given posistion 
+
+    This is a true copy, the id will be the same for the two points
+    TODO : Should this be renamed set_position ?
+
+*)
 val copy : t -> Gg.v2 -> t
 
 val set_angle : t -> float -> t
@@ -27,3 +37,4 @@ val get_coord'
     characteristics from p0 and p1 *)
 val mix
   : float -> Gg.v2 -> t -> t -> t
+
diff --git a/script.it/script.ml b/script.it/script.ml
index e91dc92..fc64d1e 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -281,7 +281,11 @@ let on_change canva mouse_position timer state =
         ~h:10.
         context;
 
-
+      Cd2d.stroke_text
+        context
+        (Jstr.of_float @@ Path.Point.get_stamp point)
+        ~x:(x +. 15.)
+        ~y;
 
     | _ -> ()
   in
diff --git a/script.it/state.ml b/script.it/state.ml
index b91c614..585ca32 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -78,14 +78,30 @@ let threshold = 20.
 
 (** Update the path in the selection with the given function applied to
     every point *)
-let update_selection id state f =
+let update_path_selection id paths f =
 
+  List.map paths
+    ~f:(fun path ->
+        let id' = Path.Fixed.id path in
+        match id = id' with
+        | false -> path
+        | true -> Path.Fixed.map_point path f
+      )
+
+let update_point_selection state path_id point f =
   let paths = List.map state.paths
-      ~f:(fun path ->
-          let id' = Path.Fixed.id path in
-          match id = id' with
-          | false -> path
-          | true -> Path.Fixed.map_point path f
+      ~f:(fun p ->
+          match Path.Fixed.id p = path_id with
+          | false -> p
+          | true ->
+            Path.Fixed.map_point
+              p
+              (fun p ->
+                 if (Path.Point.id p = Path.Point.id point) then
+                   f p
+                 else
+                   p
+              )
         ) in
   { state with paths }
 
@@ -104,18 +120,84 @@ let select_segment _ (_, selected, p0, p1) state dist =
   ; angle
   ; width }
 
+(** Handle the deletion event.
+
+    Deletion only apply to a selection
+*)
+let delete state worker =
+  match state.mode with
+  | Selection (Path id) ->
+    let paths = List.filter
+        state.paths
+        ~f:(fun p ->
+            Path.Fixed.id p != id
+          ) in
+    { state with paths ; mode = Out}
+
+  | Selection (Point (id, point)) ->
+    List.iter
+      state.paths
+      ~f:(fun p ->
+          let id' = Path.Fixed.id p in
+          match id' = id with
+          | false -> ()
+          | true ->
+            (* Send the job to the worker *)
+            Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p))
+        );
+    { state with mode = Selection (Path id) }
+  | _ ->
+    state
+
+(** Tick event
+
+    Tick only occurs when drawing a new path
+
+*)
+let tick (delay, point) state =
+  match state.mode with
+  | Edit ->
+    (* Add the point in the list *)
+    let current = insert_or_replace
+        state
+        point
+        delay
+        state.current in
+    { state with current }
+  | _ -> state
+
+let angle angle state =
+  match state.mode with
+  (* Change angle for the whole path *)
+  | Selection (Path s) ->
+    let state = { state with angle } in
+    let paths = update_path_selection s state.paths (fun p -> Path.Point.set_angle p angle) in
+    {state with paths }
+  (* Change angle localy *)
+  | Selection (Point (s, point)) ->
+    update_point_selection state s point
+      (fun p -> Path.Point.set_angle p angle)
+  | _ ->
+    { state with angle}
+
+let width width state =
+  match state.mode with
+  | Selection (Path s) ->
+    let state = { state with width } in
+    let paths = update_path_selection s state.paths (fun p -> Path.Point.set_width p width) in
+    {state with paths }
+  | Selection (Point (s, point)) ->
+    update_point_selection state s point
+      (fun p -> Path.Point.set_width p width)
+  | _ ->
+    { state with width }
+
 let do_action
   : Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state
   = fun worker timer event state ->
     match event, state.mode with
-    | `Point (delay, point), Edit ->
-      (* Add the point in the list *)
-      let current = insert_or_replace
-          state
-          point
-          delay
-          state.current in
-      { state with current }
+    | `Point (delay, point), _ ->
+      tick (delay, point) state
 
     (* Click anywhere while in Out mode, we switch in edition *)
     | `Click ((x, y) as p), Out ->
@@ -203,26 +285,8 @@ let do_action
 
           end
       end
-    | `Delete, Selection (Path id) ->
-      let paths = List.filter
-          state.paths
-          ~f:(fun p ->
-              Path.Fixed.id p != id
-            ) in
-      { state with paths ; mode = Out}
-
-    | `Delete, Selection (Point (id, point)) ->
-      List.iter
-        state.paths
-        ~f:(fun p ->
-            let id' = Path.Fixed.id p in
-            match id' = id with
-            | false -> ()
-            | true ->
-              (* Send the job to the worker *)
-              Brr_webworkers.Worker.post worker (`DeletePoint (id, point, p))
-          );
-      { state with mode = Selection (Path id) }
+    | `Delete, _ ->
+      delete state worker
 
     | `Export, _ ->
       let my_host = Uri.host @@ Window.location @@ G.window in
@@ -259,21 +323,11 @@ let do_action
       );
       state
 
-    (* Change the select curve with the appropriate setting *)
-    | `Angle angle, Selection (Path s) ->
-      let state = { state with angle } in
-      update_selection s state (fun p -> Path.Point.set_angle p angle)
-    | `Width width, Selection (Path s) ->
-      let state = { state with width } in
-      update_selection s state (fun p -> Path.Point.set_width p width)
-
-    | `Angle angle, _ ->
-      { state with angle}
-    | `Width width, _ ->
-      { state with width}
+    | `Angle value , _ ->
+      angle value state
+    | `Width value, _ ->
+      width value state
 
-    | `Delete, Out
-      -> state
 
     | `Rendering rendering, _ ->
       { state with rendering}
@@ -297,11 +351,8 @@ let do_action
 
     (* Some non possible cases *)
     | `Out _, Out
-    | `Point _, Out
-    | `Point _, Selection _
     | `Out _, Selection _
     | `Click _, Edit
-    | `Delete, Edit
       -> state
 
 let init =
diff --git a/script.it/worker.ml b/script.it/worker.ml
index e68705a..6f425cd 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -6,26 +6,21 @@ type message = [
   | `DeletePoint of (int * Path.Point.t * Path.Fixed.t)
 ]
 
-exception Empty_Element
-
 let get_point
   : Path.Fixed.path -> Gg.v2
   = function
-    | Empty -> raise Empty_Element
     | Line (_, p1) -> Path.Point.get_coord p1
     | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p1
 
 let first_point
   : Path.Fixed.path -> Gg.v2
   = function
-    | Empty -> raise Empty_Element
     | Line (p0, _) -> Path.Point.get_coord p0
     | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p0
 
 let assoc_point
   : Shapes.Bezier.t -> Path.Fixed.path -> Path.Fixed.path
   = fun bezier -> function
-    | Empty -> raise Empty_Element
     | Line (p0, p1)
     | Curve {p0; p1; _} ->
       let p0' = Path.Point.copy p0 bezier.Shapes.Bezier.p0