Outline module

9 files changed, 159 insertions, 79 deletions

diff --git a/script.it/dune b/script.it/dune
index c51c43b..bb5ca5f 100755
--- a/script.it/dune
+++ b/script.it/dune
@@ -1,3 +1,11 @@
+(library 
+  (name outline)
+ (libraries 
+   path)
+ (modules outline)
+ (preprocess (pps ppx_hash js_of_ocaml-ppx))
+ )
+
 (executable
  (name script)
  (libraries 
@@ -8,6 +16,7 @@
    blog
    layer
    worker_messages
+   outline
    )
  (modes js)
  (modules script state selection)
@@ -29,6 +38,7 @@
    shapes
    path
    worker_messages
+   outline
    )
  (modes js)
  (preprocess (pps ppx_hash js_of_ocaml-ppx))
diff --git a/script.it/outline.ml b/script.it/outline.ml
new file mode 100755
index 0000000..4962d8e
--- /dev/null
+++ b/script.it/outline.ml
@@ -0,0 +1,12 @@
+let internal_path_id = ref 0
+
+type t =
+  { id : int
+  ; path: Path.Fixed.t
+  ; back: Path.Fixed.t
+  }
+
+let get_id =
+  let id = !internal_path_id in
+  incr internal_path_id;
+  id
diff --git a/script.it/script.ml b/script.it/script.ml
index 05bec1b..9ef15fe 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -225,7 +225,7 @@ let on_change canva mouse_position timer state =
   in
 
 
-  Layer.Paths.to_canva (module Path.Path_Builder) current context state.rendering;
+  Layer.Paths.to_canva (module Layer.Paths.ReprBuild) (current, current) context state.rendering;
 
   List.iter state.paths
     ~f:(fun path ->
@@ -233,7 +233,7 @@ let on_change canva mouse_position timer state =
         let () = match state.mode with
           | Selection (Path id)
           | Selection (Point (id, _)) ->
-            begin match id = (Path.Fixed.id path) with
+            begin match id = path.Outline.id with
               | true ->
                 (* If the element is the selected one, change the color *)
                 Cd2d.set_fill_style context (Cd2d.color Blog.Nord.nord8);
@@ -245,7 +245,8 @@ let on_change canva mouse_position timer state =
           | _ -> ()
         in
 
-        Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (path, path) context state.rendering
+        let p = path.Outline.path in
+        Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (p, p) context state.rendering
       );
 
   let () = match state.mode with
@@ -254,8 +255,9 @@ let on_change canva mouse_position timer state =
       List.iter
         state.paths
         ~f:(fun path ->
-            if id = Path.Fixed.id path then
-              Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (path, path) context `Line
+            if id = path.Outline.id then
+              let p = path.Outline.path in
+              Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (p, p) context `Line
           )
     | Selection (Point (id, point)) ->
       (* As before, mark the selected path *)
