From a63662059215a26db627c4b76147a3c9338f5b74 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 6 Jan 2021 22:09:53 +0100
Subject: Point suppression

---
 script.it/worker.ml | 43 +++++++++++++++++++++++++------------------
 1 file changed, 25 insertions(+), 18 deletions(-)

(limited to 'script.it/worker.ml')

diff --git a/script.it/worker.ml b/script.it/worker.ml
index 3150869..e2408b7 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -3,6 +3,7 @@ open Js_of_ocaml
 
 type message = [
   | `Complete of (int * (Path.Fixed.path array))
+  | `DeletePoint of (int * Path.Point.t * Path.Fixed.t)
 ]
 
 exception Empty_Element
@@ -36,27 +37,33 @@ let assoc_point
         ; Path.Fixed.ctrl1 = bezier.Shapes.Bezier.ctrl1
         }
 
-let execute (command: [> message]) =
-  match command with
-  | `Complete (id, paths) ->
-    (* Convert all the points in list *)
-    let points = List.init
-        ~len:((Array.length paths) )
-        ~f:(fun i -> get_point (Array.get paths i)) in
-    let p0 = first_point (Array.get paths 0)in
+let rebuild (id, paths) =
+  (* Convert all the points in list *)
+  let points = List.init
+      ~len:((Array.length paths) )
+      ~f:(fun i -> get_point (Array.get paths i)) in
+  let p0 = first_point (Array.get paths 0)in
+
+  let points = p0::points in
 
-    let points = p0::points in
+  (* We process the whole curve in a single block *)
+  begin match Shapes.Bspline.to_bezier points with
+    | Error `InvalidPath -> ()
+    | Ok beziers ->
 
-    (* We process the whole curve in a single block *)
-    begin match Shapes.Bspline.to_bezier points with
-      | Error `InvalidPath -> ()
-      | Ok beziers ->
+      (* Now for each point, reassociate the same point information,
+         We should have as many points as before *)
+      let rebuilded = Array.map2 beziers paths ~f:assoc_point in
+      Worker.post_message (`Complete (id, rebuilded))
+  end
 
-        (* Now for each point, reassociate the same point information,
-           We should have as many points as before *)
-        let rebuilded = Array.map2 beziers paths ~f:assoc_point in
-        Worker.post_message (`Complete (id, rebuilded))
-    end
+let execute (command: [> message]) =
+  match command with
+  | `Complete (id, paths) ->
+    rebuild (id, paths)
+  | `DeletePoint (id, point, path) ->
+    let path = Path.Fixed.remove_point path point in
+    rebuild (id, Path.Fixed.path path)
   | any ->
     Worker.post_message (`Other any)
 
-- 
cgit v1.2.3