1 files changed, 266 insertions, 0 deletions
diff --git a/script.it/state.ml b/script.it/state.ml
new file mode 100755
index 0000000..5a1ef8f
--- /dev/null
+++ b/script.it/state.ml
@@ -0,0 +1,266 @@
+open StdLabels
+open Brr
+
+let expected_host = Blog.Hash_host.expected_host
+
+let backgroundColor = Blog.Nord.nord0
+
+let timer, tick = Elements.Timer.create ()
+
+type mode =
+  | Edit
+  | Selection of int
+  | Out
+
+(** Events *)
+type canva_events =
+  [ `Click of float * float
+  | `Out of float * float
+  ]
+
+type button_events =
+  [ `Delete
+  | `Export
+  ]
+
+type events =
+  [ canva_events
+  | button_events
+  | `Point of float * (float * float)
+  | `Width of float
+  | `Angle of float
+  ]
+
+(*
+ The state cant hold functionnal values, and thus cannot be used to store
+ elements like timer
+ *)
+type state =
+  { mode : mode
+  ; paths : Path.Fixed.t list
+  ; current : Path.Path_Builder.t
+  ; width : float
+  ; angle : float
+  }
+
+let insert_or_replace state ((x, y) as p) path =
+  let width = state.width
+  and angle = state.angle in
+  let point = Path.Point.create ~x ~y ~angle ~width in
+  match Path.Path_Builder.peek path with
+  | None ->
+    Path.Path_Builder.add_point
+      point
+      path
+  | Some p1 ->
+    let open Gg.V2 in
+
+    let p1' = Path.Point.get_coord p1 in
+
+    let dist = (norm (p1' - (of_tuple p))) in
+    if dist < 5. then (
+      path
+    ) else (
+      Path.Path_Builder.add_point
+        point
+        path
+    )
+
+let threshold = 20.
+
+let check_selection
+  : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t) option
+  = fun position paths ->
+    let point = Gg.V2.of_tuple position in
+    (* If the user click on a curve, select it *)
+    let _, res = List.fold_left paths
+        ~init:(threshold, None)
+        ~f:(fun (dist, selection) path ->
+            match Path.Fixed.distance point path with
+            | Some (point', p) when p < dist ->
+              dist, Some (point', path)
+            | _ -> dist, selection
+          ) in
+    res
+
+(** Update the path in the selection with the given function applied to
+    every point *)
+let update_selection id state f =
+
+  let paths = List.map state.paths
+      ~f:(fun path ->
+          let id' = Path.Fixed.id path in
+          match id = id' with
+          | false -> path
+          | true -> Path.Fixed.map_point path f
+        ) in
+  { state with paths }
+
+let do_action
+  : events -> state -> state
+  = fun event state ->
+    match event, state.mode with
+    | `Point (_delay, point), Edit ->
+      (* Add the point in the list *)
+      let current = insert_or_replace
+          state
+          point
+          state.current in
+      { state with current }
+
+    (* Click anywhere while in Out mode, we switch in edition *)
+    | `Click ((x, y) as p), Out ->
+      Elements.Timer.start timer 0.3;
+
+      let width = state.width
+      and angle = state.angle in
+
+      let point =
+        match check_selection p state.paths with
+        | None ->
+          (* Start a new path with the point clicked *)
+          Path.Point.create ~x ~y ~angle ~width
+        | Some (p, _) ->
+          (* If the point is close to an existing path, we use the closest
+             point in the path instead *)
+          let x, y = Gg.V2.to_tuple p in
+          Path.Point.create ~x ~y ~angle ~width
+      in
+
+      let current = Path.Path_Builder.add_point
+          point
+          state.current in
+      { state with current; mode = Edit }
+
+    (* Click anywhere while in selection mode, we either select another path,
+       or switch to Out mode*)
+    | `Click position, (Selection _) ->
+      begin match check_selection position state.paths with
+        | None ->
+          { state with
+            mode = Out }
+        | Some (_, selected) ->
+
+          (* Start the timer in order to handle the mouse moves *)
+
+          let id = Path.Fixed.id selected in
+          Elements.Timer.start timer 0.3;
+          { state with
+            mode = (Selection id)}
+      end
+
+    | `Out point, Edit ->
+      Elements.Timer.stop timer;
+      begin match Path.Path_Builder.peek2 state.current with
+        (* If there is at last two points selected, handle this as a curve
+            creation. And we add the new point in the current path *)
+        | Some _ ->
+
+(*
+          let point = match check_selection point state.paths with
+            | None -> point
+            | Some (p, _) -> Gg.V2.to_tuple p in
+*)
+
+          let current = insert_or_replace state point state.current in
+          let paths =
+            let last = Path.Fixed.to_fixed
+                (module Path.Path_Builder)
+                current
+            in
+            last::state.paths
+          and current = Path.Path_Builder.empty in
+          { state with
+            mode = Out
+          ; paths; current }
+
+        (* Else, check if there is a curve undre the cursor, and remove it *)
+        | None ->
+          let current = Path.Path_Builder.empty in
+          begin match check_selection point state.paths with
+            | None ->
+              { state with
+                mode = Out
+              ; current
+              }
+            | Some (_, selected) ->
+              let id = Path.Fixed.id selected in
+              { state with
+                mode = (Selection id)
+              ; current }
+          end
+      end
+    | `Delete, Selection id ->
+      let paths = List.filter state.paths ~f:(fun p -> Path.Fixed.id p != id) in
+      { state with paths ; mode = Out}
+
+
+    | `Export, _ ->
+
+      let my_host = Uri.host @@ Window.location @@ G.window in
+
+      if (Hashtbl.hash my_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 ->
+
+                   Path.to_svg
+                     ~color:backgroundColor
+                     (module Path.Fixed)
+                     path
+                     `Fill
+
+                 )) in
+        let content = El.prop Elements.Prop.outerHTML svg in
+
+        let btoa = Jv.get Jv.global "btoa" in
+        let base64data = Jv.apply btoa
+            [| Jv.of_jstr content |] in
+
+        (* Create the link to download the the element, and simulate a click on it *)
+        let a = El.a
+            ~at:At.[
+                href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data))
+              ; v (Jstr.v "download") (Jstr.v "out.svg")
+              ]
+            [] in
+        El.click a
+      );
+      state
+
+    (* Change the select curve with the appropriate setting *)
+    | `Angle angle, Selection s ->
+      let state = { state with angle } in
+      update_selection s state (fun p -> Path.Point.set_angle p angle)
+    | `Width width, Selection s ->
+      let state = { state with width } in
+      update_selection s state (fun p -> Path.Point.set_width p width)
+
+    | `Angle angle, _ ->
+      { state with angle}
+    | `Width width, _ ->
+      { state with width}
+
+    | `Delete, Out
+      -> state
+
+    (* Some non possible cases *)
+    | `Out _, Out
+    | `Point _, Out
+    | `Point _, Selection _
+    | `Out _, Selection _
+    | `Click _, Edit
+    | `Delete, Edit
+      -> state
+
+let init =
+  { paths = []
+  ; current = Path.Path_Builder.empty
+  ; mode = Out
+  ; angle = 30.
+  ; width = 10.
+  }