{-# LANGUAGE MultiParamTypeClasses #-}
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
-- | This class modells that something can be rendered to another
-- thing.
class Renderable rend tex where
copyEx :: rend -- ^ rendering context
-> tex -- ^ texture
-> Maybe (SDL.Rectangle Int) -- ^ source rectangle
-> Maybe (SDL.Rectangle Int) -- ^ destination rectangle
-> Double -- ^ rotation
-> Maybe (Point V2 Int) -- ^ rotation center
-> V2 Bool -- ^ flipping
-> 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)