Skip to content

Commit 7119228

Browse files
committed
Add renderGeometry
For #261
1 parent bb077e3 commit 7119228

File tree

3 files changed

+44
-0
lines changed

3 files changed

+44
-0
lines changed

src/SDL/Raw/Types.hsc

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,7 @@ module SDL.Raw.Types (
7272
#ifdef RECENT_ISH
7373
FPoint(..),
7474
FRect(..),
75+
Vertex(..),
7576
#endif
7677
RendererInfo(..),
7778
RWops(..),
@@ -1400,6 +1401,24 @@ instance Storable FRect where
14001401
(#poke SDL_FRect, w) ptr w
14011402
(#poke SDL_FRect, h) ptr h
14021403

1404+
data Vertex = Vertex
1405+
{ vertexPosition :: !FPoint
1406+
, vertexColor :: !Color
1407+
, vertexTexCoord :: !FPoint
1408+
} deriving (Eq, Show, Typeable)
1409+
1410+
instance Storable Vertex where
1411+
sizeOf _ = (#size SDL_Vertex)
1412+
alignment _ = (#alignment SDL_Vertex)
1413+
peek ptr = do
1414+
position <- (#peek SDL_Vertex, position) ptr
1415+
color <- (#peek SDL_Vertex, color) ptr
1416+
tex_coord <- (#peek SDL_Vertex, tex_coord) ptr
1417+
return $! Vertex position color tex_coord
1418+
poke ptr (Vertex position color tex_coord) = do
1419+
(#poke SDL_Vertex, position) ptr position
1420+
(#poke SDL_Vertex, color) ptr color
1421+
(#poke SDL_Vertex, tex_coord) ptr tex_coord
14031422
#endif
14041423

14051424
data RendererInfo = RendererInfo

src/SDL/Raw/Video.hs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,6 +130,7 @@ module SDL.Raw.Video (
130130
renderDrawRectsF,
131131
renderFillRectF,
132132
renderFillRectsF,
133+
renderGeometry,
133134
#endif
134135
renderGetClipRect,
135136
renderGetLogicalSize,
@@ -359,6 +360,7 @@ foreign import ccall "SDL.h SDL_RenderDrawRectF" renderDrawRectFFFI :: Renderer
359360
foreign import ccall "SDL.h SDL_RenderDrawRectsF" renderDrawRectsFFFI :: Renderer -> Ptr FRect -> CInt -> IO CInt
360361
foreign import ccall "SDL.h SDL_RenderFillRectF" renderFillRectFFFI :: Renderer -> Ptr FRect -> IO CInt
361362
foreign import ccall "SDL.h SDL_RenderFillRectsF" renderFillRectsFFFI :: Renderer -> Ptr FRect -> CInt -> IO CInt
363+
foreign import ccall "SDL.h SDL_RenderGeometry" renderGeometryFFI :: Renderer -> Texture -> Ptr Vertex -> CInt -> Ptr CInt -> CInt -> IO CInt
362364
#endif
363365
foreign import ccall "sqlhelper.c SDLHelper_RenderFillRectEx" renderFillRectExFFI :: Renderer -> CInt -> CInt -> CInt -> CInt -> IO CInt
364366
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
949951
renderFillRectsF v1 v2 v3 = liftIO $ renderFillRectsFFFI v1 v2 v3
950952
{-# INLINE renderFillRectsF #-}
951953

954+
renderGeometry :: MonadIO m => Renderer -> Texture -> Ptr Vertex -> CInt -> Ptr CInt -> CInt -> m CInt
955+
renderGeometry v1 v2 v3 v4 v5 v6 = liftIO $ renderGeometryFFI v1 v2 v3 v4 v5 v6
956+
{-# INLINE renderGeometry #-}
952957
#endif
953958

954959

src/SDL/Video/Renderer.hs

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,8 @@ module SDL.Video.Renderer
4242
, drawRectsF
4343
, fillRectF
4444
, fillRectsF
45+
, renderGeometry
46+
, Raw.Vertex(..)
4547
#endif
4648
, present
4749

@@ -744,6 +746,24 @@ fillRectsF (Renderer r) rects = liftIO $
744746
SV.unsafeWith rects $ \rp ->
745747
Raw.renderFillRectsF r (castPtr rp) (fromIntegral (SV.length rects))
746748

749+
-- | Render a list of triangles, optionally using a texture and indices into the
750+
-- vertex array Color and alpha modulation is done per vertex
751+
-- (SDL_SetTextureColorMod and SDL_SetTextureAlphaMod are ignored).
752+
renderGeometry :: MonadIO m => Renderer -> Maybe Texture -> SV.Vector Raw.Vertex -> SV.Vector CInt -> m ()
753+
renderGeometry (Renderer r) mtexture vertices indices = liftIO $
754+
throwIfNeg_ "SDL.Video.renderGeometry" "SDL_RenderGeometry" $
755+
SV.unsafeWith vertices $ \vp ->
756+
SV.unsafeWith indices $ \ip ->
757+
Raw.renderGeometry r t vp (fromIntegral (SV.length vertices)) (ipOrNull ip) ipSize
758+
where
759+
t = case mtexture of
760+
Just (Texture found) -> found
761+
Nothing -> nullPtr
762+
763+
ipOrNull ip = if ipSize == 0 then nullPtr else ip
764+
765+
ipSize = fromIntegral (SV.length indices)
766+
747767
#endif
748768

749769

0 commit comments

Comments
 (0)