aboutsummaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
Diffstat (limited to 'path')
-rwxr-xr-xpath/dune2
-rwxr-xr-xpath/fillPrinter.ml72
-rwxr-xr-xpath/fixed.ml8
-rwxr-xr-xpath/fixed.mli15
-rwxr-xr-xpath/linePrinter.ml54
-rwxr-xr-xpath/path.ml107
-rwxr-xr-xpath/point.ml7
-rwxr-xr-xpath/point.mli4
-rwxr-xr-xpath/wireFramePrinter.ml78
-rwxr-xr-xpath/wireFramePrinter.mli27
10 files changed, 33 insertions, 341 deletions
diff --git a/path/dune b/path/dune
index 42965db..863c768 100755
--- a/path/dune
+++ b/path/dune
@@ -2,8 +2,6 @@
(name path)
(libraries
gg
- brr
- layer
shapes
)
)
diff --git a/path/fillPrinter.ml b/path/fillPrinter.ml
deleted file mode 100755
index 76056c7..0000000
--- a/path/fillPrinter.ml
+++ /dev/null
@@ -1,72 +0,0 @@
-module Make(Repr: Layer.Repr.PRINTER) = struct
-
- type t = Point.t
-
- type repr =
- { path: Repr.t
- ; close : Repr.t -> Repr.t
- }
-
- let create_path
- : (Repr.t -> Repr.t) -> repr
- = fun f ->
- { close = f
- ; path = Repr.create ()
- }
-
- (* Start a new path. *)
- let start
- : Point.t -> repr -> 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 -> repr -> 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
- let path = t.close path in
- { t with path}
-
- let quadratic_to
- : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> 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
- let path = t.close path in
- { t with path}
-
-
- let stop
- : repr -> repr
- = fun t ->
- t
-
- let get
- : repr -> Repr.t
- = fun t ->
- t.path
-end
diff --git a/path/fixed.ml b/path/fixed.ml
index 0ff4aad..d20c897 100755
--- a/path/fixed.ml
+++ b/path/fixed.ml
@@ -41,6 +41,10 @@ module Make(Point:P) = struct
: t -> int
= fun {id; _} -> id
+ let path
+ : t -> path array
+ = fun {path; _} -> path
+
module ToFixed = struct
type t = Point.t
@@ -183,4 +187,8 @@ module Make(Point:P) = struct
) in
{id; path}
+ let update
+ : t -> path array -> t
+ = fun {id; _} path -> {id; path}
+
end
diff --git a/path/fixed.mli b/path/fixed.mli
index 1f02aed..c84b51d 100755
--- a/path/fixed.mli
+++ b/path/fixed.mli
@@ -43,4 +43,19 @@ module Make(Point:P) : sig
val map_point
: t -> (Point.t -> Point.t) -> t
+ type bezier =
+ { p0:Point.t (* The starting point *)
+ ; p1:Point.t (* The end point *)
+ ; ctrl0:Gg.v2 (* The control point *)
+ ; ctrl1:Gg.v2 } (* The control point *)
+
+ type path =
+ | Empty
+ | Line of Point.t * Point.t
+ | Curve of bezier
+
+ val path : t -> path array
+
+ val update : t -> path array -> t
+
end
diff --git a/path/linePrinter.ml b/path/linePrinter.ml
deleted file mode 100755
index c0a7d58..0000000
--- a/path/linePrinter.ml
+++ /dev/null
@@ -1,54 +0,0 @@
-module Make(Repr: Layer.Repr.PRINTER) = struct
-
- type t = Point.t
-
- type repr =
- { path: (Repr.t)
- }
-
- let create_path
- : 'b -> repr
- = fun _ ->
- { path = Repr.create ()
- }
-
- (* Start a new path. *)
- let start
- : 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
- { path
- }
-
- let line_to
- : 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
- { path
- }
-
- let quadratic_to
- : 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
- let path = Repr.line_to (Point.get_coord' p1) path in
-
- { path
- }
-
- let stop
- : repr -> repr
- = fun {path} ->
-
-
- { path
- }
-
- let get
- : repr -> Repr.t
- = fun {path; _} ->
- path
-end
diff --git a/path/path.ml b/path/path.ml
index 9b6b9c4..ea90de4 100755
--- a/path/path.ml
+++ b/path/path.ml
@@ -1,112 +1,7 @@
(** Common module for ensuring that the function is evaluated only once *)
module Point = Point
-
-module type REPRESENTABLE = sig
- type t
-
- (** Represent the path *)
- val repr
- : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
-end
-
+module Repr = Repr
module Path_Builder = Builder.Make(Point)
module Fixed = Fixed.Make(Point)
-(* Canva representation *)
-
-module FillCanvaRepr = FillPrinter.Make(Layer.CanvaPrinter)
-module LineCanvaRepr = LinePrinter.Make(Layer.CanvaPrinter)
-module WireCanvaRepr = WireFramePrinter.Make(Layer.CanvaPrinter)
-
-(* SVG representation *)
-
-module FillSVGRepr = FillPrinter.Make(Layer.Svg)
-module LineSVGRepr = LinePrinter.Make(Layer.Svg)
-module WireSVGRepr = WireFramePrinter.Make(Layer.Svg)
-
-
-type printer =
- [ `Fill
- | `Line
- | `Wire ]
-
-(** Draw a path to a canva *)
-let to_canva
- : (module REPRESENTABLE with type t = 's) -> 's -> Brr_canvas.C2d.t -> printer -> unit
- = fun (type s) (module R:REPRESENTABLE with type t = s) path ctx -> function
- | `Fill ->
- R.repr
- path
- (module FillCanvaRepr)
- (FillCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
- |> FillCanvaRepr.get
- |> Brr_canvas.C2d.stroke ctx
- | `Line ->
- R.repr
- path
- (module LineCanvaRepr)
- (LineCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
- |> LineCanvaRepr.get
- |> Brr_canvas.C2d.stroke ctx
- | `Wire ->
- R.repr
- path
- (module WireCanvaRepr)
- (WireCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
- |> WireCanvaRepr.get
- |> Brr_canvas.C2d.stroke ctx
-
-
-(** Draw a path and represent it as SVG *)
-let to_svg
- : (module REPRESENTABLE with type t = 's) -> color:Jstr.t -> 's -> printer -> Brr.El.t
- = fun (type s) (module R:REPRESENTABLE with type t = s) ~color path -> function
- | `Fill ->
-
- (* In order to deal with over crossing path, I cut the path in as
- many segment as there is curve, and fill them all. Then, all of theme
- are grouped inside a single element *)
- let paths = ref [] in
- let _ = R.repr
- path
- (module FillSVGRepr)
- (FillSVGRepr.create_path
- (fun p ->
- let repr = Layer.Svg.path
- ~at:Brr.At.[ v (Jstr.v "d") p ]
- [] in
-
- paths := repr::!paths;
- Jstr.empty)) in
-
- Brr.El.v (Jstr.v "g")
- ~at:Brr.At.[
- v (Jstr.v "fill") color
- ; v (Jstr.v "stroke") color]
- !paths
-
- | `Line ->
- let svg_path = R.repr
- path
- (module LineSVGRepr)
- (LineSVGRepr.create_path (fun _ -> ()))
- |> LineSVGRepr.get in
- Layer.Svg.path
- ~at:Brr.At.[
- v (Jstr.v "fill") color
- ; v (Jstr.v "stroke") color
- ; v (Jstr.v "d") svg_path ]
- []
- | `Wire ->
- let svg_path = R.repr
- path
- (module WireSVGRepr)
- (WireSVGRepr.create_path (fun _ -> ()))
- |> WireSVGRepr.get in
- Layer.Svg.path
- ~at:Brr.At.[
- v (Jstr.v "fill") color
- ; v (Jstr.v "stroke") color
- ; v (Jstr.v "d") svg_path ]
- []
diff --git a/path/point.ml b/path/point.ml
index 06eb635..031e1e0 100755
--- a/path/point.ml
+++ b/path/point.ml
@@ -2,18 +2,21 @@ type t =
{ p: Gg.v2
; size : float
; angle: float
+ ; stamp : float
}
let empty =
{ p = Gg.V2.of_tuple (0., 0.)
; size = 0.
; angle = 0.
+ ; stamp = 0.
}
-let create ~angle ~width ~x ~y =
+let create ~angle ~width ~stamp ~x ~y =
{ p = Gg.V2.v x y
; size = width
; angle = Gg.Float.rad_of_deg (180. -. angle )
+ ; stamp
}
let copy point p =
@@ -30,6 +33,8 @@ let (+) p1 p2 =
let get_coord { p; _ } = p
+let get_stamp { stamp; _} = stamp
+
let get_coord'
: t -> Gg.v2
= fun t ->
diff --git a/path/point.mli b/path/point.mli
index 649a3be..db87a71 100755
--- a/path/point.mli
+++ b/path/point.mli
@@ -6,7 +6,9 @@ val (+): t -> Gg.v2 -> t
val get_coord : t -> Gg.v2
-val create: angle:float -> width:float -> x:float -> y:float -> t
+val get_stamp : t -> float
+
+val create: angle:float -> width:float -> stamp:float -> x:float -> y:float -> t
val copy : t -> Gg.v2 -> t
diff --git a/path/wireFramePrinter.ml b/path/wireFramePrinter.ml
deleted file mode 100755
index 796bbd9..0000000
--- a/path/wireFramePrinter.ml
+++ /dev/null
@@ -1,78 +0,0 @@
-module Make(Repr: Layer.Repr.PRINTER) = struct
- type t = Point.t
-
- type repr =
- { back: (Repr.t -> Repr.t)
- ; path: (Repr.t)
- ; last_point : Point.t option
- }
-
- let create_path
- : 'b -> repr
- = fun _ ->
- { back = Repr.close
- ; path = Repr.create ()
- ; last_point = None
- }
-
- (* Start a new path. *)
- let start
- : 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
- { back = (fun p -> back @@ line' p)
- ; path
- ; last_point = Some t
- }
-
- let line_to
- : 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)
- ; path = Repr.line_to (Point.get_coord t) path
- ; last_point = Some t
- }
-
- let quadratic_to
- : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> 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
- : repr -> 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
- : repr -> Repr.t
- = fun {back; path; _} ->
- back path
-end
diff --git a/path/wireFramePrinter.mli b/path/wireFramePrinter.mli
deleted file mode 100755
index fa8a5a8..0000000
--- a/path/wireFramePrinter.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-module Make(Repr:Layer.Repr.PRINTER): sig
-
- type repr
-
- type t = Point.t
-
- val create_path
- : 'b -> repr
-
- (* Start a new path. *)
- val start
- : Point.t -> repr -> repr
-
- val line_to
- : Point.t -> Point.t -> repr -> repr
-
- val quadratic_to
- : Point.t -> Gg.v2 -> Gg.v2 -> Point.t -> repr -> repr
-
- val stop
- : repr -> repr
-
-
- val get
- : repr -> Repr.t
-
-end
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 08:06:02 +0000