diff options
| -rwxr-xr-x | css/dune | 1 | ||||
| -rwxr-xr-x | css/merger.ml | 17 | ||||
| -rwxr-xr-x | lib/application/application.ml | 9 | ||||
| -rwxr-xr-x | lib/application/dune | 8 | ||||
| -rwxr-xr-x | script.it/dune | 1 | ||||
| -rwxr-xr-x | script.it/script.ml | 25 | ||||
| -rwxr-xr-x | script.it/state.ml | 2 |
7 files changed, 43 insertions, 20 deletions
@@ -5,6 +5,7 @@ brr.note elements blog + application Css css_lib ) diff --git a/css/merger.ml b/css/merger.ml index 7f525ff..a7c33eb 100755 --- a/css/merger.ml +++ b/css/merger.ml @@ -47,7 +47,7 @@ let build_result merge_result let do_action - : event -> state -> state + : (event, state) Application.t = fun event state -> match event with | AddFile file -> @@ -230,13 +230,16 @@ let main id = let add_file_event, add_file_sender = Note.E.create () in let del_file_event, del_file_sender = Note.E.create () in + let state = - E.select - [ E.map (fun f -> AddFile f) add_file_event - ; del_file_event - ] - |> E.map do_action - |> Note.S.accum init in + Application.run + do_action + init + (E.select + [ E.map (fun f -> AddFile f) add_file_event + ; del_file_event + ]) + in let _ = Elr.def_children elements diff --git a/lib/application/application.ml b/lib/application/application.ml new file mode 100755 index 0000000..15452fb --- /dev/null +++ b/lib/application/application.ml @@ -0,0 +1,9 @@ +(** The type for the applcation *) +type ('a, 'b) t = 'a -> 'b -> 'b + +(** Simple helper for the main event loop *) +let run + : ?eq:('b -> 'b -> bool) -> ('a, 'b) t -> 'b -> 'a Note.E.t -> 'b Note.S.t + = fun ?eq f init event -> + let action = Note.E.map f event in + Note.S.accum ?eq init action diff --git a/lib/application/dune b/lib/application/dune new file mode 100755 index 0000000..4661283 --- /dev/null +++ b/lib/application/dune @@ -0,0 +1,8 @@ +(library + (name application) + (libraries + brr + brr.note + elements + ) + ) diff --git a/script.it/dune b/script.it/dune index db5ba3f..ceae76c 100755 --- a/script.it/dune +++ b/script.it/dune @@ -14,6 +14,7 @@ shapes elements blog + application layer worker_messages outline diff --git a/script.it/script.ml b/script.it/script.ml index a1857db..ba6b828 100755 --- a/script.it/script.ml +++ b/script.it/script.ml @@ -392,18 +392,19 @@ let page_main id = (* 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 + Application.run + (State.do_action worker timer) + State.init + (E.select + [ worker_event + ; canva_events + ; tick_event + ; angle_event + ; width_event + ; delete_event + ; export_event + ; parameters.rendering ]) + in (* The seconde evaluation is the canva refresh, which only occurs when the mouse is updated, or on delete events *) diff --git a/script.it/state.ml b/script.it/state.ml index cb5d9ff..77a24a3 100755 --- a/script.it/state.ml +++ b/script.it/state.ml @@ -195,7 +195,7 @@ let longClick mouse_coord state worker = function | _ -> state let do_action - : Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state + : Brr_webworkers.Worker.t -> Elements.Timer.t -> (events, state) Application.t = fun worker timer event state -> match event, state.mode with | `Point (delay, point), _ -> |