SDL (empty) → 0.4.0
raw patch · 19 files changed
+3834/−0 lines, 19 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- Graphics/UI/SDL.hs +40/−0
- Graphics/UI/SDL/Audio.hsc +51/−0
- Graphics/UI/SDL/CPUInfo.hs +53/−0
- Graphics/UI/SDL/Color.hs +43/−0
- Graphics/UI/SDL/Events.hsc +625/−0
- Graphics/UI/SDL/General.hsc +160/−0
- Graphics/UI/SDL/Joystick.hsc +176/−0
- Graphics/UI/SDL/Keysym.hsc +1310/−0
- Graphics/UI/SDL/RWOps.hs +69/−0
- Graphics/UI/SDL/Rect.hsc +40/−0
- Graphics/UI/SDL/Time.hs +22/−0
- Graphics/UI/SDL/Types.hsc +274/−0
- Graphics/UI/SDL/Utilities.hs +54/−0
- Graphics/UI/SDL/Version.hsc +33/−0
- Graphics/UI/SDL/Video.hsc +700/−0
- Graphics/UI/SDL/WindowManagement.hsc +110/−0
- LICENSE +35/−0
- SDL.cabal +34/−0
- Setup.lhs +5/−0
+ Graphics/UI/SDL.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portablex+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL+ ( module Graphics.UI.SDL.General+ , module Graphics.UI.SDL.Rect+ , module Graphics.UI.SDL.Time+ , module Graphics.UI.SDL.Types+ , module Graphics.UI.SDL.Video+ , module Graphics.UI.SDL.WindowManagement+ , module Graphics.UI.SDL.Audio+ , module Graphics.UI.SDL.Color+ , module Graphics.UI.SDL.Keysym+ , module Graphics.UI.SDL.Events+ , module Graphics.UI.SDL.RWOps+ , module Graphics.UI.SDL.Version+ , module Graphics.UI.SDL.Joystick+ ) where++import Graphics.UI.SDL.General+import Graphics.UI.SDL.Rect+import Graphics.UI.SDL.Time+import Graphics.UI.SDL.Types+import Graphics.UI.SDL.Video+import Graphics.UI.SDL.WindowManagement+import Graphics.UI.SDL.Audio+import Graphics.UI.SDL.Color+import Graphics.UI.SDL.Keysym+import Graphics.UI.SDL.Events+import Graphics.UI.SDL.RWOps+import Graphics.UI.SDL.Version+import Graphics.UI.SDL.Joystick
+ Graphics/UI/SDL/Audio.hsc view
@@ -0,0 +1,51 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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 = #{const AUDIO_U8}+fromAudioFormat AudioS8 = #{const AUDIO_S8}+fromAudioFormat AudioU16LSB = #{const AUDIO_U16LSB}+fromAudioFormat AudioS16LSB = #{const AUDIO_S16LSB}+fromAudioFormat AudioU16MSB = #{const AUDIO_U16MSB}+fromAudioFormat AudioS16MSB = #{const AUDIO_S16MSB}+fromAudioFormat AudioU16Sys = #{const AUDIO_U16SYS}+fromAudioFormat AudioS16Sys = #{const AUDIO_S16SYS}++toAudioFormat :: Word16 -> AudioFormat+toAudioFormat #{const AUDIO_U8} = AudioU8+toAudioFormat #{const AUDIO_S8} = AudioS8+toAudioFormat #{const AUDIO_U16LSB} = AudioU16LSB+toAudioFormat #{const AUDIO_S16LSB} = AudioS16LSB+toAudioFormat #{const AUDIO_U16MSB} = AudioU16MSB+toAudioFormat #{const AUDIO_S16MSB} = AudioS16MSB+toAudioFormat _ = error "Graphics.UI.SDL.Audio.toAudioFormat: bad argument"++
+ Graphics/UI/SDL/CPUInfo.hs view
@@ -0,0 +1,53 @@+module Graphics.UI.SDL.CPUInfo+ ( hasRDTSC+ , hasMMX+ , hasMMXExt+ , has3DNow+ , has3DNowExt+ , hasSSE+ , hasSSE2+ , hasAltiVec+ ) where++import Foreign.Marshal.Utils (toBool)++foreign import ccall unsafe "SDL_HasRDTSC" sdlHasRDTSC :: Int+-- |This function returns @True@ if the CPU has the RDTSC instruction.+hasRDTSC :: Bool+hasRDTSC = toBool sdlHasRDTSC++foreign import ccall unsafe "SDL_HasMMX" sdlHasMMX :: Int+-- |This function returns @True@ if the CPU has MMX features.+hasMMX :: Bool+hasMMX = toBool sdlHasMMX++foreign import ccall unsafe "SDL_HasMMXExt" sdlHasMMXExt :: Int+-- |This function returns @True@ if the CPU has MMX Ext. features.+hasMMXExt :: Bool+hasMMXExt = toBool sdlHasMMXExt++foreign import ccall unsafe "SDL_Has3DNow" sdlHas3DNow :: Int+-- |This function returns @True@ if the CPU has 3DNow features.+has3DNow :: Bool+has3DNow = toBool sdlHas3DNow++foreign import ccall unsafe "SDL_Has3DNowExt" sdlHas3DNowExt :: Int+-- |This function returns @True@ if the CPU has 3DNow! Ext. features.+has3DNowExt :: Bool+has3DNowExt = toBool sdlHas3DNowExt++foreign import ccall unsafe "SDL_HasSSE" sdlHasSSE :: Int+-- |This function returns @True@ if the CPU has SSE features.+hasSSE :: Bool+hasSSE = toBool sdlHasSSE++foreign import ccall unsafe "SDL_HasSSE2" sdlHasSSE2 :: Int+-- |This function returns @True@ if the CPU has SSE2 features.+hasSSE2 :: Bool+hasSSE2 = toBool sdlHasSSE2++foreign import ccall unsafe "SDL_HasAltiVec" sdlHasAltiVec :: Int+-- |This function returns @True@ if the CPU has AltiVec features.+hasAltiVec :: Bool+hasAltiVec = toBool sdlHasAltiVec+
+ Graphics/UI/SDL/Color.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Color+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Color+ (Color (..)+ ,Pixel (..)+ ) where++import Foreign (castPtr,pokeArray)+import Data.Word (Word8,Word32)+import Foreign.Storable (Storable(..))++data Color+ = Color+ { colorRed, colorGreen, colorBlue :: Word8 }++instance Storable Color where+ sizeOf = const 4+ alignment = const 1+ peek ptr+ = do r <- peekByteOff ptr 0+ g <- peekByteOff ptr 1+ b <- peekByteOff ptr 2+ return (Color r g b)+ poke ptr (Color r g b) = pokeArray (castPtr ptr) [r,g,b,0]++newtype Pixel = Pixel Word32 deriving (Show,Eq,Ord)++instance Storable Pixel where+ sizeOf (Pixel v) = sizeOf v+ alignment (Pixel v) = alignment v+ peek p+ = do v <- peek (castPtr p)+ return $ Pixel v+ poke p (Pixel v) = poke (castPtr p) v
+ Graphics/UI/SDL/Events.hsc view
@@ -0,0 +1,625 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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 = #{const SDL_NOEVENT}+fromSDLEvent SDLActiveEvent = #{const SDL_ACTIVEEVENT}+fromSDLEvent SDLKeyDown = #{const SDL_KEYDOWN}+fromSDLEvent SDLKeyUp = #{const SDL_KEYUP}+fromSDLEvent SDLMouseMotion = #{const SDL_MOUSEMOTION}+fromSDLEvent SDLMouseButtonDown = #{const SDL_MOUSEBUTTONDOWN}+fromSDLEvent SDLMouseButtonUp = #{const SDL_MOUSEBUTTONUP}+fromSDLEvent SDLJoyAxisMotion = #{const SDL_JOYAXISMOTION}+fromSDLEvent SDLJoyBallMotion = #{const SDL_JOYBALLMOTION}+fromSDLEvent SDLJoyHatMotion = #{const SDL_JOYHATMOTION}+fromSDLEvent SDLJoyButtonDown = #{const SDL_JOYBUTTONDOWN}+fromSDLEvent SDLJoyButtonUp = #{const SDL_JOYBUTTONUP}+fromSDLEvent SDLQuit = #{const SDL_QUIT}+fromSDLEvent SDLSysWMEvent = #{const SDL_SYSWMEVENT}+fromSDLEvent SDLVideoResize = #{const SDL_VIDEORESIZE}+fromSDLEvent SDLVideoExpose = #{const SDL_VIDEOEXPOSE}+fromSDLEvent (SDLUserEvent n) = #{const SDL_USEREVENT} + n+fromSDLEvent SDLNumEvents = #{const SDL_NUMEVENTS}++toSDLEvent :: Word8 -> SDLEvent+toSDLEvent #{const SDL_NOEVENT} = SDLNoEvent+toSDLEvent #{const SDL_ACTIVEEVENT} = SDLActiveEvent+toSDLEvent #{const SDL_KEYDOWN} = SDLKeyDown+toSDLEvent #{const SDL_KEYUP} = SDLKeyUp+toSDLEvent #{const SDL_MOUSEMOTION} = SDLMouseMotion+toSDLEvent #{const SDL_MOUSEBUTTONDOWN} = SDLMouseButtonDown+toSDLEvent #{const SDL_MOUSEBUTTONUP} = SDLMouseButtonUp+toSDLEvent #{const SDL_JOYAXISMOTION} = SDLJoyAxisMotion+toSDLEvent #{const SDL_JOYBALLMOTION} = SDLJoyBallMotion+toSDLEvent #{const SDL_JOYHATMOTION} = SDLJoyHatMotion+toSDLEvent #{const SDL_JOYBUTTONDOWN} = SDLJoyButtonDown+toSDLEvent #{const SDL_JOYBUTTONUP} = SDLJoyButtonUp+toSDLEvent #{const SDL_QUIT} = SDLQuit+toSDLEvent #{const SDL_SYSWMEVENT} = SDLSysWMEvent+toSDLEvent #{const SDL_VIDEORESIZE} = SDLVideoResize+toSDLEvent #{const SDL_VIDEOEXPOSE} = SDLVideoExpose+toSDLEvent n + | n >= #{const SDL_USEREVENT} &&+ n < #{const SDL_NUMEVENTS} = SDLUserEvent (n - #{const SDL_USEREVENT})+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 !Word16 !Word16+ | 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 #{const SDL_BUTTON_LEFT} = ButtonLeft+ toEnum #{const SDL_BUTTON_MIDDLE} = ButtonMiddle+ toEnum #{const SDL_BUTTON_RIGHT} = ButtonRight+ toEnum #{const SDL_BUTTON_WHEELUP} = ButtonWheelUp+ toEnum #{const SDL_BUTTON_WHEELDOWN} = ButtonWheelDown+ toEnum _ = error "Graphics.UI.SDL.Events.toEnum: bad argument"+ fromEnum ButtonLeft = #{const SDL_BUTTON_LEFT}+ fromEnum ButtonMiddle = #{const SDL_BUTTON_MIDDLE}+ fromEnum ButtonRight = #{const SDL_BUTTON_RIGHT}+ fromEnum ButtonWheelUp = #{const SDL_BUTTON_WHEELUP}+ fromEnum ButtonWheelDown = #{const SDL_BUTTON_WHEELDOWN}+ 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 = #{const SDL_APPMOUSEFOCUS}+ fromEnum InputFocus = #{const SDL_APPINPUTFOCUS}+ fromEnum ApplicationFocus = #{const SDL_APPACTIVE}+ toEnum #{const SDL_APPMOUSEFOCUS} = MouseFocus+ toEnum #{const SDL_APPINPUTFOCUS} = InputFocus+ toEnum #{const SDL_APPACTIVE} = ApplicationFocus+ toEnum _ = error "Graphics.UI.SDL.Events.toEnum: bad argument"+ succ MouseFocus = InputFocus+ succ InputFocus = ApplicationFocus+ succ _ = error "Graphics.UI.SDL.Events.succ: bad argument"+ pred InputFocus = MouseFocus+ pred ApplicationFocus = InputFocus+ pred _ = error "Graphics.UI.SDL.Events.pred: bad argument"+ enumFromTo x y | x > y = []+ | x == y = [y]+ | True = x : enumFromTo (succ x) y++-- |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 ((#{peek SDL_ActiveEvent, gain} ptr) :: IO Word8)+ state <- #{peek SDL_ActiveEvent, state} ptr :: IO Word8+ return $! (if gain then GotFocus else LostFocus) (fromBitmask state)++peekKey :: (Keysym -> Event) -> Ptr Event -> IO Event+peekKey mkEvent ptr+ = do keysym <- #{peek SDL_KeyboardEvent, keysym} ptr+ return $! mkEvent keysym++peekMouseMotion :: Ptr Event -> IO Event+peekMouseMotion ptr+ = do x <- #{peek SDL_MouseMotionEvent, x} ptr+ y <- #{peek SDL_MouseMotionEvent, y} ptr+ xrel <- #{peek SDL_MouseMotionEvent, xrel} ptr+ yrel <- #{peek SDL_MouseMotionEvent, yrel} ptr+ return $! MouseMotion x y xrel yrel++peekMouse :: (Word16 -> Word16 -> MouseButton -> Event) -> Ptr Event -> IO Event+peekMouse mkEvent ptr+ = do b <- #{peek SDL_MouseButtonEvent, button} ptr+ x <- #{peek SDL_MouseButtonEvent, x} ptr+ y <- #{peek SDL_MouseButtonEvent, y} ptr+ return $! mkEvent x y (toEnum (b::Word8))++peekJoyAxisMotion :: Ptr Event -> IO Event+peekJoyAxisMotion ptr+ = do which <- #{peek SDL_JoyAxisEvent, which} ptr+ axis <- #{peek SDL_JoyAxisEvent, axis} ptr+ value <- #{peek SDL_JoyAxisEvent, value} ptr+ return $! JoyAxisMotion which axis value++peekJoyBallMotion :: Ptr Event -> IO Event+peekJoyBallMotion ptr+ = do which <- #{peek SDL_JoyBallEvent, which} ptr+ ball <- #{peek SDL_JoyBallEvent, ball} ptr+ xrel <- #{peek SDL_JoyBallEvent, xrel} ptr+ yrel <- #{peek SDL_JoyBallEvent, yrel} ptr+ return $! JoyBallMotion which ball xrel yrel++peekJoyHatMotion :: Ptr Event -> IO Event+peekJoyHatMotion ptr+ = do which <- #{peek SDL_JoyHatEvent, which} ptr+ hat <- #{peek SDL_JoyHatEvent, hat} ptr+ value <- #{peek SDL_JoyHatEvent, value} ptr+ return $! JoyHatMotion which hat value++peekJoyButton :: (Word8 -> Word8 -> Event) -> Ptr Event -> IO Event+peekJoyButton mkEvent ptr+ = do which <- #{peek SDL_JoyButtonEvent, which} ptr+ button <- #{peek SDL_JoyButtonEvent, button} ptr+ return $! mkEvent which button++peekResize :: Ptr Event -> IO Event+peekResize ptr+ = do w <- #{peek SDL_ResizeEvent, w} ptr+ h <- #{peek SDL_ResizeEvent, h} ptr+ return $! VideoResize w h++peekUserEvent :: Ptr Event -> Word8 -> IO Event+peekUserEvent ptr n+ = do code <- #{peek SDL_UserEvent, code} ptr+ data1 <- #{peek SDL_UserEvent, data1} ptr+ data2 <- #{peek SDL_UserEvent, data2} ptr+ return $ User (fromEventType n) code data1 data2++getEventType :: Event -> Word8+getEventType = fromSDLEvent . eventToSDLEvent++eventToSDLEvent :: Event -> SDLEvent+eventToSDLEvent NoEvent = SDLNoEvent+eventToSDLEvent (GotFocus _) = SDLActiveEvent+eventToSDLEvent (LostFocus _) = SDLActiveEvent+eventToSDLEvent (KeyDown _) = SDLKeyDown+eventToSDLEvent (KeyUp _) = SDLKeyUp+eventToSDLEvent (MouseMotion _ _ _ _) = SDLMouseMotion+eventToSDLEvent (MouseButtonDown _ _ _) = SDLMouseButtonDown+eventToSDLEvent (MouseButtonUp _ _ _) = SDLMouseButtonUp+eventToSDLEvent (JoyAxisMotion _ _ _) = SDLJoyAxisMotion+eventToSDLEvent (JoyBallMotion _ _ _ _) = SDLJoyBallMotion+eventToSDLEvent (JoyHatMotion _ _ _) = SDLJoyHatMotion+eventToSDLEvent (JoyButtonDown _ _) = SDLJoyButtonDown+eventToSDLEvent (JoyButtonUp _ _) = SDLJoyButtonUp+eventToSDLEvent Quit = SDLQuit+eventToSDLEvent (VideoResize _ _) = SDLVideoResize+eventToSDLEvent VideoExpose = SDLVideoExpose+eventToSDLEvent (User uid _ _ _) = SDLUserEvent (toEventType uid)+eventToSDLEvent _ = error "Graphics.UI.SDL.Events.eventToSDLEvent: bad argument"++pokeActiveEvent :: Ptr Event -> Word8 -> [Focus] -> IO ()+pokeActiveEvent ptr gain focus+ = do #{poke SDL_ActiveEvent, gain} ptr gain+ #{poke SDL_ActiveEvent, state} ptr (toBitmask focus)++pokeKey :: Ptr Event -> Word8 -> Keysym -> IO ()+pokeKey ptr state keysym+ = do #{poke SDL_KeyboardEvent, state} ptr state+ #{poke SDL_KeyboardEvent, keysym} ptr keysym++pokeMouseMotion :: Ptr Event -> Word16 -> Word16 -> Word16 -> Word16 -> IO ()+pokeMouseMotion ptr x y xrel yrel+ = do #{poke SDL_MouseMotionEvent, x} ptr x+ #{poke SDL_MouseMotionEvent, y} ptr y+ #{poke SDL_MouseMotionEvent, xrel} ptr xrel+ #{poke SDL_MouseMotionEvent, yrel} ptr yrel++pokeMouseButton :: Ptr Event -> Word8 -> Word16 -> Word16 -> MouseButton -> IO ()+pokeMouseButton ptr state x y b+ = do #{poke SDL_MouseButtonEvent, x} ptr x+ #{poke SDL_MouseButtonEvent, y} ptr y+ #{poke SDL_MouseButtonEvent, state} ptr state+ #{poke SDL_MouseButtonEvent, button} ptr (fromEnum b)++pokeJoyAxisMotion :: Ptr Event -> Word8 -> Word8 -> Int16 -> IO ()+pokeJoyAxisMotion ptr which axis value+ = do #{poke SDL_JoyAxisEvent, which} ptr which+ #{poke SDL_JoyAxisEvent, axis} ptr axis+ #{poke SDL_JoyAxisEvent, value} ptr value++pokeJoyBallMotion :: Ptr Event -> Word8 -> Word8 -> Int16 -> Int16 -> IO ()+pokeJoyBallMotion ptr which ball xrel yrel+ = do #{poke SDL_JoyBallEvent, which} ptr which+ #{poke SDL_JoyBallEvent, ball} ptr ball+ #{poke SDL_JoyBallEvent, xrel} ptr xrel+ #{poke SDL_JoyBallEvent, yrel} ptr yrel++pokeJoyHatMotion :: Ptr Event -> Word8 -> Word8 -> Word8 -> IO ()+pokeJoyHatMotion ptr which hat value+ = do #{poke SDL_JoyHatEvent, which} ptr which+ #{poke SDL_JoyHatEvent, hat} ptr hat+ #{poke SDL_JoyHatEvent, value} ptr value++pokeJoyButton :: Ptr Event -> Word8 -> Word8 -> Word8 -> IO ()+pokeJoyButton ptr which button state+ = do #{poke SDL_JoyButtonEvent, which} ptr which+ #{poke SDL_JoyButtonEvent, button} ptr button+ #{poke SDL_JoyButtonEvent, state} ptr state++pokeResize :: Ptr Event -> Int -> Int -> IO ()+pokeResize ptr w h+ = do #{poke SDL_ResizeEvent, w} ptr w+ #{poke SDL_ResizeEvent, h} ptr h++pokeUserEvent :: Ptr Event -> UserEventID -> Int -> Ptr () -> Ptr () -> IO ()+pokeUserEvent ptr _eventId code data1 data2+ = do #{poke SDL_UserEvent, code} ptr code+ #{poke SDL_UserEvent, data1} ptr data1+ #{poke SDL_UserEvent, data2} ptr data2++instance Storable Event where+ sizeOf = const (#{size SDL_Event})+ 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 #{const SDL_PRESSED} keysym+ KeyUp keysym -> pokeKey ptr #{const SDL_RELEASED} keysym+ MouseMotion x y xrel yrel -> pokeMouseMotion ptr x y xrel yrel+ MouseButtonDown x y b -> pokeMouseButton ptr #{const SDL_PRESSED} x y b+ MouseButtonUp x y b -> pokeMouseButton ptr #{const SDL_RELEASED} x y b+ JoyAxisMotion w a v -> pokeJoyAxisMotion ptr w a v+ JoyBallMotion w b x y -> pokeJoyBallMotion ptr w b x y+ JoyHatMotion w h v -> pokeJoyHatMotion ptr w h v+ JoyButtonDown w b -> pokeJoyButton ptr w b #{const SDL_PRESSED}+ JoyButtonUp w b -> pokeJoyButton ptr w b #{const SDL_RELEASED}+ 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 :: #{type SDLKey} -> IO CString++-- | 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 #{type SDLMod}++-- | 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 :: #{type SDLMod} -> IO ()++-- | 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/General.hsc view
@@ -0,0 +1,160 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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 = #{const SDL_INIT_TIMER}+ fromEnum InitAudio = #{const SDL_INIT_AUDIO}+ fromEnum InitVideo = #{const SDL_INIT_VIDEO}+ fromEnum InitCDROM = #{const SDL_INIT_CDROM}+ fromEnum InitJoystick = #{const SDL_INIT_JOYSTICK}+ fromEnum InitNoParachute = #{const SDL_INIT_NOPARACHUTE}+ fromEnum InitEventthread = #{const SDL_INIT_EVENTTHREAD}+ fromEnum InitEverything = #{const SDL_INIT_EVERYTHING}+ toEnum #{const SDL_INIT_TIMER} = InitTimer+ toEnum #{const SDL_INIT_AUDIO} = InitAudio+ toEnum #{const SDL_INIT_VIDEO}= InitVideo+ toEnum #{const SDL_INIT_CDROM} = InitCDROM+ toEnum #{const SDL_INIT_JOYSTICK} = InitJoystick+ toEnum #{const SDL_INIT_NOPARACHUTE} = InitNoParachute+ toEnum #{const SDL_INIT_EVENTTHREAD} = InitEventthread+ toEnum #{const SDL_INIT_EVERYTHING} = InitEverything+ 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/Joystick.hsc view
@@ -0,0 +1,176 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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 =+#if defined(__GLASGOW_HASKELL__)+ finalizeForeignPtr+#else+ const (return ())+#endif++-- 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/Keysym.hsc view
@@ -0,0 +1,1310 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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 #{size SDL_keysym}+ alignment = const 4+ poke ptr (Keysym key mods unicode)+ = do #{poke SDL_keysym, sym} ptr (fromEnum key)+ #{poke SDL_keysym, mod} ptr (toBitmask mods)+ #{poke SDL_keysym, unicode} ptr (fromIntegral (ord unicode) :: Word16)+ peek ptr+ = do sym <- #{peek SDL_keysym, sym} ptr+ mods <- #{peek SDL_keysym, mod} ptr+ uni <- #{peek SDL_keysym, unicode} ptr+ 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 #{type SDLMod} where+ 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 #{type SDLMod} where+ 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/RWOps.hs view
@@ -0,0 +1,69 @@+-----------------------------------------------------------------------------+-- |+-- 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.RWOps+ ( fromFile+ , tryFromFile+ , free+ , with+ , mkFinalizedRW+ ) where++import Foreign (Ptr, FunPtr,+#if defined(__GLASGOW_HASKELL__)+ finalizeForeignPtr,+#endif+ maybePeek, newForeignPtr)+import Foreign.C (withCString, CString)++import Control.Exception (bracket)++import Graphics.UI.SDL.Types (RWops, RWopsStruct)+import Graphics.UI.SDL.General (unwrapMaybe)+++with :: FilePath -> String -> (RWops -> IO a) -> IO a+with path mode action+ = bracket (fromFile path mode)+ (free)+ action+++-- extern DECLSPEC SDL_RWops * SDLCALL SDL_RWFromFile(const char *file, const char *mode);+foreign import ccall unsafe "SDL_RWFromFile" rwFromFile :: CString -> CString -> IO (Ptr RWopsStruct)+tryFromFile :: FilePath -> String -> IO (Maybe RWops)+tryFromFile filepath mode+ = withCString filepath $ \cPath ->+ withCString mode $ \cMode ->+ rwFromFile cPath cMode >>= maybePeek mkFinalizedRW++fromFile :: FilePath -> String -> IO RWops+fromFile filepath mode = unwrapMaybe "SDL_RWFromFile" (tryFromFile filepath mode)++-- extern DECLSPEC void SDLCALL SDL_FreeRW(SDL_RWops *area);+foreign import ccall unsafe "&SDL_FreeRW" rwFreeFinal :: FunPtr (Ptr RWopsStruct -> IO ())+mkFinalizedRW :: Ptr RWopsStruct -> IO RWops+mkFinalizedRW = newForeignPtr rwFreeFinal++free :: RWops -> IO ()+free =+#if defined(__GLASGOW_HASKELL__)+ finalizeForeignPtr+#else+ const (return ())+#endif++{-+foreign import ccall unsafe "SDL_FreeRW" rwFree :: Ptr RWopsStruct -> IO ()+free :: RWops -> IO ()+free rw = withForeignPtr rw rwFree +-}+
+ Graphics/UI/SDL/Rect.hsc view
@@ -0,0 +1,40 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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 #{size SDL_Rect}+ alignment = const 2+ peek ptr+ = do x <- #{peek SDL_Rect, x} ptr :: IO Int16+ y <- #{peek SDL_Rect, y} ptr :: IO Int16+ w <- #{peek SDL_Rect, w} ptr :: IO Word16+ h <- #{peek SDL_Rect, h} ptr :: IO Word16+ return $! Rect (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)+ poke ptr (Rect x y w h)+ = do #{poke SDL_Rect, x} ptr (fromIntegral x :: Int16)+ #{poke SDL_Rect, y} ptr (fromIntegral y :: Int16)+ #{poke SDL_Rect, w} ptr (fromIntegral w :: Word16)+ #{poke SDL_Rect, h} ptr (fromIntegral h :: Word16)+
+ Graphics/UI/SDL/Time.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.Time+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Time where+++import Foreign++-- Uint32 SDL_GetTicks(void);+foreign import ccall unsafe "SDL_GetTicks" getTicks :: IO Word32++-- void SDL_Delay(Uint32 ms);+foreign import ccall unsafe "SDL_Delay" delay :: Word32 -> IO ()+
+ Graphics/UI/SDL/Types.hsc view
@@ -0,0 +1,274 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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+ ) 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 = #{const SDL_HAT_CENTERED}+ fromEnum HatUp = #{const SDL_HAT_UP}+ fromEnum HatRight = #{const SDL_HAT_RIGHT}+ fromEnum HatDown = #{const SDL_HAT_DOWN}+ fromEnum HatLeft = #{const SDL_HAT_LEFT}+ fromEnum HatRightUp = #{const SDL_HAT_RIGHTUP}+ fromEnum HatRightDown = #{const SDL_HAT_RIGHTDOWN}+ fromEnum HatLeftUp = #{const SDL_HAT_LEFTUP}+ fromEnum HatLeftDown = #{const SDL_HAT_LEFTDOWN}+ toEnum #{const SDL_HAT_CENTERED} = HatCentered+ toEnum #{const SDL_HAT_UP} = HatUp+ toEnum #{const SDL_HAT_RIGHT} = HatRight+ toEnum #{const SDL_HAT_DOWN} = HatDown+ toEnum #{const SDL_HAT_LEFT} = HatLeft+ toEnum #{const SDL_HAT_RIGHTUP} = HatRightUp+ toEnum #{const SDL_HAT_RIGHTDOWN} = HatRightDown+ toEnum #{const SDL_HAT_LEFTUP} = HatLeftUp+ toEnum #{const SDL_HAT_LEFTDOWN} = HatLeftDown+ 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_ =<< #{peek SDL_Surface, format} ptr++pixelFormatGetAlpha :: PixelFormat -> IO Word8+pixelFormatGetAlpha format =+ withForeignPtr format $+ #{peek SDL_PixelFormat, alpha}++pixelFormatGetColorKey :: PixelFormat -> IO Pixel+pixelFormatGetColorKey format =+ fmap Pixel $+ withForeignPtr format $+ #{peek SDL_PixelFormat, colorkey}++pixelFormatGetBitsPerPixel :: PixelFormat -> IO Word8+pixelFormatGetBitsPerPixel format+ = withForeignPtr format $+ #{peek SDL_PixelFormat, BitsPerPixel}++pixelFormatGetBytesPerPixel :: PixelFormat -> IO Word8+pixelFormatGetBytesPerPixel format+ = withForeignPtr format $+ #{peek SDL_PixelFormat, BytesPerPixel}++surfaceGetWidth :: Surface -> Int+surfaceGetWidth surface+ = unsafePerformIO $+ withForeignPtr surface $+ #{peek SDL_Surface, w}++surfaceGetHeight :: Surface -> Int+surfaceGetHeight surface+ = unsafePerformIO $+ withForeignPtr surface $+ #{peek SDL_Surface, h}++surfaceGetFlags :: Surface -> IO [SurfaceFlag]+surfaceGetFlags surface+ = withForeignPtr surface $+ fmap fromBitmask . #{peek SDL_Surface, flags}++surfaceGetPitch :: Surface -> Word16+surfaceGetPitch surface+ = unsafePerformIO $+ withForeignPtr surface $+ #peek SDL_Surface, pitch++surfaceGetPixels :: Surface -> IO Pixels+surfaceGetPixels surface+ = withForeignPtr surface $+ #peek SDL_Surface, pixels+
+ Graphics/UI/SDL/Utilities.hs view
@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.UI.SDL.General+-- Copyright : (c) David Himmelstrup 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : provisional+-- Portability : portable+--+-- Various small functions which makes the binding process easier.+-----------------------------------------------------------------------------+module Graphics.UI.SDL.Utilities where++import Foreign (Bits((.|.), (.&.)))++import Prelude hiding (Enum(..))++class Enum a b | a -> b where+ succ :: a -> a+ pred :: a -> a+ toEnum :: b -> a+ fromEnum :: a -> b+ enumFromTo :: a -> a -> [a]++++intToBool :: Int -> IO Int -> IO Bool+intToBool err action+ = fmap (err/=) action++toBitmask :: (Enum a b,Bits b) => [a] -> b+toBitmask = foldr (.|.) 0 . map fromEnum++fromBitmask :: (Bounded a,Enum a b,Bits b) => b -> [a]+fromBitmask mask = foldr worker [] lst+ where lst = enumFromTo minBound maxBound+ worker v+ = if (mask .&. fromEnum v) /= 0+ then (:) v+ else id+{-+toBitmaskW :: (UnsignedEnum a) => [a] -> Word32+toBitmaskW = foldr (.|.) 0 . map fromEnumW++fromBitmaskW :: (Bounded a,UnsignedEnum a) => Word32 -> [a]+fromBitmaskW mask = foldr worker [] lst+ where lst = enumFromToW minBound maxBound+ worker v+ = if (mask .&. fromEnumW v) /= 0+ then (:) v+ else id++-}
+ Graphics/UI/SDL/Version.hsc view
@@ -0,0 +1,33 @@+#include "SDL.h"+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 _ = #{size SDL_version}+ alignment _ = 1+ peek ptr = do major <- #{peek SDL_version, major} ptr+ minor <- #{peek SDL_version, minor} ptr+ patch <- #{peek SDL_version, patch} ptr+ return (SDLVersion major minor patch)++compiledFor :: Version+compiledFor = Version [ #{const SDL_MAJOR_VERSION}+ , #{const SDL_MINOR_VERSION}+ , #{const SDL_PATCHLEVEL}+ ] []++-- 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/Video.hsc view
@@ -0,0 +1,700 @@+-----------------------------------------------------------------------------+-- |+-- 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++#include <SDL.h>++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 = #{const SDL_LOGPAL}+ fromEnum Physical = #{const SDL_PHYSPAL}+ toEnum #{const SDL_LOGPAL} = Logical+ toEnum #{const SDL_PHYSPAL} = Physical+ 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 (#{const SDL_DISABLE}) = Disable+toToggle (#{const SDL_ENABLE}) = Enable+toToggle (#{const SDL_QUERY}) = Query+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+#if SDL_BYTEORDER == SDL_LIL_ENDIAN+ 0x000000FF 0x0000FF00 0x00FF0000 0xFF000000+#else+ 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF+#endif++-- | 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 =+#if defined(__GLASGOW_HASKELL__)+ finalizeForeignPtr+#else+ const (return ())+#endif++-- 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" . tryDisplayFormat++-- 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 = #{const SDL_GL_RED_SIZE}+glGreenSize = #{const SDL_GL_GREEN_SIZE}+glBlueSize = #{const SDL_GL_BLUE_SIZE}+glAlphaSize = #{const SDL_GL_ALPHA_SIZE}+glBufferSize = #{const SDL_GL_BUFFER_SIZE}+glDoubleBuffer = #{const SDL_GL_DOUBLEBUFFER}+glDepthSize = #{const SDL_GL_DEPTH_SIZE}+glStencilSize = #{const SDL_GL_STENCIL_SIZE}+glAccumRedSize = #{const SDL_GL_ACCUM_RED_SIZE}+glAccumGreenSize = #{const SDL_GL_ACCUM_GREEN_SIZE}+glAccumBlueSize = #{const SDL_GL_ACCUM_BLUE_SIZE}+glAccumAlphaSize = #{const SDL_GL_ACCUM_ALPHA_SIZE}+glStereo = #{const SDL_GL_STEREO}+glMultiSampleBuffers = #{const SDL_GL_MULTISAMPLEBUFFERS}+glMultiSampleSamples = #{const SDL_GL_MULTISAMPLESAMPLES}++--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/WindowManagement.hsc view
@@ -0,0 +1,110 @@+#include "SDL.h"+-----------------------------------------------------------------------------+-- |+-- 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 :: #{type SDL_GrabMode} -> GrabMode+toGrabMode (#{const SDL_GRAB_QUERY}) = GrabQuery+toGrabMode (#{const SDL_GRAB_OFF}) = GrabOff+toGrabMode (#{const SDL_GRAB_ON}) = GrabOn+toGrabMode _ = error "Graphics.UI.SDL.WindowManagement.toGrabMode: bad argument"++fromGrabMode :: GrabMode -> #{type SDL_GrabMode}+fromGrabMode GrabQuery = (#{const SDL_GRAB_QUERY})+fromGrabMode GrabOff = (#{const SDL_GRAB_OFF})+fromGrabMode GrabOn = (#{const SDL_GRAB_ON})++-- 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 :: #{type SDL_GrabMode} -> IO #{type SDL_GrabMode}+-- | 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++
+ LICENSE view
@@ -0,0 +1,35 @@+Copyright (c) 2004-2006, David Himmelstrup+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++ * Redistributions of source code must retain+ the above copyright notice, this list of+ conditions and the following disclaimer.+ * Redistributions in binary form must reproduce+ the above copyright notice, this list of+ conditions and the following disclaimer in the+ documentation and/or other materials provided+ with the distribution.+ * Neither the name of David Himmelstrup nor the+ names of other contributors may be used to+ endorse or promote products derived from this+ software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.
+ SDL.cabal view
@@ -0,0 +1,34 @@+Name: SDL+Version: 0.4.0+Maintainer: Lemmih (lemmih@gmail.com)+Author: Lemmih (lemmih@gmail.com)+Copyright: 2004-2005, Lemmih+License-File: LICENSE+License: BSD3+Build-Depends: base+Category: Foreign binding+Synopsis: Binding to libSDL+Tested-with: GHC ==6.4, Hugs ==20050308+Extensions: CPP, ForeignFunctionInterface, MultiParamTypeClasses, FunctionalDependencies+Exposed-Modules:+ Graphics.UI.SDL,+ Graphics.UI.SDL.CPUInfo,+ Graphics.UI.SDL.General,+ Graphics.UI.SDL.Video,+ Graphics.UI.SDL.WindowManagement,+ Graphics.UI.SDL.Audio,+ Graphics.UI.SDL.Events,+ Graphics.UI.SDL.Time,+ Graphics.UI.SDL.Keysym,+ Graphics.UI.SDL.Color,+ Graphics.UI.SDL.RWOps,+ Graphics.UI.SDL.Types,+ Graphics.UI.SDL.Rect,+ Graphics.UI.SDL.Utilities,+ Graphics.UI.SDL.Version,+ Graphics.UI.SDL.Joystick+Includes: SDL.h+-- Include-Dirs: /usr/local/lib/ghc-6.4.1/include, /sw/include/SDL+Extra-Libraries: SDL+Frameworks: AppKit+GHC-Options: -fglasgow-exts -Wall -Werror
+ Setup.lhs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMainWithHooks defaultUserHooks