aboutsummaryrefslogtreecommitdiff
path: root/path/builder.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2020-12-17 22:29:25 +0100
committerSébastien Dailly <sebastien@chimrod.com>2020-12-17 22:29:25 +0100
commite5c2a971644746818f8764481c60c4c5cf1a80c4 (patch)
tree2719a0c0c64f71c3277addb33ab1562602ba10cc /path/builder.ml
parent20d10a93e5becb41d1145f9d35136782365b0ba4 (diff)
Moved path builder in a dedicated file
Diffstat (limited to 'path/builder.ml')
-rwxr-xr-xpath/builder.ml86
1 files changed, 86 insertions, 0 deletions
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