From 7bb561f31e0ee57a388032b760b7db943dd6b36c Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 1 Jan 2021 23:18:35 +0100
Subject: Update

---
 path/path.ml | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 112 insertions(+)
 create mode 100755 path/path.ml

(limited to 'path/path.ml')

diff --git a/path/path.ml b/path/path.ml
new file mode 100755
index 0000000..9b6b9c4
--- /dev/null
+++ b/path/path.ml
@@ -0,0 +1,112 @@
+(** Common  module for ensuring that the function is evaluated only once *)
+
+module Point = Point
+
+module type REPRESENTABLE = sig
+  type t
+
+  (** Represent the path *)
+  val repr
+    : t -> (module Repr.M with type t = Point.t and type repr = 's) -> 's -> 's
+end
+
+module Path_Builder = Builder.Make(Point)
+module Fixed = Fixed.Make(Point)
+
+(* Canva representation *)
+
+module FillCanvaRepr = FillPrinter.Make(Layer.CanvaPrinter)
+module LineCanvaRepr = LinePrinter.Make(Layer.CanvaPrinter)
+module WireCanvaRepr = WireFramePrinter.Make(Layer.CanvaPrinter)
+
+(* SVG representation *)
+
+module FillSVGRepr = FillPrinter.Make(Layer.Svg)
+module LineSVGRepr = LinePrinter.Make(Layer.Svg)
+module WireSVGRepr = WireFramePrinter.Make(Layer.Svg)
+
+
+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