module UInputInterface where import Data.List import Control.Monad -- | Minimal waiting time. minWait = 700 :: Int -- | Synonyms for joystick button numbers. joystick_QUIT = 8 :: Int joystick_PREV = 4 :: Int joystick_NEXT = 5 :: Int data UInputEngine = UInputEngine { input_handleRunning :: InputHandler , input_waitForAnyKey :: IO UInput } -- | The state of user input. data UInput = UInput { dirkeys :: DirKeys -- ^ direction keys currently pressed down , quit :: Bool -- ^ quit? , axes :: (Double,Double) -- ^ joystick axes } -- | Abstract keys. data Key = KUp | KDown | KRight | KLeft | KQuit | KUnknown deriving (Show, Eq) -- | Direction (given by the keys). type DirKeys = (Double, Double) type InputHandler = UInput -> IO UInput hasQuit :: UInput -> Bool hasQuit = quit -- | Wait for any key; -- returns 'True' if "any key" was "quit" waitOrQuit :: IO UInput -> IO Bool waitOrQuit waitFAK = liftM quit waitFAK noInput = UInput { dirkeys = (0,0) , quit = False , axes = (0,0) } updateDirkeys :: (DirKeys -> DirKeys) -> UInput -> UInput updateDirkeys f ui = ui { dirkeys = f (dirkeys ui) } addKey :: Key -> UInput -> UInput addKey KUp = updateDirkeys (\ (x,y) -> (x,y-1)) addKey KDown = updateDirkeys (\ (x,y) -> (x,y+1)) addKey KLeft = updateDirkeys (\ (x,y) -> (x-1,y)) addKey KRight = updateDirkeys (\ (x,y) -> (x+1,y)) addKey KQuit = \ ui -> ui { quit = True } addKey _ = id removeKey :: Key -> UInput -> UInput removeKey KUp = addKey KDown removeKey KDown = addKey KUp removeKey KLeft = addKey KRight removeKey KRight = addKey KLeft removeKey _ = id