Effectful events holding function (#154)

* add event holding function * update examples
OCamlPro · Jun 26, 2024 · 5669d57 · 5669d57
1 parent 4c4968d
commit 5669d57
Show file tree

Hide file tree

Showing 6 changed files with 52 additions and 75 deletions.
diff --git a/examples/demo5.ml b/examples/demo5.ml
@@ -12,22 +12,17 @@ let () =
 
   Canvas.show c;
 
-  let e1 =
-    React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
+    Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
         Backend.stop ()
-      ) Event.close
-  in
+      ) Event.close;
 
-  let e2 =
-    React.E.map (fun { Event.canvas = _; timestamp = _;
+    Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
                        data = { Event.key; char = _; flags = _ } } ->
         if key = KeyEscape then
           Backend.stop ()
-      ) Event.key_down
-  in
+      ) Event.key_down;
 
-  let e3 =
-    React.E.map (fun { Event.canvas = _; timestamp = t; data = () } ->
+    Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = t; data = () } ->
         let theta, last = !state in
 
         let theta = theta +. (Int64.to_float (Int64.sub t last)) *. -0.000005 in
@@ -52,7 +47,6 @@ let () =
         Canvas.restore c;
 
         state := (theta, t)
-      ) Event.frame
-  in
+      ) Event.frame;
 
-  Backend.run (fun () -> ignore e1; ignore e2; ignore e3)
+  Backend.run (fun () -> ())
diff --git a/examples/demo6.ml b/examples/demo6.ml
@@ -13,22 +13,17 @@ let () =
 
   Canvas.show c;
 
-  let e1 =
-    React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
         Backend.stop ()
-      ) Event.close
-  in
+      ) Event.close;
 
-  let e2 =
-    React.E.map (fun { Event.canvas = _; timestamp = _;
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
                        data = { Event.key; char = _; flags = _ } } ->
         if key = KeyEscape then
           Backend.stop ()
-      ) Event.key_down
-  in
+      ) Event.key_down;
 
-  let e3 =
-    React.E.map (fun { Event.canvas = _; timestamp = _;
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
                        data = { Event.position; button } } ->
         let color =
           match button with
@@ -45,13 +40,10 @@ let () =
         Canvas.arc c ~center ~radius:10.0 ~theta1:0.0
           ~theta2:(2.0 *. Const.pi) ~ccw:false;
         Canvas.fill c ~nonzero:false;
-      ) Event.button_down
-  in
+      ) Event.button_down;
 
-  let e4 =
-    React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
         ()
-      ) Event.frame
-  in
+      ) Event.frame;
 
-  Backend.run (fun () -> ignore e1; ignore e2; ignore e3; ignore e4)
+  Backend.run (fun () -> ())
diff --git a/examples/saucisse.ml b/examples/saucisse.ml
@@ -266,41 +266,36 @@ let draw () =
   Canvas.show c
 
 let () =
-  draw ()
+  draw ();
 
-let e_move =
-  React.E.map (fun { Event.canvas = _; timestamp = _; data = (x, y) } ->
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = (x, y) } ->
       p3 := (float_of_int x, float_of_int y)
-    ) Event.mouse_move
+    ) Event.mouse_move;
 
-let e1 =
-  React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; data = () } ->
       Backend.stop ()
-    ) Event.close
+    ) Event.close;
 
-let e2 =
-  React.E.map (fun { Event.canvas = _; timestamp = _;
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
                      data = { Event.key; char = _; flags = _ }; _ } ->
                 if key = KeyEscape then
                   Backend.stop ()
-              ) Event.key_down
+              ) Event.key_down;
 
-let e3 =
-  React.E.map (fun { Event.canvas = _; timestamp = _;
+  Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _;
                      data = { Event.position = (x, y); _ } } ->
                 point (float_of_int x, float_of_int y);
               ) Event.button_down
 
 let frames = ref 0L
-
-let e_frame =
-  React.E.map (fun { Event.canvas = _; timestamp = _; _ } ->
-      Canvas.setFillColor c Color.white;
-      Canvas.fillRect c ~pos:(0.0, 0.0) ~size:(float_of_int sw, float_of_int sh);
-
-      draw ();
-      frames := Int64.add !frames Int64.one
-    ) Event.frame
+
+let () = Event.hold @@ React.E.map (fun { Event.canvas = _; timestamp = _; _ } ->
+    Canvas.setFillColor c Color.white;
+    Canvas.fillRect c ~pos:(0.0, 0.0) ~size:(float_of_int sw, float_of_int sh);
+
+    draw ();
+    frames := Int64.add !frames Int64.one
+  ) Event.frame
 
 let () =
   if Array.length Sys.argv >= 2 && Sys.argv.(1) = "bench" then
