From af88c8895bba85fe5340b34aafb3dce7650bd01f Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 1 Jan 2021 11:08:38 +0100
Subject: Use first type module instead of functors

---
 state.ml | 89 ++++++++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 58 insertions(+), 31 deletions(-)

(limited to 'state.ml')

diff --git a/state.ml b/state.ml
index 35fc2ed..52933f8 100755
--- a/state.ml
+++ b/state.ml
@@ -9,7 +9,7 @@ let timer, tick = Elements.Timer.create ()
 
 type mode =
   | Edit
-  | Selection of Paths.Fixed.t
+  | Selection of int
   | Out
 
 type current = Paths.Path_Builder.t
@@ -69,40 +69,35 @@ let insert_or_replace state ((x, y) as p) path =
         path
     )
 
+let threshold = 20.
+
 let check_selection
-  : (float * float) -> Paths.Fixed.t list -> Paths.Fixed.t option
+  : (float * float) -> Paths.Fixed.t list -> (Gg.v2 * Paths.Fixed.t) 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 Paths.Fixed.distance point path with
-              | Some p when p < 20. ->
-                Some path
-              | _ -> None
-            end
-        )
+    let _, res = List.fold_left paths
+        ~init:(threshold, None)
+        ~f:(fun (dist, selection) path ->
+            match Paths.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 s state f =
-  let s = Paths.Fixed.map_point s f
-  and id = Paths.Fixed.id s in
+let update_selection id state f =
 
   let paths = List.map state.paths
       ~f:(fun path ->
           let id' = Paths.Fixed.id path in
           match id = id' with
           | false -> path
-          | true -> s
+          | true -> Paths.Fixed.map_point path f
         ) in
-  { state with mode = Selection s ; paths}
+  { state with paths}
 
 let do_action
   : events -> state -> state
@@ -117,9 +112,28 @@ let do_action
       { state with current }
 
     (* Click anywhere while in Out mode, we switch in edition *)
-    | `Click _, Out ->
+    | `Click ((x, y) as p), Out ->
       Elements.Timer.start timer 0.3;
-      { state with mode = Edit }
+
+      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 = Paths.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*)
@@ -128,20 +142,29 @@ let do_action
         | None ->
           { state with
             mode = Out }
-        | Some selected ->
+        | Some (_, selected) ->
 
           (* Start the timer in order to handle the mouse moves *)
+
+          let id = Paths.Fixed.id selected in
           Elements.Timer.start timer 0.3;
           { state with
-            mode = (Selection selected)}
+            mode = (Selection id)}
       end
 
     | `Out point, Edit ->
       Elements.Timer.stop timer;
       begin match Paths.Path_Builder.peek2 state.current with
         (* If there is at last two points selected, handle this as a curve
-            creation *)
+            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 = Paths.Fixed.to_fixed
@@ -163,14 +186,14 @@ let do_action
                 mode = Out
               ; current
               }
-            | Some selected ->
+            | Some (_, selected) ->
+              let id = Paths.Fixed.id selected in
               { state with
-                mode = (Selection selected)
+                mode = (Selection id)
               ; current }
           end
       end
-    | `Delete, Selection s ->
-      let id = Paths.Fixed.id s in
+    | `Delete, Selection id ->
       let paths = List.filter state.paths ~f:(fun p -> Paths.Fixed.id p != id) in
       { state with paths ; mode = Out}
 
@@ -188,7 +211,11 @@ let do_action
             (List.map state.paths
                ~f:(fun path ->
                    let repr = Paths.SVGRepr.create_path (fun _ -> ()) in
-                   let path = Paths.SVGRepr.get @@ Paths.SVG_Printer.draw path repr in
+                   let path = Paths.SVGRepr.get @@
+                     Paths.Fixed.repr
+                       path
+                       (module Paths.SVGRepr)
+                       repr in
 
                    Layer.Svg.path
                      ~at:Brr.At.[
-- 
cgit v1.2.3