63 lines
No EOL
1.8 KiB
Haskell
63 lines
No EOL
1.8 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
|
|
}
|
|
|
|
------------------------------ 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 _ _ _) = handleKey key
|
|
-- handle (EventMotion _) = undefined -- TODO
|
|
-- handle (EventResize _) = undefined -- TODO
|
|
handle _ = const (const id)
|
|
|
|
-- Handle a event by pressing a key
|
|
handleKey :: Key -> (a -> a) -> InputHandler a
|
|
handleKey (SpecialKey sk) = handleSpecialKey sk
|
|
handleKey (Char c ) = handleCharKey c
|
|
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 -> (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 |