Layer.hs

module MiniLight.Component.Layer where

import Control.Monad
import Data.Aeson
import Lens.Micro
import Lens.Micro.Mtl
import Linear
import MiniLight.Component.Types
import MiniLight.Light
import MiniLight.Figure
import qualified SDL
import qualified SDL.Vect as Vect

data Layer = Layer {
  layer :: Figure
}

instance ComponentUnit Layer where
  figures comp = return [layer comp]

data Config = Config {
  image :: FilePath,
  size :: Vect.V2 Int,
  position :: Vect.V2 Int
}

instance FromJSON Config where
  parseJSON = withObject "config" $ \v -> do
    image <- v .: "image"
    size <- withObject "size" (\v -> Vect.V2 <$> v .: "width" <*> v .: "height") =<< v .: "size"

    positionMaybe <- v .:? "position"
    position <- maybe (return 0) (withObject "position" (\v -> Vect.V2 <$> v .: "x" <*> v .: "y")) positionMaybe

    return $ Config image size position

new :: Config -> MiniLight Layer
new conf = do
  pic <- picture (image conf)
  return $ Layer {layer = pic}

newNineTile :: Config -> MiniLight Layer
newNineTile conf = do
  pic <- picture $ image conf
  let siz     = fmap toEnum $ size conf
  let tex     = texture pic
  let texSize = fmap toEnum $ getFigureSize pic

  tinfo    <- SDL.queryTexture tex
  renderer <- view rendererL

  target   <- SDL.createTexture renderer
                                (SDL.texturePixelFormat tinfo)
                                SDL.TextureAccessTarget
                                siz
  SDL.rendererRenderTarget renderer SDL.$= Just target
  SDL.textureBlendMode target SDL.$= SDL.BlendAlphaBlend

  let tileSize = fmap (`div` 3) texSize

  forM_ [0 .. 2] $ \ix -> forM_ [0 .. 2] $ \iy -> do
    let targetSize = V2
          (if ix == 1 then siz ^. _x - 2 * tileSize ^. _x else tileSize ^. _x)
          (if iy == 1 then siz ^. _y - 2 * tileSize ^. _y else tileSize ^. _y)
    let targetLoc = V2
          ( if ix == 0
            then 0
            else if ix == 1 then tileSize ^. _x else siz ^. _x - tileSize ^. _x
          )
          ( if iy == 0
            then 0
            else if iy == 1 then tileSize ^. _y else siz ^. _y - tileSize ^. _y
          )

    SDL.copy
      renderer
      tex
      (Just $ SDL.Rectangle (SDL.P (tileSize * Vect.V2 ix iy)) tileSize)
      (Just $ SDL.Rectangle (SDL.P targetLoc) targetSize)

  SDL.rendererRenderTarget renderer SDL.$= Nothing

  tex <- fromTexture target
  return $ Layer {layer = tex}