{-# LINE 1 "Graphics/UI/SDL/Events.hsc" #-}
{-# LINE 5 "Graphics/UI/SDL/Events.hsc" #-}
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),
toBool, new, alloca)
import Foreign.C (peekCString, CString, CInt)
import System.IO.Unsafe (unsafePerformIO)
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, fromCInt)
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
{-# LINE 89 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLActiveEvent = 1
{-# LINE 90 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLKeyDown = 2
{-# LINE 91 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLKeyUp = 3
{-# LINE 92 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLMouseMotion = 4
{-# LINE 93 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLMouseButtonDown = 5
{-# LINE 94 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLMouseButtonUp = 6
{-# LINE 95 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLJoyAxisMotion = 7
{-# LINE 96 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLJoyBallMotion = 8
{-# LINE 97 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLJoyHatMotion = 9
{-# LINE 98 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLJoyButtonDown = 10
{-# LINE 99 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLJoyButtonUp = 11
{-# LINE 100 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLQuit = 12
{-# LINE 101 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLSysWMEvent = 13
{-# LINE 102 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLVideoResize = 16
{-# LINE 103 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLVideoExpose = 17
{-# LINE 104 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent (SDLUserEvent n) = 24 + n
{-# LINE 105 "Graphics/UI/SDL/Events.hsc" #-}
fromSDLEvent SDLNumEvents = 32
{-# LINE 106 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent :: Word8 -> SDLEvent
toSDLEvent 0 = SDLNoEvent
{-# LINE 109 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 1 = SDLActiveEvent
{-# LINE 110 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 2 = SDLKeyDown
{-# LINE 111 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 3 = SDLKeyUp
{-# LINE 112 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 4 = SDLMouseMotion
{-# LINE 113 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 5 = SDLMouseButtonDown
{-# LINE 114 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 6 = SDLMouseButtonUp
{-# LINE 115 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 7 = SDLJoyAxisMotion
{-# LINE 116 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 8 = SDLJoyBallMotion
{-# LINE 117 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 9 = SDLJoyHatMotion
{-# LINE 118 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 10 = SDLJoyButtonDown
{-# LINE 119 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 11 = SDLJoyButtonUp
{-# LINE 120 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 12 = SDLQuit
{-# LINE 121 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 13 = SDLSysWMEvent
{-# LINE 122 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 16 = SDLVideoResize
{-# LINE 123 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent 17 = SDLVideoExpose
{-# LINE 124 "Graphics/UI/SDL/Events.hsc" #-}
toSDLEvent n
| n >= 24 &&
{-# LINE 126 "Graphics/UI/SDL/Events.hsc" #-}
n < 32 = SDLUserEvent (n - 24)
{-# LINE 127 "Graphics/UI/SDL/Events.hsc" #-}
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
| ButtonUnknown !Word8
deriving (Show,Eq,Ord)
instance Enum MouseButton Word8 where
toEnum 1 = ButtonLeft
{-# LINE 178 "Graphics/UI/SDL/Events.hsc" #-}
toEnum 2 = ButtonMiddle
{-# LINE 179 "Graphics/UI/SDL/Events.hsc" #-}
toEnum 3 = ButtonRight
{-# LINE 180 "Graphics/UI/SDL/Events.hsc" #-}
toEnum 4 = ButtonWheelUp
{-# LINE 181 "Graphics/UI/SDL/Events.hsc" #-}
toEnum 5 = ButtonWheelDown
{-# LINE 182 "Graphics/UI/SDL/Events.hsc" #-}
toEnum n = ButtonUnknown (fromIntegral n)
fromEnum ButtonLeft = 1
{-# LINE 184 "Graphics/UI/SDL/Events.hsc" #-}
fromEnum ButtonMiddle = 2
{-# LINE 185 "Graphics/UI/SDL/Events.hsc" #-}
fromEnum ButtonRight = 3
{-# LINE 186 "Graphics/UI/SDL/Events.hsc" #-}
fromEnum ButtonWheelUp = 4
{-# LINE 187 "Graphics/UI/SDL/Events.hsc" #-}
fromEnum ButtonWheelDown = 5
{-# LINE 188 "Graphics/UI/SDL/Events.hsc" #-}
fromEnum (ButtonUnknown n) = fromIntegral n
succ = toEnum . (+1) . fromEnum
pred = toEnum . (subtract 1) . fromEnum
enumFromTo = defEnumFromTo
mouseButtonMask :: MouseButton -> Word8
mouseButtonMask ButtonLeft = 1
{-# LINE 195 "Graphics/UI/SDL/Events.hsc" #-}
mouseButtonMask ButtonMiddle = 2
{-# LINE 196 "Graphics/UI/SDL/Events.hsc" #-}
mouseButtonMask ButtonRight = 4
{-# LINE 197 "Graphics/UI/SDL/Events.hsc" #-}
mouseButtonMask ButtonWheelUp = 8
{-# LINE 198 "Graphics/UI/SDL/Events.hsc" #-}
mouseButtonMask ButtonWheelDown = 16
{-# LINE 199 "Graphics/UI/SDL/Events.hsc" #-}
mouseButtonMask (ButtonUnknown n) = 1 `shiftL` (fromIntegral n-1)
allButtons :: [MouseButton]
allButtons = [ButtonLeft
,ButtonMiddle
,ButtonRight
,ButtonWheelUp
,ButtonWheelDown
]
defEnumFromTo :: (Enum a b, Ord a) => a -> a -> [a]
defEnumFromTo x y | x > y = []
| x == y = [y]
| otherwise = x : defEnumFromTo (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
{-# LINE 227 "Graphics/UI/SDL/Events.hsc" #-}
fromEnum InputFocus = 2
{-# LINE 228 "Graphics/UI/SDL/Events.hsc" #-}
fromEnum ApplicationFocus = 4
{-# LINE 229 "Graphics/UI/SDL/Events.hsc" #-}
toEnum 1 = MouseFocus
{-# LINE 230 "Graphics/UI/SDL/Events.hsc" #-}
toEnum 2 = InputFocus
{-# LINE 231 "Graphics/UI/SDL/Events.hsc" #-}
toEnum 4 = ApplicationFocus
{-# LINE 232 "Graphics/UI/SDL/Events.hsc" #-}
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)
{-# LINE 288 "Graphics/UI/SDL/Events.hsc" #-}
state <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr :: IO Word8
{-# LINE 289 "Graphics/UI/SDL/Events.hsc" #-}
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
{-# LINE 294 "Graphics/UI/SDL/Events.hsc" #-}
return $! mkEvent keysym
peekMouseMotion :: Ptr Event -> IO Event
peekMouseMotion ptr
= do x <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 299 "Graphics/UI/SDL/Events.hsc" #-}
y <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
{-# LINE 300 "Graphics/UI/SDL/Events.hsc" #-}
xrel <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 301 "Graphics/UI/SDL/Events.hsc" #-}
yrel <- (\hsc_ptr -> peekByteOff hsc_ptr 10) ptr
{-# LINE 302 "Graphics/UI/SDL/Events.hsc" #-}
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
{-# LINE 307 "Graphics/UI/SDL/Events.hsc" #-}
x <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 308 "Graphics/UI/SDL/Events.hsc" #-}
y <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
{-# LINE 309 "Graphics/UI/SDL/Events.hsc" #-}
return $! mkEvent x y (toEnum (b::Word8))
peekJoyAxisMotion :: Ptr Event -> IO Event
peekJoyAxisMotion ptr
= do which <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr
{-# LINE 314 "Graphics/UI/SDL/Events.hsc" #-}
axis <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 315 "Graphics/UI/SDL/Events.hsc" #-}
value <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 316 "Graphics/UI/SDL/Events.hsc" #-}
return $! JoyAxisMotion which axis value
peekJoyBallMotion :: Ptr Event -> IO Event
peekJoyBallMotion ptr
= do which <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr
{-# LINE 321 "Graphics/UI/SDL/Events.hsc" #-}
ball <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 322 "Graphics/UI/SDL/Events.hsc" #-}
xrel <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 323 "Graphics/UI/SDL/Events.hsc" #-}
yrel <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
{-# LINE 324 "Graphics/UI/SDL/Events.hsc" #-}
return $! JoyBallMotion which ball xrel yrel
peekJoyHatMotion :: Ptr Event -> IO Event
peekJoyHatMotion ptr
= do which <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr
{-# LINE 329 "Graphics/UI/SDL/Events.hsc" #-}
hat <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 330 "Graphics/UI/SDL/Events.hsc" #-}
value <- (\hsc_ptr -> peekByteOff hsc_ptr 3) ptr
{-# LINE 331 "Graphics/UI/SDL/Events.hsc" #-}
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
{-# LINE 336 "Graphics/UI/SDL/Events.hsc" #-}
button <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 337 "Graphics/UI/SDL/Events.hsc" #-}
return $! mkEvent which button
peekResize :: Ptr Event -> IO Event
peekResize ptr
= do w <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 342 "Graphics/UI/SDL/Events.hsc" #-}
h <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 343 "Graphics/UI/SDL/Events.hsc" #-}
return $! VideoResize (fromCInt w) (fromCInt h)
peekUserEvent :: Ptr Event -> Word8 -> IO Event
peekUserEvent ptr n
= do code <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 348 "Graphics/UI/SDL/Events.hsc" #-}
data1 <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 349 "Graphics/UI/SDL/Events.hsc" #-}
data2 <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 350 "Graphics/UI/SDL/Events.hsc" #-}
return $ User (fromEventType n) (fromCInt 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
{-# LINE 378 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (toBitmask focus)
{-# LINE 379 "Graphics/UI/SDL/Events.hsc" #-}
pokeKey :: Ptr Event -> Word8 -> Keysym -> IO ()
pokeKey ptr state keysym
= do (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr state
{-# LINE 383 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr keysym
{-# LINE 384 "Graphics/UI/SDL/Events.hsc" #-}
pokeMouseMotion :: Ptr Event -> Word16 -> Word16 -> Int16 -> Int16 -> IO ()
pokeMouseMotion ptr x y xrel yrel
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr x
{-# LINE 388 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr y
{-# LINE 389 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr xrel
{-# LINE 390 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 10) ptr yrel
{-# LINE 391 "Graphics/UI/SDL/Events.hsc" #-}
pokeMouseButton :: Ptr Event -> Word8 -> Word16 -> Word16 -> MouseButton -> IO ()
pokeMouseButton ptr state x y b
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr x
{-# LINE 395 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr y
{-# LINE 396 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr state
{-# LINE 397 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (fromEnum b)
{-# LINE 398 "Graphics/UI/SDL/Events.hsc" #-}
pokeJoyAxisMotion :: Ptr Event -> Word8 -> Word8 -> Int16 -> IO ()
pokeJoyAxisMotion ptr which axis value
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
{-# LINE 402 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr axis
{-# LINE 403 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr value
{-# LINE 404 "Graphics/UI/SDL/Events.hsc" #-}
pokeJoyBallMotion :: Ptr Event -> Word8 -> Word8 -> Int16 -> Int16 -> IO ()
pokeJoyBallMotion ptr which ball xrel yrel
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
{-# LINE 408 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr ball
{-# LINE 409 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr xrel
{-# LINE 410 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr yrel
{-# LINE 411 "Graphics/UI/SDL/Events.hsc" #-}
pokeJoyHatMotion :: Ptr Event -> Word8 -> Word8 -> Word8 -> IO ()
pokeJoyHatMotion ptr which hat value
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
{-# LINE 415 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr hat
{-# LINE 416 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr value
{-# LINE 417 "Graphics/UI/SDL/Events.hsc" #-}
pokeJoyButton :: Ptr Event -> Word8 -> Word8 -> Word8 -> IO ()
pokeJoyButton ptr which button state
= do (\hsc_ptr -> pokeByteOff hsc_ptr 1) ptr which
{-# LINE 421 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr button
{-# LINE 422 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr state
{-# LINE 423 "Graphics/UI/SDL/Events.hsc" #-}
pokeResize :: Ptr Event -> Int -> Int -> IO ()
pokeResize ptr w h
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr w
{-# LINE 427 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr h
{-# LINE 428 "Graphics/UI/SDL/Events.hsc" #-}
pokeUserEvent :: Ptr Event -> UserEventID -> Int -> Ptr () -> Ptr () -> IO ()
pokeUserEvent ptr _eventId code data1 data2
= do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr code
{-# LINE 432 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr data1
{-# LINE 433 "Graphics/UI/SDL/Events.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr data2
{-# LINE 434 "Graphics/UI/SDL/Events.hsc" #-}
instance Storable Event where
sizeOf = const ((24))
{-# LINE 437 "Graphics/UI/SDL/Events.hsc" #-}
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
{-# LINE 445 "Graphics/UI/SDL/Events.hsc" #-}
KeyUp keysym -> pokeKey ptr 0 keysym
{-# LINE 446 "Graphics/UI/SDL/Events.hsc" #-}
MouseMotion x y xrel yrel -> pokeMouseMotion ptr x y xrel yrel
MouseButtonDown x y b -> pokeMouseButton ptr 1 x y b
{-# LINE 448 "Graphics/UI/SDL/Events.hsc" #-}
MouseButtonUp x y b -> pokeMouseButton ptr 0 x y b
{-# LINE 449 "Graphics/UI/SDL/Events.hsc" #-}
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
{-# LINE 453 "Graphics/UI/SDL/Events.hsc" #-}
JoyButtonUp w b -> pokeJoyButton ptr w b 0
{-# LINE 454 "Graphics/UI/SDL/Events.hsc" #-}
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
{-# LINE 509 "Graphics/UI/SDL/Events.hsc" #-}
getKeyName :: SDLKey -> String
getKeyName key = unsafePerformIO $
sdlGetKeyName (fromEnum key) >>= peekCString
foreign import ccall unsafe "SDL_GetModState" sdlGetModState :: IO Word32
{-# LINE 517 "Graphics/UI/SDL/Events.hsc" #-}
getModState :: IO [Modifier]
getModState = fmap fromBitmask sdlGetModState
foreign import ccall unsafe "SDL_SetModState" sdlSetModState :: Word32 -> IO ()
{-# LINE 524 "Graphics/UI/SDL/Events.hsc" #-}
setModState :: [Modifier] -> IO ()
setModState = sdlSetModState . toBitmask
mousePressed :: Word8 -> MouseButton -> Bool
mousePressed mask b
= mask .&. (mouseButtonMask b) /= 0
foreign import ccall "SDL_GetMouseState" sdlGetMouseState :: Ptr CInt -> Ptr CInt -> IO Word8
foreign import ccall "SDL_GetRelativeMouseState" sdlGetRelativeMouseState :: Ptr CInt -> Ptr CInt -> IO Word8
getMouseState :: IO (Int, Int, [MouseButton])
getMouseState = mouseStateGetter sdlGetMouseState
getRelativeMouseState :: IO (Int, Int, [MouseButton])
getRelativeMouseState = mouseStateGetter sdlGetRelativeMouseState
mouseStateGetter :: (Ptr CInt -> Ptr CInt -> IO Word8) -> IO (Int, Int, [MouseButton])
mouseStateGetter getter
= alloca $ \xPtr ->
alloca $ \yPtr ->
do ret <- getter xPtr yPtr
[x,y] <- mapM peek [xPtr,yPtr]
return (fromIntegral x,fromIntegral y
,filter (mousePressed ret) allButtons)
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 safe "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