From 9cc101b83efc9d71712d57067811a2053e2beeee Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Wed, 26 Jun 2024 16:11:16 +0200 Subject: [PATCH 1/2] add event holding function --- src/ocamlCanvas.ml | 5 +++++ src/ocamlCanvas.mli | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/src/ocamlCanvas.ml b/src/ocamlCanvas.ml index 023e905..381f500 100644 --- 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 index 14dff78..d482943 100644 --- 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 From b4fab478ab0d2d97170639315a25aae194c279b2 Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Wed, 26 Jun 2024 16:10:14 +0200 Subject: [PATCH 2/2] update examples --- examples/demo5.ml | 20 +++++++------------- examples/demo6.ml | 26 +++++++++----------------- examples/saucisse.ml | 41 ++++++++++++++++------------------------- examples/suncities.ml | 30 ++++++++++-------------------- 4 files changed, 42 insertions(+), 75 deletions(-) diff --git a/examples/demo5.ml b/examples/demo5.ml index 2c15fa3..41ce4a0 100644 --- 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 index d28ee90..4816b53 100644 --- 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 index a11f4db..842ab6d 100644 --- 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 index 0f779f0..8c0dad5 100644 --- 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 () -> ())