@@ -264,20 +266,20 @@ let on_change canva mouse_position timer state =
       List.iter
         state.paths
         ~f:(fun path ->
-            if id = Path.Fixed.id path then
+            if id = path.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
-                    path
+                    path.Outline.path
                   else
                     let point' = Path.Point.copy point pos_v2 in
-                    begin match Path.Fixed.replace_point path point' with
-                      | None -> path
+                    begin match Path.Fixed.replace_point path.Outline.path point' with
+                      | None -> path.Outline.path
                       | Some p -> p
                     end
-                | None -> path end in
+                | None -> path.Outline.path end in
               Layer.Paths.to_canva (module Layer.Paths.ReprFixed) (path, path) context `Line
           );
 
diff --git a/script.it/selection.ml b/script.it/selection.ml
index 591ea38..d00f026 100755
--- a/script.it/selection.ml
+++ b/script.it/selection.ml
@@ -7,32 +7,32 @@ type t =
 let threshold = 20.
 
 let get_from_paths
-  : (float * float) -> Path.Fixed.t list -> float * (Gg.v2 * Path.Fixed.t * Path.Point.t * Path.Point.t) option
-  = fun position paths ->
+  : (float * float) -> Outline.t list -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option
+  = fun position outlines ->
     let point = Gg.V2.of_tuple position in
     (* If the user click on a curve, select it *)
-    List.fold_left paths
+    List.fold_left outlines
       ~init:(threshold, None)
-      ~f:(fun (dist, selection) path ->
-          match Path.Fixed.distance point path with
+      ~f:(fun (dist, selection) outline ->
+          match Path.Fixed.distance point outline.Outline.path with
           | Some { closest_point ; distance; p0; p1 ; ratio} when distance < dist ->
-            ratio, Some (closest_point, path, p0, p1)
+            ratio, Some (closest_point, outline, p0, p1)
           | _ -> dist, selection
         )
 
 let select_path
-  : Path.Fixed.t -> t
-  = fun path -> Path (Path.Fixed.id path)
+  : Outline.t -> t
+  = fun outline -> Path outline.Outline.id
 
 let select_point
-  : Path.Fixed.t -> Gg.v2 -> t
-  = fun path v2_point ->
+  : Outline.t -> Gg.v2 -> t
+  = fun outline v2_point ->
 
     let point' = ref None in
     let dist = ref threshold in
 
     Path.Fixed.iter
-      path
+      outline.Outline.path
       ~f:(fun p ->
           let open Gg.V2 in
           let new_dist = norm ((Path.Point.get_coord p) - v2_point) in
@@ -45,9 +45,9 @@ let select_point
 
     match !point' with
     | Some point ->
-      Point (Path.Fixed.id path, point)
+      Point (outline.Outline.id, point)
     | None ->
-      Path (Path.Fixed.id path)
+      Path (outline.Outline.id)
 
             (*
       (* If the point does not exists, find the exact point on the curve *)
diff --git a/script.it/selection.mli b/script.it/selection.mli
index a405edc..984eae6 100755
--- a/script.it/selection.mli
+++ b/script.it/selection.mli
@@ -14,10 +14,10 @@ val threshold : float
 
 *)
 val get_from_paths
-  : (float * float) -> Path.Fixed.t list -> float * (Gg.v2 * Path.Fixed.t * Path.Point.t * Path.Point.t) option
+  : (float * float) -> Outline.t list -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option
 
 val select_path
-  : Path.Fixed.t -> t
+  : Outline.t -> t
 
 val select_point
-  : Path.Fixed.t -> Gg.v2 -> t
+  : Outline.t -> Gg.v2 -> t
diff --git a/script.it/state.ml b/script.it/state.ml
index c147c2c..403efbe 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -23,7 +23,7 @@ type render_event =
 
 type worker_event =
   [ `Basic of Jv.t
-  | `Complete of Path.Fixed.t
+  | `Complete of Outline.t
   ]
 
 type events =
@@ -42,7 +42,7 @@ type events =
  *)
 type state =
   { mode : mode
-  ; paths : Path.Fixed.t list
+  ; paths : Outline.t list
   ; current : Path.Path_Builder.t
   ; width : float
   ; angle : float
@@ -78,29 +78,31 @@ let insert_or_replace state ((x, y) as p) stamp path =
 
 (** Update the path in the selection with the given function applied to
     every point *)
-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 path f
-      )
+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 Path.Fixed.id p = path_id with
+          match p.Outline.id = path_id with
           | false -> p
           | true ->
-            Path.Fixed.map
-              p
-              (fun p ->
-                 if (Path.Point.id p = Path.Point.id point) then
-                   f p
-                 else
-                   p
-              )
+            { 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 }
 
@@ -129,7 +131,7 @@ let delete state worker =
     let paths = List.filter
         state.paths
         ~f:(fun p ->
-            Path.Fixed.id p != id
+            p.Outline.id != id
           ) in
     { state with paths ; mode = Out}
 
