diff options
| -rwxr-xr-x | css/merger.ml | 4 | ||||
| -rwxr-xr-x | lib/application/application.ml | 12 | ||||
| -rwxr-xr-x | script.it/script.ml | 30 | ||||
| -rwxr-xr-x | script.it/script_event/click.ml | 2 | ||||
| -rwxr-xr-x | script.it/script_event/complete_path.ml | 2 | ||||
| -rwxr-xr-x | script.it/script_event/delete.ml | 2 | ||||
| -rwxr-xr-x | script.it/script_event/export.ml | 2 | ||||
| -rwxr-xr-x | script.it/script_event/mouse_down.ml | 2 | ||||
| -rwxr-xr-x | script.it/script_event/property.ml | 2 | ||||
| -rwxr-xr-x | 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 *) |