aboutsummaryrefslogtreecommitdiff
path: root/path
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-01 23:18:35 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-01 23:18:35 +0100
commit7bb561f31e0ee57a388032b760b7db943dd6b36c (patch)
tree4e95d17cd8b62e286b026181c2590fe6ccdec401 /path
parent74cd42c5cae6644914334448e198d562f4145511 (diff)
Update
Diffstat (limited to 'path')
-rwxr-xr-xpath/path.ml112
1 files changed, 112 insertions, 0 deletions
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 ]
+ []