Moved path builder in a dedicated file

6 files changed, 164 insertions, 115 deletions

diff --git a/path/builder.ml b/path/builder.ml
new file mode 100755
index 0000000..f52fb9e
--- /dev/null
+++ b/path/builder.ml
@@ -0,0 +1,86 @@
+(** Signature for points *)
+module type P = sig
+  type t
+
+  val get_coord : t -> Gg.v2
+
+end
+
+module Make(P:P) = struct
+
+  type t = P.t list * Shapes.Bezier.t list
+
+  let get_new_segment connexion0 p5 p4 p3 p2 p1 =
+    let p5' = P.get_coord p5
+    and p4' = P.get_coord p4
+    and p3' = P.get_coord p3
+    and p2' = P.get_coord p2
+    and p1' = P.get_coord p1 in
+
+    let points_to_link =
+      [ p1'
+      ; p2'
+      ; p3'
+      ; p4'
+      ; p5' ] in
+    Shapes.Bspline.to_bezier ?connexion0 points_to_link
+
+  let empty = ([], [])
+
+  let add_point
+    : P.t -> t -> t
+    = fun lastPoint (path, beziers) ->
+      let (let*) v f =
+        match v with
+        | Ok bezier ->
+          if Array.length bezier > 0 then
+            f (Array.get bezier 0)
+          else
+            lastPoint::path, beziers
+        | _ ->
+          lastPoint::path, beziers
+      in
+
+      let connexion0 = match beziers with
+        | hd::_ -> Some hd.Shapes.Bezier.p1
+        | _ -> None in
+
+      match path with
+      | p4::p3::p2::p1::_ ->
+        let* bezier = get_new_segment connexion0
+            lastPoint p4 p3 p2 p1 in
+        (* We remove the last point and add the bezier curve in the list*)
+        let firsts = lastPoint::p4::p3::p2::[] in
+        firsts, (Shapes.Bezier.reverse bezier)::beziers
+      | _ ->
+        lastPoint::path, beziers
+
+  let replace_last
+    : P.t -> t -> t
+    = fun lastPoint ((path, beziers) as t) ->
+      match path, beziers with
+      | _::(tl), beziers ->
+        lastPoint::tl
+      , beziers
+      | _ ->
+        add_point lastPoint t
+
+  let peek2
+    : t -> (P.t * P.t) option
+    = fun (path, _) ->
+      match path with
+      | h1::h2::_ -> Some (h1, h2)
+      | _ -> None
+
+  let peek
+    : t -> P.t option
+    = fun (path, _) ->
+      match path with
+      | [] -> None
+      | hd::_ -> Some hd
+
+  let get
+    : t -> t
+    = fun t -> t
+
+end
diff --git a/path/builder.mli b/path/builder.mli
new file mode 100755
index 0000000..d99e0b2
--- /dev/null
+++ b/path/builder.mli
@@ -0,0 +1,33 @@
+(** Signature for points *)
+module type P = sig
+  type t
+
+  val get_coord : t -> Gg.v2
+end
+
+
+module Make(P:P) : sig
+
+  type t
+
+  (** Create an empty path *)
+  val empty: t
+
+  val add_point
+    : P.t -> t -> t
+
+  (** Replace the last alement in the path by the one given in parameter *)
+  val replace_last
+    : P.t -> t -> t
+
+  (** Retrieve the last element, if any *)
+  val peek 
+    : t -> P.t option
+
+  (** Retrieve the last element, if any *)
+  val peek2
+    : t -> (P.t * P.t) option
+
+  val get
+    : t -> P.t list * Shapes.Bezier.t list
+end
diff --git a/path/draw.ml b/path/draw.ml
index 757c778..ba5272a 100755
--- a/path/draw.ml
+++ b/path/draw.ml
@@ -2,6 +2,7 @@ open StdLabels
 module Path = Brr_canvas.C2d.Path
 
 module Point = Point
+module Builder = Builder
 
 (** Translate the point in the canva area *)
 let translate_point
@@ -17,7 +18,6 @@ let translate_point'
     translate_point ~area
       (point + vect)
 
-
 (* Draw a straight line between two points *)
 let line
   : Gg.v2 -> p1:Point.t -> Path.t -> unit
@@ -138,7 +138,7 @@ let go_back
   : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
   = fun ?connexion ~area canvaPath path ->
     let vect = Gg.V2.of_polar @@ Gg.V2.v
-        0.02
+        0.01
         Gg.Float.pi_div_4
     in
     match connexion, path with
diff --git a/path/point.ml b/path/point.ml
index 91b68c2..9e10200 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -1,5 +1,3 @@
-open StdLabels
-
 type t =
   { p: Gg.v2
   ; size : float
@@ -24,55 +22,3 @@ let get_coord'
     let trans = of_polar @@ v t.size t.angle in
     t.p + trans
 
-let return_segment
-  : Shapes.Bezier.t -> Shapes.Bezier.t list -> Shapes.Bezier.t list
-  = fun bezier beziers ->
-    (* We gave the points in reverse order, so we have to revert the
-       curve *)
-    let bezier' = Shapes.Bezier.reverse bezier in
-    bezier'::beziers
-
-
-let get_new_segment connexion0 p5 p4 p3 p2 p1 =
-  let p5' = get_coord p5
-  and p4' = get_coord p4
-  and p3' = get_coord p3
-  and p2' = get_coord p2
-  and p1' = get_coord p1 in
-
-  let points_to_link =
-    [ p1'
-    ; p2'
-    ; p3'
-    ; p4'
-    ; p5' ] in
-  Shapes.Bspline.to_bezier ?connexion0 points_to_link
-
-let add_point_in_path
-  : float * float -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list
-  = fun (x, y) path beziers ->
-    let lastClick = create x y in
-    let (let*) v f =
-      match v with
-      | Ok bezier ->
-        if Array.length bezier > 0 then
-          f (Array.get bezier 0)
-        else
-          lastClick::path, beziers
-      | _ ->
-        lastClick::path, beziers
-    in
-
-    let connexion0 = match beziers with
-      | hd::_ -> Some hd.Shapes.Bezier.p1
-      | _ -> None in
-
-    match path with
-    | p4::p3::p2::p1::_ ->
-      let* bezier = get_new_segment connexion0
-          lastClick p4 p3 p2 p1 in
-      (* We remove the last point and add the bezier curve in the list*)
-      let firsts = lastClick::p4::p3::p2::[] in
-      firsts, return_segment bezier beziers
-    | _ ->
-      lastClick::path, beziers
diff --git a/path/point.mli b/path/point.mli
index 068f4c1..4b75c3c 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -6,8 +6,5 @@ val get_coord : t -> Gg.v2
 
 val create: float -> float -> t
 
-val add_point_in_path
-  : (float * float) -> t list -> Shapes.Bezier.t list -> t list * Shapes.Bezier.t list
-
 val get_coord'
   : t -> Gg.v2
diff --git a/script.ml b/script.ml
index 9cd8a22..f7db9d3 100755
--- a/script.ml
+++ b/script.ml
@@ -5,15 +5,15 @@ open Brr
 module Timer = Events.Timer
 
 module Point = Draw.Point
+module Path = Draw
+
+module Path_Builder = Path.Builder.Make(Point)
 
 type mode =
   | Edit
   | Out
 
-type current =
-  { points : Point.t list (* The list of points to draw *)
-  ; beziers : Shapes.Bezier.t list (* All the points already fixed *)
-  }
+type current = Path_Builder.t
 
 type state =
   { mode : mode
@@ -66,60 +66,47 @@ let canva
 
     E.select [click; up], pos, c
 
+let insert_or_replace ((x, y) as p) path =
+  let point = Point.create x y in
+  match Path_Builder.peek path with
+  | None ->
+    Path_Builder.add_point
+      point
+      path
+  | Some p1 ->
+    let open Gg.V2 in
+
+    let p1' = Point.get_coord p1 in
+
+    let dist = (norm (p1' - (of_tuple p))) in
+    if dist < 0.05 then (
+      path
+    ) else (
+      Path_Builder.add_point
+        point
+        path
+    )
+
 let do_action
   : events -> state -> state
   = fun event state ->
     match event, state.mode with
-    | `Point (_delay, point), Edit ->
+    | `Point (_delay, (x, y)), Edit ->
       (* Add the point in the list *)
-      let points, beziers = Point.add_point_in_path
-          point
-          state.current.points
-          state.current.beziers in
-
-      let current= {points; beziers} in
-
+      let current= Path_Builder.add_point
+          (Point.create x y)
+          state.current in
       { state with current }
+
     | `Click _, Out ->
       Timer.start state.timer 0.3;
       { state with mode = Edit }
-    | `Out p, Edit ->
+    | `Out point, Edit ->
       Timer.stop state.timer;
-      (* Add the point in the list *)
-
-      let points, beziers = match state.current.points, state.current.beziers with
-        | hd::(tl), beziers ->
-
-          let open Gg.V2 in
-          let p' = of_tuple p
-          and hd' = Point.get_coord hd in
-          if (norm (hd' - p' )) < 0.05 then
-            (Point.create (fst p)  (snd p))::tl
-          , beziers
-          else (
-            Point.add_point_in_path
-              p
-              state.current.points
-              state.current.beziers
-          )
-        | _ ->
-          Point.add_point_in_path
-            p
-            state.current.points
-            state.current.beziers
-      in
-
-
-(*
-      let points, beziers = Point.add_point_in_path
-          p
-          state.current.points
-          state.current.beziers in
-*)
-      let beziers = Draw.to_path (points, beziers) in
-
+      let current = insert_or_replace point state.current in
+      let beziers = Draw.to_path @@ Path_Builder.get current in
       let paths = beziers::state.paths
-      and current = { points = []; beziers = []} in
+      and current = Path_Builder.empty in
       { state with mode = Out; paths; current }
     | _ -> state
 
@@ -195,6 +182,7 @@ let on_change canva mouse_position state =
   set_stroke_style context (color white);
   set_fill_style context (color white);
 
+
   (* If we are in edit mode, we add a point under the cursor.
 
      Otherwise, we would only display the previous registered point, which can
@@ -202,16 +190,17 @@ let on_change canva mouse_position state =
 
   *)
   let pos = S.rough_value mouse_position in
-  let points =
+  let current =
     match state.mode, pos with
     | Edit, Some (x, y) ->
-      (Point.create x y)::state.current.points
+      Path_Builder.add_point (Point.create x y) state.current
     | _ ->
-      set_image_smoothing_enabled context true;
-      set_image_smoothing_quality context Image_smoothing_quality.high;
-      state.current.points in
+      state.current
+  in
+
+  let points, beziers = Path_Builder.get current in
 
-  let path = draw_path area (points) state.current.beziers in
+  let path = draw_path area (points) beziers in
   stroke context path;
 
   List.iter state.paths
@@ -234,7 +223,6 @@ let on_change canva mouse_position state =
                 fill context p;
                 stroke context p
 
-
               )
 
         | _ ->
@@ -256,8 +244,7 @@ let page_main id =
 
   let init =
     { paths = []
-    ; current = { points = []
-                ; beziers = [] }
+    ; current = Path_Builder.empty
     ; mode = Out
     ; timer
     } in