summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xcss/dune1
-rwxr-xr-xcss/merger.ml17
-rwxr-xr-xlib/application/application.ml9
-rwxr-xr-xlib/application/dune8
-rwxr-xr-xscript.it/dune1
-rwxr-xr-xscript.it/script.ml25
-rwxr-xr-xscript.it/state.ml2
7 files changed, 43 insertions, 20 deletions
diff --git a/css/dune b/css/dune
index 65a9c41..1e32b19 100755
--- a/css/dune
+++ b/css/dune
@@ -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), _ ->