diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 ======= diff --git a/examples/AudioExample.hs b/examples/AudioExample.hs --- a/examples/AudioExample.hs +++ b/examples/AudioExample.hs @@ -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 = diff --git a/sdl2.cabal b/sdl2.cabal --- a/sdl2.cabal +++ b/sdl2.cabal @@ -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, diff --git a/src/SDL.hs b/src/SDL.hs --- a/src/SDL.hs +++ b/src/SDL.hs @@ -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 diff --git a/src/SDL/Audio.hs b/src/SDL/Audio.hs --- a/src/SDL/Audio.hs +++ b/src/SDL/Audio.hs @@ -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 diff --git a/src/SDL/Event.hs b/src/SDL/Event.hs --- a/src/SDL/Event.hs +++ b/src/SDL/Event.hs @@ -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 diff --git a/src/SDL/Exception.hs b/src/SDL/Exception.hs --- a/src/SDL/Exception.hs +++ b/src/SDL/Exception.hs @@ -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) diff --git a/src/SDL/Filesystem.hs b/src/SDL/Filesystem.hs --- a/src/SDL/Filesystem.hs +++ b/src/SDL/Filesystem.hs @@ -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 diff --git a/src/SDL/Init.hs b/src/SDL/Init.hs --- a/src/SDL/Init.hs +++ b/src/SDL/Init.hs @@ -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. diff --git a/src/SDL/Input/Joystick.hs b/src/SDL/Input/Joystick.hs --- a/src/SDL/Input/Joystick.hs +++ b/src/SDL/Input/Joystick.hs @@ -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 @@ 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 @@ 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 @@ 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 @@ for C documentation. +numHats :: (MonadIO m) => Joystick -> m CInt +numHats (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numHats" "SDL_JoystickNumHats" (Raw.joystickNumHats j) diff --git a/src/SDL/Input/Mouse.hs b/src/SDL/Input/Mouse.hs --- a/src/SDL/Input/Mouse.hs +++ b/src/SDL/Input/Mouse.hs @@ -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 diff --git a/src/SDL/Internal/Exception.hs b/src/SDL/Internal/Exception.hs new file mode 100644 --- /dev/null +++ b/src/SDL/Internal/Exception.hs @@ -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) diff --git a/src/SDL/Raw/Audio.hs b/src/SDL/Raw/Audio.hs --- a/src/SDL/Raw/Audio.hs +++ b/src/SDL/Raw/Audio.hs @@ -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 diff --git a/src/SDL/Raw/Enum.hsc b/src/SDL/Raw/Enum.hsc --- a/src/SDL/Raw/Enum.hsc +++ b/src/SDL/Raw/Enum.hsc @@ -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) diff --git a/src/SDL/Raw/Event.hs b/src/SDL/Raw/Event.hs --- a/src/SDL/Raw/Event.hs +++ b/src/SDL/Raw/Event.hs @@ -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 diff --git a/src/SDL/Raw/Types.hsc b/src/SDL/Raw/Types.hsc --- a/src/SDL/Raw/Types.hsc +++ b/src/SDL/Raw/Types.hsc @@ -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 diff --git a/src/SDL/Raw/Video.hs b/src/SDL/Raw/Video.hs --- a/src/SDL/Raw/Video.hs +++ b/src/SDL/Raw/Video.hs @@ -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 diff --git a/src/SDL/Time.hs b/src/SDL/Time.hs --- a/src/SDL/Time.hs +++ b/src/SDL/Time.hs @@ -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 diff --git a/src/SDL/Video.hs b/src/SDL/Video.hs --- a/src/SDL/Video.hs +++ b/src/SDL/Video.hs @@ -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 @@ and @@ 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 @@ 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 @@ 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 @@ 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 @@ +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 diff --git a/src/SDL/Video/OpenGL.hs b/src/SDL/Video/OpenGL.hs --- a/src/SDL/Video/OpenGL.hs +++ b/src/SDL/Video/OpenGL.hs @@ -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. diff --git a/src/SDL/Video/Renderer.hs b/src/SDL/Video/Renderer.hs --- a/src/SDL/Video/Renderer.hs +++ b/src/SDL/Video/Renderer.hs @@ -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 @@ 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 @@ 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 @@ 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