aboutsummaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
Diffstat (limited to 'path')
-rwxr-xr-xpath/builder.ml106
-rwxr-xr-xpath/builder.mli11
-rwxr-xr-xpath/canvaPrinter.ml42
-rwxr-xr-xpath/canvaPrinter.mli2
-rwxr-xr-xpath/draw.ml245
-rwxr-xr-xpath/dune3
-rwxr-xr-xpath/point.ml2
-rwxr-xr-xpath/repr.ml19
-rwxr-xr-xpath/wireFramePrinter.ml6
-rwxr-xr-xpath/wireFramePrinter.mli4
10 files changed, 122 insertions, 318 deletions
diff --git a/path/builder.ml b/path/builder.ml
index 2774cae..01dda87 100755
--- a/path/builder.ml
+++ b/path/builder.ml
@@ -25,7 +25,7 @@ module type REPR = sig
: t -> 'a repr -> 'a repr
val line_to
- : t -> 'a repr -> 'a repr
+ : t -> t -> 'a repr -> 'a repr
val quadratic_to
: t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
@@ -193,7 +193,7 @@ module Make(Point:P) = struct
| p1::p2::[] ->
let path =
Repr.start p1 path
- |> Repr.line_to p2 in
+ |> Repr.line_to p1 p2 in
( path )
| p0::p1::p2::[] ->
let path = Repr.start p0 path in
@@ -274,4 +274,106 @@ module Make(Point:P) = struct
Repr.quadratic_to p0' ctrl0 ctrl1 p1' path
)
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
+
+ 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.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
+ = fun {path; _} ->
+
+ let repr = Repr.create_path () 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
+ end
+
end
diff --git a/path/builder.mli b/path/builder.mli
index 17c1a2a..f5adef1 100755
--- a/path/builder.mli
+++ b/path/builder.mli
@@ -24,7 +24,7 @@ module type REPR = sig
: t -> 'a repr -> 'a repr
val line_to
- : t -> 'a repr -> 'a repr
+ : t -> t -> 'a repr -> 'a repr
val quadratic_to
: t -> Gg.v2 -> Gg.v2 -> t -> 'a repr -> 'a repr
@@ -74,4 +74,13 @@ module Make(P:P) : sig
: t -> '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
+ end
+
end
diff --git a/path/canvaPrinter.ml b/path/canvaPrinter.ml
deleted file mode 100755
index e696d10..0000000
--- a/path/canvaPrinter.ml
+++ /dev/null
@@ -1,42 +0,0 @@
-module Path = Brr_canvas.C2d.Path
-module V2 = Gg.V2
-
-type 'a t = Path.t
-
-let create
- : unit -> 'a t
- = Path.create
-
-(* Start a new path. *)
-let move_to
- : Gg.v2 -> 'a t -> 'a t
- = fun point path ->
- let x, y = V2.to_tuple point in
- Path.move_to ~x ~y path;
- path
-
-let line_to
- : Gg.v2 -> 'a t -> 'a t
- = fun point path ->
- let x, y = V2.to_tuple point in
- Path.line_to ~x ~y path;
- path
-
-let quadratic_to
- : Gg.v2 -> Gg.v2 -> Gg.v2 -> 'a t -> 'a t
- = fun ctrl0 ctrl1 p1 path ->
- let cx, cy = V2.to_tuple ctrl0
- and cx', cy' = V2.to_tuple ctrl1
- and x, y = V2.to_tuple p1 in
- Path.ccurve_to
- ~cx ~cy
- ~cx' ~cy'
- ~x ~y
- path;
- path
-
-let close
- : 'a t -> 'a t
- = fun path ->
- Path.close path;
- path
diff --git a/path/canvaPrinter.mli b/path/canvaPrinter.mli
deleted file mode 100755
index e273054..0000000
--- a/path/canvaPrinter.mli
+++ /dev/null
@@ -1,2 +0,0 @@
-include Repr.PRINTER
- with type 'a t = Brr_canvas.C2d.Path.t
diff --git a/path/draw.ml b/path/draw.ml
deleted file mode 100755
index e628dbc..0000000
--- a/path/draw.ml
+++ /dev/null
@@ -1,245 +0,0 @@
-open StdLabels
-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 *)
-let translate_point
- : area:Gg.v2 -> Gg.v2 -> (float * float)
- = fun ~area point ->
- let x, y = Gg.V2.(to_tuple @@ mul area point) in
- x, ((Gg.V2.y area) -. y)
-*)
-
-let translate_point
- : area:Gg.v2 -> Gg.v2 -> (float * float)
- = fun ~area point ->
- let _ = area in
-
- let x, y = Gg.V2.(to_tuple @@ point) in
- x, y
-
-let translate_point'
- : area:Gg.v2 -> Gg.v2 -> Gg.v2 -> (float * float)
- = fun ~area vect point ->
- let open Gg.V2 in
- translate_point ~area
- (point + vect)
-
-(* Draw a straight line between two points *)
-let line
- : Gg.v2 -> p1:Point.t -> Path.t -> unit
- = fun area ~p1 path ->
- let x, y = translate_point ~area (Point.get_coord p1) in
- Path.line_to path ~x ~y
-
-(* Draw a simple bezier curve from the three given points *)
-let three_points
- : Gg.v2 -> p0:Point.t -> p1:Point.t -> p2:Point.t -> Path.t -> unit
- = fun area ~p0 ~p1 ~p2 path ->
- let p0 = Point.get_coord p0
- and p1 = Point.get_coord p1
- and p2 = Point.get_coord p2 in
- let bezier = Shapes.Bezier.three_points_quadratic p0 p1 p2
- |> Shapes.Bezier.quadratic_to_cubic in
- let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0
- and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1
- and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in
-
- Path.ccurve_to path
- ~cx ~cy
- ~cx' ~cy'
- ~x ~y
-
-let multi_points
- : ?connexion:Gg.v2 -> Gg.v2 -> Point.t list -> Path.t -> unit
- = fun ?connexion area points path ->
-
- let (let*) v f =
- match v with
- | Ok beziers -> f beziers
- | _ -> () in
-
- let points = List.map ~f:Point.get_coord points in
-
- let* beziers = Shapes.Bspline.to_bezier ?connexion1:connexion points in
- Array.iter beziers
- ~f:(fun bezier ->
- let cx, cy = translate_point ~area bezier.Shapes.Bezier.ctrl0
- and cx', cy' = translate_point ~area bezier.Shapes.Bezier.ctrl1
- and x, y = translate_point ~area bezier.Shapes.Bezier.p1 in
-
- Path.ccurve_to path
- ~cx ~cy
- ~cx' ~cy'
- ~x ~y
- )
-
-let circle
- : Gg.v2 -> center:Gg.v2 -> float -> Path.t -> Path.t
- = fun area ~center r path ->
-
- let cx, cy = translate_point ~area center in
- Path.arc
- path
- ~cx ~cy
- ~r
- ~start:0.
- ~stop:Gg.Float.two_pi;
- path
-
-type bezier = Path_Builder.bezier
-
-type path =
- | Empty
- | Line of Point.t * Point.t
- | Three_point of Point.t * Point.t * Point.t
- | Curve of bezier array
-
-type t =
- { id : int
- ; path : path }
-
-let move_to
- : area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
- = fun ~area canvaPath path ->
-
- match path with
- | Empty -> ()
- | Line (p0, _)
- | Three_point (p0, _, _) ->
- let x, y = translate_point ~area (Point.get_coord p0) in
- Path.move_to canvaPath ~x ~y
- | Curve beziers ->
- try
- let bezier = Array.get beziers 0 in
- let x, y = translate_point ~area (Point.get_coord bezier.p0) in
- Path.move_to canvaPath ~x ~y
- with _ -> ()
-
-let draw
- : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
- = fun ?connexion ~area canvaPath path ->
- match connexion, path with
-
- | _, Empty -> ()
- | None, Line (_, p1) ->
- ignore @@ line area ~p1 canvaPath
-
- | Some p0, Line (p1, p2)
- | None, Three_point (p0, p1, p2)
- | Some _, Three_point (p0, p1, p2) ->
- ignore @@ three_points area ~p0 ~p1 ~p2 canvaPath
-
- | _, Curve beziers ->
- Array.iter beziers
- ~f:(fun bezier ->
-
- let cx, cy = translate_point ~area bezier.Path_Builder.ctrl0
- and cx', cy' = translate_point ~area bezier.Path_Builder.ctrl1
- and x, y = translate_point ~area (Point.get_coord bezier.Path_Builder.p1) in
-
- Path.ccurve_to canvaPath
- ~cx ~cy
- ~cx' ~cy'
- ~x ~y
- )
-
-let go_back
- : ?connexion:Point.t -> area:Gg.v2 -> Brr_canvas.C2d.Path.t -> path -> unit
- = fun ?connexion ~area canvaPath path ->
- let vect = Gg.V2.of_polar @@ Gg.V2.v
- 20.
- (Float.neg Gg.Float.pi_div_4)
- in
- match connexion, path with
- | _, Empty -> ()
- | _, Three_point (p0, p1, p2) ->
- let open Point in
- let p0' = p0 + vect
- and p1' = p1 + vect
- and p2' = p2 + vect in
-
- let x, y = translate_point' ~area vect @@ Point.get_coord p2 in
- Path.line_to canvaPath ~x ~y;
- ignore @@ three_points area ~p0:p2' ~p1:p1' ~p2:p0' canvaPath
- | _, Curve beziers ->
- let last = Array.get beziers ((Array.length beziers) -1) in
-
- let x, y =
- (Point.get_coord last.p1)
- |> translate_point' vect ~area in
-
- Path.line_to canvaPath ~x ~y;
-
- for i = 1 to Array.length beziers do
-
- let i = (Array.length beziers) - i in
- let bezier = Array.get beziers i in
-
- let cx, cy = translate_point' vect ~area bezier.ctrl1
- and cx', cy' = translate_point' vect ~area bezier.ctrl0
- and x, y = translate_point' vect ~area (Point.get_coord bezier.p0) in
-
- Path.ccurve_to canvaPath
- ~cx ~cy
- ~cx' ~cy'
- ~x ~y
- done;
-
- | _ -> ()
-
-type quick_path = Point.t list * bezier list
-
-let id = ref 0
-
-let to_path
- : quick_path -> t
- = fun (points, beziers) ->
-
- incr id;
- let id = !id in
- match beziers, points with
- | [], [] -> {id; path = Empty}
- | [], p0::p1::[] -> {id; path=Line (p0, p1)}
- | [], p0::p1::p2::[] -> {id; path=Three_point (p0, p1, p2)}
- | [], points ->
-
- let (let*) v f =
- match v with
- | Ok beziers -> f beziers
- | _ -> {id; path=Empty} in
-
- let points' = List.map ~f:Point.get_coord points in
- let* beziers = Shapes.Bspline.to_bezier points' in
- let curves = Path_Builder.points_to_beziers points beziers in
- {id; path=Curve curves}
- | beziers, _ ->
- let (let*) v f =
- match v with
- | Ok beziers -> f beziers
- | _ -> {id; path=Curve (Array.of_list beziers)} in
-
- let connexion = match beziers with
- | hd::_ -> Some (Point.get_coord hd.p1)
- | _ -> None in
-
- let* beziers' = Shapes.Bspline.to_bezier
- ?connexion1:connexion
- (List.map points ~f:Point.get_coord) in
-
-
- let curves = Path_Builder.points_to_beziers points beziers' in
-
-
- (* Create a new array with both lenght *)
- let t = Array.append
- curves
- (Array.of_list beziers)
- in
-
- {id; path = Curve t}
diff --git a/path/dune b/path/dune
index c9eff46..42965db 100755
--- a/path/dune
+++ b/path/dune
@@ -1,8 +1,9 @@
(library
- (name draw)
+ (name path)
(libraries
gg
brr
+ layer
shapes
)
)
diff --git a/path/point.ml b/path/point.ml
index 83cb168..808310c 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -12,7 +12,7 @@ let empty =
let create x y =
{ p = Gg.V2.v x y
- ; size = 20.
+ ; size = 10.
; angle = Float.neg Gg.Float.pi_div_4
}
diff --git a/path/repr.ml b/path/repr.ml
deleted file mode 100755
index b91442b..0000000
--- a/path/repr.ml
+++ /dev/null
@@ -1,19 +0,0 @@
-module type PRINTER = sig
-
- type 'a t
-
- val create: unit -> 'a t
-
- (* Start a new path. *)
- val move_to: Gg.v2 -> 'a t -> 'a t
-
- val line_to: Gg.v2 -> 'a t -> 'a t
-
- (** [quadratic_to ctrl0 ctrl1 p1] ctreate a quadratic curve from the current
- point to [p1], with control points [ctrl0] and [ctrl1] *)
- val quadratic_to: Gg.v2 -> Gg.v2 -> Gg.v2 -> 'a t -> 'a t
-
- (** Request for the path to be closed *)
- val close: 'a t -> 'a t
-
-end
diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml
index a0f52d6..fc27c62 100755
--- a/path/wireFramePrinter.ml
+++ b/path/wireFramePrinter.ml
@@ -1,4 +1,4 @@
-module Repr = CanvaPrinter
+module Repr = Layer.CanvaPrinter
type t = Point.t
@@ -28,8 +28,8 @@ let start
}
let line_to
- : Point.t -> 'a repr -> 'a repr
- = fun t {back; path; _} ->
+ : Point.t -> 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
diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli
index 26974f5..72bb5b7 100755
--- a/path/wireFramePrinter.mli
+++ b/path/wireFramePrinter.mli
@@ -10,7 +10,7 @@ val start
: Point.t -> 'a repr -> 'a repr
val line_to
- : Point.t -> 'a repr -> 'a repr
+ : Point.t -> Point.t -> 'a repr -> 'a repr
val quadratic_to
: Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> 'a repr -> 'a repr
@@ -19,5 +19,5 @@ val stop
: 'a repr -> 'a repr
val get
- : 'a repr -> 'a CanvaPrinter.t
+ : 'a repr -> 'a Layer.CanvaPrinter.t
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-26 15:44:35 +0000