Move path, some refactoring

1 files changed, 126 insertions, 130 deletions

diff --git a/script.it/state.ml b/script.it/state.ml
index fd35554..f5698ef 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -8,7 +8,7 @@ type mode =
 
 (** Events *)
 type canva_events =
-  [ `Click of float * float
+  [ `MouseDown of float * float
   | `Out of float * float
   ]
 
@@ -44,6 +44,7 @@ type state =
   ; width : float
   ; angle : float
   ; rendering : Layer.Paths.printer
+  ; mouse_down_position : Gg.v2
   }
 
 let post
@@ -73,37 +74,6 @@ let insert_or_replace state ((x, y) as p) stamp path =
         path
     )
 
-(** Update the path in the selection with the given function applied to
-    every point *)
-let update_path_selection
-  : int -> Outline.t list -> (Path.Point.t -> Path.Point.t) -> Outline.t list
-  = fun id outlines f ->
-    List.map outlines
-      ~f:(fun outline ->
-          let id' = outline.Outline.id in
-          match id = id' with
-          | false -> outline
-          | true -> {outline with path = Path.Fixed.map outline.path f}
-        )
-
-let update_point_selection state path_id point f =
-  let paths = List.map state.paths
-      ~f:(fun p ->
-          match p.Outline.id = path_id with
-          | false -> p
-          | true ->
-            { p with path = Path.Fixed.map
-                         p.path
-                         (fun p ->
-                            if (Path.Point.id p = Path.Point.id point) then
-                              f p
-                            else
-                              p
-                         ) }
-        ) in
-  { state with paths }
-
-
 (** Select the given segment, and modify angle and width accordingly *)
 let select_segment _ (_, selected, p0, p1) state dist =
 
@@ -118,10 +88,7 @@ let select_segment _ (_, selected, p0, p1) state dist =
   ; angle
   ; width }
 
-(** Handle the deletion event.
-
-    Deletion only apply to a selection
-*)
+(** Delete the selected element *)
 let delete state worker =
   match state.mode with
   | Selection (Path id) ->
@@ -139,9 +106,7 @@ let delete state worker =
           let id' = p.Outline.id in
           match id' = id with
           | false -> ()
-          | true ->
-            (* Send the job to the worker *)
-            post worker (`DeletePoint (point, p))
+          | true -> post worker (`DeletePoint (point, p))
         );
     { state with mode = Selection (Path id) }
   | _ ->
@@ -164,49 +129,70 @@ let tick (delay, point) state =
     { state with current }
   | _ -> state
 
-let angle worker 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
-    (* Update the event to the worker *)
-    let outline = List.find paths
-        ~f:(fun o -> o.Outline.id = s) in
+let update_property worker state value f = function
+  | None -> state
+  | Some (Selection.Path outline) ->
+    (* Change width for the whole path *)
+    let outline = { outline with
+                    Outline.path = Path.Fixed.map outline.Outline.path (fun p ->
+                        f p value)
+                  } in
     post worker (`Back outline);
