From a8f37f041dce3f16917b6659d3ca97492f178f4d Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 3 Jan 2021 05:42:35 +0100 Subject: Communication with webworker --- script.it/worker.ml | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) create mode 100755 script.it/worker.ml (limited to 'script.it/worker.ml') 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 -- cgit v1.2.3