From 986a36b3728eba40789d6063997dafda67b519ec Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sun, 20 Dec 2020 06:38:04 +0100
Subject: Update

---
 path/wireFramePrinter.ml | 78 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100755 path/wireFramePrinter.ml

(limited to 'path/wireFramePrinter.ml')

diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml
new file mode 100755
index 0000000..a0f52d6
--- /dev/null
+++ b/path/wireFramePrinter.ml
@@ -0,0 +1,78 @@
+module Repr = CanvaPrinter
+
+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
+  : unit -> 'a repr
+  = fun () ->
+    { back = Repr.close
+    ; path = Repr.create ()
+    ; last_point = None
+    }
+
+(* 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 line_to
+  : 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 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 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 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
+  : 'a repr -> 'a Repr.t
+  = fun {back; path; _} ->
+    back path
-- 
cgit v1.2.3