Refactor

6 files changed, 274 insertions, 248 deletions

diff --git a/path/builder.ml b/path/builder.ml
index 39ff75e..bcad493 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -43,15 +43,6 @@ module Make(Point:P) = struct
 
   type t = Point.t list * bezier list
 
-  type path =
-    | Empty
-    | Line of Point.t * Point.t
-    | Curve of bezier
-
-  type fixedPath =
-    { id: int
-    ; path : path array }
-
   let get_new_segment connexion0 p5 p4 p3 p2 p1 =
     let p5' = Point.get_coord p5
     and p4' = Point.get_coord p4
@@ -70,7 +61,7 @@ module Make(Point:P) = struct
   let empty = ([], [])
 
   let add_point
-    : Point.t -> t -> t * fixedPath option
+    : Point.t -> t -> t
     = fun lastPoint (path, beziers) ->
       let (let*) v f =
         match v with
@@ -78,11 +69,9 @@ module Make(Point:P) = struct
           if Array.length bezier > 0 then
             f (Array.get bezier 0)
           else
-            ( (lastPoint::path, beziers)
-            , None )
+            (lastPoint::path, beziers)
         | _ ->
-          ( (lastPoint::path, beziers)
-          , None )
+          (lastPoint::path, beziers)
       in
 
       let connexion0 = match beziers with
@@ -103,22 +92,19 @@ module Make(Point:P) = struct
 
         (* We remove the last point and add the bezier curve in the list*)
         let firsts = lastPoint::p4::p3::p2::[] in
-        ( (firsts, bezier_point::beziers)
-        , None )
+        (firsts, bezier_point::beziers)
       | _ ->
-        ( ( lastPoint::path
-          , beziers)
-        , None )
+        ( lastPoint::path
+        , beziers)
 
   let replace_last
-    : Point.t -> t -> t * fixedPath option
+    : Point.t -> t -> t
     = fun lastPoint ((path, beziers) as t) ->
       match path, beziers with
       | _::(tl), beziers ->
 
-        ( ( lastPoint::tl
-          , beziers )
-        , None )
+        ( lastPoint::tl
+        , beziers )
       | _ ->
         add_point lastPoint t
 
@@ -237,157 +223,4 @@ module Make(Point:P) = struct
             )
   end
 
