module Graphics.UI.SDL.Events
( Event (..)
, SDLEvent (..)
, UserEventID (..)
, MouseButton (..)
, Focus(..)
, toSafePtr
, tryFromSafePtr
, fromSafePtr
, typeOfSafePtr
, enableKeyRepeat
, enableUnicode
, queryUnicodeState
, getKeyName
, getMouseState
, getRelativeMouseState
, getModState
, setModState
, tryPushEvent
, pushEvent
, pollEvent
, waitEvent
, waitEventBlocking
, pumpEvents
, enableEvent
, queryEventState
, getAppState
) where
import Foreign (Int16, Word8, Word16, Word32, Ptr,
Storable(poke, sizeOf, alignment, peekByteOff, pokeByteOff, peek),
unsafePerformIO, toBool, new, alloca)
import Foreign.C (peekCString, CString)
import Data.Bits (Bits((.&.), shiftL))
import Control.Concurrent (threadDelay)
import Prelude hiding (Enum(..))
import qualified Prelude (Enum(..))
import Foreign.StablePtr (newStablePtr,castStablePtrToPtr,castPtrToStablePtr,deRefStablePtr)
import Data.Typeable (Typeable(typeOf),TypeRep)
import Graphics.UI.SDL.Keysym (SDLKey, Modifier, Keysym)
import Graphics.UI.SDL.Utilities (Enum(..), intToBool, toBitmask, fromBitmask)
import Graphics.UI.SDL.General (unwrapBool, failWithError)
import Graphics.UI.SDL.Video (Toggle(..), fromToggle)
data SDLEvent = SDLNoEvent
| SDLActiveEvent
| SDLKeyDown
| SDLKeyUp
| SDLMouseMotion
| SDLMouseButtonDown
| SDLMouseButtonUp
| SDLJoyAxisMotion
| SDLJoyBallMotion
| SDLJoyHatMotion
| SDLJoyButtonDown
| SDLJoyButtonUp
| SDLQuit
| SDLSysWMEvent
| SDLVideoResize
| SDLVideoExpose
| SDLUserEvent Word8
| SDLNumEvents
deriving (Eq, Ord, Show)
instance Bounded SDLEvent where
minBound = SDLNoEvent
maxBound = SDLNumEvents
fromSDLEvent :: SDLEvent -> Word8
fromSDLEvent SDLNoEvent = 0
fromSDLEvent SDLActiveEvent = 1
fromSDLEvent SDLKeyDown = 2
fromSDLEvent SDLKeyUp = 3
fromSDLEvent SDLMouseMotion = 4
fromSDLEvent SDLMouseButtonDown = 5
fromSDLEvent SDLMouseButtonUp = 6
fromSDLEvent SDLJoyAxisMotion = 7
fromSDLEvent SDLJoyBallMotion = 8
fromSDLEvent SDLJoyHatMotion = 9
fromSDLEvent SDLJoyButtonDown = 10
fromSDLEvent SDLJoyButtonUp = 11
fromSDLEvent SDLQuit = 12
fromSDLEvent SDLSysWMEvent = 13
fromSDLEvent SDLVideoResize = 16
fromSDLEvent SDLVideoExpose = 17
fromSDLEvent (SDLUserEvent n) = 24 + n
fromSDLEvent SDLNumEvents = 32
toSDLEvent :: Word8 -> SDLEvent
toSDLEvent 0 = SDLNoEvent
toSDLEvent 1 = SDLActiveEvent
toSDLEvent 2 = SDLKeyDown
toSDLEvent 3 = SDLKeyUp
toSDLEvent 4 = SDLMouseMotion
toSDLEvent 5 = SDLMouseButtonDown
toSDLEvent 6 = SDLMouseButtonUp
toSDLEvent 7 = SDLJoyAxisMotion
toSDLEvent 8 = SDLJoyBallMotion
toSDLEvent 9 = SDLJoyHatMotion
toSDLEvent 10 = SDLJoyButtonDown
toSDLEvent 11 = SDLJoyButtonUp
toSDLEvent 12 = SDLQuit
toSDLEvent 13 = SDLSysWMEvent
toSDLEvent 16 = SDLVideoResize
toSDLEvent 17 = SDLVideoExpose
toSDLEvent n
| n >= 24 &&
n < 32 = SDLUserEvent (n 24)
toSDLEvent _ = error "Graphics.UI.SDL.Events.toSDLEvent: bad argument"
data Event
= NoEvent
| GotFocus [Focus]
| LostFocus [Focus]
| KeyDown !Keysym
| KeyUp !Keysym
| MouseMotion !Word16 !Word16 !Int16 !Int16
| MouseButtonDown !Word16
!Word16
!MouseButton
| MouseButtonUp !Word16
!Word16
!MouseButton
| JoyAxisMotion !Word8 !Word8 !Int16
| JoyBallMotion !Word8 !Word8 !Int16 !Int16
| JoyHatMotion !Word8 !Word8 !Word8
| JoyButtonDown !Word8 !Word8
| JoyButtonUp !Word8 !Word8
| VideoResize !Int !Int
| VideoExpose
| Quit
| User !UserEventID !Int !(Ptr ()) !(Ptr ())
| Unknown
deriving (Show,Eq)
data MouseButton
= ButtonLeft
| ButtonMiddle
| ButtonRight
| ButtonWheelUp
| ButtonWheelDown
deriving (Show,Eq,Ord)
instance Enum MouseButton Word8 where
toEnum 1 = ButtonLeft
toEnum 2 = ButtonMiddle
toEnum 3 = ButtonRight
toEnum 4 = ButtonWheelUp
toEnum 5 = ButtonWheelDown
toEnum _ = error "Graphics.UI.SDL.Events.toEnum: bad argument"
fromEnum ButtonLeft = 1
fromEnum ButtonMiddle = 2
fromEnum ButtonRight = 3
fromEnum ButtonWheelUp = 4
fromEnum ButtonWheelDown = 5
succ ButtonLeft = ButtonMiddle
succ ButtonMiddle = ButtonRight
succ ButtonRight = ButtonWheelUp
succ ButtonWheelUp = ButtonWheelDown
succ _ = error "Graphics.UI.SDL.Events.succ: bad argument"
pred ButtonMiddle = ButtonLeft
pred ButtonRight = ButtonMiddle
pred ButtonWheelUp = ButtonRight
pred ButtonWheelDown = ButtonWheelUp
pred _ = error "Graphics.UI.SDL.Events.pred: bad argument"
enumFromTo x y | x > y = []
| x == y = [y]
| True = x : enumFromTo (succ x) y
data Focus
= MouseFocus
| InputFocus
| ApplicationFocus
deriving (Show,Eq,Ord)
instance Bounded Focus where
minBound = MouseFocus
maxBound = ApplicationFocus
instance Enum Focus Word8 where
fromEnum MouseFocus = 1
fromEnum InputFocus = 2
fromEnum ApplicationFocus = 4
toEnum 1 = MouseFocus
toEnum 2 = InputFocus
toEnum 4 = ApplicationFocus
toEnum _ = error "Graphics.UI.SDL.Events.toEnum: bad argument"
succ MouseFocus = InputFocus
succ InputFocus = ApplicationFocus
succ _ = error "Graphics.UI.SDL.Events.succ: bad argument"
pred InputFocus = MouseFocus
pred ApplicationFocus = InputFocus
pred _ = error "Graphics.UI.SDL.Events.pred: bad argument"
enumFromTo x y | x > y = []
| x == y = [y]
| True = x : enumFromTo (succ x) y
data UserEventID
= UID0 | UID1 | UID2 | UID3 | UID4 | UID5 | UID6 | UID7
deriving (Show,Eq,Prelude.Enum)
type SafePtr = Ptr ()
toSafePtr :: (Typeable a) => a -> IO SafePtr
toSafePtr val
= do stablePtr <- newStablePtr (typeOf val,val)
return (castStablePtrToPtr stablePtr)
typeOfSafePtr :: SafePtr -> IO TypeRep
typeOfSafePtr ptr
= fmap fst (deRefStablePtr (castPtrToStablePtr ptr))
tryFromSafePtr :: (Typeable a) => SafePtr -> IO (Maybe a)
tryFromSafePtr ptr
= do (ty,val) <- deRefStablePtr (castPtrToStablePtr ptr)
if ty == typeOf val
then return (Just val)
else return Nothing
fromSafePtr :: (Typeable a) => SafePtr -> IO a
fromSafePtr ptr
= do ret <- tryFromSafePtr ptr
case ret of
Nothing -> error "Graphics.UI.SDL.Events.fromSafePtr: invalid type."
Just a -> return a
toEventType :: UserEventID -> Word8
toEventType eid = fromIntegral (Prelude.fromEnum eid)
fromEventType :: Word8 -> UserEventID
fromEventType etype = Prelude.toEnum (fromIntegral etype)
peekActiveEvent :: Ptr Event -> IO Event
peekActiveEvent ptr
= do gain <- fmap toBool (((\hsc_ptr -> peekByteOff hsc_ptr 1) ptr) :: IO Word8)
state <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr :: IO Word8
return $! (if gain then GotFocus else LostFocus) (fromBitmask state)
peekKey :: (Keysym -> Event) -> Ptr Event -> IO Event
peekKey mkEvent ptr
= do keysym <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
return $! mkEvent keysym
peekMouseMotion :: Ptr Event -> IO Event
peekMouseMotion ptr
= do x <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
y <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
xrel <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
yrel <- (\hsc_ptr -> peekByteOff hsc_ptr 10) ptr
return $! MouseMotion x y xrel yrel
peekMouse :: (Word16 -> Word16 -> MouseButton -> Event) -> Ptr Event -> IO Event
peekMouse mkEvent ptr
= do b <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
x <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
y <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
return $! mkEvent x y (toEnum (b::Word8))
peekJoyAxisMotion :: Ptr Event -> IO Event
peekJoyAxisMotion ptr
= do which <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr
axis <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
value <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
return $! JoyAxisMotion which axis value
peekJoyBallMotion :: Ptr Event -> IO Event
peekJoyBallMotion ptr
= do which <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr
ball <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
xrel <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
yrel <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
return $! JoyBallMotion which ball xrel yrel
peekJoyHatMotion :: Ptr Event -> IO Event
peekJoyHatMotion ptr
= do which <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr
hat <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
value <- (\hsc_ptr -> peekByteOff hsc_ptr 3) ptr
return $! JoyHatMotion which hat value
peekJoyButton :: (Word8 -> Word8 -> Event) -> Ptr Event -> IO Event
peekJoyButton mkEvent ptr
= do which <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr
button <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
return $! mkEvent which button
peekResize :: Ptr Event -> IO Event
peekResize ptr
= do w <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
h <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
return $! VideoResize w h
peekUserEvent :: Ptr Event -> Word8 -> IO Event
peekUserEvent ptr n
= do code <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
data1 <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
data2 <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
return $ User (fromEventType n) code data1 data2
getEventType :: Event -> Word8
getEventType = fromSDLEvent . eventToSDLEvent
eventToSDLEvent :: Event -> SDLEvent
eventToSDLEvent NoEvent = SDLNoEvent
eventToSDLEvent (GotFocus _) = SDLActiveEvent
eventToSDLEvent (LostFocus _) = SDLActiveEvent
eventToSDLEvent (KeyDown _) = SDLKeyDown
eventToSDLEvent (KeyUp _) = SDLKeyUp
eventToSDLEvent (MouseMotion _ _ _ _) = SDLMouseMotion
eventToSDLEvent (MouseButtonDown _ _ _) = SDLMouseButtonDown
eventToSDLEvent (MouseButtonUp _ _ _) = SDLMouseButtonUp
eventToSDLEvent (JoyAxisMotion _ _ _) = SDLJoyAxisMotion
eventToSDLEvent (JoyBallMotion _ _ _ _) = SDLJoyBallMotion
eventToSDLEvent (JoyHatMotion _ _ _) = SDLJoyHatMotion
eventToSDLEvent (JoyButtonDown _ _) = SDLJoyButtonDown
eventToSDLEvent (JoyButtonUp _ _) = SDLJoyButtonUp
eventToSDLEvent Quit = SDLQuit
eventToSDLEvent (VideoResize _ _) = SDLVideoResize
eventToSDLEvent VideoExpose = SDLVideoExpose
eventToSDLEvent (User uid _ _ _) = SDLUserEvent (toEventType uid)
eventToSDLEvent _ = error "Graphics.UI.SDL.Events.eventToSDLEvent: bad argument"
pokeActiveEvent :: Ptr Event -> Word8 -> [Focus] -> IO ()
pokeActiveEvent ptr gain focus
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr gain
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (toBitmask focus)
pokeKey :: Ptr Event -> Word8 -> Keysym -> IO ()
pokeKey ptr state keysym
= do (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr state
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr keysym
pokeMouseMotion :: Ptr Event -> Word16 -> Word16 -> Int16 -> Int16 -> IO ()
pokeMouseMotion ptr x y xrel yrel
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr x
(\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr y
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr xrel
(\hsc_ptr -> pokeByteOff hsc_ptr 10) ptr yrel
pokeMouseButton :: Ptr Event -> Word8 -> Word16 -> Word16 -> MouseButton -> IO ()
pokeMouseButton ptr state x y b
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr x
(\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr y
(\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr state
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (fromEnum b)
pokeJoyAxisMotion :: Ptr Event -> Word8 -> Word8 -> Int16 -> IO ()
pokeJoyAxisMotion ptr which axis value
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr axis
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr value
pokeJoyBallMotion :: Ptr Event -> Word8 -> Word8 -> Int16 -> Int16 -> IO ()
pokeJoyBallMotion ptr which ball xrel yrel
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr ball
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr xrel
(\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr yrel
pokeJoyHatMotion :: Ptr Event -> Word8 -> Word8 -> Word8 -> IO ()
pokeJoyHatMotion ptr which hat value
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr hat
(\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr value
pokeJoyButton :: Ptr Event -> Word8 -> Word8 -> Word8 -> IO ()
pokeJoyButton ptr which button state
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr button
(\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr state
pokeResize :: Ptr Event -> Int -> Int -> IO ()
pokeResize ptr w h
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr w
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr h
pokeUserEvent :: Ptr Event -> UserEventID -> Int -> Ptr () -> Ptr () -> IO ()
pokeUserEvent ptr _eventId code data1 data2
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr code
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr data1
(\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr data2
instance Storable Event where
sizeOf = const ((20))
alignment = const 4
poke ptr event
= do pokeByteOff ptr 0 (getEventType event)
case event of
NoEvent -> return ()
GotFocus focus -> pokeActiveEvent ptr 1 focus
LostFocus focus -> pokeActiveEvent ptr 0 focus
KeyDown keysym -> pokeKey ptr 1 keysym
KeyUp keysym -> pokeKey ptr 0 keysym
MouseMotion x y xrel yrel -> pokeMouseMotion ptr x y xrel yrel
MouseButtonDown x y b -> pokeMouseButton ptr 1 x y b
MouseButtonUp x y b -> pokeMouseButton ptr 0 x y b
JoyAxisMotion w a v -> pokeJoyAxisMotion ptr w a v
JoyBallMotion w b x y -> pokeJoyBallMotion ptr w b x y
JoyHatMotion w h v -> pokeJoyHatMotion ptr w h v
JoyButtonDown w b -> pokeJoyButton ptr w b 1
JoyButtonUp w b -> pokeJoyButton ptr w b 0
Quit -> return ()
VideoResize w h -> pokeResize ptr w h
VideoExpose -> return ()
User eventId c d1 d2 -> pokeUserEvent ptr eventId c d1 d2
e -> failWithError $ "Unhandled eventtype: " ++ show e
peek ptr
= do eventType <- peekByteOff ptr 0
case toSDLEvent eventType of
SDLNoEvent -> return NoEvent
SDLActiveEvent -> peekActiveEvent ptr
SDLKeyDown -> peekKey KeyDown ptr
SDLKeyUp -> peekKey KeyUp ptr
SDLMouseMotion -> peekMouseMotion ptr
SDLMouseButtonDown -> peekMouse MouseButtonDown ptr
SDLMouseButtonUp -> peekMouse MouseButtonUp ptr
SDLJoyAxisMotion -> peekJoyAxisMotion ptr
SDLJoyBallMotion -> peekJoyBallMotion ptr
SDLJoyHatMotion -> peekJoyHatMotion ptr
SDLJoyButtonDown -> peekJoyButton JoyButtonDown ptr
SDLJoyButtonUp -> peekJoyButton JoyButtonUp ptr
SDLQuit -> return Quit
SDLVideoResize -> peekResize ptr
SDLVideoExpose -> return VideoExpose
SDLUserEvent n -> peekUserEvent ptr n
e -> failWithError $ "Unhandled eventtype: " ++ show e
foreign import ccall unsafe "SDL_EnableKeyRepeat" sdlEnableKeyRepeat :: Int -> Int -> IO Int
enableKeyRepeat :: Int
-> Int
-> IO Bool
enableKeyRepeat delay interval
= intToBool (1) (sdlEnableKeyRepeat delay interval)
foreign import ccall unsafe "SDL_EnableUNICODE" sdlEnableUnicode :: Int -> IO Int
enableUnicode :: Bool -> IO ()
enableUnicode enable = sdlEnableUnicode (fromToggle toggle) >>
return ()
where toggle = case enable of
True -> Enable
False -> Disable
queryUnicodeState :: IO Bool
queryUnicodeState = fmap toBool (sdlEnableUnicode (fromToggle Query))
foreign import ccall unsafe "SDL_GetKeyName" sdlGetKeyName :: Word32 -> IO CString
getKeyName :: SDLKey -> String
getKeyName key = unsafePerformIO $
sdlGetKeyName (fromEnum key) >>= peekCString
foreign import ccall unsafe "SDL_GetModState" sdlGetModState :: IO Word32
getModState :: IO [Modifier]
getModState = fmap fromBitmask sdlGetModState
foreign import ccall unsafe "SDL_SetModState" sdlSetModState :: Word32 -> IO ()
setModState :: [Modifier] -> IO ()
setModState = sdlSetModState . toBitmask
mousePressed :: Word8 -> MouseButton -> Bool
mousePressed mask b
= mask .&. (1 `shiftL` num) /= 0
where num = fromIntegral (fromEnum b)
foreign import ccall "SDL_GetMouseState" sdlGetMouseState :: Ptr Int -> Ptr Int -> IO Word8
foreign import ccall "SDL_GetRelativeMouseState" sdlGetRelativeMouseState :: Ptr Int -> Ptr Int -> IO Word8
getMouseState :: IO (Int, Int, [MouseButton])
getMouseState = mouseStateGetter sdlGetMouseState
getRelativeMouseState :: IO (Int, Int, [MouseButton])
getRelativeMouseState = mouseStateGetter sdlGetRelativeMouseState
mouseStateGetter :: (Ptr Int -> Ptr Int -> IO Word8) -> IO (Int, Int, [MouseButton])
mouseStateGetter getter
= alloca $ \xPtr ->
alloca $ \yPtr ->
do ret <- getter xPtr yPtr
[x,y] <- mapM peek [xPtr,yPtr]
return (x,y,filter (mousePressed ret) [ButtonLeft
,ButtonMiddle
,ButtonRight
,ButtonWheelUp
,ButtonWheelDown])
foreign import ccall "SDL_PollEvent" sdlPollEvent :: Ptr Event -> IO Int
pollEvent :: IO Event
pollEvent
= alloca poll
where poll ptr
= do ret <- sdlPollEvent ptr
case ret of
0 -> return NoEvent
_ -> do event <- peek ptr
case event of
NoEvent -> poll ptr
_ -> return event
foreign import ccall unsafe "SDL_PumpEvents" pumpEvents :: IO ()
foreign import ccall unsafe "SDL_PushEvent" sdlPushEvent :: Ptr Event -> IO Int
tryPushEvent :: Event -> IO Bool
tryPushEvent event
= new event >>= (fmap (0==) . sdlPushEvent)
pushEvent :: Event -> IO ()
pushEvent = unwrapBool "SDL_PushEvent" . tryPushEvent
foreign import ccall unsafe "SDL_WaitEvent" sdlWaitEvent :: Ptr Event -> IO Int
waitEvent :: IO Event
waitEvent
= loop
where loop = do pumpEvents
event <- pollEvent
case event of
NoEvent -> threadDelay 10 >> loop
_ -> return event
waitEventBlocking :: IO Event
waitEventBlocking
= alloca wait
where wait ptr
= do ret <- sdlWaitEvent ptr
case ret of
0 -> failWithError "SDL_WaitEvent"
_ -> do event <- peek ptr
case event of
NoEvent -> wait ptr
_ -> return event
foreign import ccall unsafe "SDL_EventState" sdlEventState :: Word8 -> Int -> IO Word8
enableEvent :: SDLEvent -> Bool -> IO ()
enableEvent event on
= sdlEventState (fromSDLEvent event) (fromToggle state) >> return ()
where state
| on = Enable
| otherwise = Disable
queryEventState :: SDLEvent -> IO Bool
queryEventState event
= fmap (==1) (sdlEventState (fromSDLEvent event) (fromToggle Query))
foreign import ccall unsafe "SDL_GetAppState" sdlGetAppState :: IO Word8
getAppState :: IO [Focus]
getAppState = fmap fromBitmask sdlGetAppState