summaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
Diffstat (limited to 'path')
-rwxr-xr-xpath/builder.ml188
-rwxr-xr-xpath/builder.mli24
-rwxr-xr-xpath/draw.ml1
-rwxr-xr-xpath/point.ml74
-rwxr-xr-xpath/point.mli21
-rwxr-xr-xpath/wireFramePrinter.ml78
-rwxr-xr-xpath/wireFramePrinter.mli23
7 files changed, 222 insertions, 187 deletions
diff --git a/path/builder.ml b/path/builder.ml
index 01dfb35..2774cae 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -10,6 +10,11 @@ module type P = sig
val copy : t -> Gg.v2 -> t
+end
+
+module type REPR = sig
+ type t
+
type 'a repr
val create_path
@@ -23,7 +28,7 @@ module type P = sig
: t -> 'a repr -> 'a repr
val quadratic_to
- : t -> t -> t -> t -> 'a repr -> 'a repr
+ : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
val stop
: 'a repr -> 'a repr
@@ -34,8 +39,8 @@ module Make(Point:P) = struct
(** Point creation **)
type bezier =
- { p0:Point.t (* The starting point *)
- ; p1:Point.t (* The end point *)
+ { p0:Point.t (* The starting point *)
+ ; p1:Point.t (* The end point *)
; ctrl0:Gg.v2 (* The control point *)
; ctrl1:Gg.v2 } (* The control point *)
@@ -169,91 +174,104 @@ module Make(Point:P) = struct
curves
- (** Drawing path **)
-
- let draw
- : t -> 'a Point.repr
- = fun (points, beziers) ->
-
- let path = Point.create_path () in
- let path = match points with
- | [] ->
- ( path )
- | p1::[] ->
- ( Point.start p1 path )
- | p1::p2::[] ->
- let path =
- Point.start p1 path
- |> Point.line_to p2 in
- ( path )
- | p0::p1::p2::[] ->
- let path = Point.start p0 path in
-
- let b = Shapes.Bezier.three_points_quadratic
- (Point.get_coord p0)
- (Point.get_coord p1)
- (Point.get_coord p2)
- |> Shapes.Bezier.quadratic_to_cubic in
-
- let p0' = Point.copy p0 b.Shapes.Bezier.p0
- and ctrl0 = Point.copy p0 b.Shapes.Bezier.ctrl0
- and ctrl1 = Point.copy p1 b.Shapes.Bezier.ctrl1
- and p2' = Point.copy p1 b.Shapes.Bezier.p1 in
-
- ( Point.quadratic_to p0' ctrl0 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 *)
- if i > 0 then (
-
- let bezier = Array.get beziers (i - 1) in
- let p0' = !point
- and ctrl0 = Point.copy (!point) bezier.Shapes.Bezier.ctrl0
- and ctrl1 = Point.copy pt bezier.Shapes.Bezier.ctrl1
- and p1' = pt in
-
- path := Point.quadratic_to p0' ctrl0 ctrl1 p1' (!path);
-
- point := pt;
- )
- );
- ( !path )
- in
-
- let path = List.fold_left beziers
+ 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
+
+ (* 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 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 = Point.copy bezier.p0 bezier.ctrl0
- and ctrl1 = Point.copy bezier.p1 bezier.ctrl1
+ and ctrl0 = bezier.ctrl0
+ and ctrl1 = bezier.ctrl1
and p1' = bezier.p1 in
- Point.quadratic_to p0' ctrl0 ctrl1 p1' path
+ Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
)
- in Point.stop path
+ end
end
diff --git a/path/builder.mli b/path/builder.mli
index 64617fa..17c1a2a 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -6,9 +6,15 @@ module type P = sig
val get_coord : t -> Gg.v2
+ (** Copy a point and all thoses properties to the given location *)
val copy : t -> Gg.v2 -> t
- type 'a repr
+end
+
+module type REPR = sig
+ type t
+
+ type 'a repr
val create_path
: unit -> 'a repr
@@ -21,18 +27,17 @@ module type P = sig
: t -> 'a repr -> 'a repr
val quadratic_to
- : t -> t -> t -> t -> 'a repr -> 'a repr
+ : t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
val stop
: 'a repr -> 'a repr
end
-
module Make(P:P) : sig
type bezier =
- { p0:P.t (* The starting point *)
- ; p1:P.t (* The end point *)
+ { p0:P.t (* The starting point *)
+ ; p1:P.t (* The end point *)
; ctrl0:Gg.v2 (* The control point *)
; ctrl1:Gg.v2 } (* The control point *)
@@ -62,6 +67,11 @@ module Make(P:P) : sig
val points_to_beziers
: P.t list -> Shapes.Bezier.t array -> bezier array
- val draw
- : t -> 'a P.repr
+ module Draw(Repr:REPR with type t = P.t) : sig
+
+ (** Represent the the current path *)
+ val draw
+ : t -> 'a Repr.repr
+ end
+
end
diff --git a/path/draw.ml b/path/draw.ml
index b4b7e28..e628dbc 100755
--- a/path/draw.ml
+++ b/path/draw.ml
@@ -4,6 +4,7 @@ module Path = Brr_canvas.C2d.Path
module Point = Point
module Path_Builder = Builder.Make(Point)
module Builder = Builder
+module WireFrame = WireFramePrinter
(*
(** Translate the point in the canva area *)
diff --git a/path/point.ml b/path/point.ml
index 7a32ae1..83cb168 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -30,77 +30,3 @@ let get_coord'
let open Gg.V2 in
let trans = of_polar @@ v t.size t.angle in
t.p + trans
-
-module Repr = CanvaPrinter
-
-type 'a repr =
- { back: ('a Repr.t -> 'a Repr.t)
- ; path: ('a Repr.t)
- ; last_point : t option
- }
-
-let create_path
- : unit -> 'a repr
- = fun () ->
- { back = Repr.close
- ; path = Repr.create ()
- ; last_point = None
- }
-
-(* Start a new path. *)
-let start
- : t -> 'a repr -> 'a repr
- = fun t {back; path; _} ->
- let path = Repr.move_to (get_coord t) path in
- let line' = Repr.line_to (get_coord' t) in
- { back = (fun p -> back @@ line' p)
- ; path
- ; last_point = Some t
- }
-
-let line_to
- : t -> 'a repr -> 'a repr
- = fun t {back; path; _} ->
- let line' = Repr.line_to (get_coord' t) in
- { back = (fun t -> back @@ line' t)
- ; path = Repr.line_to t.p path
- ; last_point = Some t
- }
-
-let quadratic_to
- : t -> t -> t -> t -> 'a repr -> 'a repr
- = fun p0 ctrl0 ctrl1 p1 t ->
-
- let line' path =
- Repr.quadratic_to
- (get_coord' ctrl1)
- (get_coord' ctrl0)
- (get_coord' p0) path in
-
- let path = Repr.quadratic_to
- (get_coord ctrl0)
- (get_coord ctrl1)
- (get_coord p1)
- t.path in
- { back = (fun p -> t.back @@ line' p)
- ; path
- ; last_point = Some p1
- }
-
-let stop
- : 'a repr -> 'a repr
- = fun {back; path; last_point} ->
-
- let path =
- match last_point with
- | Some point -> Repr.line_to (get_coord' point) path
- | None -> path in
-
- { back = (fun x -> x)
- ; path = back path
- ; last_point = None }
-
-let get
- : 'a repr -> 'a Repr.t
- = fun {back; path; _} ->
- back path
diff --git a/path/point.mli b/path/point.mli
index 6418de4..521eced 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -12,24 +12,3 @@ val copy : t -> Gg.v2 -> t
val get_coord'
: t -> Gg.v2
-
-type 'a repr
-
-val create_path
- : unit -> 'a repr
-
-(* Start a new path. *)
-val start
- : t -> 'a repr -> 'a repr
-
-val line_to
- : t -> 'a repr -> 'a repr
-
-val quadratic_to
- : t -> t -> t -> t -> 'a repr -> 'a repr
-
-val stop
- : 'a repr -> 'a repr
-
-val get
- : 'a repr -> 'a CanvaPrinter.t
diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml
new file mode 100755
index 0000000..a0f52d6
--- /dev/null
+++ b/path/wireFramePrinter.ml
@@ -0,0 +1,78 @@
+module Repr = CanvaPrinter
+
+type t = Point.t
+
+type 'a repr =
+ { back: ('a Repr.t -> 'a Repr.t)
+ ; path: ('a Repr.t)
+ ; last_point : Point.t option
+ }
+
+let create_path
+ : unit -> 'a repr
+ = fun () ->
+ { back = Repr.close
+ ; path = Repr.create ()
+ ; last_point = None
+ }
+
+(* Start a new path. *)
+let start
+ : Point.t -> 'a repr -> 'a 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
+ { back = (fun p -> back @@ line' p)
+ ; path
+ ; last_point = Some t
+ }
+
+let line_to
+ : Point.t -> 'a repr -> 'a repr
+ = fun t {back; path; _} ->
+ let line' = Repr.line_to (Point.get_coord' t) in
+ { back = (fun t -> back @@ line' t)
+ ; path = Repr.line_to (Point.get_coord t) path
+ ; last_point = Some t
+ }
+
+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 line' path =
+ Repr.quadratic_to
+ (Point.get_coord' @@ ctrl1')
+ (Point.get_coord' ctrl0')
+ (Point.get_coord' p0) path in
+
+ let path = Repr.quadratic_to
+ (Point.get_coord ctrl0')
+ (Point.get_coord ctrl1')
+ (Point.get_coord p1)
+ t.path in
+ { back = (fun p -> t.back @@ line' p)
+ ; path
+ ; last_point = Some p1
+ }
+
+let stop
+ : 'a repr -> 'a repr
+ = fun {back; path; last_point} ->
+
+ let path =
+ match last_point with
+ | Some point -> Repr.line_to (Point.get_coord' point) path
+ | None -> path in
+
+ { back = (fun x -> x)
+ ; path = back path
+ ; last_point = None }
+
+let get
+ : 'a repr -> 'a Repr.t
+ = fun {back; path; _} ->
+ back path
diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli
new file mode 100755
index 0000000..26974f5
--- /dev/null
+++ b/path/wireFramePrinter.mli
@@ -0,0 +1,23 @@
+type 'a repr
+
+type t = Point.t
+
+val create_path
+ : unit -> 'a repr
+
+(* Start a new path. *)
+val start
+ : Point.t -> 'a repr -> 'a repr
+
+val line_to
+ : Point.t -> 'a repr -> 'a repr
+
+val quadratic_to
+ : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
+
+val stop
+ : 'a repr -> 'a repr
+
+val get
+ : 'a repr -> 'a CanvaPrinter.t
+
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-31 07:31:46 +0000