#15 Input handling made modular

lib/control/Input.hs

@@ -13,8 +13,12 @@ import Graphics.Gloss.Interface.IO.Game
 ----------------------------------------------------------------------
 
 handleAllInput :: InputHandler Game
-handleAllInput = composeInputHandlers [
+handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g
-    handleSpecialKey KeySpace setNextState
+handleAllInput ev g                         = handleAnyKey setNextState ev g
+
+handlePlayInputs :: InputHandler Game
+handlePlayInputs = composeInputHandlers [
+    handleKey (Char 'p') (\game -> game{ state = Pause })
     ]
 
 -- Go to the next stage of the Game

lib/control/InputHandling.hs

@@ -7,8 +7,12 @@ module InputHandling
 -- all of them.
 composeInputHandlers,
 
-handle, 
+-- Handle any event
-handleSpecialKey
+handle,
+-- Handle a event by pressing a key
+handleKey,
+-- Handle any key, equivalent to "Press any key to start"
+handleAnyKey
 ) where
 
 import Graphics.Gloss.Interface.IO.Game
@@ -23,19 +27,29 @@ composeInputHandlers :: [InputHandler a] -> InputHandler a
 composeInputHandlers []       ev a = a
 composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
 
-handle :: Event -> (a -> a) -> Event -> (a -> a)
+handle :: Event -> (a -> a) -> InputHandler a
 handle (EventKey key _ _ _) = handleKey key
 -- handle (EventMotion _)      = undefined
 -- handle (EventResize _)      = undefined
 handle _                    = (\_ -> (\_ -> id))
 
-handleKey :: Key -> (a -> a) -> Event -> (a -> a)
+handleKey :: Key -> (a -> a) -> InputHandler a
-handleKey (SpecialKey  key) = handleSpecialKey key
+handleKey (SpecialKey  sk) = handleSpecialKey sk
-handleKey (Char        _  ) = (\_ -> (\_ -> id))
+handleKey (Char        c ) = handleCharKey c
-handleKey (MouseButton _  ) = (\_ -> (\_ -> id))
+handleKey (MouseButton _ ) = (\_ -> (\_ -> id))
 
-handleSpecialKey :: SpecialKey -> (a -> a) -> Event -> (a -> a)
+handleCharKey :: Char -> (a -> a) -> InputHandler a
+handleCharKey c1 f (EventKey (Char c2) Down _ _)
+    | c1 == c2  = f
+    | otherwise = id
+handleCharKey _  _ _ = id
+
+handleSpecialKey :: SpecialKey -> (a -> a) -> InputHandler a
 handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
     | sk1 == sk2 = f
     | otherwise  = id
 handleSpecialKey _   _ _ = id
+
+handleAnyKey :: (a -> a) -> InputHandler a
+handleAnyKey f (EventKey _ Down _ _) = f
+handleAnyKey _ _                     = id