aboutsummaryrefslogtreecommitdiff
path: root/layer
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-11 05:36:46 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-11 13:55:43 +0100
commit979be5f588a1ffd6e1d060cd794e87526d517b7a (patch)
treea96605b6ae27bcf646b17f022acf7f5f0cf0b8bf /layer
parent85b40e5712fcbe76c697d1a22fb126db8079098c (diff)
Layer review
Diffstat (limited to 'layer')
-rwxr-xr-xlayer/ductusPrinter.ml52
-rwxr-xr-xlayer/ductusPrinter.mli30
-rwxr-xr-xlayer/fillPrinter.ml70
-rwxr-xr-xlayer/fillPrinter.mli29
-rwxr-xr-xlayer/linePrinter.ml28
-rwxr-xr-xlayer/linePrinter.mli31
-rwxr-xr-xlayer/paths.ml104
-rwxr-xr-xlayer/repr.ml32
8 files changed, 192 insertions, 184 deletions
diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
index 8f796b4..db34481 100755
--- a/layer/ductusPrinter.ml
+++ b/layer/ductusPrinter.ml
@@ -1,45 +1,52 @@
module Make(Repr: Repr.PRINTER) = struct
- type t = Path.Point.t
+ type point = Path.Point.t
- type repr =
+ type t =
{ path: (Repr.t)
}
+ type repr = Repr.t
+
let create_path
- : 'b -> repr
+ : 'b -> t
= fun _ ->
{ path = Repr.create ()
}
- (* Start a new path. *)
let start
- : Path.Point.t -> repr -> repr
- = fun t {path} ->
- let path = Repr.move_to (Path.Point.get_coord t) path in
- let path = Repr.line_to (Path.Point.get_coord' t) path in
+ : point -> point -> t -> t
+ = fun p1 p2 { path } ->
+ let path =
+ Repr.move_to (Path.Point.get_coord p1) path
+ |> Repr.line_to (Path.Point.get_coord p2) in
{ path
}
let line_to
- : Path.Point.t -> Path.Point.t -> repr -> repr
- = fun _ t {path} ->
- let path = Repr.move_to (Path.Point.get_coord t) path in
- let path = Repr.line_to (Path.Point.get_coord' t) path in
+ : (point * point) -> (point * point) -> t -> t
+ = fun (_, p1) (_, p1') {path} ->
+ let path = Repr.move_to (Path.Point.get_coord p1) path in
+ let path = Repr.line_to (Path.Point.get_coord p1') path in
{ path
}
let quadratic_to
- : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
- = fun (p0, ctrl0, ctrl1, p1) { path } ->
-
- let path = ref path in
+ : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t
+ = fun (p0, ctrl0, ctrl1, p1) (p0', ctrl0', ctrl1', p1') {path} ->
let bezier =
{ Shapes.Bezier.p0 = Path.Point.get_coord p0
; ctrl0
; ctrl1
; p1 = Path.Point.get_coord p1
+ }
+
+ and bezier' =
+ { Shapes.Bezier.p0 = Path.Point.get_coord p0'
+ ; ctrl0 = ctrl0'
+ ; ctrl1 = ctrl1'
+ ; p1 = Path.Point.get_coord p1'
} in
(* Mark each point on the bezier curve. The first point is the most
@@ -48,25 +55,28 @@ module Make(Repr: Repr.PRINTER) = struct
((Path.Point.get_stamp p0) -. (Path.Point.get_stamp p1))
*. 30.
in
+ let path = ref path in
for i = 0 to ((Int.of_float delay) ) do
let ratio = (Float.of_int i) /. delay in
- let bezier', _ = Shapes.Bezier.slice ratio bezier in
+ let bezier, _ = Shapes.Bezier.slice ratio bezier
+ and bezier', _ = Shapes.Bezier.slice ratio bezier' in
- let point = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0 p1 in
+ let point = Path.Point.mix ratio bezier.Shapes.Bezier.p1 p0 p1
+ and point' = Path.Point.mix ratio bezier'.Shapes.Bezier.p1 p0' p1' in
path := Repr.move_to (Path.Point.get_coord point) !path;
- path := Repr.line_to (Path.Point.get_coord' point) !path;
+ path := Repr.line_to (Path.Point.get_coord point') !path;
done;
{ path = !path }
let stop
- : repr -> repr
+ : t -> t
= fun path -> path
let get
- : repr -> Repr.t
+ : t -> Repr.t
= fun {path; _} ->
path
end
diff --git a/layer/ductusPrinter.mli b/layer/ductusPrinter.mli
index cd849ef..cdcaa7c 100755
--- a/layer/ductusPrinter.mli
+++ b/layer/ductusPrinter.mli
@@ -1,28 +1,2 @@
-module Make(Repr:Repr.PRINTER): sig
-
- type repr
-
- type t = Path.Point.t
-
- val create_path
- : 'b -> repr
-
- (* Start a new path. *)
- val start
- : Path.Point.t -> repr -> repr
-
- val line_to
- : Path.Point.t -> Path.Point.t -> repr -> repr
-
- val quadratic_to
- : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
-
- val stop
- : repr -> repr
-
- val get
- : repr -> Repr.t
-
-end
-
-
+module Make(R:Repr.PRINTER):
+ Repr.LAYER with type repr = R.t
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
index 9b6546c..f3717c2 100755
--- a/layer/fillPrinter.ml
+++ b/layer/fillPrinter.ml
@@ -1,16 +1,16 @@
-module Point = Path.Point
-
module Make(Repr: Repr.PRINTER) = struct
- type t = Point.t
+ type point = Path.Point.t
+
+ type repr = Repr.t
- type repr =
+ type t =
{ path: Repr.t
; close : Repr.t -> Repr.t
}
let create_path
- : (Repr.t -> Repr.t) -> repr
+ : (Repr.t -> Repr.t) -> t
= fun f ->
{ close = f
; path = Repr.create ()
@@ -18,23 +18,23 @@ module Make(Repr: Repr.PRINTER) = struct
(* Start a new path. *)
- let start'
- : Gg.v2 -> Gg.v2 -> repr -> repr
+ let start
+ : point -> point -> t -> t
= fun p1 _ {close ; path } ->
- let path = Repr.move_to p1 path in
+ let path = Repr.move_to (Path.Point.get_coord p1) path in
{ close
; path
}
- let start
- : Path.Point.t -> repr -> repr
- = fun pt t ->
- let p = (Point.get_coord pt) in
- start' p p t
-
- let line_to'
- : (Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2) -> repr -> repr
+ let line_to
+ : (point * point) -> (point * point) -> t -> t
= fun (p0, p1) (p0', p1') t ->
+
+ let p0 = Path.Point.get_coord p0
+ and p1 = Path.Point.get_coord p1
+ and p0' = Path.Point.get_coord p0'
+ and p1' = Path.Point.get_coord p1' in
+
let path =
Repr.move_to p1 t.path
|> Repr.line_to p1'
@@ -45,21 +45,15 @@ module Make(Repr: Repr.PRINTER) = struct
let path = t.close path in
{ t with path}
- let line_to
- : Point.t -> Point.t -> repr -> repr
- = fun p0 p1 t ->
-
- line_to'
- ( Point.get_coord p0
- , Point.get_coord p1 )
- ( Point.get_coord' p0
- , Point.get_coord' p1 )
- t
-
- let quadratic_to'
- : (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> (Gg.v2 * Gg.v2 * Gg.v2 * Gg.v2) -> repr -> repr
- = fun (p0, ctrl0, ctrl1, p1) (p0', ctrl0', ctrl1', p1') t ->
+ let quadratic_to
+ : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t
+ = fun (p0, ctrl0, ctrl1, p1) (p0', ctrl0', ctrl1', p1') t ->
+ let p0 = Path.Point.get_coord p0
+ and p1 = Path.Point.get_coord p1
+ and p0' = Path.Point.get_coord p0'
+ and p1' = Path.Point.get_coord p1'
+ in
let path =
Repr.move_to p1 t.path
@@ -83,25 +77,13 @@ module Make(Repr: Repr.PRINTER) = struct
{ t with path }
- let quadratic_to
- : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
- = fun (p0, ctrl0, ctrl1, p1) t ->
-
-
- let ctrl0' = Point.get_coord' @@ Point.copy p0 ctrl0
- and ctrl1' = Point.get_coord' @@ Point.copy p1 ctrl1 in
- quadratic_to'
- (Point.get_coord p0, ctrl0, ctrl1, Point.get_coord p1)
- (Point.get_coord' p0, ctrl0', ctrl1', Point.get_coord' p1)
- t
-
let stop
- : repr -> repr
+ : t -> t
= fun t ->
t
let get
- : repr -> Repr.t
+ : t -> Repr.t
= fun t ->
t.path
end
diff --git a/layer/fillPrinter.mli b/layer/fillPrinter.mli
index c1bb30e..cdcaa7c 100755
--- a/layer/fillPrinter.mli
+++ b/layer/fillPrinter.mli
@@ -1,27 +1,2 @@
-module Make(Repr:Repr.PRINTER): sig
-
- type repr
-
- type t = Path.Point.t
-
- val create_path
- : (Repr.t -> Repr.t) -> repr
-
- (* Start a new path. *)
- val start
- : Path.Point.t -> repr -> repr
-
- val line_to
- : Path.Point.t -> Path.Point.t -> repr -> repr
-
- val quadratic_to
- : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
-
- val stop
- : repr -> repr
-
- val get
- : repr -> Repr.t
-
-end
-
+module Make(R:Repr.PRINTER):
+ Repr.LAYER with type repr = R.t
diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml
index 45ee801..d223760 100755
--- a/layer/linePrinter.ml
+++ b/layer/linePrinter.ml
@@ -1,6 +1,6 @@
module Make(Repr: Repr.PRINTER) = struct
- type t = Path.Point.t
+ type point = Path.Point.t
let mark point path =
let open Gg.V2 in
@@ -17,27 +17,28 @@ module Make(Repr: Repr.PRINTER) = struct
path
- type repr =
+ type t =
{ path: (Repr.t)
}
+ type repr = Repr.t
+
let create_path
- : 'b -> repr
+ : 'b -> t
= fun _ ->
{ path = Repr.create ()
}
- (* Start a new path. *)
let start
- : Path.Point.t -> repr -> repr
- = fun t {path} ->
- let path = mark t path in
+ : point -> point -> t -> t
+ = fun p1 _ { path } ->
+ let path = mark p1 path in
{ path
}
let line_to
- : Path.Point.t -> Path.Point.t -> repr -> repr
- = fun p0 p1 {path} ->
+ : (point * point) -> (point * point) -> t -> t
+ = fun (p0, p1) _ {path} ->
let path = Repr.move_to (Path.Point.get_coord p0) path
|> Repr.line_to (Path.Point.get_coord p1)
|> mark p1 in
@@ -45,8 +46,8 @@ module Make(Repr: Repr.PRINTER) = struct
}
let quadratic_to
- : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
- = fun (p0, ctrl0, ctrl1, p1) { path } ->
+ : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t
+ = fun (p0, ctrl0, ctrl1, p1) _ {path} ->
let path = Repr.move_to (Path.Point.get_coord p0) path
|> Repr.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1)
@@ -55,12 +56,13 @@ module Make(Repr: Repr.PRINTER) = struct
{ path = path }
let stop
- : repr -> repr
+ : t -> t
= fun path -> path
let get
- : repr -> Repr.t
+ : t -> Repr.t
= fun {path; _} ->
path
+
end
diff --git a/layer/linePrinter.mli b/layer/linePrinter.mli
index b6e9603..191830a 100755
--- a/layer/linePrinter.mli
+++ b/layer/linePrinter.mli
@@ -1,29 +1,2 @@
-module Make(Repr:Repr.PRINTER): sig
-
- type repr
-
- type t = Path.Point.t
-
- val create_path
- : 'b -> repr
-
- (* Start a new path. *)
- val start
- : Path.Point.t -> repr -> repr
-
- val line_to
- : Path.Point.t -> Path.Point.t -> repr -> repr
-
- val quadratic_to
- : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> repr -> repr
-
- val stop
- : repr -> repr
-
- val get
- : repr -> Repr.t
-
-end
-
-
-
+module Make(R:Repr.PRINTER):
+ Repr.LAYER with type repr = R.t
diff --git a/layer/paths.ml b/layer/paths.ml
index e170767..6d0157e 100755
--- a/layer/paths.ml
+++ b/layer/paths.ml
@@ -6,25 +6,87 @@ module type REPRESENTABLE = sig
(** Represent the path *)
val repr
- : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's
+ : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's
+end
+
+type printer =
+ [ `Fill
+ | `Line
+ | `Ductus ]
+
+
+module type P = sig
+ include Path.Repr.M
+
+ type repr
+
+ val create_path
+ : (repr -> repr) -> t
+
+ val get
+ : t -> repr
+end
+
+
+module MakePrinter(M:Repr.LAYER) : P with type point = M.point and type t = M.t and type repr = M.repr = struct
+
+ type t = M.t
+
+ type point = M.point
+
+ type repr = M.repr
+
+ let get
+ : t -> repr
+ = M.get
+
+ let create_path
+ : (repr -> repr) -> t
+ = M.create_path
+
+ let start
+ : Path.Point.t -> t -> t
+ = fun pt t ->
+ M.start pt pt t
+
+ let line_to
+ : Path.Point.t -> Path.Point.t -> t -> t
+ = fun p0 p1 t ->
+
+ M.line_to
+ ( p0
+ , p1 )
+ ( Path.Point.copy p0 @@ Path.Point.get_coord' p0
+ , Path.Point.copy p1 @@ Path.Point.get_coord' p1 )
+ t
+
+ let quadratic_to
+ : (Path.Point.t * Gg.v2 * Gg.v2 * Path.Point.t) -> t -> t
+ = fun (p0, ctrl0, ctrl1, p1) t ->
+
+
+ let ctrl0' = Path.Point.get_coord' @@ Path.Point.copy p0 ctrl0
+ and ctrl1' = Path.Point.get_coord' @@ Path.Point.copy p1 ctrl1 in
+ M.quadratic_to
+ (p0, ctrl0, ctrl1, p1)
+ (Path.Point.copy p0 @@ Path.Point.get_coord' p0, ctrl0', ctrl1', Path.Point.copy p1 @@ Path.Point.get_coord' p1)
+
+ t
+
+ let stop = M.stop
end
(* Canva representation *)
-module FillCanvaRepr = FillPrinter.Make(CanvaPrinter)
-module DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter)
-module LineCanvaRepr = LinePrinter.Make(CanvaPrinter)
+module FillCanvaRepr = MakePrinter(FillPrinter.Make(CanvaPrinter))
+module DuctusCanvaRepr = MakePrinter(DuctusPrinter.Make(CanvaPrinter))
+module LineCanvaRepr = MakePrinter(LinePrinter.Make(CanvaPrinter))
(* SVG representation *)
-module FillSVGRepr = FillPrinter.Make(Svg)
-module DuctusSVGRepr = DuctusPrinter.Make(Svg)
-module WireSVGRepr = WireFramePrinter.Make(Svg)
+module FillSVGRepr = MakePrinter(FillPrinter.Make(Svg))
+module DuctusSVGRepr = MakePrinter(DuctusPrinter.Make(Svg))
-type printer =
- [ `Fill
- | `Line
- | `Ductus ]
(** Draw a path to a canva *)
let to_canva
@@ -85,7 +147,7 @@ let to_svg
let svg_path = R.repr
path
(module DuctusSVGRepr)
- (DuctusSVGRepr.create_path (fun _ -> ()))
+ (DuctusSVGRepr.create_path (fun _ -> Jstr.empty))
|> DuctusSVGRepr.get in
Svg.path
~at:Brr.At.[
@@ -102,14 +164,14 @@ module ReprFixed = struct
type t = Path.Fixed.t * Path.Fixed.t
module R = struct
- type t = Path.Point.t
+ type point = Path.Point.t
type repr' =
- | Move of (Path.Point.t)
- | Line_to of (Path.Point.t * Path.Point.t)
- | Quadratic of (t * Gg.v2 * Gg.v2 * t)
+ | Move of (point)
+ | Line_to of (point * point)
+ | Quadratic of (point * Gg.v2 * Gg.v2 * point)
- type repr = repr' list
+ type t = repr' list
let start t actions =
(Move t)::actions
@@ -118,19 +180,19 @@ module ReprFixed = struct
Line_to (p0, p1)::actions
let quadratic_to
- : (t * Gg.v2 * Gg.v2 * t) -> repr -> repr
+ : (point * Gg.v2 * Gg.v2 * point) -> t -> t
= fun q actions ->
(Quadratic q)::actions
let stop
- : repr -> repr
+ : t -> t
= fun v -> List.rev v
end
let repr
- : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's
- = fun (type s) (path, _) (module Repr:Path.Repr.M with type t = Path.Point.t and type repr = s) state ->
+ : t -> (module Path.Repr.M with type point = Path.Point.t and type t = 's) -> 's -> 's
+ = fun (type s) (path, _) (module Repr:Path.Repr.M with type point = Path.Point.t and type t = s) state ->
let elems = Path.Fixed.repr path (module R) [] in
let state = List.fold_left elems
diff --git a/layer/repr.ml b/layer/repr.ml
index f2d114c..85b0f3b 100755
--- a/layer/repr.ml
+++ b/layer/repr.ml
@@ -9,7 +9,7 @@ module type PRINTER = sig
val line_to: Gg.v2 -> t -> t
- (** [quadratic_to ctrl0 ctrl1 p1] ctreate a quadratic curve from the current
+ (** [quadratic_to ctrl0 ctrl1 p1] create a quadratic curve from the current
point to [p1], with control points [ctrl0] and [ctrl1] *)
val quadratic_to: Gg.v2 -> Gg.v2 -> Gg.v2 -> t -> t
@@ -17,3 +17,33 @@ module type PRINTER = sig
val close: t -> t
end
+
+module type LAYER = sig
+ type t
+
+ type point = Path.Point.t
+
+ type repr
+
+ val get
+ : t -> repr
+
+ val create_path
+ : (repr -> repr) -> t
+
+ val start
+ : point -> point -> t -> t
+
+ val line_to
+ : (point * point) -> (point * point) -> t -> t
+
+ val quadratic_to
+ : (point * Gg.v2 * Gg.v2 * point)
+ -> (point * Gg.v2 * Gg.v2 * point)
+ -> t
+ -> t
+
+ val stop
+ : t -> t
+
+end