sdl2 2.2.0 → 2.3.0
raw patch · 10 files changed
+580/−122 lines, 10 filesdep ~basedep ~textnew-component:exe:eventwatch-examplenew-component:exe:userevent-example
Dependency ranges changed: base, text
Files
- ChangeLog.md +26/−1
- examples/EventWatch.hs +52/−0
- examples/UserEvents.hs +64/−0
- sdl2.cabal +26/−1
- src/SDL/Event.hs +257/−107
- src/SDL/Input/GameController.hs +80/−0
- src/SDL/Input/Joystick.hs +22/−0
- src/SDL/Input/Mouse.hs +22/−11
- src/SDL/Video.hs +5/−0
- src/SDL/Video/Renderer.hs +26/−2
ChangeLog.md view
@@ -1,3 +1,28 @@+Unreleased+==========++++2.3.0+=====++* Windows builds now use `-D_SDL_main_h`. See https://github.com/haskell-game/sdl2/issues/139 for more discussion.+* Some basic support for game controller events have been added. See `SDL.Input.GameController` and changes to `ControllerDeviceEventData`.+* Support for event watching: `addEventWatch` and `delEventWatch`.+* High-level bindings now distinguish between finger down / motion / up.+ See SDL.Event.TouchFingerEvent and SDL.Event.TouchFingerMotionEvent.+* Several event payloads now have their `Window` fields modified to use `Maybe Window`, substituting `Nothing` for null pointers.+* High-level structure for controller button state: `ControllerButtonState`.+* High-level structure for controller buttons: `ControllerButton`.+* High-level structure for controller connection: `ControllerDeviceConnection`.+* High-level structure for joystick device connection: `JoyDeviceConnection`.+* High-level structure for joystick button state: `JoyButtonState`.+* Support for user defined events: `registerEvent`, `pushRegisteredEvent`, and `getRegisteredEvent`.+* Initial window visibility can be specified in `WindowConfig` for `createWindow` function.+* `WarpMouseOrigin` is now fully exported and can warp to global coordinates.+* It's possible to retrieve palette information with `paletteNColors`, `paletteColors` and `palletColor`.++ 2.2.0 ===== @@ -43,7 +68,7 @@ * `getRelativeMouseMode` in `SDL.Input.Mouse` * `getMouseLocation` in `SDL.Input.Mouse` * Remove `ClipboardUpdateEventData`-* Merge `isScreenSaverEnabled, `enableScreenSaver`, and `disableScreenSaver`+* Merge `isScreenSaverEnabled`, `enableScreenSaver`, and `disableScreenSaver` into a `screenSaverEnabled` StateVar. * Make function `surfaceBlit` in `SDL.Video.Renderer` return final blit rectangle post-clipping.
+ examples/EventWatch.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}++{-|++The following example shows how setting a watch for the WindowSizeChangedEvent+allows us to handle the events as they are generated. Handling them in the+event loop, on the other hand, only allows us to see a final, coalesced, event.++To demonstrate this, run the program, resize the window with your mouse,+and check your console output.++-}+module EventWatch where++import SDL++main :: IO ()+main = do+ initializeAll+ window <- createWindow "resize" WindowConfig {+ windowBorder = True+ , windowHighDPI = False+ , windowInputGrabbed = False+ , windowMode = Windowed+ , windowOpenGL = Nothing+ , windowPosition = Wherever+ , windowResizable = True+ , windowInitialSize = V2 800 600+ , windowVisible = True+ }+ renderer <- createRenderer window (-1) defaultRenderer+ addEventWatch $ \ev ->+ case eventPayload ev of+ WindowSizeChangedEvent sizeChangeData ->+ putStrLn $ "eventWatch windowSizeChanged: " ++ show sizeChangeData+ _ -> return ()+ appLoop++appLoop :: IO ()+appLoop = waitEvent >>= go+ where+ go :: Event -> IO ()+ go ev =+ case eventPayload ev of+ WindowSizeChangedEvent sizeChangeData -> do+ putStrLn $ "waitEvent windowSizeChanged: " ++ show sizeChangeData+ waitEvent >>= go+ KeyboardEvent keyboardEvent+ | keyboardEventKeyMotion keyboardEvent == Pressed &&+ keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeQ+ -> return ()+ _ -> waitEvent >>= go
+ examples/UserEvents.hs view
@@ -0,0 +1,64 @@+module UserEvents where++import Control.Concurrent (myThreadId)+import Data.Maybe (Maybe(Nothing))+import Data.Word (Word32)+import qualified Data.Text as Text+import Foreign.Ptr (nullPtr)+import SDL++-- | A timer event with timestamp+data TimerEvent = TimerEvent Word32++timerEvent :: IO TimerEvent+timerEvent = do+ t <- show <$> ticks+ tid <- show <$> myThreadId+ putStrLn $ "Created timer event at " ++ t ++ " ticks. Threadid: " ++ tid+ return $ TimerEvent 0++main :: IO ()+main = do+ initializeAll+ let toTimerEvent _ = return . Just . TimerEvent+ fromTimerEvent = const $ return emptyRegisteredEvent+ registeredEvent <- registerEvent toTimerEvent fromTimerEvent+ case registeredEvent of+ Nothing -> putStrLn "Fatal error: unable to register timer events."+ Just registeredTimerEvent -> do+ addTimer 1000 $ mkTimerCb registeredTimerEvent+ putStrLn "press q at any time to quit"+ appLoop registeredTimerEvent++mkTimerCb :: RegisteredEventType TimerEvent -> TimerCallback+mkTimerCb (RegisteredEventType pushTimerEvent _) interval = do+ pushResult <- pushTimerEvent =<< timerEvent+ case pushResult of+ EventPushSuccess -> return ()+ EventPushFiltered -> putStrLn "event push was filtered: this is impossible"+ EventPushFailure e -> putStrLn $ "Couldn't push event: " ++ Text.unpack e+ return $ Reschedule interval++appLoop :: RegisteredEventType TimerEvent -> IO ()+appLoop (RegisteredEventType pushTimerEvent getTimerEvent) = waitEvent >>= go+ where+ go :: Event -> IO ()+ go ev =+ case eventPayload ev of+ -- Press Q to quit+ KeyboardEvent keyboardEvent+ | keyboardEventKeyMotion keyboardEvent == Pressed &&+ keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeQ+ -> return ()+ UserEvent _ -> do+ maybeTimerEvent <- getTimerEvent ev+ case maybeTimerEvent of+ Just (TimerEvent ts) -> do+ t <- show <$> ticks+ tid <- show <$> myThreadId+ putStrLn $ "Got timer event from queue at " ++ t ++ " ticks."+ putStrLn $ "Timestamp: " ++ show ts+ putStrLn $ "Threadid: " ++ tid+ Nothing -> return ()+ waitEvent >>= go+ _ -> waitEvent >>= go
sdl2.cabal view
@@ -1,5 +1,5 @@ name: sdl2-version: 2.2.0+version: 2.3.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@@ -65,6 +65,7 @@ SDL.Hint SDL.Init SDL.Input+ SDL.Input.GameController SDL.Input.Joystick SDL.Input.Keyboard SDL.Input.Keyboard.Codes@@ -136,6 +137,9 @@ default-language: Haskell2010 + if os(windows)+ cpp-options: -D_SDL_main_h+ executable lazyfoo-lesson-01 if flag(examples) build-depends: base, sdl2@@ -414,6 +418,27 @@ default-language: Haskell2010 ghc-options: -main-is AudioExample -threaded +executable eventwatch-example+ if flag(examples)+ build-depends: base, sdl2+ else+ buildable: False++ hs-source-dirs: examples+ main-is: EventWatch.hs+ default-language: Haskell2010+ ghc-options: -main-is EventWatch++executable userevent-example+ if flag(examples)+ build-depends: base, text, sdl2+ else+ buildable: False++ hs-source-dirs: examples+ main-is: UserEvents.hs+ default-language: Haskell2010+ ghc-options: -main-is UserEvents executable opengl-example if flag(opengl-example)
src/SDL/Event.hs view
@@ -17,8 +17,20 @@ , pumpEvents , waitEvent , waitEventTimeout+ -- * Registering user events+ , RegisteredEventType(..)+ , RegisteredEventData(..)+ , EventPushResult(..)+ , emptyRegisteredEvent+ , registerEvent+ -- * Watching events+ , EventWatchCallback+ , EventWatch+ , addEventWatch+ , delEventWatch -- * Event data , Event(..)+ , Timestamp , EventPayload(..) -- ** Window events , WindowShownEventData(..)@@ -60,6 +72,7 @@ , UserEventData(..) -- ** Touch events , TouchFingerEventData(..)+ , TouchFingerMotionEventData(..) -- ** Gesture events , MultiGestureEventData(..) , DollarGestureEventData(..)@@ -82,6 +95,7 @@ import GHC.Generics (Generic) import SDL.Vect import SDL.Input.Joystick+import SDL.Input.GameController import SDL.Input.Keyboard import SDL.Input.Mouse import SDL.Internal.Exception@@ -97,12 +111,14 @@ -- | A single SDL event. This event occured at 'eventTimestamp' and carries data under 'eventPayload'. data Event = Event- { eventTimestamp :: Word32+ { eventTimestamp :: Timestamp -- ^ The time the event occured. , eventPayload :: EventPayload -- ^ Data pertaining to this event. } deriving (Eq, Ord, Generic, Show, Typeable) +type Timestamp = Word32+ -- | An enumeration of all possible SDL event types. This data type pairs up event types with -- their payload, where possible. data EventPayload@@ -140,6 +156,7 @@ | UserEvent !UserEventData | SysWMEvent !SysWMEventData | TouchFingerEvent !TouchFingerEventData+ | TouchFingerMotionEvent !TouchFingerMotionEventData | MultiGestureEvent !MultiGestureEventData | DollarGestureEvent !DollarGestureEventData | DropEvent !DropEventData@@ -148,22 +165,22 @@ deriving (Eq, Ord, Generic, Show, Typeable) -- | A window has been shown.-data WindowShownEventData =- WindowShownEventData {windowShownEventWindow :: !Window+newtype WindowShownEventData =+ WindowShownEventData {windowShownEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | A window has been hidden.-data WindowHiddenEventData =- WindowHiddenEventData {windowHiddenEventWindow :: !Window+newtype WindowHiddenEventData =+ 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+newtype WindowExposedEventData =+ WindowExposedEventData {windowExposedEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable)@@ -187,72 +204,72 @@ 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+newtype WindowSizeChangedEventData =+ WindowSizeChangedEventData {windowSizeChangedEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has been minimized.-data WindowMinimizedEventData =- WindowMinimizedEventData {windowMinimizedEventWindow :: !Window+newtype WindowMinimizedEventData =+ WindowMinimizedEventData {windowMinimizedEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has been maximized.-data WindowMaximizedEventData =- WindowMaximizedEventData {windowMaximizedEventWindow :: !Window+newtype WindowMaximizedEventData =+ 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+newtype WindowRestoredEventData =+ WindowRestoredEventData {windowRestoredEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has gained mouse focus.-data WindowGainedMouseFocusEventData =- WindowGainedMouseFocusEventData {windowGainedMouseFocusEventWindow :: !Window+newtype WindowGainedMouseFocusEventData =+ WindowGainedMouseFocusEventData {windowGainedMouseFocusEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has lost mouse focus.-data WindowLostMouseFocusEventData =- WindowLostMouseFocusEventData {windowLostMouseFocusEventWindow :: !Window+newtype WindowLostMouseFocusEventData =+ WindowLostMouseFocusEventData {windowLostMouseFocusEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has gained keyboard focus.-data WindowGainedKeyboardFocusEventData =- WindowGainedKeyboardFocusEventData {windowGainedKeyboardFocusEventWindow :: !Window+newtype WindowGainedKeyboardFocusEventData =+ WindowGainedKeyboardFocusEventData {windowGainedKeyboardFocusEventWindow :: Window -- ^ The associated 'Window'. } deriving (Eq,Ord,Generic,Show,Typeable) -- | The window has lost keyboard focus.-data WindowLostKeyboardFocusEventData =- WindowLostKeyboardFocusEventData {windowLostKeyboardFocusEventWindow :: !Window+newtype WindowLostKeyboardFocusEventData =+ 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+newtype WindowClosedEventData =+ 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- -- ^ The associated 'Window'.+ KeyboardEventData {keyboardEventWindow :: !(Maybe Window)+ -- ^ The 'Window' with keyboard focus, if any. ,keyboardEventKeyMotion :: !InputMotion -- ^ Whether the key was pressed or released. ,keyboardEventRepeat :: !Bool@@ -264,8 +281,8 @@ -- | Keyboard text editing event information. data TextEditingEventData =- TextEditingEventData {textEditingEventWindow :: !Window- -- ^ The associated 'Window'.+ TextEditingEventData {textEditingEventWindow :: !(Maybe Window)+ -- ^ The 'Window' with keyboard focus, if any. ,textEditingEventText :: !Text -- ^ The editing text. ,textEditingEventStart :: !Int32@@ -277,8 +294,8 @@ -- | Keyboard text input event information. data TextInputEventData =- TextInputEventData {textInputEventWindow :: !Window- -- ^ The associated 'Window'.+ TextInputEventData {textInputEventWindow :: !(Maybe Window)+ -- ^ The 'Window' with keyboard focus, if any. ,textInputEventText :: !Text -- ^ The input text. }@@ -286,8 +303,8 @@ -- | A mouse or pointer device was moved. data MouseMotionEventData =- MouseMotionEventData {mouseMotionEventWindow :: !Window- -- ^ The associated 'Window'.+ MouseMotionEventData {mouseMotionEventWindow :: !(Maybe Window)+ -- ^ The 'Window' with mouse focus, if any. ,mouseMotionEventWhich :: !MouseDevice -- ^ The 'MouseDevice' that was moved. ,mouseMotionEventState :: ![MouseButton]@@ -301,8 +318,8 @@ -- | A mouse or pointer device button was pressed or released. data MouseButtonEventData =- MouseButtonEventData {mouseButtonEventWindow :: !Window- -- ^ The associated 'Window'.+ MouseButtonEventData {mouseButtonEventWindow :: !(Maybe Window)+ -- ^ The 'Window' with mouse focus, if any. ,mouseButtonEventMotion :: !InputMotion -- ^ Whether the button was pressed or released. ,mouseButtonEventWhich :: !MouseDevice@@ -318,8 +335,8 @@ -- | Mouse wheel event information. data MouseWheelEventData =- MouseWheelEventData {mouseWheelEventWindow :: !Window- -- ^ The associated 'Window'.+ MouseWheelEventData {mouseWheelEventWindow :: !(Maybe Window)+ -- ^ The 'Window' with mouse focus, if any. ,mouseWheelEventWhich :: !MouseDevice -- ^ The 'MouseDevice' whose wheel was scrolled. ,mouseWheelEventPos :: !(V2 Int32)@@ -368,14 +385,16 @@ -- ^ The instance id of the joystick that reported the event. ,joyButtonEventButton :: !Word8 -- ^ The index of the button that changed.- ,joyButtonEventState :: !Word8+ ,joyButtonEventState :: !JoyButtonState -- ^ The state of the button. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Joystick device event information. data JoyDeviceEventData =- JoyDeviceEventData {joyDeviceEventWhich :: !Int32+ JoyDeviceEventData {joyDeviceEventConnection :: !JoyDeviceConnection+ -- ^ Was the device added or removed?+ ,joyDeviceEventWhich :: !Int32 -- ^ The instance id of the joystick that reported the event. } deriving (Eq,Ord,Generic,Show,Typeable)@@ -395,16 +414,18 @@ data ControllerButtonEventData = ControllerButtonEventData {controllerButtonEventWhich :: !Raw.JoystickID -- ^ The joystick instance ID that reported the event.- ,controllerButtonEventButton :: !Word8+ ,controllerButtonEventButton :: !ControllerButton -- ^ The controller button.- ,controllerButtonEventState :: !Word8+ ,controllerButtonEventState :: !ControllerButtonState -- ^ The state of the button. } deriving (Eq,Ord,Generic,Show,Typeable) -- | Controller device event information data ControllerDeviceEventData =- ControllerDeviceEventData {controllerDeviceEventWhich :: !Int32+ ControllerDeviceEventData {controllerDeviceEventConnection :: !ControllerDeviceConnection+ -- ^ Was the device added, removed, or remapped?+ ,controllerDeviceEventWhich :: !Int32 -- ^ The joystick instance ID that reported the event. } deriving (Eq,Ord,Generic,Show,Typeable)@@ -421,7 +442,9 @@ -- | Event data for application-defined events. data UserEventData =- UserEventData {userEventWindow :: !Window+ UserEventData {userEventType :: !Word32+ -- ^ User defined event type.+ ,userEventWindow :: !(Maybe Window) -- ^ The associated 'Window'. ,userEventCode :: !Int32 -- ^ User defined event code.@@ -433,8 +456,8 @@ deriving (Eq,Ord,Generic,Show,Typeable) -- | A video driver dependent system event-data SysWMEventData =- SysWMEventData {sysWMEventMsg :: !Raw.SysWMmsg}+newtype SysWMEventData =+ SysWMEventData {sysWMEventMsg :: Raw.SysWMmsg} deriving (Eq,Ord,Generic,Show,Typeable) -- | Finger touch event information.@@ -443,15 +466,30 @@ -- ^ The touch device index. ,touchFingerEventFingerID :: !Raw.FingerID -- ^ The finger index.+ ,touchFingerEventMotion :: !InputMotion+ -- ^ Whether the finger was pressed or released. ,touchFingerEventPos :: !(Point V2 CFloat) -- ^ The location of the touch event, normalized between 0 and 1.- ,touchFingerEventRelMotion :: !(V2 CFloat)- -- ^ The distance moved, normalized between -1 and 1. ,touchFingerEventPressure :: !CFloat -- ^ The quantity of the pressure applied, normalized between 0 and 1. } deriving (Eq,Ord,Generic,Show,Typeable) +-- | Finger motion event information.+data TouchFingerMotionEventData =+ TouchFingerMotionEventData {touchFingerMotionEventTouchID :: !Raw.TouchID+ -- ^ The touch device index.+ ,touchFingerMotionEventFingerID :: !Raw.FingerID+ -- ^ The finger index.+ ,touchFingerMotionEventPos :: !(Point V2 CFloat)+ -- ^ The location of the touch event, normalized between 0 and 1.+ ,touchFingerMotionEventRelMotion :: !(V2 CFloat)+ -- ^ The distance moved, normalized between -1 and 1.+ ,touchFingerMotionEventPressure :: !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@@ -483,15 +521,15 @@ deriving (Eq,Ord,Generic,Show,Typeable) -- | An event used to request a file open by the system-data DropEventData =- DropEventData {dropEventFile :: !CString+newtype DropEventData =+ DropEventData {dropEventFile :: CString -- ^ The file name. } deriving (Eq,Ord,Generic,Show,Typeable) -- | SDL reported an unknown event type.-data UnknownEventData =- UnknownEventData {unknownEventType :: !Word32+newtype UnknownEventData =+ UnknownEventData {unknownEventType :: Word32 -- ^ The unknown event code. } deriving (Eq,Ord,Generic,Show,Typeable)@@ -511,78 +549,78 @@ convertRaw :: Raw.Event -> IO Event convertRaw (Raw.WindowEvent t ts a b c d) =- do w' <- fmap Window (Raw.getWindowFromID a)+ do w <- fmap Window (Raw.getWindowFromID a) return (Event ts (case b of Raw.SDL_WINDOWEVENT_SHOWN ->- WindowShownEvent (WindowShownEventData w')+ WindowShownEvent (WindowShownEventData w) Raw.SDL_WINDOWEVENT_HIDDEN ->- WindowHiddenEvent (WindowHiddenEventData w')+ WindowHiddenEvent (WindowHiddenEventData w) Raw.SDL_WINDOWEVENT_EXPOSED ->- WindowExposedEvent (WindowExposedEventData w')+ WindowExposedEvent (WindowExposedEventData w) Raw.SDL_WINDOWEVENT_MOVED -> WindowMovedEvent- (WindowMovedEventData w'+ (WindowMovedEventData w (P (V2 c d))) Raw.SDL_WINDOWEVENT_RESIZED -> WindowResizedEvent- (WindowResizedEventData w'+ (WindowResizedEventData w (V2 c d)) Raw.SDL_WINDOWEVENT_SIZE_CHANGED ->- WindowSizeChangedEvent (WindowSizeChangedEventData w')+ WindowSizeChangedEvent (WindowSizeChangedEventData w) Raw.SDL_WINDOWEVENT_MINIMIZED ->- WindowMinimizedEvent (WindowMinimizedEventData w')+ WindowMinimizedEvent (WindowMinimizedEventData w) Raw.SDL_WINDOWEVENT_MAXIMIZED ->- WindowMaximizedEvent (WindowMaximizedEventData w')+ WindowMaximizedEvent (WindowMaximizedEventData w) Raw.SDL_WINDOWEVENT_RESTORED ->- WindowRestoredEvent (WindowRestoredEventData w')+ WindowRestoredEvent (WindowRestoredEventData w) Raw.SDL_WINDOWEVENT_ENTER ->- WindowGainedMouseFocusEvent (WindowGainedMouseFocusEventData w')+ WindowGainedMouseFocusEvent (WindowGainedMouseFocusEventData w) Raw.SDL_WINDOWEVENT_LEAVE ->- WindowLostMouseFocusEvent (WindowLostMouseFocusEventData w')+ WindowLostMouseFocusEvent (WindowLostMouseFocusEventData w) Raw.SDL_WINDOWEVENT_FOCUS_GAINED ->- WindowGainedKeyboardFocusEvent (WindowGainedKeyboardFocusEventData w')+ WindowGainedKeyboardFocusEvent (WindowGainedKeyboardFocusEventData w) Raw.SDL_WINDOWEVENT_FOCUS_LOST ->- WindowLostKeyboardFocusEvent (WindowLostKeyboardFocusEventData w')+ WindowLostKeyboardFocusEvent (WindowLostKeyboardFocusEventData w) Raw.SDL_WINDOWEVENT_CLOSE ->- WindowClosedEvent (WindowClosedEventData w')+ WindowClosedEvent (WindowClosedEventData w) _ -> UnknownEvent (UnknownEventData t))) convertRaw (Raw.KeyboardEvent Raw.SDL_KEYDOWN ts a _ c d) =- do w' <- fmap Window (Raw.getWindowFromID a)+ do w <- getWindowFromID a return (Event ts (KeyboardEvent- (KeyboardEventData w'+ (KeyboardEventData w Pressed (c /= 0) (fromRawKeysym d)))) convertRaw (Raw.KeyboardEvent Raw.SDL_KEYUP ts a _ c d) =- do w' <- fmap Window (Raw.getWindowFromID a)+ do w <- getWindowFromID a return (Event ts (KeyboardEvent- (KeyboardEventData w'+ (KeyboardEventData w Released (c /= 0) (fromRawKeysym d))))-convertRaw (Raw.KeyboardEvent _ _ _ _ _ _) = error "convertRaw: Unknown keyboard motion"+convertRaw Raw.KeyboardEvent{} = error "convertRaw: Unknown keyboard motion" convertRaw (Raw.TextEditingEvent _ ts a b c d) =- do w' <- fmap Window (Raw.getWindowFromID a)+ do w <- getWindowFromID a return (Event ts (TextEditingEvent- (TextEditingEventData w'+ (TextEditingEventData w (ccharStringToText b) c d))) convertRaw (Raw.TextInputEvent _ ts a b) =- do w' <- fmap Window (Raw.getWindowFromID a)+ do w <- getWindowFromID a return (Event ts (TextInputEvent- (TextInputEventData w'+ (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)+ do w <- getWindowFromID a let buttons = catMaybes [(Raw.SDL_BUTTON_LMASK `test` c) ButtonLeft ,(Raw.SDL_BUTTON_RMASK `test` c) ButtonRight@@ -591,7 +629,7 @@ ,(Raw.SDL_BUTTON_X2MASK `test` c) ButtonX2] return (Event ts (MouseMotionEvent- (MouseMotionEventData w'+ (MouseMotionEventData w (fromNumber b) buttons (P (V2 d e))@@ -601,31 +639,24 @@ then Just else const Nothing convertRaw (Raw.MouseButtonEvent t ts a b c _ e f g) =- do w' <- fmap Window (Raw.getWindowFromID a)+ do w <- getWindowFromID a let motion | t == Raw.SDL_MOUSEBUTTONUP = Released | t == Raw.SDL_MOUSEBUTTONDOWN = Pressed | otherwise = error "convertRaw: Unexpected mouse button motion"- button- | c == Raw.SDL_BUTTON_LEFT = ButtonLeft- | c == Raw.SDL_BUTTON_MIDDLE = ButtonMiddle- | c == Raw.SDL_BUTTON_RIGHT = ButtonRight- | c == Raw.SDL_BUTTON_X1 = ButtonX1- | c == Raw.SDL_BUTTON_X2 = ButtonX2- | otherwise = ButtonExtra $ fromIntegral c return (Event ts (MouseButtonEvent- (MouseButtonEventData w'+ (MouseButtonEventData w motion (fromNumber b)- button+ (fromNumber c) e (P (V2 f g))))) convertRaw (Raw.MouseWheelEvent _ ts a b c d e) =- do w' <- fmap Window (Raw.getWindowFromID a)+ do w <- getWindowFromID a return (Event ts (MouseWheelEvent- (MouseWheelEventData w'+ (MouseWheelEventData w (fromNumber b) (V2 c d) (fromNumber e))))@@ -644,36 +675,50 @@ b (fromNumber c)))) convertRaw (Raw.JoyButtonEvent _ ts a b c) =- return (Event ts (JoyButtonEvent (JoyButtonEventData a b c)))-convertRaw (Raw.JoyDeviceEvent _ ts a) =- return (Event ts (JoyDeviceEvent (JoyDeviceEventData a)))+ return (Event ts (JoyButtonEvent (JoyButtonEventData a b (fromNumber c))))+convertRaw (Raw.JoyDeviceEvent t ts a) =+ return (Event ts (JoyDeviceEvent (JoyDeviceEventData (fromNumber t) a))) convertRaw (Raw.ControllerAxisEvent _ ts a b c) = return (Event ts (ControllerAxisEvent (ControllerAxisEventData a b c))) convertRaw (Raw.ControllerButtonEvent _ ts a b c) =- return (Event ts (ControllerButtonEvent (ControllerButtonEventData a b c)))-convertRaw (Raw.ControllerDeviceEvent _ ts a) =- return (Event ts (ControllerDeviceEvent (ControllerDeviceEventData a)))+ return (Event ts + (ControllerButtonEvent+ (ControllerButtonEventData a + (fromNumber $ fromIntegral b)+ (fromNumber c))))+convertRaw (Raw.ControllerDeviceEvent t ts a) =+ return (Event ts (ControllerDeviceEvent (ControllerDeviceEventData (fromNumber t) 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 _ _ _ _) =+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) =- do w' <- fmap Window (Raw.getWindowFromID a)- return (Event ts (UserEvent (UserEventData w' b c d)))+convertRaw (Raw.UserEvent t ts a b c d) =+ do w <- getWindowFromID a+ return (Event ts (UserEvent (UserEventData t w b c d))) convertRaw (Raw.SysWMEvent _ ts a) = return (Event ts (SysWMEvent (SysWMEventData a)))-convertRaw (Raw.TouchFingerEvent _ ts a b c d e f g) =- return (Event ts- (TouchFingerEvent- (TouchFingerEventData a- b- (P (V2 c d))- (V2 e f)- g)))+convertRaw (Raw.TouchFingerEvent t ts a b c d e f g) =+ do let touchFingerEvent motion = TouchFingerEvent+ (TouchFingerEventData a+ b+ motion+ (P (V2 c d))+ g)+ let touchFingerMotionEvent = TouchFingerMotionEvent+ (TouchFingerMotionEventData a+ b+ (P (V2 c d))+ (V2 e f)+ g)+ case t of+ Raw.SDL_FINGERDOWN -> return (Event ts (touchFingerEvent Pressed))+ Raw.SDL_FINGERUP -> return (Event ts (touchFingerEvent Released))+ Raw.SDL_FINGERMOTION -> return (Event ts touchFingerMotionEvent)+ _ -> error "convertRaw: Unexpected touch finger event" convertRaw (Raw.MultiGestureEvent _ ts a b c d e f) = return (Event ts (MultiGestureEvent@@ -740,6 +785,76 @@ then return Nothing else fmap Just (peek e >>= convertRaw) +-- | A user defined event structure that has been registered with SDL.+--+-- Use 'registerEvent', below, to obtain an instance.+data RegisteredEventType a =+ RegisteredEventType {pushRegisteredEvent :: a -> IO EventPushResult+ ,getRegisteredEvent :: Event -> IO (Maybe a)+ }++-- | A record used to convert between SDL Events and user-defined data structures.+--+-- Used for 'registerEvent', below.+data RegisteredEventData =+ RegisteredEventData {registeredEventWindow :: !(Maybe Window)+ -- ^ The associated 'Window'.+ ,registeredEventCode :: !Int32+ -- ^ User defined event code.+ ,registeredEventData1 :: !(Ptr ())+ -- ^ User defined data pointer.+ ,registeredEventData2 :: !(Ptr ())+ -- ^ User defined data pointer.+ }+ deriving (Eq,Ord,Generic,Show,Typeable)++-- | A registered event with no associated data.+--+-- This is a resonable baseline to modify for converting to+-- 'RegisteredEventData'.+emptyRegisteredEvent :: RegisteredEventData+emptyRegisteredEvent = RegisteredEventData Nothing 0 nullPtr nullPtr++-- | Possible results of an attempted push of an event to the queue.+data EventPushResult = EventPushSuccess | EventPushFiltered | EventPushFailure Text+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++-- | Register a new event type with SDL.+--+-- Provide functions that convert between 'UserEventData' and your structure.+-- You can then use 'pushRegisteredEvent' to add a custom event of the+-- registered type to the queue, and 'getRegisteredEvent' to test for such+-- events in the main loop.+registerEvent :: MonadIO m+ => (RegisteredEventData -> Timestamp -> IO (Maybe a))+ -> (a -> IO RegisteredEventData)+ -> m (Maybe (RegisteredEventType a))+registerEvent registeredEventDataToEvent eventToRegisteredEventData = do+ typ <- Raw.registerEvents 1+ if typ == maxBound+ then return Nothing+ else+ let pushEv ev = do+ RegisteredEventData mWin code d1 d2 <- eventToRegisteredEventData ev+ windowID <- case mWin of+ Just (Window w) -> Raw.getWindowID w+ Nothing -> return 0+ -- timestamp will be filled in by SDL+ let rawEvent = Raw.UserEvent typ 0 windowID code d1 d2+ liftIO . alloca $ \eventPtr -> do+ poke eventPtr rawEvent+ pushResult <- Raw.pushEvent eventPtr+ case pushResult of+ 1 -> return $ EventPushSuccess+ 0 -> return $ EventPushFiltered+ _ -> EventPushFailure <$> getError++ getEv (Event ts (UserEvent (UserEventData typ mWin code d1 d2))) =+ registeredEventDataToEvent (RegisteredEventData mWin code d1 d2) ts+ getEv _ = return Nothing++ in return . Just $ RegisteredEventType pushEv getEv+ -- | Pump the event loop, gathering events from the input devices. -- -- This function updates the event queue and internal input device state.@@ -751,3 +866,38 @@ -- See @<https://wiki.libsdl.org/SDL_PumpEvents SDL_PumpEvents>@ for C documentation. pumpEvents :: MonadIO m => m () pumpEvents = Raw.pumpEvents++-- | An 'EventWatchCallback' can process and respond to an event+-- when it is added to the event queue.+type EventWatchCallback = Event -> IO ()+newtype EventWatch = EventWatch {runEventWatchRemoval :: IO ()}++-- | Trigger an 'EventWatchCallback' when an event is added to the SDL+-- event queue.+--+-- See @<https://wiki.libsdl.org/SDL_AddEventWatch>@ for C documentation.+addEventWatch :: MonadIO m => EventWatchCallback -> m EventWatch+addEventWatch callback = liftIO $ do+ rawFilter <- Raw.mkEventFilter wrappedCb+ Raw.addEventWatch rawFilter nullPtr+ return (EventWatch $ auxRemove rawFilter)+ where+ wrappedCb :: Ptr () -> Ptr Raw.Event -> IO CInt+ wrappedCb _ evPtr = 0 <$ (callback =<< convertRaw =<< peek evPtr)++ auxRemove :: Raw.EventFilter -> IO ()+ auxRemove rawFilter = do+ Raw.delEventWatch rawFilter nullPtr+ freeHaskellFunPtr rawFilter++-- | Remove an 'EventWatch'.+--+-- See @<https://wiki.libsdl.org/SDL_DelEventWatch>@ for C documentation.+delEventWatch :: MonadIO m => EventWatch -> m ()+delEventWatch = liftIO . runEventWatchRemoval++-- | Checks raw Windows for null references.+getWindowFromID :: MonadIO m => Word32 -> m (Maybe Window)+getWindowFromID id = do+ rawWindow <- Raw.getWindowFromID id+ return $ if rawWindow == nullPtr then Nothing else Just $ Window rawWindow
+ src/SDL/Input/GameController.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}++module SDL.Input.GameController+ ( ControllerButton(..)+ , ControllerButtonState(..)+ , ControllerDeviceConnection(..)+ ) where++import Data.Data (Data)+import Data.Typeable+import Data.Word+import GHC.Generics (Generic)+import GHC.Int (Int32)+import SDL.Internal.Numbered+import qualified SDL.Raw as Raw++-- | Identifies a gamepad button.+data ControllerButton+ = ControllerButtonInvalid+ | ControllerButtonA+ | ControllerButtonB+ | ControllerButtonX+ | ControllerButtonY+ | ControllerButtonBack+ | ControllerButtonGuide+ | ControllerButtonStart+ | ControllerButtonLeftStick+ | ControllerButtonRightStick+ | ControllerButtonLeftShoulder+ | ControllerButtonRightShoulder+ | ControllerButtonDpadUp+ | ControllerButtonDpadDown+ | ControllerButtonDpadLeft+ | ControllerButtonDpadRight+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance FromNumber ControllerButton Int32 where+ fromNumber n = case n of+ Raw.SDL_CONTROLLER_BUTTON_A -> ControllerButtonA+ Raw.SDL_CONTROLLER_BUTTON_B -> ControllerButtonB+ Raw.SDL_CONTROLLER_BUTTON_X -> ControllerButtonX+ Raw.SDL_CONTROLLER_BUTTON_Y -> ControllerButtonY+ Raw.SDL_CONTROLLER_BUTTON_BACK -> ControllerButtonBack+ Raw.SDL_CONTROLLER_BUTTON_GUIDE -> ControllerButtonGuide+ Raw.SDL_CONTROLLER_BUTTON_START -> ControllerButtonStart+ Raw.SDL_CONTROLLER_BUTTON_LEFTSTICK -> ControllerButtonLeftStick+ Raw.SDL_CONTROLLER_BUTTON_RIGHTSTICK -> ControllerButtonRightStick+ Raw.SDL_CONTROLLER_BUTTON_LEFTSHOULDER -> ControllerButtonLeftShoulder+ Raw.SDL_CONTROLLER_BUTTON_RIGHTSHOULDER -> ControllerButtonRightShoulder+ Raw.SDL_CONTROLLER_BUTTON_DPAD_UP -> ControllerButtonDpadUp+ Raw.SDL_CONTROLLER_BUTTON_DPAD_DOWN -> ControllerButtonDpadDown+ Raw.SDL_CONTROLLER_BUTTON_DPAD_LEFT -> ControllerButtonDpadLeft+ Raw.SDL_CONTROLLER_BUTTON_DPAD_RIGHT -> ControllerButtonDpadRight+ _ -> ControllerButtonInvalid++-- | Identifies the state of a controller button.+data ControllerButtonState = ControllerButtonPressed | ControllerButtonReleased+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance FromNumber ControllerButtonState Word8 where+ fromNumber n = case n of+ Raw.SDL_PRESSED -> ControllerButtonPressed+ Raw.SDL_RELEASED -> ControllerButtonReleased+ _ -> ControllerButtonPressed++-- | Identified whether the game controller was added, removed, or remapped.+data ControllerDeviceConnection+ = ControllerDeviceAdded+ | ControllerDeviceRemoved+ | ControllerDeviceRemapped+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance FromNumber ControllerDeviceConnection Word32 where+ fromNumber n = case n of+ Raw.SDL_CONTROLLERDEVICEADDED -> ControllerDeviceAdded+ Raw.SDL_CONTROLLERDEVICEREMOVED -> ControllerDeviceRemoved+ _ -> ControllerDeviceRemapped
src/SDL/Input/Joystick.hs view
@@ -15,6 +15,7 @@ , getJoystickID , Joystick+ , JoyButtonState(..) , buttonPressed , ballDelta , axisPosition@@ -24,6 +25,7 @@ , JoyHatPosition(..) , getHat , numHats+ , JoyDeviceConnection(..) ) where import Control.Monad.IO.Class (MonadIO, liftIO)@@ -57,6 +59,16 @@ , joystickDeviceId :: CInt } deriving (Eq, Generic, Read, Ord, Show, Typeable) +-- | Identifies the state of a joystick button.+data JoyButtonState = JoyButtonPressed | JoyButtonReleased+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance FromNumber JoyButtonState Word8 where+ fromNumber n = case n of+ Raw.SDL_PRESSED -> JoyButtonPressed+ Raw.SDL_RELEASED -> JoyButtonReleased+ _ -> JoyButtonReleased+ -- | Count the number of joysticks attached to the system. -- -- See @<https://wiki.libsdl.org/SDL_NumJoysticks SDL_NumJoysticks>@ for C documentation.@@ -195,3 +207,13 @@ -- 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)++-- | Identifies whether a joystick has been connected or disconnected.+data JoyDeviceConnection = JoyDeviceAdded | JoyDeviceRemoved+ deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance FromNumber JoyDeviceConnection Word32 where+ fromNumber n = case n of+ Raw.SDL_JOYDEVICEADDED -> JoyDeviceAdded+ Raw.SDL_JOYDEVICEREMOVED -> JoyDeviceRemoved+ _ -> JoyDeviceAdded
src/SDL/Input/Mouse.hs view
@@ -23,7 +23,7 @@ , getMouseButtons -- * Warping the Mouse- , WarpMouseOrigin+ , WarpMouseOrigin(..) , warpMouse -- * Cursor Visibility@@ -99,6 +99,22 @@ | ButtonExtra !Int -- ^ An unknown mouse button. deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) +instance FromNumber MouseButton Word8 where+ fromNumber Raw.SDL_BUTTON_LEFT = ButtonLeft+ fromNumber Raw.SDL_BUTTON_MIDDLE = ButtonMiddle+ fromNumber Raw.SDL_BUTTON_RIGHT = ButtonRight+ fromNumber Raw.SDL_BUTTON_X1 = ButtonX1+ fromNumber Raw.SDL_BUTTON_X2 = ButtonX2+ fromNumber buttonCode = ButtonExtra $ fromIntegral buttonCode++instance ToNumber MouseButton Word8 where+ toNumber ButtonLeft = Raw.SDL_BUTTON_LEFT+ toNumber ButtonMiddle = Raw.SDL_BUTTON_MIDDLE+ toNumber ButtonRight = Raw.SDL_BUTTON_RIGHT+ toNumber ButtonX1 = Raw.SDL_BUTTON_X1+ toNumber ButtonX2 = Raw.SDL_BUTTON_X2+ toNumber (ButtonExtra i) = fromIntegral i+ -- | Identifies what kind of mouse-like device this is. data MouseDevice = Mouse !Int -- ^ An actual mouse. The number identifies which mouse.@@ -127,13 +143,16 @@ -- ^ Move the mouse pointer within a given 'Window'. | WarpCurrentFocus -- ^ Move the mouse pointer within whichever 'Window' currently has focus.- -- WarpGlobal -- Needs 2.0.4+ | WarpGlobal+ -- ^ Move the mouse pointer in global screen space. deriving (Data, Eq, Generic, Ord, Show, Typeable) -- | Move the current location of a mouse pointer. The 'WarpMouseOrigin' specifies the origin for the given warp coordinates. warpMouse :: MonadIO m => WarpMouseOrigin -> Point V2 CInt -> m () warpMouse (WarpInWindow (Window w)) (P (V2 x y)) = Raw.warpMouseInWindow w x y warpMouse WarpCurrentFocus (P (V2 x y)) = Raw.warpMouseInWindow nullPtr x y+warpMouse WarpGlobal (P (V2 x y)) = throwIfNeg_ "SDL.Mouse.warpMouse" "SDL_WarpMouseGlobal" $+ Raw.warpMouseGlobal x y -- | Get or set whether the cursor is currently visible. --@@ -173,15 +192,7 @@ getMouseButtons = liftIO $ convert <$> Raw.getMouseState nullPtr nullPtr where- convert w b = w `testBit` index- where- index = case b of- ButtonLeft -> 0- ButtonMiddle -> 1- ButtonRight -> 2- ButtonX1 -> 3- ButtonX2 -> 4- ButtonExtra i -> i+ convert w b = w `testBit` fromIntegral (toNumber b) newtype Cursor = Cursor { unwrapCursor :: Raw.Cursor } deriving (Eq, Typeable)
src/SDL/Video.hs view
@@ -122,6 +122,7 @@ , toNumber $ windowMode config , if isJust $ windowOpenGL config then Raw.SDL_WINDOW_OPENGL else 0 , if windowResizable config then Raw.SDL_WINDOW_RESIZABLE else 0+ , if windowVisible config then 0 else Raw.SDL_WINDOW_HIDDEN ] setGLAttributes (OpenGLConfig (V4 r g b a) d s ms p) = do let (msk, v0, v1, flg) = case p of@@ -159,6 +160,7 @@ -- , 'windowPosition' = 'Wherever' -- , 'windowResizable' = False -- , 'windowInitialSize' = V2 800 600+-- , 'windowVisible' = True -- } -- @ defaultWindow :: WindowConfig@@ -171,6 +173,7 @@ , windowPosition = Wherever , windowResizable = False , windowInitialSize = V2 800 600+ , windowVisible = True } data WindowConfig = WindowConfig@@ -182,6 +185,7 @@ , windowPosition :: WindowPosition -- ^ Defaults to 'Wherever'. , windowResizable :: Bool -- ^ Defaults to 'False'. Whether the window can be resized by the user. It is still possible to programatically change the size with 'setWindowSize'. , windowInitialSize :: V2 CInt -- ^ Defaults to @(800, 600)@.+ , windowVisible :: Bool -- ^ Defaults to 'True'. } deriving (Eq, Generic, Ord, Read, Show, Typeable) data WindowMode@@ -352,6 +356,7 @@ , windowPosition = Absolute (P wPos) , windowResizable = wFlags .&. Raw.SDL_WINDOW_RESIZABLE > 0 , windowInitialSize = wSize+ , windowVisible = wFlags .&. Raw.SDL_WINDOW_SHOWN > 0 } -- | Get the pixel format that is used for the given window.
src/SDL/Video/Renderer.hs view
@@ -73,6 +73,9 @@ -- * 'Palette's and pixel formats , Palette+ , paletteNColors+ , paletteColors+ , paletteColor , PixelFormat(..) , SurfacePixelFormat , formatPalette@@ -159,8 +162,8 @@ surfaceBlit (Surface src _) srcRect (Surface dst _) dstLoc = liftIO $ maybeWith with srcRect $ \srcPtr -> maybeWith with (fmap (flip Rectangle 0) dstLoc) $ \dstPtr -> do- throwIfNeg "SDL.Video.blitSurface" "SDL_BlitSurface" $- Raw.blitSurface src (castPtr srcPtr) dst (castPtr dstPtr)+ _ <- 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.@@ -433,6 +436,27 @@ where wrap p | p == nullPtr = Nothing | otherwise = Just (Palette p)++paletteNColors :: MonadIO m => Palette -> m CInt+paletteNColors (Palette p) = liftIO $ Raw.paletteNColors <$> peek p++paletteColors :: MonadIO m => Palette -> m (Maybe (SV.Vector (V4 Word8)))+paletteColors q@(Palette p) = do+ n <- liftIO $ fromIntegral <$> paletteNColors q+ let wrap p' | p' == nullPtr = Nothing+ | otherwise = return p'+ mv <- liftIO $ wrap . castPtr . Raw.paletteColors <$> peek p+ mColor <- liftIO $ traverse newForeignPtr_ mv+ return $ flip SV.unsafeFromForeignPtr0 n <$> mColor++paletteColor :: MonadIO m => Palette -> CInt -> m (Maybe (V4 Word8))+paletteColor q@(Palette p) i = do+ rp <- liftIO $ peek p+ m <- paletteNColors q+ if m > i && i >= 0 then+ liftIO $ fmap return . flip peekElemOff (fromIntegral i) . castPtr . Raw.paletteColors $ rp+ else+ return Nothing -- | Set a range of colors in a palette. --