aboutsummaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
Diffstat (limited to 'path')
-rwxr-xr-xpath/builder.ml203
-rwxr-xr-xpath/builder.mli29
-rwxr-xr-xpath/fillPrinter.ml18
-rwxr-xr-xpath/fixed.ml164
-rwxr-xr-xpath/fixed.mli66
-rwxr-xr-xpath/linePrinter.ml16
-rwxr-xr-xpath/wireFramePrinter.ml18
-rwxr-xr-xpath/wireFramePrinter.mli14
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