module Data.Component.Layer where

import Control.Lens
import Control.Lens.TH.Rules
import Control.Monad
import Data.Aeson
import Linear
import MiniLight
import qualified SDL
import qualified SDL.Vect as Vect
import qualified Data.Component.Basic as Basic

data Config = Config {
  Config -> Config
basic :: Basic.Config,
  Config -> FilePath
image :: FilePath
}

instance FromJSON Config where
  parseJSON :: Value -> Parser Config
parseJSON = (Config -> FilePath -> Parser Config)
-> (Object -> Parser FilePath) -> Value -> Parser Config
forall a r.
(Config -> a -> Parser r)
-> (Object -> Parser a) -> Value -> Parser r
Basic.wrapConfig (\b :: Config
b l :: FilePath
l -> Config -> Parser Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Parser Config) -> Config -> Parser Config
forall a b. (a -> b) -> a -> b
$ Config -> FilePath -> Config
Config Config
b FilePath
l) ((Object -> Parser FilePath) -> Value -> Parser Config)
-> (Object -> Parser FilePath) -> Value -> Parser Config
forall a b. (a -> b) -> a -> b
$ \v :: Object
v ->
    Object
v Object -> Text -> Parser FilePath
forall a. FromJSON a => Object -> Text -> Parser a
.: "image"

data Layer = Layer {
  Layer -> Figure
layer :: Figure,
  Layer -> Config
config :: Config
}

makeLensesWith lensRules_ ''Config
makeLensesWith lensRules_ ''Layer

instance Basic.HasConfig Config where
  config :: (Config -> f Config) -> Config -> f Config
config = (Config -> f Config) -> Config -> f Config
Lens' Config Config
_basic

instance ComponentUnit Layer where
  figures :: Layer -> LightT env m [Figure]
figures comp :: Layer
comp = [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Figure] -> LightT env m [Figure])
-> [Figure] -> LightT env m [Figure]
forall a b. (a -> b) -> a -> b
$ Config -> [Figure] -> [Figure]
Basic.wrapFigures (Config -> Config
basic (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Layer -> Config
config Layer
comp) [Layer -> Figure
layer Layer
comp]

  onSignal :: Event -> Layer -> LightT env m Layer
onSignal = Lens' Layer Config
-> (Event -> Layer -> LightT env m Layer)
-> Event
-> Layer
-> LightT env m Layer
forall env (m :: * -> *) c.
(HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m,
 ComponentUnit c) =>
Lens' c Config
-> (Event -> c -> LightT env m c) -> Event -> c -> LightT env m c
Basic.wrapSignal ((Config -> f Config) -> Layer -> f Layer
Lens' Layer Config
_config ((Config -> f Config) -> Layer -> f Layer)
-> ((Config -> f Config) -> Config -> f Config)
-> (Config -> f Config)
-> Layer
-> f Layer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> f Config) -> Config -> f Config
forall c. HasConfig c => Lens' c Config
Basic.config) (\_ -> Layer -> LightT env m Layer
forall (m :: * -> *) a. Monad m => a -> m a
return)

  useCache :: Layer -> Layer -> Bool
useCache _ _ = Bool
True

new :: Config -> MiniLight Layer
new :: Config -> MiniLight Layer
new conf :: Config
conf = do
  Figure
pic <- FilePath -> LightT LightEnv IO Figure
forall r (m :: * -> *). Rendering r m => FilePath -> m r
picture (Config -> FilePath
image Config
conf)

  Layer -> MiniLight Layer
forall (m :: * -> *) a. Monad m => a -> m a
return (Layer -> MiniLight Layer) -> Layer -> MiniLight Layer
forall a b. (a -> b) -> a -> b
$ $WLayer :: Figure -> Config -> Layer
Layer
    { layer :: Figure
layer  = Figure
pic
    , config :: Config
config = Config
conf { basic :: Config
basic = (Config -> Config
basic Config
conf) { size :: V2 Int
Basic.size = Figure -> V2 Int
getFigureSize Figure
pic } }
    }

newNineTile :: Config -> MiniLight Layer
newNineTile :: Config -> MiniLight Layer
newNineTile conf :: Config
conf = do
  Maybe Renderer
mrenderer <- Getting (Maybe Renderer) LightEnv (Maybe Renderer)
-> LightT LightEnv IO (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) LightEnv (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
  Maybe Texture
target    <- ((Renderer -> LightT LightEnv IO Texture)
 -> Maybe Renderer -> LightT LightEnv IO (Maybe Texture))
-> Maybe Renderer
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Renderer -> LightT LightEnv IO Texture)
-> Maybe Renderer -> LightT LightEnv IO (Maybe Texture)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe Renderer
mrenderer ((Renderer -> LightT LightEnv IO Texture)
 -> LightT LightEnv IO (Maybe Texture))
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ \renderer :: Renderer
renderer -> do
    Figure
