From 0faaa5fda396f0eca6bebf69f3624a344278fa6e Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sat, 19 Dec 2020 19:59:17 +0100
Subject: First commit

---
 path/point.ml | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 84 insertions(+), 2 deletions(-)

(limited to 'path/point.ml')

diff --git a/path/point.ml b/path/point.ml
index 9e10200..7a32ae1 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -4,12 +4,21 @@ type t =
   ; angle: float
   }
 
+let empty =
+  { p = Gg.V2.of_tuple (0., 0.)
+  ; size = 0.
+  ; angle = 0.
+  }
+
 let create x y =
   { p = Gg.V2.v x y
-  ; size = 0.1
-  ; angle = Gg.Float.pi_div_4
+  ; size = 20.
+  ; angle = Float.neg Gg.Float.pi_div_4
   }
 
+let copy point p =
+  { point with p }
+
 let (+) p1 p2 =
   { p1 with p = Gg.V2.(+) p1.p p2 }
 
@@ -22,3 +31,76 @@ let get_coord'
     let trans = of_polar @@ v t.size t.angle in
     t.p + trans
 
+module Repr = CanvaPrinter
+
+type 'a repr =
+  { back: ('a Repr.t -> 'a Repr.t)
+  ; path: ('a Repr.t)
+  ; last_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
+  : t -> 'a repr -> 'a repr
+  = fun t {back; path; _} ->
+    let path = Repr.move_to (get_coord t) path in
+    let line' = Repr.line_to (get_coord' t) in
+    { back = (fun p -> back @@ line' p)
+    ; path
+    ; last_point = Some t
+    }
+
+let line_to
+  : t -> 'a repr -> 'a repr
+  = fun t {back; path; _} ->
+    let line' = Repr.line_to (get_coord' t) in
+    { back = (fun t -> back @@ line' t)
+    ; path = Repr.line_to t.p path
+    ; last_point = Some t
+    }
+
+let quadratic_to
+  : t -> t -> t -> t -> 'a repr -> 'a repr
+  = fun p0 ctrl0 ctrl1 p1 t ->
+
+    let line' path =
+      Repr.quadratic_to
+        (get_coord' ctrl1)
+        (get_coord' ctrl0)
+        (get_coord' p0) path in
+
+    let path = Repr.quadratic_to
+        (get_coord ctrl0)
+        (get_coord ctrl1)
+        (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 (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