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