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