packages feed

sdl2 2.5.4.0 → 2.5.4.1

raw patch · 11 files changed

+456/−15 lines, 11 filesdep ~basedep ~bytestringdep ~vectornew-component:exe:rendergeometry-example

Dependency ranges changed: base, bytestring, vector

Files

ChangeLog.md view
@@ -1,3 +1,11 @@+2.5.4.1+=======++* Added `windowOpacity` property+* Added `renderGeometry` and `renderGeometryRaw`+  - Requires SDL 2.0.18+  - See examples/RenderGeometry.hs+ 2.5.4.0 =======
+ examples/RenderGeometry.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}++module RenderGeometry where++import Control.Monad+import Data.Word (Word8)+import Foreign (castPtr, plusPtr, sizeOf)+import Foreign.C.Types+import SDL.Vect+import qualified Data.Vector.Storable as V++import SDL (($=))+import qualified SDL+import SDL.Raw.Types (FPoint(..), Color(..))++screenWidth, screenHeight :: CInt+(screenWidth, screenHeight) = (640, 480)++main :: IO ()+main = do+  SDL.initialize [SDL.InitVideo]+  SDL.HintRenderScaleQuality $= SDL.ScaleLinear+  do renderQuality <- SDL.get SDL.HintRenderScaleQuality+     when (renderQuality /= SDL.ScaleLinear) $+       putStrLn "Warning: Linear texture filtering not enabled!"++  window <-+    SDL.createWindow+      "SDL / RenderGeometry Example"+      SDL.defaultWindow+        { SDL.windowInitialSize = V2 screenWidth screenHeight+        , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL+        }+  SDL.showWindow window++  renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer++  let+    tl = fromIntegral screenWidth * 0.1+    tt = fromIntegral screenHeight * 0.1+    tr = fromIntegral screenWidth * 0.9+    tb = fromIntegral screenHeight * 0.9++    triVertices = V.fromList+      [ SDL.Vertex+          (FPoint tl tb)+          (Color 0xFF 0 0 255)+          (FPoint 0 0)+      , SDL.Vertex+          (FPoint tr tb)+          (Color 0 0xFF 0 255)+          (FPoint 0 1)+      , SDL.Vertex+          (FPoint (tl/2 + tr/2) tt)+          (Color 0 0 0xFF 255)+          (FPoint 1 1)+      ]++  let+    l = fromIntegral screenWidth * 0.2+    t = fromIntegral screenHeight * 0.2+    r = fromIntegral screenWidth * 0.8+    b = fromIntegral screenHeight * 0.8++    quadVertices = V.fromList+      [ SDL.Vertex+          (FPoint l b)+          (Color 0xFF 0 0xFF 127)+          (FPoint 0 0)+      , SDL.Vertex+          (FPoint r b)+          (Color 0xFF 0 0xFF 127)+          (FPoint 1 0)+      , SDL.Vertex+          (FPoint r t)+          (Color 0xFF 0xFF 0 127)+          (FPoint 1 1)+      , SDL.Vertex+          (FPoint l t)+          (Color 0 0 0 127)+          (FPoint 0 1)+      ]+    quadIndices = V.fromList+      [ 0, 1, 3+      , 2, 3, 1+      ]+    stride = fromIntegral $ sizeOf (undefined :: SDL.Vertex)++  let loop = do+        events <- SDL.pollEvents+        let quit = elem SDL.QuitEvent $ map SDL.eventPayload events++        SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound+        SDL.clear renderer++        SDL.renderGeometry+          renderer+          Nothing+          triVertices+          mempty++        SDL.rendererDrawBlendMode renderer $= SDL.BlendAlphaBlend+        V.unsafeWith quadVertices $ \ptr ->+          SDL.renderGeometryRaw+            renderer+            Nothing+            (castPtr ptr)+            stride+            (castPtr ptr `plusPtr` sizeOf (undefined :: FPoint))+            stride+            (castPtr ptr `plusPtr` sizeOf (undefined :: FPoint) `plusPtr` sizeOf (undefined :: Color))+            stride+            (fromIntegral $ V.length quadVertices)+            (quadIndices :: V.Vector Word8)++        SDL.present renderer++        unless quit loop++  loop++  SDL.destroyWindow window+  SDL.quit
sdl2.cabal view
@@ -1,5 +1,5 @@ name:                sdl2-version:             2.5.4.0+version:             2.5.4.1 synopsis:            Both high- and low-level bindings to the SDL library (version 2.0.6+). description:   This package contains bindings to the SDL 2 library, in both high- and@@ -61,7 +61,7 @@   description:       Use features from a more recent libsdl2 release.   default:           True   manual:            False-  + flag pkgconfig   description:       Use pkgconfig to sort out SDL2 dependency   default:           True@@ -150,13 +150,13 @@     StateVar >= 1.1.0.0 && < 1.3,     text >= 1.1.0.0 && < 2.1,     transformers >= 0.2 && < 0.7,-    vector >= 0.10.9.0 && < 0.13+    vector >= 0.10.9.0 && < 0.14    if flag(no-linear)     cpp-options: -Dnolinear   else     build-depends:-      linear >= 1.10.1.2 && < 1.22+      linear >= 1.10.1.2 && < 1.23    if impl(ghc >= 8.6)     default-extensions: NoStarIsType@@ -505,6 +505,18 @@   main-is: UserEvents.hs   default-language: Haskell2010   ghc-options: -main-is UserEvents+  other-modules: Paths_sdl2++executable rendergeometry-example+  if flag(examples)+    build-depends: base, bytestring, vector, sdl2+  else+    buildable: False++  hs-source-dirs: examples+  main-is: RenderGeometry.hs+  default-language: Haskell2010+  ghc-options: -main-is RenderGeometry   other-modules: Paths_sdl2  executable opengl-example
src/SDL/Event.hs view
@@ -109,10 +109,10 @@ import Control.Applicative #endif --- | A single SDL event. This event occured at 'eventTimestamp' and carries data under 'eventPayload'.+-- | A single SDL event. This event occurred at 'eventTimestamp' and carries data under 'eventPayload'. data Event = Event   { eventTimestamp :: Timestamp-    -- ^ The time the event occured.+    -- ^ The time the event occurred.   , eventPayload :: EventPayload     -- ^ Data pertaining to this event.   } deriving (Eq, Ord, Generic, Show, Typeable)@@ -396,7 +396,7 @@ data JoyDeviceEventData =   JoyDeviceEventData {joyDeviceEventConnection :: !JoyDeviceConnection                       -- ^ Was the device added or removed?-                     ,joyDeviceEventWhich :: !Int32+                     ,joyDeviceEventWhich :: !Raw.JoystickID                       -- ^ The instance id of the joystick that reported the event.                      }   deriving (Eq,Ord,Generic,Show,Typeable)@@ -405,7 +405,7 @@ data ControllerAxisEventData =   ControllerAxisEventData {controllerAxisEventWhich :: !Raw.JoystickID                            -- ^ The joystick instance ID that reported the event.-                          ,controllerAxisEventAxis :: !Word8+                          ,controllerAxisEventAxis :: !ControllerAxis                            -- ^ The index of the axis.                           ,controllerAxisEventValue :: !Int16                            -- ^ The axis value ranging between -32768 and 32767.@@ -427,7 +427,7 @@ data ControllerDeviceEventData =   ControllerDeviceEventData {controllerDeviceEventConnection :: !ControllerDeviceConnection                              -- ^ Was the device added, removed, or remapped?-                            ,controllerDeviceEventWhich :: !Int32+                            ,controllerDeviceEventWhich :: !Raw.JoystickID                              -- ^ The joystick instance ID that reported the event.                             }   deriving (Eq,Ord,Generic,Show,Typeable)@@ -681,7 +681,11 @@ 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)))+  return (Event ts+            (ControllerAxisEvent+              (ControllerAxisEventData a+                                      (fromNumber $ fromIntegral b)+                                      c))) convertRaw (Raw.ControllerButtonEvent t ts a b _) =   return (Event ts            (ControllerButtonEvent
src/SDL/Input/GameController.hs view
@@ -1,22 +1,177 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}  module SDL.Input.GameController-  ( ControllerButton(..)-  , ControllerButtonState(..)-  , ControllerDeviceConnection(..)+  ( ControllerDevice (..)+  , availableControllers++  , openController+  , closeController+  , controllerAttached++  , getControllerID++  , controllerMapping+  , addControllerMapping+  , addControllerMappingsFromFile++  , ControllerButton (..)+  , ControllerButtonState (..)+  , controllerButton++  , ControllerAxis (..)+  , controllerAxis+  +  , ControllerDeviceConnection (..)   ) where +import Control.Monad (filterM)+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 (withCString)+import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable import GHC.Generics (Generic) import GHC.Int (Int32)+import SDL.Input.Joystick (numJoysticks)+import SDL.Internal.Exception import SDL.Internal.Numbered+import SDL.Internal.Types+import SDL.Vect+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BSI import qualified SDL.Raw as Raw+import qualified Data.Text.Encoding as Text+import qualified Data.Vector as V +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif++{- | A description of game controller that can be opened using 'openController'.+ To retrieve a list of connected game controllers, use 'availableControllers'.+-}+data ControllerDevice = ControllerDevice+  { gameControllerDeviceName :: Text+  , gameControllerDeviceId :: CInt+  }+  deriving (Eq, Generic, Read, Ord, Show, Typeable)++-- | Enumerate all connected Controllers, retrieving a description of each.+availableControllers :: MonadIO m => m (V.Vector ControllerDevice)+availableControllers = liftIO $ do+  n <- numJoysticks+  indices <- filterM Raw.isGameController [0 .. (n - 1)]+  fmap V.fromList $ for indices $ \i -> do+    cstr <-+      throwIfNull "SDL.Input.Controller.availableGameControllers" "SDL_GameControllerNameForIndex" $+        Raw.gameControllerNameForIndex i+    name <- Text.decodeUtf8 <$> BS.packCString cstr+    return (ControllerDevice name i)++{- | Open a controller so that you can start receiving events from interaction with this controller.++ See @<https://wiki.libsdl.org/SDL_GameControllerOpen SDL_GameControllerOpen>@ for C documentation.+-}+openController+  :: (Functor m, MonadIO m)+  => ControllerDevice+  -- ^ The device to open. Use 'availableControllers' to find 'JoystickDevices's+  -> m GameController+openController (ControllerDevice _ x) =+  fmap GameController $+    throwIfNull "SDL.Input.GameController.openController" "SDL_GameControllerOpen" $+      Raw.gameControllerOpen x++{- | Close a controller previously opened with 'openController'.++ See @<https://wiki.libsdl.org/SDL_GameControllerClose SDL_GameControllerClose>@ for C documentation.+-}+closeController :: MonadIO m => GameController -> m ()+closeController (GameController j) = Raw.gameControllerClose j++{- | Check if a controller has been opened and is currently connected.++ See @<https://wiki.libsdl.org/SDL_GameControllerGetAttached SDL_GameControllerGetAttached>@ for C documentation.+-}+controllerAttached :: MonadIO m => GameController -> m Bool+controllerAttached (GameController c) = Raw.gameControllerGetAttached c++{- | Get the instance ID of an opened controller. The instance ID is used to identify the controller+ in future SDL events.++ See @<https://wiki.libsdl.org/SDL_GameControllerInstanceID SDL_GameControllerInstanceID>@ for C documentation.+-}+getControllerID :: MonadIO m => GameController -> m Int32+getControllerID (GameController c) =+  throwIfNeg "SDL.Input.GameController.getControllerID" "SDL_JoystickInstanceID" $+    Raw.joystickInstanceID c++{- | Get the current mapping of a Game Controller.++ See @<https://wiki.libsdl.org/SDL_GameControllerMapping SDL_GameControllerMapping>@ for C documentation.+-}+controllerMapping :: MonadIO m => GameController -> m Text+controllerMapping (GameController c) = liftIO $ do+  mapping <-+    throwIfNull "SDL.Input.GameController.getControllerMapping" "SDL_GameControllerMapping" $+      Raw.gameControllerMapping c+  Text.decodeUtf8 <$> BS.packCString mapping++{- | Add support for controllers that SDL is unaware of or to cause an existing controller to+ have a different binding.++ See @<https://wiki.libsdl.org/SDL_GameControllerAddMapping SDL_GameControllerAddMapping>@ for C documentation.+-}+addControllerMapping :: MonadIO m => BS.ByteString -> m ()+addControllerMapping mapping =+  liftIO $+    throwIfNeg_ "SDL.Input.GameController.addControllerMapping" "SDL_GameControllerAddMapping" $+      let (mappingForeign, _, _) = BSI.toForeignPtr mapping+       in withForeignPtr mappingForeign $ \mappingPtr ->+            Raw.gameControllerAddMapping (castPtr mappingPtr)++{- | Use this function to load a set of Game Controller mappings from a file, filtered by the+ current SDL_GetPlatform(). A community sourced database of controllers is available+ @<https://raw.githubusercontent.com/gabomdq/SDL_GameControllerDB/master/gamecontrollerdb.txt here>@+ (on GitHub).++ See @<https://wiki.libsdl.org/SDL_GameControllerAddMappingsFromFile SDL_GameControllerAddMappingsFromFile>@ for C documentation.+-}+addControllerMappingsFromFile :: MonadIO m => FilePath -> m ()+addControllerMappingsFromFile mappingFile =+  liftIO $+    throwIfNeg_ "SDL.Input.GameController.addControllerMappingsFromFile" "SDL_GameControllerAddMappingsFromFile" $+      withCString mappingFile Raw.gameControllerAddMappingsFromFile++{- | Get the current state of an axis control on a game controller.++ See @<https://wiki.libsdl.org/SDL_GameControllerGetAxis SDL_GameControllerGetAxis>@ for C documentation.+-}+controllerAxis :: MonadIO m => GameController -> ControllerAxis -> m Int16+controllerAxis (GameController c) axis =+  Raw.gameControllerGetAxis c (toNumber axis)++{- | Get the current state of a button on a game controller.++ See @<https://wiki.libsdl.org/SDL_GameControllerGetButton SDL_GameControllerGetButton>@ for C documentation.+-}+controllerButton :: MonadIO m => GameController -> ControllerButton -> m ControllerButtonState+controllerButton (GameController c) button =+  fromNumber . fromIntegral <$> Raw.gameControllerGetButton c (toNumber button)+ -- | Identifies a gamepad button. data ControllerButton   = ControllerButtonInvalid@@ -88,7 +243,40 @@     Raw.SDL_CONTROLLERBUTTONUP -> ControllerButtonReleased     _ -> ControllerButtonInvalidState --- | Identified whether the game controller was added, removed, or remapped.+data ControllerAxis+  = ControllerAxisInvalid+  | ControllerAxisLeftX+  | ControllerAxisLeftY+  | ControllerAxisRightX+  | ControllerAxisRightY+  | ControllerAxisTriggerLeft+  | ControllerAxisTriggerRight+  | ControllerAxisMax+  deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)++instance ToNumber ControllerAxis Int32 where+  toNumber a = case a of+    ControllerAxisLeftX -> Raw.SDL_CONTROLLER_AXIS_LEFTX+    ControllerAxisLeftY -> Raw.SDL_CONTROLLER_AXIS_LEFTY+    ControllerAxisRightX -> Raw.SDL_CONTROLLER_AXIS_RIGHTX+    ControllerAxisRightY -> Raw.SDL_CONTROLLER_AXIS_RIGHTY+    ControllerAxisTriggerLeft -> Raw.SDL_CONTROLLER_AXIS_TRIGGERLEFT+    ControllerAxisTriggerRight -> Raw.SDL_CONTROLLER_AXIS_TRIGGERRIGHT+    ControllerAxisMax -> Raw.SDL_CONTROLLER_AXIS_MAX+    ControllerAxisInvalid -> Raw.SDL_CONTROLLER_AXIS_INVALID++instance FromNumber ControllerAxis Int32 where+  fromNumber n = case n of+    Raw.SDL_CONTROLLER_AXIS_LEFTX -> ControllerAxisLeftX+    Raw.SDL_CONTROLLER_AXIS_LEFTY -> ControllerAxisLeftY+    Raw.SDL_CONTROLLER_AXIS_RIGHTX -> ControllerAxisRightX+    Raw.SDL_CONTROLLER_AXIS_RIGHTY -> ControllerAxisRightY+    Raw.SDL_CONTROLLER_AXIS_TRIGGERLEFT -> ControllerAxisTriggerLeft+    Raw.SDL_CONTROLLER_AXIS_TRIGGERRIGHT -> ControllerAxisTriggerRight+    Raw.SDL_CONTROLLER_AXIS_MAX -> ControllerAxisMax+    _ -> ControllerAxisInvalid++-- | Identifies whether the game controller was added, removed, or remapped. data ControllerDeviceConnection   = ControllerDeviceAdded   | ControllerDeviceRemoved
src/SDL/Input/Joystick.hs view
@@ -108,7 +108,7 @@ -- in future SDL events. -- -- See @<https://wiki.libsdl.org/SDL_JoystickInstanceID SDL_JoystickInstanceID>@ for C documentation.-getJoystickID :: MonadIO m => Joystick -> m (Int32)+getJoystickID :: MonadIO m => Joystick -> m Raw.JoystickID getJoystickID (Joystick j) =   throwIfNeg "SDL.Input.Joystick.getJoystickID" "SDL_JoystickInstanceID" $   Raw.joystickInstanceID j
src/SDL/Internal/Types.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} module SDL.Internal.Types   ( Joystick(..)+  , GameController(..)   , Window(..)   , Renderer(..)   ) where@@ -13,6 +14,10 @@ import qualified SDL.Raw as Raw  newtype Joystick = Joystick { joystickPtr :: Raw.Joystick }+  deriving (Data, Eq, Generic, Ord, Show, Typeable)++newtype GameController = GameController+  { gameControllerPtr :: Raw.GameController }   deriving (Data, Eq, Generic, Ord, Show, Typeable)  newtype Window = Window (Raw.Window)
src/SDL/Raw/Types.hsc view
@@ -72,6 +72,7 @@ #ifdef RECENT_ISH   FPoint(..),   FRect(..),+  Vertex(..), #endif   RendererInfo(..),   RWops(..),@@ -1400,6 +1401,24 @@     (#poke SDL_FRect, w) ptr w     (#poke SDL_FRect, h) ptr h +data Vertex = Vertex+  { vertexPosition :: !FPoint+  , vertexColor :: !Color+  , vertexTexCoord :: !FPoint+  } deriving (Eq, Show, Typeable)++instance Storable Vertex where+  sizeOf _ = (#size SDL_Vertex)+  alignment _ = (#alignment SDL_Vertex)+  peek ptr = do+    position <- (#peek SDL_Vertex, position) ptr+    color <- (#peek SDL_Vertex, color) ptr+    tex_coord <- (#peek SDL_Vertex, tex_coord) ptr+    return $! Vertex position color tex_coord+  poke ptr (Vertex position color tex_coord) = do+    (#poke SDL_Vertex, position) ptr position+    (#poke SDL_Vertex, color) ptr color+    (#poke SDL_Vertex, tex_coord) ptr tex_coord #endif  data RendererInfo = RendererInfo
src/SDL/Raw/Video.hs view
@@ -52,6 +52,7 @@   getWindowID,   getWindowMaximumSize,   getWindowMinimumSize,+  getWindowOpacity,   getWindowPixelFormat,   getWindowPosition,   getWindowSize,@@ -73,6 +74,7 @@   setWindowIcon,   setWindowMaximumSize,   setWindowMinimumSize,+  setWindowOpacity,   setWindowPosition,   setWindowSize,   setWindowTitle,@@ -128,6 +130,8 @@   renderDrawRectsF,   renderFillRectF,   renderFillRectsF,+  renderGeometry,+  renderGeometryRaw, #endif   renderGetClipRect,   renderGetLogicalSize,@@ -282,6 +286,7 @@ foreign import ccall "SDL.h SDL_GetWindowID" getWindowIDFFI :: Window -> IO Word32 foreign import ccall "SDL.h SDL_GetWindowMaximumSize" getWindowMaximumSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () foreign import ccall "SDL.h SDL_GetWindowMinimumSize" getWindowMinimumSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO ()+foreign import ccall "SDL.h SDL_GetWindowOpacity" getWindowOpacityFFI :: Window -> Ptr CFloat -> IO () foreign import ccall "SDL.h SDL_GetWindowPixelFormat" getWindowPixelFormatFFI :: Window -> IO Word32 foreign import ccall "SDL.h SDL_GetWindowPosition" getWindowPositionFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () foreign import ccall "SDL.h SDL_GetWindowSize" getWindowSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO ()@@ -303,6 +308,7 @@ foreign import ccall "SDL.h SDL_SetWindowIcon" setWindowIconFFI :: Window -> Ptr Surface -> IO () foreign import ccall "SDL.h SDL_SetWindowMaximumSize" setWindowMaximumSizeFFI :: Window -> CInt -> CInt -> IO () foreign import ccall "SDL.h SDL_SetWindowMinimumSize" setWindowMinimumSizeFFI :: Window -> CInt -> CInt -> IO ()+foreign import ccall "SDL.h SDL_SetWindowOpacity" setWindowOpacityFFI :: Window -> CFloat -> IO () foreign import ccall "SDL.h SDL_SetWindowPosition" setWindowPositionFFI :: Window -> CInt -> CInt -> IO () foreign import ccall "SDL.h SDL_SetWindowSize" setWindowSizeFFI :: Window -> CInt -> CInt -> IO () foreign import ccall "SDL.h SDL_SetWindowTitle" setWindowTitleFFI :: Window -> CString -> IO ()@@ -355,6 +361,8 @@ foreign import ccall "SDL.h SDL_RenderDrawRectsF" renderDrawRectsFFFI :: Renderer -> Ptr FRect -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderFillRectF" renderFillRectFFFI :: Renderer -> Ptr FRect -> IO CInt foreign import ccall "SDL.h SDL_RenderFillRectsF" renderFillRectsFFFI :: Renderer -> Ptr FRect -> CInt -> IO CInt+foreign import ccall "SDL.h SDL_RenderGeometry" renderGeometryFFI :: Renderer -> Texture -> Ptr Vertex -> CInt -> Ptr CInt -> CInt -> IO CInt+foreign import ccall "SDL.h SDL_RenderGeometryRaw" renderGeometryRawFFI :: Renderer -> Texture -> Ptr FPoint -> CInt -> Ptr Color -> CInt -> Ptr FPoint -> CInt -> CInt -> Ptr () -> CInt -> CInt -> IO CInt #endif foreign import ccall "sqlhelper.c SDLHelper_RenderFillRectEx" renderFillRectExFFI :: Renderer -> CInt -> CInt -> CInt -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderFillRects" renderFillRectsFFI :: Renderer -> Ptr Rect -> CInt -> IO CInt@@ -643,6 +651,10 @@ getWindowMinimumSize v1 v2 v3 = liftIO $ getWindowMinimumSizeFFI v1 v2 v3 {-# INLINE getWindowMinimumSize #-} +getWindowOpacity :: MonadIO m => Window -> Ptr CFloat -> m ()+getWindowOpacity v1 v2 = liftIO $ getWindowOpacityFFI v1 v2+{-# INLINE getWindowOpacity #-}+ getWindowPixelFormat :: MonadIO m => Window -> m Word32 getWindowPixelFormat v1 = liftIO $ getWindowPixelFormatFFI v1 {-# INLINE getWindowPixelFormat #-}@@ -727,6 +739,10 @@ setWindowMinimumSize v1 v2 v3 = liftIO $ setWindowMinimumSizeFFI v1 v2 v3 {-# INLINE setWindowMinimumSize #-} +setWindowOpacity :: MonadIO m => Window -> CFloat -> m ()+setWindowOpacity v1 v2 = liftIO $ setWindowOpacityFFI v1 v2+{-# INLINE setWindowOpacity #-}+ setWindowPosition :: MonadIO m => Window -> CInt -> CInt -> m () setWindowPosition v1 v2 v3 = liftIO $ setWindowPositionFFI v1 v2 v3 {-# INLINE setWindowPosition #-}@@ -937,6 +953,13 @@ renderFillRectsF v1 v2 v3 = liftIO $ renderFillRectsFFFI v1 v2 v3 {-# INLINE renderFillRectsF #-} +renderGeometry :: MonadIO m => Renderer -> Texture -> Ptr Vertex -> CInt -> Ptr CInt -> CInt -> m CInt+renderGeometry v1 v2 v3 v4 v5 v6 = liftIO $ renderGeometryFFI v1 v2 v3 v4 v5 v6+{-# INLINE renderGeometry #-}++renderGeometryRaw :: MonadIO m => Renderer -> Texture -> Ptr FPoint -> CInt -> Ptr Color -> CInt -> Ptr FPoint -> CInt -> CInt -> Ptr () -> CInt -> CInt -> m CInt+renderGeometryRaw v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 = liftIO $ renderGeometryRawFFI v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12+{-# INLINE renderGeometryRaw #-} #endif
src/SDL/Video.hs view
@@ -25,6 +25,7 @@   -- * Window Attributes   , windowMinimumSize   , windowMaximumSize+  , windowOpacity   , windowSize   , windowBordered   , windowBrightness@@ -610,6 +611,22 @@     alloca $ \hptr -> do       Raw.getWindowMinimumSize win wptr hptr       V2 <$> peek wptr <*> peek hptr++-- | Get or set the opacity of a window.+--+-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.+--+-- See @<https://wiki.libsdl.org/SDL_SetWindowOpacity SDL_SetWindowOpacity>@ and @<https://wiki.libsdl.org/SDL_GetWindowOpacity SDL_GetWindowOpacity>@ for C documentation.+windowOpacity :: Window -> StateVar CFloat+windowOpacity (Window win) = makeStateVar getWindowOpacity setWindowOpacity+  where+  setWindowOpacity opacity = Raw.setWindowOpacity win opacity++  getWindowOpacity =+    liftIO $+    alloca $ \optr -> do+      Raw.getWindowOpacity win optr+      peek optr  createRenderer :: MonadIO m => Window -> CInt -> RendererConfig -> m Renderer createRenderer (Window w) driver config =
src/SDL/Video/Renderer.hs view
@@ -42,6 +42,9 @@   , drawRectsF   , fillRectF   , fillRectsF+  , renderGeometry+  , Raw.Vertex(..)+  , renderGeometryRaw #endif   , present @@ -744,6 +747,45 @@     SV.unsafeWith rects $ \rp ->       Raw.renderFillRectsF r (castPtr rp) (fromIntegral (SV.length rects)) +-- | Render a list of triangles, optionally using a texture and indices into the+-- vertex array Color and alpha modulation is done per vertex+-- (SDL_SetTextureColorMod and SDL_SetTextureAlphaMod are ignored).+renderGeometry :: MonadIO m => Renderer -> Maybe Texture -> SV.Vector Raw.Vertex -> SV.Vector CInt -> m ()+renderGeometry (Renderer r) mtexture vertices indices = liftIO $+  throwIfNeg_ "SDL.Video.renderGeometry" "SDL_RenderGeometry" $+    SV.unsafeWith vertices $ \vp ->+      SV.unsafeWith indices $ \ip ->+        Raw.renderGeometry r t vp (fromIntegral (SV.length vertices)) (ipOrNull ip) ipSize+  where+    t = case mtexture of+      Just (Texture found) -> found+      Nothing -> nullPtr++    ipOrNull ip = if ipSize == 0 then nullPtr else ip++    ipSize = fromIntegral (SV.length indices)++-- | Render a list of triangles, optionally using a texture and indices into the+-- vertex array Color and alpha modulation is done per vertex+-- (SDL_SetTextureColorMod and SDL_SetTextureAlphaMod are ignored).+--+-- This version allows storeing vertex data in arbitrary types, but you have to provide+-- pointers and strides yourself.+renderGeometryRaw :: forall ix m . (Storable ix, MonadIO m) => Renderer -> Maybe Texture -> Ptr Raw.FPoint -> CInt -> Ptr Raw.Color -> CInt -> Ptr Raw.FPoint -> CInt -> CInt -> SV.Vector ix -> m ()+renderGeometryRaw (Renderer r) mtexture xy xyStride color colorStride uv uvStride numVertices indices = liftIO $+  throwIfNeg_ "SDL.Video.renderGeometryRaw" "SDL_RenderGeometryRaw" $+    SV.unsafeWith indices $ \ip ->+      Raw.renderGeometryRaw r t xy xyStride color colorStride uv uvStride numVertices (castPtr $ ipOrNull ip) ipSize sizeOfip+  where+    t = case mtexture of+      Just (Texture found) -> found+      Nothing -> nullPtr++    ipOrNull ip = if ipSize == 0 then nullPtr else ip++    ipSize = fromIntegral (SV.length indices)++    sizeOfip = fromIntegral $ sizeOf (undefined :: ix) #endif