Refactor

4 files changed, 474 insertions, 0 deletions

diff --git a/script.it/state/dune b/script.it/state/dune
new file mode 100755
index 0000000..7d4ef3f
--- /dev/null
+++ b/script.it/state/dune
@@ -0,0 +1,13 @@
+(library
+ (name script_state)
+ (libraries 
+   brr
+   brr.note
+   blog
+   application
+   worker_messages
+   outline
+   layer
+   path
+   )
+ )
diff --git a/script.it/state/selection.ml b/script.it/state/selection.ml
new file mode 100755
index 0000000..f5f135a
--- /dev/null
+++ b/script.it/state/selection.ml
@@ -0,0 +1,71 @@
+open StdLabels
+
+type 'a selection =
+  | Path of 'a
+  | Point of ('a * Path.Point.t)
+
+type t = int selection
+
+let find_selection
+  : int selection -> Outline.t list -> Outline.t selection option
+  = fun selection paths ->
+    match selection with
+    | Path id -> Option.map (fun p -> Path p) (Outline.find paths id)
+    | Point (id, pt) -> Option.map (fun p -> Point (p, pt)) (Outline.find paths id)
+
+let threshold = 20.
+
+let get_from_paths
+  : (float * float) -> Outline.t list -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option
+  = fun position outlines ->
+    let point = Gg.V2.of_tuple position in
+    (* If the user click on a curve, select it *)
+    List.fold_left outlines
+      ~init:(threshold, None)
+      ~f:(fun (dist, selection) outline ->
+          match Path.Fixed.distance point outline.Outline.path with
+          | Some { closest_point ; distance; p0; p1 ; ratio} when distance < dist ->
+            ratio, Some (closest_point, outline, p0, p1)
+          | _ -> dist, selection
+        )
+
+let select_path
+  : Outline.t -> t
+  = fun outline -> Path outline.Outline.id
+
+let select_point
+  : Outline.t -> Gg.v2 -> t
+  = fun outline v2_point ->
+
+    let point' = ref None in
+    let dist = ref threshold in
+
+    Path.Fixed.iter
+      outline.Outline.path
+      ~f:(fun p ->
+          let open Gg.V2 in
+          let new_dist = norm ((Path.Point.get_coord p) - v2_point) in
+          match (new_dist < !dist) with
+          | false -> ()
+          | true ->
+            dist:= new_dist;
+            point' := Some p
+        );
+
+    match !point' with
+    | Some point ->
+      Point (outline.Outline.id, point)
+    | None ->
+      Path (outline.Outline.id)
+
+            (*
+      (* If the point does not exists, find the exact point on the curve *)
+      let coord = Gg.V2.to_tuple v2_point in
+      begin match get_from_paths coord [path] with
+        | _, None -> Path (Path.Fixed.id path)
+        | f, Some (point, path, p0, p1) ->
+
+          let point' = Path.Point.mix f point p0 p1 in
+          Point (Path.Fixed.id path, point')
+      end
+      *)
diff --git a/script.it/state/selection.mli b/script.it/state/selection.mli
new file mode 100755
index 0000000..9792a2d
--- /dev/null
+++ b/script.it/state/selection.mli
@@ -0,0 +1,33 @@
+type 'a selection =
+  | Path of 'a
+  | Point of ('a * Path.Point.t)
+
+type t = int selection
+
+val threshold : float
+
+(** Return the closest path from the list to a given point. 
+
+    The path is returned with all thoses informations :
+    - The point in the path 
+    - The path itself
+    - The starting point from the path
+    - The end point in the path
+
+*)
+val get_from_paths
+  : (float * float) -> Outline.t list -> float * (Gg.v2 * Outline.t * Path.Point.t * Path.Point.t) option
+
+val select_path
+  : Outline.t -> t
+
+(** Check for selecting a point on the given outline. 
+
+    If no point is available, select the path.
+
+*)
+val select_point
+  : Outline.t -> Gg.v2 -> t
+
+val find_selection
+  : int selection -> Outline.t list -> Outline.t selection option
diff --git a/script.it/state/state.ml b/script.it/state/state.ml
new file mode 100755
index 0000000..d7cb13e
--- /dev/null
+++ b/script.it/state/state.ml
@@ -0,0 +1,357 @@
+open StdLabels
+open Brr
+
+type mode =
+  | Edit
+  | Selection of Selection.t
+  | Out
+
+(** Events *)
+type canva_events =
+  [ `MouseDown of float * float
+  ]
+
+type button_events =
+  [ `Delete
+  | `Export
+  ]
+type render_event =
+  [
+    `Rendering of Layer.Paths.printer
+  ]
+
+type worker_event = Worker_messages.from_worker
+
+(*
+ The state cant hold functionnal values, and thus cannot be used to store
+ elements like timer
+ *)
+type state =
+  { mode : mode
+  ; paths : Outline.t list
+  ; current : Path.Path_Builder.t
+  ; width : float
+  ; angle : float
+  ; rendering : Layer.Paths.printer
+  ; mouse_down_position : Gg.v2
+  }
+
+module type Handler = sig
+
+  type t
+
+  val apply: t -> state -> state
+
+end
+
+type t = E : 'a * (module Handler with type t = 'a) -> t
+
+type events =
+  [ canva_events
+  | button_events
+  | render_event
+  | worker_event
+  | `Point of float * (float * float)
+  | `Width of float
+  | `Angle of float
+  | `Generic of t
+  ]
+
+let post
+  : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
+  = Brr_webworkers.Worker.post
+
+let insert_or_replace state ((x, y) as p) stamp path =
+  let width = state.width
+  and angle = state.angle in
+  let point = Path.Point.create ~x ~y ~angle ~width ~stamp 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
+    )
+
+(** Select the given segment, and modify angle and width accordingly *)
+let select_segment _ (_, selected, p0, p1) state dist =
+
+  let point' = Path.Point.mix dist (Path.Point.get_coord p0) p0 p1 in
+
+  let angle = (Float.round @@ 10. *. Path.Point.get_angle point') /. 10.
+  and width = (Float.round @@ 10. *. Path.Point.get_width point') /. 10. in
+
+  let id = Selection.select_path selected in
+  { state with
+    mode = (Selection id)
+  ; angle
+  ; width }
+
+(** Delete the selected element *)
+let delete state worker =
+  match state.mode with
+  | Selection (Path id) ->
+    let paths = List.filter
+        state.paths
+        ~f:(fun p ->
+            p.Outline.id != id
+          ) in
+    { state with paths ; mode = Out}
+
+  | Selection (Point (id, point)) ->
+    List.iter
+      state.paths
+      ~f:(fun p ->
+          let id' = p.Outline.id in
+          match id' = id with
+          | false -> ()
+          | true -> post worker (`DeletePoint (point, p))
+        );
+    { state with mode = Selection (Path id) }
+  | _ ->
+    state
+
+(** 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 }
+
+
+(** Short click on any element, just do nothing (each element is on MouseDown
+    event) *)
+let click state = function
+  | _ -> state
+
+(** Long click, move the selected element if any *)
+let longClick mouse_coord state worker = function
+  | Selection t ->
+    let mouse_v2 = Gg.V2.of_tuple mouse_coord in
+    begin match Selection.find_selection t state.paths with
+      | None -> state
+      | Some (Point (path, point)) ->
+        let point' = Path.Point.copy point mouse_v2 in
+        post worker (`TranslatePoint (point', path));
+        (* Just replace the position of the selected point *)
+        { state with mode = Selection (Point (path.id, point')) }
+      | Some (Path path) ->
+        let delta = Gg.V2.(mouse_v2 - state.mouse_down_position) in
+        post worker (`TranslatePath (path, delta));
+        state
+    end
+  (*  TODO Long click in out mode should translate the slate *)
+  | _ -> state
+
+let do_action
+  : Brr_webworkers.Worker.t -> Elements.Timer.t -> (events, state) Application.t
+  = fun worker timer event state ->
+    match event, state.mode with
+    | `Generic (E (t, (module Handler))), _ ->
+      Handler.apply t state
+    | `Point (delay, point), _ ->
+      tick (delay, point) state
+
+    (* Click anywhere while in Out mode, we switch in edition *)
+    | `MouseDown ((x, y) as p), Out ->
+      Elements.Timer.start timer 0.3;
+
+      let width = state.width
+      and angle = state.angle in
+
+      let stamp = 0. in
+      let point =
+        match Selection.get_from_paths p state.paths with
+        | _, None ->
+          (* Start a new path with the point clicked *)
+          Path.Point.create ~x ~y ~angle ~width ~stamp
+        | _, 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 ~stamp
+      in
+
+      let current = Path.Path_Builder.add_point
+          point
+          state.current in
+      { state with
+        current
+      ; mode = Edit
+      ; mouse_down_position = Gg.V2.of_tuple (x, y)}
+
+    (* Click anywhere while in selection mode, we either select another path,
+       or switch to Out mode*)
+    | `MouseDown position, (Selection (Path id))
+    | `MouseDown position, (Selection (Point (id, _))) ->
+
+      let get_any () =
+        begin match Selection.get_from_paths position state.paths with
+          | _, None ->
+            { state with
+              mode = Out
+            ; mouse_down_position = Gg.V2.of_tuple position }
+          | dist, Some selection ->
+            let _, outline, _, _ = selection in
+            if outline.Outline.id != id then (
+              let mouse_down_position = Gg.V2.of_tuple position in
+              select_segment position selection { state with mouse_down_position } dist
+            ) else
+              (* On the same segment, check for a point *)
+              let selection = Selection.select_point outline (Gg.V2.of_tuple position) in
+              match selection with
+              | Path _ ->
+                { state with
+                  mode = Selection selection
+                ; mouse_down_position = Gg.V2.of_tuple position }
+              | Point (_, pt) ->
+                (* In order to handle the point move, start the timer *)
+                Elements.Timer.start timer 0.3;
+                { state with
+                  mode = Selection selection
+                ; angle = Path.Point.get_angle pt
+                ; width = Path.Point.get_width pt
+                ; mouse_down_position = Gg.V2.of_tuple position }
+        end
+      in
+
+      (* First, check for a point in the selected path. If any of them in
+         found, check anything to select in all the elements *)
+      begin match Outline.find state.paths id with
+        | None -> get_any ()
+        | Some outline ->
+          begin match Selection.select_point outline (Gg.V2.of_tuple position) with
+            | Path _ -> get_any ()
+            | other ->
+              Elements.Timer.start timer 0.3;
+              {state with
+               mode = Selection other
+             ; mouse_down_position = Gg.V2.of_tuple position }
+          end
+      end
+
+    | `Delete, _ ->
+      delete state worker
+
+    | `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 }
+
+
+    (* Some non possible cases *)
+    | `MouseDown _, Edit
+      -> state
+
+let init =
+  { paths = []
+  ; current = Path.Path_Builder.empty
+  ; mode = Out
+  ; angle = 30.
+  ; width = 10.
+  ; rendering = `Fill
+  ; mouse_down_position = Gg.V2.ox
+  }