Formalized exchanges between worker and app

12 files changed, 72 insertions, 68 deletions

diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 8383a9c..8f796b4 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -30,8 +30,8 @@ module Make(Repr: Repr.PRINTER) = struct
       }
 
   let quadratic_to
-    : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr
-    = fun p0 ctrl0 ctrl1 p1 { path } ->
+    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+    = fun (p0,  ctrl0, ctrl1, p1) { path } ->
 
       let path = ref path in
 
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
index 3093ada..19f0ac4 100755
--- a/layer/fillPrinter.ml
+++ b/layer/fillPrinter.ml
@@ -79,8 +79,8 @@ module Make(Repr: Repr.PRINTER) = struct
       { t with path}
 
   let quadratic_to
-    : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr
-    = fun p0 ctrl0 ctrl1 p1 t ->
+    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+    = fun (p0,  ctrl0, ctrl1, p1) t ->
 
       let ctrl0' = Point.copy p1 ctrl0
       and ctrl1' = Point.copy p1 ctrl1 in
diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml
index 38dae5c..45ee801 100755
--- a/layer/linePrinter.ml
+++ b/layer/linePrinter.ml
@@ -45,8 +45,8 @@ module Make(Repr: Repr.PRINTER) = struct
       }
 
   let quadratic_to
-    : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr
-    = fun p0 ctrl0 ctrl1 p1 { path } ->
+    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+    = fun (p0,  ctrl0, ctrl1, p1) { path } ->
 
       let path = Repr.move_to (Path.Point.get_coord p0) path
                  |> Repr.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1)
diff --git a/path/builder.ml b/path/builder.ml
index fd772ea..7901e78 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -133,15 +133,15 @@ module Make(Point:P) = struct
 
           Repr.start p0 path
           |> Repr.quadratic_to
-            p0'
-            b0.Shapes.Bezier.ctrl0
-            b0.Shapes.Bezier.ctrl1
-            p1'
+            ( p0'
+            , b0.Shapes.Bezier.ctrl0
+            , b0.Shapes.Bezier.ctrl1
+            , p1' )
           |> Repr.quadratic_to
-            p1'
-            b1.Shapes.Bezier.ctrl0
-            b1.Shapes.Bezier.ctrl1
-            p2'
+            ( p1'
+            , b1.Shapes.Bezier.ctrl0
+            , b1.Shapes.Bezier.ctrl1
+            , p2' )
         | (p0::_ as points) ->
 
           let (let*) v f =
@@ -179,10 +179,10 @@ module Make(Point:P) = struct
                   let bezier = Array.get beziers (i - 1) in
 
                   path := Repr.quadratic_to
-                      !point
-                      bezier.Shapes.Bezier.ctrl0
-                      bezier.Shapes.Bezier.ctrl1
-                      pt
+                      ( !point
+                      , bezier.Shapes.Bezier.ctrl0
+                      , bezier.Shapes.Bezier.ctrl1
+                      , pt )
                       (!path);
                   point := pt;
                 )
@@ -195,11 +195,12 @@ module Make(Point:P) = struct
       Repr.stop @@ List.fold_left beziers
         ~init:path
         ~f:(fun path bezier ->
-            let p0' = bezier.p0
-            and ctrl0 = bezier.ctrl0
-            and ctrl1 = bezier.ctrl1
-            and p1' = bezier.p1 in
-            Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
+            Repr.quadratic_to
+              ( bezier.p0
+              , bezier.ctrl0
+              , bezier.ctrl1
+              , bezier.p1 )
+              path
           )
 
 end
diff --git a/path/fixed.ml b/path/fixed.ml
index 812dd3b..d9abcb5 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -14,6 +14,12 @@ end
 
 module Make(Point:P) = struct
 
+  type bezier =
+    { p0:Point.t    (* The starting point *)
+    ; p1:Point.t    (* The end point *)
+    ; ctrl0:Gg.v2   (* The control point *)
+    ; ctrl1:Gg.v2 } (* The control point *)
+
   module type BUILDER = sig
     type t
 
@@ -21,12 +27,6 @@ module Make(Point:P) = struct
       : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
   end
 
-  type bezier =
-    { p0:Point.t    (* The starting point *)
-    ; p1:Point.t    (* The end point *)
-    ; ctrl0:Gg.v2   (* The control point *)
-    ; ctrl1:Gg.v2 } (* The control point *)
-
   type path =
     | Line of Point.t * Point.t
     | Curve of bezier
@@ -58,8 +58,8 @@ module Make(Point:P) = struct
         , Line (p1, p2)::t)
 
     let quadratic_to
-      : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
-      = fun p0 ctrl0 ctrl1 p1 (i, t) ->
+      : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+      = fun (p0,  ctrl0, ctrl1, p1) (i, t) ->
         let curve = Curve
             { p0
             ; ctrl0
@@ -99,10 +99,10 @@ module Make(Point:P) = struct
     = fun (type s) {path; _} (module Repr : Repr.M with type t = Point.t and type repr = s) repr ->
       let repr_bezier p bezier =
         Repr.quadratic_to
-          bezier.p0
-          bezier.ctrl0
-          bezier.ctrl1
-          bezier.p1
+          ( bezier.p0
+          , bezier.ctrl0
+          , bezier.ctrl1
+          , bezier.p1 )
           p in
 
       let _, repr = Array.fold_left path
diff --git a/path/repr.ml b/path/repr.ml
index 63e7ba0..55a2920 100755
--- a/path/repr.ml
+++ b/path/repr.ml
@@ -11,7 +11,7 @@ module type M = sig
     : t -> t -> repr -> repr
 
   val quadratic_to
-    : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
+    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
 
   val stop
     : repr -> repr
diff --git a/script.it/dune b/script.it/dune
index 84b91f6..c51c43b 100755
--- a/script.it/dune
+++ b/script.it/dune
@@ -7,6 +7,7 @@
    elements
    blog
    layer
+   worker_messages
    )
  (modes js)
  (modules script state selection)
