From 979be5f588a1ffd6e1d060cd794e87526d517b7a Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Mon, 11 Jan 2021 05:36:46 +0100
Subject: Layer review

---
 layer/paths.ml | 104 +++++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 83 insertions(+), 21 deletions(-)

(limited to 'layer/paths.ml')

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
-- 
cgit v1.2.3