revamped sdl level event handling code

This commit is contained in:
cqc
2021-09-22 18:34:15 -05:00
parent fe935c4e1f
commit eca8a055cf

73
main.ml
View File

@ -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 () =
(* create and fill event list *)
let ev = Sdl.Event.create () in
let el = ref [`None] in
while Sdl.wait_event_timeout (Some ev) 50 (* HACK *) do
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 handle_frame_events frame events =
List.iter
(fun (e : Event.t) ->
match e with
| `Quit -> frame.quit <- true
| `Fullscreen a ->
frame.fullscreen <- a ;
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 )
| _ -> () )
events
let display_frame frame actor =
let events =
(* create and fill event list *)
let convert_event ev =
match Event.event_of_sdlevent ev with
(* Handle relevant events *)
List.filter_map
(function
| `Quit ->
frame.quit <- true ;
None
| `Fullscreen a ->
if a then (
frame.fullscreen <- not frame.fullscreen ;
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 ) ) ;
None
| a -> Some a )
(get_events ()) in
| 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