Use first type module instead of functors pt.2

11 files changed, 197 insertions, 167 deletions

diff --git a/path/builder.ml b/path/builder.ml
index cb87fc5..182fc13 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -12,25 +12,6 @@ module type P = sig
 
 end
 
-module type REPR = sig
-  type t
-
-  type repr
-
-  (* Start a new path. *)
-  val start
-    : t -> repr -> repr
-
-  val line_to
-    : t -> t -> repr -> repr
-
-  val quadratic_to
-    : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
-
-  val stop
-    : repr -> repr
-end
-
 module Make(Point:P) = struct
 
   (** Point creation  **)
@@ -123,8 +104,8 @@ module Make(Point:P) = struct
       | hd::_ -> Some hd
 
   let repr
-    : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's
-    = fun (type s) (points, beziers) (module Repr : REPR with type t = Point.t and type repr = s) path ->
+    : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
+    = fun (type s) (points, beziers) (module Repr : Repr.M with type t = Point.t and type repr = s) path ->
 
       (* Represent the last points *)
       let path = match points with
diff --git a/path/builder.mli b/path/builder.mli
index 8c8081b..78bb778 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -11,25 +11,6 @@ module type P = sig
 
 end
 
-module type REPR = sig
-  type t
-
-  type repr
-
-  (* Start a new path. *)
-  val start
-    : t -> repr -> repr
-
-  val line_to
-    : t -> t -> repr -> repr
-
-  val quadratic_to
-    : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
-
-  val stop
-    : repr -> repr
-end
-
 module Make(Point:P) : sig
 
   type t
@@ -54,6 +35,6 @@ module Make(Point:P) : sig
 
   (** Represent the path *)
   val repr
-    : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's
+    : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
 
 end
diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml
index ab5a1eb..76056c7 100755
--- a/path/fillPrinter.ml
+++ b/path/fillPrinter.ml
@@ -3,12 +3,12 @@ module Make(Repr: Layer.Repr.PRINTER) = struct
   type t = Point.t
 
   type repr =
