From a8f37f041dce3f16917b6659d3ca97492f178f4d Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sun, 3 Jan 2021 05:42:35 +0100
Subject: Communication with webworker

---
 layer/dune                 |   2 +-
 layer/fillPrinter.ml       |  73 +++++++++++++++++++++++++++++++
 layer/linePrinter.ml       |  69 +++++++++++++++++++++++++++++
 layer/paths.ml             | 107 +++++++++++++++++++++++++++++++++++++++++++++
 layer/wireFramePrinter.ml  |  80 +++++++++++++++++++++++++++++++++
 layer/wireFramePrinter.mli |  27 ++++++++++++
 6 files changed, 357 insertions(+), 1 deletion(-)
 create mode 100755 layer/fillPrinter.ml
 create mode 100755 layer/linePrinter.ml
 create mode 100755 layer/paths.ml
 create mode 100755 layer/wireFramePrinter.ml
 create mode 100755 layer/wireFramePrinter.mli

(limited to 'layer')

diff --git a/layer/dune b/layer/dune
index f0b1b13..3c617ad 100755
--- a/layer/dune
+++ b/layer/dune
@@ -3,6 +3,6 @@
  (libraries 
    gg
    brr
-   shapes
+   path
    )
  )
diff --git a/layer/fillPrinter.ml b/layer/fillPrinter.ml
new file mode 100755
index 0000000..2297d15
--- /dev/null
+++ b/layer/fillPrinter.ml
@@ -0,0 +1,73 @@
+module Point = Path.Point
+module Make(Repr: 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
+    : Path.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/layer/linePrinter.ml b/layer/linePrinter.ml
new file mode 100755
index 0000000..3ed1c3c
--- /dev/null
+++ b/layer/linePrinter.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/paths.ml b/layer/paths.ml
new file mode 100755
index 0000000..3cedd6d
--- /dev/null
+++ b/layer/paths.ml
@@ -0,0 +1,107 @@
+(** Common  module for ensuring that the function is evaluated only once *)
+
+module type REPRESENTABLE = sig
+  type t
+
+  (** Represent the path *)
+  val repr
+    : t -> (module Path.Repr.M with type t = Path.Point.t and type repr = 's) -> 's -> 's
+end
+
+(* Canva representation *)
+
+module FillCanvaRepr = FillPrinter.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 WireSVGRepr = WireFramePrinter.Make(Svg)
+
+
+type printer =
+  [ `Fill
+  | `Line
+  | `Ductus ]
+
+(** 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
+    | `Ductus ->
+      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 = 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
+      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
+          (module WireSVGRepr)
+          (WireSVGRepr.create_path (fun _ -> ()))
+                     |> WireSVGRepr.get in
+      Svg.path
+        ~at:Brr.At.[
+            v (Jstr.v "fill")  color
+          ; v (Jstr.v "stroke") color
+          ; v (Jstr.v "d") svg_path ]
+        []
diff --git a/layer/wireFramePrinter.ml b/layer/wireFramePrinter.ml
new file mode 100755
index 0000000..81ab271
--- /dev/null
+++ b/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/layer/wireFramePrinter.mli b/layer/wireFramePrinter.mli
new file mode 100755
index 0000000..b198d58
--- /dev/null
+++ b/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
-- 
cgit v1.2.3