blob: 59215df451dc500255005395c38e19a143abc197 (
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
|
(** 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 WireSVGRepr)
(WireSVGRepr.create_path (fun _ -> ()))
|> WireSVGRepr.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
|
