some more keyboard interaction

This commit is contained in:
nek0 2018-09-18 05:35:40 +02:00
parent aed0732d3e
commit 7aa691bf87
1 changed files with 14 additions and 0 deletions

View File

@ -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