diff --git a/src/Main.hs b/src/Main.hs index 12debe4..69f373f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -57,6 +57,8 @@ pre = do let Subsystems w m k = subsystems ud _ <- partSubscribe w (fitViewport (1280/720)) _ <- partSubscribe w exitOnWindowClose + _ <- partSubscribe k toggleFullScreen + _ <- partSubscribe k quitGame (ws, _) <- yieldSystemT (0, defStorage) (return ()) putAffection ud { threadContext = Just threadCtx @@ -64,6 +66,18 @@ pre = do , worldState = ws } +quitGame :: KeyboardMessage -> Affection UserData () +quitGame (MsgKeyboardEvent _ _ SDL.Pressed False sym) + | SDL.keysymKeycode sym == SDL.KeycodeEscape = quit + | otherwise = return () +quitGame _ = return () + +toggleFullScreen :: KeyboardMessage -> Affection UserData () +toggleFullScreen (MsgKeyboardEvent _ _ SDL.Pressed False sym) + | SDL.keysymKeycode sym == SDL.KeycodeF11 = toggleScreen + | otherwise = return () +toggleFullScreen _ = return () + update :: Double -> Affection UserData () update dt = do ud <- getAffection