Add renderGeometryRaw

Author: dpwiz

src/SDL/Raw/Video.hs

@@ -131,6 +131,7 @@ module SDL.Raw.Video (
   renderFillRectF,
   renderFillRectsF,
   renderGeometry,
+  renderGeometryRaw,
 #endif
   renderGetClipRect,
   renderGetLogicalSize,
@@ -361,6 +362,7 @@ foreign import ccall "SDL.h SDL_RenderDrawRectsF" renderDrawRectsFFFI :: Rendere
 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
@@ -954,6 +956,10 @@ renderFillRectsF v1 v2 v3 = liftIO $ renderFillRectsFFFI v1 v2 v3
 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/Renderer.hs

@@ -44,6 +44,7 @@ module SDL.Video.Renderer
   , fillRectsF
   , renderGeometry
   , Raw.Vertex(..)
+  , renderGeometryRaw
 #endif
   , present
 
@@ -764,6 +765,27 @@ renderGeometry (Renderer r) mtexture vertices indices = liftIO $
 
     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