From a86ede2f3d29d6de6ef7c1eab577f00d4c583660 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sun, 20 Dec 2020 11:57:14 +0100
Subject: Update

---
 path/builder.ml | 106 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 104 insertions(+), 2 deletions(-)

(limited to 'path/builder.ml')

diff --git a/path/builder.ml b/path/builder.ml
index 2774cae..01dda87 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -25,7 +25,7 @@ module type REPR = sig
     : t -> 'a repr -> 'a repr
 
   val line_to
-    : t -> 'a repr -> 'a repr
+    : t -> t -> 'a repr -> 'a repr
 
   val quadratic_to
     : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
@@ -193,7 +193,7 @@ module Make(Point:P) = struct
           | p1::p2::[] ->
             let path =
               Repr.start p1 path
-              |> Repr.line_to p2 in
+              |> Repr.line_to p1 p2 in
             ( path )
           | p0::p1::p2::[] ->
             let path = Repr.start p0 path in
@@ -274,4 +274,106 @@ module Make(Point:P) = struct
               Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
             )
   end
+
+  type path =
+    | Empty
+    | Line of Point.t * Point.t
+    | Curve of bezier
+
+  type fixedPath =
+    { id: int
+    ; path : path array }
+
+  module ToFixed = struct
+    type t = Point.t
+
+    type 'a repr = int * path list
+
+    let create_path () = 0, []
+
+    (* Start a new path. *)
+    let start point t =
+      let _ = point in
+      t
+
+    let line_to
+      : t -> t -> 'a repr -> 'a repr
+      = fun p1 p2 (i, t) ->
+        ( i + 1
+        , Line (p1, p2)::t)
+
+
+    let quadratic_to
+      : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
+      = fun p0 ctrl0 ctrl1 p1 (i, t) ->
+        let curve = Curve
+            { p0
+            ; ctrl0
+            ; ctrl1
+            ; p1} in
+        ( i + 1
+        , curve::t)
+
+
+    let stop t = t
+
+    let get
+      : int * path list -> path array
+      = fun (n, t) ->
+        let res = Array.make n Empty in
+        List.iteri t
+          ~f:(fun i elem -> Array.set res (n - i - 1) elem );
+        res
+  end
+
+  let id = ref 0
+  module FixedBuilder = Draw(ToFixed)
+  let to_fixed
+    : t -> fixedPath
+    = fun t ->
+      incr id;
+      { id = !id
+      ; path = FixedBuilder.draw t
+               |> ToFixed.get
+      }
+
+  module DrawFixed(Repr:REPR with type t = Point.t) = struct
+
+
+    let repr_bezier p bezier =
+      Repr.quadratic_to
+        bezier.p0
+        bezier.ctrl0
+        bezier.ctrl1
+        bezier.p1
+        p
+
+    let draw
+      : fixedPath -> 'a Repr.repr
+      = fun {path; _} ->
+
+        let repr = Repr.create_path () in
+        let _, repr = Array.fold_left path
+            ~init:(true, repr)
+            ~f:(fun (first, path) element ->
+                match element with
+                | Empty -> (true, path)
+                | Line (p0, p1) ->
+
+                  let path =  if first then
+                      Repr.start p0 path
+                    else path in
+
+                  ( false
+                  , Repr.line_to p0 p1 path )
+                | Curve bezier ->
+                  let path =  if first then
+                      Repr.start bezier.p0 path
+                    else path in
+                  ( false
+                  , repr_bezier path bezier )
+              ) in
+        Repr.stop repr
+  end
+
 end
-- 
cgit v1.2.3