@@ -309,9 +304,5 @@ let () =
     done
   else
     Backend.run (fun () ->
-        ignore (Sys.opaque_identity e_frame);
-        ignore (Sys.opaque_identity e_move);
-        ignore (Sys.opaque_identity (e1, e2));
-        ignore (Sys.opaque_identity (e3));
         Printf.printf "\nDisplayed %Ld frames. Goodbye !\n" !frames)
 
diff --git a/examples/suncities.ml b/examples/suncities.ml
@@ -463,9 +463,6 @@ let rotate_light c x _y =
   scene := { !scene with sun_angle_xy; sun_angle_z };
   regen_shadows ()
 
-let stored_ev = ref []
-
-let store ev = stored_ev := ev::!stored_ev
 
 type maction =
   | NoAction
@@ -485,37 +482,33 @@ let () =
   draw_scene c;
   Canvas.show c;
 
-  let ev_regen = React.E.map
+  Event.hold @@ React.E.map
     (fun ({ data = { Event.key; char = _; flags = _ }; _ } : _ Event.canvas_event) ->
       if key = KeySpacebar then
         (regen (); draw_scene c)
-    ) Event.key_down
-  in
+    ) Event.key_down;
 
-  let ev_resize = React.E.map
+  Event.hold @@ React.E.map
     (fun ({ data = size; _ } : _ Event.canvas_event) ->
      (Canvas.setSize c size; compute_projection c; draw_scene c)
-    ) Event.resize
-  in
+    ) Event.resize;
 
   let mpos = ref NoAction in
 
-  let ev_mousedown = React.E.map
+  Event.hold @@ React.E.map
     (fun ({ data = { position = (x,y); button }; _ } : Event.button_data Event.canvas_event) ->
       match button with
       | ButtonLeft -> mpos := ViewRot (x,y)
       | ButtonRight -> mpos := LightRot (x,y)
       | _ -> ()
-    ) Event.button_down
-  in
+    ) Event.button_down;
 
-  let ev_mouseup = React.E.map
+  Event.hold @@ React.E.map
     (fun ({ data = { button = _; _ }; _ } : Event.button_data Event.canvas_event) ->
       mpos := NoAction
-    ) Event.button_up
-  in
+    ) Event.button_up;
 
-  let ev_mouse = React.E.map
+  Event.hold @@ React.E.map
     (fun ({ data = (x, y); _ } : _ Event.canvas_event) ->
       match !mpos with
       | NoAction -> ()
@@ -527,9 +520,6 @@ let () =
         mpos := LightRot (x,y);
         rotate_light c (ox-x) (y-oy);
         draw_scene c)
-    Event.mouse_move
-  in
-
-  List.iter store [ev_resize; ev_regen; ev_mouse; ev_mousedown; ev_mouseup];
+    Event.mouse_move;
 
   Backend.run (fun () -> ())
diff --git a/src/ocamlCanvas.ml b/src/ocamlCanvas.ml
@@ -1078,6 +1078,10 @@ module V1 = struct
     external key_of_int : int -> key
       = "ml_canvas_key_of_int"
 
+    let held_events = ref []
+
+    let hold (e : unit React.event) = held_events := e::!held_events
+
   end
 
   module InternalEvent = struct
@@ -1184,6 +1188,7 @@ module V1 = struct
     let run k =
       let open InternalEvent in
       let open Event in
+      let k () = held_events := []; k () in
       let h e =
         (match e with
         | FrameCycle { timestamp } ->

diff --git a/src/ocamlCanvas.mli b/src/ocamlCanvas.mli
@@ -1498,6 +1498,11 @@ module V1 : sig
         {ul
         {- {!Invalid_argument} if [i] < 0 or [i] > 255}} *)
 
+    val hold : unit React.event -> unit
+    (** [hold e] ensures that effectful React event [e] won't be
+        collected early by the GC. In particular, in the case of the
+        Javascript backend where a global reference might not be
+        enough. *)
 
   end