1 files changed, 80 insertions, 0 deletions
diff --git a/script.it/layer/wireFramePrinter.ml b/script.it/layer/wireFramePrinter.ml
new file mode 100755
index 0000000..81ab271
--- /dev/null
+++ b/script.it/layer/wireFramePrinter.ml
@@ -0,0 +1,80 @@
+module Point = Path.Point
+
+module Make(Repr: Repr.PRINTER) = struct
+  type t = Point.t
+
+  type repr =
+    { back: (Repr.t -> Repr.t)
+    ; path: (Repr.t)
+    ; last_point : Point.t option
+    }
+
+  let create_path
+    : 'b -> repr
+    = fun _ ->
+      { back = Repr.close
+      ; path = Repr.create ()
+      ; last_point = None
+      }
+
+  (* Start a new path. *)
+  let start
+    : Point.t -> repr -> 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 line_to
+    : Point.t -> Point.t -> repr -> 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 quadratic_to
+    : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr
+    = fun p0 ctrl0 ctrl1 p1 t ->
+
+      let ctrl0' = Point.copy p1 ctrl0
+      and ctrl1' = Point.copy p1 ctrl1 in
+
+      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
+    : repr -> 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
+
+      { back = (fun x -> x)
+      ; path = back path
+      ; last_point = None }
+
+  let get
+    : repr -> Repr.t
+    = fun {back; path; _} ->
+      back path
+end