diff options
Diffstat (limited to 'path/fixed.ml')
| -rwxr-xr-x | path/fixed.ml | 164 |
1 files changed, 77 insertions, 87 deletions
diff --git a/path/fixed.ml b/path/fixed.ml index e339afc..7203ebb 100755 --- a/path/fixed.ml +++ b/path/fixed.ml @@ -16,20 +16,20 @@ end module type REPR = sig type t - type 'a repr + type repr (* Start a new path. *) val start - : t -> 'a repr -> 'a repr + : t -> repr -> repr val line_to - : t -> t -> 'a repr -> 'a repr + : t -> t -> repr -> repr val quadratic_to - : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr + : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr val stop - : 'a repr -> 'a repr + : repr -> repr end @@ -38,12 +38,8 @@ module Make(Point:P) = struct module type BUILDER = sig type t - module Draw(Repr:REPR with type t = Point.t) : sig - - (** Represent the the current path *) - val draw - : t -> 'a Repr.repr -> 'a Repr.repr - end + val repr + : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's end type bezier = @@ -68,7 +64,7 @@ module Make(Point:P) = struct module ToFixed = struct type t = Point.t - type 'a repr = int * path list + type repr = int * path list let create_path () = 0, [] @@ -78,13 +74,13 @@ module Make(Point:P) = struct t let line_to - : t -> t -> 'a repr -> 'a repr + : t -> t -> repr -> repr = fun p1 p2 (i, t) -> ( i + 1 , Line (p1, p2)::t) let quadratic_to - : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr + : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr = fun p0 ctrl0 ctrl1 p1 (i, t) -> let curve = Curve { p0 @@ -94,7 +90,6 @@ module Make(Point:P) = struct ( i + 1 , curve::t) - let stop t = t let get @@ -112,48 +107,43 @@ module Make(Point:P) = struct : (module BUILDER with type t = 'a) -> 'a -> t = fun (type s) (module Builder: BUILDER with type t = s) t -> incr internal_id; - let module FixedBuilder = Builder.Draw(ToFixed) in { id = !internal_id - ; path = FixedBuilder.draw t (ToFixed.create_path ()) + ; path = Builder.repr t (module ToFixed) (ToFixed.create_path ()) |> ToFixed.get } - module DrawFixed(Repr:REPR with type t = Point.t) = struct - - let repr_bezier p bezier = - Repr.quadratic_to - bezier.p0 - bezier.ctrl0 - bezier.ctrl1 - bezier.p1 - p - - let draw - : t -> 'a Repr.repr -> 'a Repr.repr - = fun {path; _} repr -> - - let _, repr = Array.fold_left path - ~init:(true, repr) - ~f:(fun (first, path) element -> - match element with - | Empty -> (true, path) - | Line (p0, p1) -> - - let path = if first then - Repr.start p0 path - else path in - - ( false - , Repr.line_to p0 p1 path ) - | Curve bezier -> - let path = if first then - Repr.start bezier.p0 path - else path in - ( false - , repr_bezier path bezier ) - ) in - Repr.stop repr - end + let repr + : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's + = fun (type s) {path; _} (module Repr : REPR with type t = Point.t and type repr = s) repr -> + let repr_bezier p bezier = + Repr.quadratic_to + bezier.p0 + bezier.ctrl0 + bezier.ctrl1 + bezier.p1 + p in + + let _, repr = Array.fold_left path + ~init:(true, repr) + ~f:(fun (first, path) element -> + match element with + | Empty -> (true, path) + | Line (p0, p1) -> + + let path = if first then + Repr.start p0 path + else path in + + ( false + , Repr.line_to p0 p1 path ) + | Curve bezier -> + let path = if first then + Repr.start bezier.p0 path + else path in + ( false + , repr_bezier path bezier ) + ) in + Repr.stop repr let box : bezier -> Gg.box2 @@ -167,40 +157,40 @@ module Make(Point:P) = struct (** Return the distance between a given point and the curve. May return None if the point is out of the curve *) let distance - : Gg.v2 -> t -> float option = - fun point beziers -> - - Array.fold_left beziers.path - ~init:None - ~f:(fun res -> function - | 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 -> - (* TODO Evaluate the normal *) - 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 - ) + : Gg.v2 -> t -> (Gg.v2 * float) option + = fun point beziers -> + + Array.fold_left beziers.path + ~init:None + ~f:(fun res -> function + | 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 -> + (* TODO Evaluate the normal *) + 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 (point', distance) + | Some (_, d) -> if d < distance then res else (Some (point', distance)) + end + ) let map_point : t -> (Point.t -> Point.t) -> t |