Fix event handling in demo

This commit is contained in:
Ollie Charles 2021-01-24 16:49:38 +00:00
parent bc4b74cfea
commit bfa31b53a2

20
Main.hs
View File

@ -30,7 +30,7 @@ main = do
loop :: Window -> IORef Bool -> IO ()
loop w checked = do
ev <- pollEventWithImGui
quit <- pollEvents
openGL2NewFrame
sdl2NewFrame w
@ -85,11 +85,21 @@ loop w checked = do
glSwapWindow w
if quit then return () else loop w checked
where
pollEvents = do
ev <- pollEventWithImGui
case ev of
Nothing -> loop w checked
Just Event{ eventPayload } -> case eventPayload of
QuitEvent -> return ()
_ -> loop w checked
Nothing -> return False
Just Event{ eventPayload } -> do
let isQuit = case eventPayload of
QuitEvent -> True
_ -> False
(isQuit ||) <$> pollEvents
whenTrue :: IO () -> Bool -> IO ()