-    {state with paths }
-  (* Change angle localy *)
-  | Selection (Point (s, point)) ->
-    let state = update_point_selection state s point
-        (fun p -> Path.Point.set_angle p angle) in
-    (* Update the event to the worker *)
-    let outline = List.find state.paths
-        ~f:(fun o -> o.Outline.id = s) in
+    state
+  | Some (Point (outline, point)) ->
+    let path = Path.Fixed.map
+        outline.path
+        (fun pt ->
+           match Path.Point.id pt = Path.Point.id point with
+           | false -> pt
+           | true -> f pt value)
+    in
+    let outline = {outline with path} in
     post worker (`Back outline);
-    { state with angle }
-  | _ ->
-    { state with angle}
+    state
 
 let width worker width state =
   match state.mode with
-  | Selection (Path s) ->
+
+  | Selection t ->
     let state = { state with width } in
-    let paths = update_path_selection s state.paths (fun p -> Path.Point.set_width p width) in
-    (* Update the event to the worker *)
-    let outline = List.find paths
-        ~f:(fun o -> o.Outline.id = s) in
-    post worker (`Back outline);
-    {state with paths }
-  | Selection (Point (s, point)) ->
-    let state = update_point_selection state s point
-        (fun p -> Path.Point.set_width p width) in
-    (* Update the event to the worker *)
-    let outline = List.find state.paths
-        ~f:(fun o -> o.Outline.id = s) in
-    post worker (`Back outline);
-    { state with width }
-  | _ ->
-    { state with width }
+    Selection.find_selection t state.paths
+    |> update_property worker state width Path.Point.set_width
+  | _ -> state
+
+let angle worker angle state =
+  match state.mode with
+
+  | Selection t ->
+    let state = { state with angle } in
+    Selection.find_selection t state.paths
+    |> update_property worker state angle Path.Point.set_angle
+  | _ -> state
+
+
+(** Short click on any element, just do nothing (each element is on MouseDown
+    event) *)
+let click state = function
+  | _ -> state
+
+(** Long click, move the selected element if any *)
+let longClick mouse_coord state worker = function
+  | Selection t ->
+    let mouse_v2 = Gg.V2.of_tuple mouse_coord in
+    begin match Selection.find_selection t state.paths with
+      | None -> state
+      | Some (Point (path, point)) ->
+        let point' = Path.Point.copy point mouse_v2 in
+        post worker (`TranslatePoint (point', path));
+        (* Just replace the position of the selected point *)
+        { state with mode = Selection (Point (path.id, point')) }
+      | Some (Path path) ->
+        let delta = Gg.V2.(mouse_v2 - state.mouse_down_position) in
+        post worker (`TranslatePath (path, delta));
+        state
+    end
+  (*  TODO Long click in out mode should translate the slate *)
+  | _ -> state
 
 let do_action
   : Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state
@@ -216,7 +202,7 @@ let do_action
       tick (delay, point) state
 
     (* Click anywhere while in Out mode, we switch in edition *)
-    | `Click ((x, y) as p), Out ->
+    | `MouseDown ((x, y) as p), Out ->
       Elements.Timer.start timer 0.3;
 
       let width = state.width
@@ -238,34 +224,59 @@ let do_action
       let current = Path.Path_Builder.add_point
           point
           state.current in
-      { state with current; mode = Edit }
+      { state with
+        current
+      ; mode = Edit
+      ; mouse_down_position = Gg.V2.of_tuple (x, y)}
 
     (* Click anywhere while in selection mode, we either select another path,
        or switch to Out mode*)
-    | `Click position, (Selection (Path id))
-    | `Click position, (Selection (Point (id, _))) ->
-      begin match Selection.get_from_paths position state.paths with
-        | _, None ->
-          { state with
-            mode = Out }
-        | dist, Some selection ->
-          let _, outline, _, _ = selection in
-          if outline.Outline.id != id then
-            select_segment position selection state dist
-          else
-            (* On the same segment, check for a point *)
-            let selection = Selection.select_point outline (Gg.V2.of_tuple position) in
-            match selection with
-            | Path _ ->
-              { state with mode = Selection selection }
-            | Point (_, pt) ->
-              (* In order to handle the point move, start the timer *)
+    | `MouseDown position, (Selection (Path id))
+    | `MouseDown position, (Selection (Point (id, _))) ->
+
+      let get_any () =
+        begin match Selection.get_from_paths position state.paths with
+          | _, None ->
+            { state with
+              mode = Out
+            ; mouse_down_position = Gg.V2.of_tuple position }
+          | dist, Some selection ->
+            let _, outline, _, _ = selection in
+            if outline.Outline.id != id then (
+              let mouse_down_position = Gg.V2.of_tuple position in
+              select_segment position selection { state with mouse_down_position } dist
+            ) else
+              (* On the same segment, check for a point *)
+              let selection = Selection.select_point outline (Gg.V2.of_tuple position) in
+              match selection with
+              | Path _ ->
+                { state with
+                  mode = Selection selection
+                ; mouse_down_position = Gg.V2.of_tuple position }
+              | Point (_, pt) ->
+                (* In order to handle the point move, start the timer *)
+                Elements.Timer.start timer 0.3;
+                { state with
+                  mode = Selection selection
+                ; angle = Path.Point.get_angle pt
+                ; width = Path.Point.get_width pt
+                ; mouse_down_position = Gg.V2.of_tuple position }
+        end
+      in
+
+      (* First, check for a point in the selected path. If any of them in
+         found, check anything to select in all the elements *)
+      begin match Outline.find state.paths id with
+        | None -> get_any ()
+        | Some outline ->
+          begin match Selection.select_point outline (Gg.V2.of_tuple position) with
+            | Path _ -> get_any ()
+            | other ->
               Elements.Timer.start timer 0.3;
-              { state with
-                mode = Selection selection
-              ; angle = Path.Point.get_angle pt
-              ; width = Path.Point.get_width pt
-              }
+              {state with
+               mode = Selection other
+             ; mouse_down_position = Gg.V2.of_tuple position }
+          end
       end
 
     | `Out point, Edit ->
@@ -287,10 +298,10 @@ let do_action
               (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
 
           let last =
-            { Outline.path = path
-            ; Outline.back = back
-            ; Outline.id = Outline.get_id ()
-            }
+            Outline.{ path
+                    ; back
+                    ; id = Outline.get_id ()
+                    }
           in
 
           (* Send to the worker for a full review *)
@@ -318,26 +329,12 @@ let do_action
           end
       end
 
-    | `Out mouse_coord, Selection (Point (id, point)) ->
-      let mouse_v2 = Gg.V2.of_tuple mouse_coord in
-      if Elements.Timer.delay timer < 0.3 then
-        state
-      else
-        let point' = Path.Point.copy point mouse_v2  in
-        List.iter state.paths
-          ~f:(fun outline ->
-              let id' = outline.Outline.id in
-              match id = id' with
-              | false -> ()
-              | true ->
-                Option.iter
-                  (fun p ->
-
-                     let outline = {outline with path = p} in
-                     post worker (`Complete outline))
-                  (Path.Fixed.replace_point outline.Outline.path point')
-            );
-        { state with mode = Selection (Point (id, point')) }
+    | `Out _, mode when Elements.Timer.delay timer < 0.3 ->
+      click state mode
+
+    | `Out mouse_coord, mode ->
+      longClick mouse_coord state worker mode
+
     | `Delete, _ ->
       delete state worker
 
@@ -355,7 +352,7 @@ let do_action
                    Layer.Paths.to_svg
                      ~color:Blog.Nord.nord0
                      (module Path.Fixed)
-                     (path.Outline.path, path.Outline.back)
+                     Outline.(path.path, path.back)
                      state.rendering
 
                  )) in
@@ -393,16 +390,14 @@ let do_action
       let paths = List.map
           state.paths
           ~f:(fun line ->
-              match newPath.Outline.id = line.Outline.id with
+              match Outline.(newPath.id = line.id) with
               | true -> newPath
               | false -> line) in
       { state with paths }
 
 
     (* Some non possible cases *)
-    | `Out _, Out
-    | `Out _, Selection _
-    | `Click _, Edit
+    | `MouseDown _, Edit
       -> state
 
 let init =
@@ -412,4 +407,5 @@ let init =
   ; angle = 30.
   ; width = 10.
   ; rendering = `Fill
+  ; mouse_down_position = Gg.V2.ox
   }