From e5c2a971644746818f8764481c60c4c5cf1a80c4 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Thu, 17 Dec 2020 22:29:25 +0100
Subject: Moved path builder in a dedicated file

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

(limited to 'path/builder.ml')

diff --git a/path/builder.ml b/path/builder.ml
new file mode 100755
index 0000000..f52fb9e
--- /dev/null
+++ b/path/builder.ml
@@ -0,0 +1,86 @@
+(** Signature for points *)
+module type P = sig
+  type t
+
+  val get_coord : t -> Gg.v2
+
+end
+
+module Make(P:P) = struct
+
+  type t = P.t list * Shapes.Bezier.t list
+
+  let get_new_segment connexion0 p5 p4 p3 p2 p1 =
+    let p5' = P.get_coord p5
+    and p4' = P.get_coord p4
+    and p3' = P.get_coord p3
+    and p2' = P.get_coord p2
+    and p1' = P.get_coord p1 in
+
+    let points_to_link =
+      [ p1'
+      ; p2'
+      ; p3'
+      ; p4'
+      ; p5' ] in
+    Shapes.Bspline.to_bezier ?connexion0 points_to_link
+
+  let empty = ([], [])
+
+  let add_point
+    : P.t -> t -> t
+    = fun lastPoint (path, beziers) ->
+      let (let*) v f =
+        match v with
+        | Ok bezier ->
+          if Array.length bezier > 0 then
+            f (Array.get bezier 0)
+          else
+            lastPoint::path, beziers
+        | _ ->
+          lastPoint::path, beziers
+      in
+
+      let connexion0 = match beziers with
+        | hd::_ -> Some hd.Shapes.Bezier.p1
+        | _ -> None in
+
+      match path with
+      | p4::p3::p2::p1::_ ->
+        let* bezier = get_new_segment connexion0
+            lastPoint p4 p3 p2 p1 in
+        (* We remove the last point and add the bezier curve in the list*)
+        let firsts = lastPoint::p4::p3::p2::[] in
+        firsts, (Shapes.Bezier.reverse bezier)::beziers
+      | _ ->
+        lastPoint::path, beziers
+
+  let replace_last
+    : P.t -> t -> t
+    = fun lastPoint ((path, beziers) as t) ->
+      match path, beziers with
+      | _::(tl), beziers ->
+        lastPoint::tl
+      , beziers
+      | _ ->
+        add_point lastPoint t
+
+  let peek2
+    : t -> (P.t * P.t) option
+    = fun (path, _) ->
+      match path with
+      | h1::h2::_ -> Some (h1, h2)
+      | _ -> None
+
+  let peek
+    : t -> P.t option
+    = fun (path, _) ->
+      match path with
+      | [] -> None
+      | hd::_ -> Some hd
+
+  let get
+    : t -> t
+    = fun t -> t
+
+end
-- 
cgit v1.2.3