-  module ToFixed = struct
-    type t = Point.t
-
-    type 'a repr = int * path list
-
-    let create_path () = 0, []
-
-    (* Start a new path. *)
-    let start point t =
-      let _ = point in
-      t
-
-    let line_to
-      : t -> t -> 'a repr -> 'a repr
-      = fun p1 p2 (i, t) ->
-        ( i + 1
-        , Line (p1, p2)::t)
-
-
-    let quadratic_to
-      : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
-      = fun p0 ctrl0 ctrl1 p1 (i, t) ->
-        let curve = Curve
-            { p0
-            ; ctrl0
-            ; ctrl1
-            ; p1} in
-        ( i + 1
-        , curve::t)
-
-
-    let stop t = t
-
-    let get
-      : int * path list -> path array
-      = fun (n, t) ->
-        let res = Array.make n Empty in
-        List.iteri t
-          ~f:(fun i elem -> Array.set res (n - i - 1) elem );
-        res
-  end
-
-  let id = ref 0
-  module FixedBuilder = Draw(ToFixed)
-  let to_fixed
-    : t -> fixedPath
-    = fun t ->
-      incr id;
-      { id = !id
-      ; path = FixedBuilder.draw t (ToFixed.create_path ())
-               |> ToFixed.get
-      }
-
-  module DrawFixed(Repr:REPR with type t = Point.t) = struct
-
-
-    let repr_bezier p bezier =
-      Repr.quadratic_to
-        bezier.p0
-        bezier.ctrl0
-        bezier.ctrl1
-        bezier.p1
-        p
-
-    let draw
-      : fixedPath -> 'a Repr.repr -> 'a Repr.repr
-      = fun {path; _} repr ->
-
-        let _, repr = Array.fold_left path
-            ~init:(true, repr)
-            ~f:(fun (first, path) element ->
-                match element with
-                | Empty -> (true, path)
-                | Line (p0, p1) ->
-
-                  let path =  if first then
-                      Repr.start p0 path
-                    else path in
-
-                  ( false
-                  , Repr.line_to p0 p1 path )
-                | Curve bezier ->
-                  let path =  if first then
-                      Repr.start bezier.p0 path
-                    else path in
-                  ( false
-                  , repr_bezier path bezier )
-              ) in
-        Repr.stop repr
-  end
-
-  let box
-    : bezier -> Gg.box2
-    = fun bezier ->
-      Gg.Box2.of_pts
-        (Point.get_coord bezier.p0)
-        (Point.get_coord bezier.p1)
-      |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0)
-      |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1)
-
-  (** Return the distance between a given point and the curve. May return
-      None if the point is out of the curve *)
-  let distance
-    : Gg.v2 -> fixedPath -> float option =
-    fun point beziers ->
-
-    Array.fold_left beziers.path
-      ~init:None
-      ~f:(fun res -> function
-          | Empty -> None
-          | Line (p0, p1) ->
-            let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
-            begin match Gg.Box2.mem point box with
-              | false -> res
-              | true ->
-                (* TODO Evaluate the normal *)
-                res
-            end
-          | Curve bezier ->
-            begin match Gg.Box2.mem point (box bezier) with
-              | false -> res
-              | true ->
-
-                let bezier' = Shapes.Bezier.(
-
-                    { p0 = Point.get_coord bezier.p0
-                    ; p1 = Point.get_coord bezier.p1
-                    ; ctrl0 = bezier.ctrl0
-                    ; ctrl1 = bezier.ctrl1 }
-                  ) in
-                let _, point' = Shapes.Bezier.get_closest_point point bezier' in
-                let distance = Gg.V2.( norm (point - point') ) in
-                match res with
-                | None -> Some distance
-                | Some d -> if d < distance then res else (Some distance)
-            end
-        )
-
-  let id
-    : fixedPath -> int
-    = fun {id; _} -> id
-
-  let map_point
-    : fixedPath -> (Point.t -> Point.t) -> fixedPath
-    = fun {id; path} f ->
-      let path = Array.map path
-          ~f:(function
-              | Empty -> Empty
-              | Line (p1, p2) -> Line (f p1, f p2)
-              | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
-            ) in
-      {id; path}
-
 end
diff --git a/path/builder.mli b/path/builder.mli
index ca496f7..7f34f10 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -34,17 +34,15 @@ module Make(P:P) : sig
 
   type t
 
-  type fixedPath
-
   (** Create an empty path *)
   val empty: t
 
   val add_point
-    : P.t -> t -> t * fixedPath option
+    : P.t -> t -> t
 
   (** Replace the last alement in the path by the one given in parameter *)
   val replace_last
-    : P.t -> t -> t * fixedPath option
+    : P.t -> t -> t
 
   (** Retrieve the last element, if any *)
   val peek 
@@ -61,20 +59,4 @@ module Make(P:P) : sig
       : t -> 'a Repr.repr -> 'a Repr.repr
   end
 
-  val to_fixed : t -> fixedPath
-
-  module DrawFixed(Repr:REPR with type t = P.t) : sig 
-    val draw
-      : fixedPath -> 'a Repr.repr -> 'a Repr.repr
-  end
-
-  (** Return the shortest distance between the mouse and a point *)
-  val distance
-    : Gg.v2 -> fixedPath -> float option 
-
-  val id 
-    : fixedPath -> int
-
-  val map_point 
-    : fixedPath -> (P.t -> P.t) -> fixedPath
 end
diff --git a/path/fixed.ml b/path/fixed.ml
new file mode 100755
index 0000000..e339afc
--- /dev/null
+++ b/path/fixed.ml
@@ -0,0 +1,216 @@
+open StdLabels
+
+(** Signature for points *)
+module type P = sig
+  type t
+
+  val empty : t
+
+  val get_coord : t -> Gg.v2
+
+  (** Copy a point and all thoses properties to the given location *)
+  val copy : t -> Gg.v2 -> t
+
+end
+
+module type REPR = sig
+  type t
+
+  type 'a repr
+
+  (* Start a new path. *)
+  val start
+    : t -> 'a repr -> 'a repr
+
+  val line_to
+    : t -> t -> 'a repr -> 'a repr
+
+  val quadratic_to
+    : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
+
+  val stop
+    : 'a repr -> 'a repr
+end
+
+
+module Make(Point:P) = struct
+
+  module type BUILDER = sig
+    type t
+
+    module Draw(Repr:REPR with type t = Point.t) : sig
+
+      (** Represent the the current path *)
+      val draw
+        : t -> 'a Repr.repr -> 'a Repr.repr
+    end
+  end
+
+  type bezier =
+    { p0:Point.t    (* The starting point *)
+    ; p1:Point.t    (* The end point *)
+    ; ctrl0:Gg.v2   (* The control point *)
+    ; ctrl1:Gg.v2 } (* The control point *)
+
+  type path =
+    | Empty
+    | Line of Point.t * Point.t
+    | Curve of bezier
+
+  type t =
+    { id: int
+    ; path : path array }
+
+  let id
+    : t -> int
+    = fun {id; _} -> id
+
+  module ToFixed = struct
+    type t = Point.t
+
+    type 'a repr = int * path list
+
+    let create_path () = 0, []
+
+    (* Start a new path. *)
+    let start point t =
+      let _ = point in
+      t
+
+    let line_to
+      : t -> t -> 'a repr -> 'a repr
+      = fun p1 p2 (i, t) ->
+        ( i + 1
+        , Line (p1, p2)::t)
+
+    let quadratic_to
+      : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
+      = fun p0 ctrl0 ctrl1 p1 (i, t) ->
+        let curve = Curve
+            { p0
+            ; ctrl0
+            ; ctrl1
+            ; p1} in
+        ( i + 1
+        , curve::t)
+
+
+    let stop t = t
+
+    let get
+      : int * path list -> path array
+      = fun (n, t) ->
+        let res = Array.make n Empty in
+        List.iteri t
+          ~f:(fun i elem -> Array.set res (n - i - 1) elem );
+        res
+  end
+
+  let internal_id = ref 0
+
+  let to_fixed
+    : (module BUILDER with type t = 'a) -> 'a -> t
+    = fun (type s) (module Builder: BUILDER with type t = s) t ->
+      incr internal_id;
+      let module FixedBuilder = Builder.Draw(ToFixed) in
+      { id = !internal_id
+      ; path = FixedBuilder.draw t (ToFixed.create_path ())
+               |> ToFixed.get
+      }
+
+  module DrawFixed(Repr:REPR with type t = Point.t) = struct
+
+    let repr_bezier p bezier =
+      Repr.quadratic_to
+        bezier.p0
+        bezier.ctrl0
+        bezier.ctrl1
+        bezier.p1
+        p
+
+    let draw
+      : t -> 'a Repr.repr -> 'a Repr.repr
+      = fun {path; _} repr ->
+
+        let _, repr = Array.fold_left path
+            ~init:(true, repr)
+            ~f:(fun (first, path) element ->
+                match element with
+                | Empty -> (true, path)
+                | Line (p0, p1) ->
+
+                  let path =  if first then
+                      Repr.start p0 path
+                    else path in
+
+                  ( false
+                  , Repr.line_to p0 p1 path )
+                | Curve bezier ->
+                  let path =  if first then
+                      Repr.start bezier.p0 path
+                    else path in
+                  ( false
+                  , repr_bezier path bezier )
+              ) in
+        Repr.stop repr
+  end
+
+  let box
+    : bezier -> Gg.box2
+    = fun bezier ->
+      Gg.Box2.of_pts
+        (Point.get_coord bezier.p0)
+        (Point.get_coord bezier.p1)
+      |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0)
+      |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1)
+
+  (** Return the distance between a given point and the curve. May return
+      None if the point is out of the curve *)
+  let distance
+    : Gg.v2 -> t -> float option =
+    fun point beziers ->
+
+    Array.fold_left beziers.path
+      ~init:None
+      ~f:(fun res -> function
+          | Empty -> None
+          | Line (p0, p1) ->
+            let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in
+            begin match Gg.Box2.mem point box with
+              | false -> res
+              | true ->
+                (* TODO Evaluate the normal *)
+                res
+            end
+          | Curve bezier ->
+            begin match Gg.Box2.mem point (box bezier) with
+              | false -> res
+              | true ->
+
+                let bezier' = Shapes.Bezier.(
+
+                    { p0 = Point.get_coord bezier.p0
+                    ; p1 = Point.get_coord bezier.p1
+                    ; ctrl0 = bezier.ctrl0
+                    ; ctrl1 = bezier.ctrl1 }
+                  ) in
+                let _, point' = Shapes.Bezier.get_closest_point point bezier' in
+                let distance = Gg.V2.( norm (point - point') ) in
+                match res with
+                | None -> Some distance
+                | Some d -> if d < distance then res else (Some distance)
+            end
+        )
+
+  let map_point
+    : t -> (Point.t -> Point.t) -> t
+    = fun {id; path} f ->
+      let path = Array.map path
+          ~f:(function
+              | Empty -> Empty
+              | Line (p1, p2) -> Line (f p1, f p2)
+              | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1}
+            ) in
+      {id; path}
+
+end
diff --git a/paths.ml b/paths.ml
index 82eca48..49bf03a 100755
--- a/paths.ml
+++ b/paths.ml
@@ -1,4 +1,10 @@
 (** Common  module for ensuring that the function is evaluated only once *)
 
 module Path_Builder = Path.Builder.Make(Path.Point)
