From 74cd42c5cae6644914334448e198d562f4145511 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 1 Jan 2021 16:48:23 +0100
Subject: Use first type module instead of functors pt.2

---
 paths.ml | 106 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 104 insertions(+), 2 deletions(-)

(limited to 'paths.ml')

diff --git a/paths.ml b/paths.ml
index 4ff6c66..9d968f0 100755
--- a/paths.ml
+++ b/paths.ml
@@ -5,8 +5,110 @@ module Fixed = Path.Fixed.Make(Path.Point)
 
 (* Canva representation *)
 
-module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
+module FillCanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter)
+module LineCanvaRepr = Path.LinePrinter.Make(Layer.CanvaPrinter)
+module WireCanvaRepr = Path.WireFramePrinter.Make(Layer.CanvaPrinter)
+
 
 (* SVG representation *)
 
-module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
+module FillSVGRepr = Path.FillPrinter.Make(Layer.Svg)
+module LineSVGRepr = Path.LinePrinter.Make(Layer.Svg)
+module WireSVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
+
+
+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
+
+type printer =
+  [ `Fill
+  | `Line
+  | `Wire
+  ]
+
+(** 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
+    | `Wire ->
+      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 = Layer.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
+      Layer.Svg.path
+        ~at:Brr.At.[
+            v (Jstr.v "fill")  color
+          ; v (Jstr.v "stroke") color
+          ; v (Jstr.v "d") svg_path ]
+        []
+    | `Wire ->
+      let svg_path = R.repr
+          path
+          (module WireSVGRepr)
+          (WireSVGRepr.create_path (fun _ -> ()))
+                     |> WireSVGRepr.get in
+      Layer.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