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/script.ml | 196 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 124 insertions(+), 72 deletions(-) (limited to 'script.it/script.ml') 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 -- cgit v1.2.3