(** 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 DuctusCanvaRepr = DuctusPrinter.Make(CanvaPrinter) module LineCanvaRepr = LinePrinter.Make(CanvaPrinter) module WireCanvaRepr = WireFramePrinter.Make(CanvaPrinter) (* SVG representation *) module FillSVGRepr = FillPrinter.Make(Svg) module DuctusSVGRepr = DuctusPrinter.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 DuctusCanvaRepr) (DuctusCanvaRepr.create_path (fun p -> Brr_canvas.C2d.fill ctx p; p)) |> DuctusCanvaRepr.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 | `Ductus -> let svg_path = R.repr path (module DuctusSVGRepr) (DuctusSVGRepr.create_path (fun _ -> ())) |> DuctusSVGRepr.get in Svg.path ~at:Brr.At.[ v (Jstr.v "fill") color ; v (Jstr.v "stroke") color ; v (Jstr.v "d") svg_path ] [] | `Line -> raise Not_found