+module Fixed = Path.Fixed.Make(Path.Point)
 
+module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
+module SVG_Printer = Fixed.DrawFixed(SVGRepr)
+
+module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
+module Fixed_Printer = Fixed.DrawFixed(CanvaRepr)
diff --git a/script.ml b/script.ml
index a250c7f..d7d969c 100755
--- a/script.ml
+++ b/script.ml
@@ -3,12 +3,9 @@ open Note
 open Brr
 open Brr_note
 
-module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
 
-module Path_Printer = Paths.Path_Builder.Draw(CanvaRepr)
-module Fixed_Printer = Paths.Path_Builder.DrawFixed(CanvaRepr)
-
-type canva_signal = Path.Point.t
+module Path_Printer = Paths.Path_Builder.Draw(Paths.CanvaRepr)
+module Fixed_Printer = Paths.Fixed.DrawFixed(Paths.CanvaRepr)
 
 module Mouse = Brr_note_kit.Mouse
 
@@ -195,32 +192,29 @@ let on_change canva mouse_position state =
 
   *)
   let pos = S.rough_value mouse_position in
-  let current, paths =
+  let current =
     begin match state.State.mode, pos with
       | Edit, Some point ->
-        begin match State.insert_or_replace state point state.current with
-          | current, None -> current, state.paths
-          | current, Some p -> current, p::state.paths
-        end
+        State.insert_or_replace state point state.current
       | _ ->
