Move path, some refactoring

7 files changed, 277 insertions, 200 deletions

diff --git a/script.it/outline.ml b/script.it/outline.ml
index 0dbecd0..1df7588 100755
--- a/script.it/outline.ml
+++ b/script.it/outline.ml
@@ -1,3 +1,5 @@
+open StdLabels
+
 let internal_path_id = ref 0
 
 type t =
@@ -10,3 +12,10 @@ let get_id () =
   let id = !internal_path_id in
   incr internal_path_id;
   id
+
+let find
+  : t list -> int -> t option
+  = fun ts id ->
+    List.find_opt
+      ts
+      ~f:(fun p -> p.id = id)
diff --git a/script.it/script.ml b/script.it/script.ml
index 3859cc9..73e5ac3 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -3,7 +3,9 @@ open Note
 open Brr
 open Brr_note
 
-
+let post
+  : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
+  = Brr_webworkers.Worker.post
 
 (** Create the element in the page, and the event handler *)
 let canva
@@ -47,7 +49,7 @@ let canva
 
     let click =
       Brr_note_kit.Mouse.left_down mouse
-      |> E.map (fun c -> `Click c) in
+      |> E.map (fun c -> `MouseDown c) in
 
     let up =
       Brr_note_kit.Mouse.left_up mouse
@@ -190,8 +192,21 @@ let backgroundColor = Blog.Nord.nord0
 let white = Jstr.v "#eceff4"
 let green = Jstr.v "#a3be8c"
 
+let draw_point point context =
+  let module Cd2d = Brr_canvas.C2d in
+  let x, y = Gg.V2.to_tuple @@ Path.Point.get_coord point in
+  Cd2d.stroke_rect
+    ~x:(x -. 5.)
+    ~y:(y -. 5.)
+    ~w:10.
+    ~h:10.
+    context
+
 (** Redraw the canva on update *)
 let on_change canva mouse_position timer state =
+  let pos = S.rough_value mouse_position in
+  let pos_v2 = Option.map Gg.V2.of_tuple pos in
+
   let module Cd2d = Brr_canvas.C2d in
 
   let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in
@@ -213,7 +228,6 @@ let on_change canva mouse_position timer state =
      be far away in the past, and would give to the user a sensation of lag.
 
   *)
-  let pos = S.rough_value mouse_position in
   let current =
     begin match state.State.mode, pos with
       | Edit, Some point ->
@@ -252,52 +266,63 @@ let on_change canva mouse_position timer state =
         Layer.Paths.to_canva (module Path.Fixed) (p, path.Outline.back) context state.rendering
       );
 
+  (* Draw the selected path, and operate the modifications directly as a preview  *)
   let () = match state.mode with