-    { path: (Repr.t)
-    ; close : Repr.t -> unit
+    { path: Repr.t
+    ; close : Repr.t -> Repr.t
     }
 
   let create_path
-    : 'b -> repr
+    : (Repr.t -> Repr.t) -> repr
     = fun f ->
       { close = f
       ; path = Repr.create ()
@@ -33,7 +33,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct
         |> Repr.line_to (Point.get_coord p0)
         |> Repr.line_to (Point.get_coord p1)
         |> Repr.close in
-      t.close path;
+      let path = t.close path in
       { t with path}
 
   let quadratic_to
@@ -56,7 +56,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct
           (Point.get_coord ctrl1')
           (Point.get_coord p1)
         |> Repr.close in
-      t.close path;
+      let path = t.close path in
       { t with path}
 
 
diff --git a/path/fixed.ml b/path/fixed.ml
index 7203ebb..0ff4aad 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -13,33 +13,13 @@ module type P = sig
 
 end
 
-module type REPR = sig
-  type t
-
-  type repr
-
-  (* Start a new path. *)
-  val start
-    : t -> repr -> repr
-
-  val line_to
-    : t -> t -> repr -> repr
-
-  val quadratic_to
-    : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
-
-  val stop
-    : repr -> repr
-end
-
-
 module Make(Point:P) = struct
 
   module type BUILDER = sig
     type t
 
     val repr
-      : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's
+      : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
   end
 
   type bezier =
@@ -113,8 +93,8 @@ module Make(Point:P) = struct
       }
 
   let repr
-    : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's
-    = fun (type s) {path; _} (module Repr : REPR with type t = Point.t and type repr = s) repr ->
+    : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
+    = fun (type s) {path; _} (module Repr : Repr.M with type t = Point.t and type repr = s) repr ->
       let repr_bezier p bezier =
         Repr.quadratic_to
           bezier.p0
diff --git a/path/fixed.mli b/path/fixed.mli
index 3fc542c..1f02aed 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -11,33 +11,13 @@ module type P = sig
 
 end
 
-module type REPR = sig
-  type t
-
-  type repr
-
-  (* Start a new path. *)
-  val start
-    : t -> repr -> repr
-
-  val line_to
-    : t -> t -> repr -> repr
-
-  val quadratic_to
-    : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
-
-  val stop
-    : repr -> repr
-end
-
-
 module Make(Point:P) : sig
 
   module type BUILDER = sig
     type t
 
     val repr
-      : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's
+      : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
 
   end
 
@@ -53,7 +33,7 @@ module Make(Point:P) : sig
 
   (** Represent the path *)
   val repr
-    : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's
+    : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
 
   (** Return the distance between a given point and the curve. May return
       None if the point is out of the curve *)
diff --git a/path/linePrinter.ml b/path/linePrinter.ml
index e109e4a..c0a7d58 100755
--- a/path/linePrinter.ml
+++ b/path/linePrinter.ml
@@ -1,53 +1,54 @@
-module Repr = Layer.CanvaPrinter
+module Make(Repr: Layer.Repr.PRINTER) = struct
 
-type t = Point.t
+  type t = Point.t
 
-type repr =
-  { path: (Repr.t)
-  }
-
-let create_path
-  : 'b -> repr
-  = fun _ ->
-    { path = Repr.create ()
-    }
-
-(* Start a new path. *)
-let start
-  : Point.t -> repr -> repr
-  = fun t {path} ->
-    let path = Repr.move_to (Point.get_coord t) path in
-    let path = Repr.line_to (Point.get_coord' t) path in
-    { path
-    }
-
-let line_to
-  : Point.t -> Point.t -> repr -> repr
-  = fun _ t {path} ->
-    let path = Repr.move_to (Point.get_coord t) path in
-    let path = Repr.line_to (Point.get_coord' t) path in
-    { path
-    }
-
-let quadratic_to
-  : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr
-  = fun _p0 _ctrl0 _ctrl1 p1 {path} ->
-
-    let path = Repr.move_to (Point.get_coord p1) path in
-    let path = Repr.line_to (Point.get_coord' p1) path in
-
-    { path
-    }
-
-let stop
-  : repr -> repr
-  = fun {path} ->
-
-
-    { path
+  type repr =
+    { path: (Repr.t)
     }
 
-let get
-  : repr -> Repr.t
-  = fun {path; _} ->
-    path
+  let create_path
+    : 'b -> repr
+    = fun _ ->
+      { path = Repr.create ()
+      }
+
+  (* Start a new path. *)
+  let start
+    : Point.t -> repr -> repr
+    = fun t {path} ->
+      let path = Repr.move_to (Point.get_coord t) path in
+      let path = Repr.line_to (Point.get_coord' t) path in
+      { path
+      }
+
+  let line_to
+    : Point.t -> Point.t -> repr -> repr
+    = fun _ t {path} ->
+      let path = Repr.move_to (Point.get_coord t) path in
+      let path = Repr.line_to (Point.get_coord' t) path in
+      { path
+      }
+
+  let quadratic_to
+    : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr
+    = fun _p0 _ctrl0 _ctrl1 p1 {path} ->
+
+      let path = Repr.move_to (Point.get_coord p1) path in
+      let path = Repr.line_to (Point.get_coord' p1) path in
+
+      { path
+      }
+
+  let stop
+    : repr -> repr
+    = fun {path} ->
+
+
+      { path
+      }
+
+  let get
+    : repr -> Repr.t
+    = fun {path; _} ->
+      path
+end
diff --git a/path/repr.ml b/path/repr.ml
new file mode 100755
index 0000000..63e7ba0
--- /dev/null
+++ b/path/repr.ml
@@ -0,0 +1,18 @@
+module type M = sig
+  type t
+
+  type repr
+
+  (* Start a new path. *)
+  val start
+    : t -> repr -> repr
+
+  val line_to
+    : t -> t -> repr -> repr
+
+  val quadratic_to
+    : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr
+
+  val stop
+    : repr -> repr
+end
diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli
index 1e76120..fa8a5a8 100755
--- a/path/wireFramePrinter.mli
+++ b/path/wireFramePrinter.mli
@@ -19,6 +19,7 @@ module Make(Repr:Layer.Repr.PRINTER): sig
 
   val stop
     : repr -> repr
+    
 
   val get 
     : repr -> Repr.t
diff --git a/paths.ml b/paths.ml
index 4ff6c66..9d968f0 100755
--- a/paths.ml
+++ b/paths.ml
@@ -5,8 +5,110 @@ module Fixed = Path.Fixed.Make(Path.Point)
 
 (* Canva representation *)
 
-module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
+module FillCanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
+module LineCanvaRepr = Path.LinePrinter.Make(Layer.CanvaPrinter)
+module WireCanvaRepr = Path.WireFramePrinter.Make(Layer.CanvaPrinter)
+
 
 (* SVG representation *)
 
-module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
+module FillSVGRepr = Path.FillPrinter.Make(Layer.Svg)
+module LineSVGRepr = Path.LinePrinter.Make(Layer.Svg)
+module WireSVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
+
+
+module type REPRESENTABLE = sig
+  type t
+
+  (** Represent the path *)
+  val repr
+    : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's
+end
+
+type printer =
+  [ `Fill
+  | `Line
+  | `Wire
+  ]
+
+(** Draw a path to a canva *)
+let to_canva
+  : (module REPRESENTABLE with type t = 's)  -> 's -> Brr_canvas.C2d.t -> printer -> unit
+  = fun (type s) (module R:REPRESENTABLE with type t = s) path ctx -> function
+    | `Fill ->
+      R.repr
+        path
+        (module FillCanvaRepr)
+        (FillCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
+      |> FillCanvaRepr.get
+      |> Brr_canvas.C2d.stroke ctx
+    | `Line ->
+      R.repr
+        path
+        (module LineCanvaRepr)
+        (LineCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
+      |> LineCanvaRepr.get
+      |> Brr_canvas.C2d.stroke ctx
+    | `Wire ->
+      R.repr
+        path
+        (module WireCanvaRepr)
+        (WireCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
+      |> WireCanvaRepr.get
+      |> Brr_canvas.C2d.stroke ctx
+
+
+(** Draw a path and represent it as SVG *)
+let to_svg
+  : (module REPRESENTABLE with type t = 's) -> color:Jstr.t -> 's -> printer -> Brr.El.t
+  = fun (type s) (module R:REPRESENTABLE with type t = s) ~color path -> function
+    | `Fill ->
+
+      (* In order to deal with over crossing path, I cut the path in as
+         many segment as there is curve, and fill them all. Then, all of theme
+         are grouped inside a single element *)
+      let paths = ref [] in
+      let _ = R.repr
+          path
+          (module FillSVGRepr)
+          (FillSVGRepr.create_path
+             (fun p ->
+                let repr = Layer.Svg.path
+                    ~at:Brr.At.[ v (Jstr.v "d") p ]
+                    [] in
+
+                paths := repr::!paths;
+                Jstr.empty)) in
+
+      Brr.El.v (Jstr.v "g")
+        ~at:Brr.At.[
+            v (Jstr.v "fill")  color
+          ; v (Jstr.v "stroke") color]
+        !paths
+
+    | `Line ->
+      let svg_path = R.repr
+          path
+          (module LineSVGRepr)
+          (LineSVGRepr.create_path (fun _ -> ()))
+                     |> LineSVGRepr.get in
+      Layer.Svg.path
+        ~at:Brr.At.[
+            v (Jstr.v "fill")  color
+          ; v (Jstr.v "stroke") color
+          ; v (Jstr.v "d") svg_path ]
+        []
+    | `Wire ->
+      let svg_path = R.repr
+          path
+          (module WireSVGRepr)
+          (WireSVGRepr.create_path (fun _ -> ()))
+                     |> WireSVGRepr.get in
+      Layer.Svg.path
+        ~at:Brr.At.[
+            v (Jstr.v "fill")  color
+          ; v (Jstr.v "stroke") color
+          ; v (Jstr.v "d") svg_path ]
+        []
+
+
diff --git a/script.ml b/script.ml
index 595d975..d501b10 100755
--- a/script.ml
+++ b/script.ml
@@ -197,12 +197,9 @@ let on_change canva mouse_position state =
     end
   in
 
-  let path = Paths.CanvaRepr.get
-    @@ Paths.Path_Builder.repr
-      current
-      (module Paths.CanvaRepr)
-      (Paths.CanvaRepr.create_path (fun p -> fill context p)) in
-  stroke context path;
+  let repr = `Wire in
+
+  Paths.to_canva (module Paths.Path_Builder) current context repr;
 
   List.iter state.paths
     ~f:(fun path ->
@@ -221,12 +218,7 @@ let on_change canva mouse_position state =
           | _ -> ()
         in
 
-        let path = Paths.CanvaRepr.get
-          @@ Paths.Fixed.repr
-            path
-            (module Paths.CanvaRepr)
-            (Paths.CanvaRepr.create_path (fun p -> fill context p)) in
-        stroke context path;
+        Paths.to_canva (module Paths.Fixed) path context repr
       );
   ()
 
diff --git a/state.ml b/state.ml
index 52933f8..57007b3 100755
--- a/state.ml
+++ b/state.ml
@@ -210,19 +210,13 @@ 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 = Paths.SVGRepr.create_path (fun _ -> ()) in
-                   let path = Paths.SVGRepr.get @@
-                     Paths.Fixed.repr
-                       path
-                       (module Paths.SVGRepr)
-                       repr in
-
-                   Layer.Svg.path
-                     ~at:Brr.At.[
-                         v (Jstr.v "fill")  backgroundColor
-                       ; v (Jstr.v "stroke") backgroundColor
-                       ; v (Jstr.v "d") path ]
-                     []
+
+                   Paths.to_svg
+                     ~color:backgroundColor
+                     (module Paths.Fixed)
+                     path
+                     `Fill
+
                  )) in
         let content = El.prop Elements.Prop.outerHTML svg in