From 7aa691bf87e83f82c2d05a636f44ab1d24f92c78 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Tue, 18 Sep 2018 05:35:40 +0200
Subject: [PATCH] some more keyboard interaction

---
 src/Main.hs | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

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