blob: 9b6b9c4909f4cbfd9e3ba3dea93a3bba6c6c2b44 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
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 ]
[]
|