diff options
Diffstat (limited to 'script.it/path/builder.ml')
| -rwxr-xr-x | script.it/path/builder.ml | 224 |
1 files changed, 224 insertions, 0 deletions
diff --git a/script.it/path/builder.ml b/script.it/path/builder.ml new file mode 100755 index 0000000..4403599 --- /dev/null +++ b/script.it/path/builder.ml @@ -0,0 +1,224 @@ +open StdLabels + +(** Signature for points *) +module type P = sig + type t + + val empty : t + + val get_coord : t -> Gg.v2 + + val copy : t -> Gg.v2 -> t + +end + +module Make(Point:P) = struct + + (** Point creation **) + + type bezier = + { p0:Point.t (* The starting point *) + ; p1:Point.t (* The end point *) + ; ctrl0:Gg.v2 (* The control point *) + ; ctrl1:Gg.v2 } (* The control point *) + + type t = Point.t list * bezier list + + let get_new_segment connexion0 p5 p4 p3 p2 p1 = + let p5' = Point.get_coord p5 + and p4' = Point.get_coord p4 + and p3' = Point.get_coord p3 + and p2' = Point.get_coord p2 + and p1' = Point.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 + : Point.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 (Point.get_coord hd.p1) + | _ -> None in + + match path with + | p4::p3::p2::p1::_ -> + let* bezier = get_new_segment connexion0 + lastPoint p4 p3 p2 p1 in + + let bezier_point = + { p0 = p2 + ; p1 = p1 + ; ctrl0 = bezier.Shapes.Bezier.ctrl1 + ; ctrl1 = bezier.Shapes.Bezier.ctrl0 + } in + + (* We remove the last point and add the bezier curve in the list*) + let firsts = lastPoint::p4::p3::p2::[] in + (firsts, bezier_point::beziers) + | _ -> + ( lastPoint::path + , beziers) + + let replace_last + : Point.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 -> (Point.t * Point.t) option + = fun (path, _) -> + match path with + | h1::h2::_ -> Some (h1, h2) + | _ -> None + + let peek + : t -> Point.t option + = fun (path, _) -> + match path with + | [] -> None + | hd::_ -> Some hd + + let repr + : t -> (module Repr.M with type point = Point.t and type t = 's) -> 's -> 's + = fun (type s) (points, beziers) (module Repr : Repr.M with type point = Point.t and type t = s) path -> + + (* Represent the last points *) + let path = match points with + | [] -> + ( path ) + | p1::[] -> + ( Repr.start p1 path ) + | p1::p2::[] -> + let path = + Repr.start p1 path + |> Repr.line_to p1 p2 in + ( path ) + | p0::p1::p2::[] -> + + let b0, b1 = Shapes.Bezier.quadratic_to_cubic + @@ Shapes.Bezier.three_points_quadratic + (Point.get_coord p0) + (Point.get_coord p1) + (Point.get_coord p2) + |> Shapes.Bezier.slice 0.5 + in + let p0' = Point.copy p0 b0.Shapes.Bezier.p0 + and p1' = Point.copy p1 b0.Shapes.Bezier.p1 + and p2' = Point.copy p2 b1.Shapes.Bezier.p1 in + + Repr.start p0 path + |> Repr.quadratic_to + ( p0' + , b0.Shapes.Bezier.ctrl0 + , b0.Shapes.Bezier.ctrl1 + , p1' ) + |> Repr.quadratic_to + ( p1' + , b1.Shapes.Bezier.ctrl0 + , b1.Shapes.Bezier.ctrl1 + , p2' ) + | (p0::_ as points) -> + + let (let*) v f = + match v with + | Ok beziers -> f beziers + | _ -> path in + + let points' = List.map ~f:Point.get_coord points in + let connexion = match beziers with + | [] -> None + | hd ::_ -> Some (Point.get_coord hd.p1) in + + let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points' in + + (* Stdlib does not provide fold_left_i function and we need to map + each bezier point with the associated point in the curve. + + So I use references here for keeping each result element + + *) + let path = ref path in + let point = ref p0 in + + List.iteri + points + ~f:(fun i pt -> + + (* The first iteration is ignored, as we need both previous and + current point for the two point in the curve. + + Do not forget that there is always n-1 bezier curve for n + points *) + if i > 0 then ( + + let bezier = Array.get beziers (i - 1) in + + path := Repr.quadratic_to + ( !point + , bezier.Shapes.Bezier.ctrl0 + , bezier.Shapes.Bezier.ctrl1 + , pt ) + (!path); + point := pt; + ) + ); + ( !path ) + in + + (* Now represent the already evaluated points. Much easer to do, just + iterate on them *) + Repr.stop @@ List.fold_left beziers + ~init:path + ~f:(fun path bezier -> + Repr.quadratic_to + ( bezier.p0 + , bezier.ctrl0 + , bezier.ctrl1 + , bezier.p1 ) + path + ) + + let map + : t -> (Point.t -> Point.t) -> t + = fun (points, beziers) f -> + let points = List.map + points + ~f + and beziers = List.map + beziers + ~f:(fun bezier -> + + { p0 = f bezier.p0 + ; p1 = f bezier.p1 + ; ctrl0 = Point.(get_coord (f ( copy bezier.p0 bezier.ctrl0))) + ; ctrl1 = Point.(get_coord (f ( copy bezier.p1 bezier.ctrl1))) + } + ) in + points, beziers + +end |