Local point configuration

3 files changed, 107 insertions, 57 deletions

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