diff --git a/lib/control/Input.hs b/lib/control/Input.hs index e13b523..30c6a6b 100644 --- a/lib/control/Input.hs +++ b/lib/control/Input.hs @@ -13,8 +13,12 @@ import Graphics.Gloss.Interface.IO.Game ---------------------------------------------------------------------- handleAllInput :: InputHandler Game -handleAllInput = composeInputHandlers [ - handleSpecialKey KeySpace setNextState +handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g +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 diff --git a/lib/control/InputHandling.hs b/lib/control/InputHandling.hs index 86704e4..1b4db4a 100644 --- a/lib/control/InputHandling.hs +++ b/lib/control/InputHandling.hs @@ -7,8 +7,12 @@ module InputHandling -- all of them. composeInputHandlers, -handle, -handleSpecialKey +-- Handle any event +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 (SpecialKey key) = handleSpecialKey key -handleKey (Char _ ) = (\_ -> (\_ -> id)) -handleKey (MouseButton _ ) = (\_ -> (\_ -> id)) +handleKey :: Key -> (a -> a) -> InputHandler a +handleKey (SpecialKey sk) = handleSpecialKey sk +handleKey (Char c ) = handleCharKey c +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