{-# 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)