Communication with webworker

1 files changed, 64 insertions, 0 deletions

diff --git a/script.it/worker.ml b/script.it/worker.ml
new file mode 100755
index 0000000..3150869
--- /dev/null
+++ b/script.it/worker.ml
@@ -0,0 +1,64 @@
+open StdLabels
+open Js_of_ocaml
+
+type message = [
+  | `Complete of (int * (Path.Fixed.path array))
+]
+
+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
+      and p1' = Path.Point.copy p1 bezier.Shapes.Bezier.p1 in
+      Curve
+        { Path.Fixed.p0 = p0'
+        ; Path.Fixed.p1 = p1'
+        ; Path.Fixed.ctrl0 = bezier.Shapes.Bezier.ctrl0
+        ; 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 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 ->
+
+        (* 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
+  | any ->
+    Worker.post_message (`Other any)
+
+let () =
+  Worker.set_onmessage execute