sdl2 2.1.3.1 → 2.2.0
raw patch · 21 files changed
+553/−298 lines, 21 files
Files
- ChangeLog.md +53/−0
- examples/AudioExample.hs +2/−2
- sdl2.cabal +6/−5
- src/SDL.hs +4/−4
- src/SDL/Audio.hs +1/−1
- src/SDL/Event.hs +155/−132
- src/SDL/Exception.hs +0/−62
- src/SDL/Filesystem.hs +1/−1
- src/SDL/Init.hs +1/−4
- src/SDL/Input/Joystick.hs +51/−2
- src/SDL/Input/Mouse.hs +14/−21
- src/SDL/Internal/Exception.hs +69/−0
- src/SDL/Raw/Audio.hs +18/−0
- src/SDL/Raw/Enum.hsc +47/−0
- src/SDL/Raw/Event.hs +36/−0
- src/SDL/Raw/Types.hsc +32/−2
- src/SDL/Raw/Video.hs +18/−0
- src/SDL/Time.hs +1/−1
- src/SDL/Video.hs +26/−25
- src/SDL/Video/OpenGL.hs +8/−5
- src/SDL/Video/Renderer.hs +10/−31
ChangeLog.md view
@@ -1,3 +1,56 @@+2.2.0+=====++* Version 2.0.4 of the SDL2 C library is now required:+ * `SDL.Event`:+ * Add `AudioDeviceEvent` constructor to `Event`+ * Add `KeymapChangedEvent` constructor to `EventPayload`+ * Add `mouseWheelEventDirection` field to `MouseWheelEventData`+ * `SDL.Input.Mouse`:+ * Add `MouseScrollDirection` enumeration+ * `SDL.Raw.Audio`:+ * Add `clearQueuedAudio` function+ * Add `getQueuedAudioSize` function+ * Add `queueAudio` function+ * `SDL.Raw.Enum`:+ * Add `SDL_GL_CONTEXT_RELEASE_BEHAVIOR` pattern synonym+ * Add `JoystickPowerLevel` pattern synonyms+ * Add `SDL_MOUSEWHEEL_NORMAL` and `SDL_MOUSEWHEEL_FLIPPED` pattern synonyms+ * Add `SDL_KEYMAPCHANGED`, `SDL_AUDIODEVICEADDED`, `SDL_AUDIODEVICEREMOVED`,+ `SDL_RENDER_TARGETS_RESET`, and `SDL_RENDER_DEVICE_RESET` pattern synonyms+ * Add `SDL_GL_CONTEXT_RELEASE_BEHAVIOR_NONE` and+ `SDL_GL_CONTEXT_RELEASE_BEHAVIOR_FLUSH` pattern synonyms+ * Add `SDL_WINDOW_MOUSE_CAPTURE` pattern synonym+ * `SDL.Raw.Event`:+ * Add `captureMouse` function+ * Add `getGlobalMouseState` function+ * Add `warpMouseGlobal` function+ * Add `joystickCurrentPowerLevel` function+ * Add `joystickFromInstanceID` function+ * Add `gameControllerFromInstanceID` function+ * `SDL.Raw.Event`:+ * Add `AudioDeviceEvent` constructor to `Event`+ * Add `KeymapChangedEvent` constructor to `Event`+ * Add `mouseWheelEventDirection` field to `MouseMotionEvent` constructor++* Add `SDL.Exception` module, exposing `SDLException`+* Add new function, `createSoftwareRenderer`, to render onto a surface+* Add joystick POV hat support+* Remove deprecated functionality:+ * `InitEverything` enumeration in `SDL.Init`+ * `mapRGB` in `SDL.Video.Renderer`+ * `setRelativeMouseMode` in `SDL.Input.Mouse`+ * `getRelativeMouseMode` in `SDL.Input.Mouse`+ * `getMouseLocation` in `SDL.Input.Mouse`+* Remove `ClipboardUpdateEventData`+* Merge `isScreenSaverEnabled, `enableScreenSaver`, and `disableScreenSaver`+ into a `screenSaverEnabled` StateVar.+* Make function `surfaceBlit` in `SDL.Video.Renderer` return final blit+ rectangle post-clipping.+* Make all fields in EventData constructors strict+* Fix issue with `setWindowMode` transitions not working properly between+ fullscreen and windowed modes.+ 2.1.3.1 =======
examples/AudioExample.hs view
@@ -5,7 +5,7 @@ import Data.IORef import Control.Monad import Control.Concurrent-import Data.Int (Int16)+import Data.Int (Int16, Int32) import SDL import qualified Data.Vector.Storable.Mutable as V @@ -15,7 +15,7 @@ let t = fromIntegral n / 48000 :: Double freq = 440 * 4 in round (fromIntegral (maxBound `div` 2 :: Int16) * sin (t * freq)))- [0 :: Int16 ..]+ [0 :: Int32 ..] audioCB :: IORef [Int16] -> AudioFormat sampleType -> V.IOVector sampleType -> IO () audioCB samples format buffer =
sdl2.cabal view
@@ -1,6 +1,6 @@ name: sdl2-version: 2.1.3.1-synopsis: Both high- and low-level bindings to the SDL library (version 2.0.2+).+version: 2.2.0+synopsis: Both high- and low-level bindings to the SDL library (version 2.0.4+). description: This package contains bindings to the SDL 2 library, in both high- and low-level forms:@@ -60,6 +60,7 @@ SDL SDL.Audio SDL.Event+ SDL.Exception SDL.Filesystem SDL.Hint SDL.Init@@ -75,6 +76,8 @@ SDL.Video.OpenGL SDL.Video.Renderer + SDL.Internal.Exception+ SDL.Internal.Numbered SDL.Internal.Types SDL.Internal.Vect @@ -95,8 +98,6 @@ other-modules: Data.Bitmask- SDL.Internal.Numbered- SDL.Exception hs-source-dirs: src/@@ -115,7 +116,7 @@ SDL2 pkgconfig-depends:- sdl2 >= 2.0.2+ sdl2 >= 2.0.4 build-depends: base >= 4.7 && < 5,
src/SDL.hs view
@@ -26,20 +26,20 @@ , module SDL.Vect , module SDL.Video + -- * Error Handling+ , module SDL.Exception+ -- * Working with State Variables -- $stateVars , get, ($=), ($~) -- ** Strict modification , ($=!), ($~!)-- -- * Error Handling- , SDLException(..) ) where import Data.StateVar import SDL.Audio import SDL.Event-import SDL.Exception (SDLException(..))+import SDL.Exception import SDL.Filesystem import SDL.Hint import SDL.Init
src/SDL/Audio.hs view
@@ -89,7 +89,7 @@ import Foreign.Storable import GHC.Exts (Constraint) import GHC.Generics (Generic)-import SDL.Exception+import SDL.Internal.Exception import qualified Data.ByteString as BS import qualified Data.Text.Encoding as Text import qualified Data.Vector as V
src/SDL/Event.hs view
@@ -54,6 +54,8 @@ , ControllerAxisEventData(..) , ControllerButtonEventData(..) , ControllerDeviceEventData(..)+ -- ** Audio events+ , AudioDeviceEventData(..) -- ** User events , UserEventData(..) -- ** Touch events@@ -63,8 +65,6 @@ , DollarGestureEventData(..) -- ** Drag and drop events , DropEventData(..)- -- ** Clipboard events- , ClipboardUpdateEventData(..) -- ** Unknown events , UnknownEventData(..) -- * Auxiliary event data@@ -77,17 +77,18 @@ import Data.Maybe (catMaybes) import Data.Text (Text) import Data.Typeable-import Foreign+import Foreign hiding (throwIfNeg_) import Foreign.C import GHC.Generics (Generic) import SDL.Vect+import SDL.Input.Joystick import SDL.Input.Keyboard import SDL.Input.Mouse+import SDL.Internal.Exception import SDL.Internal.Numbered import SDL.Internal.Types (Window(Window)) import qualified Data.ByteString.Char8 as BSC8 import qualified Data.Text.Encoding as Text-import qualified SDL.Exception as SDLEx import qualified SDL.Raw as Raw #if !MIN_VERSION_base(4,8,0)@@ -105,383 +106,392 @@ -- | An enumeration of all possible SDL event types. This data type pairs up event types with -- their payload, where possible. data EventPayload- = WindowShownEvent WindowShownEventData- | WindowHiddenEvent WindowHiddenEventData- | WindowExposedEvent WindowExposedEventData- | WindowMovedEvent WindowMovedEventData- | WindowResizedEvent WindowResizedEventData- | WindowSizeChangedEvent WindowSizeChangedEventData- | WindowMinimizedEvent WindowMinimizedEventData- | WindowMaximizedEvent WindowMaximizedEventData- | WindowRestoredEvent WindowRestoredEventData- | WindowGainedMouseFocusEvent WindowGainedMouseFocusEventData- | WindowLostMouseFocusEvent WindowLostMouseFocusEventData- | WindowGainedKeyboardFocusEvent WindowGainedKeyboardFocusEventData- | WindowLostKeyboardFocusEvent WindowLostKeyboardFocusEventData- | WindowClosedEvent WindowClosedEventData- | KeyboardEvent KeyboardEventData- | TextEditingEvent TextEditingEventData- | TextInputEvent TextInputEventData- | MouseMotionEvent MouseMotionEventData- | MouseButtonEvent MouseButtonEventData- | MouseWheelEvent MouseWheelEventData- | JoyAxisEvent JoyAxisEventData- | JoyBallEvent JoyBallEventData- | JoyHatEvent JoyHatEventData- | JoyButtonEvent JoyButtonEventData- | JoyDeviceEvent JoyDeviceEventData- | ControllerAxisEvent ControllerAxisEventData- | ControllerButtonEvent ControllerButtonEventData- | ControllerDeviceEvent ControllerDeviceEventData+ = WindowShownEvent !WindowShownEventData+ | WindowHiddenEvent !WindowHiddenEventData+ | WindowExposedEvent !WindowExposedEventData+ | WindowMovedEvent !WindowMovedEventData+ | WindowResizedEvent !WindowResizedEventData+ | WindowSizeChangedEvent !WindowSizeChangedEventData+ | WindowMinimizedEvent !WindowMinimizedEventData+ | WindowMaximizedEvent !WindowMaximizedEventData+ | WindowRestoredEvent !WindowRestoredEventData+ | WindowGainedMouseFocusEvent !WindowGainedMouseFocusEventData+ | WindowLostMouseFocusEvent !WindowLostMouseFocusEventData+ | WindowGainedKeyboardFocusEvent !WindowGainedKeyboardFocusEventData+ | WindowLostKeyboardFocusEvent !WindowLostKeyboardFocusEventData+ | WindowClosedEvent !WindowClosedEventData+ | KeyboardEvent !KeyboardEventData+ | TextEditingEvent !TextEditingEventData+ | TextInputEvent !TextInputEventData+ | KeymapChangedEvent+ | MouseMotionEvent !MouseMotionEventData+ | MouseButtonEvent !MouseButtonEventData+ | MouseWheelEvent !MouseWheelEventData+ | JoyAxisEvent !JoyAxisEventData+ | JoyBallEvent !JoyBallEventData+ | JoyHatEvent !JoyHatEventData+ | JoyButtonEvent !JoyButtonEventData+ | JoyDeviceEvent !JoyDeviceEventData+ | ControllerAxisEvent !ControllerAxisEventData+ | ControllerButtonEvent !ControllerButtonEventData+ | ControllerDeviceEvent !ControllerDeviceEventData+ | AudioDeviceEvent !AudioDeviceEventData | QuitEvent- | UserEvent UserEventData- | SysWMEvent SysWMEventData- | TouchFingerEvent TouchFingerEventData- | MultiGestureEvent MultiGestureEventData- | DollarGestureEvent DollarGestureEventData- | DropEvent DropEventData- | ClipboardUpdateEvent ClipboardUpdateEventData- | UnknownEvent UnknownEventData+ | UserEvent !UserEventData+ | SysWMEvent !SysWMEventData+ | TouchFingerEvent !TouchFingerEventData+ | MultiGestureEvent !MultiGestureEventData+ | DollarGestureEvent !DollarGestureEventData+ | DropEvent !DropEventData+ | ClipboardUpdateEvent+ | UnknownEvent !UnknownEventData deriving (Eq, Ord, Generic, Show, Typeable) -- | A window has been shown. data WindowShownEventData =- WindowShownEventData {windowShownEventWindow :: Window+ WindowShownEventData {windowShownEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A window has been hidden. data WindowHiddenEventData =- WindowHiddenEventData {windowHiddenEventWindow :: Window+ WindowHiddenEventData {windowHiddenEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A part of a window has been exposed - where exposure means to become visible (for example, an overlapping window no longer overlaps with the window). data WindowExposedEventData =- WindowExposedEventData {windowExposedEventWindow :: Window+ WindowExposedEventData {windowExposedEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A 'Window' has been moved. data WindowMovedEventData =- WindowMovedEventData {windowMovedEventWindow :: Window+ WindowMovedEventData {windowMovedEventWindow :: !Window -- ^ The associated 'Window'.- ,windowMovedEventPosition :: Point V2 Int32+ ,windowMovedEventPosition :: !(Point V2 Int32) -- ^ The new position of the 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Window has been resized. This is event is always preceded by 'WindowSizeChangedEvent'. data WindowResizedEventData =- WindowResizedEventData {windowResizedEventWindow :: Window+ WindowResizedEventData {windowResizedEventWindow :: !Window -- ^ The associated 'Window'.- ,windowResizedEventSize :: V2 Int32+ ,windowResizedEventSize :: !(V2 Int32) -- ^ The new size of the 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window size has changed, either as a result of an API call or through the system or user changing the window size; this event is followed by 'WindowResizedEvent' if the size was changed by an external event, i.e. the user or the window manager. data WindowSizeChangedEventData =- WindowSizeChangedEventData {windowSizeChangedEventWindow :: Window+ WindowSizeChangedEventData {windowSizeChangedEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has been minimized. data WindowMinimizedEventData =- WindowMinimizedEventData {windowMinimizedEventWindow :: Window+ WindowMinimizedEventData {windowMinimizedEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has been maximized. data WindowMaximizedEventData =- WindowMaximizedEventData {windowMaximizedEventWindow :: Window+ WindowMaximizedEventData {windowMaximizedEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has been restored to normal size and position. data WindowRestoredEventData =- WindowRestoredEventData {windowRestoredEventWindow :: Window+ WindowRestoredEventData {windowRestoredEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has gained mouse focus. data WindowGainedMouseFocusEventData =- WindowGainedMouseFocusEventData {windowGainedMouseFocusEventWindow :: Window+ WindowGainedMouseFocusEventData {windowGainedMouseFocusEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has lost mouse focus. data WindowLostMouseFocusEventData =- WindowLostMouseFocusEventData {windowLostMouseFocusEventWindow :: Window+ WindowLostMouseFocusEventData {windowLostMouseFocusEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has gained keyboard focus. data WindowGainedKeyboardFocusEventData =- WindowGainedKeyboardFocusEventData {windowGainedKeyboardFocusEventWindow :: Window+ WindowGainedKeyboardFocusEventData {windowGainedKeyboardFocusEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has lost keyboard focus. data WindowLostKeyboardFocusEventData =- WindowLostKeyboardFocusEventData {windowLostKeyboardFocusEventWindow :: Window+ WindowLostKeyboardFocusEventData {windowLostKeyboardFocusEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window manager requests that the window be closed. data WindowClosedEventData =- WindowClosedEventData {windowClosedEventWindow :: Window+ WindowClosedEventData {windowClosedEventWindow :: !Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A keyboard key has been pressed or released. data KeyboardEventData =- KeyboardEventData {keyboardEventWindow :: Window+ KeyboardEventData {keyboardEventWindow :: !Window -- ^ The associated 'Window'.- ,keyboardEventKeyMotion :: InputMotion+ ,keyboardEventKeyMotion :: !InputMotion -- ^ Whether the key was pressed or released.- ,keyboardEventRepeat :: Bool+ ,keyboardEventRepeat :: !Bool -- ^ 'True' if this is a repeating key press from the user holding the key down.- ,keyboardEventKeysym :: Keysym+ ,keyboardEventKeysym :: !Keysym -- ^ A description of the key that this event pertains to. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Keyboard text editing event information. data TextEditingEventData =- TextEditingEventData {textEditingEventWindow :: Window+ TextEditingEventData {textEditingEventWindow :: !Window -- ^ The associated 'Window'.- ,textEditingEventText :: Text+ ,textEditingEventText :: !Text -- ^ The editing text.- ,textEditingEventStart :: Int32+ ,textEditingEventStart :: !Int32 -- ^ The location to begin editing from.- ,textEditingEventLength :: Int32+ ,textEditingEventLength :: !Int32 -- ^ The number of characters to edit from the start point. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Keyboard text input event information. data TextInputEventData =- TextInputEventData {textInputEventWindow :: Window+ TextInputEventData {textInputEventWindow :: !Window -- ^ The associated 'Window'.- ,textInputEventText :: Text+ ,textInputEventText :: !Text -- ^ The input text. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A mouse or pointer device was moved. data MouseMotionEventData =- MouseMotionEventData {mouseMotionEventWindow :: Window+ MouseMotionEventData {mouseMotionEventWindow :: !Window -- ^ The associated 'Window'.- ,mouseMotionEventWhich :: MouseDevice+ ,mouseMotionEventWhich :: !MouseDevice -- ^ The 'MouseDevice' that was moved.- ,mouseMotionEventState :: [MouseButton]+ ,mouseMotionEventState :: ![MouseButton] -- ^ A collection of 'MouseButton's that are currently held down.- ,mouseMotionEventPos :: Point V2 Int32+ ,mouseMotionEventPos :: !(Point V2 Int32) -- ^ The new position of the mouse.- ,mouseMotionEventRelMotion :: V2 Int32+ ,mouseMotionEventRelMotion :: !(V2 Int32) -- ^ The relative mouse motion of the mouse. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A mouse or pointer device button was pressed or released. data MouseButtonEventData =- MouseButtonEventData {mouseButtonEventWindow :: Window+ MouseButtonEventData {mouseButtonEventWindow :: !Window -- ^ The associated 'Window'.- ,mouseButtonEventMotion :: InputMotion+ ,mouseButtonEventMotion :: !InputMotion -- ^ Whether the button was pressed or released.- ,mouseButtonEventWhich :: MouseDevice+ ,mouseButtonEventWhich :: !MouseDevice -- ^ The 'MouseDevice' whose button was pressed or released.- ,mouseButtonEventButton :: MouseButton+ ,mouseButtonEventButton :: !MouseButton -- ^ The button that was pressed or released.- ,mouseButtonEventClicks :: Word8+ ,mouseButtonEventClicks :: !Word8 -- ^ The amount of clicks. 1 for a single-click, 2 for a double-click, etc.- ,mouseButtonEventPos :: Point V2 Int32+ ,mouseButtonEventPos :: !(Point V2 Int32) -- ^ The coordinates of the mouse click. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Mouse wheel event information. data MouseWheelEventData =- MouseWheelEventData {mouseWheelEventWindow :: Window+ MouseWheelEventData {mouseWheelEventWindow :: !Window -- ^ The associated 'Window'.- ,mouseWheelEventWhich :: MouseDevice+ ,mouseWheelEventWhich :: !MouseDevice -- ^ The 'MouseDevice' whose wheel was scrolled.- ,mouseWheelEventPos :: V2 Int32+ ,mouseWheelEventPos :: !(V2 Int32) -- ^ The amount scrolled.+ ,mouseWheelEventDirection :: !MouseScrollDirection+ -- ^ The scroll direction mode. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Joystick axis motion event information data JoyAxisEventData =- JoyAxisEventData {joyAxisEventWhich :: Raw.JoystickID+ JoyAxisEventData {joyAxisEventWhich :: !Raw.JoystickID -- ^ The instance id of the joystick that reported the event.- ,joyAxisEventAxis :: Word8+ ,joyAxisEventAxis :: !Word8 -- ^ The index of the axis that changed.- ,joyAxisEventValue :: Int16+ ,joyAxisEventValue :: !Int16 -- ^ The current position of the axis, ranging between -32768 and 32767. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Joystick trackball motion event information. data JoyBallEventData =- JoyBallEventData {joyBallEventWhich :: Raw.JoystickID+ JoyBallEventData {joyBallEventWhich :: !Raw.JoystickID -- ^ The instance id of the joystick that reported the event.- ,joyBallEventBall :: Word8+ ,joyBallEventBall :: !Word8 -- ^ The index of the trackball that changed.- ,joyBallEventRelMotion :: V2 Int16+ ,joyBallEventRelMotion :: !(V2 Int16) -- ^ The relative motion of the trackball. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Joystick hat position change event information data JoyHatEventData =- JoyHatEventData {joyHatEventWhich :: Raw.JoystickID+ JoyHatEventData {joyHatEventWhich :: !Raw.JoystickID -- ^ The instance id of the joystick that reported the event.- ,joyHatEventHat :: Word8+ ,joyHatEventHat :: !Word8 -- ^ The index of the hat that changed.- ,joyHatEventValue :: Word8+ ,joyHatEventValue :: !JoyHatPosition -- ^ The new position of the hat. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Joystick button event information. data JoyButtonEventData =- JoyButtonEventData {joyButtonEventWhich :: Raw.JoystickID+ JoyButtonEventData {joyButtonEventWhich :: !Raw.JoystickID -- ^ The instance id of the joystick that reported the event.- ,joyButtonEventButton :: Word8+ ,joyButtonEventButton :: !Word8 -- ^ The index of the button that changed.- ,joyButtonEventState :: Word8+ ,joyButtonEventState :: !Word8 -- ^ The state of the button. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Joystick device event information. data JoyDeviceEventData =- JoyDeviceEventData {joyDeviceEventWhich :: Int32+ JoyDeviceEventData {joyDeviceEventWhich :: !Int32 -- ^ The instance id of the joystick that reported the event. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Game controller axis motion event information. data ControllerAxisEventData =- ControllerAxisEventData {controllerAxisEventWhich :: Raw.JoystickID+ ControllerAxisEventData {controllerAxisEventWhich :: !Raw.JoystickID -- ^ The joystick instance ID that reported the event.- ,controllerAxisEventAxis :: Word8+ ,controllerAxisEventAxis :: !Word8 -- ^ The index of the axis.- ,controllerAxisEventValue :: Int16+ ,controllerAxisEventValue :: !Int16 -- ^ The axis value ranging between -32768 and 32767. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Game controller button event information data ControllerButtonEventData =- ControllerButtonEventData {controllerButtonEventWhich :: Raw.JoystickID+ ControllerButtonEventData {controllerButtonEventWhich :: !Raw.JoystickID -- ^ The joystick instance ID that reported the event.- ,controllerButtonEventButton :: Word8+ ,controllerButtonEventButton :: !Word8 -- ^ The controller button.- ,controllerButtonEventState :: Word8+ ,controllerButtonEventState :: !Word8 -- ^ The state of the button. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Controller device event information data ControllerDeviceEventData =- ControllerDeviceEventData {controllerDeviceEventWhich :: Int32+ ControllerDeviceEventData {controllerDeviceEventWhich :: !Int32 -- ^ The joystick instance ID that reported the event. } deriving (Eq,Ord,Generic,Show,Typeable) +data AudioDeviceEventData =+ AudioDeviceEventData {audioDeviceEventIsAddition :: !Bool+ -- ^ If the audio device is an addition, or a removal.+ ,audioDeviceEventWhich :: !Word32+ -- ^ The audio device ID that reported the event.+ ,audioDeviceEventIsCapture :: !Bool+ -- ^ If the audio device is a capture device.+ }+ deriving (Eq,Ord,Generic,Show,Typeable)+ -- | Event data for application-defined events. data UserEventData =- UserEventData {userEventWindow :: Window+ UserEventData {userEventWindow :: !Window -- ^ The associated 'Window'.- ,userEventCode :: Int32+ ,userEventCode :: !Int32 -- ^ User defined event code.- ,userEventData1 :: Ptr ()+ ,userEventData1 :: !(Ptr ()) -- ^ User defined data pointer.- ,userEventData2 :: Ptr ()+ ,userEventData2 :: !(Ptr ()) -- ^ User defined data pointer. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A video driver dependent system event data SysWMEventData =- SysWMEventData {sysWMEventMsg :: Raw.SysWMmsg}+ SysWMEventData {sysWMEventMsg :: !Raw.SysWMmsg} deriving (Eq,Ord,Generic,Show,Typeable) -- | Finger touch event information. data TouchFingerEventData =- TouchFingerEventData {touchFingerEventTouchID :: Raw.TouchID+ TouchFingerEventData {touchFingerEventTouchID :: !Raw.TouchID -- ^ The touch device index.- ,touchFingerEventFingerID :: Raw.FingerID+ ,touchFingerEventFingerID :: !Raw.FingerID -- ^ The finger index.- ,touchFingerEventPos :: Point V2 CFloat+ ,touchFingerEventPos :: !(Point V2 CFloat) -- ^ The location of the touch event, normalized between 0 and 1.- ,touchFingerEventRelMotion :: V2 CFloat+ ,touchFingerEventRelMotion :: !(V2 CFloat) -- ^ The distance moved, normalized between -1 and 1.- ,touchFingerEventPressure :: CFloat+ ,touchFingerEventPressure :: !CFloat -- ^ The quantity of the pressure applied, normalized between 0 and 1. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Multiple finger gesture event information data MultiGestureEventData =- MultiGestureEventData {multiGestureEventTouchID :: Raw.TouchID+ MultiGestureEventData {multiGestureEventTouchID :: !Raw.TouchID -- ^ The touch device index.- ,multiGestureEventDTheta :: CFloat+ ,multiGestureEventDTheta :: !CFloat -- ^ The amount that the fingers rotated during this motion.- ,multiGestureEventDDist :: CFloat+ ,multiGestureEventDDist :: !CFloat -- ^ The amount that the fingers pinched during this motion.- ,multiGestureEventPos :: Point V2 CFloat+ ,multiGestureEventPos :: !(Point V2 CFloat) -- ^ The normalized center of the gesture.- ,multiGestureEventNumFingers :: Word16+ ,multiGestureEventNumFingers :: !Word16 -- ^ The number of fingers used in this gesture. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Complex gesture event information. data DollarGestureEventData =- DollarGestureEventData {dollarGestureEventTouchID :: Raw.TouchID+ DollarGestureEventData {dollarGestureEventTouchID :: !Raw.TouchID -- ^ The touch device index.- ,dollarGestureEventGestureID :: Raw.GestureID+ ,dollarGestureEventGestureID :: !Raw.GestureID -- ^ The unique id of the closest gesture to the performed stroke.- ,dollarGestureEventNumFingers :: Word32+ ,dollarGestureEventNumFingers :: !Word32 -- ^ The number of fingers used to draw the stroke.- ,dollarGestureEventError :: CFloat+ ,dollarGestureEventError :: !CFloat -- ^ The difference between the gesture template and the actual performed gesture (lower errors correspond to closer matches).- ,dollarGestureEventPos :: Point V2 CFloat+ ,dollarGestureEventPos :: !(Point V2 CFloat) -- ^ The normalized center of the gesture. } deriving (Eq,Ord,Generic,Show,Typeable) -- | An event used to request a file open by the system data DropEventData =- DropEventData {dropEventFile :: CString+ DropEventData {dropEventFile :: !CString -- ^ The file name. } deriving (Eq,Ord,Generic,Show,Typeable) --- | The clipboard changed.-data ClipboardUpdateEventData =- ClipboardUpdateEventData- deriving (Eq,Ord,Generic,Show,Typeable)- -- | SDL reported an unknown event type. data UnknownEventData =- UnknownEventData {unknownEventType :: Word32+ UnknownEventData {unknownEventType :: !Word32 -- ^ The unknown event code. } deriving (Eq,Ord,Generic,Show,Typeable)@@ -569,6 +579,8 @@ (TextInputEvent (TextInputEventData w' (ccharStringToText b))))+convertRaw (Raw.KeymapChangedEvent _ ts) =+ return (Event ts KeymapChangedEvent) convertRaw (Raw.MouseMotionEvent _ ts a b c d e f g) = do w' <- fmap Window (Raw.getWindowFromID a) let buttons =@@ -609,13 +621,14 @@ button e (P (V2 f g)))))-convertRaw (Raw.MouseWheelEvent _ ts a b c d) =+convertRaw (Raw.MouseWheelEvent _ ts a b c d e) = do w' <- fmap Window (Raw.getWindowFromID a) return (Event ts (MouseWheelEvent (MouseWheelEventData w' (fromNumber b)- (V2 c d))))+ (V2 c d)+ (fromNumber e)))) convertRaw (Raw.JoyAxisEvent _ ts a b c) = return (Event ts (JoyAxisEvent (JoyAxisEventData a b c))) convertRaw (Raw.JoyBallEvent _ ts a b c d) =@@ -625,7 +638,11 @@ b (V2 c d)))) convertRaw (Raw.JoyHatEvent _ ts a b c) =- return (Event ts (JoyHatEvent (JoyHatEventData a b c)))+ return (Event ts+ (JoyHatEvent+ (JoyHatEventData a+ b+ (fromNumber c)))) convertRaw (Raw.JoyButtonEvent _ ts a b c) = return (Event ts (JoyButtonEvent (JoyButtonEventData a b c))) convertRaw (Raw.JoyDeviceEvent _ ts a) =@@ -636,6 +653,12 @@ return (Event ts (ControllerButtonEvent (ControllerButtonEventData a b c))) convertRaw (Raw.ControllerDeviceEvent _ ts a) = return (Event ts (ControllerDeviceEvent (ControllerDeviceEventData a)))+convertRaw (Raw.AudioDeviceEvent Raw.SDL_AUDIODEVICEADDED ts a b) =+ return (Event ts (AudioDeviceEvent (AudioDeviceEventData True a (b /= 0))))+convertRaw (Raw.AudioDeviceEvent Raw.SDL_AUDIODEVICEREMOVED ts a b) =+ return (Event ts (AudioDeviceEvent (AudioDeviceEventData False a (b /= 0))))+convertRaw (Raw.AudioDeviceEvent _ _ _ _) =+ error "convertRaw: Unknown audio device motion" convertRaw (Raw.QuitEvent _ ts) = return (Event ts QuitEvent) convertRaw (Raw.UserEvent _ ts a b c d) =@@ -670,7 +693,7 @@ convertRaw (Raw.DropEvent _ ts a) = return (Event ts (DropEvent (DropEventData a))) convertRaw (Raw.ClipboardUpdateEvent _ ts) =- return (Event ts (ClipboardUpdateEvent ClipboardUpdateEventData))+ return (Event ts ClipboardUpdateEvent) convertRaw (Raw.UnknownEvent t ts) = return (Event ts (UnknownEvent (UnknownEventData t))) @@ -703,7 +726,7 @@ -- | Wait indefinitely for the next available event. waitEvent :: MonadIO m => m Event waitEvent = liftIO $ alloca $ \e -> do- SDLEx.throwIfNeg_ "SDL.Events.waitEvent" "SDL_WaitEvent" $+ throwIfNeg_ "SDL.Events.waitEvent" "SDL_WaitEvent" $ Raw.waitEvent e peek e >>= convertRaw
src/SDL/Exception.hs view
@@ -1,38 +1,16 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module SDL.Exception ( SDLException(..)- , fromC- , getError- , throwIf- , throwIf_- , throwIf0- , throwIfNeg- , throwIfNeg_- , throwIfNot0- , throwIfNot0_- , throwIfNull ) where import Control.Exception-import Control.Monad-import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Data (Data)-import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Typeable (Typeable)-import Foreign (Ptr, nullPtr) import GHC.Generics (Generic)-import qualified Data.ByteString as BS-import qualified Data.Text.Encoding as Text-import qualified SDL.Raw as Raw -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- -- | Error details about a failure to call an SDL routine. Almost all functions in this library have the -- ability to produce exceptions of this type. Inspection should help you learn more about what has -- gone wrong.@@ -65,43 +43,3 @@ deriving (Data,Eq,Generic,Ord,Read,Show,Typeable) instance Exception SDLException--getError :: MonadIO m => m Text-getError = liftIO $ do- cstr <- Raw.getError- Text.decodeUtf8 <$> BS.packCString cstr--throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a-throwIf f caller funName m = do- a <- m- liftIO $ when (f a) $- (SDLCallFailed caller funName <$> getError) >>= throwIO- return a--throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m ()-throwIf_ f caller funName m = throwIf f caller funName m >> return ()--throwIfNeg :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m a-throwIfNeg = throwIf (< 0)--throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m ()-throwIfNeg_ = throwIf_ (< 0)--throwIfNull :: (MonadIO m) => Text -> Text -> m (Ptr a) -> m (Ptr a)-throwIfNull = throwIf (== nullPtr)--throwIf0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a-throwIf0 = throwIf (== 0)--throwIfNot0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a-throwIfNot0 = throwIf (/= 0)--throwIfNot0_ :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m ()-throwIfNot0_ = throwIf_ (/= 0)--fromC :: Show a => Text -> Text -> (a -> Maybe b) -> a -> b-fromC caller funName f x =- fromMaybe (throw (SDLUnexpectedArgument caller- funName- (show x)))- (f x)
src/SDL/Filesystem.hs view
@@ -11,7 +11,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Text (Text) import Foreign.Marshal.Alloc-import SDL.Exception+import SDL.Internal.Exception import qualified Data.ByteString as BS import qualified Data.Text.Encoding as Text import qualified SDL.Raw.Filesystem as Raw
src/SDL/Init.hs view
@@ -21,7 +21,7 @@ import Foreign.Marshal.Alloc import Foreign.Storable import GHC.Generics-import SDL.Exception+import SDL.Internal.Exception import SDL.Internal.Numbered import qualified SDL.Raw as Raw @@ -29,7 +29,6 @@ import Data.Foldable #endif -{-# DEPRECATED InitEverything "Instead of initialize [InitEverything], use initializeAll" #-} data InitFlag = InitTimer | InitAudio@@ -38,7 +37,6 @@ | InitHaptic | InitGameController | InitEvents- | InitEverything deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) instance ToNumber InitFlag Word32 where@@ -49,7 +47,6 @@ toNumber InitHaptic = Raw.SDL_INIT_HAPTIC toNumber InitGameController = Raw.SDL_INIT_GAMECONTROLLER toNumber InitEvents = Raw.SDL_INIT_EVENTS- toNumber InitEverything = Raw.SDL_INIT_EVERYTHING -- | Initializes SDL and the given subsystems. Do not call any SDL functions -- prior to this one, unless otherwise documented that you may do so.
src/SDL/Input/Joystick.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} module SDL.Input.Joystick ( numJoysticks@@ -19,19 +21,25 @@ , numAxes , numButtons , numBalls+ , JoyHatPosition(..)+ , getHat+ , numHats ) where import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Data (Data) import Data.Int import Data.Text (Text) import Data.Traversable (for) import Data.Typeable+import Data.Word import Foreign.C.Types import Foreign.Marshal.Alloc import Foreign.Storable import GHC.Generics (Generic) import SDL.Vect-import SDL.Exception+import SDL.Internal.Exception+import SDL.Internal.Numbered import SDL.Internal.Types import qualified Data.ByteString as BS import qualified Data.Text.Encoding as Text@@ -96,7 +104,7 @@ -- | Determine if a given button is currently held. -- -- See @<https://wiki.libsdl.org/SDL_JoystickGetButton SDL_JoystickGetButton>@ for C documentation.-buttonPressed :: (Functor m,MonadIO m)+buttonPressed :: (Functor m, MonadIO m) => Joystick -> CInt -- ^ The index of the button. You can use 'numButtons' to determine how many buttons a given joystick has. -> m Bool@@ -146,3 +154,44 @@ -- See @<https://wiki.libsdl.org/SDL_JoystickNumBalls SDL_JoystickNumBalls>@ for C documentation. numBalls :: (MonadIO m) => Joystick -> m CInt numBalls (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numBalls" "SDL_JoystickNumBalls" (Raw.joystickNumBalls j)++-- | Identifies the state of the POV hat on a joystick.+data JoyHatPosition+ = HatCentered -- ^ Centered position+ | HatUp -- ^ Up position+ | HatRight -- ^ Right position+ | HatDown -- ^ Down position+ | HatLeft -- ^ Left position+ | HatRightUp -- ^ Right-up position+ | HatRightDown -- ^ Right-down position+ | HatLeftUp -- ^ Left-up position+ | HatLeftDown -- ^ Left-down position+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance FromNumber JoyHatPosition Word8 where+ fromNumber n = case n of+ Raw.SDL_HAT_CENTERED -> HatCentered+ Raw.SDL_HAT_UP -> HatUp+ Raw.SDL_HAT_RIGHT -> HatRight+ Raw.SDL_HAT_DOWN -> HatDown+ Raw.SDL_HAT_LEFT -> HatLeft+ Raw.SDL_HAT_RIGHTUP -> HatRightUp+ Raw.SDL_HAT_RIGHTDOWN -> HatRightDown+ Raw.SDL_HAT_LEFTUP -> HatLeftUp+ Raw.SDL_HAT_LEFTDOWN -> HatLeftDown+ _ -> HatCentered++-- | Get current position of a POV hat on a joystick.+--+-- See @<https://wiki.libsdl.org/SDL_JoystickGetHat SDL_JoystickGetHat>@ for C documentation.+getHat :: (Functor m, MonadIO m)+ => Joystick+ -> CInt -- ^ The index of the POV hat. You can use 'numHats' to determine how many POV hats a given joystick has.+ -> m JoyHatPosition+getHat (Joystick j) hatIndex = fromNumber <$> Raw.joystickGetHat j hatIndex++-- | Get the number of POV hats on a joystick.+--+-- See @<https://wiki.libsdl.org/https://wiki.libsdl.org/SDL_JoystickNumHats SDL_JoystickNumHats>@ for C documentation.+numHats :: (MonadIO m) => Joystick -> m CInt+numHats (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numHats" "SDL_JoystickNumHats" (Raw.joystickNumHats j)
src/SDL/Input/Mouse.hs view
@@ -10,16 +10,14 @@ LocationMode(..) , setMouseLocationMode , getMouseLocationMode- , setRelativeMouseMode --deprecated- , getRelativeMouseMode --deprecated -- * Mouse and Touch Input , MouseButton(..) , MouseDevice(..)+ , MouseScrollDirection(..) -- * Mouse State , getModalMouseLocation- , getMouseLocation --deprecated , getAbsoluteMouseLocation , getRelativeMouseLocation , getMouseButtons@@ -53,7 +51,7 @@ import Foreign.Storable import GHC.Generics (Generic) import SDL.Vect-import SDL.Exception+import SDL.Internal.Exception import SDL.Internal.Numbered import SDL.Internal.Types (Window(Window)) import SDL.Video.Renderer (Surface(Surface))@@ -92,23 +90,6 @@ _ -> getAbsoluteMouseLocation return (mode, location) --- deprecated-setRelativeMouseMode :: (Functor m, MonadIO m) => Bool -> m ()-{-# DEPRECATED setRelativeMouseMode "Use setMouseLocationMode instead" #-}-setRelativeMouseMode enable =- throwIfNeg_ "SDL.Input.Mouse" "SDL_SetRelativeMouseMode" $- Raw.setRelativeMouseMode enable----deprecated-getRelativeMouseMode :: MonadIO m => m Bool-{-# DEPRECATED getRelativeMouseMode "Use getMouseLocationMode instead" #-}-getRelativeMouseMode = Raw.getRelativeMouseMode----deprecated-getMouseLocation :: MonadIO m => m (Point V2 CInt)-{-# DEPRECATED getMouseLocation "Use getAbsoluteMouseLocation instead, or getModalMouseLocation to match future behavior." #-}-getMouseLocation = getAbsoluteMouseLocation- data MouseButton = ButtonLeft | ButtonMiddle@@ -128,6 +109,18 @@ fromNumber n' = case n' of Raw.SDL_TOUCH_MOUSEID -> Touch n -> Mouse $ fromIntegral n++-- | Identifies mouse scroll direction.+data MouseScrollDirection+ = ScrollNormal+ | ScrollFlipped+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance FromNumber MouseScrollDirection Word32 where+ fromNumber n' = case n' of+ Raw.SDL_MOUSEWHEEL_NORMAL -> ScrollNormal+ Raw.SDL_MOUSEWHEEL_FLIPPED -> ScrollFlipped+ _ -> ScrollNormal data WarpMouseOrigin = WarpInWindow Window
+ src/SDL/Internal/Exception.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE CPP #-}++module SDL.Internal.Exception+ ( fromC+ , getError+ , throwIf+ , throwIf_+ , throwIf0+ , throwIfNeg+ , throwIfNeg_+ , throwIfNot0+ , throwIfNot0_+ , throwIfNull+ ) where++import Control.Exception+import Data.Maybe (fromMaybe)+import Control.Monad+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Text (Text)+import Foreign (Ptr, nullPtr)+import SDL.Exception+import qualified Data.ByteString as BS+import qualified Data.Text.Encoding as Text+import qualified SDL.Raw as Raw++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif++getError :: MonadIO m => m Text+getError = liftIO $ do+ cstr <- Raw.getError+ Text.decodeUtf8 <$> BS.packCString cstr++throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a+throwIf f caller funName m = do+ a <- m+ liftIO $ when (f a) $+ (SDLCallFailed caller funName <$> getError) >>= throwIO+ return a++throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m ()+throwIf_ f caller funName m = throwIf f caller funName m >> return ()++throwIfNeg :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m a+throwIfNeg = throwIf (< 0)++throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m ()+throwIfNeg_ = throwIf_ (< 0)++throwIfNull :: (MonadIO m) => Text -> Text -> m (Ptr a) -> m (Ptr a)+throwIfNull = throwIf (== nullPtr)++throwIf0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a+throwIf0 = throwIf (== 0)++throwIfNot0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a+throwIfNot0 = throwIf (/= 0)++throwIfNot0_ :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m ()+throwIfNot0_ = throwIf_ (/= 0)++fromC :: Show a => Text -> Text -> (a -> Maybe b) -> a -> b+fromC caller funName f x =+ fromMaybe (throw (SDLUnexpectedArgument caller+ funName+ (show x)))+ (f x)
src/SDL/Raw/Audio.hs view
@@ -3,6 +3,7 @@ audioInit, audioQuit, buildAudioCVT,+ clearQueuedAudio, closeAudio, closeAudioDevice, convertAudio,@@ -14,6 +15,7 @@ getCurrentAudioDriver, getNumAudioDevices, getNumAudioDrivers,+ getQueuedAudioSize, loadWAV, loadWAV_RW, lockAudio,@@ -24,6 +26,7 @@ openAudioDevice, pauseAudio, pauseAudioDevice,+ queueAudio, unlockAudio, unlockAudioDevice ) where@@ -40,6 +43,7 @@ foreign import ccall "SDL.h SDL_AudioInit" audioInitFFI :: CString -> IO CInt foreign import ccall "SDL.h SDL_AudioQuit" audioQuitFFI :: IO () foreign import ccall "SDL.h SDL_BuildAudioCVT" buildAudioCVTFFI :: Ptr AudioCVT -> AudioFormat -> Word8 -> CInt -> AudioFormat -> Word8 -> CInt -> IO CInt+foreign import ccall "SDL.h SDL_ClearQueuedAudio" clearQueuedAudioFFI :: AudioDeviceID -> IO () foreign import ccall "SDL.h SDL_CloseAudio" closeAudioFFI :: IO () foreign import ccall "SDL.h SDL_CloseAudioDevice" closeAudioDeviceFFI :: AudioDeviceID -> IO () foreign import ccall "SDL.h SDL_ConvertAudio" convertAudioFFI :: Ptr AudioCVT -> IO CInt@@ -51,6 +55,7 @@ foreign import ccall "SDL.h SDL_GetCurrentAudioDriver" getCurrentAudioDriverFFI :: IO CString foreign import ccall "SDL.h SDL_GetNumAudioDevices" getNumAudioDevicesFFI :: CInt -> IO CInt foreign import ccall "SDL.h SDL_GetNumAudioDrivers" getNumAudioDriversFFI :: IO CInt+foreign import ccall "SDL.h SDL_GetQueuedAudioSize" getQueuedAudioSizeFFI :: AudioDeviceID -> IO Word32 foreign import ccall "SDL.h SDL_LoadWAV_RW" loadWAV_RWFFI :: Ptr RWops -> CInt -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> IO (Ptr AudioSpec) foreign import ccall "SDL.h SDL_LockAudio" lockAudioFFI :: IO () foreign import ccall "SDL.h SDL_LockAudioDevice" lockAudioDeviceFFI :: AudioDeviceID -> IO ()@@ -60,6 +65,7 @@ foreign import ccall "SDL.h SDL_OpenAudioDevice" openAudioDeviceFFI :: CString -> CInt -> Ptr AudioSpec -> Ptr AudioSpec -> CInt -> IO AudioDeviceID foreign import ccall "SDL.h SDL_PauseAudio" pauseAudioFFI :: CInt -> IO () foreign import ccall "SDL.h SDL_PauseAudioDevice" pauseAudioDeviceFFI :: AudioDeviceID -> CInt -> IO ()+foreign import ccall "SDL.h SDL_QueueAudio" queueAudioFFI :: AudioDeviceID -> Ptr () -> Word32 -> IO CInt foreign import ccall "SDL.h SDL_UnlockAudio" unlockAudioFFI :: IO () foreign import ccall "SDL.h SDL_UnlockAudioDevice" unlockAudioDeviceFFI :: AudioDeviceID -> IO () @@ -75,6 +81,10 @@ buildAudioCVT v1 v2 v3 v4 v5 v6 v7 = liftIO $ buildAudioCVTFFI v1 v2 v3 v4 v5 v6 v7 {-# INLINE buildAudioCVT #-} +clearQueuedAudio :: MonadIO m => AudioDeviceID -> m ()+clearQueuedAudio v1 = liftIO $ clearQueuedAudioFFI v1+{-# INLINE clearQueuedAudio #-}+ closeAudio :: MonadIO m => m () closeAudio = liftIO closeAudioFFI {-# INLINE closeAudio #-}@@ -119,6 +129,10 @@ getNumAudioDrivers = liftIO getNumAudioDriversFFI {-# INLINE getNumAudioDrivers #-} +getQueuedAudioSize :: MonadIO m => AudioDeviceID -> m Word32+getQueuedAudioSize v1 = liftIO $ getQueuedAudioSizeFFI v1+{-# INLINE getQueuedAudioSize #-}+ loadWAV :: MonadIO m => CString -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> m (Ptr AudioSpec) loadWAV file spec audio_buf audio_len = liftIO $ do rw <- withCString "rb" $ rwFromFile file@@ -160,6 +174,10 @@ pauseAudioDevice :: MonadIO m => AudioDeviceID -> CInt -> m () pauseAudioDevice v1 v2 = liftIO $ pauseAudioDeviceFFI v1 v2 {-# INLINE pauseAudioDevice #-}++queueAudio :: MonadIO m => AudioDeviceID -> Ptr () -> Word32 -> m CInt+queueAudio v1 v2 v3 = liftIO $ queueAudioFFI v1 v2 v3+{-# INLINE queueAudio #-} unlockAudio :: MonadIO m => m () unlockAudio = liftIO unlockAudioFFI
src/SDL/Raw/Enum.hsc view
@@ -101,6 +101,7 @@ pattern SDL_GL_CONTEXT_PROFILE_MASK, pattern SDL_GL_SHARE_WITH_CURRENT_CONTEXT, pattern SDL_GL_FRAMEBUFFER_SRGB_CAPABLE,+ pattern SDL_GL_CONTEXT_RELEASE_BEHAVIOR, -- ** Hint Priority HintPriority,@@ -120,6 +121,16 @@ pattern SDL_INIT_NOPARACHUTE, pattern SDL_INIT_EVERYTHING, + -- ** Joystick Power Level+ JoystickPowerLevel,+ pattern SDL_JOYSTICK_POWER_UNKNOWN,+ pattern SDL_JOYSTICK_POWER_EMPTY,+ pattern SDL_JOYSTICK_POWER_LOW,+ pattern SDL_JOYSTICK_POWER_MEDIUM,+ pattern SDL_JOYSTICK_POWER_FULL,+ pattern SDL_JOYSTICK_POWER_WIRED,+ pattern SDL_JOYSTICK_POWER_MAX,+ -- ** Keycode Keycode, pattern SDLK_UNKNOWN,@@ -694,6 +705,10 @@ pattern SDL_BUTTON_X1MASK, pattern SDL_BUTTON_X2MASK, + -- ** Mouse Wheel Direction+ pattern SDL_MOUSEWHEEL_NORMAL,+ pattern SDL_MOUSEWHEEL_FLIPPED,+ -- ** Event Type pattern SDL_FIRSTEVENT, pattern SDL_QUIT,@@ -709,6 +724,7 @@ pattern SDL_KEYUP, pattern SDL_TEXTEDITING, pattern SDL_TEXTINPUT,+ pattern SDL_KEYMAPCHANGED, pattern SDL_MOUSEMOTION, pattern SDL_MOUSEBUTTONDOWN, pattern SDL_MOUSEBUTTONUP,@@ -734,6 +750,10 @@ pattern SDL_MULTIGESTURE, pattern SDL_CLIPBOARDUPDATE, pattern SDL_DROPFILE,+ pattern SDL_AUDIODEVICEADDED,+ pattern SDL_AUDIODEVICEREMOVED,+ pattern SDL_RENDER_TARGETS_RESET,+ pattern SDL_RENDER_DEVICE_RESET, pattern SDL_USEREVENT, pattern SDL_LASTEVENT, @@ -784,6 +804,10 @@ pattern SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG, pattern SDL_GL_CONTEXT_RESET_ISOLATION_FLAG, + -- ** OpenGL Context Release Behavior Flag+ pattern SDL_GL_CONTEXT_RELEASE_BEHAVIOR_NONE,+ pattern SDL_GL_CONTEXT_RELEASE_BEHAVIOR_FLUSH,+ -- ** Pixel Formats pattern SDL_PIXELFORMAT_UNKNOWN, pattern SDL_PIXELFORMAT_INDEX1LSB,@@ -873,6 +897,7 @@ pattern SDL_WINDOW_FULLSCREEN_DESKTOP, pattern SDL_WINDOW_FOREIGN, pattern SDL_WINDOW_ALLOW_HIGHDPI,+ pattern SDL_WINDOW_MOUSE_CAPTURE, -- ** Window Positioning pattern SDL_WINDOWPOS_UNDEFINED,@@ -899,6 +924,7 @@ type GLattr = (#type SDL_GLattr) type HintPriority = (#type SDL_HintPriority) type InitFlag = Word32+type JoystickPowerLevel = (#type SDL_JoystickPowerLevel) type Keycode = (#type SDL_Keycode) type Keymod = (#type SDL_Keymod) type LogPriority = (#type SDL_LogPriority)@@ -991,6 +1017,7 @@ pattern SDL_GL_CONTEXT_PROFILE_MASK = (#const SDL_GL_CONTEXT_PROFILE_MASK) :: GLattr pattern SDL_GL_SHARE_WITH_CURRENT_CONTEXT = (#const SDL_GL_SHARE_WITH_CURRENT_CONTEXT) :: GLattr pattern SDL_GL_FRAMEBUFFER_SRGB_CAPABLE = (#const SDL_GL_FRAMEBUFFER_SRGB_CAPABLE) :: GLattr+pattern SDL_GL_CONTEXT_RELEASE_BEHAVIOR = (#const SDL_GL_CONTEXT_RELEASE_BEHAVIOR) :: GLattr pattern SDL_HINT_DEFAULT = (#const SDL_HINT_DEFAULT) :: HintPriority pattern SDL_HINT_NORMAL = (#const SDL_HINT_NORMAL) :: HintPriority@@ -1006,6 +1033,14 @@ pattern SDL_INIT_NOPARACHUTE = (#const SDL_INIT_NOPARACHUTE) :: InitFlag pattern SDL_INIT_EVERYTHING = (#const SDL_INIT_EVERYTHING) :: InitFlag +pattern SDL_JOYSTICK_POWER_UNKNOWN = (#const SDL_JOYSTICK_POWER_UNKNOWN) :: JoystickPowerLevel+pattern SDL_JOYSTICK_POWER_EMPTY = (#const SDL_JOYSTICK_POWER_EMPTY) :: JoystickPowerLevel+pattern SDL_JOYSTICK_POWER_LOW = (#const SDL_JOYSTICK_POWER_LOW) :: JoystickPowerLevel+pattern SDL_JOYSTICK_POWER_MEDIUM = (#const SDL_JOYSTICK_POWER_MEDIUM) :: JoystickPowerLevel+pattern SDL_JOYSTICK_POWER_FULL = (#const SDL_JOYSTICK_POWER_FULL) :: JoystickPowerLevel+pattern SDL_JOYSTICK_POWER_WIRED = (#const SDL_JOYSTICK_POWER_WIRED) :: JoystickPowerLevel+pattern SDL_JOYSTICK_POWER_MAX = (#const SDL_JOYSTICK_POWER_MAX) :: JoystickPowerLevel+ pattern SDLK_UNKNOWN = (#const SDLK_UNKNOWN) :: Keycode pattern SDLK_RETURN = (#const SDLK_RETURN) :: Keycode pattern SDLK_ESCAPE = (#const SDLK_ESCAPE) :: Keycode@@ -1556,6 +1591,9 @@ pattern SDL_BUTTON_X1MASK = (#const SDL_BUTTON_X1MASK) pattern SDL_BUTTON_X2MASK = (#const SDL_BUTTON_X2MASK) +pattern SDL_MOUSEWHEEL_NORMAL = (#const SDL_MOUSEWHEEL_NORMAL)+pattern SDL_MOUSEWHEEL_FLIPPED = (#const SDL_MOUSEWHEEL_FLIPPED)+ pattern SDL_FIRSTEVENT = (#const SDL_FIRSTEVENT) pattern SDL_QUIT = (#const SDL_QUIT) pattern SDL_APP_TERMINATING = (#const SDL_APP_TERMINATING)@@ -1570,6 +1608,7 @@ pattern SDL_KEYUP = (#const SDL_KEYUP) pattern SDL_TEXTEDITING = (#const SDL_TEXTEDITING) pattern SDL_TEXTINPUT = (#const SDL_TEXTINPUT)+pattern SDL_KEYMAPCHANGED = (#const SDL_KEYMAPCHANGED) pattern SDL_MOUSEMOTION = (#const SDL_MOUSEMOTION) pattern SDL_MOUSEBUTTONDOWN = (#const SDL_MOUSEBUTTONDOWN) pattern SDL_MOUSEBUTTONUP = (#const SDL_MOUSEBUTTONUP)@@ -1595,6 +1634,10 @@ pattern SDL_MULTIGESTURE = (#const SDL_MULTIGESTURE) pattern SDL_CLIPBOARDUPDATE = (#const SDL_CLIPBOARDUPDATE) pattern SDL_DROPFILE = (#const SDL_DROPFILE)+pattern SDL_AUDIODEVICEADDED = (#const SDL_AUDIODEVICEADDED)+pattern SDL_AUDIODEVICEREMOVED = (#const SDL_AUDIODEVICEREMOVED)+pattern SDL_RENDER_TARGETS_RESET = (#const SDL_RENDER_TARGETS_RESET)+pattern SDL_RENDER_DEVICE_RESET = (#const SDL_RENDER_DEVICE_RESET) pattern SDL_USEREVENT = (#const SDL_USEREVENT) pattern SDL_LASTEVENT = (#const SDL_LASTEVENT) @@ -1638,6 +1681,9 @@ pattern SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG = (#const SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG) pattern SDL_GL_CONTEXT_RESET_ISOLATION_FLAG = (#const SDL_GL_CONTEXT_RESET_ISOLATION_FLAG) +pattern SDL_GL_CONTEXT_RELEASE_BEHAVIOR_NONE = (#const SDL_GL_CONTEXT_RELEASE_BEHAVIOR_NONE)+pattern SDL_GL_CONTEXT_RELEASE_BEHAVIOR_FLUSH = (#const SDL_GL_CONTEXT_RELEASE_BEHAVIOR_FLUSH)+ pattern SDL_PIXELFORMAT_UNKNOWN = (#const SDL_PIXELFORMAT_UNKNOWN) pattern SDL_PIXELFORMAT_INDEX1LSB = (#const SDL_PIXELFORMAT_INDEX1LSB) pattern SDL_PIXELFORMAT_INDEX1MSB = (#const SDL_PIXELFORMAT_INDEX1MSB)@@ -1720,6 +1766,7 @@ pattern SDL_WINDOW_FULLSCREEN_DESKTOP = (#const SDL_WINDOW_FULLSCREEN_DESKTOP) pattern SDL_WINDOW_FOREIGN = (#const SDL_WINDOW_FOREIGN) pattern SDL_WINDOW_ALLOW_HIGHDPI = (#const SDL_WINDOW_ALLOW_HIGHDPI)+pattern SDL_WINDOW_MOUSE_CAPTURE = (#const SDL_WINDOW_MOUSE_CAPTURE) pattern SDL_WINDOWPOS_UNDEFINED = (#const SDL_WINDOWPOS_UNDEFINED) pattern SDL_WINDOWPOS_CENTERED = (#const SDL_WINDOWPOS_CENTERED)
src/SDL/Raw/Event.hs view
@@ -46,12 +46,14 @@ stopTextInput, -- * Mouse Support+ captureMouse, createColorCursor, createCursor, createSystemCursor, freeCursor, getCursor, getDefaultCursor,+ getGlobalMouseState, getMouseFocus, getMouseState, getRelativeMouseMode,@@ -59,11 +61,14 @@ setCursor, setRelativeMouseMode, showCursor,+ warpMouseGlobal, warpMouseInWindow, -- * Joystick Support joystickClose,+ joystickCurrentPowerLevel, joystickEventState,+ joystickFromInstanceID, joystickGetAttached, joystickGetAxis, joystickGetBall,@@ -90,6 +95,7 @@ gameControllerAddMappingsFromRW, gameControllerClose, gameControllerEventState,+ gameControllerFromInstanceID, gameControllerGetAttached, gameControllerGetAxis, gameControllerGetAxisFromString,@@ -164,12 +170,14 @@ foreign import ccall "SDL.h SDL_StartTextInput" startTextInputFFI :: IO () foreign import ccall "SDL.h SDL_StopTextInput" stopTextInputFFI :: IO () +foreign import ccall "SDL.h SDL_CaptureMouse" captureMouseFFI :: Bool -> IO CInt foreign import ccall "SDL.h SDL_CreateColorCursor" createColorCursorFFI :: Ptr Surface -> CInt -> CInt -> IO Cursor foreign import ccall "SDL.h SDL_CreateCursor" createCursorFFI :: Ptr Word8 -> Ptr Word8 -> CInt -> CInt -> CInt -> CInt -> IO Cursor foreign import ccall "SDL.h SDL_CreateSystemCursor" createSystemCursorFFI :: SystemCursor -> IO Cursor foreign import ccall "SDL.h SDL_FreeCursor" freeCursorFFI :: Cursor -> IO () foreign import ccall "SDL.h SDL_GetCursor" getCursorFFI :: IO Cursor foreign import ccall "SDL.h SDL_GetDefaultCursor" getDefaultCursorFFI :: IO Cursor+foreign import ccall "SDL.h SDL_GetGlobalMouseState" getGlobalMouseStateFFI :: Ptr CInt -> Ptr CInt -> IO Word32 foreign import ccall "SDL.h SDL_GetMouseFocus" getMouseFocusFFI :: IO Window foreign import ccall "SDL.h SDL_GetMouseState" getMouseStateFFI :: Ptr CInt -> Ptr CInt -> IO Word32 foreign import ccall "SDL.h SDL_GetRelativeMouseMode" getRelativeMouseModeFFI :: IO Bool@@ -177,10 +185,13 @@ foreign import ccall "SDL.h SDL_SetCursor" setCursorFFI :: Cursor -> IO () foreign import ccall "SDL.h SDL_SetRelativeMouseMode" setRelativeMouseModeFFI :: Bool -> IO CInt foreign import ccall "SDL.h SDL_ShowCursor" showCursorFFI :: CInt -> IO CInt+foreign import ccall "SDL.h SDL_WarpMouseGlobal" warpMouseGlobalFFI :: CInt -> CInt -> IO CInt foreign import ccall "SDL.h SDL_WarpMouseInWindow" warpMouseInWindowFFI :: Window -> CInt -> CInt -> IO () foreign import ccall "SDL.h SDL_JoystickClose" joystickCloseFFI :: Joystick -> IO ()+foreign import ccall "SDL.h SDL_JoystickCurrentPowerLevel" joystickCurrentPowerLevelFFI :: Joystick -> IO JoystickPowerLevel foreign import ccall "SDL.h SDL_JoystickEventState" joystickEventStateFFI :: CInt -> IO CInt+foreign import ccall "SDL.h SDL_JoystickFromInstanceID" joystickFromInstanceIDFFI :: JoystickID -> IO Joystick foreign import ccall "SDL.h SDL_JoystickGetAttached" joystickGetAttachedFFI :: Joystick -> IO Bool foreign import ccall "SDL.h SDL_JoystickGetAxis" joystickGetAxisFFI :: Joystick -> CInt -> IO Int16 foreign import ccall "SDL.h SDL_JoystickGetBall" joystickGetBallFFI :: Joystick -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt@@ -205,6 +216,7 @@ foreign import ccall "SDL.h SDL_GameControllerAddMappingsFromRW" gameControllerAddMappingsFromRWFFI :: Ptr RWops -> CInt -> IO CInt foreign import ccall "SDL.h SDL_GameControllerClose" gameControllerCloseFFI :: GameController -> IO () foreign import ccall "SDL.h SDL_GameControllerEventState" gameControllerEventStateFFI :: CInt -> IO CInt+foreign import ccall "SDL.h SDL_GameControllerFromInstanceID" gameControllerFromInstanceIDFFI :: JoystickID -> IO GameController foreign import ccall "SDL.h SDL_GameControllerGetAttached" gameControllerGetAttachedFFI :: GameController -> IO Bool foreign import ccall "SDL.h SDL_GameControllerGetAxis" gameControllerGetAxisFFI :: GameController -> GameControllerAxis -> IO Int16 foreign import ccall "SDL.h SDL_GameControllerGetAxisFromString" gameControllerGetAxisFromStringFFI :: CString -> IO GameControllerAxis@@ -394,6 +406,10 @@ stopTextInput = liftIO stopTextInputFFI {-# INLINE stopTextInput #-} +captureMouse :: MonadIO m => Bool -> m CInt+captureMouse v1 = liftIO $ captureMouseFFI v1+{-# INLINE captureMouse #-}+ createColorCursor :: MonadIO m => Ptr Surface -> CInt -> CInt -> m Cursor createColorCursor v1 v2 v3 = liftIO $ createColorCursorFFI v1 v2 v3 {-# INLINE createColorCursor #-}@@ -418,6 +434,10 @@ getDefaultCursor = liftIO getDefaultCursorFFI {-# INLINE getDefaultCursor #-} +getGlobalMouseState :: MonadIO m => Ptr CInt -> Ptr CInt -> m Word32+getGlobalMouseState v1 v2 = liftIO $ getGlobalMouseStateFFI v1 v2+{-# INLINE getGlobalMouseState #-}+ getMouseFocus :: MonadIO m => m Window getMouseFocus = liftIO getMouseFocusFFI {-# INLINE getMouseFocus #-}@@ -446,6 +466,10 @@ showCursor v1 = liftIO $ showCursorFFI v1 {-# INLINE showCursor #-} +warpMouseGlobal :: MonadIO m => CInt -> CInt -> m CInt+warpMouseGlobal v1 v2 = liftIO $ warpMouseGlobalFFI v1 v2+{-# INLINE warpMouseGlobal #-}+ warpMouseInWindow :: MonadIO m => Window -> CInt -> CInt -> m () warpMouseInWindow v1 v2 v3 = liftIO $ warpMouseInWindowFFI v1 v2 v3 {-# INLINE warpMouseInWindow #-}@@ -454,10 +478,18 @@ joystickClose v1 = liftIO $ joystickCloseFFI v1 {-# INLINE joystickClose #-} +joystickCurrentPowerLevel :: MonadIO m => Joystick -> m JoystickPowerLevel+joystickCurrentPowerLevel v1 = liftIO $ joystickCurrentPowerLevelFFI v1+{-# INLINE joystickCurrentPowerLevel #-}+ joystickEventState :: MonadIO m => CInt -> m CInt joystickEventState v1 = liftIO $ joystickEventStateFFI v1 {-# INLINE joystickEventState #-} +joystickFromInstanceID :: MonadIO m => JoystickID -> m Joystick+joystickFromInstanceID v1 = liftIO $ joystickFromInstanceIDFFI v1+{-# INLINE joystickFromInstanceID #-}+ joystickGetAttached :: MonadIO m => Joystick -> m Bool joystickGetAttached v1 = liftIO $ joystickGetAttachedFFI v1 {-# INLINE joystickGetAttached #-}@@ -563,6 +595,10 @@ gameControllerEventState :: MonadIO m => CInt -> m CInt gameControllerEventState v1 = liftIO $ gameControllerEventStateFFI v1 {-# INLINE gameControllerEventState #-}++gameControllerFromInstanceID :: MonadIO m => JoystickID -> m GameController+gameControllerFromInstanceID v1 = liftIO $ gameControllerFromInstanceIDFFI v1+{-# INLINE gameControllerFromInstanceID #-} gameControllerGetAttached :: MonadIO m => GameController -> m Bool gameControllerGetAttached v1 = liftIO $ gameControllerGetAttachedFFI v1
src/SDL/Raw/Types.hsc view
@@ -304,6 +304,10 @@ , textInputEventWindowID :: !Word32 , textInputEventText :: ![CChar] }+ | KeymapChangedEvent+ { eventType :: !Word32+ , eventTimestamp :: !Word32+ } | MouseMotionEvent { eventType :: !Word32 , eventTimestamp :: !Word32@@ -333,6 +337,7 @@ , mouseWheelEventWhich :: !Word32 , mouseWheelEventX :: !Int32 , mouseWheelEventY :: !Int32+ , mouseWheelEventDirection :: !Word32 } | JoyAxisEvent { eventType :: !Word32@@ -387,6 +392,12 @@ , eventTimestamp :: !Word32 , controllerDeviceEventWhich :: !Int32 }+ | AudioDeviceEvent+ { eventType :: !Word32+ , eventTimestamp :: !Word32+ , audioDeviceEventWhich :: !Word32+ , audioDeviceEventIsCapture :: !Word8+ } | QuitEvent { eventType :: !Word32 , eventTimestamp :: !Word32@@ -482,6 +493,8 @@ text <- peekArray (#const SDL_TEXTINPUTEVENT_TEXT_SIZE) $ (#ptr SDL_Event, text.text) ptr let upToNull = takeWhile (/= 0) text return $! TextInputEvent typ timestamp wid upToNull+ (#const SDL_KEYMAPCHANGED) ->+ return $! KeymapChangedEvent typ timestamp (#const SDL_MOUSEMOTION) -> do wid <- (#peek SDL_Event, motion.windowID) ptr which <- (#peek SDL_Event, motion.which) ptr@@ -498,7 +511,8 @@ which <- (#peek SDL_Event, wheel.which) ptr x <- (#peek SDL_Event, wheel.x) ptr y <- (#peek SDL_Event, wheel.y) ptr- return $! MouseWheelEvent typ timestamp wid which x y+ direction <- (#peek SDL_Event, wheel.direction) ptr+ return $! MouseWheelEvent typ timestamp wid which x y direction (#const SDL_JOYAXISMOTION) -> do which <- (#peek SDL_Event, jaxis.which) ptr axis <- (#peek SDL_Event, jaxis.axis) ptr@@ -529,6 +543,8 @@ (#const SDL_CONTROLLERDEVICEADDED) -> controllerdevice $ ControllerDeviceEvent typ timestamp (#const SDL_CONTROLLERDEVICEREMOVED) -> controllerdevice $ ControllerDeviceEvent typ timestamp (#const SDL_CONTROLLERDEVICEREMAPPED) -> controllerdevice $ ControllerDeviceEvent typ timestamp+ (#const SDL_AUDIODEVICEADDED) -> audiodevice $ AudioDeviceEvent typ timestamp+ (#const SDL_AUDIODEVICEREMOVED) -> audiodevice $ AudioDeviceEvent typ timestamp (#const SDL_FINGERDOWN) -> finger $ TouchFingerEvent typ timestamp (#const SDL_FINGERUP) -> finger $ TouchFingerEvent typ timestamp (#const SDL_FINGERMOTION) -> finger $ TouchFingerEvent typ timestamp@@ -592,6 +608,11 @@ which <- (#peek SDL_Event, cdevice.which) ptr return $! f which + audiodevice f = do+ which <- (#peek SDL_Event, adevice.which) ptr+ iscapture <- (#peek SDL_Event, adevice.iscapture) ptr+ return $! f which iscapture+ finger f = do touchId <- (#peek SDL_Event, tfinger.touchId) ptr fingerId <- (#peek SDL_Event, tfinger.fingerId) ptr@@ -637,6 +658,9 @@ (#poke SDL_Event, common.timestamp) ptr timestamp (#poke SDL_Event, text.windowID) ptr wid pokeArray ((#ptr SDL_Event, text.text) ptr) text+ KeymapChangedEvent typ timestamp -> do+ (#poke SDL_Event, common.type) ptr typ+ (#poke SDL_Event, common.timestamp) ptr timestamp MouseMotionEvent typ timestamp wid which state x y xrel yrel -> do (#poke SDL_Event, common.type) ptr typ (#poke SDL_Event, common.timestamp) ptr timestamp@@ -657,13 +681,14 @@ (#poke SDL_Event, button.clicks) ptr clicks (#poke SDL_Event, button.x) ptr x (#poke SDL_Event, button.y) ptr y- MouseWheelEvent typ timestamp wid which x y -> do+ MouseWheelEvent typ timestamp wid which x y direction -> do (#poke SDL_Event, common.type) ptr typ (#poke SDL_Event, common.timestamp) ptr timestamp (#poke SDL_Event, wheel.windowID) ptr wid (#poke SDL_Event, wheel.which) ptr which (#poke SDL_Event, wheel.x) ptr x (#poke SDL_Event, wheel.y) ptr y+ (#poke SDL_Event, wheel.direction) ptr direction JoyAxisEvent typ timestamp which axis value -> do (#poke SDL_Event, common.type) ptr typ (#poke SDL_Event, common.timestamp) ptr timestamp@@ -709,6 +734,11 @@ (#poke SDL_Event, common.type) ptr typ (#poke SDL_Event, common.timestamp) ptr timestamp (#poke SDL_Event, cdevice.which) ptr which+ AudioDeviceEvent typ timestamp which iscapture -> do+ (#poke SDL_Event, common.type) ptr typ+ (#poke SDL_Event, common.timestamp) ptr timestamp+ (#poke SDL_Event, adevice.which) ptr which+ (#poke SDL_Event, adevice.iscapture) ptr iscapture QuitEvent typ timestamp -> do (#poke SDL_Event, common.type) ptr typ (#poke SDL_Event, common.timestamp) ptr timestamp
src/SDL/Raw/Video.hs view
@@ -29,8 +29,10 @@ getCurrentVideoDriver, getDesktopDisplayMode, getDisplayBounds,+ getDisplayDPI, getDisplayMode, getDisplayName,+ getGrabbedWindow, getNumDisplayModes, getNumVideoDisplays, getNumVideoDrivers,@@ -113,6 +115,7 @@ renderGetLogicalSize, renderGetScale, renderGetViewport,+ renderIsClipEnabled, renderPresent, renderReadPixels, renderSetClipRect,@@ -232,8 +235,10 @@ foreign import ccall "SDL.h SDL_GetCurrentVideoDriver" getCurrentVideoDriverFFI :: IO CString foreign import ccall "SDL.h SDL_GetDesktopDisplayMode" getDesktopDisplayModeFFI :: CInt -> Ptr DisplayMode -> IO CInt foreign import ccall "SDL.h SDL_GetDisplayBounds" getDisplayBoundsFFI :: CInt -> Ptr Rect -> IO CInt+foreign import ccall "SDL.h SDL_GetDisplayDPI" getDisplayDPIFFI :: CInt -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO CInt foreign import ccall "SDL.h SDL_GetDisplayMode" getDisplayModeFFI :: CInt -> CInt -> Ptr DisplayMode -> IO CInt foreign import ccall "SDL.h SDL_GetDisplayName" getDisplayNameFFI :: CInt -> IO CString+foreign import ccall "SDL.h SDL_GetGrabbedWindow" getGrabbedWindowFFI :: IO Window foreign import ccall "SDL.h SDL_GetNumDisplayModes" getNumDisplayModesFFI :: CInt -> IO CInt foreign import ccall "SDL.h SDL_GetNumVideoDisplays" getNumVideoDisplaysFFI :: IO CInt foreign import ccall "SDL.h SDL_GetNumVideoDrivers" getNumVideoDriversFFI :: IO CInt@@ -315,6 +320,7 @@ foreign import ccall "SDL.h SDL_RenderGetLogicalSize" renderGetLogicalSizeFFI :: Renderer -> Ptr CInt -> Ptr CInt -> IO () foreign import ccall "SDL.h SDL_RenderGetScale" renderGetScaleFFI :: Renderer -> Ptr CFloat -> Ptr CFloat -> IO () foreign import ccall "SDL.h SDL_RenderGetViewport" renderGetViewportFFI :: Renderer -> Ptr Rect -> IO ()+foreign import ccall "SDL.h SDL_RenderIsClipEnabled" renderIsClipEnabledFFI :: Renderer -> IO Bool foreign import ccall "SDL.h SDL_RenderPresent" renderPresentFFI :: Renderer -> IO () foreign import ccall "SDL.h SDL_RenderReadPixels" renderReadPixelsFFI :: Renderer -> Ptr Rect -> Word32 -> Ptr () -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderSetClipRect" renderSetClipRectFFI :: Renderer -> Ptr Rect -> IO CInt@@ -504,6 +510,10 @@ getDisplayBounds v1 v2 = liftIO $ getDisplayBoundsFFI v1 v2 {-# INLINE getDisplayBounds #-} +getDisplayDPI :: MonadIO m => CInt -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> m CInt+getDisplayDPI v1 v2 v3 v4 = liftIO $ getDisplayDPIFFI v1 v2 v3 v4+{-# INLINE getDisplayDPI #-}+ getDisplayMode :: MonadIO m => CInt -> CInt -> Ptr DisplayMode -> m CInt getDisplayMode v1 v2 v3 = liftIO $ getDisplayModeFFI v1 v2 v3 {-# INLINE getDisplayMode #-}@@ -512,6 +522,10 @@ getDisplayName v1 = liftIO $ getDisplayNameFFI v1 {-# INLINE getDisplayName #-} +getGrabbedWindow :: MonadIO m => m Window+getGrabbedWindow = liftIO getGrabbedWindowFFI+{-# INLINE getGrabbedWindow #-}+ getNumDisplayModes :: MonadIO m => CInt -> m CInt getNumDisplayModes v1 = liftIO $ getNumDisplayModesFFI v1 {-# INLINE getNumDisplayModes #-}@@ -831,6 +845,10 @@ renderGetViewport :: MonadIO m => Renderer -> Ptr Rect -> m () renderGetViewport v1 v2 = liftIO $ renderGetViewportFFI v1 v2 {-# INLINE renderGetViewport #-}++renderIsClipEnabled :: MonadIO m => Renderer -> m Bool+renderIsClipEnabled v1 = liftIO $ renderIsClipEnabledFFI v1+{-# INLINE renderIsClipEnabled #-} renderPresent :: MonadIO m => Renderer -> m () renderPresent v1 = liftIO $ renderPresentFFI v1
src/SDL/Time.hs view
@@ -22,7 +22,7 @@ import Foreign import GHC.Generics (Generic) -import SDL.Exception+import SDL.Internal.Exception import qualified SDL.Raw.Timer as Raw import qualified SDL.Raw.Types as Raw
src/SDL/Video.hs view
@@ -40,6 +40,7 @@ -- * Renderer Management , createRenderer+ , createSoftwareRenderer , destroyRenderer -- * Clipboard Handling@@ -61,9 +62,7 @@ -- -- Screen savers are disabled by default upon the initialization of the -- video subsystem.- , disableScreenSaver- , enableScreenSaver- , isScreenSaverEnabled+ , screenSaverEnabled -- * Message Box , showSimpleMessageBox@@ -88,7 +87,7 @@ import Foreign.C import GHC.Generics (Generic) import SDL.Vect-import SDL.Exception+import SDL.Internal.Exception import SDL.Internal.Numbered import SDL.Internal.Types import SDL.Video.OpenGL@@ -124,7 +123,7 @@ , if isJust $ windowOpenGL config then Raw.SDL_WINDOW_OPENGL else 0 , if windowResizable config then Raw.SDL_WINDOW_RESIZABLE else 0 ]- setGLAttributes (OpenGLConfig (V4 r g b a) d s p) = do+ setGLAttributes (OpenGLConfig (V4 r g b a) d s ms p) = do let (msk, v0, v1, flg) = case p of Core Debug v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_CORE, v0', v1', Raw.SDL_GL_CONTEXT_DEBUG_FLAG) Core Normal v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_CORE, v0', v1', 0)@@ -139,6 +138,8 @@ , (Raw.SDL_GL_ALPHA_SIZE, a) , (Raw.SDL_GL_DEPTH_SIZE, d) , (Raw.SDL_GL_STENCIL_SIZE, s)+ , (Raw.SDL_GL_MULTISAMPLEBUFFERS, if ms > 1 then 1 else 0)+ , (Raw.SDL_GL_MULTISAMPLESAMPLES, if ms > 1 then ms else 0) , (Raw.SDL_GL_CONTEXT_PROFILE_MASK, msk) , (Raw.SDL_GL_CONTEXT_MAJOR_VERSION, v0) , (Raw.SDL_GL_CONTEXT_MINOR_VERSION, v1)@@ -265,11 +266,11 @@ setWindowMode (Window w) mode = liftIO . throwIfNot0_ "SDL.Video.setWindowMode" "SDL_SetWindowFullscreen" $ case mode of- Fullscreen -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN- FullscreenDesktop -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN_DESKTOP+ Fullscreen -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN <* Raw.raiseWindow w+ FullscreenDesktop -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN_DESKTOP <* Raw.raiseWindow w Maximized -> Raw.setWindowFullscreen w 0 <* Raw.maximizeWindow w Minimized -> Raw.minimizeWindow w >> return 0- Windowed -> Raw.restoreWindow w >> return 0+ Windowed -> Raw.setWindowFullscreen w 0 <* Raw.restoreWindow w -- | Set the position of the window. setWindowPosition :: MonadIO m => Window -> WindowPosition -> m ()@@ -324,8 +325,6 @@ -- window and name. -- -- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.------ See @<https://wiki.libsdl.org/SDL_SetWindowTitle SDL_SetWindowTitle>@ and @<https://wiki.libsdl.org/SDL_GetWindowTitle SDL_GetWindowTitle>@ for C documentation. windowData :: Window -> CString -> StateVar (Ptr ()) windowData (Window w) key = makeStateVar getWindowData setWindowData where@@ -392,23 +391,16 @@ raiseWindow :: MonadIO m => Window -> m () raiseWindow (Window w) = Raw.raiseWindow w --- | Prevent the screen from being blanked by a screen saver. If you disable the screensaver, it is automatically re-enabled when SDL quits.------ See @<https://wiki.libsdl.org/SDL_DisableScreenSaver SDL_DisableScreenSaver>@ for C documentation.-disableScreenSaver :: MonadIO m => m ()-disableScreenSaver = Raw.disableScreenSaver---- | Allow the screen to be blanked by a screen saver.+-- | Get or set whether to allow the screen to be blanked by a screen saver. ----- See @<https://wiki.libsdl.org/SDL_EnableScreenSaver SDL_EnableScreenSaver>@ for C documentation.-enableScreenSaver :: MonadIO m => m ()-enableScreenSaver = Raw.enableScreenSaver+-- Screen savers are re-enabled, if needed, when SDL quits.+screenSaverEnabled :: StateVar Bool+screenSaverEnabled = makeStateVar (isScreenSaverEnabled) (setScreenSaverEnabled)+ where+ isScreenSaverEnabled = Raw.isScreenSaverEnabled --- | Check whether screen savers are enabled .------ See @<https://wiki.libsdl.org/SDL_IsScreenSaverEnabled SDL_IsScreenSaverEnabled>@ for C documentation.-isScreenSaverEnabled :: MonadIO m => m Bool-isScreenSaverEnabled = Raw.isScreenSaverEnabled+ setScreenSaverEnabled True = Raw.enableScreenSaver+ setScreenSaverEnabled False = Raw.disableScreenSaver -- | Show a window. --@@ -574,6 +566,15 @@ liftIO . fmap Renderer $ throwIfNull "SDL.Video.createRenderer" "SDL_CreateRenderer" $ Raw.createRenderer w driver (toNumber config)++-- | Create a 2D software rendering context for the given surface.+--+-- See @<https://wiki.libsdl.org/SDL_CreateSoftwareRenderer>@+createSoftwareRenderer :: MonadIO m => Surface -> m Renderer+createSoftwareRenderer (Surface ptr _) =+ liftIO . fmap Renderer $+ throwIfNull "SDL.Video.createSoftwareRenderer" "SDL_CreateSoftwareRenderer" $+ Raw.createSoftwareRenderer ptr destroyRenderer :: MonadIO m => Renderer -> m () destroyRenderer (Renderer r) = Raw.destroyRenderer r
src/SDL/Video/OpenGL.hs view
@@ -37,7 +37,7 @@ import Foreign.C.Types import GHC.Generics (Generic) import SDL.Vect-import SDL.Exception+import SDL.Internal.Exception import SDL.Internal.Numbered import SDL.Internal.Types import qualified SDL.Raw as Raw@@ -53,6 +53,7 @@ -- { 'glColorPrecision' = V4 8 8 8 0 -- , 'glDepthPrecision' = 24 -- , 'glStencilPrecision' = 8+-- , 'glMultisampleSamples' = 1 -- , 'glProfile' = 'Compatibility' 'Normal' 2 1 -- } -- @@@ -61,15 +62,17 @@ { glColorPrecision = V4 8 8 8 0 , glDepthPrecision = 24 , glStencilPrecision = 8+ , glMultisampleSamples = 1 , glProfile = Compatibility Normal 2 1 } -- | Configuration used when creating an OpenGL rendering context. data OpenGLConfig = OpenGLConfig- { glColorPrecision :: V4 CInt -- ^ Defaults to 'V4' @8 8 8 0@.- , glDepthPrecision :: CInt -- ^ Defaults to @24@.- , glStencilPrecision :: CInt -- ^ Defaults to @8@.- , glProfile :: Profile -- ^ Defaults to 'Compatibility' 'Normal' @2 1@.+ { glColorPrecision :: V4 CInt -- ^ Defaults to 'V4' @8 8 8 0@.+ , glDepthPrecision :: CInt -- ^ Defaults to @24@.+ , glStencilPrecision :: CInt -- ^ Defaults to @8@.+ , glMultisampleSamples :: CInt -- ^ Defaults to @1@.+ , glProfile :: Profile -- ^ Defaults to 'Compatibility' 'Normal' @2 1@. } deriving (Eq, Generic, Ord, Read, Show, Typeable) -- | The profile a driver should use when creating an OpenGL context.
src/SDL/Video/Renderer.hs view
@@ -76,7 +76,6 @@ , PixelFormat(..) , SurfacePixelFormat , formatPalette- , mapRGB , setPaletteColors , pixelFormatToMasks , masksToPixelFormat@@ -133,7 +132,7 @@ import GHC.Generics (Generic) import Prelude hiding (foldr) import SDL.Vect-import SDL.Exception+import SDL.Internal.Exception import SDL.Internal.Numbered import SDL.Internal.Types import qualified Data.ByteString as BS@@ -156,12 +155,13 @@ -> Maybe (Rectangle CInt) -- ^ The rectangle to be copied, or 'Nothing' to copy the entire surface -> Surface -- ^ The 'Surface' that is the blit target -> Maybe (Point V2 CInt) -- ^ The position to blit to- -> m ()+ -> m (Maybe (Rectangle CInt)) surfaceBlit (Surface src _) srcRect (Surface dst _) dstLoc = liftIO $- throwIfNeg_ "SDL.Video.blitSurface" "SDL_BlitSurface" $ maybeWith with srcRect $ \srcPtr ->- maybeWith with (fmap (flip Rectangle 0) dstLoc) $ \dstPtr ->- Raw.blitSurface src (castPtr srcPtr) dst (castPtr dstPtr)+ maybeWith with (fmap (flip Rectangle 0) dstLoc) $ \dstPtr -> do+ throwIfNeg "SDL.Video.blitSurface" "SDL_BlitSurface" $+ Raw.blitSurface src (castPtr srcPtr) dst (castPtr dstPtr)+ maybe (pure Nothing) (\_ -> Just <$> peek dstPtr) dstLoc -- | Create a texture for a rendering context. --@@ -255,13 +255,13 @@ -- -- See @<https://wiki.libsdl.org/SDL_UnlockTexture SDL_UnlockTexture>@ for C documentation. unlockTexture :: MonadIO m => Texture -> m ()-unlockTexture (Texture t) = liftIO $ Raw.unlockTexture t+unlockTexture (Texture t) = Raw.unlockTexture t -- | Set up a surface for directly accessing the pixels. -- -- See @<https://wiki.libsdl.org/SDL_LockSurface SDL_LockSurface>@ for C documentation. lockSurface :: MonadIO m => Surface -> m ()-lockSurface (Surface s _) = liftIO $+lockSurface (Surface s _) = throwIfNeg_ "lockSurface" "SDL_LockSurface" $ Raw.lockSurface s @@ -364,7 +364,7 @@ surfaceFillRect (Surface s _) rect (V4 r g b a) = liftIO $ throwIfNeg_ "SDL.Video.fillRect" "SDL_FillRect" $ maybeWith with rect $ \rectPtr -> do- format <- liftIO (Raw.surfaceFormat <$> peek s)+ format <- Raw.surfaceFormat <$> peek s Raw.mapRGBA format r g b a >>= Raw.fillRect s (castPtr rectPtr) -- | Perform a fast fill of a set of rectangles with a specific color.@@ -380,7 +380,7 @@ surfaceFillRects (Surface s _) rects (V4 r g b a) = liftIO $ do throwIfNeg_ "SDL.Video.fillRects" "SDL_FillRects" $ SV.unsafeWith rects $ \rp -> do- format <- liftIO (Raw.surfaceFormat <$> peek s)+ format <- Raw.surfaceFormat <$> peek s Raw.fillRects s (castPtr rp) (fromIntegral (SV.length rects))@@ -405,27 +405,6 @@ newtype SurfacePixelFormat = SurfacePixelFormat (Ptr Raw.PixelFormat) deriving (Eq, Typeable)---- It's possible we could use unsafePerformIO here, but I'm not--- sure. De need to guarantee that pointers aren't reused?--- | Map an RGB triple to an opaque pixel value for a given pixel format.------ This function maps the RGB color value to the specified pixel format and returns the pixel value best approximating the given RGB color value for the given pixel format.------ If the format has a palette (8-bit) the index of the closest matching color in the palette will be returned.------ If the specified pixel format has an alpha component it will be returned as all 1 bits (fully opaque).------ If the pixel format bpp (color depth) is less than 32-bpp then the unused upper bits of the return value can safely be ignored (e.g., with a 16-bpp format the return value can be assigned to a 'Word16', and similarly a 'Word8' for an 8-bpp format).------ See @<https://wiki.libsdl.org/SDL_MapRGB SDL_MapRGB>@ for C documentation.-mapRGB :: MonadIO m- => SurfacePixelFormat -- ^ The format of the pixel- -> V3 Word8 -- ^ The color to map- -> m Word32-mapRGB (SurfacePixelFormat fmt) (V3 r g b) = Raw.mapRGB fmt r g b--{-# DEPRECATED mapRGB "mapRGB is no longer needed, as it called implictly. If you still need this, use SDL.Raw.mapRGB" #-} -- It's possible we could use unsafePerformIO here, but I'm not -- sure. surface->{w,h} are immutable, but do we need to guarantee that pointers