-    | Selection (Path id) ->
-      Cd2d.set_stroke_style context (Cd2d.color white);
-      List.iter
-        state.paths
-        ~f:(fun path ->
-            if id = path.Outline.id then
-              let p = path.Outline.path in
-              Layer.Paths.to_canva (module Path.Fixed) (p, path.Outline.back) context `Line
-          )
-    | Selection (Point (id, point)) ->
-      (* As before, mark the selected path *)
+    | Selection t ->
       Cd2d.set_stroke_style context (Cd2d.color white);
-
-      List.iter
-        state.paths
-        ~f:(fun outline ->
-            if id = outline.Outline.id then
-              let path = begin match pos with
-                | Some pos ->
-
-                  let pos_v2 = Gg.V2.of_tuple pos in
-                  if Elements.Timer.delay timer < 0.3 then
-                    outline.Outline.path
-                  else
-                    let point' = Path.Point.copy point pos_v2 in
-                    begin match Path.Fixed.replace_point outline.Outline.path point' with
-                      | None -> outline.Outline.path
-                      | Some p -> p
-                    end
-                | None -> outline.Outline.path end in
-              Layer.Paths.to_canva (module Path.Fixed) (path, outline.Outline.back) context `Line
-          );
-
-      (* Now draw the selected point *)
-      let x, y = Gg.V2.to_tuple @@ Path.Point.get_coord point in
-      Cd2d.stroke_rect
-        ~x:(x -. 5.)
-        ~y:(y -. 5.)
-        ~w:10.
-        ~h:10.
-        context;
+      begin match pos_v2, Selection.find_selection t state.paths with
+        (* The selected element does not exist, just do nothing *)
+        | _, None -> ()
+
+        (* There is no click on the canva, print the line *)
+        | None, Some (Path outline) ->
+          Layer.Paths.to_canva
+            (module Path.Fixed)
+            (outline.path, outline.back)
+            context
+            `Line;
+
+          (* The user is modifiying the path *)
+        | Some pos_v2, Some (Path outline) ->
+          (* Translate the path *)
+          let delta = Gg.V2.(pos_v2 - state.State.mouse_down_position) in
+          let path = Path.Fixed.map
+              outline.Outline.path
+              (fun pt -> Path.Point.get_coord pt
+                         |> Gg.V2.add delta
+                         |> Path.Point.copy pt) in
+          Layer.Paths.to_canva
+            (module Path.Fixed)
+            (path, path)
+            context
+            `Line;
+
+          (* The user is modifiying the point *)
+        | Some pos_v2, Some (Point (outline, point)) when Elements.Timer.delay timer > 0.3 ->
+          let point' = Path.Point.copy point pos_v2 in
+          let path = begin match Path.Fixed.replace_point outline.Outline.path point' with
+            | None -> outline.Outline.path
+            | Some p -> p
+          end in
+
+          Layer.Paths.to_canva
+            (module Path.Fixed)
+            (path, path)
+            context
+            `Line;
+          draw_point point context
+
+        | _, Some (Point (outline, point)) ->
+          Layer.Paths.to_canva
+            (module Path.Fixed)
+            (outline.path, outline.back)
+            context
+            `Line;
+          draw_point point context
+
+      end
     | _ -> ()
   in
-
-
   ()
 
 let spawn_worker () =
@@ -387,12 +412,11 @@ let page_main id =
         let _ =
           E.select
             [ E.map (fun _ -> ()) (S.changes mouse_position)
-            ; E.map (fun _ -> ()) (S.changes parameters.angle)
-            ; E.map (fun _ -> ()) (S.changes parameters.width)
             ; E.map (fun _ -> ()) parameters.rendering
             ; E.map (fun _ -> ()) worker_event
             ; parameters.delete ]
-          |> fun ev -> E.log ev (fun _ -> on_change canva mouse_position timer (S.value state) )
+          |> fun ev -> E.log ev (fun _ ->
+              on_change canva mouse_position timer (S.value state) )
                        |> Option.iter Logr.hold in
 
 
diff --git a/script.it/selection.ml b/script.it/selection.ml
index d00f026..f5f135a 100755
--- a/script.it/selection.ml
+++ b/script.it/selection.ml
@@ -1,8 +1,17 @@
 open StdLabels
 
