aboutsummaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
Diffstat (limited to 'path')
-rwxr-xr-xpath/builder.ml159
-rwxr-xr-xpath/builder.mli31
-rwxr-xr-xpath/fillPrinter.ml71
-rwxr-xr-xpath/linePrinter.ml53
-rwxr-xr-xpath/wireFramePrinter.ml4
-rwxr-xr-xpath/wireFramePrinter.mli2
6 files changed, 219 insertions, 101 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
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 15:13:02 +0000