Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Effectful events holding function #154

Merged
merged 2 commits into from
Jun 26, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 7 additions & 13 deletions examples/demo5.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 () -> ())
26 changes: 9 additions & 17 deletions examples/demo6.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 () -> ())
41 changes: 16 additions & 25 deletions examples/saucisse.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)

30 changes: 10 additions & 20 deletions examples/suncities.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 -> ()
Expand All @@ -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 () -> ())
5 changes: 5 additions & 0 deletions src/ocamlCanvas.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 } ->
Expand Down
5 changes: 5 additions & 0 deletions src/ocamlCanvas.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
Loading