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/paths.ml | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 107 insertions(+)
 create mode 100755 layer/paths.ml

(limited to 'layer/paths.ml')

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 ]
+        []
-- 
cgit v1.2.3