pic <- FilePath -> LightT LightEnv IO Figure
forall r (m :: * -> *). Rendering r m => FilePath -> m r
picture (FilePath -> LightT LightEnv IO Figure)
-> FilePath -> LightT LightEnv IO Figure
forall a b. (a -> b) -> a -> b
$ Config -> FilePath
image Config
conf
    let siz :: V2 CInt
siz      = (Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum (V2 Int -> V2 CInt) -> V2 Int -> V2 CInt
forall a b. (a -> b) -> a -> b
$ Config -> V2 Int
Basic.size (Config -> V2 Int) -> Config -> V2 Int
forall a b. (a -> b) -> a -> b
$ Config -> Config
basic Config
conf
    let Just tex :: Texture
tex = Figure -> Maybe Texture
texture Figure
pic
    let texSize :: V2 CInt
texSize  = (Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum (V2 Int -> V2 CInt) -> V2 Int -> V2 CInt
forall a b. (a -> b) -> a -> b
$ Figure -> V2 Int
getFigureSize Figure
pic

    TextureInfo
tinfo  <- Texture -> LightT LightEnv IO TextureInfo
forall (m :: * -> *). MonadIO m => Texture -> m TextureInfo
SDL.queryTexture Texture
tex

    Texture
target <- Renderer
-> PixelFormat
-> TextureAccess
-> V2 CInt
-> LightT LightEnv IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> PixelFormat -> TextureAccess -> V2 CInt -> m Texture
SDL.createTexture Renderer
renderer
                                (TextureInfo -> PixelFormat
SDL.texturePixelFormat TextureInfo
tinfo)
                                TextureAccess
SDL.TextureAccessTarget
                                V2 CInt
siz
    Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
renderer StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
target
    Texture -> StateVar BlendMode
SDL.textureBlendMode Texture
target StateVar BlendMode -> BlendMode -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= BlendMode
SDL.BlendAlphaBlend

    let tileSize :: V2 CInt
tileSize = (CInt -> CInt) -> V2 CInt -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`div` 3) V2 CInt
texSize

    [CInt] -> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [0 .. 2] ((CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ())
-> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall a b. (a -> b) -> a -> b
$ \ix :: CInt
ix -> [CInt] -> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [0 .. 2] ((CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ())
-> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall a b. (a -> b) -> a -> b
$ \iy :: CInt
iy -> do
      let targetSize :: V2 CInt
targetSize = CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2
            (if CInt
ix CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 2 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x else V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)
            (if CInt
iy CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 2 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y else V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)
      let targetLoc :: V2 CInt
targetLoc = CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2
            ( if CInt
ix CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
              then 0
              else if CInt
ix CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                then V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x
                else V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x
            )
            ( if CInt
iy CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
              then 0
              else if CInt
iy CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                then V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y
                else V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y
            )

      Renderer
-> Texture
-> Maybe (Rectangle CInt)
-> Maybe (Rectangle CInt)
-> LightT LightEnv IO ()
forall (m :: * -> *).
MonadIO m =>
Renderer
-> Texture
-> Maybe (Rectangle CInt)
-> Maybe (Rectangle CInt)
-> m ()
SDL.copy
        Renderer
renderer
        Texture
tex
        (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just (Rectangle CInt -> Maybe (Rectangle CInt))
-> Rectangle CInt -> Maybe (Rectangle CInt)
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 CInt -> Point V2 CInt
forall (f :: * -> *) a. f a -> Point f a
SDL.P (V2 CInt
tileSize V2 CInt -> V2 CInt -> V2 CInt
forall a. Num a => a -> a -> a
* CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 CInt
ix CInt
iy)) V2 CInt
tileSize)
        (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just (Rectangle CInt -> Maybe (Rectangle CInt))
-> Rectangle CInt -> Maybe (Rectangle CInt)
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 CInt -> Point V2 CInt
forall (f :: * -> *) a. f a -> Point f a
SDL.P V2 CInt
targetLoc) V2 CInt
targetSize)

    Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
renderer StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Maybe Texture
forall a. Maybe a
Nothing

    Texture -> LightT LightEnv IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
target

  Figure
tex <- LightT LightEnv IO Figure
-> (Texture -> LightT LightEnv IO Figure)
-> Maybe Texture
-> LightT LightEnv IO Figure
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Figure -> LightT LightEnv IO Figure
forall (m :: * -> *) a. Monad m => a -> m a
return Figure
emptyFigure) Texture -> LightT LightEnv IO Figure
forall r (m :: * -> *). Rendering r m => Texture -> m r
fromTexture Maybe Texture
target
  Layer -> MiniLight Layer
forall (m :: * -> *) a. Monad m => a -> m a
return (Layer -> MiniLight Layer) -> Layer -> MiniLight Layer
forall a b. (a -> b) -> a -> b
$ $WLayer :: Figure -> Config -> Layer
Layer {layer :: Figure
layer = Figure
tex, config :: Config
config = Config
conf}