Point suppression

3 files changed, 98 insertions, 42 deletions

diff --git a/layer/ductusPrinter.ml b/layer/ductusPrinter.ml
new file mode 100755
index 0000000..3ed1c3c
--- /dev/null
+++ b/layer/ductusPrinter.ml
@@ -0,0 +1,69 @@
+module Make(Repr: Repr.PRINTER) = struct
+
+  type t = Path.Point.t
+
+  type repr =
+    { path: (Repr.t)
+    }
+
+  let create_path
+    : 'b -> repr
+    = 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
+      { 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
+      { path
+      }
+
+  let quadratic_to
+    : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr
+    = fun p0 ctrl0 ctrl1 p1 { path } ->
+
+      let path = ref path in
+
+      let bezier =
+        { Shapes.Bezier.p0 = Path.Point.get_coord p0
+        ; ctrl0
+        ; 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))
+        *. 100. /. 3.
+      in
+      for i = 0 to (Int.of_float delay) do
+        let bezier', _ = Shapes.Bezier.slice (0.1 *. (Float.of_int i)) bezier in
+        let point = Path.Point.copy p1 bezier'.Shapes.Bezier.p1 in
+        path := Repr.move_to (Path.Point.get_coord point) !path;
+        path := Repr.line_to (Path.Point.get_coord' point) !path;
+      done;
+
+      { path = !path }
+
+  let stop
+    : repr -> repr
+    = fun path -> path
+
+
+  let get
+    : repr -> Repr.t
+    = fun {path; _} ->
+      path
+end
diff --git a/layer/linePrinter.ml b/layer/linePrinter.ml
index 3ed1c3c..c15bcc9 100755
--- a/layer/linePrinter.ml
+++ b/layer/linePrinter.ml
@@ -2,6 +2,21 @@ module Make(Repr: Repr.PRINTER) = struct
 
   type t = 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 = Repr.move_to (point - (of_tuple (dist, dist))) path
+               |> Repr.line_to ( point + (of_tuple (dist, dist)))
+               |> Repr.move_to (point + (of_tuple (dist', dist)))
+               |> Repr.line_to ( point + (of_tuple (dist, dist')))
+    in
+    path
+
+
   type repr =
     { path: (Repr.t)
     }
@@ -16,16 +31,15 @@ module Make(Repr: Repr.PRINTER) = struct
   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
+      let path = mark t path 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
+      let path = Repr.line_to (Path.Point.get_coord t) path
+                 |> mark t in
       { path
       }
 
@@ -33,29 +47,11 @@ module Make(Repr: Repr.PRINTER) = struct
     : Path.Point.t -> Gg.v2 -> Gg.v2 -> Path.Point.t -> repr -> repr
     = fun p0 ctrl0 ctrl1 p1 { path } ->
 
-      let path = ref path in
-
-      let bezier =
-        { Shapes.Bezier.p0 = Path.Point.get_coord p0
-        ; ctrl0
-        ; 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))
-        *. 100. /. 3.
-      in
-      for i = 0 to (Int.of_float delay) do
-        let bezier', _ = Shapes.Bezier.slice (0.1 *. (Float.of_int i)) bezier in
-        let point = Path.Point.copy p1 bezier'.Shapes.Bezier.p1 in
-        path := Repr.move_to (Path.Point.get_coord point) !path;
-        path := Repr.line_to (Path.Point.get_coord' point) !path;
-      done;
+      let path = Repr.move_to (Path.Point.get_coord p0) path
+                 |> Repr.quadratic_to ctrl0 ctrl1 (Path.Point.get_coord p1)
+                 |> mark p1 in
 
-      { path = !path }
+      { path = path }
 
   let stop
     : repr -> repr
diff --git a/layer/paths.ml b/layer/paths.ml
index 3cedd6d..59215df 100755
--- a/layer/paths.ml
+++ b/layer/paths.ml
@@ -11,13 +11,14 @@ end
 (* Canva representation *)
 
 module FillCanvaRepr = FillPrinter.Make(CanvaPrinter)
+module DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter)
 module LineCanvaRepr = LinePrinter.Make(CanvaPrinter)
 module WireCanvaRepr = WireFramePrinter.Make(CanvaPrinter)
 
 (* SVG representation *)
 
 module FillSVGRepr = FillPrinter.Make(Svg)
-module LineSVGRepr = LinePrinter.Make(Svg)
+module DuctusSVGRepr = DuctusPrinter.Make(Svg)
 module WireSVGRepr = WireFramePrinter.Make(Svg)
 
 
@@ -47,9 +48,9 @@ let to_canva
     | `Ductus ->
       R.repr
         path
-        (module WireCanvaRepr)
-        (WireCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
-      |> WireCanvaRepr.get
+        (module DuctusCanvaRepr)
+        (DuctusCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p))
+      |> DuctusCanvaRepr.get
       |> Brr_canvas.C2d.stroke ctx
 
 
@@ -81,18 +82,6 @@ let to_svg
           ; v (Jstr.v "stroke") color]
         !paths
 
-    | `Line ->
-      let svg_path = R.repr
-          path
-          (module LineSVGRepr)
-          (LineSVGRepr.create_path (fun _ -> ()))
-                     |> LineSVGRepr.get in
-      Svg.path
-        ~at:Brr.At.[
-            v (Jstr.v "fill")  color
-          ; v (Jstr.v "stroke") color
-          ; v (Jstr.v "d") svg_path ]
-        []
     | `Ductus ->
       let svg_path = R.repr
           path
@@ -105,3 +94,5 @@ let to_svg
           ; v (Jstr.v "stroke") color
           ; v (Jstr.v "d") svg_path ]
         []
+    | `Line ->
+      raise Not_found