diff options
Diffstat (limited to 'path/builder.ml')
| -rwxr-xr-x | path/builder.ml | 159 |
1 files changed, 82 insertions, 77 deletions
diff --git a/path/builder.ml b/path/builder.ml index 01dda87..b77c60a 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -17,9 +17,6 @@ module type REPR = sig type 'a repr - val create_path - : unit -> 'a repr - (* Start a new path. *) val start : t -> 'a repr -> 'a repr @@ -46,6 +43,15 @@ module Make(Point:P) = struct type t = Point.t list * bezier list + type path = + | Empty + | Line of Point.t * Point.t + | Curve of bezier + + type fixedPath = + { id: int + ; path : path array } + let get_new_segment connexion0 p5 p4 p3 p2 p1 = let p5' = Point.get_coord p5 and p4' = Point.get_coord p4 @@ -64,7 +70,7 @@ module Make(Point:P) = struct let empty = ([], []) let add_point - : Point.t -> t -> t + : Point.t -> t -> t * fixedPath option = fun lastPoint (path, beziers) -> let (let*) v f = match v with @@ -72,9 +78,11 @@ module Make(Point:P) = struct if Array.length bezier > 0 then f (Array.get bezier 0) else - lastPoint::path, beziers + ( (lastPoint::path, beziers) + , None ) | _ -> - lastPoint::path, beziers + ( (lastPoint::path, beziers) + , None ) in let connexion0 = match beziers with @@ -95,18 +103,22 @@ module Make(Point:P) = struct (* 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, bezier_point::beziers + ( (firsts, bezier_point::beziers) + , None ) | _ -> - lastPoint::path, beziers + ( ( lastPoint::path + , beziers) + , None ) let replace_last - : Point.t -> t -> t + : Point.t -> t -> t * fixedPath option = fun lastPoint ((path, beziers) as t) -> match path, beziers with | _::(tl), beziers -> - lastPoint::tl - , beziers + + ( ( lastPoint::tl + , beziers ) + , None ) | _ -> add_point lastPoint t @@ -124,65 +136,15 @@ module Make(Point:P) = struct | [] -> None | hd::_ -> Some hd - let get - : 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:(first_point, -1) - ~f:(fun (prev_point, i) point -> - (* In the first step, prev_point = point *) - if i < 0 then - ( prev_point - , 0) - else - - let bezier_curve = Array.get beziers i in - Array.set curves i - { p0 = Point.copy prev_point bezier_curve.Shapes.Bezier.p0 - ; ctrl0 = bezier_curve.Shapes.Bezier.ctrl0 - ; ctrl1 = bezier_curve.Shapes.Bezier.ctrl1 - ; p1 = Point.copy point bezier_curve.Shapes.Bezier.p1 }; - - ( point - , i + 1) - ) in - curves - - module Draw(Repr:REPR with type t = Point.t) = struct (** Drawing path **) let draw - : t -> 'a Repr.repr - = fun (points, beziers) -> - - let path = Repr.create_path () in + : t -> 'a Repr.repr -> 'a Repr.repr + = fun (points, beziers) path -> (* Represent the last points *) let path = match points with @@ -275,15 +237,6 @@ module Make(Point:P) = struct ) end - type path = - | Empty - | Line of Point.t * Point.t - | Curve of bezier - - type fixedPath = - { id: int - ; path : path array } - module ToFixed = struct type t = Point.t @@ -333,7 +286,7 @@ module Make(Point:P) = struct = fun t -> incr id; { id = !id - ; path = FixedBuilder.draw t + ; path = FixedBuilder.draw t (ToFixed.create_path ()) |> ToFixed.get } @@ -349,10 +302,9 @@ module Make(Point:P) = struct p let draw - : fixedPath -> 'a Repr.repr - = fun {path; _} -> + : fixedPath -> 'a Repr.repr -> 'a Repr.repr + = fun {path; _} repr -> - let repr = Repr.create_path () in let _, repr = Array.fold_left path ~init:(true, repr) ~f:(fun (first, path) element -> @@ -376,4 +328,57 @@ module Make(Point:P) = struct Repr.stop repr end + + let box + : bezier -> Gg.box2 + = fun bezier -> + Gg.Box2.of_pts + (Point.get_coord bezier.p0) + (Point.get_coord bezier.p1) + |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0) + |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1) + + + let distance + : Gg.v2 -> fixedPath -> float option = + fun point beziers -> + + Array.fold_left beziers.path + ~init:None + ~f:(fun res path -> + match path with + | Empty -> None + | Line (p0, p1) -> + let box = Gg.Box2.of_pts (Point.get_coord p0) (Point.get_coord p1) in + begin match Gg.Box2.mem point box with + | false -> res + | true -> + res + end + | Curve bezier -> + begin match Gg.Box2.mem point (box bezier) with + | false -> res + | true -> + + let bezier' = Shapes.Bezier.( + + { p0 = Point.get_coord bezier.p0 + ; p1 = Point.get_coord bezier.p1 + ; ctrl0 = bezier.ctrl0 + ; ctrl1 = bezier.ctrl1 } + ) in + let _, point' = Shapes.Bezier.get_closest_point point bezier' in + let distance = Gg.V2.( norm (point - point') ) in + match res with + | None -> Some distance + | Some d -> if d < distance then res else (Some distance) + end + + + ) + + + + + end |