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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
open StdLabels
open Brr
module Path_Builder = Paths.Path_Builder
module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg)
module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr)
let expected_host = [%static_hash ""]
let backgroundColor = Blog.Nord.nord0
let timer, tick = Elements.Timer.create ()
type mode =
| Edit
| Selection of Path_Builder.fixedPath
| Out
type current = Path_Builder.t
(** Events *)
type canva_events =
[ `Click of float * float
| `Out of float * float
]
type button_events =
[ `Delete
| `Export
]
type events =
[ canva_events
| button_events
| `Point of float * (float * float)
| `Width of float
| `Angle of float
]
(*
The state cannt hold functionnal values, and thus cannot be used to store
elements like timer
*)
type state =
{ mode : mode
; paths : Path_Builder.fixedPath list
; current : current
; width : float
; angle : float
}
let insert_or_replace state ((x, y) as p) path =
let width = state.width
and angle = state.angle in
let point = Path.Point.create ~x ~y ~angle ~width in
match Path_Builder.peek path with
| None ->
Path_Builder.add_point
point
path
| Some p1 ->
let open Gg.V2 in
let p1' = Path.Point.get_coord p1 in
let dist = (norm (p1' - (of_tuple p))) in
if dist < 5. then (
path, None
) else (
Path_Builder.add_point
point
path
)
let check_selection
: (float * float) -> Path_Builder.fixedPath list -> Path_Builder.fixedPath option
= fun position paths ->
let point = Gg.V2.of_tuple position in
(* If the user click on a curve, select it *)
List.fold_left paths
~init:None
~f:(fun selection path ->
match selection with
| Some p -> Some p
| None ->
(* TODO : Add a method in the point module *)
begin match Path_Builder.distance point path with
| Some p when p < 20. ->
Some path
| _ -> None
end
)
let do_action
: events -> state -> state
= fun event state ->
match event, state.mode with
| `Point (_delay, point), Edit ->
(* Add the point in the list *)
let current, fixed_path = insert_or_replace
state
point
state.current in
let paths = match fixed_path with
| None -> state.paths
| Some p -> p::state.paths in
{ state with current; paths }
(* Click anywhere while in Out mode, we switch in edition *)
| `Click _, Out ->
Elements.Timer.start timer 0.3;
{ state with mode = Edit }
(* Click anywhere while in selection mode, we either select another path,
or switch to Out mode*)
| `Click position, (Selection _) ->
begin match check_selection position state.paths with
| None ->
{ state with
mode = Out }
| Some selected ->
(* Start the timer in order to handle the mouse moves *)
Elements.Timer.start timer 0.3;
{ state with
mode = (Selection selected)}
end
| `Out point, Edit ->
Elements.Timer.stop timer;
begin match Path_Builder.peek2 state.current with
(* If there is at last two points selected, handle this as a curve
creation *)
| Some _ ->
let current, fixed_path = insert_or_replace state point state.current in
let paths = match fixed_path with
| None -> Path_Builder.to_fixed current::state.paths
| Some p -> p::state.paths
and current = Path_Builder.empty in
{ state with
mode = Out
; paths; current }
(* Else, check if there is a curve undre the cursor, and remove it *)
| None ->
let current = Path_Builder.empty in
begin match check_selection point state.paths with
| None ->
{ state with
mode = Out
; current
}
| Some selected ->
{ state with
mode = (Selection selected)
; current }
end
end
| `Delete, Selection s ->
let id = Path_Builder.id s in
let paths = List.filter state.paths ~f:(fun p -> Path_Builder.id p != id) in
{ state with paths ; mode = Out}
| `Export, _ ->
let my_host = Uri.host @@ Window.location @@ G.window in
if (Hashtbl.hash my_host) = expected_host then (
(* Convert the path into an sVG element *)
let svg = Layer.Svg.svg
~at:Brr.At.[
v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg")
; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ]
(List.map state.paths
~f:(fun path ->
let repr = SVGRepr.create_path (fun _ -> ()) in
let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in
Layer.Svg.path
~at:Brr.At.[
v (Jstr.v "fill") backgroundColor
; v (Jstr.v "stroke") backgroundColor
; v (Jstr.v "d") path ]
[]
)) in
let content = El.prop Elements.Prop.outerHTML svg in
let btoa = Jv.get Jv.global "btoa" in
let base64data = Jv.apply btoa
[| Jv.of_jstr content |] in
(* Create the link to download the the element, and simulate a click on it *)
let a = El.a
~at:At.[
href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data))
; v (Jstr.v "download") (Jstr.v "out.svg")
]
[] in
El.click a
);
state
| `Angle angle, _ ->
{ state with angle}
| `Width width, _ ->
{ state with width}
| _ -> state
let init =
{ paths = []
; current = Path_Builder.empty
; mode = Out
; angle = 30.
; width = 10.
}
|
