From 0faaa5fda396f0eca6bebf69f3624a344278fa6e Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sat, 19 Dec 2020 19:59:17 +0100 Subject: First commit --- path/builder.ml | 209 ++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 196 insertions(+), 13 deletions(-) (limited to 'path/builder.ml') diff --git a/path/builder.ml b/path/builder.ml index f52fb9e..4fe8951 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -1,21 +1,52 @@ +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 + + type 'a repr + + val create_path + : unit -> 'a repr + + (* Start a new path. *) + val start + : t -> 'a repr -> 'a repr + + val line_to + : t -> 'a repr -> 'a repr + + val quadratic_to + : t -> t -> t -> t -> 'a repr -> 'a repr + + val stop + : 'a repr -> 'a repr end -module Make(P:P) = struct +module Make(Point:P) = struct + + (** Point creation **) - type t = P.t list * Shapes.Bezier.t list + 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' = 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 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' @@ -28,7 +59,7 @@ module Make(P:P) = struct let empty = ([], []) let add_point - : P.t -> t -> t + : Point.t -> t -> t = fun lastPoint (path, beziers) -> let (let*) v f = match v with @@ -42,21 +73,30 @@ module Make(P:P) = struct in let connexion0 = match beziers with - | hd::_ -> Some hd.Shapes.Bezier.p1 + | 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 = lastPoint + ; p1 = p4 + ; ctrl0 = bezier.Shapes.Bezier.ctrl0 + ; ctrl1 = bezier.Shapes.Bezier.ctrl1 + } 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 + (*firsts, (Shapes.Bezier.reverse bezier)::beziers*) + firsts, bezier_point::beziers | _ -> lastPoint::path, beziers let replace_last - : P.t -> t -> t + : Point.t -> t -> t = fun lastPoint ((path, beziers) as t) -> match path, beziers with | _::(tl), beziers -> @@ -66,14 +106,14 @@ module Make(P:P) = struct add_point lastPoint t let peek2 - : t -> (P.t * P.t) option + : t -> (Point.t * Point.t) option = fun (path, _) -> match path with | h1::h2::_ -> Some (h1, h2) | _ -> None let peek - : t -> P.t option + : t -> Point.t option = fun (path, _) -> match path with | [] -> None @@ -83,4 +123,147 @@ module Make(P:P) = struct : t -> t = fun t -> t + + (** Complete path **) + + (* Transform the result by replacing each start and end point by the + version given in the list + + This allow to keep the informations like angle or nib width inside the + bezier curve + + *) + let points_to_beziers + : Point.t list -> Shapes.Bezier.t array -> bezier array + = fun points beziers -> + match points with + (* If there is no point to draw, just return empty array *) + | [] -> [||] + | first_point::_ -> + let curves = Array.make + ( (List.length points) -1) + { p0 = Point.empty + ; ctrl0 = Gg.V2.of_tuple (0., 0.) + ; ctrl1 = Gg.V2.of_tuple (0., 0.) + ; p1 = Point.empty } in + + let _ = List.fold_left points + ~init:(true, first_point, 0) + ~f:(fun (first, prev_point, i) point -> + if first then (false, prev_point, i) + else + + let bezier_curve = Array.get beziers i in + + Array.set curves i + { p0 = prev_point + ; ctrl0 = bezier_curve.Shapes.Bezier.ctrl1 + ; ctrl1 = bezier_curve.Shapes.Bezier.ctrl0 + ; p1 = point }; + + + (false, point, i + 1) + ) in + curves + + + (** Drawing path **) + + let draw + : t -> 'a Point.repr + = fun (points, beziers) -> + + let path = Point.create_path () in + let path, last = match points with + | [] -> + ( path + , None ) + | p1::[] -> + ( Point.start p1 path + , Some p1 ) + | p1::p2::[] -> + let path = + Point.start p1 path + |> Point.line_to p2 in + ( path + , Some p2 ) + | p0::p1::p2::[] -> + let path = Point.start p0 path in + + let b = Shapes.Bezier.three_points_quadratic + (Point.get_coord p0) + (Point.get_coord p1) + (Point.get_coord p2) + |> Shapes.Bezier.quadratic_to_cubic in + + let p0' = Point.copy p0 b.Shapes.Bezier.p0 + and ctrl0 = Point.copy p0 b.Shapes.Bezier.ctrl0 + and ctrl1 = Point.copy p1 b.Shapes.Bezier.ctrl1 + and p2' = Point.copy p1 b.Shapes.Bezier.p1 in + + ( Point.quadratic_to p0' ctrl0 ctrl1 p2' path + , Some p2 ) + | (p0::_ as points) -> + + let (let*) v f = + match v with + | Ok beziers -> f beziers + | _ -> path, None 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 -> + + if i < Array.length beziers then ( + + let bezier = Array.get beziers i in + + let p0' = Point.copy pt bezier.Shapes.Bezier.p0 + and ctrl0 = Point.copy (!point) bezier.Shapes.Bezier.ctrl0 + and ctrl1 = Point.copy pt bezier.Shapes.Bezier.ctrl1 + and p1' = Point.copy pt bezier.Shapes.Bezier.p1 in + + path := Point.quadratic_to p0' ctrl0 ctrl1 p1' (!path); + + let () = if i > 0 then + point := pt in + () + ) + ); + ( !path + , Some !point ) + in + + let path = match last with + | None -> path + | Some pt -> + + (* TODO : instead of copying the last point, keeep a track for each + point as declared in the type P.t *) + + List.fold_left beziers + ~init:path + ~f:(fun path bezier -> + let p0' = bezier.p0 + and ctrl0 = Point.copy pt bezier.ctrl0 + and ctrl1 = Point.copy pt bezier.ctrl1 + and p1' = bezier.p1 in + Point.quadratic_to p0' ctrl0 ctrl1 p1' path + ) + in Point.stop path end -- cgit v1.2.3