-        state.current, state.paths
+        state.current
     end
   in
 
-  let path = CanvaRepr.get
+  let path = Paths.CanvaRepr.get
     @@ Path_Printer.draw
       current
-      (*       (CanvaRepr.create_path (fun p -> fill context p)) in *)
-      (CanvaRepr.create_path (fun _ -> () )) in
+      (Paths.CanvaRepr.create_path (fun p -> fill context p)) in
   stroke context path;
 
-  List.iter paths
+  List.iter state.paths
     ~f:(fun path ->
 
         let () = match state.mode with
           | Selection s ->
-            begin match (Paths.Path_Builder.id s) = (Paths.Path_Builder.id path) with
+            begin match (Paths.Fixed.id s) = (Paths.Fixed.id path) with
               | true ->
+                (* If the element is the selected one, change the color *)
                 set_fill_style context (color Blog.Nord.nord8);
                 set_stroke_style context (color Blog.Nord.nord8)
               | false  ->
@@ -230,10 +224,10 @@ let on_change canva mouse_position state =
           | _ -> ()
         in
 
-        let path = CanvaRepr.get
+        let path = Paths.CanvaRepr.get
           @@ Fixed_Printer.draw
             path
-            (CanvaRepr.create_path (fun p -> fill context p)) in
+            (Paths.CanvaRepr.create_path (fun p -> fill context p)) in
         stroke context path;
       );
   ()
@@ -241,7 +235,6 @@ let on_change canva mouse_position state =
 
 let page_main id =
 
-
   let delete_event', angle_signal', width_signal', export_event' =
     begin match Blog.Sidebar.get () with
       | None ->
