revamped sdl level event handling code

main.ml

@@ -426,6 +426,7 @@ module Display = struct
     { sdl_win: Sdl.window
     ; gl: Sdl.gl_context
     ; wall: Wall.renderer
+    ; mutable last_pane: pane
     ; mutable quit: bool
     ; mutable fullscreen: bool }
 
@@ -453,48 +454,50 @@ module Display = struct
       let wall =
         Wall.Renderer.create ~antialias:true ~stencil_strokes:true ()
       in
-      Ok {sdl_win; gl; wall; quit= false; fullscreen= false} )
+      Ok
+        { sdl_win
+        ; gl
+        ; wall
+        ; quit= false
+        ; fullscreen= false
+        ; last_pane= pane_empty } )
       ~cleanup:(fun () -> Sdl.destroy_window sdl_win)
 
-  let get_events () =
+  let handle_frame_events frame events =
-    (* create and fill event list *)
+    List.iter
-    let ev = Sdl.Event.create () in
+      (fun (e : Event.t) ->
-    let el = ref [`None] in
+        match e with
-    while Sdl.wait_event_timeout (Some ev) 50 (* HACK *) do
+        | `Quit -> frame.quit <- true
-      let e = Event.event_of_sdlevent ev in
-      if e != `None then el := !el @ [e]
-      (* HACK? *)
-    done ;
-    !el
-
-  let last_pane = ref pane_empty
-
-  let display_frame frame actor =
-    let events =
-      (* Handle relevant events *)
-      List.filter_map
-        (function
-          | `Quit ->
-              frame.quit <- true ;
-              None
         | `Fullscreen a ->
-              if a then (
+            frame.fullscreen <- a ;
-                frame.fullscreen <- not frame.fullscreen ;
+            ignore (Sdl.show_cursor (not frame.fullscreen) : _ result) ;
-                ignore
-                  (Sdl.show_cursor (not frame.fullscreen) : _ result) ;
             ignore
               ( Sdl.set_window_fullscreen frame.sdl_win
                   ( if frame.fullscreen then
                     Sdl.Window.fullscreen_desktop
                   else Sdl.Window.windowed )
-                    : _ result ) ) ;
+                : _ result )
-              None
+        | _ -> () )
-          | a -> Some a )
+      events
-        (get_events ()) in
+
+  let display_frame frame actor =
+    (* create and fill event list *)
+    let convert_event ev =
+      match Event.event_of_sdlevent ev with
+      (* Handle relevant events *)
+      | a -> a in
+    let ev = Sdl.Event.create () in
+    let events : Event.t list ref = ref [] in
+    if Sdl.wait_event_timeout (Some ev) 100 then (
+      events := !events @ [convert_event ev] ;
+      while Sdl.wait_event_timeout (Some ev) 1 do
+        events := !events @ [convert_event ev]
+      done ) ;
+    handle_frame_events frame !events ;
     let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
-    if List.length events > 0 then last_pane := actor events ;
+    if List.length !events > 0 then frame.last_pane <- actor !events ;
     let _, (_, image) =
-      !last_pane
+      frame.last_pane
         { box= Box2.v (P2.v 0. 0.) (P2.v (float width) (float height))
         ; time= ticks ()
         ; wall= frame.wall } in