diff options
Diffstat (limited to 'path')
| -rwxr-xr-x | path/builder.ml | 203 | ||||
| -rwxr-xr-x | path/builder.mli | 29 | ||||
| -rwxr-xr-x | path/fillPrinter.ml | 18 | ||||
| -rwxr-xr-x | path/fixed.ml | 164 | ||||
| -rwxr-xr-x | path/fixed.mli | 66 | ||||
| -rwxr-xr-x | path/linePrinter.ml | 16 | ||||
| -rwxr-xr-x | path/wireFramePrinter.ml | 18 | ||||
| -rwxr-xr-x | path/wireFramePrinter.mli | 14 |
8 files changed, 287 insertions, 241 deletions
diff --git a/path/builder.ml b/path/builder.ml index bcad493..cb87fc5 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -15,20 +15,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 module Make(Point:P) = struct @@ -122,105 +122,98 @@ module Make(Point:P) = struct | [] -> None | hd::_ -> Some hd - (** Complete path **) - - module Draw(Repr:REPR with type t = Point.t) = struct - - (** Drawing path **) - - let draw - : t -> 'a Repr.repr -> 'a Repr.repr - = fun (points, beziers) 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 path = Repr.start p0 path in - - let b = Shapes.Bezier.quadratic_to_cubic - @@ Shapes.Bezier.three_points_quadratic - (Point.get_coord p0) - (Point.get_coord p1) - (Point.get_coord p2) - in - - let p0' = Point.copy p0 b.Shapes.Bezier.p0 - and p2' = Point.copy p1 b.Shapes.Bezier.p1 in - - ( Repr.quadratic_to - p0' - b.Shapes.Bezier.ctrl0 - b.Shapes.Bezier.ctrl1 - p2' - path ) - | (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 -> - let p0' = bezier.p0 - and ctrl0 = bezier.ctrl0 - and ctrl1 = bezier.ctrl1 - and p1' = bezier.p1 in - Repr.quadratic_to p0' ctrl0 ctrl1 p1' path - ) - end + let repr + : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's + = fun (type s) (points, beziers) (module Repr : REPR with type t = Point.t and type repr = 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 path = Repr.start p0 path in + + let b = Shapes.Bezier.quadratic_to_cubic + @@ Shapes.Bezier.three_points_quadratic + (Point.get_coord p0) + (Point.get_coord p1) + (Point.get_coord p2) + in + + let p0' = Point.copy p0 b.Shapes.Bezier.p0 + and p2' = Point.copy p1 b.Shapes.Bezier.p1 in + + ( Repr.quadratic_to + p0' + b.Shapes.Bezier.ctrl0 + b.Shapes.Bezier.ctrl1 + p2' + path ) + | (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 -> + let p0' = bezier.p0 + and ctrl0 = bezier.ctrl0 + and ctrl1 = bezier.ctrl1 + and p1' = bezier.p1 in + Repr.quadratic_to p0' ctrl0 ctrl1 p1' path + ) end diff --git a/path/builder.mli b/path/builder.mli index 7f34f10..8c8081b 100755 --- a/path/builder.mli +++ b/path/builder.mli @@ -14,23 +14,23 @@ 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 -module Make(P:P) : sig +module Make(Point:P) : sig type t @@ -38,25 +38,22 @@ module Make(P:P) : sig val empty: t val add_point - : P.t -> t -> t + : Point.t -> t -> t (** Replace the last alement in the path by the one given in parameter *) val replace_last - : P.t -> t -> t + : Point.t -> t -> t (** Retrieve the last element, if any *) val peek - : t -> P.t option + : t -> Point.t option (** Retrieve the last element, if any *) val peek2 - : t -> (P.t * P.t) option + : t -> (Point.t * Point.t) option - module Draw(Repr:REPR with type t = P.t) : sig - - (** Represent the the current path *) - val draw - : t -> 'a Repr.repr -> 'a Repr.repr - end + (** Represent the path *) + val repr + : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's end diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml index b506f9b..ab5a1eb 100755 --- a/path/fillPrinter.ml +++ b/path/fillPrinter.ml @@ -2,13 +2,13 @@ module Make(Repr: Layer.Repr.PRINTER) = struct type t = Point.t - type 'a repr = - { path: ('a Repr.t) - ; close : 'a Repr.t -> unit + type repr = + { path: (Repr.t) + ; close : Repr.t -> unit } let create_path - : 'b -> 'a repr + : 'b -> repr = fun f -> { close = f ; path = Repr.create () @@ -16,7 +16,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct (* Start a new path. *) let start - : Point.t -> 'a repr -> 'a repr + : Point.t -> repr -> repr = fun t {close ; path } -> let path = Repr.move_to (Point.get_coord t) path in { close @@ -24,7 +24,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct } let line_to - : Point.t -> Point.t -> 'a repr -> 'a repr + : Point.t -> Point.t -> repr -> repr = fun p0 p1 t -> let path = Repr.move_to (Point.get_coord p1) t.path @@ -37,7 +37,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct { t with path} let quadratic_to - : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr = fun p0 ctrl0 ctrl1 p1 t -> let ctrl0' = Point.copy p1 ctrl0 @@ -61,12 +61,12 @@ module Make(Repr: Layer.Repr.PRINTER) = struct let stop - : 'a repr -> 'a repr + : repr -> repr = fun t -> t let get - : 'a repr -> 'a Repr.t + : repr -> Repr.t = fun t -> t.path end 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 diff --git a/path/fixed.mli b/path/fixed.mli new file mode 100755 index 0000000..3fc542c --- /dev/null +++ b/path/fixed.mli @@ -0,0 +1,66 @@ +(** Signature for points *) +module type P = sig + type t + + val empty : t + + val get_coord : t -> Gg.v2 + + (** Copy a point and all thoses properties to the given location *) + val copy : t -> Gg.v2 -> t + +end + +module type REPR = sig + type t + + type repr + + (* Start a new path. *) + val start + : t -> repr -> repr + + val line_to + : t -> t -> repr -> repr + + val quadratic_to + : t -> Gg.v2 -> Gg.v2 -> t -> repr -> repr + + val stop + : repr -> repr +end + + +module Make(Point:P) : sig + + module type BUILDER = sig + type t + + val repr + : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's + + end + + type t + + (** Return the identifier for this path *) + val id + : t -> int + + (** Create a path from a builder *) + val to_fixed + : (module BUILDER with type t = 'a) -> 'a -> t + + (** Represent the path *) + val repr + : t -> (module REPR with type t = Point.t and type repr = 's) -> 's -> 's + + (** Return the distance between a given point and the curve. May return + None if the point is out of the curve *) + val distance + : Gg.v2 -> t -> (Gg.v2 * float) option + + val map_point + : t -> (Point.t -> Point.t) -> t + +end diff --git a/path/linePrinter.ml b/path/linePrinter.ml index 247d554..e109e4a 100755 --- a/path/linePrinter.ml +++ b/path/linePrinter.ml @@ -2,19 +2,19 @@ module Repr = Layer.CanvaPrinter type t = Point.t -type 'a repr = - { path: ('a Repr.t) +type repr = + { path: (Repr.t) } let create_path - : 'b -> 'a repr + : 'b -> repr = fun _ -> { path = Repr.create () } (* Start a new path. *) let start - : Point.t -> 'a repr -> 'a repr + : Point.t -> repr -> repr = fun t {path} -> let path = Repr.move_to (Point.get_coord t) path in let path = Repr.line_to (Point.get_coord' t) path in @@ -22,7 +22,7 @@ let start } let line_to - : Point.t -> Point.t -> 'a repr -> 'a repr + : Point.t -> Point.t -> repr -> repr = fun _ t {path} -> let path = Repr.move_to (Point.get_coord t) path in let path = Repr.line_to (Point.get_coord' t) path in @@ -30,7 +30,7 @@ let line_to } let quadratic_to - : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr = fun _p0 _ctrl0 _ctrl1 p1 {path} -> let path = Repr.move_to (Point.get_coord p1) path in @@ -40,7 +40,7 @@ let quadratic_to } let stop - : 'a repr -> 'a repr + : repr -> repr = fun {path} -> @@ -48,6 +48,6 @@ let stop } let get - : 'a repr -> 'a Repr.t + : repr -> Repr.t = fun {path; _} -> path diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml index 47eb9d4..796bbd9 100755 --- a/path/wireFramePrinter.ml +++ b/path/wireFramePrinter.ml @@ -1,14 +1,14 @@ module Make(Repr: Layer.Repr.PRINTER) = struct type t = Point.t - type 'a repr = - { back: ('a Repr.t -> 'a Repr.t) - ; path: ('a Repr.t) + type repr = + { back: (Repr.t -> Repr.t) + ; path: (Repr.t) ; last_point : Point.t option } let create_path - : 'b -> 'a repr + : 'b -> repr = fun _ -> { back = Repr.close ; path = Repr.create () @@ -17,7 +17,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct (* Start a new path. *) let start - : Point.t -> 'a repr -> 'a repr + : Point.t -> repr -> repr = fun t {back; path; _} -> let path = Repr.move_to (Point.get_coord t) path in let line' = Repr.line_to (Point.get_coord' t) in @@ -27,7 +27,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct } let line_to - : Point.t -> Point.t -> 'a repr -> 'a repr + : Point.t -> Point.t -> repr -> repr = fun _ t {back; path; _} -> let line' = Repr.line_to (Point.get_coord' t) in { back = (fun t -> back @@ line' t) @@ -36,7 +36,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct } let quadratic_to - : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr = fun p0 ctrl0 ctrl1 p1 t -> let ctrl0' = Point.copy p1 ctrl0 @@ -59,7 +59,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct } let stop - : 'a repr -> 'a repr + : repr -> repr = fun {back; path; last_point} -> let path = @@ -72,7 +72,7 @@ module Make(Repr: Layer.Repr.PRINTER) = struct ; last_point = None } let get - : 'a repr -> 'a Repr.t + : repr -> Repr.t = fun {back; path; _} -> back path end diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli index d6f346e..1e76120 100755 --- a/path/wireFramePrinter.mli +++ b/path/wireFramePrinter.mli @@ -1,26 +1,26 @@ module Make(Repr:Layer.Repr.PRINTER): sig - type 'a repr + type repr type t = Point.t val create_path - : 'b -> 'a repr + : 'b -> repr (* Start a new path. *) val start - : Point.t -> 'a repr -> 'a repr + : Point.t -> repr -> repr val line_to - : Point.t -> Point.t -> 'a repr -> 'a repr + : Point.t -> Point.t -> repr -> repr val quadratic_to - : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr val stop - : 'a repr -> 'a repr + : repr -> repr val get - : 'a repr -> 'a Repr.t + : repr -> Repr.t end |