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