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
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
open StdLabels
open Note
open Brr
module Timer = Events.Timer
module Point = Draw.Point
module Path = Draw
module Path_Builder = Path.Builder.Make(Point)
type mode =
| Edit
| Out
type current = Path_Builder.t
type state =
{ mode : mode
; paths : Draw.t list (* All the previous paths *)
; current : current
; timer : Timer.t
}
(** Events *)
type canva_events =
[ `Click of float * float
| `Out of float * float
]
type events =
[ canva_events
| `Point of float * (float * float) ]
type canva_signal = Point.t
module Mouse = Brr_note_kit.Mouse
(** Create the element in the page, and the event handler *)
let canva
: Brr.El.t -> [> canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
= fun element ->
let module C = Brr_canvas.Canvas in
let c = C.of_el element in
(* Mouse events *)
let mouse = Brr_note_kit.Mouse.on_el
~normalize:false
(fun x y -> (x, y)) element in
let click =
Brr_note_kit.Mouse.left_down mouse
|> E.map (fun c -> `Click c) in
let up =
Brr_note_kit.Mouse.left_up mouse
|> E.map (fun c -> `Out c) in
let position = Mouse.pos mouse in
let pos = S.l2 (fun b pos ->
if b then
Some pos
else
None
) (Mouse.left mouse) position in
E.select [click; up], pos, c
let insert_or_replace ((x, y) as p) path =
let point = Point.create x y in
match Path_Builder.peek path with
| None ->
Path_Builder.add_point
point
path
| Some p1 ->
let open Gg.V2 in
let p1' = Point.get_coord p1 in
let dist = (norm (p1' - (of_tuple p))) in
if dist < 0.05 then (
path
) else (
Path_Builder.add_point
point
path
)
let do_action
: events -> state -> state
= fun event state ->
match event, state.mode with
| `Point (_delay, (x, y)), Edit ->
(* Add the point in the list *)
let current= Path_Builder.add_point
(Point.create x y)
state.current in
{ state with current }
| `Click _, Out ->
Timer.start state.timer 0.3;
{ state with mode = Edit }
| `Out point, Edit ->
Timer.stop state.timer;
let current = insert_or_replace point state.current in
let beziers = Draw.to_path @@ Path_Builder.get current in
let paths = beziers::state.paths
and current = Path_Builder.empty in
{ state with mode = Out; paths; current }
| _ -> state
let backgroundColor = Jstr.v "#2e3440"
let white = Jstr.v "#eceff4"
let green = Jstr.v "#a3be8c"
let nord8 = Jstr.v "#81a1c1"
let draw
: ?connexion:Gg.v2 -> area:Gg.v2 -> Point.t list -> Brr_canvas.C2d.Path.t
= fun ?connexion ~area points ->
let open Brr_canvas.C2d in
let path = Path.create () in
let () = match points with
| [] -> ()
| hd::_ ->
let vect = Draw.Line (hd, Point.create 0. 0.) in
Draw.move_to ~area path vect in
let _ = match points with
| []
| _::[] -> ()
| _::p1::[] ->
Draw.line area ~p1 path
| p0::p1::p2::[] ->
Draw.three_points area ~p0 ~p1 ~p2 path
| _ ->
Draw.multi_points ?connexion area points path
in path
let draw_path area points beziers =
let open Brr_canvas.C2d in
let connexion = match beziers with
| [] -> None
| hd ::_ -> Some hd.Shapes.Bezier.p1 in
(* Firt draw all the points most recent points *)
let path = draw ?connexion ~area points in
(* Then add the fixed ones *)
let path = List.fold_left beziers
~init:path
~f:(fun path bezier ->
let cx, cy = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl0
and cx', cy' = Draw.translate_point ~area bezier.Shapes.Bezier.ctrl1
and x, y = Draw.translate_point ~area bezier.Shapes.Bezier.p1 in
Path.ccurve_to path
~cx ~cy
~cx' ~cy'
~x ~y;
path
) in
path
let on_change canva mouse_position state =
let open Brr_canvas.C2d in
let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in
let area = Gg.V2.v w h in
let context = create canva in
set_fill_style context (color backgroundColor);
fill_rect context
~x:0.0
~y:0.0
~w
~h;
set_stroke_style context (color white);
set_fill_style context (color white);
(* If we are in edit mode, we add a point under the cursor.
Otherwise, we would only display the previous registered point, which can
be far away in the past, and would give to the user a sensation of lag.
*)
let pos = S.rough_value mouse_position in
let current =
match state.mode, pos with
| Edit, Some (x, y) ->
Path_Builder.add_point (Point.create x y) state.current
| _ ->
state.current
in
let path = Point.get @@ Path_Builder.draw current in
stroke context path;
(*
let points, beziers = Path_Builder.get current in
let path = draw_path area (points) beziers in
stroke context path;
*)
List.iter state.paths
~f:(fun path ->
(* This is ugly, and probably non efficient, but is an appropriate solution for
the cases of overlapping path *)
match path.Draw.path with
| Draw.Curve beziers ->
Array.iter beziers
~f:(fun bezier ->
let b = Draw.Curve [|bezier|] in
let p = Path.create () in
Draw.move_to ~area p b;
Draw.draw ~area p b;
Draw.go_back ~area p b;
Path.close p;
fill context p;
stroke context p
)
| _ ->
let p = Path.create () in
Draw.move_to ~area p path.Draw.path;
Draw.draw ~area p path.Draw.path;
Draw.go_back ~area p path.Draw.path;
Path.close p;
fill context p;
stroke context p
);
()
let page_main id =
let timer, tick = Timer.create () in
let init =
{ paths = []
; current = Path_Builder.empty
; mode = Out
; timer
} in
(*begin match Document.find_el_by_id G.document id with*)
begin match (Jv.is_none id) with
| true -> Console.(error [str "No element with id '%s' found"; id])
| false ->
let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in
let tick_event =
S.sample_filter mouse_position
~on:tick
(fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in
(* The first evaluation is the state. Which is the result of all the
successives events to the initial state *)
let state =
E.select [canva_events; tick_event]
|> E.map do_action
|> Note.S.accum init in
(* The seconde evaluation is the canva refresh, which only occurs when
the mouse is updated *)
let v =
E.map (fun _ -> state) (S.changes mouse_position)
|> E.map (fun x -> on_change canva mouse_position (S.value x) )
|> fun ev -> E.log ev (fun _ -> ()) in
(* Draw the canva for first time *)
on_change canva mouse_position init;
let _ = Logr.hold (S.log state (fun _ -> ())) in
let _ = match v with
| None -> ()
| Some log -> Logr.hold log in
()
end
let () =
if Brr_webworkers.Worker.ami () then
()
else
let open Jv in
let drawer = obj
[| "run", (repr page_main)
|] in
set global "drawer" drawer
|