aboutsummaryrefslogtreecommitdiff
path: root/script.it/state
diff options
context:
space:
mode:
Diffstat (limited to 'script.it/state')
-rwxr-xr-xscript.it/state/state.ml136
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 =