summaryrefslogtreecommitdiff
path: root/path/path.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-01-03 05:42:35 +0100
committerSébastien Dailly <sebastien@chimrod.com>2021-01-03 20:19:14 +0100
commita8f37f041dce3f16917b6659d3ca97492f178f4d (patch)
tree35223969024c9ebaed7309b5a6299f8de5f18d1f /path/path.ml
parent20addbe8fd0ac4c79c8a69a4f888ec320a9ca4c3 (diff)
Communication with webworker
Diffstat (limited to 'path/path.ml')
-rwxr-xr-xpath/path.ml107
1 files changed, 1 insertions, 106 deletions
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 ]
- []