Layer review

8 files changed, 192 insertions, 184 deletions

diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 8f796b4..db34481 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -1,45 +1,52 @@
 module Make(Repr: Repr.PRINTER) = struct
 
-  type t = Path.Point.t
+  type point = Path.Point.t
 
-  type repr =
+  type t =
     { path: (Repr.t)
     }
 
+  type repr = Repr.t
+
   let create_path
-    : 'b -> repr
+    : 'b -> t
     = fun _ ->
       { path = Repr.create ()
       }
 
-  (* Start a new path. *)
   let start
-    : Path.Point.t -> repr -> repr
-    = fun t {path} ->
-      let path = Repr.move_to (Path.Point.get_coord t) path in
-      let path = Repr.line_to (Path.Point.get_coord' t) path in
+    : point -> point -> t -> t
+    = fun p1 p2 { path } ->
+      let path =
+        Repr.move_to (Path.Point.get_coord p1) path
+        |> Repr.line_to (Path.Point.get_coord p2) in
       { path
       }
 
   let line_to
-    : Path.Point.t -> Path.Point.t -> repr -> repr
-    = fun _ t {path} ->
-      let path = Repr.move_to (Path.Point.get_coord t) path in
-      let path = Repr.line_to (Path.Point.get_coord' t) path in
+    : (point * point) -> (point * point) -> t -> t
+    = fun (_, p1) (_, p1') {path} ->
+      let path = Repr.move_to (Path.Point.get_coord p1) path in
+      let path = Repr.line_to (Path.Point.get_coord p1') path in
       { path
       }
 
   let quadratic_to
-    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
-    = fun (p0,  ctrl0, ctrl1, p1) { path } ->
-
-      let path = ref path in
+    : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t
+    = fun (p0, ctrl0, ctrl1, p1) (p0',  ctrl0', ctrl1', p1') {path} ->
 
       let bezier =
         { Shapes.Bezier.p0 = Path.Point.get_coord p0
         ; ctrl0
         ; ctrl1
         ; p1 = Path.Point.get_coord p1
+        }
+
+      and bezier' =
+        { Shapes.Bezier.p0 = Path.Point.get_coord p0'
+        ; ctrl0 = ctrl0'
+        ; ctrl1 = ctrl1'
+        ; p1 = Path.Point.get_coord p1'
         } in
 
       (* Mark each point on the bezier curve. The first point is the most
@@ -48,25 +55,28 @@ module Make(Repr: Repr.PRINTER) = struct
         ((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1))
         *. 30.
       in
+      let path = ref path in
       for i = 0 to ((Int.of_float delay) ) do
         let ratio = (Float.of_int i) /. delay in
-        let bezier', _ = Shapes.Bezier.slice ratio bezier in
+        let bezier, _ = Shapes.Bezier.slice ratio bezier
+        and bezier', _ = Shapes.Bezier.slice ratio bezier'  in
 
-        let point = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0 p1 in
+        let point = Path.Point.mix ratio bezier.Shapes.Bezier.p1 p0 p1
+        and point' = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0' p1' in
 
         path := Repr.move_to (Path.Point.get_coord point) !path;
-        path := Repr.line_to (Path.Point.get_coord' point) !path;
+        path := Repr.line_to (Path.Point.get_coord point') !path;
       done;
 
       { path = !path }
 
   let stop
-    : repr -> repr
+    : t -> t
     = fun path -> path
 
 
   let get
-    : repr -> Repr.t
+    : t -> Repr.t
     = fun {path; _} ->
       path
 end
diff --git a/layer/ductusPrinter.mli b/layer/ductusPrinter.mli
index cd849ef..cdcaa7c 100755
--- a/layer/ductusPrinter.mli
+++ b/layer/ductusPrinter.mli
@@ -1,28 +1,2 @@
-module Make(Repr:Repr.PRINTER): sig
-
-  type repr 
-
-  type t = Path.Point.t
-
-  val create_path
-    : 'b -> repr
-
-  (* Start a new path. *)
-  val start
-    : Path.Point.t -> repr -> repr
-
-  val line_to
-    : Path.Point.t -> Path.Point.t -> repr -> repr
-
-  val quadratic_to
-    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
-
-  val stop
-    : repr -> repr
-
-  val get 
-    : repr -> Repr.t
-
-end
-
-
+module Make(R:Repr.PRINTER): 
+  Repr.LAYER with type repr = R.t
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
index 9b6546c..f3717c2 100755
--- a/layer/fillPrinter.ml
+++ b/layer/fillPrinter.ml
@@ -1,16 +1,16 @@
-module Point = Path.Point
-
 module Make(Repr: Repr.PRINTER) = struct
 
-  type t = Point.t
+  type point = Path.Point.t
+
+  type repr = Repr.t
 
-  type repr =
+  type t =
     { path: Repr.t
     ; close : Repr.t -> Repr.t
     }
 
   let create_path
-    : (Repr.t -> Repr.t) -> repr
+    : (Repr.t -> Repr.t) -> t
     = fun f ->
       { close = f
       ; path = Repr.create ()
@@ -18,23 +18,23 @@ module Make(Repr: Repr.PRINTER) = struct
 
   (* Start a new path. *)
 
-  let start'
-    : Gg.v2 -> Gg.v2 -> repr -> repr
+  let start
+    : point -> point -> t -> t
     = fun p1 _ {close ; path } ->
-      let path = Repr.move_to p1 path in
+      let path = Repr.move_to (Path.Point.get_coord p1) path in
       { close
       ; path
       }
 
-  let start
-    : Path.Point.t -> repr -> repr
-    = fun pt t ->
-      let p = (Point.get_coord pt) in
-      start' p p t
-
-  let line_to'
-    : (Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2) -> repr -> repr
+  let line_to
+    : (point * point) -> (point * point) -> t -> t
     = fun (p0, p1) (p0', p1') t ->
+
+      let p0 = Path.Point.get_coord p0
+      and p1 = Path.Point.get_coord p1
+      and p0' = Path.Point.get_coord p0'
+      and p1' = Path.Point.get_coord p1' in
+
       let path =
         Repr.move_to p1 t.path
         |> Repr.line_to p1'
@@ -45,21 +45,15 @@ module Make(Repr: Repr.PRINTER) = struct
       let path = t.close path in
       { t with path}
 
-  let line_to
-    : Point.t -> Point.t -> repr -> repr
-    = fun p0 p1 t ->
-
-      line_to'
-        (  Point.get_coord p0
-        , Point.get_coord p1 )
-        ( Point.get_coord' p0
-        , Point.get_coord' p1 )
-        t
-
-  let quadratic_to'
-    : (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> repr -> repr
-    = fun (p0,  ctrl0, ctrl1, p1) (p0',  ctrl0', ctrl1', p1') t ->
+  let quadratic_to
+    : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t
+    = fun (p0, ctrl0, ctrl1, p1) (p0',  ctrl0', ctrl1', p1') t ->
 
+      let p0 = Path.Point.get_coord p0
+      and p1 = Path.Point.get_coord p1
+      and p0' = Path.Point.get_coord p0'
+      and p1' = Path.Point.get_coord p1'
+      in
 
       let path =
         Repr.move_to p1 t.path
@@ -83,25 +77,13 @@ module Make(Repr: Repr.PRINTER) = struct
 
       { t with path }
 
-  let quadratic_to
-    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
-    = fun (p0,  ctrl0, ctrl1, p1) t ->
-
-
-      let ctrl0' = Point.get_coord' @@ Point.copy p0 ctrl0
-      and ctrl1' = Point.get_coord' @@ Point.copy p1 ctrl1 in
-      quadratic_to'
-        (Point.get_coord p0, ctrl0, ctrl1, Point.get_coord p1)
-        (Point.get_coord' p0, ctrl0', ctrl1', Point.get_coord' p1)
-        t
-
   let stop
-    : repr -> repr
+    : t -> t
     = fun t ->
       t
 
   let get
-    : repr -> Repr.t
+    : t -> Repr.t
     = fun t ->
       t.path
 end
diff --git a/layer/fillPrinter.mli b/layer/fillPrinter.mli
index c1bb30e..cdcaa7c 100755
--- a/layer/fillPrinter.mli
+++ b/layer/fillPrinter.mli
@@ -1,27 +1,2 @@
-module Make(Repr:Repr.PRINTER): sig
-
-  type repr 
-
-  type t = Path.Point.t
-
-  val create_path
-    : (Repr.t -> Repr.t) -> repr
-
-  (* Start a new path. *)
-  val start
-    : Path.Point.t -> repr -> repr
-
-  val line_to
-    : Path.Point.t -> Path.Point.t -> repr -> repr
-
-  val quadratic_to
-    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
-
-  val stop
-    : repr -> repr
-
-  val get 
-    : repr -> Repr.t
-
-end
-
+module Make(R:Repr.PRINTER): 
+  Repr.LAYER with type repr = R.t
diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml
index 45ee801..d223760 100755
--- a/layer/linePrinter.ml
+++ b/layer/linePrinter.ml
@@ -1,6 +1,6 @@
 module Make(Repr: Repr.PRINTER) = struct
 
-  type t = Path.Point.t
+  type point = Path.Point.t
 
   let mark point path =
     let open Gg.V2 in
@@ -17,27 +17,28 @@ module Make(Repr: Repr.PRINTER) = struct
     path
 
 
-  type repr =
+  type t =
     { path: (Repr.t)
     }
 
+  type repr = Repr.t
+
   let create_path
-    : 'b -> repr
+    : 'b -> t
     = fun _ ->
       { path = Repr.create ()
       }
 
-  (* Start a new path. *)
   let start
-    : Path.Point.t -> repr -> repr
-    = fun t {path} ->
-      let path = mark t path in
+    : point -> point -> t -> t
+    = fun p1 _ { path } ->
+      let path = mark p1 path in
       { path
       }
 
   let line_to
-    : Path.Point.t -> Path.Point.t -> repr -> repr
-    = fun p0 p1 {path} ->
+    : (point * point) -> (point * point) -> t -> t
+    = fun (p0, p1) _ {path} ->
       let path = Repr.move_to (Path.Point.get_coord p0) path
                  |> Repr.line_to (Path.Point.get_coord p1)
                  |> mark p1 in
@@ -45,8 +46,8 @@ module Make(Repr: Repr.PRINTER) = struct
       }
 
   let quadratic_to
-    : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
-    = fun (p0,  ctrl0, ctrl1, p1) { path } ->
+    : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t
+    = fun (p0, ctrl0, ctrl1, p1) _ {path} ->
 
       let path = Repr.move_to (Path.Point.get_coord p0) path
                  |> Repr.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1)
@@ -55,12 +56,13 @@ module Make(Repr: Repr.PRINTER) = struct
       { path = path }
 
   let stop
-    : repr -> repr
+    : t -> t
     = fun path -> path
 
 
   let get
-    : repr -> Repr.t
+    : t -> Repr.t
     = fun {path; _} ->
       path
+
 end
diff --git a/layer/linePrinter.mli b/layer/linePrinter.mli
index b6e9603..191830a 100755
--- a/layer/linePrinter.mli
+++ b/layer/linePrinter.mli
@@ -1,29 +1,2 @@
-module Make(Repr:Repr.PRINTER): sig
-
-  type repr 
-
-  type t = Path.Point.t
-
-  val create_path
-    : 'b -> repr
-
-  (* Start a new path. *)
-  val start
-    : Path.Point.t -> repr -> repr
-
-  val line_to
-    : Path.Point.t -> Path.Point.t -> repr -> repr
-
-  val quadratic_to
-    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
-
-  val stop
-    : repr -> repr
-
-  val get 
-    : repr -> Repr.t
-
-end
-
-
-
+module Make(R:Repr.PRINTER):
+  Repr.LAYER with type repr = R.t
diff --git a/layer/paths.ml b/layer/paths.ml
index e170767..6d0157e 100755
--- a/layer/paths.ml
+++ b/layer/paths.ml
@@ -6,25 +6,87 @@ module type REPRESENTABLE = sig
 
   (** Represent the path *)
   val repr
-    : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's
+    : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's
+end
+
+type printer =
+  [ `Fill
+  | `Line
+  | `Ductus ]
+
+
+module type P = sig
+  include Path.Repr.M
+
+  type repr
+
+  val create_path
+    : (repr -> repr) -> t
+
+  val get
+    : t -> repr
+end
+
+
+module MakePrinter(M:Repr.LAYER) : P with type point = M.point and type t = M.t and type repr = M.repr = struct
+
+  type t = M.t
+
+  type point = M.point
+
+  type repr = M.repr
+
+  let get
+    : t -> repr
+    = M.get
+
+  let create_path
+    : (repr -> repr) -> t
+    = M.create_path
+
+  let start
+    : Path.Point.t -> t -> t
+    = fun pt t ->
+      M.start pt pt t
+
+  let line_to
+    : Path.Point.t -> Path.Point.t -> t -> t
+    = fun p0 p1 t ->
+
+      M.line_to
+        ( p0
+        , p1 )
+        ( Path.Point.copy p0 @@ Path.Point.get_coord' p0
+        , Path.Point.copy p1 @@ Path.Point.get_coord' p1 )
+        t
+
+  let quadratic_to
+    : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> t -> t
+    = fun (p0,  ctrl0, ctrl1, p1) t ->
+
+
+      let ctrl0' = Path.Point.get_coord' @@ Path.Point.copy p0 ctrl0
+      and ctrl1' = Path.Point.get_coord' @@ Path.Point.copy p1 ctrl1 in
+      M.quadratic_to
+        (p0, ctrl0, ctrl1, p1)
+        (Path.Point.copy p0 @@ Path.Point.get_coord' p0, ctrl0', ctrl1', Path.Point.copy p1 @@ Path.Point.get_coord' p1)
+
+        t
+
+  let stop = M.stop
 end
 
 (* Canva representation *)
 
-module FillCanvaRepr = FillPrinter.Make(CanvaPrinter)
-module DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter)
-module LineCanvaRepr = LinePrinter.Make(CanvaPrinter)
+module FillCanvaRepr = MakePrinter(FillPrinter.Make(CanvaPrinter))
+module DuctusCanvaRepr = MakePrinter(DuctusPrinter.Make(CanvaPrinter))
+module LineCanvaRepr = MakePrinter(LinePrinter.Make(CanvaPrinter))
 
 (* SVG representation *)
 
-module FillSVGRepr = FillPrinter.Make(Svg)
-module DuctusSVGRepr = DuctusPrinter.Make(Svg)
-module WireSVGRepr = WireFramePrinter.Make(Svg)
+module FillSVGRepr = MakePrinter(FillPrinter.Make(Svg))
+module DuctusSVGRepr = MakePrinter(DuctusPrinter.Make(Svg))
 
-type printer =
-  [ `Fill
-  | `Line
-  | `Ductus ]
 
 (** Draw a path to a canva *)
 let to_canva
@@ -85,7 +147,7 @@ let to_svg
       let svg_path = R.repr
           path
           (module DuctusSVGRepr)
-          (DuctusSVGRepr.create_path (fun _ -> ()))
+          (DuctusSVGRepr.create_path (fun _ -> Jstr.empty))
                      |> DuctusSVGRepr.get in
       Svg.path
         ~at:Brr.At.[
@@ -102,14 +164,14 @@ module ReprFixed = struct
   type t = Path.Fixed.t * Path.Fixed.t
 
   module R = struct
-    type t = Path.Point.t
+    type point = Path.Point.t
 
     type repr' =
-      | Move of (Path.Point.t)
-      | Line_to of (Path.Point.t * Path.Point.t)
-      | Quadratic of (t * Gg.v2 * Gg.v2 * t)
+      | Move of (point)
+      | Line_to of (point * point)
+      | Quadratic of (point * Gg.v2 * Gg.v2 * point)
 
-    type repr = repr' list
+    type t = repr' list
 
     let start t actions =
       (Move t)::actions
@@ -118,19 +180,19 @@ module ReprFixed = struct
       Line_to (p0, p1)::actions
 
     let quadratic_to
-      : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+      : (point * Gg.v2 * Gg.v2 * point) -> t -> t
       = fun q actions ->
         (Quadratic q)::actions
 
     let stop
-      : repr -> repr
+      : t -> t
       = fun v -> List.rev v
 
   end
 
   let repr
-    : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's
-    = fun (type s) (path, _) (module Repr:Path.Repr.M with type t = Path.Point.t and type repr = s) state ->
+    : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's
+    = fun (type s) (path, _) (module Repr:Path.Repr.M with type point = Path.Point.t and type t = s) state ->
       let elems = Path.Fixed.repr path (module R) [] in
 
       let state = List.fold_left elems
diff --git a/layer/repr.ml b/layer/repr.ml
index f2d114c..85b0f3b 100755
--- a/layer/repr.ml
+++ b/layer/repr.ml
@@ -9,7 +9,7 @@ module type PRINTER = sig
 
   val line_to: Gg.v2 -> t -> t
 
-  (** [quadratic_to ctrl0 ctrl1 p1] ctreate a quadratic curve from the current
+  (** [quadratic_to ctrl0 ctrl1 p1] create a quadratic curve from the current
       point to [p1], with control points [ctrl0] and [ctrl1] *)
   val quadratic_to: Gg.v2 -> Gg.v2 -> Gg.v2 -> t -> t
 
@@ -17,3 +17,33 @@ module type PRINTER = sig
   val close: t -> t
 
 end
+
+module type LAYER = sig
+  type t
+
+  type point = Path.Point.t
+
+  type repr
+
+  val get
+    : t -> repr
+
+  val create_path
+    : (repr -> repr) -> t
+
+  val start
+    : point -> point -> t -> t
+
+  val line_to
+    : (point * point) -> (point * point) -> t -> t
+
+  val quadratic_to
+    : (point * Gg.v2 * Gg.v2 * point)
+    -> (point * Gg.v2 * Gg.v2 * point)
+    -> t
+    -> t
+
+  val stop
+    : t -> t
+
+end