diff options
| author | Sébastien Dailly <sebastien@chimrod.com> | 2021-05-25 11:08:00 +0200 | 
|---|---|---|
| committer | Sébastien Dailly <sebastien@dailly.me> | 2022-02-07 16:22:43 +0100 | 
| commit | 6a75fb043ed30389fff1ce97fe20ee56b1c95066 (patch) | |
| tree | 20e0c2cb39dffcf85449e0b810d773909c405a0e /script.it/state | |
| parent | 90f1f73f08b2d9231b2ee029b9e39dd570e36f36 (diff) | |
Update script.it project
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 =  | 
