From ec812521b31471ce9ac3d9bdf1288b1569defbc8 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 23 Dec 2020 19:11:31 +0100
Subject: Add svg output

---
 path/fillPrinter.ml       | 121 +++++++++++++++++++++---------------------
 path/wireFramePrinter.ml  | 132 +++++++++++++++++++++++-----------------------
 path/wireFramePrinter.mli |  33 ++++++------
 3 files changed, 145 insertions(+), 141 deletions(-)

(limited to 'path')

diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml
index d95030c..b506f9b 100755
--- a/path/fillPrinter.ml
+++ b/path/fillPrinter.ml
@@ -1,71 +1,72 @@
-module Repr = Layer.CanvaPrinter
+module Make(Repr: Layer.Repr.PRINTER) = struct
 
-type t = Point.t
+  type t = Point.t
 
-type 'a repr =
-  { path: ('a Repr.t)
-  ; close : 'a Repr.t -> unit
-  }
-
-let create_path
-  : 'b -> 'a repr
-  = fun f ->
-    { close = f
-    ; path = Repr.create ()
+  type 'a repr =
+    { path: ('a Repr.t)
+    ; close : 'a Repr.t -> unit
     }
 
-(* Start a new path. *)
-let start
-  : Point.t -> 'a repr -> 'a repr
-  = fun t {close ; path } ->
-    let path = Repr.move_to (Point.get_coord t) path in
-    { close
-    ; path
-    }
+  let create_path
+    : 'b -> 'a repr
+    = fun f ->
+      { close = f
+      ; path = Repr.create ()
+      }
+
+  (* Start a new path. *)
+  let start
+    : Point.t -> 'a repr -> 'a repr
+    = fun t {close ; path } ->
+      let path = Repr.move_to (Point.get_coord t) path in
+      { close
+      ; path
+      }
 
-let line_to
-  : Point.t -> Point.t -> 'a repr -> 'a repr
-  = fun p0 p1 t ->
-    let path =
-      Repr.move_to (Point.get_coord p1) t.path
-      |> Repr.line_to (Point.get_coord' p1)
-      |> Repr.line_to (Point.get_coord' p0)
-      |> Repr.line_to (Point.get_coord p0)
-      |> Repr.line_to (Point.get_coord p1)
-      |> Repr.close in
-    t.close path;
-    { t with path}
+  let line_to
+    : Point.t -> Point.t -> 'a repr -> 'a repr
+    = fun p0 p1 t ->
+      let path =
+        Repr.move_to (Point.get_coord p1) t.path
+        |> Repr.line_to (Point.get_coord' p1)
+        |> Repr.line_to (Point.get_coord' p0)
+        |> Repr.line_to (Point.get_coord p0)
+        |> Repr.line_to (Point.get_coord p1)
+        |> Repr.close in
+      t.close path;
+      { t with path}
 
-let quadratic_to
-  : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
-  = fun p0 ctrl0 ctrl1 p1 t ->
+  let quadratic_to
+    : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
+    = fun p0 ctrl0 ctrl1 p1 t ->
 
-    let ctrl0' = Point.copy p1 ctrl0
-    and ctrl1' = Point.copy p1 ctrl1 in
+      let ctrl0' = Point.copy p1 ctrl0
+      and ctrl1' = Point.copy p1 ctrl1 in
 
-    let path =
-      Repr.move_to (Point.get_coord p1) t.path
-      |> Repr.line_to (Point.get_coord' p1)
-      |> Repr.quadratic_to
-        (Point.get_coord' ctrl1')
-        (Point.get_coord' ctrl0')
-        (Point.get_coord' p0)
-      |> Repr.line_to (Point.get_coord p0)
-      |> Repr.quadratic_to
-        (Point.get_coord ctrl0')
-        (Point.get_coord ctrl1')
-        (Point.get_coord p1)
-      |> Repr.close in
-    t.close path;
-    { t with path}
+      let path =
+        Repr.move_to (Point.get_coord p1) t.path
+        |> Repr.line_to (Point.get_coord' p1)
+        |> Repr.quadratic_to
+          (Point.get_coord' ctrl1')
+          (Point.get_coord' ctrl0')
+          (Point.get_coord' p0)
+        |> Repr.line_to (Point.get_coord p0)
+        |> Repr.quadratic_to
+          (Point.get_coord ctrl0')
+          (Point.get_coord ctrl1')
+          (Point.get_coord p1)
+        |> Repr.close in
+      t.close path;
+      { t with path}
 
 
-let stop
-  : 'a repr -> 'a repr
-  = fun t ->
-    t
+  let stop
+    : 'a repr -> 'a repr
+    = fun t ->
+      t
 
-let get
-  : 'a repr -> 'a Repr.t
-  = fun t ->
-    t.path
+  let get
+    : 'a repr -> 'a Repr.t
+    = fun t ->
+      t.path
+end
diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml
index 13d90ad..47eb9d4 100755
--- a/path/wireFramePrinter.ml
+++ b/path/wireFramePrinter.ml
@@ -1,78 +1,78 @@
-module Repr = Layer.CanvaPrinter
+module Make(Repr: Layer.Repr.PRINTER) = struct
+  type t = Point.t
 
-type t = Point.t
-
-type 'a repr =
-  { back: ('a Repr.t -> 'a Repr.t)
-  ; path: ('a Repr.t)
-  ; last_point : Point.t option
-  }
-
-let create_path
-  : 'b -> 'a repr
-  = fun _ ->
-    { back = Repr.close
-    ; path = Repr.create ()
-    ; last_point = None
+  type 'a repr =
+    { back: ('a Repr.t -> 'a Repr.t)
+    ; path: ('a Repr.t)
+    ; last_point : Point.t option
     }
 
-(* Start a new path. *)
-let start
-  : Point.t -> 'a repr -> 'a repr
-  = fun t {back; path; _} ->
-    let path = Repr.move_to (Point.get_coord t) path in
-    let line' = Repr.line_to (Point.get_coord' t) in
-    { back = (fun p -> back @@ line' p)
-    ; path
-    ; last_point = Some t
-    }
+  let create_path
+    : 'b -> 'a repr
+    = fun _ ->
+      { back = Repr.close
+      ; path = Repr.create ()
+      ; last_point = None
+      }
 
-let line_to
-  : Point.t -> Point.t -> 'a repr -> 'a repr
-  = fun _ t {back; path; _} ->
-    let line' = Repr.line_to (Point.get_coord' t) in
-    { back = (fun t -> back @@ line' t)
-    ; path = Repr.line_to (Point.get_coord t) path
-    ; last_point = Some t
-    }
+  (* Start a new path. *)
+  let start
+    : Point.t -> 'a repr -> 'a repr
+    = fun t {back; path; _} ->
+      let path = Repr.move_to (Point.get_coord t) path in
+      let line' = Repr.line_to (Point.get_coord' t) in
+      { back = (fun p -> back @@ line' p)
+      ; path
+      ; last_point = Some t
+      }
 
-let quadratic_to
-  : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
-  = fun p0 ctrl0 ctrl1 p1 t ->
+  let line_to
+    : Point.t -> Point.t -> 'a repr -> 'a repr
+    = fun _ t {back; path; _} ->
+      let line' = Repr.line_to (Point.get_coord' t) in
+      { back = (fun t -> back @@ line' t)
+      ; path = Repr.line_to (Point.get_coord t) path
+      ; last_point = Some t
+      }
 
-    let ctrl0' = Point.copy p1 ctrl0
-    and ctrl1' = Point.copy p1 ctrl1 in
+  let quadratic_to
+    : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
+    = fun p0 ctrl0 ctrl1 p1 t ->
 
-    let line' path =
-      Repr.quadratic_to
-        (Point.get_coord' @@ ctrl1')
-        (Point.get_coord' ctrl0')
-        (Point.get_coord' p0) path in
+      let ctrl0' = Point.copy p1 ctrl0
+      and ctrl1' = Point.copy p1 ctrl1 in
 
-    let path = Repr.quadratic_to
-        (Point.get_coord ctrl0')
-        (Point.get_coord ctrl1')
-        (Point.get_coord p1)
-        t.path in
-    { back = (fun p -> t.back @@ line' p)
-    ; path
-    ; last_point = Some p1
-    }
+      let line' path =
+        Repr.quadratic_to
+          (Point.get_coord' @@ ctrl1')
+          (Point.get_coord' ctrl0')
+          (Point.get_coord' p0) path in
+
+      let path = Repr.quadratic_to
+          (Point.get_coord ctrl0')
+          (Point.get_coord ctrl1')
+          (Point.get_coord p1)
+          t.path in
+      { back = (fun p -> t.back @@ line' p)
+      ; path
+      ; last_point = Some p1
+      }
 
-let stop
-  : 'a repr -> 'a repr
-  = fun {back; path; last_point} ->
+  let stop
+    : 'a repr -> 'a repr
+    = fun {back; path; last_point} ->
 
-    let path =
-      match last_point with
-      | Some point -> Repr.line_to (Point.get_coord' point) path
-      | None -> path in
+      let path =
+        match last_point with
+        | Some point -> Repr.line_to (Point.get_coord' point) path
+        | None -> path in
 
-    { back = (fun x -> x)
-    ; path = back path
-    ; last_point = None }
+      { back = (fun x -> x)
+      ; path = back path
+      ; last_point = None }
 
-let get
-  : 'a repr -> 'a Repr.t
-  = fun {back; path; _} ->
-    back path
+  let get
+    : 'a repr -> 'a Repr.t
+    = fun {back; path; _} ->
+      back path
+end
diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli
index c6b7a98..d6f346e 100755
--- a/path/wireFramePrinter.mli
+++ b/path/wireFramePrinter.mli
@@ -1,23 +1,26 @@
-type 'a repr 
+module Make(Repr:Layer.Repr.PRINTER): sig
 
-type t = Point.t
+  type 'a repr 
 
-val create_path
-  : 'b -> 'a repr
+  type t = Point.t
 
-(* Start a new path. *)
-val start
-  : Point.t -> 'a repr -> 'a repr
+  val create_path
+    : 'b -> 'a repr
 
-val line_to
-  : Point.t -> Point.t -> 'a repr -> 'a repr
+  (* Start a new path. *)
+  val start
+    : Point.t -> 'a repr -> 'a repr
 
-val quadratic_to
-  : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
+  val line_to
+    : Point.t -> Point.t -> 'a repr -> 'a repr
 
-val stop
-  : 'a repr -> 'a repr
+  val quadratic_to
+    : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
 
-val get 
-  : 'a repr -> 'a Layer.CanvaPrinter.t
+  val stop
+    : 'a repr -> 'a repr
 
+  val get 
+    : 'a repr -> 'a Repr.t
+
+end
-- 
cgit v1.2.3