module FRP.Helm.Keyboard ( shift, ctrl, enter, Key(..), space, arrows, wasd ) where import Control.Applicative import Data.List import Foreign hiding (shift) import Foreign.C.Types import FRP.Elerea.Simple import qualified Graphics.UI.SDL as SDL import qualified Graphics.UI.SDL.Utilities as Utilities -- The SDL bindings for Haskell don't wrap this, so we have to use the FFI ourselves. foreign import ccall unsafe "SDL_GetKeyState" sdlGetKeyState :: Ptr CInt -> IO (Ptr Word8) -- Based on http://coderepos.org/share/browser/lang/haskell/nario/Main.hs?rev=22646#L49 getKeyState :: IO [SDL.SDLKey] getKeyState = alloca $ \numkeysPtr -> do keysPtr <- sdlGetKeyState numkeysPtr numkeys <- peek numkeysPtr (map Utilities.toEnum . map fromIntegral . findIndices (== 1)) <$> peekArray (fromIntegral numkeys) keysPtr data Key = BackspaceKey | TabKey | ClearKey | EnterKey | PauseKey | EscapeKey | SpaceKey | ExclaimKey | QuotedBlKey | HashKey | DollarKey | AmpersandKey | QuoteKey | LeftParenKey | RightParenKey | AsteriskKey | PlusKey | CommaKey | MinusKey | PeriodKey | SlashKey | Num0Key | Num1Key | Num2Key | Num3Key | Num4Key | Num5Key | Num6Key | Num7Key | Num8Key | Num9Key | ColonKey | SemicolonKey | LessKey | EqualsKey | GreaterKey | QuestionKey | AtKey | LeftBracketKey | BackslashKey | RightBracketKey | CaretKey | UnderscoreKey | BackquoteKey | AKey | BKey | CKey | DKey | EKey | FKey | GKey | HKey | IKey | JKey | LKey | MKey | NKey | OKey | PKey | QKey | RKey | SKey | TKey | UKey | VKey | WKey | XKey | YKey | ZKey | DeleteKey | Keypad0Key | Keypad1Key | Keypad2Key | Keypad3Key | Keypad4Key | Keypad5Key | Keypad6Key | Keypad7Key | Keypad8Key | Keypad9Key | KeypadPeriodKey | KeypadDivideKey | KeypadMultiplyKey | KeypadMinusKey | KeypadPlusKey | KeypadEnterKey | KeypadEqualsKey | UpKey | DownKey | RightKey | LeftKey | InsertKey | HomeKey | EndKey | PageUpKey | PageDownKey | F1Key | F2Key | F3Key | F4Key | F5Key | F6Key | F7Key | F8Key | F9Key | F10Key | F11Key | F12Key | F13Key | F14Key | F15Key | NumLockKey | CapsLockKey | ScrollLockKey | RShiftKey | LShiftKey | RCtrlKey | LCtrlKey | RAltKey | LAltKey | RMetaKey | LMetaKey | RSuperKey | LSuperKey | ComposeKey | HelpKey | PrintKey | SysReqKey | BreakKey | MenuKey | PowerKey | EuroKey | UndoKey mapKey :: Key -> SDL.SDLKey mapKey k = case k of BackspaceKey -> SDL.SDLK_BACKSPACE TabKey -> SDL.SDLK_TAB ClearKey -> SDL.SDLK_CLEAR EnterKey -> SDL.SDLK_RETURN PauseKey -> SDL.SDLK_PAUSE EscapeKey -> SDL.SDLK_ESCAPE SpaceKey -> SDL.SDLK_SPACE ExclaimKey -> SDL.SDLK_EXCLAIM QuotedBlKey -> SDL.SDLK_QUOTEDBL HashKey -> SDL.SDLK_HASH DollarKey -> SDL.SDLK_DOLLAR AmpersandKey -> SDL.SDLK_AMPERSAND QuoteKey -> SDL.SDLK_QUOTE LeftParenKey -> SDL.SDLK_LEFTPAREN RightParenKey -> SDL.SDLK_RIGHTPAREN AsteriskKey -> SDL.SDLK_ASTERISK PlusKey -> SDL.SDLK_PLUS CommaKey -> SDL.SDLK_COMMA MinusKey -> SDL.SDLK_MINUS PeriodKey -> SDL.SDLK_PERIOD SlashKey -> SDL.SDLK_SLASH Num0Key -> SDL.SDLK_0 Num1Key -> SDL.SDLK_1 Num2Key -> SDL.SDLK_2 Num3Key -> SDL.SDLK_3 Num4Key -> SDL.SDLK_4 Num5Key -> SDL.SDLK_5 Num6Key -> SDL.SDLK_6 Num7Key -> SDL.SDLK_7 Num8Key -> SDL.SDLK_8 Num9Key -> SDL.SDLK_9 ColonKey -> SDL.SDLK_COLON SemicolonKey -> SDL.SDLK_SEMICOLON LessKey -> SDL.SDLK_LESS EqualsKey -> SDL.SDLK_EQUALS GreaterKey -> SDL.SDLK_GREATER QuestionKey -> SDL.SDLK_QUESTION AtKey -> SDL.SDLK_AT LeftBracketKey -> SDL.SDLK_LEFTBRACKET BackslashKey -> SDL.SDLK_BACKSLASH RightBracketKey -> SDL.SDLK_RIGHTBRACKET CaretKey -> SDL.SDLK_CARET UnderscoreKey -> SDL.SDLK_UNDERSCORE BackquoteKey -> SDL.SDLK_BACKQUOTE AKey -> SDL.SDLK_a BKey -> SDL.SDLK_b CKey -> SDL.SDLK_c DKey -> SDL.SDLK_d EKey -> SDL.SDLK_e FKey -> SDL.SDLK_f GKey -> SDL.SDLK_g HKey -> SDL.SDLK_h IKey -> SDL.SDLK_i JKey -> SDL.SDLK_j LKey -> SDL.SDLK_l MKey -> SDL.SDLK_m NKey -> SDL.SDLK_n OKey -> SDL.SDLK_o PKey -> SDL.SDLK_p QKey -> SDL.SDLK_q RKey -> SDL.SDLK_r SKey -> SDL.SDLK_s TKey -> SDL.SDLK_t UKey -> SDL.SDLK_u VKey -> SDL.SDLK_v WKey -> SDL.SDLK_w XKey -> SDL.SDLK_x YKey -> SDL.SDLK_y ZKey -> SDL.SDLK_z DeleteKey -> SDL.SDLK_DELETE Keypad0Key -> SDL.SDLK_KP0 Keypad1Key -> SDL.SDLK_KP1 Keypad2Key -> SDL.SDLK_KP2 Keypad3Key -> SDL.SDLK_KP3 Keypad4Key -> SDL.SDLK_KP4 Keypad5Key -> SDL.SDLK_KP5 Keypad6Key -> SDL.SDLK_KP6 Keypad7Key -> SDL.SDLK_KP7 Keypad8Key -> SDL.SDLK_KP8 Keypad9Key -> SDL.SDLK_KP9 KeypadPeriodKey -> SDL.SDLK_KP_PERIOD KeypadDivideKey -> SDL.SDLK_KP_DIVIDE KeypadMultiplyKey -> SDL.SDLK_KP_MULTIPLY KeypadMinusKey -> SDL.SDLK_KP_MINUS KeypadPlusKey -> SDL.SDLK_KP_PLUS KeypadEnterKey -> SDL.SDLK_KP_ENTER KeypadEqualsKey -> SDL.SDLK_KP_EQUALS UpKey -> SDL.SDLK_UP DownKey -> SDL.SDLK_DOWN RightKey -> SDL.SDLK_RIGHT LeftKey -> SDL.SDLK_LEFT InsertKey -> SDL.SDLK_INSERT HomeKey -> SDL.SDLK_HOME EndKey -> SDL.SDLK_END PageUpKey -> SDL.SDLK_PAGEUP PageDownKey -> SDL.SDLK_PAGEDOWN F1Key -> SDL.SDLK_F1 F2Key -> SDL.SDLK_F2 F3Key -> SDL.SDLK_F3 F4Key -> SDL.SDLK_F4 F5Key -> SDL.SDLK_F5 F6Key -> SDL.SDLK_F6 F7Key -> SDL.SDLK_F7 F8Key -> SDL.SDLK_F8 F9Key -> SDL.SDLK_F9 F10Key -> SDL.SDLK_F10 F11Key -> SDL.SDLK_F11 F12Key -> SDL.SDLK_F12 F13Key -> SDL.SDLK_F13 F14Key -> SDL.SDLK_F14 F15Key -> SDL.SDLK_F15 NumLockKey -> SDL.SDLK_NUMLOCK CapsLockKey -> SDL.SDLK_CAPSLOCK ScrollLockKey -> SDL.SDLK_SCROLLOCK RShiftKey -> SDL.SDLK_RSHIFT LShiftKey -> SDL.SDLK_LSHIFT RCtrlKey -> SDL.SDLK_RCTRL LCtrlKey -> SDL.SDLK_LCTRL RAltKey -> SDL.SDLK_RALT LAltKey -> SDL.SDLK_LALT RMetaKey -> SDL.SDLK_RMETA LMetaKey -> SDL.SDLK_LMETA RSuperKey -> SDL.SDLK_RSUPER LSuperKey -> SDL.SDLK_LSUPER ComposeKey -> SDL.SDLK_COMPOSE HelpKey -> SDL.SDLK_HELP PrintKey -> SDL.SDLK_PRINT SysReqKey -> SDL.SDLK_SYSREQ BreakKey -> SDL.SDLK_BREAK MenuKey -> SDL.SDLK_MENU PowerKey -> SDL.SDLK_POWER EuroKey -> SDL.SDLK_EURO UndoKey -> SDL.SDLK_UNDO -- |Whether either shift key is pressed. shift :: SignalGen (Signal Bool) shift = effectful $ (elem SDL.KeyModShift) <$> SDL.getModState -- |Whether either control key is pressed. ctrl :: SignalGen (Signal Bool) ctrl = effectful $ (elem SDL.KeyModCtrl) <$> SDL.getModState -- |Whether a specific key is pressed. isDown :: Key -> SignalGen (Signal Bool) isDown k = effectful $ (elem (mapKey k)) <$> getKeyState -- |Whether the shift key is pressed. enter :: SignalGen (Signal Bool) enter = isDown EnterKey -- |Whether the space key is pressed. space :: SignalGen (Signal Bool) space = isDown SpaceKey {- TODO: keysDown :: SignalGen (Signal [Key]) -} {-| A unit vector combined from the arrow keys. When no keys are being pressed this signal samples to (0, 0), otherwise it samples to a specific direction based on which keys are pressed. For example, pressing the left key results in (-1, 0), the down key (0, 1), etc. -} arrows :: SignalGen (Signal (Int, Int)) arrows = do up <- isDown UpKey left <- isDown LeftKey down <- isDown DownKey right <- isDown RightKey return $ arrows' <$> up <*> left <*> down <*> right arrows' :: Bool -> Bool -> Bool -> Bool -> (Int, Int) arrows' u l d r = (-1 * fromEnum l + 1 * fromEnum r, -1 * fromEnum u + 1 * fromEnum d) -- |Similar to the 'arrows' signal, but uses the W, A, S and D keys instead. wasd :: SignalGen (Signal (Int, Int)) wasd = do w <- isDown WKey a <- isDown AKey s <- isDown SKey d <- isDown DKey return $ arrows' <$> w <*> a <*> s <*> d