Communication with webworker

1 files changed, 124 insertions, 72 deletions

diff --git a/script.it/script.ml b/script.it/script.ml
index 3e52f5c..131ea39 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -80,8 +80,16 @@ let click_event el =
 let show_value input =
   El.txt (Jstr.of_float input)
 
+type 'a param_events =
+  { width : float S.t
+  ; angle : float S.t
+  ; export : unit E.t
+  ; delete : unit E.t
+  ; rendering : ([> State.render_event] as 'a) E.t
+  }
+
 let set_sidebar
-  : El.t -> State.state -> unit E.t * float S.t * float S.t *unit E.t
+  : El.t -> State.state -> _ param_events
   = fun element state ->
 
     let open El in
@@ -130,6 +138,7 @@ let set_sidebar
                ; v (Jstr.v "max") (Jstr.v "90")
                ; At.value (Jstr.of_float state.angle)
                ] in
+
     let angle = El.div [] in
     Elr.def_children
       angle
@@ -143,17 +152,32 @@ let set_sidebar
 
     let render =
       El.select
-        [ El.option ~at:At.[value (Jstr.v "Fill")]
+        [ El.option ~at:At.[value (Jstr.v "1")]
             [ txt' "Fill"]
-        ; El.option ~at:At.[value (Jstr.v "Wireframe")]
-            [ txt' "Wireframe"]
-        ; El.option ~at:At.[value (Jstr.v "Ductus")]
+        ; El.option ~at:At.[value (Jstr.v "2")]
             [ txt' "Ductus"]
+(*
+        ; El.option ~at:At.[value (Jstr.v "3")]
+            [ txt' "Line"]
+*)
         ] in
+
     let rendering' = El.div
         [ txt' "Rendering : "
         ; render ] in
 
+    let render_event =
+      Evr.on_el
+        Ev.change (fun _ ->
+            let raw_value = El.prop El.Prop.value render
+                            |> Jstr.to_int in
+            match raw_value with
+            | Some 1 -> `Rendering `Fill
+            | Some 2 -> `Rendering `Line
+            | Some 3 -> `Rendering `Ductus
+            | _ -> `Rendering `Fill
+          )  rendering' in
+
     let () =
       El.append_children element
         [ hr ()
@@ -172,14 +196,19 @@ let set_sidebar
 
         ]
     in
-    delete_event, angle_event, nib_size_event, export_event
+    { delete = delete_event
+    ; angle = angle_event
+    ; width = nib_size_event
+    ; export = export_event
+    ; rendering = render_event
+    }
 
 let backgroundColor = Blog.Nord.nord0
 let white = Jstr.v "#eceff4"
 let green = Jstr.v "#a3be8c"
 
 (** Redraw the canva on update *)
-let on_change canva mouse_position state =
+let on_change canva mouse_position timer state =
   let module Cd2d = Brr_canvas.C2d in
 
   let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in
@@ -206,15 +235,14 @@ let on_change canva mouse_position state =
   let current =
     begin match state.State.mode, pos with
       | Edit, Some point ->
-        State.insert_or_replace state point state.current
+        let stamp = Elements.Timer.delay timer in
+        State.insert_or_replace state point stamp state.current
       | _ ->
         state.current
     end
   in
 
-  let repr = `Fill in
-
-  Path.to_canva (module Path.Path_Builder) current context repr;
+  Layer.Paths.to_canva (module Path.Path_Builder) current context state.rendering;
 
   List.iter state.paths
     ~f:(fun path ->
@@ -233,14 +261,21 @@ let on_change canva mouse_position state =
           | _ -> ()
         in
 
-        Path.to_canva (module Path.Fixed) path context repr
+        Layer.Paths.to_canva (module Path.Fixed) path context state.rendering
       );
   ()
 
+let spawn_worker () =
+  try
+    Ok (Brr_webworkers.Worker.create (Jstr.v "worker.js"))
+  with
+  | Jv.Error e -> Error e
 
 let page_main id =
 
-  let delete_event', angle_signal', width_signal', export_event' =
+  let timer, tick = Elements.Timer.create () in
+
+  let parameters =
     begin match Blog.Sidebar.get () with
       | None ->
         Jv.throw (Jstr.v "No sidebar")
@@ -249,11 +284,11 @@ let page_main id =
         Blog.Sidebar.clean el;
         set_sidebar el State.init
     end in
-  let delete_event = E.map (fun () -> `Delete) delete_event'
-  and export_event = E.map (fun () -> `Export) export_event'
-  and angle_event = S.changes angle_signal'
+  let delete_event = E.map (fun () -> `Delete) parameters.delete
+  and export_event = E.map (fun () -> `Export) parameters.export
+  and angle_event = S.changes parameters.angle
                     |> E.map (fun value -> `Angle value)
-  and width_event = S.changes width_signal'
+  and width_event = S.changes parameters.width
                     |> E.map (fun value -> `Width value)
   in
 
@@ -263,64 +298,81 @@ let page_main id =
     | true -> Console.(error [str "No element with id '%s' found"; id])
     | false ->
 
-      (* Add the events to the canva :
-
-         - The mouse position is a signal used for both the update and the
-           canva refresh
-
-         - Get also the click event for starting to draw
-      *)
-
-      let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in
-
-      let tick_event =
-        S.sample_filter mouse_position
-          ~on:State.tick
-          (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in
-
-      (* The first evaluation is the state. Which is the result of all the
-         successives events to the initial state *)
-      let state =
-        E.select
-          [ canva_events
-          ; tick_event
-          ; angle_event
-          ; width_event
-          ; delete_event
-          ; export_event ]
-        |> E.map State.do_action
-        |> Note.S.accum State.init in
-
-      (* The seconde evaluation is the canva refresh, which only occurs when
-         the mouse is updated, or on delete events  *)
-      let _ =
-        E.select
-          [ E.map (fun _ -> ()) (S.changes mouse_position)
-          ; E.map (fun _ -> ()) (S.changes angle_signal')
-          ; E.map (fun _ -> ()) (S.changes width_signal')
-          ; delete_event' ]
-        |> fun ev -> E.log ev (fun _ -> on_change canva mouse_position (S.value state) )
-                     |> Option.iter Logr.hold in
-
-
-      (* Draw the canva for first time *)
-      on_change canva mouse_position State.init;
-
-      (* Hold the state *)
-      let _ = Logr.hold (S.log state (fun _ -> ())) in
-      ()
+      match spawn_worker () with
+      | Error e -> El.set_children (Jv.Id.of_jv id)
+                     [ El.p El.[txt (Jv.Error.message e)]]
+      | Ok worker ->
+
+        let worker_event, worker_send = E.create () in
+        let my_host = Uri.host @@ Window.location @@ G.window in
+        if (Hashtbl.hash my_host) = Blog.Hash_host.expected_host then (
+          let target = Brr_webworkers.Worker.as_target worker in
+          Ev.listen Brr_io.Message.Ev.message
+            (fun t ->
+               Ev.as_type t
+               |> Brr_io.Message.Ev.data
+               |> worker_send)
+            target);
+
+        (* Add the events to the canva :
+
+           - The mouse position is a signal used for both the update and the
+             canva refresh
+
+           - Get also the click event for starting to draw
+        *)
+
+        let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in
+
+        let tick_event =
+          S.sample_filter mouse_position
+            ~on:tick
+            (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in
+
+        (* The first evaluation is the state. Which is the result of all the
+           successives events to the initial state *)
+        let state =
+          E.select
+            [ worker_event
+            ; canva_events
+            ; tick_event
+            ; angle_event
+            ; width_event
+            ; delete_event
+            ; export_event
+            ; parameters.rendering
+            ]
+          |> E.map (State.do_action worker timer)
+          |> Note.S.accum State.init in
+
+        (* The seconde evaluation is the canva refresh, which only occurs when
+           the mouse is updated, or on delete events  *)
+        let _ =
+          E.select
+            [ E.map (fun _ -> ()) (S.changes mouse_position)
+            ; E.map (fun _ -> ()) (S.changes parameters.angle)
+            ; E.map (fun _ -> ()) (S.changes parameters.width)
+            ; E.map (fun _ -> ()) parameters.rendering
+            ; E.map (fun _ -> ()) worker_event
+            ; parameters.delete ]
+          |> fun ev -> E.log ev (fun _ -> on_change canva mouse_position timer (S.value state) )
+                       |> Option.iter Logr.hold in
+
+
+        (* Draw the canva for first time *)
+        on_change canva mouse_position timer State.init;
+
+        (* Hold the state *)
+        let _ = Logr.hold (S.log state (fun _ -> ())) in
+        ()
 
   end
 
 let () =
-  if Brr_webworkers.Worker.ami () then
-    ()
-  else (
 
-    let open Jv in
-    let drawer  = obj
-        [| "run", (repr page_main)
-        |] in
+  let open Jv in
+  let drawer  = obj
+      [| "run", (repr page_main)
+      |] in
 
-    set global "drawer" drawer
-  )
+  set global "drawer" drawer