63 lines
No EOL
2 KiB
Haskell
63 lines
No EOL
2 KiB
Haskell
module RPGEngine.Input.Core
|
|
( InputHandler
|
|
, ListSelector(..)
|
|
|
|
, composeInputHandlers
|
|
, handle
|
|
, handleKey
|
|
, handleAnyKey
|
|
|
|
, SpecialKey(..)
|
|
) where
|
|
|
|
import Graphics.Gloss.Interface.Pure.Game
|
|
( Event(EventKey), Key(..), KeyState(Down), SpecialKey )
|
|
|
|
----------------------------- Constants ------------------------------
|
|
|
|
type InputHandler a = Event -> (a -> a)
|
|
|
|
data ListSelector = ListSelector {
|
|
selection :: Int,
|
|
selected :: Bool
|
|
} deriving (Eq, Show)
|
|
|
|
------------------------------ Exported ------------------------------
|
|
|
|
-- Compose multiple InputHandlers into one InputHandler that handles
|
|
-- all of them.
|
|
composeInputHandlers :: [InputHandler a] -> InputHandler a
|
|
composeInputHandlers [] ev a = a
|
|
composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
|
|
|
|
-- Handle any event
|
|
handle :: Event -> (a -> a) -> InputHandler a
|
|
handle (EventKey key state _ _) = handleKey key state
|
|
-- handle (EventMotion _) = undefined -- TODO
|
|
-- handle (EventResize _) = undefined -- TODO
|
|
handle _ = const (const id)
|
|
|
|
-- Handle a event by pressing a key
|
|
handleKey :: Key -> KeyState -> (a -> a) -> InputHandler a
|
|
handleKey (SpecialKey sk) s = handleSpecialKey sk s
|
|
handleKey (Char c ) s = handleCharKey c s
|
|
handleKey (MouseButton _ ) _ = const (const id)
|
|
|
|
-- Handle any key, equivalent to "Press any key to start"
|
|
handleAnyKey :: (a -> a) -> InputHandler a
|
|
handleAnyKey f (EventKey _ Down _ _) = f
|
|
handleAnyKey _ _ = id
|
|
|
|
--------------------------- Help functions ---------------------------
|
|
|
|
handleCharKey :: Char -> KeyState -> (a -> a) -> InputHandler a
|
|
handleCharKey c1 s1 f (EventKey (Char c2) s2 _ _)
|
|
| c1 == c2 && s1 == s2 = f
|
|
| otherwise = id
|
|
handleCharKey _ _ _ _ = id
|
|
|
|
handleSpecialKey :: SpecialKey -> KeyState -> (a -> a) -> InputHandler a
|
|
handleSpecialKey sk1 s1 f (EventKey (SpecialKey sk2) s2 _ _)
|
|
| sk1 == sk2 && s1 == s2 = f
|
|
| otherwise = id
|
|
handleSpecialKey _ _ _ _ = id |