Add renderGeometry

For #261

Author: dpwiz

src/SDL/Raw/Types.hsc

@@ -72,6 +72,7 @@ module SDL.Raw.Types (
 #ifdef RECENT_ISH
   FPoint(..),
   FRect(..),
+  Vertex(..),
 #endif
   RendererInfo(..),
   RWops(..),
@@ -1400,6 +1401,24 @@ instance Storable FRect where
     (#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

@@ -130,6 +130,7 @@ module SDL.Raw.Video (
   renderDrawRectsF,
   renderFillRectF,
   renderFillRectsF,
+  renderGeometry,
 #endif
   renderGetClipRect,
   renderGetLogicalSize,
@@ -359,6 +360,7 @@ foreign import ccall "SDL.h SDL_RenderDrawRectF" renderDrawRectFFFI :: Renderer
 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
 #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
@@ -949,6 +951,9 @@ renderFillRectsF :: MonadIO m => Renderer -> Ptr FRect -> CInt -> m CInt
 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 #-}
 #endif
 
 

src/SDL/Video/Renderer.hs

@@ -42,6 +42,8 @@ module SDL.Video.Renderer
   , drawRectsF
   , fillRectF
   , fillRectsF
+  , renderGeometry
+  , Raw.Vertex(..)
 #endif
   , present
 
@@ -744,6 +746,24 @@ fillRectsF (Renderer r) rects = liftIO $
     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)
+
 #endif