diff --git a/state.ml b/state.ml
index e41c328..35fc2ed 100755
--- a/state.ml
+++ b/state.ml
@@ -1,10 +1,6 @@
 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 = Blog.Hash_host.expected_host
 
 let backgroundColor = Blog.Nord.nord0
@@ -13,10 +9,10 @@ let timer, tick = Elements.Timer.create ()
 
 type mode =
   | Edit
-  | Selection of Path_Builder.fixedPath
+  | Selection of Paths.Fixed.t
   | Out
 
-type current = Path_Builder.t
+type current = Paths.Path_Builder.t
 
 
 (** Events *)
@@ -44,7 +40,7 @@ type events =
  *)
 type state =
   { mode : mode
-  ; paths : Path_Builder.fixedPath list
+  ; paths : Paths.Fixed.t list
   ; current : current
   ; width : float
   ; angle : float
@@ -54,9 +50,9 @@ 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
+  match Paths.Path_Builder.peek path with
   | None ->
-    Path_Builder.add_point
+    Paths.Path_Builder.add_point
       point
       path
   | Some p1 ->
@@ -66,15 +62,15 @@ let insert_or_replace state ((x, y) as p) path =
 
     let dist = (norm (p1' - (of_tuple p))) in
     if dist < 5. then (
-      path, None
+      path
     ) else (
-      Path_Builder.add_point
+      Paths.Path_Builder.add_point
         point
         path
     )
 
 let check_selection
-  : (float * float) -> Path_Builder.fixedPath list -> Path_Builder.fixedPath option
+  : (float * float) -> Paths.Fixed.t list -> Paths.Fixed.t option
   = fun position paths ->
     let point = Gg.V2.of_tuple position in
     (* If the user click on a curve, select it *)
@@ -86,7 +82,7 @@ let check_selection
           | Some p -> Some p
           | None ->
             (* TODO : Add a method in the point module *)
-            begin match Path_Builder.distance point path with
+            begin match Paths.Fixed.distance point path with
               | Some p when p < 20. ->
                 Some path
               | _ -> None
@@ -96,12 +92,12 @@ let check_selection
 (** Update the path in the selection with the given function applied to
     every point *)
 let update_selection s state f =
-  let s = Path_Builder.map_point s f
-  and id = Path_Builder.id s in
+  let s = Paths.Fixed.map_point s f
+  and id = Paths.Fixed.id s in
 
   let paths = List.map state.paths
       ~f:(fun path ->
-          let id' = Path_Builder.id path in
+          let id' = Paths.Fixed.id path in
           match id = id' with
           | false -> path
           | true -> s
@@ -114,14 +110,11 @@ let do_action
     match event, state.mode with
     | `Point (_delay, point), Edit ->
       (* Add the point in the list *)
-      let current, fixed_path = insert_or_replace
+      let current = 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 }
+      { state with current }
 
     (* Click anywhere while in Out mode, we switch in edition *)
     | `Click _, Out ->
@@ -145,22 +138,25 @@ let do_action
 
     | `Out point, Edit ->
       Elements.Timer.stop timer;
-      begin match Path_Builder.peek2 state.current with
+      begin match Paths.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
+          let current = insert_or_replace state point state.current in
+          let paths =
+            let last = Paths.Fixed.to_fixed
+                (module Paths.Path_Builder)
+                current
+            in
+            last::state.paths
+          and current = Paths.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
+          let current = Paths.Path_Builder.empty in
           begin match check_selection point state.paths with
             | None ->
               { state with
@@ -174,8 +170,8 @@ let do_action
           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
+      let id = Paths.Fixed.id s in
+      let paths = List.filter state.paths ~f:(fun p -> Paths.Fixed.id p != id) in
       { state with paths ; mode = Out}
 
 
@@ -191,8 +187,8 @@ let do_action
               ; 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
+                   let repr = Paths.SVGRepr.create_path (fun _ -> ()) in
+                   let path = Paths.SVGRepr.get @@ Paths.SVG_Printer.draw path repr in
 
                    Layer.Svg.path
                      ~at:Brr.At.[
@@ -245,7 +241,7 @@ let do_action
 
 let init =
   { paths = []
-  ; current = Path_Builder.empty
+  ; current = Paths.Path_Builder.empty
   ; mode = Out
   ; angle = 30.
   ; width = 10.