@@ -27,6 +28,7 @@
    js_of_ocaml
    shapes
    path
+   worker_messages
    )
  (modes js)
  (preprocess (pps ppx_hash js_of_ocaml-ppx))
diff --git a/script.it/script.ml b/script.it/script.ml
index ca831ba..3133269 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -4,14 +4,6 @@ open Brr
 open Brr_note
 
 
-module Mouse = Brr_note_kit.Mouse
-
-let get_height el =
-  match El.at (Jstr.v "height") el with
-  | None -> 0
-  | Some att ->
-    Option.value ~default:0 (Jstr.to_int att)
-
 (** Create the element in the page, and the event handler *)
 let canva
   : Brr.El.t -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
@@ -60,14 +52,14 @@ let canva
       Brr_note_kit.Mouse.left_up mouse
       |> E.map (fun c -> `Out c) in
 
-    let position = Mouse.pos mouse in
+    let position = Brr_note_kit.Mouse.pos mouse in
 
     let pos = S.l2 (fun b pos ->
         if b then
           Some pos
         else
           None
-      ) (Mouse.left mouse) position in
+      ) (Brr_note_kit.Mouse.left mouse) position in
 
     E.select [click; up], pos, c
 
@@ -293,15 +285,6 @@ let on_change canva mouse_position timer state =
         ~w:10.
         ~h:10.
         context;
-
-(*
-      Cd2d.stroke_text
-        context
-        (Jstr.of_float @@ Path.Point.get_stamp point)
-        ~x:(x +. 15.)
-        ~y;
-*)
-
     | _ -> ()
   in
 
diff --git a/script.it/state.ml b/script.it/state.ml
index da97b13..cc199d1 100755
--- a/script.it/state.ml
+++ b/script.it/state.ml
@@ -1,8 +1,6 @@
 open StdLabels
 open Brr
 
-let backgroundColor = Blog.Nord.nord0
-
 type mode =
   | Edit
   | Selection of Selection.t
@@ -51,6 +49,10 @@ type state =
   ; rendering : Layer.Paths.printer
   }
 
+let post
+  : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
+  = Brr_webworkers.Worker.post
+
 let insert_or_replace state ((x, y) as p) stamp path =
   let width = state.width
   and angle = state.angle in
@@ -140,7 +142,7 @@ let delete state worker =
           | false -> ()
           | true ->
             (* Send the job to the worker *)
-            Brr_webworkers.Worker.post worker (`DeletePoint (point, p))
+            post worker (`DeletePoint (point, p))
         );
     { state with mode = Selection (Path id) }
   | _ ->
@@ -266,7 +268,7 @@ let do_action
                 current
             in
 
-            let () = Brr_webworkers.Worker.post worker (`Complete last) in
+            let () = post worker (`Complete last) in
             last::state.paths
           and current = Path.Path_Builder.empty in
 
@@ -302,7 +304,7 @@ let do_action
               | false -> ()
               | true ->
                 Option.iter
-                  (fun p -> Brr_webworkers.Worker.post worker (`Complete p))
+                  (fun p -> post worker (`Complete p))
                   (Path.Fixed.replace_point path point')
             );
 
@@ -322,7 +324,7 @@ let do_action
                ~f:(fun path ->
 
                    Layer.Paths.to_svg
-                     ~color:backgroundColor
+                     ~color:Blog.Nord.nord0
                      (module Path.Fixed)
                      path
                      state.rendering
diff --git a/script.it/worker.ml b/script.it/worker.ml
index 4ea9220..00e4595 100755
--- a/script.it/worker.ml
+++ b/script.it/worker.ml
@@ -1,11 +1,10 @@
 open Js_of_ocaml
 
-type message = [
-  | `Complete of Path.Fixed.t
-  | `DeletePoint of (Path.Point.t * Path.Fixed.t)
-]
+let post_message
+  : Worker_messages.from_worker -> unit
+  = Worker.post_message
 
-let execute (command: [> message]) =
+let execute (command: [> Worker_messages.to_worker]) =
   match command with
   | `Complete path ->
     begin match Path.Fixed.rebuild path with
@@ -17,8 +16,8 @@ let execute (command: [> message]) =
       | Some path ->  Worker.post_message (`Complete path)
       | None -> ()
     end
-  | any ->
-    Worker.post_message (`Other any)
+  | _ ->
+    post_message (`Other (Js.string "Unknown message received"))
 
 let () =
   Worker.set_onmessage execute
diff --git a/script.it/worker_messages/dune b/script.it/worker_messages/dune
new file mode 100755
index 0000000..d1511a6
--- /dev/null
+++ b/script.it/worker_messages/dune
@@ -0,0 +1,6 @@
+(library
+ (name worker_messages)
+ (libraries 
+   js_of_ocaml
+   path)
+  )
diff --git a/script.it/worker_messages/worker_messages.ml b/script.it/worker_messages/worker_messages.ml
new file mode 100755
index 0000000..992ec29
--- /dev/null
+++ b/script.it/worker_messages/worker_messages.ml
@@ -0,0 +1,11 @@
+open Js_of_ocaml
+
+type to_worker = [
+  | `Complete of Path.Fixed.t
+  | `DeletePoint of (Path.Point.t * Path.Fixed.t)
+]
+
+type from_worker = [
+  | `Complete of Path.Fixed.t
+  | `Other of Js.js_string Js.t
+]