diff options
Diffstat (limited to 'script.it/state')
| -rwxr-xr-x | script.it/state/state.ml | 136 |
1 files changed, 5 insertions, 131 deletions
diff --git a/script.it/state/state.ml b/script.it/state/state.ml index 4cf6992..e8cd87e 100755 --- a/script.it/state/state.ml +++ b/script.it/state/state.ml @@ -1,17 +1,8 @@ -open StdLabels -open Brr - type mode = | Edit | Selection of Selection.t | Out -(** Events *) -type render_event = - [ - `Rendering of Layer.Paths.printer - ] - type worker_event = Worker_messages.from_worker (* @@ -32,21 +23,13 @@ module type Handler = sig type t - val apply: t -> state -> state + val update: t -> state -> state end type t = E : 'a * (module Handler with type t = 'a) -> t -type events = - [ `Export - | render_event - | worker_event - | `Point of float * (float * float) - | `Width of float - | `Angle of float - | `Generic of t - ] +type events = t let post : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit @@ -89,120 +72,11 @@ let select_segment _ (_, selected, p0, p1) state dist = ; angle ; width } -(** Tick event - - Tick only occurs when drawing a new path - -*) -let tick (delay, point) state = - match state.mode with - | Edit -> - (* Add the point in the list *) - let current = insert_or_replace - state - point - delay - state.current in - { state with current } - | _ -> state - -let update_property worker state value f = function - | None -> state - | Some (Selection.Path outline) -> - (* Change width for the whole path *) - let outline = { outline with - Outline.path = Path.Fixed.map outline.Outline.path (fun p -> - f p value) - } in - post worker (`Back outline); - state - | Some (Point (outline, point)) -> - let path = Path.Fixed.map - outline.path - (fun pt -> - match Path.Point.id pt = Path.Point.id point with - | false -> pt - | true -> f pt value) - in - let outline = {outline with path} in - post worker (`Back outline); - state - -let width worker width state = - match state.mode with - - | Selection t -> - let state = { state with width } in - Selection.find_selection t state.paths - |> update_property worker state width Path.Point.set_width - | _ -> { state with width } - -let angle worker angle state = - match state.mode with - - | Selection t -> - let state = { state with angle } in - Selection.find_selection t state.paths - |> update_property worker state angle Path.Point.set_angle - | _ -> { state with angle } - let do_action - : Brr_webworkers.Worker.t -> (events, state) Application.t - = fun worker event state -> - match event, state.mode with - | `Generic (E (t, (module Handler))), _ -> - Handler.apply t state - | `Point (delay, point), _ -> - tick (delay, point) state - - - | `Export, _ -> - 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 *) - let svg = Layer.Svg.svg - ~at:Brr.At.[ - v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg") - ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ] - (List.map state.paths - ~f:(fun path -> - - Layer.Paths.to_svg - ~color:Blog.Nord.nord0 - (module Path.Fixed) - Outline.(path.path, path.back) - state.rendering - - )) in - let content = El.prop Elements.Prop.outerHTML svg in - Elements.Transfert.send - ~mime_type:(Jstr.v "image/svg+xml") - ~filename:(Jstr.v "out.svg") - content); - state - - | `Angle value , _ -> - angle worker value state - | `Width value, _ -> - width worker value state - - - | `Rendering rendering, _ -> - { state with rendering} - - | `Other t, _ -> - Console.(log [t]); - state - - | `Complete newPath, _ -> - let paths = List.map - state.paths - ~f:(fun line -> - match Outline.(newPath.id = line.id) with - | true -> newPath - | false -> line) in - { state with paths } + : (events, state) Application.t + = fun (E (t, (module Handler))) state -> + Handler.update t state let init = |