-type t =
-  | Path of int
-  | Point of (int * Path.Point.t)
+type 'a selection =
+  | Path of 'a
+  | Point of ('a * Path.Point.t)
+
+type t = int selection
+
+let find_selection
+  : int selection -> Outline.t list -> Outline.t selection option
+  = fun selection paths ->
+    match selection with
+    | Path id -> Option.map (fun p -> Path p) (Outline.find paths id)
+    | Point (id, pt) -> Option.map (fun p -> Point (p, pt)) (Outline.find paths id)
 
 let threshold = 20.
 
diff --git a/script.it/selection.mli b/script.it/selection.mli
index 984eae6..9792a2d 100755
--- a/script.it/selection.mli
+++ b/script.it/selection.mli
@@ -1,6 +1,8 @@
-type t =
-  | Path of int
-  | Point of (int * Path.Point.t)
+type 'a selection =
+  | Path of 'a
+  | Point of ('a * Path.Point.t)
+
+type t = int selection
 
 val threshold : float
 
@@ -19,5 +21,13 @@ val get_from_paths
 val select_path
   : Outline.t -> t
 
+(** Check for selecting a point on the given outline. 
+
+    If no point is available, select the path.
+
+*)
 val select_point
   : Outline.t -> Gg.v2 -> t
+
+val find_selection
+  : int selection -> Outline.t list -> Outline.t selection option
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
   }
diff --git a/script.it/worker.ml b/script.it/worker.ml
index 51fe49c..62104ec 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -7,28 +7,28 @@ let post_message
   : Worker_messages.from_worker -> unit
   = Worker.post_message
 
-let execute (command: [> Worker_messages.to_worker]) =
+
+let rebuild outline =
+  let path = outline.Outline.path in
+
+  let=? path = Path.Fixed.rebuild path in
+  let back = Path.Fixed.map
+      path
+      (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
+  let=? back = Path.Fixed.rebuild back in
+  post_message (`Complete {outline with path; back})
+
+let execute (command: Worker_messages.to_worker) =
   match command with
 
   (* Full rebuild, evaluate the whole path *)
   | `Complete outline ->
-    let path = outline.Outline.path in
-
-    let=? path = Path.Fixed.rebuild path in
-    let back = Path.Fixed.map
-        path
-        (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
-    let=? back = Path.Fixed.rebuild back in
-    post_message (`Complete {outline with path; back})
+    rebuild outline
 
   (* Remove the point from the main line, and reevaluate the whole path *)
   | `DeletePoint (point, outline) ->
     let=? path = Path.Fixed.remove_point outline.Outline.path point in
-    let back = Path.Fixed.map
-        path
-        (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
-    let=? back = Path.Fixed.rebuild back in
-    post_message (`Complete {outline with path; back})
+    rebuild { outline with path }
 
   (* Only evaluate the interior *)
   | `Back outline ->
@@ -38,8 +38,30 @@ let execute (command: [> Worker_messages.to_worker]) =
     let=? back = Path.Fixed.rebuild back in
     post_message (`Complete {outline with back})
 
-  | _ ->
-    post_message (`Other (Js.string "Unknown message received"))
+  | `TranslatePath (outline, delta) ->
+    let path = Path.Fixed.map
+        outline.path
+        (fun pt -> Path.Point.get_coord pt
+                   |> Gg.V2.add delta
+                   |> Path.Point.copy pt)
+    and back = Path.Fixed.map
+        outline.back
+        (fun pt -> Path.Point.get_coord pt
+                   |> Gg.V2.add delta
+                   |> Path.Point.copy pt) in
+    post_message (`Complete {outline with path; back})
+
+  | `TranslatePoint (point, outline) ->
+    (* I do not use the function Path.Fixed.replace_point here, I just
+       replace the point position and run a full rebuild *)
+    let path = Path.Fixed.map outline.path
+        (fun pt ->
+           match Path.Point.id pt = Path.Point.id point with
+           | true -> point
+           | false -> pt
+        ) in
+
+    rebuild { outline with path }
 
 let () =
   Worker.set_onmessage execute
diff --git a/script.it/worker_messages/worker_messages.ml b/script.it/worker_messages/worker_messages.ml
index b33bb23..7efd3d3 100755
--- a/script.it/worker_messages/worker_messages.ml
+++ b/script.it/worker_messages/worker_messages.ml
@@ -3,7 +3,14 @@ open Js_of_ocaml
 type to_worker = [
   | `Complete of Outline.t
   | `DeletePoint of (Path.Point.t * Outline.t)
+
+  (* Update the interior path *)
   | `Back of Outline.t
+
+  (* Translate a path *)
+  | `TranslatePath of (Outline.t * Gg.v2)
+
+  | `TranslatePoint of (Path.Point.t * Outline.t)
 ]
 
 type from_worker = [