aboutsummaryrefslogtreecommitdiff
path: root/script.it/layer
diff options
context:
space:
mode:
Diffstat (limited to 'script.it/layer')
-rwxr-xr-xscript.it/layer/canvaPrinter.ml42
-rwxr-xr-xscript.it/layer/canvaPrinter.mli2
-rwxr-xr-xscript.it/layer/ductusEngine.ml82
-rwxr-xr-xscript.it/layer/ductusEngine.mli2
-rwxr-xr-xscript.it/layer/dune8
-rwxr-xr-xscript.it/layer/fillEngine.ml89
-rwxr-xr-xscript.it/layer/fillEngine.mli2
-rwxr-xr-xscript.it/layer/lineEngine.ml68
-rwxr-xr-xscript.it/layer/lineEngine.mli2
-rwxr-xr-xscript.it/layer/paths.ml244
-rwxr-xr-xscript.it/layer/repr.ml49
-rwxr-xr-xscript.it/layer/svg.ml64
-rwxr-xr-xscript.it/layer/wireFramePrinter.ml80
-rwxr-xr-xscript.it/layer/wireFramePrinter.mli27
14 files changed, 761 insertions, 0 deletions
diff --git a/script.it/layer/canvaPrinter.ml b/script.it/layer/canvaPrinter.ml
new file mode 100755
index 0000000..23cf842
--- /dev/null
+++ b/script.it/layer/canvaPrinter.ml
@@ -0,0 +1,42 @@
+module Path = Brr_canvas.C2d.Path
+module V2 = Gg.V2
+
+type t = Path.t
+
+let create
+ : unit -> t
+ = Path.create
+
+(* Start a new path. *)
+let move_to
+ : Gg.v2 -> t -> t
+ = fun point path ->
+ let x, y = V2.to_tuple point in
+ Path.move_to ~x ~y path;
+ path
+
+let line_to
+ : Gg.v2 -> t -> 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 -> t -> 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
+ : t -> t
+ = fun path ->
+ Path.close path;
+ path
diff --git a/script.it/layer/canvaPrinter.mli b/script.it/layer/canvaPrinter.mli
new file mode 100755
index 0000000..0c46448
--- /dev/null
+++ b/script.it/layer/canvaPrinter.mli
@@ -0,0 +1,2 @@
+include Repr.PRINTER
+ with type t = Brr_canvas.C2d.Path.t
diff --git a/script.it/layer/ductusEngine.ml b/script.it/layer/ductusEngine.ml
new file mode 100755
index 0000000..b943467
--- /dev/null
+++ b/script.it/layer/ductusEngine.ml
@@ -0,0 +1,82 @@
+module Make(Layer: Repr.PRINTER) = struct
+
+ type point = Path.Point.t
+
+ type t =
+ { path: (Layer.t)
+ }
+
+ type repr = Layer.t
+
+ let create_path
+ : 'b -> t
+ = fun _ ->
+ { path = Layer.create ()
+ }
+
+ let start
+ : point -> point -> t -> t
+ = fun p1 p2 { path } ->
+ let path =
+ Layer.move_to (Path.Point.get_coord p1) path
+ |> Layer.line_to (Path.Point.get_coord p2) in
+ { path
+ }
+
+ let line_to
+ : (point * point) -> (point * point) -> t -> t
+ = fun (_, p1) (_, p1') {path} ->
+ let path = Layer.move_to (Path.Point.get_coord p1) path in
+ let path = Layer.line_to (Path.Point.get_coord p1') path in
+ { path
+ }
+
+ 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') {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
+ recent point *)
+ let delay =
+ ((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
+ and bezier', _ = Shapes.Bezier.slice ratio bezier' 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 := Layer.move_to (Path.Point.get_coord point) !path;
+ path := Layer.line_to (Path.Point.get_coord point') !path;
+ done;
+
+ { path = !path }
+
+ let stop
+ : t -> t
+ = fun path -> path
+
+
+ let get
+ : t -> Layer.t
+ = fun {path; _} ->
+ path
+end
diff --git a/script.it/layer/ductusEngine.mli b/script.it/layer/ductusEngine.mli
new file mode 100755
index 0000000..e1660f4
--- /dev/null
+++ b/script.it/layer/ductusEngine.mli
@@ -0,0 +1,2 @@
+module Make(R:Repr.PRINTER):
+ Repr.ENGINE with type repr = R.t
diff --git a/script.it/layer/dune b/script.it/layer/dune
new file mode 100755
index 0000000..3c617ad
--- /dev/null
+++ b/script.it/layer/dune
@@ -0,0 +1,8 @@
+(library
+ (name layer)
+ (libraries
+ gg
+ brr
+ path
+ )
+ )
diff --git a/script.it/layer/fillEngine.ml b/script.it/layer/fillEngine.ml
new file mode 100755
index 0000000..9a3fe7e
--- /dev/null
+++ b/script.it/layer/fillEngine.ml
@@ -0,0 +1,89 @@
+module Make(Layer: Repr.PRINTER) = struct
+
+ type point = Path.Point.t
+
+ type repr = Layer.t
+
+ type t =
+ { path: Layer.t
+ ; close : Layer.t -> Layer.t
+ }
+
+ let create_path
+ : (Layer.t -> Layer.t) -> t
+ = fun f ->
+ { close = f
+ ; path = Layer.create ()
+ }
+
+ (* Start a new path. *)
+
+ let start
+ : point -> point -> t -> t
+ = fun p1 _ {close ; path } ->
+ let path = Layer.move_to (Path.Point.get_coord p1) path in
+ { close
+ ; path
+ }
+
+ 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 =
+ Layer.move_to p1 t.path
+ |> Layer.line_to p1'
+ |> Layer.line_to p0'
+ |> Layer.line_to p0
+ |> Layer.line_to p1
+ |> Layer.close in
+ let path = t.close path in
+ { t with path}
+
+ 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 =
+ Layer.move_to p1 t.path
+ |> Layer.line_to p1'
+
+ (* Backward *)
+ |> Layer.quadratic_to
+ ctrl1'
+ ctrl0'
+ p0'
+ |> Layer.line_to p0
+
+ (* Forward *)
+ |> Layer.quadratic_to
+ ctrl0
+ ctrl1
+ p1
+ |> Layer.close
+ |> t.close in
+
+
+ { t with path }
+
+ let stop
+ : t -> t
+ = fun t ->
+ t
+
+ let get
+ : t -> Layer.t
+ = fun t ->
+ t.path
+end
diff --git a/script.it/layer/fillEngine.mli b/script.it/layer/fillEngine.mli
new file mode 100755
index 0000000..e1660f4
--- /dev/null
+++ b/script.it/layer/fillEngine.mli
@@ -0,0 +1,2 @@
+module Make(R:Repr.PRINTER):
+ Repr.ENGINE with type repr = R.t
diff --git a/script.it/layer/lineEngine.ml b/script.it/layer/lineEngine.ml
new file mode 100755
index 0000000..3d15d9c
--- /dev/null
+++ b/script.it/layer/lineEngine.ml
@@ -0,0 +1,68 @@
+module Make(Layer: Repr.PRINTER) = struct
+
+ type point = Path.Point.t
+
+ let mark point path =
+ let open Gg.V2 in
+ let point = Path.Point.get_coord point in
+
+ let dist = 5.
+ and dist' = -5. in
+
+ let path = Layer.move_to (point - (of_tuple (dist, dist))) path
+ |> Layer.line_to ( point + (of_tuple (dist, dist)))
+ |> Layer.move_to (point + (of_tuple (dist', dist)))
+ |> Layer.line_to ( point + (of_tuple (dist, dist')))
+ in
+ path
+
+
+ type t =
+ { path: (Layer.t)
+ }
+
+ type repr = Layer.t
+
+ let create_path
+ : 'b -> t
+ = fun _ ->
+ { path = Layer.create ()
+ }
+
+ let start
+ : point -> point -> t -> t
+ = fun p1 _ { path } ->
+ let path = mark p1 path in
+ { path
+ }
+
+ let line_to
+ : (point * point) -> (point * point) -> t -> t
+ = fun (p0, p1) _ {path} ->
+ let path = Layer.move_to (Path.Point.get_coord p0) path
+ |> Layer.line_to (Path.Point.get_coord p1)
+ |> mark p1 in
+ { path
+ }
+
+ let quadratic_to
+ : (point * Gg.v2 * Gg.v2 * point) -> (point * Gg.v2 * Gg.v2 * point) -> t -> t
+ = fun (p0, ctrl0, ctrl1, p1) _ {path} ->
+
+ let path = Layer.move_to (Path.Point.get_coord p0) path
+ |> Layer.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1)
+ |> mark p1 in
+
+ { path = path }
+
+ let stop
+ : t -> t
+ = fun path -> path
+
+
+ let get
+ : t -> Layer.t
+ = fun {path; _} ->
+ path
+
+end
diff --git a/script.it/layer/lineEngine.mli b/script.it/layer/lineEngine.mli
new file mode 100755
index 0000000..86ef5fb
--- /dev/null
+++ b/script.it/layer/lineEngine.mli
@@ -0,0 +1,2 @@
+module Make(R:Repr.PRINTER):
+ Repr.ENGINE with type repr = R.t
diff --git a/script.it/layer/paths.ml b/script.it/layer/paths.ml
new file mode 100755
index 0000000..d3baf02
--- /dev/null
+++ b/script.it/layer/paths.ml
@@ -0,0 +1,244 @@
+open StdLabels
+(** Common module for ensuring that the function is evaluated only once *)
+
+(** This represent a single path, which can be transformed throug a [repr]
+ function. *)
+module type PATH = sig
+ type t
+
+ (** Represent the path *)
+ val repr
+ : 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.ENGINE) : 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
+
+(** Transform the two path, into a single one. *)
+module ReprSingle = struct
+
+ type point = Path.Point.t
+
+ type repr =
+ | Move of (point)
+ | Line_to of (point * point)
+ | Quadratic of (point * Gg.v2 * Gg.v2 * point)
+
+ module R = struct
+ type t = repr list
+
+ type point = Path.Point.t
+
+ let start t actions =
+ (Move t)::actions
+
+ let line_to p0 p1 actions =
+ Line_to (p0, p1)::actions
+
+ let quadratic_to
+ : (point * Gg.v2 * Gg.v2 * point) -> t -> t
+ = fun q actions ->
+ (Quadratic q)::actions
+
+ let stop
+ : t -> t
+ = fun v -> v
+
+ end
+
+ let repr
+ : (module PATH with type t = 't) -> 't -> 't -> repr list * repr list
+ = fun (type t) (module P:PATH with type t = t) path back ->
+ let path = P.repr path (module R) []
+ and back = P.repr back (module R) [] in
+ path, back
+end
+
+(* Canva representation *)
+
+module FillCanva = FillEngine.Make(CanvaPrinter)
+module LineCanva = LineEngine.Make(CanvaPrinter)
+module DuctusCanva = DuctusEngine.Make(CanvaPrinter)
+
+(* SVG representation *)
+
+module FillSVG = FillEngine.Make(Svg)
+module DuctusSVG = DuctusEngine.Make(Svg)
+
+
+(** Draw a path to a canva.contents
+
+ The code may seems scary, but is very repetitive. Firt, all points (from the
+ main stroke, and the interior one) are evaluated. Then, they are both rendered
+ using the selected engine.
+*)
+let to_canva
+ : (module PATH with type t = 's) -> 's * 's -> Brr_canvas.C2d.t -> printer -> unit
+ = fun (type s) (module R:PATH with type t = s) (path, back) ctx engine ->
+ let f, b = ReprSingle.repr (module R) path back in
+ match engine with
+ | `Fill ->
+ let t = List.fold_left2 f b
+ ~init:(FillCanva.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
+ ~f:(fun ctx f b ->
+ match (f, b) with
+ | ReprSingle.Move p0, ReprSingle.Move p0' -> FillCanva.start p0 p0' ctx
+ | ReprSingle.Line_to l, ReprSingle.Line_to l' -> FillCanva.line_to l l' ctx
+ | ReprSingle.Quadratic q, ReprSingle.Quadratic q' -> FillCanva.quadratic_to q q' ctx
+ | _ -> ctx
+ ) in
+ FillCanva.get t
+ |> Brr_canvas.C2d.stroke ctx
+ | `Line ->
+ let t = List.fold_left2 f b
+ ~init:(LineCanva.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
+ ~f:(fun ctx f b ->
+ match (f, b) with
+ | ReprSingle.Move p0, ReprSingle.Move p0' -> LineCanva.start p0 p0' ctx
+ | ReprSingle.Line_to l, ReprSingle.Line_to l' -> LineCanva.line_to l l' ctx
+ | ReprSingle.Quadratic q, ReprSingle.Quadratic q' -> LineCanva.quadratic_to q q' ctx
+ | _ -> ctx
+ ) in
+ LineCanva.get t
+ |> Brr_canvas.C2d.stroke ctx
+ | `Ductus ->
+ let t = List.fold_left2 f b
+ ~init:(DuctusCanva.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
+ ~f:(fun ctx f b ->
+ match (f, b) with
+ | ReprSingle.Move p0, ReprSingle.Move p0' -> DuctusCanva.start p0 p0' ctx
+ | ReprSingle.Line_to l, ReprSingle.Line_to l' -> DuctusCanva.line_to l l' ctx
+ | ReprSingle.Quadratic q, ReprSingle.Quadratic q' -> DuctusCanva.quadratic_to q q' ctx
+ | _ -> ctx
+ ) in
+ DuctusCanva.get t
+ |> Brr_canvas.C2d.stroke ctx
+
+
+
+(** Draw a path and represent it as SVG *)
+let to_svg
+ : (module PATH with type t = 's) -> color:Jstr.t -> 's * 's -> printer -> Brr.El.t
+ = fun (type s) (module R:PATH with type t = s) ~color (path, back) engine ->
+ let f, b = ReprSingle.repr (module R) path back in
+ match engine with
+ | `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 init = (FillSVG.create_path
+ (fun p ->
+ let repr = Svg.path
+ ~at:Brr.At.[ v (Jstr.v "d") p ]
+ [] in
+
+ paths := repr::!paths;
+ Jstr.empty)) in
+ let _ = List.fold_left2 f b
+ ~init
+ ~f:(fun ctx f b ->
+ match (f, b) with
+ | ReprSingle.Move p0, ReprSingle.Move p0' -> FillSVG.start p0 p0' ctx
+ | ReprSingle.Line_to l, ReprSingle.Line_to l' -> FillSVG.line_to l l' ctx
+ | ReprSingle.Quadratic q, ReprSingle.Quadratic q' -> FillSVG.quadratic_to q q' ctx
+ | _ -> ctx
+ ) in
+
+ Brr.El.v (Jstr.v "g")
+ ~at:Brr.At.[
+ v (Jstr.v "fill") color
+ ; v (Jstr.v "stroke") color]
+ !paths
+
+ | `Ductus ->
+ let init = DuctusSVG.create_path (fun _ -> Jstr.empty) in
+ let svg_path = List.fold_left2 f b
+ ~init
+ ~f:(fun ctx f b ->
+ match (f, b) with
+ | ReprSingle.Move p0, ReprSingle.Move p0' -> DuctusSVG.start p0 p0' ctx
+ | ReprSingle.Line_to l, ReprSingle.Line_to l' -> DuctusSVG.line_to l l' ctx
+ | ReprSingle.Quadratic q, ReprSingle.Quadratic q' -> DuctusSVG.quadratic_to q q' ctx
+ | _ -> ctx
+ )
+ |> DuctusSVG.get in
+
+ Svg.path
+ ~at:Brr.At.[
+ v (Jstr.v "fill") color
+ ; v (Jstr.v "stroke") color
+ ; v (Jstr.v "d") svg_path ]
+ []
+ | `Line ->
+ raise Not_found
diff --git a/script.it/layer/repr.ml b/script.it/layer/repr.ml
new file mode 100755
index 0000000..552e2b7
--- /dev/null
+++ b/script.it/layer/repr.ml
@@ -0,0 +1,49 @@
+module type PRINTER = sig
+
+ type t
+
+ val create: unit -> t
+
+ (* Start a new path. *)
+ val move_to: Gg.v2 -> t -> t
+
+ val line_to: Gg.v2 -> t -> t
+
+ (** [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
+
+ (** Request for the path to be closed *)
+ val close: t -> t
+
+end
+
+module type ENGINE = 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
diff --git a/script.it/layer/svg.ml b/script.it/layer/svg.ml
new file mode 100755
index 0000000..2394cb8
--- /dev/null
+++ b/script.it/layer/svg.ml
@@ -0,0 +1,64 @@
+(** SVG representation *)
+
+open Brr
+
+module V2 = Gg.V2
+
+let svg : El.cons
+ = fun ?d ?at childs ->
+ El.v ?d ?at (Jstr.v "svg") childs
+
+let path: El.cons
+ = fun ?d ?at childs ->
+ El.v ?d ?at (Jstr.v "path") childs
+
+type t = Jstr.t
+
+let create
+ : unit -> t
+ = fun () -> Jstr.empty
+
+(* Start a new path. *)
+let move_to
+ : Gg.v2 -> t -> t
+ = fun point path ->
+ let x, y = V2.to_tuple point in
+
+ Jstr.concat ~sep:(Jstr.v " ")
+ [ path
+ ; Jstr.v "M"
+ ; Jstr.of_float x
+ ; Jstr.of_float y ]
+
+let line_to
+ : Gg.v2 -> t -> t
+ = fun point path ->
+ let x, y = V2.to_tuple point in
+ Jstr.concat ~sep:(Jstr.v " ")
+ [ path
+ ; (Jstr.v "L")
+ ; (Jstr.of_float x)
+ ; (Jstr.of_float y) ]
+
+let quadratic_to
+ : Gg.v2 -> Gg.v2 -> Gg.v2 -> t -> 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
+ Jstr.concat ~sep:(Jstr.v " ")
+ [ path
+ ; (Jstr.v "C")
+ ; (Jstr.of_float cx)
+ ; (Jstr.of_float cy)
+ ; (Jstr.v ",")
+ ; (Jstr.of_float cx')
+ ; (Jstr.of_float cy')
+ ; (Jstr.v ",")
+ ; (Jstr.of_float x)
+ ; (Jstr.of_float y) ]
+
+let close
+ : t -> t
+ = fun path ->
+ Jstr.append path (Jstr.v " Z")
diff --git a/script.it/layer/wireFramePrinter.ml b/script.it/layer/wireFramePrinter.ml
new file mode 100755
index 0000000..81ab271
--- /dev/null
+++ b/script.it/layer/wireFramePrinter.ml
@@ -0,0 +1,80 @@
+module Point = Path.Point
+
+module Make(Repr: 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/script.it/layer/wireFramePrinter.mli b/script.it/layer/wireFramePrinter.mli
new file mode 100755
index 0000000..b198d58
--- /dev/null
+++ b/script.it/layer/wireFramePrinter.mli
@@ -0,0 +1,27 @@
+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