Skip to content

Commit 5669d57

Browse files
Keryan-devKeryan-dev
authored
Effectful events holding function (#154)
* add event holding function * update examples
1 parent 4c4968d commit 5669d57

File tree

6 files changed

+52
-75
lines changed

6 files changed

+52
-75
lines changed

‎examples/demo5.ml

+7-13
Original file line numberDiff line numberDiff line change
@@ -12,22 +12,17 @@ let () =
1212

1313
Canvas.show c;
1414

15-
let e1 =
16-
React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
15+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
1716
Backend.stop ()
18-
) Event.close
19-
in
17+
) Event.close;
2018

21-
let e2 =
22-
React.E.map (fun { Event.canvas = _; timestamp = _;
19+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
2320
data = { Event.key; char = _; flags = _ } } ->
2421
if key = KeyEscape then
2522
Backend.stop ()
26-
) Event.key_down
27-
in
23+
) Event.key_down;
2824

29-
let e3 =
30-
React.E.map (fun { Event.canvas = _; timestamp = t; data = () } ->
25+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = t; data = () } ->
3126
let theta, last = !state in
3227

3328
let theta = theta +. (Int64.to_float (Int64.sub t last)) *. -0.000005 in
@@ -52,7 +47,6 @@ let () =
5247
Canvas.restore c;
5348

5449
state := (theta, t)
55-
) Event.frame
56-
in
50+
) Event.frame;
5751

58-
Backend.run (fun () -> ignore e1; ignore e2; ignore e3)
52+
Backend.run (fun () -> ())

‎examples/demo6.ml

+9-17
Original file line numberDiff line numberDiff line change
@@ -13,22 +13,17 @@ let () =
1313

1414
Canvas.show c;
1515

16-
let e1 =
17-
React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
16+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
1817
Backend.stop ()
19-
) Event.close
20-
in
18+
) Event.close;
2119

22-
let e2 =
23-
React.E.map (fun { Event.canvas = _; timestamp = _;
20+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
2421
data = { Event.key; char = _; flags = _ } } ->
2522
if key = KeyEscape then
2623
Backend.stop ()
27-
) Event.key_down
28-
in
24+
) Event.key_down;
2925

30-
let e3 =
31-
React.E.map (fun { Event.canvas = _; timestamp = _;
26+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
3227
data = { Event.position; button } } ->
3328
let color =
3429
match button with
@@ -45,13 +40,10 @@ let () =
4540
Canvas.arc c ~center ~radius:10.0 ~theta1:0.0
4641
~theta2:(2.0 *. Const.pi) ~ccw:false;
4742
Canvas.fill c ~nonzero:false;
48-
) Event.button_down
49-
in
43+
) Event.button_down;
5044

51-
let e4 =
52-
React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
45+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
5346
()
54-
) Event.frame
55-
in
47+
) Event.frame;
5648

57-
Backend.run (fun () -> ignore e1; ignore e2; ignore e3; ignore e4)
49+
Backend.run (fun () -> ())

‎examples/saucisse.ml

+16-25
Original file line numberDiff line numberDiff line change
@@ -266,41 +266,36 @@ let draw () =
266266
Canvas.show c
267267

268268
let () =
269-
draw ()
269+
draw ();
270270

271-
let e_move =
272-
React.E.map (fun { Event.canvas = _; timestamp = _; data = (x, y) } ->
271+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = (x, y) } ->
273272
p3 := (float_of_int x, float_of_int y)
274-
) Event.mouse_move
273+
) Event.mouse_move;
275274

276-
let e1 =
277-
React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
275+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
278276
Backend.stop ()
279-
) Event.close
277+
) Event.close;
280278

281-
let e2 =
282-
React.E.map (fun { Event.canvas = _; timestamp = _;
279+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
283280
data = { Event.key; char = _; flags = _ }; _ } ->
284281
if key = KeyEscape then
285282
Backend.stop ()
286-
) Event.key_down
283+
) Event.key_down;
287284

288-
let e3 =
289-
React.E.map (fun { Event.canvas = _; timestamp = _;
285+
Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
290286
data = { Event.position = (x, y); _ } } ->
291287
point (float_of_int x, float_of_int y);
292288
) Event.button_down
293289

294290
let frames = ref 0L
295-
296-
let e_frame =
297-
React.E.map (fun { Event.canvas = _; timestamp = _; _ } ->
298-
Canvas.setFillColor c Color.white;
299-
Canvas.fillRect c ~pos:(0.0, 0.0) ~size:(float_of_int sw, float_of_int sh);
300-
301-
draw ();
302-
frames := Int64.add !frames Int64.one
303-
) Event.frame
291+
292+
let () = Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; _ } ->
293+
Canvas.setFillColor c Color.white;
294+
Canvas.fillRect c ~pos:(0.0, 0.0) ~size:(float_of_int sw, float_of_int sh);
295+
296+
draw ();
297+
frames := Int64.add !frames Int64.one
298+
) Event.frame
304299

