From e25b7797708c19cbaef68c14ebef8738de44c2d9 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 30 Dec 2020 11:41:01 +0100 Subject: Refactor --- path/builder.ml | 185 +++-------------------------------------------- path/builder.mli | 22 +----- path/fixed.ml | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 227 insertions(+), 196 deletions(-) create mode 100755 path/fixed.ml (limited to 'path') diff --git a/path/builder.ml b/path/builder.ml index 39ff75e..bcad493 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -43,15 +43,6 @@ 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 @@ -70,7 +61,7 @@ module Make(Point:P) = struct let empty = ([], []) let add_point - : Point.t -> t -> t * fixedPath option + : Point.t -> t -> t = fun lastPoint (path, beziers) -> let (let*) v f = match v with @@ -78,11 +69,9 @@ module Make(Point:P) = struct if Array.length bezier > 0 then f (Array.get bezier 0) else - ( (lastPoint::path, beziers) - , None ) + (lastPoint::path, beziers) | _ -> - ( (lastPoint::path, beziers) - , None ) + (lastPoint::path, beziers) in let connexion0 = match beziers with @@ -103,22 +92,19 @@ 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, bezier_point::beziers) - , None ) + (firsts, bezier_point::beziers) | _ -> - ( ( lastPoint::path - , beziers) - , None ) + ( lastPoint::path + , beziers) let replace_last - : Point.t -> t -> t * fixedPath option + : Point.t -> t -> t = fun lastPoint ((path, beziers) as t) -> match path, beziers with | _::(tl), beziers -> - ( ( lastPoint::tl - , beziers ) - , None ) + ( lastPoint::tl + , beziers ) | _ -> add_point lastPoint t @@ -237,157 +223,4 @@ module Make(Point:P) = struct ) end - module ToFixed = struct - type t = Point.t - - type 'a repr = int * path list - - let create_path () = 0, [] - - (* Start a new path. *) - let start point t = - let _ = point in - t - - let line_to - : t -> t -> 'a repr -> 'a 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 - = fun p0 ctrl0 ctrl1 p1 (i, t) -> - let curve = Curve - { p0 - ; ctrl0 - ; ctrl1 - ; p1} in - ( i + 1 - , curve::t) - - - let stop t = t - - let get - : int * path list -> path array - = fun (n, t) -> - let res = Array.make n Empty in - List.iteri t - ~f:(fun i elem -> Array.set res (n - i - 1) elem ); - res - end - - let id = ref 0 - module FixedBuilder = Draw(ToFixed) - let to_fixed - : t -> fixedPath - = fun t -> - incr id; - { id = !id - ; path = FixedBuilder.draw t (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 - : fixedPath -> '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 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) - - (** 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 -> fixedPath -> 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 - ) - - let id - : fixedPath -> int - = fun {id; _} -> id - - let map_point - : fixedPath -> (Point.t -> Point.t) -> fixedPath - = fun {id; path} f -> - let path = Array.map path - ~f:(function - | Empty -> Empty - | Line (p1, p2) -> Line (f p1, f p2) - | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1} - ) in - {id; path} - end diff --git a/path/builder.mli b/path/builder.mli index ca496f7..7f34f10 100755 --- a/path/builder.mli +++ b/path/builder.mli @@ -34,17 +34,15 @@ module Make(P:P) : sig type t - type fixedPath - (** Create an empty path *) val empty: t val add_point - : P.t -> t -> t * fixedPath option + : P.t -> t -> t (** Replace the last alement in the path by the one given in parameter *) val replace_last - : P.t -> t -> t * fixedPath option + : P.t -> t -> t (** Retrieve the last element, if any *) val peek @@ -61,20 +59,4 @@ module Make(P:P) : sig : t -> 'a Repr.repr -> 'a Repr.repr end - val to_fixed : t -> fixedPath - - module DrawFixed(Repr:REPR with type t = P.t) : sig - val draw - : fixedPath -> 'a Repr.repr -> 'a Repr.repr - end - - (** Return the shortest distance between the mouse and a point *) - val distance - : Gg.v2 -> fixedPath -> float option - - val id - : fixedPath -> int - - val map_point - : fixedPath -> (P.t -> P.t) -> fixedPath end diff --git a/path/fixed.ml b/path/fixed.ml new file mode 100755 index 0000000..e339afc --- /dev/null +++ b/path/fixed.ml @@ -0,0 +1,216 @@ +open StdLabels + +(** 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 'a repr + + (* Start a new path. *) + val start + : t -> 'a repr -> 'a repr + + val line_to + : t -> t -> 'a repr -> 'a repr + + val quadratic_to + : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr + + val stop + : 'a repr -> 'a repr +end + + +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 + end + + 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 path = + | Empty + | Line of Point.t * Point.t + | Curve of bezier + + type t = + { id: int + ; path : path array } + + let id + : t -> int + = fun {id; _} -> id + + module ToFixed = struct + type t = Point.t + + type 'a repr = int * path list + + let create_path () = 0, [] + + (* Start a new path. *) + let start point t = + let _ = point in + t + + let line_to + : t -> t -> 'a repr -> 'a 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 + = fun p0 ctrl0 ctrl1 p1 (i, t) -> + let curve = Curve + { p0 + ; ctrl0 + ; ctrl1 + ; p1} in + ( i + 1 + , curve::t) + + + let stop t = t + + let get + : int * path list -> path array + = fun (n, t) -> + let res = Array.make n Empty in + List.iteri t + ~f:(fun i elem -> Array.set res (n - i - 1) elem ); + res + end + + let internal_id = ref 0 + + let to_fixed + : (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 ()) + |> 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 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) + + (** 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 + ) + + let map_point + : t -> (Point.t -> Point.t) -> t + = fun {id; path} f -> + let path = Array.map path + ~f:(function + | Empty -> Empty + | Line (p1, p2) -> Line (f p1, f p2) + | Curve bezier -> Curve {bezier with p0 = f bezier.p0 ; p1 = f bezier.p1} + ) in + {id; path} + +end -- cgit v1.2.3