Update project structure

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