From 561d0f0155f4906d90eb7e73a3ff9cb28909126f Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 5 Feb 2021 09:08:39 +0100 Subject: Update project structure --- path/builder.ml | 224 -------------------------------------------------------- 1 file changed, 224 deletions(-) delete mode 100755 path/builder.ml (limited to 'path/builder.ml') diff --git a/path/builder.ml b/path/builder.ml deleted file mode 100755 index 4403599..0000000 --- a/path/builder.ml +++ /dev/null @@ -1,224 +0,0 @@ -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 -- cgit v1.2.3