From 1f1f13a3f02e7f5f5da5926a402d53f2ccbfe536 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 20 Dec 2020 20:58:31 +0100 Subject: Update du soir --- path/builder.ml | 159 ++++++++++++++++++++++++---------------------- path/builder.mli | 31 +++------ path/fillPrinter.ml | 71 +++++++++++++++++++++ path/linePrinter.ml | 53 ++++++++++++++++ path/wireFramePrinter.ml | 4 +- path/wireFramePrinter.mli | 2 +- 6 files changed, 219 insertions(+), 101 deletions(-) create mode 100755 path/fillPrinter.ml create mode 100755 path/linePrinter.ml (limited to 'path') 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 diff --git a/path/builder.mli b/path/builder.mli index f5adef1..42f433e 100755 --- a/path/builder.mli +++ b/path/builder.mli @@ -16,9 +16,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 @@ -35,23 +32,20 @@ end module Make(P:P) : sig - type bezier = - { p0:P.t (* The starting point *) - ; p1:P.t (* The end point *) - ; ctrl0:Gg.v2 (* The control point *) - ; ctrl1:Gg.v2 } (* The control point *) - + type bezier type t + type fixedPath + (** Create an empty path *) val empty: t val add_point - : P.t -> t -> t + : P.t -> t -> t * fixedPath option (** Replace the last alement in the path by the one given in parameter *) val replace_last - : P.t -> t -> t + : P.t -> t -> t * fixedPath option (** Retrieve the last element, if any *) val peek @@ -61,26 +55,21 @@ module Make(P:P) : sig val peek2 : t -> (P.t * P.t) option - val get - : t -> P.t list * bezier list - - val points_to_beziers - : P.t list -> Shapes.Bezier.t array -> bezier array - module Draw(Repr:REPR with type t = P.t) : sig (** Represent the the current path *) val draw - : t -> 'a Repr.repr + : t -> 'a Repr.repr -> 'a Repr.repr end - type fixedPath - val to_fixed : t -> fixedPath module DrawFixed(Repr:REPR with type t = P.t) : sig val draw - : fixedPath -> 'a Repr.repr + : 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 end diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml new file mode 100755 index 0000000..d95030c --- /dev/null +++ b/path/fillPrinter.ml @@ -0,0 +1,71 @@ +module Repr = Layer.CanvaPrinter + +type t = Point.t + +type 'a repr = + { path: ('a Repr.t) + ; close : 'a Repr.t -> unit + } + +let create_path + : 'b -> 'a repr + = fun f -> + { close = f + ; path = Repr.create () + } + +(* Start a new path. *) +let start + : Point.t -> 'a repr -> 'a repr + = fun t {close ; path } -> + let path = Repr.move_to (Point.get_coord t) path in + { close + ; path + } + +let line_to + : Point.t -> Point.t -> 'a repr -> 'a repr + = fun p0 p1 t -> + let path = + Repr.move_to (Point.get_coord p1) t.path + |> Repr.line_to (Point.get_coord' p1) + |> Repr.line_to (Point.get_coord' p0) + |> Repr.line_to (Point.get_coord p0) + |> Repr.line_to (Point.get_coord p1) + |> Repr.close in + t.close path; + { t with path} + +let quadratic_to + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + = fun p0 ctrl0 ctrl1 p1 t -> + + let ctrl0' = Point.copy p1 ctrl0 + and ctrl1' = Point.copy p1 ctrl1 in + + let path = + Repr.move_to (Point.get_coord p1) t.path + |> Repr.line_to (Point.get_coord' p1) + |> Repr.quadratic_to + (Point.get_coord' ctrl1') + (Point.get_coord' ctrl0') + (Point.get_coord' p0) + |> Repr.line_to (Point.get_coord p0) + |> Repr.quadratic_to + (Point.get_coord ctrl0') + (Point.get_coord ctrl1') + (Point.get_coord p1) + |> Repr.close in + t.close path; + { t with path} + + +let stop + : 'a repr -> 'a repr + = fun t -> + t + +let get + : 'a repr -> 'a Repr.t + = fun t -> + t.path diff --git a/path/linePrinter.ml b/path/linePrinter.ml new file mode 100755 index 0000000..247d554 --- /dev/null +++ b/path/linePrinter.ml @@ -0,0 +1,53 @@ +module Repr = Layer.CanvaPrinter + +type t = Point.t + +type 'a repr = + { path: ('a Repr.t) + } + +let create_path + : 'b -> 'a repr + = fun _ -> + { path = Repr.create () + } + +(* Start a new path. *) +let start + : Point.t -> 'a repr -> 'a 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 + { path + } + +let line_to + : Point.t -> Point.t -> 'a repr -> 'a 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 + { path + } + +let quadratic_to + : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr + = fun _p0 _ctrl0 _ctrl1 p1 {path} -> + + let path = Repr.move_to (Point.get_coord p1) path in + let path = Repr.line_to (Point.get_coord' p1) path in + + { path + } + +let stop + : 'a repr -> 'a repr + = fun {path} -> + + + { path + } + +let get + : 'a repr -> 'a Repr.t + = fun {path; _} -> + path diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml index fc27c62..13d90ad 100755 --- a/path/wireFramePrinter.ml +++ b/path/wireFramePrinter.ml @@ -9,8 +9,8 @@ type 'a repr = } let create_path - : unit -> 'a repr - = fun () -> + : 'b -> 'a repr + = fun _ -> { back = Repr.close ; path = Repr.create () ; last_point = None diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli index 72bb5b7..c6b7a98 100755 --- a/path/wireFramePrinter.mli +++ b/path/wireFramePrinter.mli @@ -3,7 +3,7 @@ type 'a repr type t = Point.t val create_path - : unit -> 'a repr + : 'b -> 'a repr (* Start a new path. *) val start -- cgit v1.2.3