From 6a75fb043ed30389fff1ce97fe20ee56b1c95066 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Tue, 25 May 2021 11:08:00 +0200
Subject: Update script.it project

---
 script.it/state/state.ml | 136 ++---------------------------------------------
 1 file changed, 5 insertions(+), 131 deletions(-)

(limited to 'script.it/state/state.ml')

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 =
-- 
cgit v1.2.3