SDL 0.5.1 → 0.5.2
raw patch · 25 files changed
+3854/−24 lines, 25 filessetup-changed
Files
- Graphics/UI/SDL/Audio.hs +71/−0
- Graphics/UI/SDL/Audio.hsc +3/−0
- Graphics/UI/SDL/Events.hs +750/−0
- Graphics/UI/SDL/Events.hsc +3/−0
- Graphics/UI/SDL/General.hs +182/−0
- Graphics/UI/SDL/General.hsc +3/−0
- Graphics/UI/SDL/Joystick.hs +182/−0
- Graphics/UI/SDL/Joystick.hsc +3/−0
- Graphics/UI/SDL/Keysym.hs +1325/−0
- Graphics/UI/SDL/Keysym.hsc +3/−0
- Graphics/UI/SDL/Rect.hs +55/−0
- Graphics/UI/SDL/Rect.hsc +3/−0
- Graphics/UI/SDL/Types.hs +324/−0
- Graphics/UI/SDL/Types.hsc +3/−0
- Graphics/UI/SDL/Version.hs +46/−0
- Graphics/UI/SDL/Version.hsc +3/−0
- Graphics/UI/SDL/Video.hs +729/−0
- Graphics/UI/SDL/Video.hsc +3/−0
- Graphics/UI/SDL/WindowManagement.hs +125/−0
- Graphics/UI/SDL/WindowManagement.hsc +3/−0
- SDL.cabal +4/−3
- Setup.lhs +1/−1
- WIN32 +13/−19
- configure.ac +1/−1
- includes/HsSDLConfig.h.in +16/−0
+ Graphics/UI/SDL/Audio.hs view
@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/Audio.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/Audio.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Audio+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Audio+ ( AudioFormat (..)+ , fromAudioFormat+ , toAudioFormat+ ) where++import Data.Word (Word16)++data AudioFormat+ = AudioU8+ | AudioS8+ | AudioU16LSB+ | AudioS16LSB+ | AudioU16MSB+ | AudioS16MSB+ | AudioU16Sys+ | AudioS16Sys+ deriving (Show,Eq,Ord,Enum)++fromAudioFormat :: AudioFormat -> Word16+fromAudioFormat AudioU8 = 8+{-# LINE 34 "Graphics/UI/SDL/Audio.hsc" #-}+fromAudioFormat AudioS8 = 32776+{-# LINE 35 "Graphics/UI/SDL/Audio.hsc" #-}+fromAudioFormat AudioU16LSB = 16+{-# LINE 36 "Graphics/UI/SDL/Audio.hsc" #-}+fromAudioFormat AudioS16LSB = 32784+{-# LINE 37 "Graphics/UI/SDL/Audio.hsc" #-}+fromAudioFormat AudioU16MSB = 4112+{-# LINE 38 "Graphics/UI/SDL/Audio.hsc" #-}+fromAudioFormat AudioS16MSB = 36880+{-# LINE 39 "Graphics/UI/SDL/Audio.hsc" #-}+fromAudioFormat AudioU16Sys = 16+{-# LINE 40 "Graphics/UI/SDL/Audio.hsc" #-}+fromAudioFormat AudioS16Sys = 32784+{-# LINE 41 "Graphics/UI/SDL/Audio.hsc" #-}++toAudioFormat :: Word16 -> AudioFormat+toAudioFormat 8 = AudioU8+{-# LINE 44 "Graphics/UI/SDL/Audio.hsc" #-}+toAudioFormat 32776 = AudioS8+{-# LINE 45 "Graphics/UI/SDL/Audio.hsc" #-}+toAudioFormat 16 = AudioU16LSB+{-# LINE 46 "Graphics/UI/SDL/Audio.hsc" #-}+toAudioFormat 32784 = AudioS16LSB+{-# LINE 47 "Graphics/UI/SDL/Audio.hsc" #-}+toAudioFormat 4112 = AudioU16MSB+{-# LINE 48 "Graphics/UI/SDL/Audio.hsc" #-}+toAudioFormat 36880 = AudioS16MSB+{-# LINE 49 "Graphics/UI/SDL/Audio.hsc" #-}+toAudioFormat _ = error "Graphics.UI.SDL.Audio.toAudioFormat: bad argument"++
Graphics/UI/SDL/Audio.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.Audio
+ Graphics/UI/SDL/Events.hs view
@@ -0,0 +1,750 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/Events.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/Events.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Events+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+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)++-- |Low level event structure keeping a one-to-one relation with the C event structure.+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 85 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLActiveEvent = 1+{-# LINE 86 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLKeyDown = 2+{-# LINE 87 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLKeyUp = 3+{-# LINE 88 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLMouseMotion = 4+{-# LINE 89 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLMouseButtonDown = 5+{-# LINE 90 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLMouseButtonUp = 6+{-# LINE 91 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLJoyAxisMotion = 7+{-# LINE 92 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLJoyBallMotion = 8+{-# LINE 93 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLJoyHatMotion = 9+{-# LINE 94 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLJoyButtonDown = 10+{-# LINE 95 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLJoyButtonUp = 11+{-# LINE 96 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLQuit = 12+{-# LINE 97 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLSysWMEvent = 13+{-# LINE 98 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLVideoResize = 16+{-# LINE 99 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLVideoExpose = 17+{-# LINE 100 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent (SDLUserEvent n) = 24 + n+{-# LINE 101 "Graphics/UI/SDL/Events.hsc" #-}+fromSDLEvent SDLNumEvents = 32+{-# LINE 102 "Graphics/UI/SDL/Events.hsc" #-}++toSDLEvent :: Word8 -> SDLEvent+toSDLEvent 0 = SDLNoEvent+{-# LINE 105 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 1 = SDLActiveEvent+{-# LINE 106 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 2 = SDLKeyDown+{-# LINE 107 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 3 = SDLKeyUp+{-# LINE 108 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 4 = SDLMouseMotion+{-# LINE 109 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 5 = SDLMouseButtonDown+{-# LINE 110 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 6 = SDLMouseButtonUp+{-# LINE 111 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 7 = SDLJoyAxisMotion+{-# LINE 112 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 8 = SDLJoyBallMotion+{-# LINE 113 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 9 = SDLJoyHatMotion+{-# LINE 114 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 10 = SDLJoyButtonDown+{-# LINE 115 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 11 = SDLJoyButtonUp+{-# LINE 116 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 12 = SDLQuit+{-# LINE 117 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 13 = SDLSysWMEvent+{-# LINE 118 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 16 = SDLVideoResize+{-# LINE 119 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent 17 = SDLVideoExpose+{-# LINE 120 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent n + | n >= 24 &&+{-# LINE 122 "Graphics/UI/SDL/Events.hsc" #-}+ n < 32 = SDLUserEvent (n - 24)+{-# LINE 123 "Graphics/UI/SDL/Events.hsc" #-}+toSDLEvent _ = error "Graphics.UI.SDL.Events.toSDLEvent: bad argument"++-- |High level event structure.+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+ -- ^ device index, axis index, axis value.+ | JoyBallMotion !Word8 !Word8 !Int16 !Int16+ -- ^ device index, trackball index, relative motion.+ | JoyHatMotion !Word8 !Word8 !Word8+ -- ^ device index, hat index, hat position.+ | JoyButtonDown !Word8 !Word8+ -- ^ device index, button index.+ | JoyButtonUp !Word8 !Word8+ -- ^ device index, button index.+ | VideoResize !Int !Int+ -- ^ When @Resizable@ is passed as a flag to 'Graphics.UI.SDL.Video.setVideoMode' the user is+ -- allowed to resize the applications window. When the window is resized+ -- an @VideoResize@ is reported, with the new window width and height values.+ -- When an @VideoResize@ is recieved the window should be resized to the+ -- new dimensions using 'Graphics.UI.SDL.Video.setVideoMode'.+ | VideoExpose+ -- ^ A @VideoExpose@ event is triggered when the screen has been modified+ -- outside of the application, usually by the window manager and needs to be redrawn.+ | 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+{-# LINE 173 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum 2 = ButtonMiddle+{-# LINE 174 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum 3 = ButtonRight+{-# LINE 175 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum 4 = ButtonWheelUp+{-# LINE 176 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum 5 = ButtonWheelDown+{-# LINE 177 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum _ = error "Graphics.UI.SDL.Events.toEnum: bad argument"+ fromEnum ButtonLeft = 1+{-# LINE 179 "Graphics/UI/SDL/Events.hsc" #-}+ fromEnum ButtonMiddle = 2+{-# LINE 180 "Graphics/UI/SDL/Events.hsc" #-}+ fromEnum ButtonRight = 3+{-# LINE 181 "Graphics/UI/SDL/Events.hsc" #-}+ fromEnum ButtonWheelUp = 4+{-# LINE 182 "Graphics/UI/SDL/Events.hsc" #-}+ fromEnum ButtonWheelDown = 5+{-# LINE 183 "Graphics/UI/SDL/Events.hsc" #-}+ 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+{-# LINE 210 "Graphics/UI/SDL/Events.hsc" #-}+ fromEnum InputFocus = 2+{-# LINE 211 "Graphics/UI/SDL/Events.hsc" #-}+ fromEnum ApplicationFocus = 4+{-# LINE 212 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum 1 = MouseFocus+{-# LINE 213 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum 2 = InputFocus+{-# LINE 214 "Graphics/UI/SDL/Events.hsc" #-}+ toEnum 4 = ApplicationFocus+{-# LINE 215 "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++-- |Typed user events ranging from 0 to 7+data UserEventID+ = UID0 | UID1 | UID2 | UID3 | UID4 | UID5 | UID6 | UID7+ deriving (Show,Eq,Prelude.Enum)++-- |A safe pointer keeps the type of the object it was created from+-- and checks it when it's deconstructed.+type SafePtr = Ptr ()++-- |Constructs a safe pointer from an arbitrary value.+toSafePtr :: (Typeable a) => a -> IO SafePtr+toSafePtr val+ = do stablePtr <- newStablePtr (typeOf val,val)+ return (castStablePtrToPtr stablePtr)++-- |Return the type of the object the safe pointer was created from.+typeOfSafePtr :: SafePtr -> IO TypeRep+typeOfSafePtr ptr+ = fmap fst (deRefStablePtr (castPtrToStablePtr ptr))++-- |Get object from a safe pointer. @Nothing@ on type mismatch.+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++-- |Get object from a safe pointer. Throws an exception on type mismatch.+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 271 "Graphics/UI/SDL/Events.hsc" #-}+ state <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr :: IO Word8+{-# LINE 272 "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 277 "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 282 "Graphics/UI/SDL/Events.hsc" #-}+ y <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr+{-# LINE 283 "Graphics/UI/SDL/Events.hsc" #-}+ xrel <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr+{-# LINE 284 "Graphics/UI/SDL/Events.hsc" #-}+ yrel <- (\hsc_ptr -> peekByteOff hsc_ptr 10) ptr+{-# LINE 285 "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 290 "Graphics/UI/SDL/Events.hsc" #-}+ x <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr+{-# LINE 291 "Graphics/UI/SDL/Events.hsc" #-}+ y <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr+{-# LINE 292 "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 297 "Graphics/UI/SDL/Events.hsc" #-}+ axis <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr+{-# LINE 298 "Graphics/UI/SDL/Events.hsc" #-}+ value <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr+{-# LINE 299 "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 304 "Graphics/UI/SDL/Events.hsc" #-}+ ball <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr+{-# LINE 305 "Graphics/UI/SDL/Events.hsc" #-}+ xrel <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr+{-# LINE 306 "Graphics/UI/SDL/Events.hsc" #-}+ yrel <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr+{-# LINE 307 "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 312 "Graphics/UI/SDL/Events.hsc" #-}+ hat <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr+{-# LINE 313 "Graphics/UI/SDL/Events.hsc" #-}+ value <- (\hsc_ptr -> peekByteOff hsc_ptr 3) ptr+{-# LINE 314 "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 319 "Graphics/UI/SDL/Events.hsc" #-}+ button <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr+{-# LINE 320 "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 325 "Graphics/UI/SDL/Events.hsc" #-}+ h <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr+{-# LINE 326 "Graphics/UI/SDL/Events.hsc" #-}+ return $! VideoResize w h++peekUserEvent :: Ptr Event -> Word8 -> IO Event+peekUserEvent ptr n+ = do code <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr+{-# LINE 331 "Graphics/UI/SDL/Events.hsc" #-}+ data1 <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr+{-# LINE 332 "Graphics/UI/SDL/Events.hsc" #-}+ data2 <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr+{-# LINE 333 "Graphics/UI/SDL/Events.hsc" #-}+ 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+{-# LINE 361 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (toBitmask focus)+{-# LINE 362 "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 366 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr keysym+{-# LINE 367 "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 371 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr y+{-# LINE 372 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr xrel+{-# LINE 373 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 10) ptr yrel+{-# LINE 374 "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 378 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr y+{-# LINE 379 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr state+{-# LINE 380 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (fromEnum b)+{-# LINE 381 "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 385 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr axis+{-# LINE 386 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr value+{-# LINE 387 "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 391 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr ball+{-# LINE 392 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr xrel+{-# LINE 393 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr yrel+{-# LINE 394 "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 398 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr hat+{-# LINE 399 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr value+{-# LINE 400 "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 404 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr button+{-# LINE 405 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 3) ptr state+{-# LINE 406 "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 410 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr h+{-# LINE 411 "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 415 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr data1+{-# LINE 416 "Graphics/UI/SDL/Events.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr data2+{-# LINE 417 "Graphics/UI/SDL/Events.hsc" #-}++instance Storable Event where+ sizeOf = const ((24))+{-# LINE 420 "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 428 "Graphics/UI/SDL/Events.hsc" #-}+ KeyUp keysym -> pokeKey ptr 0 keysym+{-# LINE 429 "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 431 "Graphics/UI/SDL/Events.hsc" #-}+ MouseButtonUp x y b -> pokeMouseButton ptr 0 x y b+{-# LINE 432 "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 436 "Graphics/UI/SDL/Events.hsc" #-}+ JoyButtonUp w b -> pokeJoyButton ptr w b 0+{-# LINE 437 "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+-- SDLSysWMEvent+ SDLVideoResize -> peekResize ptr+ SDLVideoExpose -> return VideoExpose+ SDLUserEvent n -> peekUserEvent ptr n+-- SDLNumEvents + e -> failWithError $ "Unhandled eventtype: " ++ show e++-- int SDL_EnableKeyRepeat(int delay, int interval);+foreign import ccall unsafe "SDL_EnableKeyRepeat" sdlEnableKeyRepeat :: Int -> Int -> IO Int++-- | Sets keyboard repeat rate. Returns @False@ on error.+enableKeyRepeat :: Int -- ^ Initial delay. @0@ to disable.+ -> Int -- ^ Interval.+ -> IO Bool+enableKeyRepeat delay interval+ = intToBool (-1) (sdlEnableKeyRepeat delay interval)++-- int SDL_EnableUNICODE(int enable);+foreign import ccall unsafe "SDL_EnableUNICODE" sdlEnableUnicode :: Int -> IO Int++-- | Enables or disables unicode translation.+enableUnicode :: Bool -> IO ()+enableUnicode enable = sdlEnableUnicode (fromToggle toggle) >>+ return ()+ where toggle = case enable of+ True -> Enable+ False -> Disable++-- | Returns the current state of unicode translation. See also 'enableUnicode'.+queryUnicodeState :: IO Bool+queryUnicodeState = fmap toBool (sdlEnableUnicode (fromToggle Query))++-- char *SDL_GetKeyName(SDLKey key);+foreign import ccall unsafe "SDL_GetKeyName" sdlGetKeyName :: Word32 -> IO CString+{-# LINE 492 "Graphics/UI/SDL/Events.hsc" #-}++-- | Gets the name of an SDL virtual keysym.+getKeyName :: SDLKey -> String+getKeyName key = unsafePerformIO $+ sdlGetKeyName (fromEnum key) >>= peekCString++-- SDLMod SDL_GetModState(void);+foreign import ccall unsafe "SDL_GetModState" sdlGetModState :: IO Word32+{-# LINE 500 "Graphics/UI/SDL/Events.hsc" #-}++-- | Gets the state of modifier keys.+getModState :: IO [Modifier]+getModState = fmap fromBitmask sdlGetModState++-- void SDL_SetModState(SDLMod modstate);+foreign import ccall unsafe "SDL_SetModState" sdlSetModState :: Word32 -> IO ()+{-# LINE 507 "Graphics/UI/SDL/Events.hsc" #-}++-- | Sets the internal state of modifier keys.+setModState :: [Modifier] -> IO ()+setModState = sdlSetModState . toBitmask++mousePressed :: Word8 -> MouseButton -> Bool+mousePressed mask b+ = mask .&. (1 `shiftL` num) /= 0+ where num = fromIntegral (fromEnum b)+ ++-- Uint8 SDL_GetMouseState(int *x, int *y);+foreign import ccall "SDL_GetMouseState" sdlGetMouseState :: Ptr Int -> Ptr Int -> IO Word8+foreign import ccall "SDL_GetRelativeMouseState" sdlGetRelativeMouseState :: Ptr Int -> Ptr Int -> IO Word8++-- | Retrieves the current state of the mouse. Returns (X position, Y position, pressed buttons).+getMouseState :: IO (Int, Int, [MouseButton])+getMouseState = mouseStateGetter sdlGetMouseState++-- | Retrieve the current state of the mouse. Like 'getMouseState' except that X and Y are+-- set to the change since last call to getRelativeMouseState.+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])++++-- int SDL_PollEvent(SDL_Event *event);+foreign import ccall "SDL_PollEvent" sdlPollEvent :: Ptr Event -> IO Int++-- | Polls for currently pending events.+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++-- void SDL_PumpEvents(void);+-- | Pumps the event loop, gathering events from the input devices.+foreign import ccall unsafe "SDL_PumpEvents" pumpEvents :: IO ()++-- int SDL_PushEvent(SDL_Event *event);+foreign import ccall unsafe "SDL_PushEvent" sdlPushEvent :: Ptr Event -> IO Int++-- | Pushes an event onto the event queue. Returns @False@ on error.+tryPushEvent :: Event -> IO Bool+tryPushEvent event+ = new event >>= (fmap (0==) . sdlPushEvent)++-- | Pushes an event onto the event queue. Throws an exception on error.+pushEvent :: Event -> IO ()+pushEvent = unwrapBool "SDL_PushEvent" . tryPushEvent++-- int SDL_WaitEvent(SDL_Event *event);+foreign import ccall unsafe "SDL_WaitEvent" sdlWaitEvent :: Ptr Event -> IO Int++-- | Waits indefinitely for the next available event.+waitEvent :: IO Event+waitEvent+ = loop+ where loop = do pumpEvents+ event <- pollEvent+ case event of+ NoEvent -> threadDelay 10 >> loop+ _ -> return event++-- | Waits indefinitely for the next available event. Blocks Haskell threads.+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++-- Uint8 SDL_EventState(Uint8 type, int state);+foreign import ccall unsafe "SDL_EventState" sdlEventState :: Word8 -> Int -> IO Word8++-- |Enable or disable events from being processed.+enableEvent :: SDLEvent -> Bool -> IO ()+enableEvent event on+ = sdlEventState (fromSDLEvent event) (fromToggle state) >> return ()+ where state+ | on = Enable+ | otherwise = Disable++-- |Checks current state of a event. See also 'enableEvent'.+queryEventState :: SDLEvent -> IO Bool+queryEventState event+ = fmap (==1) (sdlEventState (fromSDLEvent event) (fromToggle Query))++-- Uint8 SDL_GetAppState(void);+foreign import ccall unsafe "SDL_GetAppState" sdlGetAppState :: IO Word8++-- | Gets the state of the application.+getAppState :: IO [Focus]+getAppState = fmap fromBitmask sdlGetAppState+
Graphics/UI/SDL/Events.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.Events
+ Graphics/UI/SDL/General.hs view
@@ -0,0 +1,182 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/General.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/General.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.General+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.General+ ( init+ , withInit+ , initSubSystem+ , quitSubSystem+ , quit+ , wasInit+ , getError+ , failWithError+ , unwrapBool+ , unwrapMaybe+ , unwrapInt+ , InitFlag(..)+ ) where++import Foreign.C (peekCString,CString)+import Data.Maybe (fromMaybe)+import Control.Monad (when)+import Data.Word (Word32)++import Control.Exception (bracket_)++import Prelude hiding (init,Enum(..))++import Graphics.UI.SDL.Utilities (Enum(..), toBitmask, fromBitmask)+++data InitFlag = InitTimer+ | InitAudio+ | InitVideo+ | InitCDROM+ | InitJoystick+ | InitNoParachute+ | InitEventthread+ | InitEverything+ deriving (Eq, Ord, Show, Read)+instance Bounded InitFlag where+ minBound = InitTimer+ maxBound = InitEventthread++instance Enum InitFlag Word32 where+ fromEnum InitTimer = 1+{-# LINE 55 "Graphics/UI/SDL/General.hsc" #-}+ fromEnum InitAudio = 16+{-# LINE 56 "Graphics/UI/SDL/General.hsc" #-}+ fromEnum InitVideo = 32+{-# LINE 57 "Graphics/UI/SDL/General.hsc" #-}+ fromEnum InitCDROM = 256+{-# LINE 58 "Graphics/UI/SDL/General.hsc" #-}+ fromEnum InitJoystick = 512+{-# LINE 59 "Graphics/UI/SDL/General.hsc" #-}+ fromEnum InitNoParachute = 1048576+{-# LINE 60 "Graphics/UI/SDL/General.hsc" #-}+ fromEnum InitEventthread = 16777216+{-# LINE 61 "Graphics/UI/SDL/General.hsc" #-}+ fromEnum InitEverything = 65535+{-# LINE 62 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 1 = InitTimer+{-# LINE 63 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 16 = InitAudio+{-# LINE 64 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 32= InitVideo+{-# LINE 65 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 256 = InitCDROM+{-# LINE 66 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 512 = InitJoystick+{-# LINE 67 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 1048576 = InitNoParachute+{-# LINE 68 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 16777216 = InitEventthread+{-# LINE 69 "Graphics/UI/SDL/General.hsc" #-}+ toEnum 65535 = InitEverything+{-# LINE 70 "Graphics/UI/SDL/General.hsc" #-}+ toEnum _ = error "Graphics.UI.SDL.General.toEnum: bad argument"+ succ InitTimer = InitAudio+ succ InitAudio = InitVideo+ succ InitVideo = InitCDROM+ succ InitCDROM = InitJoystick+ succ InitJoystick = InitNoParachute+ succ InitNoParachute = InitEventthread+ succ InitEventthread = InitEverything+ succ _ = error "Graphics.UI.SDL.General.succ: bad argument"+ pred InitAudio = InitTimer+ pred InitVideo = InitAudio+ pred InitCDROM = InitVideo+ pred InitJoystick = InitCDROM+ pred InitNoParachute = InitJoystick+ pred InitEventthread = InitNoParachute+ pred InitEverything = InitEventthread+ pred _ = error "Graphics.UI.SDL.General.pred: bad argument"+ enumFromTo x y | x > y = []+ | x == y = [y]+ | True = x : enumFromTo (succ x) y++unwrapMaybe :: String -> IO (Maybe a) -> IO a+unwrapMaybe errMsg action+ = do val <- action+ case val of+ Just a -> return a+ Nothing -> failWithError errMsg++unwrapInt :: (Int -> Bool) -> String -> IO Int -> IO Int+unwrapInt fn errMsg action+ = do val <- action+ if fn val+ then return val+ else failWithError errMsg++unwrapBool :: String -> IO Bool -> IO ()+unwrapBool errMsg action+ = do val <- action+ case val of+ True -> return ()+ False -> failWithError errMsg++foreign import ccall unsafe "SDL_Init" sdlInit :: Word32 -> IO Int+-- | Initializes SDL. This should be called before all other SDL functions.+init :: [InitFlag] -> IO ()+init flags+ = do ret <- sdlInit (fromIntegral (toBitmask flags))+ when (ret == (-1)) (failWithError "SDL_Init")++withInit :: [InitFlag] -> IO a -> IO a+withInit flags action+ = bracket_ (init flags) quit action++foreign import ccall unsafe "SDL_InitSubSystem" sdlInitSubSystem :: Word32 -> IO Int+-- | After SDL has been initialized with SDL_Init you may initialize+-- uninitialized subsystems with SDL_InitSubSystem.+initSubSystem :: [InitFlag] -> IO ()+initSubSystem flags+ = do ret <- sdlInitSubSystem (fromIntegral (toBitmask flags))+ when (ret == (-1)) (failWithError "SDL_InitSubSystem")++foreign import ccall unsafe "SDL_QuitSubSystem" sdlQuitSubSystem :: Word32 -> IO ()+quitSubSystem :: [InitFlag] -> IO ()+quitSubSystem = sdlQuitSubSystem . fromIntegral . toBitmask++foreign import ccall unsafe "SDL_Quit" sdlQuit :: IO ()+quit :: IO ()+quit = sdlQuit++foreign import ccall unsafe "SDL_WasInit" sdlWasInit :: Word32 -> IO Word32+-- | wasInit allows you to see which SDL subsytems have been initialized+wasInit :: [InitFlag] -> IO [InitFlag]+wasInit flags+ = do ret <- sdlWasInit (fromIntegral (toBitmask flags))+ return (fromBitmask (fromIntegral ret))+++foreign import ccall unsafe "SDL_GetError" sdlGetError :: IO CString+-- | Returns a string containing the last error. Nothing if no error.+getError :: IO (Maybe String)+getError+ = do str <- peekCString =<< sdlGetError + if null str+ then return Nothing+ else return (Just str)++failWithError :: String -> IO a+failWithError msg+ = do err <- fmap (fromMaybe "No SDL error") getError+ ioError $ userError $ msg ++ "\nSDL message: " ++ err+
Graphics/UI/SDL/General.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.General
+ Graphics/UI/SDL/Joystick.hs view
@@ -0,0 +1,182 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/Joystick.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/Joystick.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Joystick+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Joystick+ ( countAvailable+ , tryName+ , name+ , tryOpen+ , open+ , opened+ , index+ , axesAvailable+ , ballsAvailable+ , hatsAvailable+ , buttonsAvailable+ , update+ , getAxis+ , getHat+ , getButton+ , getBall+ , close+ ) where++import Foreign (Int16, Word8, Ptr, FunPtr, Storable(peek), unsafePerformIO,+ finalizeForeignPtr, toBool, maybePeek, alloca, withForeignPtr, newForeignPtr)+import Foreign.C (peekCString, CString)++import Graphics.UI.SDL.General (unwrapMaybe)+import Graphics.UI.SDL.Utilities (fromBitmask)+import Graphics.UI.SDL.Types (Hat, Joystick, JoystickStruct)++type JoystickIndex = Int++--int SDL_NumJoysticks(void);+-- | Counts the number of joysticks attached to the system.+foreign import ccall unsafe "SDL_NumJoysticks" countAvailable :: IO Int++-- const char *SDL_JoystickName(int index);+foreign import ccall unsafe "SDL_JoystickName" sdlJoystickName :: JoystickIndex -> IO CString+-- | Gets joystick name. Returns @Nothing@ on error.+tryName :: JoystickIndex -> IO (Maybe String)+tryName idx = sdlJoystickName idx >>= maybePeek peekCString++-- | Gets joystick name. Throws an exception on error.+name :: JoystickIndex -> IO String+name = unwrapMaybe "SDL_JoystickName" . tryName++-- SDL_Joystick *SDL_JoystickOpen(int index);+foreign import ccall unsafe "SDL_JoystickOpen" sdlJoystickOpen :: JoystickIndex -> IO (Ptr JoystickStruct)+-- | Opens a joystick for use. Returns @Nothing@ on error.+tryOpen :: JoystickIndex -> IO (Maybe Joystick)+tryOpen idx = sdlJoystickOpen idx >>= maybePeek mkFinalizedJoystick++-- | Opens a joystick for use. Throws an exception on error.+open :: JoystickIndex -> IO Joystick+open = unwrapMaybe "SDL_JoystickOpen" . tryOpen++-- int SDL_JoystickOpened(int index);+foreign import ccall unsafe "SDL_JoystickOpened" sdlJoystickOpened :: JoystickIndex -> IO Int++-- | Determines if a joystick has been opened.+opened :: JoystickIndex -> IO Bool+opened = fmap toBool . sdlJoystickOpened++-- int SDL_JoystickIndex(SDL_Joystick *joystick);+foreign import ccall unsafe "SDL_JoystickIndex" sdlJoystickIndex :: Ptr JoystickStruct -> JoystickIndex+-- | Gets the index of an @Joystick@.+index :: Joystick -> JoystickIndex+index joystick+ = unsafePerformIO $+ withForeignPtr joystick $+ return . sdlJoystickIndex++-- int SDL_JoystickNumAxes(SDL_Joystick *joystick);+foreign import ccall unsafe "SDL_JoystickNumAxes" sdlJoystickNumAxes :: Ptr JoystickStruct -> Int+-- | Gets the number of joystick axes.+axesAvailable :: Joystick -> Int+axesAvailable joystick+ = unsafePerformIO $+ withForeignPtr joystick $+ return . sdlJoystickNumAxes++-- int SDL_JoystickNumBalls(SDL_Joystick *joystick);+foreign import ccall unsafe "SDL_JoystickNumBalls" sdlJoystickNumBalls :: Ptr JoystickStruct -> Int+-- | Gets the number of joystick trackballs.+ballsAvailable :: Joystick -> Int+ballsAvailable joystick+ = unsafePerformIO $+ withForeignPtr joystick $+ return . sdlJoystickNumBalls++-- int SDL_JoystickNumHats(SDL_Joystick *joystick);+foreign import ccall unsafe "SDL_JoystickNumHats" sdlJoystickNumHats :: Ptr JoystickStruct -> Int+-- | Gets the number of joystick hats.+hatsAvailable :: Joystick -> Int+hatsAvailable joystick+ = unsafePerformIO $+ withForeignPtr joystick $+ return . sdlJoystickNumHats++-- int SDL_JoystickNumButtons(SDL_Joystick *joystick);+foreign import ccall unsafe "SDL_JoystickNumButtons" sdlJoystickNumButtons :: Ptr JoystickStruct -> Int+-- | Gets the number of joystick buttons.+buttonsAvailable :: Joystick -> Int+buttonsAvailable joystick+ = unsafePerformIO $+ withForeignPtr joystick $+ return . sdlJoystickNumButtons++-- void SDL_JoystickUpdate(void);+-- | Updates the state of all joysticks.+foreign import ccall unsafe "SDL_JoystickUpdate" update :: IO ()++-- Sint16 SDL_JoystickGetAxis(SDL_Joystick *joystick, int axis);+foreign import ccall unsafe "SDL_JoystickGetAxis" joystickGetAxis :: Ptr JoystickStruct -> Int -> IO Int16+-- | Gets the current state of an axis.+getAxis :: Joystick -> Word8 -> IO Int16+getAxis joystick axis+ = withForeignPtr joystick $ \ptr ->+ joystickGetAxis ptr (fromIntegral axis)++-- Uint8 SDL_JoystickGetHat(SDL_Joystick *joystick, int hat);+foreign import ccall unsafe "SDL_JoystickGetHat" joystickGetHat :: Ptr JoystickStruct -> Int -> IO Word8+-- | Gets the current state of a joystick hat.+getHat :: Joystick -> Word8 -> IO [Hat]+getHat joystick axis+ = withForeignPtr joystick $ \ptr ->+ fmap (fromBitmask.fromIntegral) (joystickGetHat ptr (fromIntegral axis))++-- Uint8 SDL_JoystickGetButton(SDL_Joystick *joystick, int button);+foreign import ccall unsafe "SDL_JoystickGetButton" joystickGetButton :: Ptr JoystickStruct -> Int -> IO Word8+-- | Gets the current state of a given button on a given joystick.+getButton :: Joystick -> Word8 -> IO Bool+getButton joystick button+ = withForeignPtr joystick $ \ptr ->+ fmap toBool (joystickGetButton ptr (fromIntegral button))++-- int SDL_JoystickGetBall(SDL_Joystick *joystick, int ball, int *dx, int *dy);+foreign import ccall unsafe "SDL_JoystickGetBall" joystickGetBall+ :: Ptr JoystickStruct -> Int -> Ptr Int -> Ptr Int -> IO Int+-- | Gets relative trackball motion.+getBall :: Joystick -> Word8 -> IO (Maybe (Int16,Int16))+getBall joystick ball+ = withForeignPtr joystick $ \ptr ->+ alloca $ \xrelPtr ->+ alloca $ \yrelPtr ->+ do ret <- joystickGetBall ptr (fromIntegral ball) xrelPtr yrelPtr+ case ret of+ 0 -> do [xrel,yrel] <- mapM (fmap fromIntegral . peek) [xrelPtr,yrelPtr]+ return $! Just (xrel,yrel)+ _ -> return Nothing++-- | Force finalization of a previous opened @Joystick@. Only supported with GHC.+close :: Joystick -> IO ()+close =++{-# LINE 166 "Graphics/UI/SDL/Joystick.hsc" #-}+ finalizeForeignPtr++{-# LINE 170 "Graphics/UI/SDL/Joystick.hsc" #-}++-- void SDL_JoystickClose(SDL_Joystick *joystick);+foreign import ccall unsafe "&SDL_JoystickClose" sdlCloseJoystickFinal :: FunPtr (Ptr JoystickStruct -> IO ())++mkFinalizedJoystick :: Ptr JoystickStruct -> IO Joystick+mkFinalizedJoystick = newForeignPtr sdlCloseJoystickFinal+
Graphics/UI/SDL/Joystick.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.Joystick
+ Graphics/UI/SDL/Keysym.hs view
@@ -0,0 +1,1325 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/Keysym.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/Keysym.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Keysym+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Keysym where++import Foreign (Word16, Word32,+ Storable(poke, sizeOf, alignment, peekByteOff, pokeByteOff, peek))+import Data.Char (chr, ord)+import Prelude hiding (Enum(..))++import Graphics.UI.SDL.Utilities (Enum(..), toBitmask, fromBitmask)++data Keysym+ = Keysym+ { symKey :: SDLKey,+ symModifiers :: [Modifier],+ symUnicode :: Char}+ deriving (Show,Eq)++instance Storable Keysym where+ sizeOf = const (16)+{-# LINE 31 "Graphics/UI/SDL/Keysym.hsc" #-}+ alignment = const 4+ poke ptr (Keysym key mods unicode)+ = do (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromEnum key)+{-# LINE 34 "Graphics/UI/SDL/Keysym.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (toBitmask mods)+{-# LINE 35 "Graphics/UI/SDL/Keysym.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr (fromIntegral (ord unicode) :: Word16)+{-# LINE 36 "Graphics/UI/SDL/Keysym.hsc" #-}+ peek ptr+ = do sym <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr+{-# LINE 38 "Graphics/UI/SDL/Keysym.hsc" #-}+ mods <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr+{-# LINE 39 "Graphics/UI/SDL/Keysym.hsc" #-}+ uni <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr+{-# LINE 40 "Graphics/UI/SDL/Keysym.hsc" #-}+ return $! Keysym (toEnum sym) (fromBitmask mods) (chr $ fromIntegral (uni::Word16))+++data Modifier = KeyModNone+ | KeyModLeftShift+ | KeyModRightShift+ | KeyModLeftCtrl+ | KeyModRightCtrl+ | KeyModLeftAlt+ | KeyModRightAlt+ | KeyModLeftMeta+ | KeyModRightMeta+ | KeyModNum+ | KeyModCaps+ | KeyModMode+ | KeyModCtrl+ | KeyModShift+ | KeyModAlt+ | KeyModMeta+ deriving (Eq, Ord, Show)+instance Bounded Modifier where+ minBound = KeyModNone+ maxBound = KeyModMode+instance Enum Modifier Word32 where+{-# LINE 64 "Graphics/UI/SDL/Keysym.hsc" #-}+ fromEnum KeyModNone = 0+ fromEnum KeyModLeftShift = 1+ fromEnum KeyModRightShift = 2+ fromEnum KeyModLeftCtrl = 64+ fromEnum KeyModRightCtrl = 128+ fromEnum KeyModLeftAlt = 256+ fromEnum KeyModRightAlt = 512+ fromEnum KeyModLeftMeta = 1024+ fromEnum KeyModRightMeta = 2048+ fromEnum KeyModNum = 4096+ fromEnum KeyModCaps = 8192+ fromEnum KeyModMode = 16384+ fromEnum KeyModCtrl = 192+ fromEnum KeyModShift = 3+ fromEnum KeyModAlt = 768+ fromEnum KeyModMeta = 3072+ toEnum 0 = KeyModNone+ toEnum 1 = KeyModLeftShift+ toEnum 2 = KeyModRightShift+ toEnum 64 = KeyModLeftCtrl+ toEnum 128 = KeyModRightCtrl+ toEnum 256 = KeyModLeftAlt+ toEnum 512 = KeyModRightAlt+ toEnum 1024 = KeyModLeftMeta+ toEnum 2048 = KeyModRightMeta+ toEnum 4096 = KeyModNum+ toEnum 8192 = KeyModCaps+ toEnum 16384 = KeyModMode+ toEnum 192 = KeyModCtrl+ toEnum 3 = KeyModShift+ toEnum 768 = KeyModAlt+ toEnum 3072 = KeyModMeta+ toEnum _ = error "Graphics.UI.SDL.Keysym.toEnum: bad argument"+ succ KeyModNone = KeyModLeftShift+ succ KeyModLeftShift = KeyModRightShift+ succ KeyModRightShift = KeyModLeftCtrl+ succ KeyModLeftCtrl = KeyModRightCtrl+ succ KeyModRightCtrl = KeyModLeftAlt+ succ KeyModLeftAlt = KeyModRightAlt+ succ KeyModRightAlt = KeyModLeftMeta+ succ KeyModLeftMeta = KeyModRightMeta+ succ KeyModRightMeta = KeyModNum+ succ KeyModNum = KeyModCaps+ succ KeyModCaps = KeyModMode+ succ KeyModMode = KeyModCtrl+ succ KeyModCtrl = KeyModShift+ succ KeyModShift = KeyModAlt+ succ KeyModAlt = KeyModMeta+ succ _ = error "Graphics.UI.SDL.Keysym.succ: bad argument"+ pred KeyModLeftShift = KeyModNone+ pred KeyModRightShift = KeyModLeftShift+ pred KeyModLeftCtrl = KeyModRightShift+ pred KeyModRightCtrl = KeyModLeftCtrl+ pred KeyModLeftAlt = KeyModRightCtrl+ pred KeyModRightAlt = KeyModLeftAlt+ pred KeyModLeftMeta = KeyModRightAlt+ pred KeyModRightMeta = KeyModLeftMeta+ pred KeyModNum = KeyModRightMeta+ pred KeyModCaps = KeyModNum+ pred KeyModMode = KeyModCaps+ pred KeyModCtrl = KeyModMode+ pred KeyModShift = KeyModCtrl+ pred KeyModAlt = KeyModShift+ pred KeyModMeta = KeyModAlt+ pred _ = error "Graphics.UI.SDL.Keysym.pred: bad argument"+ enumFromTo x y | x > y = []+ | x == y = [y]+ | True = x : enumFromTo (succ x) y++data SDLKey = SDLK_UNKNOWN+ | SDLK_FIRST+ | SDLK_BACKSPACE+ | SDLK_TAB+ | SDLK_CLEAR+ | SDLK_RETURN+ | SDLK_PAUSE+ | SDLK_ESCAPE+ | SDLK_SPACE+ | SDLK_EXCLAIM+ | SDLK_QUOTEDBL+ | SDLK_HASH+ | SDLK_DOLLAR+ | SDLK_AMPERSAND+ | SDLK_QUOTE+ | SDLK_LEFTPAREN+ | SDLK_RIGHTPAREN+ | SDLK_ASTERISK+ | SDLK_PLUS+ | SDLK_COMMA+ | SDLK_MINUS+ | SDLK_PERIOD+ | SDLK_SLASH+ | SDLK_0+ | SDLK_1+ | SDLK_2+ | SDLK_3+ | SDLK_4+ | SDLK_5+ | SDLK_6+ | SDLK_7+ | SDLK_8+ | SDLK_9+ | SDLK_COLON+ | SDLK_SEMICOLON+ | SDLK_LESS+ | SDLK_EQUALS+ | SDLK_GREATER+ | SDLK_QUESTION+ | SDLK_AT+ | SDLK_LEFTBRACKET+ | SDLK_BACKSLASH+ | SDLK_RIGHTBRACKET+ | SDLK_CARET+ | SDLK_UNDERSCORE+ | SDLK_BACKQUOTE+ | SDLK_a+ | SDLK_b+ | SDLK_c+ | SDLK_d+ | SDLK_e+ | SDLK_f+ | SDLK_g+ | SDLK_h+ | SDLK_i+ | SDLK_j+ | SDLK_k+ | SDLK_l+ | SDLK_m+ | SDLK_n+ | SDLK_o+ | SDLK_p+ | SDLK_q+ | SDLK_r+ | SDLK_s+ | SDLK_t+ | SDLK_u+ | SDLK_v+ | SDLK_w+ | SDLK_x+ | SDLK_y+ | SDLK_z+ | SDLK_DELETE+ | SDLK_WORLD_0+ | SDLK_WORLD_1+ | SDLK_WORLD_2+ | SDLK_WORLD_3+ | SDLK_WORLD_4+ | SDLK_WORLD_5+ | SDLK_WORLD_6+ | SDLK_WORLD_7+ | SDLK_WORLD_8+ | SDLK_WORLD_9+ | SDLK_WORLD_10+ | SDLK_WORLD_11+ | SDLK_WORLD_12+ | SDLK_WORLD_13+ | SDLK_WORLD_14+ | SDLK_WORLD_15+ | SDLK_WORLD_16+ | SDLK_WORLD_17+ | SDLK_WORLD_18+ | SDLK_WORLD_19+ | SDLK_WORLD_20+ | SDLK_WORLD_21+ | SDLK_WORLD_22+ | SDLK_WORLD_23+ | SDLK_WORLD_24+ | SDLK_WORLD_25+ | SDLK_WORLD_26+ | SDLK_WORLD_27+ | SDLK_WORLD_28+ | SDLK_WORLD_29+ | SDLK_WORLD_30+ | SDLK_WORLD_31+ | SDLK_WORLD_32+ | SDLK_WORLD_33+ | SDLK_WORLD_34+ | SDLK_WORLD_35+ | SDLK_WORLD_36+ | SDLK_WORLD_37+ | SDLK_WORLD_38+ | SDLK_WORLD_39+ | SDLK_WORLD_40+ | SDLK_WORLD_41+ | SDLK_WORLD_42+ | SDLK_WORLD_43+ | SDLK_WORLD_44+ | SDLK_WORLD_45+ | SDLK_WORLD_46+ | SDLK_WORLD_47+ | SDLK_WORLD_48+ | SDLK_WORLD_49+ | SDLK_WORLD_50+ | SDLK_WORLD_51+ | SDLK_WORLD_52+ | SDLK_WORLD_53+ | SDLK_WORLD_54+ | SDLK_WORLD_55+ | SDLK_WORLD_56+ | SDLK_WORLD_57+ | SDLK_WORLD_58+ | SDLK_WORLD_59+ | SDLK_WORLD_60+ | SDLK_WORLD_61+ | SDLK_WORLD_62+ | SDLK_WORLD_63+ | SDLK_WORLD_64+ | SDLK_WORLD_65+ | SDLK_WORLD_66+ | SDLK_WORLD_67+ | SDLK_WORLD_68+ | SDLK_WORLD_69+ | SDLK_WORLD_70+ | SDLK_WORLD_71+ | SDLK_WORLD_72+ | SDLK_WORLD_73+ | SDLK_WORLD_74+ | SDLK_WORLD_75+ | SDLK_WORLD_76+ | SDLK_WORLD_77+ | SDLK_WORLD_78+ | SDLK_WORLD_79+ | SDLK_WORLD_80+ | SDLK_WORLD_81+ | SDLK_WORLD_82+ | SDLK_WORLD_83+ | SDLK_WORLD_84+ | SDLK_WORLD_85+ | SDLK_WORLD_86+ | SDLK_WORLD_87+ | SDLK_WORLD_88+ | SDLK_WORLD_89+ | SDLK_WORLD_90+ | SDLK_WORLD_91+ | SDLK_WORLD_92+ | SDLK_WORLD_93+ | SDLK_WORLD_94+ | SDLK_WORLD_95+ | SDLK_KP0+ | SDLK_KP1+ | SDLK_KP2+ | SDLK_KP3+ | SDLK_KP4+ | SDLK_KP5+ | SDLK_KP6+ | SDLK_KP7+ | SDLK_KP8+ | SDLK_KP9+ | SDLK_KP_PERIOD+ | SDLK_KP_DIVIDE+ | SDLK_KP_MULTIPLY+ | SDLK_KP_MINUS+ | SDLK_KP_PLUS+ | SDLK_KP_ENTER+ | SDLK_KP_EQUALS+ | SDLK_UP+ | SDLK_DOWN+ | SDLK_RIGHT+ | SDLK_LEFT+ | SDLK_INSERT+ | SDLK_HOME+ | SDLK_END+ | SDLK_PAGEUP+ | SDLK_PAGEDOWN+ | SDLK_F1+ | SDLK_F2+ | SDLK_F3+ | SDLK_F4+ | SDLK_F5+ | SDLK_F6+ | SDLK_F7+ | SDLK_F8+ | SDLK_F9+ | SDLK_F10+ | SDLK_F11+ | SDLK_F12+ | SDLK_F13+ | SDLK_F14+ | SDLK_F15+ | SDLK_NUMLOCK+ | SDLK_CAPSLOCK+ | SDLK_SCROLLOCK+ | SDLK_RSHIFT+ | SDLK_LSHIFT+ | SDLK_RCTRL+ | SDLK_LCTRL+ | SDLK_RALT+ | SDLK_LALT+ | SDLK_RMETA+ | SDLK_LMETA+ | SDLK_LSUPER+ | SDLK_RSUPER+ | SDLK_MODE+ | SDLK_COMPOSE+ | SDLK_HELP+ | SDLK_PRINT+ | SDLK_SYSREQ+ | SDLK_BREAK+ | SDLK_MENU+ | SDLK_POWER+ | SDLK_EURO+ | SDLK_UNDO+ | SDLK_LAST+ deriving (Eq, Ord, Show)+instance Bounded SDLKey where+ minBound = SDLK_UNKNOWN+ maxBound = SDLK_LAST+instance Enum SDLKey Word32 where+{-# LINE 372 "Graphics/UI/SDL/Keysym.hsc" #-}+ fromEnum SDLK_UNKNOWN = 0+ fromEnum SDLK_FIRST = 0+ fromEnum SDLK_BACKSPACE = 8+ fromEnum SDLK_TAB = 9+ fromEnum SDLK_CLEAR = 12+ fromEnum SDLK_RETURN = 13+ fromEnum SDLK_PAUSE = 19+ fromEnum SDLK_ESCAPE = 27+ fromEnum SDLK_SPACE = 32+ fromEnum SDLK_EXCLAIM = 33+ fromEnum SDLK_QUOTEDBL = 34+ fromEnum SDLK_HASH = 35+ fromEnum SDLK_DOLLAR = 36+ fromEnum SDLK_AMPERSAND = 38+ fromEnum SDLK_QUOTE = 39+ fromEnum SDLK_LEFTPAREN = 40+ fromEnum SDLK_RIGHTPAREN = 41+ fromEnum SDLK_ASTERISK = 42+ fromEnum SDLK_PLUS = 43+ fromEnum SDLK_COMMA = 44+ fromEnum SDLK_MINUS = 45+ fromEnum SDLK_PERIOD = 46+ fromEnum SDLK_SLASH = 47+ fromEnum SDLK_0 = 48+ fromEnum SDLK_1 = 49+ fromEnum SDLK_2 = 50+ fromEnum SDLK_3 = 51+ fromEnum SDLK_4 = 52+ fromEnum SDLK_5 = 53+ fromEnum SDLK_6 = 54+ fromEnum SDLK_7 = 55+ fromEnum SDLK_8 = 56+ fromEnum SDLK_9 = 57+ fromEnum SDLK_COLON = 58+ fromEnum SDLK_SEMICOLON = 59+ fromEnum SDLK_LESS = 60+ fromEnum SDLK_EQUALS = 61+ fromEnum SDLK_GREATER = 62+ fromEnum SDLK_QUESTION = 63+ fromEnum SDLK_AT = 64+ fromEnum SDLK_LEFTBRACKET = 91+ fromEnum SDLK_BACKSLASH = 92+ fromEnum SDLK_RIGHTBRACKET = 93+ fromEnum SDLK_CARET = 94+ fromEnum SDLK_UNDERSCORE = 95+ fromEnum SDLK_BACKQUOTE = 96+ fromEnum SDLK_a = 97+ fromEnum SDLK_b = 98+ fromEnum SDLK_c = 99+ fromEnum SDLK_d = 100+ fromEnum SDLK_e = 101+ fromEnum SDLK_f = 102+ fromEnum SDLK_g = 103+ fromEnum SDLK_h = 104+ fromEnum SDLK_i = 105+ fromEnum SDLK_j = 106+ fromEnum SDLK_k = 107+ fromEnum SDLK_l = 108+ fromEnum SDLK_m = 109+ fromEnum SDLK_n = 110+ fromEnum SDLK_o = 111+ fromEnum SDLK_p = 112+ fromEnum SDLK_q = 113+ fromEnum SDLK_r = 114+ fromEnum SDLK_s = 115+ fromEnum SDLK_t = 116+ fromEnum SDLK_u = 117+ fromEnum SDLK_v = 118+ fromEnum SDLK_w = 119+ fromEnum SDLK_x = 120+ fromEnum SDLK_y = 121+ fromEnum SDLK_z = 122+ fromEnum SDLK_DELETE = 127+ fromEnum SDLK_WORLD_0 = 160+ fromEnum SDLK_WORLD_1 = 161+ fromEnum SDLK_WORLD_2 = 162+ fromEnum SDLK_WORLD_3 = 163+ fromEnum SDLK_WORLD_4 = 164+ fromEnum SDLK_WORLD_5 = 165+ fromEnum SDLK_WORLD_6 = 166+ fromEnum SDLK_WORLD_7 = 167+ fromEnum SDLK_WORLD_8 = 168+ fromEnum SDLK_WORLD_9 = 169+ fromEnum SDLK_WORLD_10 = 170+ fromEnum SDLK_WORLD_11 = 171+ fromEnum SDLK_WORLD_12 = 172+ fromEnum SDLK_WORLD_13 = 173+ fromEnum SDLK_WORLD_14 = 174+ fromEnum SDLK_WORLD_15 = 175+ fromEnum SDLK_WORLD_16 = 176+ fromEnum SDLK_WORLD_17 = 177+ fromEnum SDLK_WORLD_18 = 178+ fromEnum SDLK_WORLD_19 = 179+ fromEnum SDLK_WORLD_20 = 180+ fromEnum SDLK_WORLD_21 = 181+ fromEnum SDLK_WORLD_22 = 182+ fromEnum SDLK_WORLD_23 = 183+ fromEnum SDLK_WORLD_24 = 184+ fromEnum SDLK_WORLD_25 = 185+ fromEnum SDLK_WORLD_26 = 186+ fromEnum SDLK_WORLD_27 = 187+ fromEnum SDLK_WORLD_28 = 188+ fromEnum SDLK_WORLD_29 = 189+ fromEnum SDLK_WORLD_30 = 190+ fromEnum SDLK_WORLD_31 = 191+ fromEnum SDLK_WORLD_32 = 192+ fromEnum SDLK_WORLD_33 = 193+ fromEnum SDLK_WORLD_34 = 194+ fromEnum SDLK_WORLD_35 = 195+ fromEnum SDLK_WORLD_36 = 196+ fromEnum SDLK_WORLD_37 = 197+ fromEnum SDLK_WORLD_38 = 198+ fromEnum SDLK_WORLD_39 = 199+ fromEnum SDLK_WORLD_40 = 200+ fromEnum SDLK_WORLD_41 = 201+ fromEnum SDLK_WORLD_42 = 202+ fromEnum SDLK_WORLD_43 = 203+ fromEnum SDLK_WORLD_44 = 204+ fromEnum SDLK_WORLD_45 = 205+ fromEnum SDLK_WORLD_46 = 206+ fromEnum SDLK_WORLD_47 = 207+ fromEnum SDLK_WORLD_48 = 208+ fromEnum SDLK_WORLD_49 = 209+ fromEnum SDLK_WORLD_50 = 210+ fromEnum SDLK_WORLD_51 = 211+ fromEnum SDLK_WORLD_52 = 212+ fromEnum SDLK_WORLD_53 = 213+ fromEnum SDLK_WORLD_54 = 214+ fromEnum SDLK_WORLD_55 = 215+ fromEnum SDLK_WORLD_56 = 216+ fromEnum SDLK_WORLD_57 = 217+ fromEnum SDLK_WORLD_58 = 218+ fromEnum SDLK_WORLD_59 = 219+ fromEnum SDLK_WORLD_60 = 220+ fromEnum SDLK_WORLD_61 = 221+ fromEnum SDLK_WORLD_62 = 222+ fromEnum SDLK_WORLD_63 = 223+ fromEnum SDLK_WORLD_64 = 224+ fromEnum SDLK_WORLD_65 = 225+ fromEnum SDLK_WORLD_66 = 226+ fromEnum SDLK_WORLD_67 = 227+ fromEnum SDLK_WORLD_68 = 228+ fromEnum SDLK_WORLD_69 = 229+ fromEnum SDLK_WORLD_70 = 230+ fromEnum SDLK_WORLD_71 = 231+ fromEnum SDLK_WORLD_72 = 232+ fromEnum SDLK_WORLD_73 = 233+ fromEnum SDLK_WORLD_74 = 234+ fromEnum SDLK_WORLD_75 = 235+ fromEnum SDLK_WORLD_76 = 236+ fromEnum SDLK_WORLD_77 = 237+ fromEnum SDLK_WORLD_78 = 238+ fromEnum SDLK_WORLD_79 = 239+ fromEnum SDLK_WORLD_80 = 240+ fromEnum SDLK_WORLD_81 = 241+ fromEnum SDLK_WORLD_82 = 242+ fromEnum SDLK_WORLD_83 = 243+ fromEnum SDLK_WORLD_84 = 244+ fromEnum SDLK_WORLD_85 = 245+ fromEnum SDLK_WORLD_86 = 246+ fromEnum SDLK_WORLD_87 = 247+ fromEnum SDLK_WORLD_88 = 248+ fromEnum SDLK_WORLD_89 = 249+ fromEnum SDLK_WORLD_90 = 250+ fromEnum SDLK_WORLD_91 = 251+ fromEnum SDLK_WORLD_92 = 252+ fromEnum SDLK_WORLD_93 = 253+ fromEnum SDLK_WORLD_94 = 254+ fromEnum SDLK_WORLD_95 = 255+ fromEnum SDLK_KP0 = 256+ fromEnum SDLK_KP1 = 257+ fromEnum SDLK_KP2 = 258+ fromEnum SDLK_KP3 = 259+ fromEnum SDLK_KP4 = 260+ fromEnum SDLK_KP5 = 261+ fromEnum SDLK_KP6 = 262+ fromEnum SDLK_KP7 = 263+ fromEnum SDLK_KP8 = 264+ fromEnum SDLK_KP9 = 265+ fromEnum SDLK_KP_PERIOD = 266+ fromEnum SDLK_KP_DIVIDE = 267+ fromEnum SDLK_KP_MULTIPLY = 268+ fromEnum SDLK_KP_MINUS = 269+ fromEnum SDLK_KP_PLUS = 270+ fromEnum SDLK_KP_ENTER = 271+ fromEnum SDLK_KP_EQUALS = 272+ fromEnum SDLK_UP = 273+ fromEnum SDLK_DOWN = 274+ fromEnum SDLK_RIGHT = 275+ fromEnum SDLK_LEFT = 276+ fromEnum SDLK_INSERT = 277+ fromEnum SDLK_HOME = 278+ fromEnum SDLK_END = 279+ fromEnum SDLK_PAGEUP = 280+ fromEnum SDLK_PAGEDOWN = 281+ fromEnum SDLK_F1 = 282+ fromEnum SDLK_F2 = 283+ fromEnum SDLK_F3 = 284+ fromEnum SDLK_F4 = 285+ fromEnum SDLK_F5 = 286+ fromEnum SDLK_F6 = 287+ fromEnum SDLK_F7 = 288+ fromEnum SDLK_F8 = 289+ fromEnum SDLK_F9 = 290+ fromEnum SDLK_F10 = 291+ fromEnum SDLK_F11 = 292+ fromEnum SDLK_F12 = 293+ fromEnum SDLK_F13 = 294+ fromEnum SDLK_F14 = 295+ fromEnum SDLK_F15 = 296+ fromEnum SDLK_NUMLOCK = 300+ fromEnum SDLK_CAPSLOCK = 301+ fromEnum SDLK_SCROLLOCK = 302+ fromEnum SDLK_RSHIFT = 303+ fromEnum SDLK_LSHIFT = 304+ fromEnum SDLK_RCTRL = 305+ fromEnum SDLK_LCTRL = 306+ fromEnum SDLK_RALT = 307+ fromEnum SDLK_LALT = 308+ fromEnum SDLK_RMETA = 309+ fromEnum SDLK_LMETA = 310+ fromEnum SDLK_LSUPER = 311+ fromEnum SDLK_RSUPER = 312+ fromEnum SDLK_MODE = 313+ fromEnum SDLK_COMPOSE = 314+ fromEnum SDLK_HELP = 315+ fromEnum SDLK_PRINT = 316+ fromEnum SDLK_SYSREQ = 317+ fromEnum SDLK_BREAK = 318+ fromEnum SDLK_MENU = 319+ fromEnum SDLK_POWER = 320+ fromEnum SDLK_EURO = 321+ fromEnum SDLK_UNDO = 322+ fromEnum SDLK_LAST = 323+ toEnum 0 = SDLK_UNKNOWN+ toEnum 8 = SDLK_BACKSPACE+ toEnum 9 = SDLK_TAB+ toEnum 12 = SDLK_CLEAR+ toEnum 13 = SDLK_RETURN+ toEnum 19 = SDLK_PAUSE+ toEnum 27 = SDLK_ESCAPE+ toEnum 32 = SDLK_SPACE+ toEnum 33 = SDLK_EXCLAIM+ toEnum 34 = SDLK_QUOTEDBL+ toEnum 35 = SDLK_HASH+ toEnum 36 = SDLK_DOLLAR+ toEnum 38 = SDLK_AMPERSAND+ toEnum 39 = SDLK_QUOTE+ toEnum 40 = SDLK_LEFTPAREN+ toEnum 41 = SDLK_RIGHTPAREN+ toEnum 42 = SDLK_ASTERISK+ toEnum 43 = SDLK_PLUS+ toEnum 44 = SDLK_COMMA+ toEnum 45 = SDLK_MINUS+ toEnum 46 = SDLK_PERIOD+ toEnum 47 = SDLK_SLASH+ toEnum 48 = SDLK_0+ toEnum 49 = SDLK_1+ toEnum 50 = SDLK_2+ toEnum 51 = SDLK_3+ toEnum 52 = SDLK_4+ toEnum 53 = SDLK_5+ toEnum 54 = SDLK_6+ toEnum 55 = SDLK_7+ toEnum 56 = SDLK_8+ toEnum 57 = SDLK_9+ toEnum 58 = SDLK_COLON+ toEnum 59 = SDLK_SEMICOLON+ toEnum 60 = SDLK_LESS+ toEnum 61 = SDLK_EQUALS+ toEnum 62 = SDLK_GREATER+ toEnum 63 = SDLK_QUESTION+ toEnum 64 = SDLK_AT+ toEnum 91 = SDLK_LEFTBRACKET+ toEnum 92 = SDLK_BACKSLASH+ toEnum 93 = SDLK_RIGHTBRACKET+ toEnum 94 = SDLK_CARET+ toEnum 95 = SDLK_UNDERSCORE+ toEnum 96 = SDLK_BACKQUOTE+ toEnum 97 = SDLK_a+ toEnum 98 = SDLK_b+ toEnum 99 = SDLK_c+ toEnum 100 = SDLK_d+ toEnum 101 = SDLK_e+ toEnum 102 = SDLK_f+ toEnum 103 = SDLK_g+ toEnum 104 = SDLK_h+ toEnum 105 = SDLK_i+ toEnum 106 = SDLK_j+ toEnum 107 = SDLK_k+ toEnum 108 = SDLK_l+ toEnum 109 = SDLK_m+ toEnum 110 = SDLK_n+ toEnum 111 = SDLK_o+ toEnum 112 = SDLK_p+ toEnum 113 = SDLK_q+ toEnum 114 = SDLK_r+ toEnum 115 = SDLK_s+ toEnum 116 = SDLK_t+ toEnum 117 = SDLK_u+ toEnum 118 = SDLK_v+ toEnum 119 = SDLK_w+ toEnum 120 = SDLK_x+ toEnum 121 = SDLK_y+ toEnum 122 = SDLK_z+ toEnum 127 = SDLK_DELETE+ toEnum 160 = SDLK_WORLD_0+ toEnum 161 = SDLK_WORLD_1+ toEnum 162 = SDLK_WORLD_2+ toEnum 163 = SDLK_WORLD_3+ toEnum 164 = SDLK_WORLD_4+ toEnum 165 = SDLK_WORLD_5+ toEnum 166 = SDLK_WORLD_6+ toEnum 167 = SDLK_WORLD_7+ toEnum 168 = SDLK_WORLD_8+ toEnum 169 = SDLK_WORLD_9+ toEnum 170 = SDLK_WORLD_10+ toEnum 171 = SDLK_WORLD_11+ toEnum 172 = SDLK_WORLD_12+ toEnum 173 = SDLK_WORLD_13+ toEnum 174 = SDLK_WORLD_14+ toEnum 175 = SDLK_WORLD_15+ toEnum 176 = SDLK_WORLD_16+ toEnum 177 = SDLK_WORLD_17+ toEnum 178 = SDLK_WORLD_18+ toEnum 179 = SDLK_WORLD_19+ toEnum 180 = SDLK_WORLD_20+ toEnum 181 = SDLK_WORLD_21+ toEnum 182 = SDLK_WORLD_22+ toEnum 183 = SDLK_WORLD_23+ toEnum 184 = SDLK_WORLD_24+ toEnum 185 = SDLK_WORLD_25+ toEnum 186 = SDLK_WORLD_26+ toEnum 187 = SDLK_WORLD_27+ toEnum 188 = SDLK_WORLD_28+ toEnum 189 = SDLK_WORLD_29+ toEnum 190 = SDLK_WORLD_30+ toEnum 191 = SDLK_WORLD_31+ toEnum 192 = SDLK_WORLD_32+ toEnum 193 = SDLK_WORLD_33+ toEnum 194 = SDLK_WORLD_34+ toEnum 195 = SDLK_WORLD_35+ toEnum 196 = SDLK_WORLD_36+ toEnum 197 = SDLK_WORLD_37+ toEnum 198 = SDLK_WORLD_38+ toEnum 199 = SDLK_WORLD_39+ toEnum 200 = SDLK_WORLD_40+ toEnum 201 = SDLK_WORLD_41+ toEnum 202 = SDLK_WORLD_42+ toEnum 203 = SDLK_WORLD_43+ toEnum 204 = SDLK_WORLD_44+ toEnum 205 = SDLK_WORLD_45+ toEnum 206 = SDLK_WORLD_46+ toEnum 207 = SDLK_WORLD_47+ toEnum 208 = SDLK_WORLD_48+ toEnum 209 = SDLK_WORLD_49+ toEnum 210 = SDLK_WORLD_50+ toEnum 211 = SDLK_WORLD_51+ toEnum 212 = SDLK_WORLD_52+ toEnum 213 = SDLK_WORLD_53+ toEnum 214 = SDLK_WORLD_54+ toEnum 215 = SDLK_WORLD_55+ toEnum 216 = SDLK_WORLD_56+ toEnum 217 = SDLK_WORLD_57+ toEnum 218 = SDLK_WORLD_58+ toEnum 219 = SDLK_WORLD_59+ toEnum 220 = SDLK_WORLD_60+ toEnum 221 = SDLK_WORLD_61+ toEnum 222 = SDLK_WORLD_62+ toEnum 223 = SDLK_WORLD_63+ toEnum 224 = SDLK_WORLD_64+ toEnum 225 = SDLK_WORLD_65+ toEnum 226 = SDLK_WORLD_66+ toEnum 227 = SDLK_WORLD_67+ toEnum 228 = SDLK_WORLD_68+ toEnum 229 = SDLK_WORLD_69+ toEnum 230 = SDLK_WORLD_70+ toEnum 231 = SDLK_WORLD_71+ toEnum 232 = SDLK_WORLD_72+ toEnum 233 = SDLK_WORLD_73+ toEnum 234 = SDLK_WORLD_74+ toEnum 235 = SDLK_WORLD_75+ toEnum 236 = SDLK_WORLD_76+ toEnum 237 = SDLK_WORLD_77+ toEnum 238 = SDLK_WORLD_78+ toEnum 239 = SDLK_WORLD_79+ toEnum 240 = SDLK_WORLD_80+ toEnum 241 = SDLK_WORLD_81+ toEnum 242 = SDLK_WORLD_82+ toEnum 243 = SDLK_WORLD_83+ toEnum 244 = SDLK_WORLD_84+ toEnum 245 = SDLK_WORLD_85+ toEnum 246 = SDLK_WORLD_86+ toEnum 247 = SDLK_WORLD_87+ toEnum 248 = SDLK_WORLD_88+ toEnum 249 = SDLK_WORLD_89+ toEnum 250 = SDLK_WORLD_90+ toEnum 251 = SDLK_WORLD_91+ toEnum 252 = SDLK_WORLD_92+ toEnum 253 = SDLK_WORLD_93+ toEnum 254 = SDLK_WORLD_94+ toEnum 255 = SDLK_WORLD_95+ toEnum 256 = SDLK_KP0+ toEnum 257 = SDLK_KP1+ toEnum 258 = SDLK_KP2+ toEnum 259 = SDLK_KP3+ toEnum 260 = SDLK_KP4+ toEnum 261 = SDLK_KP5+ toEnum 262 = SDLK_KP6+ toEnum 263 = SDLK_KP7+ toEnum 264 = SDLK_KP8+ toEnum 265 = SDLK_KP9+ toEnum 266 = SDLK_KP_PERIOD+ toEnum 267 = SDLK_KP_DIVIDE+ toEnum 268 = SDLK_KP_MULTIPLY+ toEnum 269 = SDLK_KP_MINUS+ toEnum 270 = SDLK_KP_PLUS+ toEnum 271 = SDLK_KP_ENTER+ toEnum 272 = SDLK_KP_EQUALS+ toEnum 273 = SDLK_UP+ toEnum 274 = SDLK_DOWN+ toEnum 275 = SDLK_RIGHT+ toEnum 276 = SDLK_LEFT+ toEnum 277 = SDLK_INSERT+ toEnum 278 = SDLK_HOME+ toEnum 279 = SDLK_END+ toEnum 280 = SDLK_PAGEUP+ toEnum 281 = SDLK_PAGEDOWN+ toEnum 282 = SDLK_F1+ toEnum 283 = SDLK_F2+ toEnum 284 = SDLK_F3+ toEnum 285 = SDLK_F4+ toEnum 286 = SDLK_F5+ toEnum 287 = SDLK_F6+ toEnum 288 = SDLK_F7+ toEnum 289 = SDLK_F8+ toEnum 290 = SDLK_F9+ toEnum 291 = SDLK_F10+ toEnum 292 = SDLK_F11+ toEnum 293 = SDLK_F12+ toEnum 294 = SDLK_F13+ toEnum 295 = SDLK_F14+ toEnum 296 = SDLK_F15+ toEnum 300 = SDLK_NUMLOCK+ toEnum 301 = SDLK_CAPSLOCK+ toEnum 302 = SDLK_SCROLLOCK+ toEnum 303 = SDLK_RSHIFT+ toEnum 304 = SDLK_LSHIFT+ toEnum 305 = SDLK_RCTRL+ toEnum 306 = SDLK_LCTRL+ toEnum 307 = SDLK_RALT+ toEnum 308 = SDLK_LALT+ toEnum 309 = SDLK_RMETA+ toEnum 310 = SDLK_LMETA+ toEnum 311 = SDLK_LSUPER+ toEnum 312 = SDLK_RSUPER+ toEnum 313 = SDLK_MODE+ toEnum 314 = SDLK_COMPOSE+ toEnum 315 = SDLK_HELP+ toEnum 316 = SDLK_PRINT+ toEnum 317 = SDLK_SYSREQ+ toEnum 318 = SDLK_BREAK+ toEnum 319 = SDLK_MENU+ toEnum 320 = SDLK_POWER+ toEnum 321 = SDLK_EURO+ toEnum 322 = SDLK_UNDO+ toEnum 323 = SDLK_LAST+ toEnum _ = error "Graphics.UI.SDL.Keysym.toEnum: bad argument"+ succ SDLK_UNKNOWN = SDLK_FIRST+ succ SDLK_FIRST = SDLK_BACKSPACE+ succ SDLK_BACKSPACE = SDLK_TAB+ succ SDLK_TAB = SDLK_CLEAR+ succ SDLK_CLEAR = SDLK_RETURN+ succ SDLK_RETURN = SDLK_PAUSE+ succ SDLK_PAUSE = SDLK_ESCAPE+ succ SDLK_ESCAPE = SDLK_SPACE+ succ SDLK_SPACE = SDLK_EXCLAIM+ succ SDLK_EXCLAIM = SDLK_QUOTEDBL+ succ SDLK_QUOTEDBL = SDLK_HASH+ succ SDLK_HASH = SDLK_DOLLAR+ succ SDLK_DOLLAR = SDLK_AMPERSAND+ succ SDLK_AMPERSAND = SDLK_QUOTE+ succ SDLK_QUOTE = SDLK_LEFTPAREN+ succ SDLK_LEFTPAREN = SDLK_RIGHTPAREN+ succ SDLK_RIGHTPAREN = SDLK_ASTERISK+ succ SDLK_ASTERISK = SDLK_PLUS+ succ SDLK_PLUS = SDLK_COMMA+ succ SDLK_COMMA = SDLK_MINUS+ succ SDLK_MINUS = SDLK_PERIOD+ succ SDLK_PERIOD = SDLK_SLASH+ succ SDLK_SLASH = SDLK_0+ succ SDLK_0 = SDLK_1+ succ SDLK_1 = SDLK_2+ succ SDLK_2 = SDLK_3+ succ SDLK_3 = SDLK_4+ succ SDLK_4 = SDLK_5+ succ SDLK_5 = SDLK_6+ succ SDLK_6 = SDLK_7+ succ SDLK_7 = SDLK_8+ succ SDLK_8 = SDLK_9+ succ SDLK_9 = SDLK_COLON+ succ SDLK_COLON = SDLK_SEMICOLON+ succ SDLK_SEMICOLON = SDLK_LESS+ succ SDLK_LESS = SDLK_EQUALS+ succ SDLK_EQUALS = SDLK_GREATER+ succ SDLK_GREATER = SDLK_QUESTION+ succ SDLK_QUESTION = SDLK_AT+ succ SDLK_AT = SDLK_LEFTBRACKET+ succ SDLK_LEFTBRACKET = SDLK_BACKSLASH+ succ SDLK_BACKSLASH = SDLK_RIGHTBRACKET+ succ SDLK_RIGHTBRACKET = SDLK_CARET+ succ SDLK_CARET = SDLK_UNDERSCORE+ succ SDLK_UNDERSCORE = SDLK_BACKQUOTE+ succ SDLK_BACKQUOTE = SDLK_a+ succ SDLK_a = SDLK_b+ succ SDLK_b = SDLK_c+ succ SDLK_c = SDLK_d+ succ SDLK_d = SDLK_e+ succ SDLK_e = SDLK_f+ succ SDLK_f = SDLK_g+ succ SDLK_g = SDLK_h+ succ SDLK_h = SDLK_i+ succ SDLK_i = SDLK_j+ succ SDLK_j = SDLK_k+ succ SDLK_k = SDLK_l+ succ SDLK_l = SDLK_m+ succ SDLK_m = SDLK_n+ succ SDLK_n = SDLK_o+ succ SDLK_o = SDLK_p+ succ SDLK_p = SDLK_q+ succ SDLK_q = SDLK_r+ succ SDLK_r = SDLK_s+ succ SDLK_s = SDLK_t+ succ SDLK_t = SDLK_u+ succ SDLK_u = SDLK_v+ succ SDLK_v = SDLK_w+ succ SDLK_w = SDLK_x+ succ SDLK_x = SDLK_y+ succ SDLK_y = SDLK_z+ succ SDLK_z = SDLK_DELETE+ succ SDLK_DELETE = SDLK_WORLD_0+ succ SDLK_WORLD_0 = SDLK_WORLD_1+ succ SDLK_WORLD_1 = SDLK_WORLD_2+ succ SDLK_WORLD_2 = SDLK_WORLD_3+ succ SDLK_WORLD_3 = SDLK_WORLD_4+ succ SDLK_WORLD_4 = SDLK_WORLD_5+ succ SDLK_WORLD_5 = SDLK_WORLD_6+ succ SDLK_WORLD_6 = SDLK_WORLD_7+ succ SDLK_WORLD_7 = SDLK_WORLD_8+ succ SDLK_WORLD_8 = SDLK_WORLD_9+ succ SDLK_WORLD_9 = SDLK_WORLD_10+ succ SDLK_WORLD_10 = SDLK_WORLD_11+ succ SDLK_WORLD_11 = SDLK_WORLD_12+ succ SDLK_WORLD_12 = SDLK_WORLD_13+ succ SDLK_WORLD_13 = SDLK_WORLD_14+ succ SDLK_WORLD_14 = SDLK_WORLD_15+ succ SDLK_WORLD_15 = SDLK_WORLD_16+ succ SDLK_WORLD_16 = SDLK_WORLD_17+ succ SDLK_WORLD_17 = SDLK_WORLD_18+ succ SDLK_WORLD_18 = SDLK_WORLD_19+ succ SDLK_WORLD_19 = SDLK_WORLD_20+ succ SDLK_WORLD_20 = SDLK_WORLD_21+ succ SDLK_WORLD_21 = SDLK_WORLD_22+ succ SDLK_WORLD_22 = SDLK_WORLD_23+ succ SDLK_WORLD_23 = SDLK_WORLD_24+ succ SDLK_WORLD_24 = SDLK_WORLD_25+ succ SDLK_WORLD_25 = SDLK_WORLD_26+ succ SDLK_WORLD_26 = SDLK_WORLD_27+ succ SDLK_WORLD_27 = SDLK_WORLD_28+ succ SDLK_WORLD_28 = SDLK_WORLD_29+ succ SDLK_WORLD_29 = SDLK_WORLD_30+ succ SDLK_WORLD_30 = SDLK_WORLD_31+ succ SDLK_WORLD_31 = SDLK_WORLD_32+ succ SDLK_WORLD_32 = SDLK_WORLD_33+ succ SDLK_WORLD_33 = SDLK_WORLD_34+ succ SDLK_WORLD_34 = SDLK_WORLD_35+ succ SDLK_WORLD_35 = SDLK_WORLD_36+ succ SDLK_WORLD_36 = SDLK_WORLD_37+ succ SDLK_WORLD_37 = SDLK_WORLD_38+ succ SDLK_WORLD_38 = SDLK_WORLD_39+ succ SDLK_WORLD_39 = SDLK_WORLD_40+ succ SDLK_WORLD_40 = SDLK_WORLD_41+ succ SDLK_WORLD_41 = SDLK_WORLD_42+ succ SDLK_WORLD_42 = SDLK_WORLD_43+ succ SDLK_WORLD_43 = SDLK_WORLD_44+ succ SDLK_WORLD_44 = SDLK_WORLD_45+ succ SDLK_WORLD_45 = SDLK_WORLD_46+ succ SDLK_WORLD_46 = SDLK_WORLD_47+ succ SDLK_WORLD_47 = SDLK_WORLD_48+ succ SDLK_WORLD_48 = SDLK_WORLD_49+ succ SDLK_WORLD_49 = SDLK_WORLD_50+ succ SDLK_WORLD_50 = SDLK_WORLD_51+ succ SDLK_WORLD_51 = SDLK_WORLD_52+ succ SDLK_WORLD_52 = SDLK_WORLD_53+ succ SDLK_WORLD_53 = SDLK_WORLD_54+ succ SDLK_WORLD_54 = SDLK_WORLD_55+ succ SDLK_WORLD_55 = SDLK_WORLD_56+ succ SDLK_WORLD_56 = SDLK_WORLD_57+ succ SDLK_WORLD_57 = SDLK_WORLD_58+ succ SDLK_WORLD_58 = SDLK_WORLD_59+ succ SDLK_WORLD_59 = SDLK_WORLD_60+ succ SDLK_WORLD_60 = SDLK_WORLD_61+ succ SDLK_WORLD_61 = SDLK_WORLD_62+ succ SDLK_WORLD_62 = SDLK_WORLD_63+ succ SDLK_WORLD_63 = SDLK_WORLD_64+ succ SDLK_WORLD_64 = SDLK_WORLD_65+ succ SDLK_WORLD_65 = SDLK_WORLD_66+ succ SDLK_WORLD_66 = SDLK_WORLD_67+ succ SDLK_WORLD_67 = SDLK_WORLD_68+ succ SDLK_WORLD_68 = SDLK_WORLD_69+ succ SDLK_WORLD_69 = SDLK_WORLD_70+ succ SDLK_WORLD_70 = SDLK_WORLD_71+ succ SDLK_WORLD_71 = SDLK_WORLD_72+ succ SDLK_WORLD_72 = SDLK_WORLD_73+ succ SDLK_WORLD_73 = SDLK_WORLD_74+ succ SDLK_WORLD_74 = SDLK_WORLD_75+ succ SDLK_WORLD_75 = SDLK_WORLD_76+ succ SDLK_WORLD_76 = SDLK_WORLD_77+ succ SDLK_WORLD_77 = SDLK_WORLD_78+ succ SDLK_WORLD_78 = SDLK_WORLD_79+ succ SDLK_WORLD_79 = SDLK_WORLD_80+ succ SDLK_WORLD_80 = SDLK_WORLD_81+ succ SDLK_WORLD_81 = SDLK_WORLD_82+ succ SDLK_WORLD_82 = SDLK_WORLD_83+ succ SDLK_WORLD_83 = SDLK_WORLD_84+ succ SDLK_WORLD_84 = SDLK_WORLD_85+ succ SDLK_WORLD_85 = SDLK_WORLD_86+ succ SDLK_WORLD_86 = SDLK_WORLD_87+ succ SDLK_WORLD_87 = SDLK_WORLD_88+ succ SDLK_WORLD_88 = SDLK_WORLD_89+ succ SDLK_WORLD_89 = SDLK_WORLD_90+ succ SDLK_WORLD_90 = SDLK_WORLD_91+ succ SDLK_WORLD_91 = SDLK_WORLD_92+ succ SDLK_WORLD_92 = SDLK_WORLD_93+ succ SDLK_WORLD_93 = SDLK_WORLD_94+ succ SDLK_WORLD_94 = SDLK_WORLD_95+ succ SDLK_WORLD_95 = SDLK_KP0+ succ SDLK_KP0 = SDLK_KP1+ succ SDLK_KP1 = SDLK_KP2+ succ SDLK_KP2 = SDLK_KP3+ succ SDLK_KP3 = SDLK_KP4+ succ SDLK_KP4 = SDLK_KP5+ succ SDLK_KP5 = SDLK_KP6+ succ SDLK_KP6 = SDLK_KP7+ succ SDLK_KP7 = SDLK_KP8+ succ SDLK_KP8 = SDLK_KP9+ succ SDLK_KP9 = SDLK_KP_PERIOD+ succ SDLK_KP_PERIOD = SDLK_KP_DIVIDE+ succ SDLK_KP_DIVIDE = SDLK_KP_MULTIPLY+ succ SDLK_KP_MULTIPLY = SDLK_KP_MINUS+ succ SDLK_KP_MINUS = SDLK_KP_PLUS+ succ SDLK_KP_PLUS = SDLK_KP_ENTER+ succ SDLK_KP_ENTER = SDLK_KP_EQUALS+ succ SDLK_KP_EQUALS = SDLK_UP+ succ SDLK_UP = SDLK_DOWN+ succ SDLK_DOWN = SDLK_RIGHT+ succ SDLK_RIGHT = SDLK_LEFT+ succ SDLK_LEFT = SDLK_INSERT+ succ SDLK_INSERT = SDLK_HOME+ succ SDLK_HOME = SDLK_END+ succ SDLK_END = SDLK_PAGEUP+ succ SDLK_PAGEUP = SDLK_PAGEDOWN+ succ SDLK_PAGEDOWN = SDLK_F1+ succ SDLK_F1 = SDLK_F2+ succ SDLK_F2 = SDLK_F3+ succ SDLK_F3 = SDLK_F4+ succ SDLK_F4 = SDLK_F5+ succ SDLK_F5 = SDLK_F6+ succ SDLK_F6 = SDLK_F7+ succ SDLK_F7 = SDLK_F8+ succ SDLK_F8 = SDLK_F9+ succ SDLK_F9 = SDLK_F10+ succ SDLK_F10 = SDLK_F11+ succ SDLK_F11 = SDLK_F12+ succ SDLK_F12 = SDLK_F13+ succ SDLK_F13 = SDLK_F14+ succ SDLK_F14 = SDLK_F15+ succ SDLK_F15 = SDLK_NUMLOCK+ succ SDLK_NUMLOCK = SDLK_CAPSLOCK+ succ SDLK_CAPSLOCK = SDLK_SCROLLOCK+ succ SDLK_SCROLLOCK = SDLK_RSHIFT+ succ SDLK_RSHIFT = SDLK_LSHIFT+ succ SDLK_LSHIFT = SDLK_RCTRL+ succ SDLK_RCTRL = SDLK_LCTRL+ succ SDLK_LCTRL = SDLK_RALT+ succ SDLK_RALT = SDLK_LALT+ succ SDLK_LALT = SDLK_RMETA+ succ SDLK_RMETA = SDLK_LMETA+ succ SDLK_LMETA = SDLK_LSUPER+ succ SDLK_LSUPER = SDLK_RSUPER+ succ SDLK_RSUPER = SDLK_MODE+ succ SDLK_MODE = SDLK_COMPOSE+ succ SDLK_COMPOSE = SDLK_HELP+ succ SDLK_HELP = SDLK_PRINT+ succ SDLK_PRINT = SDLK_SYSREQ+ succ SDLK_SYSREQ = SDLK_BREAK+ succ SDLK_BREAK = SDLK_MENU+ succ SDLK_MENU = SDLK_POWER+ succ SDLK_POWER = SDLK_EURO+ succ SDLK_EURO = SDLK_UNDO+ succ SDLK_UNDO = SDLK_LAST+ succ _ = error "Graphics.UI.SDL.Keysym.succ: bad argument"+ pred SDLK_FIRST = SDLK_UNKNOWN+ pred SDLK_BACKSPACE = SDLK_FIRST+ pred SDLK_TAB = SDLK_BACKSPACE+ pred SDLK_CLEAR = SDLK_TAB+ pred SDLK_RETURN = SDLK_CLEAR+ pred SDLK_PAUSE = SDLK_RETURN+ pred SDLK_ESCAPE = SDLK_PAUSE+ pred SDLK_SPACE = SDLK_ESCAPE+ pred SDLK_EXCLAIM = SDLK_SPACE+ pred SDLK_QUOTEDBL = SDLK_EXCLAIM+ pred SDLK_HASH = SDLK_QUOTEDBL+ pred SDLK_DOLLAR = SDLK_HASH+ pred SDLK_AMPERSAND = SDLK_DOLLAR+ pred SDLK_QUOTE = SDLK_AMPERSAND+ pred SDLK_LEFTPAREN = SDLK_QUOTE+ pred SDLK_RIGHTPAREN = SDLK_LEFTPAREN+ pred SDLK_ASTERISK = SDLK_RIGHTPAREN+ pred SDLK_PLUS = SDLK_ASTERISK+ pred SDLK_COMMA = SDLK_PLUS+ pred SDLK_MINUS = SDLK_COMMA+ pred SDLK_PERIOD = SDLK_MINUS+ pred SDLK_SLASH = SDLK_PERIOD+ pred SDLK_0 = SDLK_SLASH+ pred SDLK_1 = SDLK_0+ pred SDLK_2 = SDLK_1+ pred SDLK_3 = SDLK_2+ pred SDLK_4 = SDLK_3+ pred SDLK_5 = SDLK_4+ pred SDLK_6 = SDLK_5+ pred SDLK_7 = SDLK_6+ pred SDLK_8 = SDLK_7+ pred SDLK_9 = SDLK_8+ pred SDLK_COLON = SDLK_9+ pred SDLK_SEMICOLON = SDLK_COLON+ pred SDLK_LESS = SDLK_SEMICOLON+ pred SDLK_EQUALS = SDLK_LESS+ pred SDLK_GREATER = SDLK_EQUALS+ pred SDLK_QUESTION = SDLK_GREATER+ pred SDLK_AT = SDLK_QUESTION+ pred SDLK_LEFTBRACKET = SDLK_AT+ pred SDLK_BACKSLASH = SDLK_LEFTBRACKET+ pred SDLK_RIGHTBRACKET = SDLK_BACKSLASH+ pred SDLK_CARET = SDLK_RIGHTBRACKET+ pred SDLK_UNDERSCORE = SDLK_CARET+ pred SDLK_BACKQUOTE = SDLK_UNDERSCORE+ pred SDLK_a = SDLK_BACKQUOTE+ pred SDLK_b = SDLK_a+ pred SDLK_c = SDLK_b+ pred SDLK_d = SDLK_c+ pred SDLK_e = SDLK_d+ pred SDLK_f = SDLK_e+ pred SDLK_g = SDLK_f+ pred SDLK_h = SDLK_g+ pred SDLK_i = SDLK_h+ pred SDLK_j = SDLK_i+ pred SDLK_k = SDLK_j+ pred SDLK_l = SDLK_k+ pred SDLK_m = SDLK_l+ pred SDLK_n = SDLK_m+ pred SDLK_o = SDLK_n+ pred SDLK_p = SDLK_o+ pred SDLK_q = SDLK_p+ pred SDLK_r = SDLK_q+ pred SDLK_s = SDLK_r+ pred SDLK_t = SDLK_s+ pred SDLK_u = SDLK_t+ pred SDLK_v = SDLK_u+ pred SDLK_w = SDLK_v+ pred SDLK_x = SDLK_w+ pred SDLK_y = SDLK_x+ pred SDLK_z = SDLK_y+ pred SDLK_DELETE = SDLK_z+ pred SDLK_WORLD_0 = SDLK_DELETE+ pred SDLK_WORLD_1 = SDLK_WORLD_0+ pred SDLK_WORLD_2 = SDLK_WORLD_1+ pred SDLK_WORLD_3 = SDLK_WORLD_2+ pred SDLK_WORLD_4 = SDLK_WORLD_3+ pred SDLK_WORLD_5 = SDLK_WORLD_4+ pred SDLK_WORLD_6 = SDLK_WORLD_5+ pred SDLK_WORLD_7 = SDLK_WORLD_6+ pred SDLK_WORLD_8 = SDLK_WORLD_7+ pred SDLK_WORLD_9 = SDLK_WORLD_8+ pred SDLK_WORLD_10 = SDLK_WORLD_9+ pred SDLK_WORLD_11 = SDLK_WORLD_10+ pred SDLK_WORLD_12 = SDLK_WORLD_11+ pred SDLK_WORLD_13 = SDLK_WORLD_12+ pred SDLK_WORLD_14 = SDLK_WORLD_13+ pred SDLK_WORLD_15 = SDLK_WORLD_14+ pred SDLK_WORLD_16 = SDLK_WORLD_15+ pred SDLK_WORLD_17 = SDLK_WORLD_16+ pred SDLK_WORLD_18 = SDLK_WORLD_17+ pred SDLK_WORLD_19 = SDLK_WORLD_18+ pred SDLK_WORLD_20 = SDLK_WORLD_19+ pred SDLK_WORLD_21 = SDLK_WORLD_20+ pred SDLK_WORLD_22 = SDLK_WORLD_21+ pred SDLK_WORLD_23 = SDLK_WORLD_22+ pred SDLK_WORLD_24 = SDLK_WORLD_23+ pred SDLK_WORLD_25 = SDLK_WORLD_24+ pred SDLK_WORLD_26 = SDLK_WORLD_25+ pred SDLK_WORLD_27 = SDLK_WORLD_26+ pred SDLK_WORLD_28 = SDLK_WORLD_27+ pred SDLK_WORLD_29 = SDLK_WORLD_28+ pred SDLK_WORLD_30 = SDLK_WORLD_29+ pred SDLK_WORLD_31 = SDLK_WORLD_30+ pred SDLK_WORLD_32 = SDLK_WORLD_31+ pred SDLK_WORLD_33 = SDLK_WORLD_32+ pred SDLK_WORLD_34 = SDLK_WORLD_33+ pred SDLK_WORLD_35 = SDLK_WORLD_34+ pred SDLK_WORLD_36 = SDLK_WORLD_35+ pred SDLK_WORLD_37 = SDLK_WORLD_36+ pred SDLK_WORLD_38 = SDLK_WORLD_37+ pred SDLK_WORLD_39 = SDLK_WORLD_38+ pred SDLK_WORLD_40 = SDLK_WORLD_39+ pred SDLK_WORLD_41 = SDLK_WORLD_40+ pred SDLK_WORLD_42 = SDLK_WORLD_41+ pred SDLK_WORLD_43 = SDLK_WORLD_42+ pred SDLK_WORLD_44 = SDLK_WORLD_43+ pred SDLK_WORLD_45 = SDLK_WORLD_44+ pred SDLK_WORLD_46 = SDLK_WORLD_45+ pred SDLK_WORLD_47 = SDLK_WORLD_46+ pred SDLK_WORLD_48 = SDLK_WORLD_47+ pred SDLK_WORLD_49 = SDLK_WORLD_48+ pred SDLK_WORLD_50 = SDLK_WORLD_49+ pred SDLK_WORLD_51 = SDLK_WORLD_50+ pred SDLK_WORLD_52 = SDLK_WORLD_51+ pred SDLK_WORLD_53 = SDLK_WORLD_52+ pred SDLK_WORLD_54 = SDLK_WORLD_53+ pred SDLK_WORLD_55 = SDLK_WORLD_54+ pred SDLK_WORLD_56 = SDLK_WORLD_55+ pred SDLK_WORLD_57 = SDLK_WORLD_56+ pred SDLK_WORLD_58 = SDLK_WORLD_57+ pred SDLK_WORLD_59 = SDLK_WORLD_58+ pred SDLK_WORLD_60 = SDLK_WORLD_59+ pred SDLK_WORLD_61 = SDLK_WORLD_60+ pred SDLK_WORLD_62 = SDLK_WORLD_61+ pred SDLK_WORLD_63 = SDLK_WORLD_62+ pred SDLK_WORLD_64 = SDLK_WORLD_63+ pred SDLK_WORLD_65 = SDLK_WORLD_64+ pred SDLK_WORLD_66 = SDLK_WORLD_65+ pred SDLK_WORLD_67 = SDLK_WORLD_66+ pred SDLK_WORLD_68 = SDLK_WORLD_67+ pred SDLK_WORLD_69 = SDLK_WORLD_68+ pred SDLK_WORLD_70 = SDLK_WORLD_69+ pred SDLK_WORLD_71 = SDLK_WORLD_70+ pred SDLK_WORLD_72 = SDLK_WORLD_71+ pred SDLK_WORLD_73 = SDLK_WORLD_72+ pred SDLK_WORLD_74 = SDLK_WORLD_73+ pred SDLK_WORLD_75 = SDLK_WORLD_74+ pred SDLK_WORLD_76 = SDLK_WORLD_75+ pred SDLK_WORLD_77 = SDLK_WORLD_76+ pred SDLK_WORLD_78 = SDLK_WORLD_77+ pred SDLK_WORLD_79 = SDLK_WORLD_78+ pred SDLK_WORLD_80 = SDLK_WORLD_79+ pred SDLK_WORLD_81 = SDLK_WORLD_80+ pred SDLK_WORLD_82 = SDLK_WORLD_81+ pred SDLK_WORLD_83 = SDLK_WORLD_82+ pred SDLK_WORLD_84 = SDLK_WORLD_83+ pred SDLK_WORLD_85 = SDLK_WORLD_84+ pred SDLK_WORLD_86 = SDLK_WORLD_85+ pred SDLK_WORLD_87 = SDLK_WORLD_86+ pred SDLK_WORLD_88 = SDLK_WORLD_87+ pred SDLK_WORLD_89 = SDLK_WORLD_88+ pred SDLK_WORLD_90 = SDLK_WORLD_89+ pred SDLK_WORLD_91 = SDLK_WORLD_90+ pred SDLK_WORLD_92 = SDLK_WORLD_91+ pred SDLK_WORLD_93 = SDLK_WORLD_92+ pred SDLK_WORLD_94 = SDLK_WORLD_93+ pred SDLK_WORLD_95 = SDLK_WORLD_94+ pred SDLK_KP0 = SDLK_WORLD_95+ pred SDLK_KP1 = SDLK_KP0+ pred SDLK_KP2 = SDLK_KP1+ pred SDLK_KP3 = SDLK_KP2+ pred SDLK_KP4 = SDLK_KP3+ pred SDLK_KP5 = SDLK_KP4+ pred SDLK_KP6 = SDLK_KP5+ pred SDLK_KP7 = SDLK_KP6+ pred SDLK_KP8 = SDLK_KP7+ pred SDLK_KP9 = SDLK_KP8+ pred SDLK_KP_PERIOD = SDLK_KP9+ pred SDLK_KP_DIVIDE = SDLK_KP_PERIOD+ pred SDLK_KP_MULTIPLY = SDLK_KP_DIVIDE+ pred SDLK_KP_MINUS = SDLK_KP_MULTIPLY+ pred SDLK_KP_PLUS = SDLK_KP_MINUS+ pred SDLK_KP_ENTER = SDLK_KP_PLUS+ pred SDLK_KP_EQUALS = SDLK_KP_ENTER+ pred SDLK_UP = SDLK_KP_EQUALS+ pred SDLK_DOWN = SDLK_UP+ pred SDLK_RIGHT = SDLK_DOWN+ pred SDLK_LEFT = SDLK_RIGHT+ pred SDLK_INSERT = SDLK_LEFT+ pred SDLK_HOME = SDLK_INSERT+ pred SDLK_END = SDLK_HOME+ pred SDLK_PAGEUP = SDLK_END+ pred SDLK_PAGEDOWN = SDLK_PAGEUP+ pred SDLK_F1 = SDLK_PAGEDOWN+ pred SDLK_F2 = SDLK_F1+ pred SDLK_F3 = SDLK_F2+ pred SDLK_F4 = SDLK_F3+ pred SDLK_F5 = SDLK_F4+ pred SDLK_F6 = SDLK_F5+ pred SDLK_F7 = SDLK_F6+ pred SDLK_F8 = SDLK_F7+ pred SDLK_F9 = SDLK_F8+ pred SDLK_F10 = SDLK_F9+ pred SDLK_F11 = SDLK_F10+ pred SDLK_F12 = SDLK_F11+ pred SDLK_F13 = SDLK_F12+ pred SDLK_F14 = SDLK_F13+ pred SDLK_F15 = SDLK_F14+ pred SDLK_NUMLOCK = SDLK_F15+ pred SDLK_CAPSLOCK = SDLK_NUMLOCK+ pred SDLK_SCROLLOCK = SDLK_CAPSLOCK+ pred SDLK_RSHIFT = SDLK_SCROLLOCK+ pred SDLK_LSHIFT = SDLK_RSHIFT+ pred SDLK_RCTRL = SDLK_LSHIFT+ pred SDLK_LCTRL = SDLK_RCTRL+ pred SDLK_RALT = SDLK_LCTRL+ pred SDLK_LALT = SDLK_RALT+ pred SDLK_RMETA = SDLK_LALT+ pred SDLK_LMETA = SDLK_RMETA+ pred SDLK_LSUPER = SDLK_LMETA+ pred SDLK_RSUPER = SDLK_LSUPER+ pred SDLK_MODE = SDLK_RSUPER+ pred SDLK_COMPOSE = SDLK_MODE+ pred SDLK_HELP = SDLK_COMPOSE+ pred SDLK_PRINT = SDLK_HELP+ pred SDLK_SYSREQ = SDLK_PRINT+ pred SDLK_BREAK = SDLK_SYSREQ+ pred SDLK_MENU = SDLK_BREAK+ pred SDLK_POWER = SDLK_MENU+ pred SDLK_EURO = SDLK_POWER+ pred SDLK_UNDO = SDLK_EURO+ pred SDLK_LAST = SDLK_UNDO+ pred _ = error "Graphics.UI.SDL.Keysym.pred: bad argument"+ enumFromTo x y | x > y = []+ | x == y = [y]+ | True = x : enumFromTo (succ x) y
Graphics/UI/SDL/Keysym.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.Keysym
+ Graphics/UI/SDL/Rect.hs view
@@ -0,0 +1,55 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/Rect.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/Rect.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Video+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Rect where++import Foreign (Storable(poke, sizeOf, alignment, peekByteOff, pokeByteOff,+ peek))+import Data.Word (Word16)+import Data.Int (Int16)++data Rect+ = Rect+ { rectX, rectY :: Int, -- Actually Int16+ rectW, rectH :: Int } -- Actually Word16+ deriving (Show,Eq,Ord)++instance Storable Rect where+ sizeOf = const (8)+{-# LINE 28 "Graphics/UI/SDL/Rect.hsc" #-}+ alignment = const 2+ peek ptr+ = do x <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO Int16+{-# LINE 31 "Graphics/UI/SDL/Rect.hsc" #-}+ y <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr :: IO Int16+{-# LINE 32 "Graphics/UI/SDL/Rect.hsc" #-}+ w <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO Word16+{-# LINE 33 "Graphics/UI/SDL/Rect.hsc" #-}+ h <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr :: IO Word16+{-# LINE 34 "Graphics/UI/SDL/Rect.hsc" #-}+ return $! Rect (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)+ poke ptr (Rect x y w h)+ = do (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral x :: Int16)+{-# LINE 37 "Graphics/UI/SDL/Rect.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (fromIntegral y :: Int16)+{-# LINE 38 "Graphics/UI/SDL/Rect.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromIntegral w :: Word16)+{-# LINE 39 "Graphics/UI/SDL/Rect.hsc" #-}+ (\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr (fromIntegral h :: Word16)+{-# LINE 40 "Graphics/UI/SDL/Rect.hsc" #-}+
Graphics/UI/SDL/Rect.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.Video
+ Graphics/UI/SDL/Types.hs view
@@ -0,0 +1,324 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/Types.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/Types.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Types+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Types+ ( SurfaceStruct+ , Surface+ , VideoInfoStruct+ , VideoInfo+ , RWopsStruct+ , RWops+ , PixelFormatStruct+ , PixelFormat+ , JoystickStruct+ , Joystick+ , Hat(..)+ , TimerIDStruct+ , SurfaceFlag (..)+ , surfaceGetPixelFormat+ , surfaceGetWidth+ , surfaceGetHeight+ , surfaceGetFlags+ , surfaceGetPitch+ , surfaceGetPixels+ , pixelFormatGetAlpha+ , pixelFormatGetColorKey+ , pixelFormatGetBitsPerPixel+ , pixelFormatGetBytesPerPixel+ , videoInfoWidth+ , videoInfoHeight+ ) where++import Foreign (Word8, Word16, Word32, Ptr, Storable(peekByteOff),+ unsafePerformIO, newForeignPtr_, ForeignPtr, withForeignPtr)++import Graphics.UI.SDL.Utilities (Enum(..), fromBitmask)+import Graphics.UI.SDL.Color (Pixel(..))++import Prelude hiding (Enum(..))++data SurfaceStruct+type Surface = ForeignPtr SurfaceStruct++data VideoInfoStruct+type VideoInfo = ForeignPtr VideoInfoStruct++data RWopsStruct+type RWops = ForeignPtr RWopsStruct++data PixelFormatStruct+type PixelFormat = ForeignPtr PixelFormatStruct++data TimerIDStruct++data PixelsData+type Pixels = Ptr PixelsData++data JoystickStruct+type Joystick = ForeignPtr JoystickStruct++data Hat+ = HatCentered+ | HatUp+ | HatRight+ | HatDown+ | HatLeft+ | HatRightUp+ | HatRightDown+ | HatLeftUp+ | HatLeftDown+ deriving (Show,Eq,Ord)++instance Bounded Hat where+ minBound = HatCentered+ maxBound = HatLeftDown++instance Enum Hat Word8 where+ fromEnum HatCentered = 0+{-# LINE 87 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatUp = 1+{-# LINE 88 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatRight = 2+{-# LINE 89 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatDown = 4+{-# LINE 90 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatLeft = 8+{-# LINE 91 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatRightUp = 3+{-# LINE 92 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatRightDown = 6+{-# LINE 93 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatLeftUp = 9+{-# LINE 94 "Graphics/UI/SDL/Types.hsc" #-}+ fromEnum HatLeftDown = 12+{-# LINE 95 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 0 = HatCentered+{-# LINE 96 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 1 = HatUp+{-# LINE 97 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 2 = HatRight+{-# LINE 98 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 4 = HatDown+{-# LINE 99 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 8 = HatLeft+{-# LINE 100 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 3 = HatRightUp+{-# LINE 101 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 6 = HatRightDown+{-# LINE 102 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 9 = HatLeftUp+{-# LINE 103 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum 12 = HatLeftDown+{-# LINE 104 "Graphics/UI/SDL/Types.hsc" #-}+ toEnum _ = error "Graphics.UI.SDL.Types.toEnum: bad argument"+ succ HatCentered = HatUp+ succ HatUp = HatRight+ succ HatRight = HatDown+ succ HatDown = HatLeft+ succ HatLeft = HatRightUp+ succ HatRightUp = HatRightDown+ succ HatRightDown = HatLeftUp+ succ HatLeftUp = HatLeftDown+ succ _ = error "Graphics.UI.SDL.Types.succ: bad argument"+ pred HatUp = HatCentered+ pred HatRight = HatUp+ pred HatDown = HatRight+ pred HatLeft = HatDown+ pred HatRightUp = HatLeft+ pred HatRightDown = HatRightUp+ pred HatLeftUp = HatRightDown+ pred HatLeftDown = HatLeftUp+ pred _ = error "Graphics.UI.SDL.Types.pred: bad argument"+ enumFromTo x y | x > y = []+ | x == y = [y]+ | True = x : enumFromTo (succ x) y+ ++data SurfaceFlag+ = SWSurface+ | HWSurface+ | OpenGL+ | ASyncBlit+ | OpenGLBlit+ | Resizable+ | NoFrame+ | HWAccel+ | SrcColorKey+ | RLEAccel+ | SrcAlpha+ | PreAlloc+ | AnyFormat+ | HWPalette+ | DoubleBuf+ | Fullscreen+ deriving (Eq, Ord, Show, Read)+instance Bounded SurfaceFlag where+ minBound = SWSurface+ maxBound = Fullscreen+instance Enum SurfaceFlag Word32 where+ fromEnum SWSurface = 0+ fromEnum HWSurface = 1+ fromEnum OpenGL = 2+ fromEnum ASyncBlit = 4+ fromEnum OpenGLBlit = 10+ fromEnum Resizable = 16+ fromEnum NoFrame = 32+ fromEnum HWAccel = 256+ fromEnum SrcColorKey = 4096+ fromEnum RLEAccel = 16384+ fromEnum SrcAlpha = 65536+ fromEnum PreAlloc = 16777216+ fromEnum AnyFormat = 268435456+ fromEnum HWPalette = 536870912+ fromEnum DoubleBuf = 1073741824+ fromEnum Fullscreen = 2147483648+ toEnum 0 = SWSurface+ toEnum 1 = HWSurface+ toEnum 4 = ASyncBlit+ toEnum 2 = OpenGL+ toEnum 10 = OpenGLBlit+ toEnum 16 = Resizable+ toEnum 32 = NoFrame+ toEnum 256 = HWAccel+ toEnum 4096 = SrcColorKey+ toEnum 16384 = RLEAccel+ toEnum 65536 = SrcAlpha+ toEnum 16777216 = PreAlloc+ toEnum 268435456 = AnyFormat+ toEnum 536870912 = HWPalette+ toEnum 1073741824 = DoubleBuf+ toEnum 2147483648 = Fullscreen+ toEnum _ = error "Graphics.UI.SDL.Types.fromEnum: bad argument"+ succ SWSurface = HWSurface+ succ HWSurface = OpenGL+ succ OpenGL = ASyncBlit+ succ ASyncBlit = OpenGLBlit+ succ OpenGLBlit = Resizable+ succ Resizable = NoFrame+ succ NoFrame = HWAccel+ succ HWAccel = SrcColorKey+ succ SrcColorKey = RLEAccel+ succ RLEAccel = SrcAlpha+ succ SrcAlpha = PreAlloc+ succ PreAlloc = AnyFormat+ succ AnyFormat = HWPalette+ succ HWPalette = DoubleBuf+ succ DoubleBuf = Fullscreen+ succ _ = error "Graphics.UI.SDL.Types.succ: bad argument"++ pred HWSurface = SWSurface+ pred OpenGL = HWSurface+ pred ASyncBlit = OpenGL+ pred OpenGLBlit = ASyncBlit+ pred Resizable = OpenGLBlit+ pred NoFrame = Resizable+ pred HWAccel = NoFrame+ pred SrcColorKey = HWAccel+ pred RLEAccel = SrcColorKey+ pred SrcAlpha = RLEAccel+ pred PreAlloc = SrcAlpha+ pred AnyFormat = PreAlloc+ pred HWPalette = AnyFormat+ pred DoubleBuf = HWPalette+ pred Fullscreen = DoubleBuf+ pred _ = error "Graphics.UI.SDL.Types.pred: bad argument"++ enumFromTo x y | x > y = []+ | x == y = [y]+ | True = x : enumFromTo (succ x) y+++surfaceGetPixelFormat :: Surface -> PixelFormat+surfaceGetPixelFormat surface+ = unsafePerformIO $+ withForeignPtr surface $ \ptr ->+ newForeignPtr_ =<< (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr+{-# LINE 227 "Graphics/UI/SDL/Types.hsc" #-}++pixelFormatGetAlpha :: PixelFormat -> IO Word8+pixelFormatGetAlpha format =+ withForeignPtr format $+ (\hsc_ptr -> peekByteOff hsc_ptr 40)+{-# LINE 232 "Graphics/UI/SDL/Types.hsc" #-}++pixelFormatGetColorKey :: PixelFormat -> IO Pixel+pixelFormatGetColorKey format =+ fmap Pixel $+ withForeignPtr format $+ (\hsc_ptr -> peekByteOff hsc_ptr 36)+{-# LINE 238 "Graphics/UI/SDL/Types.hsc" #-}++pixelFormatGetBitsPerPixel :: PixelFormat -> IO Word8+pixelFormatGetBitsPerPixel format+ = withForeignPtr format $+ (\hsc_ptr -> peekByteOff hsc_ptr 8)+{-# LINE 243 "Graphics/UI/SDL/Types.hsc" #-}++pixelFormatGetBytesPerPixel :: PixelFormat -> IO Word8+pixelFormatGetBytesPerPixel format+ = withForeignPtr format $+ (\hsc_ptr -> peekByteOff hsc_ptr 9)+{-# LINE 248 "Graphics/UI/SDL/Types.hsc" #-}++surfaceGetWidth :: Surface -> Int+surfaceGetWidth surface+ = unsafePerformIO $+ withForeignPtr surface $+ (\hsc_ptr -> peekByteOff hsc_ptr 16)+{-# LINE 254 "Graphics/UI/SDL/Types.hsc" #-}++surfaceGetHeight :: Surface -> Int+surfaceGetHeight surface+ = unsafePerformIO $+ withForeignPtr surface $+ (\hsc_ptr -> peekByteOff hsc_ptr 20)+{-# LINE 260 "Graphics/UI/SDL/Types.hsc" #-}++surfaceGetFlags :: Surface -> IO [SurfaceFlag]+surfaceGetFlags surface+ = withForeignPtr surface $+ fmap fromBitmask . (\hsc_ptr -> peekByteOff hsc_ptr 0)+{-# LINE 265 "Graphics/UI/SDL/Types.hsc" #-}++surfaceGetPitch :: Surface -> Word16+surfaceGetPitch surface+ = unsafePerformIO $+ withForeignPtr surface $+ (\hsc_ptr -> peekByteOff hsc_ptr 24)+{-# LINE 271 "Graphics/UI/SDL/Types.hsc" #-}++surfaceGetPixels :: Surface -> IO Pixels+surfaceGetPixels surface+ = withForeignPtr surface $+ (\hsc_ptr -> peekByteOff hsc_ptr 32)+{-# LINE 276 "Graphics/UI/SDL/Types.hsc" #-}++videoInfoWidth :: VideoInfo -> Int+videoInfoWidth vi+ = unsafePerformIO $+ withForeignPtr vi $+ (\hsc_ptr -> peekByteOff hsc_ptr 16)+{-# LINE 282 "Graphics/UI/SDL/Types.hsc" #-}++videoInfoHeight :: VideoInfo -> Int+videoInfoHeight vi+ = unsafePerformIO $+ withForeignPtr vi $+ (\hsc_ptr -> peekByteOff hsc_ptr 20)+{-# LINE 288 "Graphics/UI/SDL/Types.hsc" #-}+
Graphics/UI/SDL/Types.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.Types
+ Graphics/UI/SDL/Version.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/Version.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/Version.hsc" #-}+module Graphics.UI.SDL.Version+ ( compiledFor+ , linkedWith+ ) where++import Data.Version (Version(Version))++import Foreign (Word8, Ptr, Storable(sizeOf, alignment, peekByteOff, peek))++data SDLVersion+ = SDLVersion Word8 Word8 Word8++instance Storable SDLVersion where+ sizeOf _ = (3)+{-# LINE 16 "Graphics/UI/SDL/Version.hsc" #-}+ alignment _ = 1+ peek ptr = do major <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr+{-# LINE 18 "Graphics/UI/SDL/Version.hsc" #-}+ minor <- (\hsc_ptr -> peekByteOff hsc_ptr 1) ptr+{-# LINE 19 "Graphics/UI/SDL/Version.hsc" #-}+ patch <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr+{-# LINE 20 "Graphics/UI/SDL/Version.hsc" #-}+ return (SDLVersion major minor patch)++compiledFor :: Version+compiledFor = Version [ 1+{-# LINE 24 "Graphics/UI/SDL/Version.hsc" #-}+ , 2+{-# LINE 25 "Graphics/UI/SDL/Version.hsc" #-}+ , 10+{-# LINE 26 "Graphics/UI/SDL/Version.hsc" #-}+ ] []++-- const SDL_version * SDL_Linked_Version(void);+foreign import ccall unsafe "SDL_Linked_Version" sdlLinkedVersion :: IO (Ptr SDLVersion)+linkedWith :: IO Version+linkedWith = do versionPtr <- sdlLinkedVersion+ SDLVersion major minor patch <- peek versionPtr+ return (Version (map fromIntegral [major,minor,patch]) [])
Graphics/UI/SDL/Version.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif module Graphics.UI.SDL.Version ( compiledFor , linkedWith
+ Graphics/UI/SDL/Video.hs view
@@ -0,0 +1,729 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE <SDL.h> #-}+{-# LINE 1 "Graphics/UI/SDL/Video.hsc" #-}+-----------------------------------------------------------------------------+{-# LINE 2 "Graphics/UI/SDL/Video.hsc" #-}+-- |+-- Module : Graphics.UI.SDL.Video+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Video+ ( Palette+ , Toggle (..)+ , fromToggle+ , toToggle+ , tryGetVideoSurface+ , getVideoSurface+ , tryVideoDriverName+ , videoDriverName+ , getVideoInfo+ , ListModes(..)+ , listModes+ , videoModeOK+ , trySetVideoMode+ , setVideoMode+ , updateRect+ , updateRects+ , tryFlip+ , flip+ , setColors+ , setPalette+ , setGamma+ , tryGetGammaRamp+ , getGammaRamp+ , trySetGammaRamp+ , setGammaRamp+ , mapRGB+ , mapRGBA+ , getRGB+ , getRGBA+ , tryCreateRGBSurface+ , createRGBSurface+ , tryCreateRGBSurfaceEndian+ , createRGBSurfaceEndian+ , tryCreateRGBSurfaceFrom+ , createRGBSurfaceFrom+ , freeSurface+ , lockSurface+ , unlockSurface+ , loadBMP+ , saveBMP+ , setColorKey+ , setAlpha+ , setClipRect+ , getClipRect+ , withClipRect+ , tryConvertSurface+ , convertSurface+ , blitSurface+ , fillRect+ , tryDisplayFormat+ , displayFormat+ , tryDisplayFormatAlpha+ , displayFormatAlpha+ , warpMouse+ , showCursor+ , queryCursorState+ , GLAttr, GLValue+ , glRedSize, glGreenSize, glBlueSize, glAlphaSize, glBufferSize, glDoubleBuffer+ , glDepthSize, glStencilSize, glAccumRedSize, glAccumGreenSize, glAccumBlueSize+ , glAccumAlphaSize, glStereo, glMultiSampleBuffers, glMultiSampleSamples+ , tryGLGetAttribute, glGetAttribute+ , tryGLSetAttribute, glSetAttribute+ , glSwapBuffers+ , mkFinalizedSurface+ ) where+++{-# LINE 80 "Graphics/UI/SDL/Video.hsc" #-}++import Foreign (Ptr, FunPtr, Storable(peek), castPtr, plusPtr, nullPtr, newForeignPtr_,+ finalizeForeignPtr, alloca, withForeignPtr, newForeignPtr)+import Foreign.C (peekCString, CString)+import Foreign.Marshal.Array (withArrayLen, peekArray0, peekArray, allocaArray)+import Foreign.Marshal.Utils (with, toBool, maybeWith, maybePeek, fromBool)+import Control.Exception (bracket)+import Data.Word (Word8, Word16, Word32)+import Data.Int (Int32)++import Graphics.UI.SDL.Utilities (Enum(..), intToBool, toBitmask)+import Graphics.UI.SDL.General (unwrapMaybe, unwrapBool)+import Graphics.UI.SDL.Rect (Rect(rectY, rectX, rectW, rectH))+import Graphics.UI.SDL.Color (Pixel(..), Color)+import Graphics.UI.SDL.Types (SurfaceFlag, PixelFormat, PixelFormatStruct, RWops,+ RWopsStruct, VideoInfo, VideoInfoStruct, Surface, SurfaceStruct)+import qualified Graphics.UI.SDL.RWOps as RW++import Prelude hiding (flip,Enum(..))++--import Foreign.HacanonLight.Generate+--import Foreign.HacanonLight.DIS (foreignPtr,mkOut,word8)++data Palette+ = Logical+ | Physical+ deriving (Show,Eq,Ord)++instance Bounded Palette where+ minBound = Logical+ maxBound = Physical++instance Enum Palette Int where+ fromEnum Logical = 1+{-# LINE 114 "Graphics/UI/SDL/Video.hsc" #-}+ fromEnum Physical = 2+{-# LINE 115 "Graphics/UI/SDL/Video.hsc" #-}+ toEnum 1 = Logical+{-# LINE 116 "Graphics/UI/SDL/Video.hsc" #-}+ toEnum 2 = Physical+{-# LINE 117 "Graphics/UI/SDL/Video.hsc" #-}+ toEnum _ = error "Graphics.UI.SDL.Video.toEnum: bad argument"+ succ Logical = Physical+ succ _ = error "Graphics.UI.SDL.Video.succ: bad argument"+ pred Physical = Logical+ pred _ = error "Graphics.UI.SDL.Video.pred: bad argument"+ enumFromTo x y | x > y = []+ | x == y = [y]+ | True = x : enumFromTo (succ x) y+++data Toggle = Disable | Enable | Query+ deriving (Eq, Ord, Show)++toToggle :: (Num a) => a -> Toggle+toToggle (0) = Disable+{-# LINE 132 "Graphics/UI/SDL/Video.hsc" #-}+toToggle (1) = Enable+{-# LINE 133 "Graphics/UI/SDL/Video.hsc" #-}+toToggle (-1) = Query+{-# LINE 134 "Graphics/UI/SDL/Video.hsc" #-}+toToggle _ = error "Graphics.UI.SDL.Video.toToggle: bad argument"++fromToggle :: (Num a) => Toggle -> a+fromToggle Disable = 0+fromToggle Enable = 1+fromToggle Query = (-1)+++foreign import ccall unsafe "SDL_GetVideoSurface" sdlGetVideoSurface :: IO (Ptr SurfaceStruct)++-- | Returns the video surface or @Nothing@ on error.+tryGetVideoSurface :: IO (Maybe Surface)+tryGetVideoSurface =+ sdlGetVideoSurface >>= maybePeek newForeignPtr_++-- | Returns the video surface, throwing an exception on error.+getVideoSurface :: IO Surface+getVideoSurface = unwrapMaybe "SDL_GetVideoSurface" tryGetVideoSurface++foreign import ccall unsafe "SDL_VideoDriverName" sdlVideoDriverName :: CString -> Int -> IO CString++-- | Returns the video driver name or @Nothing@ on error. Notice, the driver name is limited to 256 chars.+tryVideoDriverName :: IO (Maybe String)+tryVideoDriverName + = allocaArray size (\ptr -> sdlVideoDriverName ptr size >>= maybePeek peekCString)+ where size = 256++-- | Returns the video driver name, throwing an exception on error. See also 'tryVideoDriverName'.+videoDriverName :: IO String+videoDriverName = unwrapMaybe "SDL_VideoDriverName" tryVideoDriverName++foreign import ccall unsafe "SDL_GetVideoInfo" sdlGetVideoInfo :: IO (Ptr VideoInfoStruct)+getVideoInfo :: IO VideoInfo+getVideoInfo = sdlGetVideoInfo >>= newForeignPtr_++data ListModes+ = Modes [Rect] -- ^ List of available resolutions.+ | NonAvailable -- ^ No modes available!+ | AnyOK -- ^ All resolutions available.+ deriving (Show,Eq,Ord)++foreign import ccall unsafe "SDL_ListModes" sdlListModes :: Ptr PixelFormatStruct -> Word32 -> IO (Ptr (Ptr Rect))++-- | Returns the available screen resolutions for the given format and video flags.+listModes :: Maybe PixelFormat -- ^ Will use SDL_GetVideoInfo()->vfmt when @Nothing@.+ -> [SurfaceFlag]+ -> IO ListModes+listModes mbFormat flags+ = do ret <- getFormat (\ptr -> sdlListModes ptr (toBitmask flags))+ if ret == nullPtr `plusPtr` (-1)+ then return AnyOK+ else if ret == nullPtr+ then return NonAvailable+ else do array <- peekArray0 nullPtr ret+ fmap Modes (mapM peek array)+ where getFormat = maybe (\action -> action nullPtr) withForeignPtr mbFormat++-- int SDL_VideoModeOK(int width, int height, int bpp, Uint32 flags);+foreign import ccall unsafe "SDL_VideoModeOK" sdlVideoModeOK :: Int -> Int -> Int -> Word32 -> IO Int++-- | Check to see if a particular video mode is supported.+-- Returns the bits-per-pixel of the closest available mode with the given width,+-- height and requested surface flags, or @Nothing@ on error.+videoModeOK :: Int -- ^ Width.+ -> Int -- ^ Height.+ -> Int -- ^ Bits-per-pixel.+ -> [SurfaceFlag] -- ^ Flags.+ -> IO (Maybe Int)+videoModeOK width height bpp flags+ = do ret <- sdlVideoModeOK width height bpp (toBitmask flags)+ case ret of+ 0 -> return Nothing+ x -> return (Just x)++-- SDL_Surface *SDL_SetVideoMode(int width, int height, int bpp, Uint32 flags);+foreign import ccall unsafe "SDL_SetVideoMode" sdlSetVideoMode :: Int -> Int -> Int -> Word32 -> IO (Ptr SurfaceStruct)++-- | Set up a video mode with the specified width, height and bits-per-pixel.+-- Returns @Nothing@ on error.+trySetVideoMode :: Int -- ^ Width.+ -> Int -- ^ Height.+ -> Int -- ^ Bits-per-pixel.+ -> [SurfaceFlag] -- ^ Flags.+ -> IO (Maybe Surface)+trySetVideoMode width height bpp flags+ = sdlSetVideoMode width height bpp (toBitmask flags) >>= maybePeek newForeignPtr_++-- | Same as 'trySetVideoMode' except it throws an exception on error.+setVideoMode :: Int -> Int -> Int -> [SurfaceFlag] -> IO Surface+setVideoMode width height bpp flags+ = unwrapMaybe "SDL_SetVideoMode" (trySetVideoMode width height bpp flags)++-- void SDL_UpdateRect(SDL_Surface *screen, Sint32 x, Sint32 y, Sint32 w, Sint32 h);+foreign import ccall unsafe "SDL_UpdateRect" sdlUpdateRect :: Ptr SurfaceStruct+ -> Int32 -> Int32 -> Word32 -> Word32 -> IO ()++-- | Makes sure the given area is updated on the given screen.+updateRect :: Surface -> Rect -> IO ()+updateRect surface rect+ = withForeignPtr surface (\ptr -> sdlUpdateRect ptr x y w h)+ where x = fromIntegral (rectX rect)+ y = fromIntegral (rectY rect)+ w = fromIntegral (rectW rect)+ h = fromIntegral (rectH rect)+++-- void SDL_UpdateRects(SDL_Surface *screen, int numrects, SDL_Rect *rects);+foreign import ccall unsafe "SDL_UpdateRects" sdlUpdateRects :: Ptr SurfaceStruct -> Int -> Ptr Rect -> IO ()++-- | Makes sure the given list of rectangles is updated on the given screen.+-- The rectangles are not automatically merged or checked for overlap.+-- In general, the programmer can use his knowledge about his particular+-- rectangles to merge them in an efficient way, to avoid overdraw.+updateRects :: Surface -> [Rect] -> IO ()+updateRects surface rects+ = withForeignPtr surface $ \ptr ->+ withArrayLen rects $ \len array ->+ sdlUpdateRects ptr len array++-- int SDL_Flip(SDL_Surface *screen);+foreign import ccall unsafe "SDL_Flip" sdlFlip :: Ptr SurfaceStruct -> IO Int++-- | Swaps screen buffers.+tryFlip :: Surface -> IO Bool+tryFlip surface+ = withForeignPtr surface $ \ptr ->+ do ret <- sdlFlip ptr+ case ret of+ (-1) -> return False+ _ -> return True++-- | Same as 'tryFlip' but throws an exception on error.+flip :: Surface -> IO ()+flip = unwrapBool "SDL_Flip" . tryFlip++-- int SDL_SetColors(SDL_Surface *surface, SDL_Color *colors, int firstcolor, int ncolors);+foreign import ccall unsafe "SDL_SetColors" sdlSetColors :: Ptr SurfaceStruct -> Ptr Color -> Int -> Int -> IO Int++-- | Sets a portion of the colormap for the given 8-bit surface.+setColors :: Surface -> [Color] -> Int -> IO Bool+setColors surface colors start+ = withForeignPtr surface $ \ptr ->+ withArrayLen colors $ \len array ->+ fmap toBool (sdlSetColors ptr array start len)++-- int SDL_SetPalette(SDL_Surface *surface, int flags, SDL_Color *colors, int firstcolor, int ncolors);+foreign import ccall unsafe "SDL_SetPalette" sdlSetPalette+ :: Ptr SurfaceStruct -> Int -> Ptr Color -> Int -> Int -> IO Int++-- | Sets the colors in the palette of an 8-bit surface.+setPalette :: Surface -> [Palette] -> [Color] -> Int -> IO Bool+setPalette surface flags colors start+ = withForeignPtr surface $ \ptr ->+ withArrayLen colors $ \len array ->+ fmap toBool (sdlSetPalette ptr (toBitmask flags) array start len)++--int SDL_SetGamma(float redgamma, float greengamma, float bluegamma);+foreign import ccall unsafe "SDL_SetGamma" sdlSetGamma :: Float -> Float -> Float -> IO Int+setGamma :: Float -> Float -> Float -> IO Bool+setGamma red green blue+ = intToBool (-1) (sdlSetGamma red green blue)++-- int SDL_GetGammaRamp(Uint16 *redtable, Uint16 *greentable, Uint16 *bluetable);+foreign import ccall unsafe "SDL_GetGammaRamp" sdlGetGammaRamp :: Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO Int+tryGetGammaRamp :: IO (Maybe ([Word16],[Word16],[Word16]))+tryGetGammaRamp+ = allocaArray size $ \red ->+ allocaArray size $ \green ->+ allocaArray size $ \blue ->+ do ret <- sdlGetGammaRamp red green blue+ case ret of+ (-1) -> return Nothing+ _ -> do [r,g,b] <- mapM (peekArray size) [red,green,blue]+ return (Just (r,g,b))+ where size = 256++getGammaRamp :: IO ([Word16],[Word16],[Word16])+getGammaRamp = unwrapMaybe "SDL_GetGammaRamp" tryGetGammaRamp++-- int SDL_SetGammaRamp(Uint16 *redtable, Uint16 *greentable, Uint16 *bluetable);+foreign import ccall unsafe "SDL_SetGammaRamp" sdlSetGammaRamp :: Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO Int+trySetGammaRamp :: [Word16] -> [Word16] -> [Word16] -> IO Bool+trySetGammaRamp red green blue+ = withArrayLen red $ check $ \ptrRed ->+ withArrayLen green $ check $ \ptrGreen ->+ withArrayLen blue $ check $ \ptrBlue ->+ intToBool (-1) (sdlSetGammaRamp ptrRed ptrGreen ptrBlue)+ where check action 256 ptr = action ptr+ check _ _ _ = return False++setGammaRamp :: [Word16] -> [Word16] -> [Word16] -> IO ()+setGammaRamp red green blue = unwrapBool "setGammaRamp_" (trySetGammaRamp red green blue)++-- Uint32 SDL_MapRGB(SDL_PixelFormat *fmt, Uint8 r, Uint8 g, Uint8 b);+foreign import ccall unsafe "SDL_MapRGB" sdlMapRGB :: Ptr PixelFormatStruct -> Word8 -> Word8 -> Word8 -> IO Word32++-- | Map a RGB color value to a pixel format.+mapRGB :: PixelFormat+ -> Word8 -- ^ Red value.+ -> Word8 -- ^ Green value.+ -> Word8 -- ^ Blue value.+ -> IO Pixel+mapRGB format r g b+ = withForeignPtr format $ \ptr ->+ fmap Pixel (sdlMapRGB ptr r g b)++-- Uint32 SDL_MapRGBA(SDL_PixelFormat *fmt, Uint8 r, Uint8 g, Uint8 b, Uint8 a);++foreign import ccall unsafe "SDL_MapRGBA" sdlMapRGBA+ :: Ptr PixelFormatStruct -> Word8 -> Word8 -> Word8 -> Word8 -> IO Word32++-- | Map a RGBA color value to a pixel format.+mapRGBA :: PixelFormat+ -> Word8 -- ^ Red value.+ -> Word8 -- ^ Green value.+ -> Word8 -- ^ Blue value.+ -> Word8 -- ^ Alpha value.+ -> IO Pixel+mapRGBA format r g b a+ = withForeignPtr format $ \ptr ->+ fmap Pixel (sdlMapRGBA ptr r g b a)++-- void SDL_GetRGB(Uint32 pixel, SDL_PixelFormat *fmt, Uint8 *r, Uint8 *g, Uint8 *b);+foreign import ccall unsafe "SDL_GetRGB" sdlGetRGB+ :: Word32 -> Ptr PixelFormatStruct -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()++-- | Get RGB values from a pixel in the specified pixel format.+getRGB :: Pixel -> PixelFormat -> IO (Word8,Word8,Word8)+getRGB (Pixel p) format+ = alloca $ \red ->+ alloca $ \green ->+ alloca $ \blue ->+ withForeignPtr format $ \ptr ->+ do sdlGetRGB p ptr red green blue+ [r,g,b] <- mapM peek [red,green,blue]+ return (r,g,b)++-- void SDL_GetRGBA(Uint32 pixel, SDL_PixelFormat *fmt, Uint8 *r, Uint8 *g, Uint8 *b, Uint8 *a);+foreign import ccall unsafe "SDL_GetRGBA" sdlGetRGBA+ :: Word32 -> Ptr PixelFormatStruct -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()++-- | Gets RGBA values from a pixel in the specified pixel format.+getRGBA :: Pixel -> PixelFormat -> IO (Word8,Word8,Word8,Word8)+getRGBA (Pixel p) format+ = alloca $ \red ->+ alloca $ \green ->+ alloca $ \blue ->+ alloca $ \alpha -> + withForeignPtr format $ \ptr ->+ do sdlGetRGBA p ptr red green blue alpha+ [r,g,b,a] <- mapM peek [red,green,blue,alpha]+ return (r,g,b,a)++-- SDL_Surface *SDL_CreateRGBSurface(Uint32 flags, int width, int height, int depth, Uint32 Rmask, Uint32 Gmask, Uint32 Bmask, Uint32 Amask);+foreign import ccall unsafe "SDL_CreateRGBSurface" sdlCreateRGBSurface+ :: Word32 -> Int -> Int -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr SurfaceStruct)++-- | Creates an empty @Surface@. Returns @Nothing@ on error.+tryCreateRGBSurface :: [SurfaceFlag] -> Int -> Int -> Int+ -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Maybe Surface)+tryCreateRGBSurface flags width height bpp rmask gmask bmask amask+ = sdlCreateRGBSurface (toBitmask flags) width height bpp rmask gmask bmask amask >>=+ maybePeek mkFinalizedSurface++-- | Creates an empty @Surface@. Throws an exception on error.+createRGBSurface :: [SurfaceFlag] -> Int -> Int -> Int+ -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface+createRGBSurface flags width height bpp rmask gmask bmask amask+ = unwrapMaybe "SDL_CreateRGBSurface" (tryCreateRGBSurface flags width height bpp rmask gmask bmask amask)++-- | Creates an empty @Surface@ with (r\/g\/b\/a)mask determined from the local endian.+-- Returns @Nothing@ on error.+tryCreateRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO (Maybe Surface)+tryCreateRGBSurfaceEndian flags width height bpp+ = tryCreateRGBSurface flags width height bpp++{-# LINE 410 "Graphics/UI/SDL/Video.hsc" #-}+ 0x000000FF 0x0000FF00 0x00FF0000 0xFF000000++{-# LINE 414 "Graphics/UI/SDL/Video.hsc" #-}++-- | Creates an empty @Surface@ with (r\/g\/b\/a)mask determined from the local endian.+-- Throws an exception on error.+createRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO Surface+createRGBSurfaceEndian flags width height bpp+ = unwrapMaybe "SDL_CreateRGBSurface" (tryCreateRGBSurfaceEndian flags width height bpp)++-- SDL_Surface *SDL_CreateRGBSurfaceFrom(void *pixels, int width, int height, int depth, int pitch, Uint32 Rmask, Uint32 Gmask, Uint32 Bmask, Uint32 Amask);+foreign import ccall unsafe "SDL_CreateRGBSurfaceFrom" sdlCreateRGBSurfaceFrom+ :: Ptr Word8 -> Int -> Int -> Int -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr SurfaceStruct)+tryCreateRGBSurfaceFrom :: Ptr a -> Int -> Int -> Int -> Int+ -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Maybe Surface)+tryCreateRGBSurfaceFrom pixels width height depth pitch rmask gmask bmask amask+ = sdlCreateRGBSurfaceFrom (castPtr pixels) width height depth pitch rmask gmask bmask amask >>=+ maybePeek mkFinalizedSurface++createRGBSurfaceFrom :: Ptr a -> Int -> Int -> Int -> Int+ -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface+createRGBSurfaceFrom pixels width height depth pitch rmask gmask bmask amask+ = unwrapMaybe "SDL_CreateRGBSurfaceFrom"+ (tryCreateRGBSurfaceFrom pixels width height depth pitch rmask gmask bmask amask)++{-+-- void SDL_FreeSurface(SDL_Surface *surface);+foreign import ccall unsafe "SDL_FreeSurface" sdlFreeSurface :: Ptr SurfaceStruct -> IO ()+-- | Frees (deletes) a @Surface@. Don\'t use it unless you really know what you're doing. All surfaces+-- are automatically deleted when they're out of scope or forced with @finalizeForeignPtr@.+freeSurface :: Surface -> IO ()+freeSurface surface+ = withForeignPtr surface sdlFreeSurface+-}++-- | Forces the finalization of a @Surface@. Only supported with GHC.+freeSurface :: Surface -> IO ()+freeSurface =++{-# LINE 450 "Graphics/UI/SDL/Video.hsc" #-}+ finalizeForeignPtr++{-# LINE 454 "Graphics/UI/SDL/Video.hsc" #-}++-- int SDL_LockSurface(SDL_Surface *surface);+foreign import ccall unsafe "SDL_LockSurface" sdlLockSurface :: Ptr SurfaceStruct -> IO Int++-- | Locks a surface for direct access.+lockSurface :: Surface -> IO Bool+lockSurface surface+ = withForeignPtr surface $ \ptr ->+ intToBool (-1) (sdlLockSurface ptr)++-- void SDL_UnlockSurface(SDL_Surface *surface);+foreign import ccall unsafe "SDL_UnlockSurface" sdlUnlockSurface :: Ptr SurfaceStruct -> IO ()++-- | Unlocks a previously locked surface.+unlockSurface :: Surface -> IO ()+unlockSurface surface = withForeignPtr surface sdlUnlockSurface++-- extern DECLSPEC SDL_Surface * SDLCALL SDL_LoadBMP_RW(SDL_RWops *src, int freesrc);+-- define SDL_LoadBMP(file) SDL_LoadBMP_RW(SDL_RWFromFile(file, "rb"), 1)+foreign import ccall unsafe "SDL_LoadBMP_RW" sdlLoadBMP_RW :: Ptr RWopsStruct -> Int -> IO (Ptr SurfaceStruct)++tryLoadBMPRW :: RWops -> Bool -> IO (Maybe Surface)+tryLoadBMPRW rw freesrc+ = withForeignPtr rw $ \rwPtr ->+ sdlLoadBMP_RW rwPtr (fromBool freesrc) >>= maybePeek mkFinalizedSurface++loadBMPRW :: RWops -> Bool -> IO Surface+loadBMPRW rw freesrc = unwrapMaybe "SDL_LoadBMP_RW" (tryLoadBMPRW rw freesrc)++loadBMP :: FilePath -> IO Surface+loadBMP filepath+ = RW.with filepath "rb" $ \rw ->+ loadBMPRW rw False++-- extern DECLSPEC int SDLCALL SDL_SaveBMP_RW+-- (SDL_Surface *surface, SDL_RWops *dst, int freedst);+foreign import ccall unsafe "SDL_SaveBMP_RW" sdlSaveBMP_RW :: Ptr SurfaceStruct -> Ptr RWopsStruct -> Int -> IO Int++saveBMPRW :: Surface -> RWops -> Bool -> IO Bool+saveBMPRW surface rw freedst+ = withForeignPtr surface $ \ptr ->+ withForeignPtr rw $ \rwPtr ->+ intToBool (-1) (sdlSaveBMP_RW ptr rwPtr (fromBool freedst))++saveBMP :: Surface -> FilePath -> IO Bool+saveBMP surface filepath+ = RW.with filepath "wb" $ \rw ->+ saveBMPRW surface rw False+++-- int SDL_SetColorKey(SDL_Surface *surface, Uint32 flag, Uint32 key);+foreign import ccall unsafe "SDL_SetColorKey" sdlSetColorKey :: Ptr SurfaceStruct -> Word32 -> Word32 -> IO Int+setColorKey :: Surface -> [SurfaceFlag] -> Pixel -> IO Bool+setColorKey surface flags (Pixel w)+ = withForeignPtr surface $ \ptr ->+ intToBool (-1) (sdlSetColorKey ptr (toBitmask flags) w)++-- int SDL_SetAlpha(SDL_Surface *surface, Uint32 flag, Uint8 alpha);+foreign import ccall unsafe "SDL_SetAlpha" sdlSetAlpha :: Ptr SurfaceStruct -> Word32 -> Word8 -> IO Int++-- | Adjusts the alpha properties of a surface.+setAlpha :: Surface -> [SurfaceFlag] -> Word8 -> IO Bool+setAlpha surface flags alpha+ = withForeignPtr surface $ \ptr ->+ intToBool (-1) (sdlSetAlpha ptr (toBitmask flags) alpha)++-- void SDL_SetClipRect(SDL_Surface *surface, SDL_Rect *rect);+foreign import ccall unsafe "SDL_SetClipRect" sdlSetClipRect :: Ptr SurfaceStruct -> Ptr Rect -> IO ()++-- | Sets the clipping rectangle for a surface.+setClipRect :: Surface -> Maybe Rect -> IO ()+setClipRect surface mbRect+ = withForeignPtr surface $ \ptr ->+ maybeWith with mbRect $ \rect ->+ sdlSetClipRect ptr rect++-- void SDL_GetClipRect(SDL_Surface *surface, SDL_Rect *rect);+foreign import ccall unsafe "SDL_GetClipRect" sdlGetClipRect :: Ptr SurfaceStruct -> Ptr Rect -> IO ()++-- | Gets the clipping rectangle for a surface.+getClipRect :: Surface -> IO Rect+getClipRect surface+ = withForeignPtr surface $ \ptr ->+ alloca $ \rectPtr ->+ do sdlGetClipRect ptr rectPtr+ peek rectPtr++-- | Run an action with a given clipping rect applied.+-- If an exception is raised, then withClipRect will re-raise the exception (after resetting the original clipping rect).+withClipRect :: Surface -> Maybe Rect -> IO a -> IO a+withClipRect surface rect action+ = bracket (getClipRect surface) -- Get the current cliprect+ (setClipRect surface . Just) -- Reset to old cliprect when done.+ (const (setClipRect surface rect >> action)) -- Set new cliprect.++-- SDL_Surface *SDL_ConvertSurface(SDL_Surface *src, SDL_PixelFormat *fmt, Uint32 flags);+foreign import ccall unsafe "SDL_ConvertSurface" sdlConvertSurface+ :: Ptr SurfaceStruct -> Ptr PixelFormatStruct -> Word32 -> IO (Ptr SurfaceStruct)++-- | Converts a surface to the same format as another surface. Returns @Nothing@ on error.+tryConvertSurface :: Surface -> PixelFormat -> [SurfaceFlag] -> IO (Maybe Surface)+tryConvertSurface surface format flags+ = withForeignPtr surface $ \ptr ->+ withForeignPtr format $ \formatPtr ->+ sdlConvertSurface ptr formatPtr (toBitmask flags) >>= maybePeek mkFinalizedSurface++-- | Converts a surface to the same format as another surface. Throws an exception on error.+convertSurface :: Surface -> PixelFormat -> [SurfaceFlag] -> IO Surface+convertSurface surface format flags+ = unwrapMaybe "SDL_ConvertSurface"+ (tryConvertSurface surface format flags)+++-- int SDL_UpperBlit(SDL_Surface *src, SDL_Rect *srcrect, SDL_Surface *dst, SDL_Rect *dstrect);+foreign import ccall unsafe "SDL_UpperBlit" sdlBlitSurface+ :: Ptr SurfaceStruct -> Ptr Rect -> Ptr SurfaceStruct -> Ptr Rect -> IO Int++-- | This function performs a fast blit from the source surface to the destination surface.+blitSurface :: Surface -> Maybe Rect -> Surface -> Maybe Rect -> IO Bool+blitSurface src srcRect dst dstRect+ = withForeignPtr src $ \srcPtr ->+ withForeignPtr dst $ \dstPtr ->+ maybeWith with srcRect $ \srcRectPtr ->+ maybeWith with dstRect $ \dstRectPtr ->+ intToBool (-1) (sdlBlitSurface srcPtr srcRectPtr dstPtr dstRectPtr)+++-- int SDL_FillRect(SDL_Surface *dst, SDL_Rect *dstrect, Uint32 color);+foreign import ccall unsafe "SDL_FillRect" sdlFillRect :: Ptr SurfaceStruct -> Ptr Rect -> Word32 -> IO Int++-- | This function performs a fast fill of the given rectangle with some color.+fillRect :: Surface -> Maybe Rect -> Pixel -> IO Bool+fillRect surface mbRect (Pixel w)+ = withForeignPtr surface $ \ptr ->+ maybeWith with mbRect $ \rect ->+ intToBool (-1) (sdlFillRect ptr rect w)++-- SDL_Surface *SDL_DisplayFormat(SDL_Surface *surface);+foreign import ccall unsafe "SDL_DisplayFormat" sdlDisplayFormat :: Ptr SurfaceStruct -> IO (Ptr SurfaceStruct)++-- | Converts a surface to the display format. Returns @Nothing@ on error.+tryDisplayFormat :: Surface -> IO (Maybe Surface)+tryDisplayFormat surface+ = withForeignPtr surface $ \ptr ->+ sdlDisplayFormat ptr >>= maybePeek mkFinalizedSurface++-- | Converts a surface to the display format. Throws an exception on error.+displayFormat :: Surface -> IO Surface+displayFormat = unwrapMaybe "SDL_DisplayFormat" . tryDisplayFormat++-- SDL_Surface *SDL_DisplayFormatAlpha(SDL_Surface *surface);+foreign import ccall unsafe "SDL_DisplayFormatAlpha" sdlDisplayFormatAlpha :: Ptr SurfaceStruct -> IO (Ptr SurfaceStruct)++-- | Converts a surface to the display format. Returns @Nothing@ on error.+tryDisplayFormatAlpha :: Surface -> IO (Maybe Surface)+tryDisplayFormatAlpha surface+ = withForeignPtr surface $ \ptr ->+ sdlDisplayFormatAlpha ptr >>= maybePeek mkFinalizedSurface++-- | Converts a surface to the display format. Throws an exception on error.+displayFormatAlpha :: Surface -> IO Surface+displayFormatAlpha = unwrapMaybe "SDL_DisplayFormatAlpha" . tryDisplayFormatAlpha++-- void SDL_WarpMouse(Uint16 x, Uint16 y);+foreign import ccall unsafe "SDL_WarpMouse" sdlWarpMouse :: Word16 -> Word16 -> IO ()++-- | Sets the position of the mouse cursor.+warpMouse :: Word16 -- ^ Mouse X position.+ -> Word16 -- ^ Mouse Y position.+ -> IO ()+warpMouse = sdlWarpMouse++-- int SDL_ShowCursor(int toggle);+foreign import ccall unsafe "SDL_ShowCursor" sdlShowCursor :: Int -> IO Int++-- | Toggle whether or not the cursor is shown on the screen.+showCursor :: Bool -> IO ()+showCursor enable+ = sdlShowCursor (fromToggle toggle) >>+ return ()+ where toggle = case enable of+ True -> Enable+ False -> Disable++-- | Returns @True@ when the cursor is set to visible. See also 'showCursor'.+queryCursorState :: IO Bool+queryCursorState = fmap toBool (sdlShowCursor (fromToggle Query))+++type GLAttr = Int+type GLValue = Int++glRedSize, glGreenSize, glBlueSize, glAlphaSize, glBufferSize, glDoubleBuffer :: GLAttr+glDepthSize, glStencilSize, glAccumRedSize, glAccumGreenSize, glAccumBlueSize :: GLAttr+glAccumAlphaSize, glStereo, glMultiSampleBuffers, glMultiSampleSamples :: GLAttr++glRedSize = 0+{-# LINE 651 "Graphics/UI/SDL/Video.hsc" #-}+glGreenSize = 1+{-# LINE 652 "Graphics/UI/SDL/Video.hsc" #-}+glBlueSize = 2+{-# LINE 653 "Graphics/UI/SDL/Video.hsc" #-}+glAlphaSize = 3+{-# LINE 654 "Graphics/UI/SDL/Video.hsc" #-}+glBufferSize = 4+{-# LINE 655 "Graphics/UI/SDL/Video.hsc" #-}+glDoubleBuffer = 5+{-# LINE 656 "Graphics/UI/SDL/Video.hsc" #-}+glDepthSize = 6+{-# LINE 657 "Graphics/UI/SDL/Video.hsc" #-}+glStencilSize = 7+{-# LINE 658 "Graphics/UI/SDL/Video.hsc" #-}+glAccumRedSize = 8+{-# LINE 659 "Graphics/UI/SDL/Video.hsc" #-}+glAccumGreenSize = 9+{-# LINE 660 "Graphics/UI/SDL/Video.hsc" #-}+glAccumBlueSize = 10+{-# LINE 661 "Graphics/UI/SDL/Video.hsc" #-}+glAccumAlphaSize = 11+{-# LINE 662 "Graphics/UI/SDL/Video.hsc" #-}+glStereo = 12+{-# LINE 663 "Graphics/UI/SDL/Video.hsc" #-}+glMultiSampleBuffers = 13+{-# LINE 664 "Graphics/UI/SDL/Video.hsc" #-}+glMultiSampleSamples = 14+{-# LINE 665 "Graphics/UI/SDL/Video.hsc" #-}++--int SDL_GL_SetAttribute(SDL_GLattr attr, int value);+foreign import ccall unsafe "SDL_GL_SetAttribute" sdlGLSetAttribute :: Int -> Int -> IO Int+-- | Sets a special SDL\/OpenGL attribute. Returns @False@ on error.+tryGLSetAttribute :: GLAttr -> GLValue -> IO Bool+tryGLSetAttribute attr value = fmap (==0) (sdlGLSetAttribute attr value)++-- | Sets a special SDL\/OpenGL attribute. Throws an exception on error.+glSetAttribute :: GLAttr -> GLValue -> IO ()+glSetAttribute attr value = unwrapBool "SDL_GL_SetAttribute" (tryGLSetAttribute attr value)++-- int SDL_GL_GetAttribute(SDLGLattr attr, int *value);+foreign import ccall unsafe "SDL_GL_GetAttribute" sdlGLGetAttribute :: Int -> Ptr Int -> IO Int++-- | Gets the value of a special SDL\/OpenGL attribute. Returns @Nothing@ on error.+tryGLGetAttribute :: GLAttr -> IO (Maybe GLValue)+tryGLGetAttribute attr+ = alloca $ \valuePtr ->+ do ret <- sdlGLGetAttribute attr valuePtr+ case ret of+ 0 -> fmap Just (peek valuePtr)+ _ -> return Nothing++-- | Gets the value of a special SDL\/OpenGL attribute. Throws an exception on error.+glGetAttribute :: GLAttr -> IO GLValue+glGetAttribute = unwrapMaybe "SDL_GL_GetAttribute" . tryGLGetAttribute++--void SDLCALL SDL_GL_SwapBuffers(void);+-- | Swaps OpenGL framebuffers\/Update Display.+foreign import ccall unsafe "SDL_GL_SwapBuffers" glSwapBuffers :: IO ()++foreign import ccall unsafe "&SDL_FreeSurface" sdlFreeSurfaceFinal :: FunPtr (Ptr SurfaceStruct -> IO ())++mkFinalizedSurface :: Ptr SurfaceStruct -> IO Surface+mkFinalizedSurface = newForeignPtr sdlFreeSurfaceFinal+
Graphics/UI/SDL/Video.hsc view
@@ -77,6 +77,9 @@ ) where #include <SDL.h>+#ifdef main+#undef main+#endif import Foreign (Ptr, FunPtr, Storable(peek), castPtr, plusPtr, nullPtr, newForeignPtr_, finalizeForeignPtr, alloca, withForeignPtr, newForeignPtr)
+ Graphics/UI/SDL/WindowManagement.hs view
@@ -0,0 +1,125 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# OPTIONS_GHC -optc-D_GNU_SOURCE=1 #-}+{-# OPTIONS_GHC -optc-D_REENTRANT #-}+{-# INCLUDE "SDL.h" #-}+{-# LINE 1 "Graphics/UI/SDL/WindowManagement.hsc" #-}++{-# LINE 2 "Graphics/UI/SDL/WindowManagement.hsc" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.WindowManagement+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.WindowManagement+ ( GrabMode (..)+ , setCaption+ , rawSetCaption+ , getCaption+ , iconifyWindow+ , tryToggleFullscreen+ , toggleFullscreen+ , grabInput+ , queryGrabMode+ ) where++import Foreign (Int32, Ptr, Storable(peek), nullPtr, toBool, maybePeek,+ void, alloca, withForeignPtr)+import Foreign.C (withCString, peekCString, CString)++import Graphics.UI.SDL.Types (Surface, SurfaceStruct)+import Graphics.UI.SDL.General (unwrapBool)+++data GrabMode+ = GrabQuery+ | GrabOff+ | GrabOn+ deriving (Show,Eq)++toGrabMode :: Int32 -> GrabMode+{-# LINE 40 "Graphics/UI/SDL/WindowManagement.hsc" #-}+toGrabMode (-1) = GrabQuery+{-# LINE 41 "Graphics/UI/SDL/WindowManagement.hsc" #-}+toGrabMode (0) = GrabOff+{-# LINE 42 "Graphics/UI/SDL/WindowManagement.hsc" #-}+toGrabMode (1) = GrabOn+{-# LINE 43 "Graphics/UI/SDL/WindowManagement.hsc" #-}+toGrabMode _ = error "Graphics.UI.SDL.WindowManagement.toGrabMode: bad argument"++fromGrabMode :: GrabMode -> Int32+{-# LINE 46 "Graphics/UI/SDL/WindowManagement.hsc" #-}+fromGrabMode GrabQuery = (-1)+{-# LINE 47 "Graphics/UI/SDL/WindowManagement.hsc" #-}+fromGrabMode GrabOff = (0)+{-# LINE 48 "Graphics/UI/SDL/WindowManagement.hsc" #-}+fromGrabMode GrabOn = (1)+{-# LINE 49 "Graphics/UI/SDL/WindowManagement.hsc" #-}++-- void SDL_WM_SetCaption(const char *title, const char *icon);+foreign import ccall unsafe "SDL_WM_SetCaption" sdlSetCaption :: CString -> CString -> IO ()+-- | Sets the window title and icon name.+setCaption :: String -> String -> IO ()+setCaption title icon+ = withCString title $ \titlePtr ->+ withCString icon $ \iconPtr ->+ sdlSetCaption titlePtr iconPtr++-- | Sets the window title and icon name. Use @Nothing@ to unset.+rawSetCaption :: Maybe String -> Maybe String -> IO ()+rawSetCaption title icon+ = maybeStr title $ \titlePtr ->+ maybeStr icon $ \iconPtr ->+ sdlSetCaption titlePtr iconPtr+ where maybeStr Nothing action = action nullPtr+ maybeStr (Just s) action = withCString s action+-- void SDL_WM_GetCaption(char **title, char **icon);+foreign import ccall unsafe "SDL_WM_GetCaption" sdlGetCaption :: Ptr CString -> Ptr CString -> IO ()+-- | Gets the window title and icon name.+getCaption :: IO (Maybe String,Maybe String)+getCaption+ = alloca $ \cTitle ->+ alloca $ \cIcon ->+ do sdlGetCaption cTitle cIcon+ title <- maybePeek ((peekCString =<<).peek) cTitle+ icon <- maybePeek ((peekCString =<<).peek) cIcon+ return (title,icon)++-- int SDL_WM_IconifyWindow(void);+foreign import ccall unsafe "SDL_WM_IconifyWindow" sdlIconifyWindow :: IO Int+-- | Iconify\/Minimise the window.+iconifyWindow :: IO Bool+iconifyWindow = fmap toBool sdlIconifyWindow++-- int SDL_WM_ToggleFullScreen(SDL_Surface *surface);+foreign import ccall unsafe "SDL_WM_ToggleFullScreen" sdlToggleFullScreen :: Ptr SurfaceStruct -> IO Int+-- |Toggles fullscreen mode. Returns @False@ on error.+tryToggleFullscreen :: Surface -> IO Bool+tryToggleFullscreen surface+ = withForeignPtr surface $ fmap toBool . sdlToggleFullScreen++-- | Toggles fullscreen mode. Throws an exception on error.+toggleFullscreen :: Surface -> IO ()+toggleFullscreen = unwrapBool "SDL_WM_ToggleFullScreen" . tryToggleFullscreen++-- SDL_GrabMode SDL_WM_GrabInput(SDL_GrabMode mode);+foreign import ccall unsafe "SDL_WM_GrabInput" sdlGrabInput :: Int32 -> IO Int32+{-# LINE 98 "Graphics/UI/SDL/WindowManagement.hsc" #-}+-- | Grabbing means that the mouse is confined to the application+-- window, and nearly all keyboard input is passed directly to+-- the application, and not interpreted by a window manager, if any.+grabInput :: Bool -> IO ()+grabInput = void . sdlGrabInput . fromGrabMode . mkGrabMode+ where mkGrabMode True = GrabOn+ mkGrabMode False = GrabOff++-- | Returns the current grabbing mode.+queryGrabMode :: IO GrabMode+queryGrabMode = fmap toGrabMode . sdlGrabInput . fromGrabMode $ GrabQuery++
Graphics/UI/SDL/WindowManagement.hsc view
@@ -1,4 +1,7 @@ #include "SDL.h"+#ifdef main+#undef main+#endif ----------------------------------------------------------------------------- -- | -- Module : Graphics.UI.SDL.WindowManagement
SDL.cabal view
@@ -1,11 +1,12 @@ Name: SDL-Version: 0.5.1+Version: 0.5.2 Maintainer: Lemmih (lemmih@gmail.com) Author: Lemmih (lemmih@gmail.com) Copyright: 2004-2007, Lemmih License-File: LICENSE License: BSD3 Build-Depends: base+Build-Type: Custom Category: Foreign binding Synopsis: Binding to libSDL Tested-with: GHC ==6.6, GHC ==6.8, Hugs ==20050308@@ -31,6 +32,6 @@ -- Include-Dirs: /usr/local/lib/ghc-6.4.1/include, /sw/include/SDL Extra-Libraries: SDL Frameworks: AppKit-GHC-Options: -fglasgow-exts -Wall -Werror-Extra-Source-files: configure, configure.ac, SDL.buildinfo.in, config.mk.in+GHC-Options: -fglasgow-exts -Wall+Extra-Source-files: configure, configure.ac, SDL.buildinfo.in, config.mk.in, includes/HsSDLConfig.h.in Data-files: README, MACOSX, WIN32
Setup.lhs view
@@ -2,4 +2,4 @@ > module Main where > import Distribution.Simple > main :: IO ()-> main = defaultMainWithHooks defaultUserHooks+> main = defaultMainWithHooks autoconfUserHooks
WIN32 view
@@ -31,22 +31,7 @@ Include-Dirs: C:\SDL-1.2.12\include Extra-Lib-Dirs: C:\SDL-1.2.12\lib -4. Modify C:\SDL-1.2.12\include\SDL.h-- Line 28 there is a line:-- #include "SDL_main.h"-- Comment this out by changing it to:-- /* #include "SDL_main.h" */-- (This step is needed so that hsc2hs will later work correctly. hsc2hs works- by generating a C program that generates a haskell program when run.- SDL_main.h uses a preprocessor macro to mangle the program's main function.- This causes hsc2hs to fail)--5. Open a Windows Command Prompt (Start -> Run -> "cmd.exe")+4. Open a Windows Command Prompt (Start -> Run -> "cmd.exe") cd into the hsSDL distribution directory and run: runghc Setup.lhs configure@@ -70,7 +55,7 @@ runghc Setup.lhs install -6. Compile the example program. Run:+5. Compile the example program. Run: cd Examples ghc --make Test.hs@@ -84,12 +69,21 @@ Now run Test.exe, press spacebar a few times to watch the smiley face jump around, and finally press Q to quit. -7. Using SDL from GHCi does not seem to work. This is the error I get trying to- run Test.hs from GHCi:+6. Using SDL from GHCi requires a trick. If you try running Test.hs you will+ get this error: + > ghci Test.hs Prelude Main> main Loading package SDL-0.4.0 ... can't load .so/.DLL for: SDLmain (addDLL: unknown error)++ To get ghci working, you must make 2 copies of SDL.dll called SDLmain.dll,+ and SDL.dll.dll:++ copy SDL.dll SDLmain.dll+ copy SDL.dll SDL.dll.dll++ Now everything should work! Peace, Bit Connor <bit@mutantlemon.com>
configure.ac view
@@ -1,4 +1,4 @@-AC_INIT([Haskell SDL package], [0.4.0], [lemmih@gmail.com], [SDL])+AC_INIT([Haskell SDL package], [0.5.2], [lemmih@gmail.com], [SDL]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([includes/HsSDLConfig.h.in])
+ includes/HsSDLConfig.h.in view
@@ -0,0 +1,16 @@+/* includes/HsSDLConfig.h.in. Generated from configure.ac by autoheader. */++/* Define to the address where bug reports for this package should be sent. */+#undef PACKAGE_BUGREPORT++/* Define to the full name of this package. */+#undef PACKAGE_NAME++/* Define to the full name and version of this package. */+#undef PACKAGE_STRING++/* Define to the one symbol short name of this package. */+#undef PACKAGE_TARNAME++/* Define to the version of this package. */+#undef PACKAGE_VERSION