1 files changed, 221 insertions, 0 deletions
diff --git a/state.ml b/state.ml
new file mode 100755
index 0000000..60796c8
--- /dev/null
+++ b/state.ml
@@ -0,0 +1,221 @@
+open StdLabels
+open Brr
+
+module Path_Builder = Paths.Path_Builder
+module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
+module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr)
+
+
+let expected_host = [%static_hash ""]
+
+let backgroundColor = Blog.Nord.nord0
+
+let timer, tick = Elements.Timer.create ()
+
+type mode =
+  | Edit
+  | Selection of Path_Builder.fixedPath
+  | Out
+
+type current = Path_Builder.t
+
+
+(** 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 cannt hold functionnal values, and thus cannot be used to store
+ elements like timer
+ *)
+type state =
+  { mode : mode
+  ; paths : Path_Builder.fixedPath list
+  ; current : current
+  ; 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_Builder.peek path with
+  | None ->
+    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, None
+    ) else (
+      Path_Builder.add_point
+        point
+        path
+    )
+
+let check_selection
+  : (float * float) -> Path_Builder.fixedPath list -> Path_Builder.fixedPath option
+  = fun position paths ->
+    let point = Gg.V2.of_tuple position in
+    (* If the user click on a curve, select it *)
+    List.fold_left paths
+      ~init:None
+      ~f:(fun selection path ->
+
+          match selection with
+          | Some p -> Some p
+          | None ->
+            (* TODO : Add a method in the point module *)
+            begin match Path_Builder.distance point path with
+              | Some p when p < 20. ->
+                Some path
+              | _ -> None
+            end
+        )
+
+
+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, fixed_path = insert_or_replace
+          state
+          point
+          state.current in
+      let paths = match fixed_path with
+        | None -> state.paths
+        | Some p -> p::state.paths in
+      { state with current; paths }
+
+    (* Click anywhere while in Out mode, we switch in edition *)
+    | `Click _, Out ->
+      Elements.Timer.start timer 0.3;
+      { state with 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 *)
+          Elements.Timer.start timer 0.3;
+          { state with
+            mode = (Selection selected)}
+      end
+
+    | `Out point, Edit ->
+      Elements.Timer.stop timer;
+      begin match Path_Builder.peek2 state.current with
+        (* If there is at last two points selected, handle this as a curve
+            creation *)
+        | Some _ ->
+          let current, fixed_path = insert_or_replace state point state.current in
+          let paths = match fixed_path with
+            | None -> Path_Builder.to_fixed current::state.paths
+            | Some p -> p::state.paths
+          and current = 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_Builder.empty in
+          begin match check_selection point state.paths with
+            | None ->
+              { state with
+                mode = Out
+              ; current
+              }
+            | Some selected ->
+              { state with
+                mode = (Selection selected)
+              ; current }
+          end
+      end
+    | `Delete, Selection s ->
+      let id = Path_Builder.id s in
+      let paths = List.filter state.paths ~f:(fun p -> Path_Builder.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 ->
+                   let repr = SVGRepr.create_path (fun _ -> ()) in
+                   let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in
+
+                   Layer.Svg.path
+                     ~at:Brr.At.[
+                         v (Jstr.v "fill")  backgroundColor
+                       ; v (Jstr.v "stroke") backgroundColor
+                       ; v (Jstr.v "d") path ]
+                     []
+                 )) 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
+
+    | `Angle angle, _ ->
+      { state with angle}
+    | `Width width, _ ->
+      { state with width}
+
+    | _ -> state
+
+let init =
+  { paths = []
+  ; current = Path_Builder.empty
+  ; mode = Out
+  ; angle = 30.
+  ; width = 10.
+  }