From a8f37f041dce3f16917b6659d3ca97492f178f4d Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 3 Jan 2021 05:42:35 +0100 Subject: Communication with webworker --- path/path.ml | 107 +---------------------------------------------------------- 1 file changed, 1 insertion(+), 106 deletions(-) (limited to 'path/path.ml') diff --git a/path/path.ml b/path/path.ml index 9b6b9c4..ea90de4 100755 --- a/path/path.ml +++ b/path/path.ml @@ -1,112 +1,7 @@ (** 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 Repr = Repr 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