diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-01 16:48:23 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2021-01-01 16:48:23 +0100 |
commit | 74cd42c5cae6644914334448e198d562f4145511 (patch) | |
tree | d502e0798a04566c16d345c194ce725330631145 /paths.ml | |
parent | af88c8895bba85fe5340b34aafb3dce7650bd01f (diff) |
Use first type module instead of functors pt.2
Diffstat (limited to 'paths.ml')
-rwxr-xr-x | paths.ml | 106 |
1 files changed, 104 insertions, 2 deletions
@@ -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 ] + [] + + |