Refactor

3 files changed, 227 insertions, 196 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