From 2e29673fa970b814c97d5838963de49c2a65424b Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 13:43:24 +0100
Subject: Rename application functions
---
css/merger.ml | 4 ++--
lib/application/application.ml | 12 ++++++++++--
script.it/script.ml | 30 ++++++++----------------------
script.it/script_event/click.ml | 2 +-
script.it/script_event/complete_path.ml | 2 +-
script.it/script_event/delete.ml | 2 +-
script.it/script_event/export.ml | 2 +-
script.it/script_event/mouse_down.ml | 2 +-
script.it/script_event/property.ml | 2 +-
script.it/script_event/tick.ml | 2 +-
10 files changed, 27 insertions(+), 33 deletions(-)
diff --git a/css/merger.ml b/css/merger.ml
index 2a681be..47fa906 100755
--- a/css/merger.ml
+++ b/css/merger.ml
@@ -47,7 +47,7 @@ let build_result
module AddFile = struct
type t = file
- let update file state =
+ let process file state =
let _ = state.files##push file in
let elements = state.files##.length
and result_css = build_result state.files in
@@ -58,7 +58,7 @@ module DelFile = struct
type t = File.t
- let update file state =
+ let process file state =
let files = state.files##filter
(Js.wrap_callback @@ (fun elt _ _ -> Js.bool (elt.file != file))) in
let elements = files##.length
diff --git a/lib/application/application.ml b/lib/application/application.ml
index 789bd80..422aa4f 100755
--- a/lib/application/application.ml
+++ b/lib/application/application.ml
@@ -48,7 +48,7 @@ module Make(S:sig type t end) = struct
type t
- val update: t -> S.t -> S.t
+ val process: t -> S.t -> S.t
end
@@ -58,8 +58,16 @@ module Make(S:sig type t end) = struct
let run
: ?eq:(S.t -> S.t -> bool) -> S.t -> event Note.E.t -> S.t Note.S.t
= fun ?eq init event ->
- let action = Note.E.map (fun (E (t, (module Event))) st -> Event.update t st) event in
+ let action = Note.E.map (fun (E (t, (module Event))) st -> Event.process t st) event in
Note.S.accum ?eq init action
+
+ let dispatch
+ : (module Event with type t = 's) -> 's -> event
+ = fun (type s) (module M: Event with type t = s) v ->
+ E
+ ( v
+ , (module M : Event with type t = M.t ))
+
end
diff --git a/script.it/script.ml b/script.it/script.ml
index 6c2b5d3..78a45b3 100755
--- a/script.it/script.ml
+++ b/script.it/script.ml
@@ -168,7 +168,7 @@ let set_sidebar
let module M = struct
type t = Layer.Paths.printer
- let update t state = { state with State.rendering = t }
+ let process t state = { state with State.rendering = t }
end
in
@@ -375,31 +375,23 @@ let page_main id =
let delete_event = E.map
(fun () ->
let module Delete = Script_event.Delete in
- State.E
- ( Delete.{ worker }
- , (module Delete: State.Event with type t = Delete.t )))
+ State.dispatch (module Delete) Delete.{ worker })
parameters.delete
and export_event =
E.map (fun () ->
let module Export = Script_event.Export in
- State.E
- ( ()
- , (module Export: State.Event with type t = Export.t )))
+ State.dispatch (module Export ) ())
parameters.export
and angle_event = S.changes parameters.angle
|> E.map (fun value ->
let module Property = Script_event.Property in
- State.E
- ( Property.{ value ; worker ; prop = `Angle }
- , (module Property: State.Event with type t = Property.t )))
+ State.dispatch (module Property) (Property.{ value ; worker ; prop = `Angle}))
and width_event = S.changes parameters.width
|> E.map (fun value ->
let module Property = Script_event.Property in
- State.E
- ( Property.{ value ; worker ; prop = `Width }
- , (module Property: State.Event with type t = Property.t )))
+ State.dispatch (module Property) (Property.{ value ; worker ; prop = `Width }))
and worker_event = Note.E.filter_map
(function
| `Other t ->
@@ -408,9 +400,7 @@ let page_main id =
| `Complete outline ->
let module Complete_path = Script_event.Complete_path in
Some (
- State.E
- ( outline
- , (module Complete_path: State.Event with type t = Complete_path.t ))))
+ State.dispatch (module Complete_path) outline))
worker_event
in
@@ -437,15 +427,11 @@ let page_main id =
(function
| `MouseDown c ->
let module MouseDown = Script_event.Mouse_down in
- State.E
- ( MouseDown.{ position = c ; timer }
- , (module MouseDown: State.Event with type t = MouseDown.t ))
+ State.dispatch (module MouseDown) MouseDown.{ position = c ; timer }
| `Out c ->
let module Click = Script_event.Click in
- State.E
- ( Click.{ point = c ; worker; timer }
- , (module Click: State.Event with type t = Click.t ))
+ State.dispatch (module Click) Click.{ point = c ; worker ; timer }
) canva_events in
let tick_event =
diff --git a/script.it/script_event/click.ml b/script.it/script_event/click.ml
index 591887b..b7ffcb6 100755
--- a/script.it/script_event/click.ml
+++ b/script.it/script_event/click.ml
@@ -30,7 +30,7 @@ let drag mouse_coord state worker = function
(* TODO Long click in out mode should translate the whole slate *)
| _ -> state
-let update {point; timer ; worker} state =
+let process {point; timer ; worker} state =
match state.State.mode with
| Edit ->
diff --git a/script.it/script_event/complete_path.ml b/script.it/script_event/complete_path.ml
index 99dd6ae..4383a2e 100755
--- a/script.it/script_event/complete_path.ml
+++ b/script.it/script_event/complete_path.ml
@@ -3,7 +3,7 @@ module State = Script_state.State
type t = Outline.t
-let update newPath state =
+let process newPath state =
let paths = List.map
state.State.paths
~f:(fun line ->
diff --git a/script.it/script_event/delete.ml b/script.it/script_event/delete.ml
index 6aac5d2..3566b8f 100755
--- a/script.it/script_event/delete.ml
+++ b/script.it/script_event/delete.ml
@@ -7,7 +7,7 @@ module Selection = Script_state.Selection
type t = { worker : Brr_webworkers.Worker.t }
(* Click anywhere while in Out mode, we switch in edition *)
-let update { worker } state =
+let process { worker } state =
match state.State.mode with
| Selection (Path id) ->
let paths = List.filter
diff --git a/script.it/script_event/export.ml b/script.it/script_event/export.ml
index 9e900c7..10dd937 100755
--- a/script.it/script_event/export.ml
+++ b/script.it/script_event/export.ml
@@ -4,7 +4,7 @@ module State = Script_state.State
type t = unit
-let update () state =
+let process () state =
let my_host = Uri.host @@ Window.location @@ G.window in
if (Hashtbl.hash my_host) = Blog.Hash_host.expected_host then (
(* Convert the path into an sVG element *)
diff --git a/script.it/script_event/mouse_down.ml b/script.it/script_event/mouse_down.ml
index 98e866a..1c25a7d 100755
--- a/script.it/script_event/mouse_down.ml
+++ b/script.it/script_event/mouse_down.ml
@@ -4,7 +4,7 @@ module Selection = Script_state.Selection
type t = { position : float * float
; timer : Elements.Timer.t }
-let update { position; timer } state =
+let process { position; timer } state =
match state.State.mode with
| Out ->
diff --git a/script.it/script_event/property.ml b/script.it/script_event/property.ml
index e637ab7..dbdc1de 100755
--- a/script.it/script_event/property.ml
+++ b/script.it/script_event/property.ml
@@ -28,7 +28,7 @@ type t = { prop : [`Angle | `Width ]
; worker : Brr_webworkers.Worker.t
}
-let update { prop; value ; worker } state =
+let process { prop; value ; worker } state =
match prop with
| `Angle ->
let angle = value in
diff --git a/script.it/script_event/tick.ml b/script.it/script_event/tick.ml
index c927a2a..1052cf8 100755
--- a/script.it/script_event/tick.ml
+++ b/script.it/script_event/tick.ml
@@ -7,7 +7,7 @@ type t = float * (float * float)
Tick only occurs when drawing a new path
*)
-let update (delay, point) state =
+let process (delay, point) state =
match state.State.mode with
| Edit ->
(* Add the point in the list *)
--
cgit v1.2.3