@@ -137,7 +139,7 @@ let delete state worker =
     List.iter
       state.paths
       ~f:(fun p ->
-          let id' = Path.Fixed.id p in
+          let id' = p.Outline.id in
           match id' = id with
           | false -> ()
           | true ->
@@ -165,30 +167,46 @@ let tick (delay, point) state =
     { state with current }
   | _ -> state
 
-let angle angle 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
+    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
+    post worker (`Back outline);
     { state with angle }
   | _ ->
     { state with angle}
 
-let width width state =
+let width worker 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
+    (* 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 }
@@ -234,12 +252,12 @@ let do_action
           { state with
             mode = Out }
         | dist, Some selection ->
-          let _, path, _, _ = selection in
-          if Path.Fixed.id path != id then
+          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 path (Gg.V2.of_tuple position) in
+            let selection = Selection.select_point outline (Gg.V2.of_tuple position) in
             match selection with
             | Path _ ->
               { state with mode = Selection selection }
@@ -263,9 +281,21 @@ let do_action
 
           let current = insert_or_replace state point stamp state.current in
           let paths =
-            let last = Path.Fixed.to_fixed
+
+            let path = Path.Fixed.to_fixed
                 (module Path.Path_Builder)
-                current
+                current in
+
+            (* Create a copy from the path with all the interior points *)
+            let back = Path.Fixed.map
+                path
+                (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
+              }
             in
 
             let () = post worker (`Complete last) in
@@ -298,14 +328,17 @@ let do_action
       else
         let point' = Path.Point.copy point mouse_v2  in
         List.iter state.paths
-          ~f:(fun path ->
-              let id' = Path.Fixed.id path in
+          ~f:(fun outline ->
+              let id' = outline.Outline.id in
               match id = id' with
               | false -> ()
               | true ->
                 Option.iter
-                  (fun p -> post worker (`Complete p))
-                  (Path.Fixed.replace_point path point')
+                  (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')) }
     | `Delete, _ ->
@@ -325,7 +358,7 @@ let do_action
                    Layer.Paths.to_svg
                      ~color:Blog.Nord.nord0
                      (module Layer.Paths.ReprFixed)
-                     (path, path)
+                     (path.Outline.path, path.Outline.path)
                      state.rendering
 
                  )) in
@@ -347,9 +380,9 @@ let do_action
       state
 
     | `Angle value , _ ->
-      angle value state
+      angle worker value state
     | `Width value, _ ->
-      width value state
+      width worker value state
 
 
     | `Rendering rendering, _ ->
@@ -361,14 +394,13 @@ let do_action
       state
 
     | `Complete path, _ ->
-      let id = Path.Fixed.id path in
+      let id = path.Outline.id in
       let paths = List.map state.paths
-          ~f:(fun path' ->
-              let id' = Path.Fixed.id path' in
+          ~f:(fun line ->
+              let id' = line.Outline.id in
               match id = id' with
-              | false -> path'
-              | true ->
-                path
+              | false -> line
+              | true -> path
             ) in
       { state with paths }
 
diff --git a/script.it/worker.ml b/script.it/worker.ml
index 00e4595..898df39 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -1,21 +1,43 @@
 open Js_of_ocaml
 
+let (let=?) : 'a option -> ('a -> unit) -> unit
+  = fun f opt -> Option.iter opt f
+
 let post_message
   : Worker_messages.from_worker -> unit
   = Worker.post_message
 
 let execute (command: [> Worker_messages.to_worker]) =
   match command with
-  | `Complete path ->
-    begin match Path.Fixed.rebuild path with
-      | Some path -> Worker.post_message (`Complete path)
-      | None -> ()
-    end
-  | `DeletePoint (point, path) ->
-    begin match Path.Fixed.remove_point path point with
-      | Some path ->  Worker.post_message (`Complete path)
-      | None -> ()
-    end
+
+  (* 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
+    Worker.post_message (`Complete {outline with path; back})
+
+  (* 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
+    Worker.post_message (`Complete {outline with path; back})
+
+  (* Only evaluate the interior *)
+  | `Back outline ->
+    let back = Path.Fixed.map
+        outline.Outline.path
+        (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in
+    let=? back = Path.Fixed.rebuild back in
+    Worker.post_message (`Complete {outline with back})
+
   | _ ->
     post_message (`Other (Js.string "Unknown message received"))
 
diff --git a/script.it/worker_messages/dune b/script.it/worker_messages/dune
index d1511a6..b4e1c2b 100755
--- a/script.it/worker_messages/dune
+++ b/script.it/worker_messages/dune
@@ -2,5 +2,6 @@
  (name worker_messages)
  (libraries 
    js_of_ocaml
+   outline
    path)
   )
diff --git a/script.it/worker_messages/worker_messages.ml b/script.it/worker_messages/worker_messages.ml
index 992ec29..a4d05c8 100755
--- a/script.it/worker_messages/worker_messages.ml
+++ b/script.it/worker_messages/worker_messages.ml
@@ -1,8 +1,9 @@
 open Js_of_ocaml
 
 type to_worker = [
-  | `Complete of Path.Fixed.t
-  | `DeletePoint of (Path.Point.t * Path.Fixed.t)
+  | `Complete of Outline.t
+  | `DeletePoint of (Path.Point.t * Outline.t)
+  | `Back of Outline.t
 ]
 
 type from_worker = [