module SDL.Data.Texture
( Renderable(..)
, Texture(..)
, Renderer(..)
)
where
import Control.Monad (void)
import Data.StateVar (StateVar)
import Data.Word (Word8)
import Foreign.C (CDouble(..))
import Linear.Affine (Point(..))
import Linear.V2 (V2(..))
import Linear.V3 (V3)
import Linear.V4 (V4)
import qualified SDL
class Renderable rend tex where
copyEx :: rend
-> tex
-> Maybe (SDL.Rectangle Int)
-> Maybe (SDL.Rectangle Int)
-> Double
-> Maybe (Point V2 Int)
-> V2 Bool
-> IO ()
createTexture :: rend
-> SDL.PixelFormat
-> SDL.TextureAccess
-> V2 Int
-> IO tex
rendererRenderTarget :: rend -> StateVar (Maybe tex)
instance Renderable SDL.Renderer SDL.Texture where
copyEx rend tex sourceRect destRect rot center flipping =
void $
SDL.copyEx rend tex (fmap fromIntegral <$> sourceRect)
(fmap fromIntegral <$> destRect) (CDouble rot)
(fmap fromIntegral <$> center) flipping
createTexture r pf ta = SDL.createTexture r pf ta . fmap fromIntegral
rendererRenderTarget = SDL.rendererRenderTarget
class Texture tex where
textureAlphaMod :: tex -> StateVar Word8
textureColorMod :: tex -> StateVar (V3 Word8)
textureBlendMode :: tex -> StateVar SDL.BlendMode
textureWidth :: tex -> IO Int
textureHeight :: tex -> IO Int
textureDims :: tex -> IO (V2 Int)
textureDims t =
V2 <$> textureWidth t <*> textureHeight t
destroyTexture :: tex -> IO ()
instance Texture SDL.Texture where
textureAlphaMod = SDL.textureAlphaMod
textureColorMod = SDL.textureColorMod
textureBlendMode = SDL.textureBlendMode
textureWidth = fmap (fromIntegral . SDL.textureWidth) . SDL.queryTexture
textureHeight = fmap (fromIntegral . SDL.textureHeight) . SDL.queryTexture
textureDims = fmap (\q -> fromIntegral <$>
V2 (SDL.textureWidth q) (SDL.textureHeight q)) .
SDL.queryTexture
destroyTexture = SDL.destroyTexture
class Renderer rend where
rendererDrawColor :: rend -> StateVar (V4 Word8)
clear :: rend -> IO ()
present :: rend -> IO ()
drawRect :: rend -> Maybe (SDL.Rectangle Int) -> IO ()
drawLine :: rend -> Point V2 Int -> Point V2 Int -> IO ()
instance Renderer SDL.Renderer where
rendererDrawColor = SDL.rendererDrawColor
clear = SDL.clear
present = SDL.present
drawRect r = SDL.drawRect r . fmap (fmap fromIntegral)
drawLine r a b = SDL.drawLine r (fromIntegral <$> a) (fromIntegral <$> b)