305300
let () =
306301
if Array.length Sys.argv >= 2 && Sys.argv.(1) = "bench" then
@@ -309,9 +304,5 @@ let () =
309304
done
310305
else
311306
Backend.run (fun () ->
312-
ignore (Sys.opaque_identity e_frame);
313-
ignore (Sys.opaque_identity e_move);
314-
ignore (Sys.opaque_identity (e1, e2));
315-
ignore (Sys.opaque_identity (e3));
316307
Printf.printf "\nDisplayed %Ld frames. Goodbye !\n" !frames)
317308

‎examples/suncities.ml

+10-20
Original file line numberDiff line numberDiff line change
@@ -463,9 +463,6 @@ let rotate_light c x _y =
463463
scene := { !scene with sun_angle_xy; sun_angle_z };
464464
regen_shadows ()
465465

466-
let stored_ev = ref []
467-
468-
let store ev = stored_ev := ev::!stored_ev
469466

470467
type maction =
471468
| NoAction
@@ -485,37 +482,33 @@ let () =
485482
draw_scene c;
486483
Canvas.show c;
487484

488-
let ev_regen = React.E.map
485+
Event.hold @@ React.E.map
489486
(fun ({ data = { Event.key; char = _; flags = _ }; _ } : _ Event.canvas_event) ->
490487
if key = KeySpacebar then
491488
(regen (); draw_scene c)
492-
) Event.key_down
493-
in
489+
) Event.key_down;
494490

495-
let ev_resize = React.E.map
491+
Event.hold @@ React.E.map
496492
(fun ({ data = size; _ } : _ Event.canvas_event) ->
497493
(Canvas.setSize c size; compute_projection c; draw_scene c)
498-
) Event.resize
499-
in
494+
) Event.resize;
500495

501496
let mpos = ref NoAction in
502497

503-
let ev_mousedown = React.E.map
498+
Event.hold @@ React.E.map
504499
(fun ({ data = { position = (x,y); button }; _ } : Event.button_data Event.canvas_event) ->
505500
match button with
506501
| ButtonLeft -> mpos := ViewRot (x,y)
507502
| ButtonRight -> mpos := LightRot (x,y)
508503
| _ -> ()
509-
) Event.button_down
510-
in
504+
) Event.button_down;
511505

512-
let ev_mouseup = React.E.map
506+
Event.hold @@ React.E.map
513507
(fun ({ data = { button = _; _ }; _ } : Event.button_data Event.canvas_event) ->
514508
mpos := NoAction
515-
) Event.button_up
516-
in
509+
) Event.button_up;
517510

518-
let ev_mouse = React.E.map
511+
Event.hold @@ React.E.map
519512
(fun ({ data = (x, y); _ } : _ Event.canvas_event) ->
520513
match !mpos with
521514
| NoAction -> ()
@@ -527,9 +520,6 @@ let () =
527520
mpos := LightRot (x,y);
528521
rotate_light c (ox-x) (y-oy);
529522
draw_scene c)
530-
Event.mouse_move
531-
in
532-
533-
List.iter store [ev_resize; ev_regen; ev_mouse; ev_mousedown; ev_mouseup];
523+
Event.mouse_move;
534524

535525
Backend.run (fun () -> ())

‎src/ocamlCanvas.ml

+5
Original file line numberDiff line numberDiff line change
@@ -1078,6 +1078,10 @@ module V1 = struct
10781078
external key_of_int : int -> key
10791079
= "ml_canvas_key_of_int"
10801080

1081+
let held_events = ref []
1082+
1083+
let hold (e : unit React.event) = held_events := e::!held_events
1084+
10811085
end
10821086

10831087
module InternalEvent = struct
@@ -1184,6 +1188,7 @@ module V1 = struct
11841188
let run k =
11851189
let open InternalEvent in
11861190
let open Event in
1191+
let k () = held_events := []; k () in
11871192
let h e =
11881193
(match e with
11891194
| FrameCycle { timestamp } ->

‎src/ocamlCanvas.mli

+5
Original file line numberDiff line numberDiff line change
@@ -1498,6 +1498,11 @@ module V1 : sig
14981498
{ul
14991499
{- {!Invalid_argument} if [i] < 0 or [i] > 255}} *)
15001500

1501+
val hold : unit React.event -> unit
1502+
(** [hold e] ensures that effectful React event [e] won't be
1503+
collected early by the GC. In particular, in the case of the
1504+
Javascript backend where a global reference might not be
1505+
enough. *)
15011506

15021507
end
15031508

0 commit comments

Comments
 (0)