module Data.Component.AnimationLayer where

import Control.Lens
import Control.Monad.State
import Data.Aeson
import Linear
import MiniLight
import qualified Data.Component.Layer as Layer
import qualified SDL
import qualified SDL.Vect as Vect

data AnimationLayer = AnimationLayer {
  AnimationLayer -> Layer
layer :: Layer.Layer,
  AnimationLayer -> Int
counter :: Int,
  AnimationLayer -> V2 Int
tileSize :: Vect.V2 Int,
  AnimationLayer -> Config
config :: Config
}

instance ComponentUnit AnimationLayer where
  update :: AnimationLayer -> LightT env m AnimationLayer
update = StateT AnimationLayer (LightT env m) ()
-> AnimationLayer -> LightT env m AnimationLayer
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (StateT AnimationLayer (LightT env m) ()
 -> AnimationLayer -> LightT env m AnimationLayer)
-> StateT AnimationLayer (LightT env m) ()
-> AnimationLayer
-> LightT env m AnimationLayer
forall a b. (a -> b) -> a -> b
$ do
    (AnimationLayer -> AnimationLayer)
-> StateT AnimationLayer (LightT env m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AnimationLayer -> AnimationLayer)
 -> StateT AnimationLayer (LightT env m) ())
-> (AnimationLayer -> AnimationLayer)
-> StateT AnimationLayer (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ \c :: AnimationLayer
c -> AnimationLayer
c { counter :: Int
counter = (AnimationLayer -> Int
counter AnimationLayer
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) }
    (AnimationLayer -> AnimationLayer)
-> StateT AnimationLayer (LightT env m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AnimationLayer -> AnimationLayer)
 -> StateT AnimationLayer (LightT env m) ())
-> (AnimationLayer -> AnimationLayer)
-> StateT AnimationLayer (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ \c :: AnimationLayer
c -> AnimationLayer
c { counter :: Int
counter = if AnimationLayer -> Int
counter AnimationLayer
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Config -> V2 Int
division (AnimationLayer -> Config
config AnimationLayer
c) V2 Int -> Getting Int (V2 Int) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (V2 Int) Int
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Config -> V2 Int
division (AnimationLayer -> Config
config AnimationLayer
c) V2 Int -> Getting Int (V2 Int) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (V2 Int) Int
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Config -> Int
interval (AnimationLayer -> Config
config AnimationLayer
c) then 0 else AnimationLayer -> Int
counter AnimationLayer
c }

  figures :: AnimationLayer -> LightT env m [Figure]
figures comp :: AnimationLayer
comp = do
    let iv :: V2 Int
iv = Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 ((AnimationLayer -> Int
counter AnimationLayer
comp Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Config -> Int
interval (AnimationLayer -> Config
config AnimationLayer
comp)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Config -> V2 Int
division (AnimationLayer -> Config
config AnimationLayer
comp) V2 Int -> Getting Int (V2 Int) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (V2 Int) Int
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) ((AnimationLayer -> Int
counter AnimationLayer
comp Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Config -> Int
interval (AnimationLayer -> Config
config AnimationLayer
comp)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Config -> V2 Int
division (AnimationLayer -> Config
config AnimationLayer
comp) V2 Int -> Getting Int (V2 Int) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (V2 Int) Int
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)
    [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. Monad m => a -> m a
return [
      Rectangle Int -> Figure -> Figure
forall r (m :: * -> *). Rendering r m => Rectangle Int -> r -> r
clip (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 Int -> Point V2 Int
forall (f :: * -> *) a. f a -> Point f a
SDL.P (AnimationLayer -> V2 Int
tileSize AnimationLayer
comp V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
* V2 Int
iv)) (AnimationLayer -> V2 Int
tileSize AnimationLayer
comp)) (Figure -> Figure) -> Figure -> Figure
forall a b. (a -> b) -> a -> b
$ Layer -> Figure
Layer.layer (Layer -> Figure) -> Layer -> Figure
forall a b. (a -> b) -> a -> b
$ AnimationLayer -> Layer
layer AnimationLayer
comp
      ]

data Config = Config {
  Config -> Config
layerConf :: Layer.Config,
  Config -> V2 Int
division :: Vect.V2 Int,
  Config -> Int
interval :: Int
}

instance FromJSON Config where
  parseJSON :: Value -> Parser Config
parseJSON = String -> (Object -> Parser Config) -> Value -> Parser Config
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "config" ((Object -> Parser Config) -> Value -> Parser Config)
-> (Object -> Parser Config) -> Value -> Parser Config
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> do
    Config
conf <- Value -> Parser Config
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
    V2 Int
division <- (\v :: Object
v -> Int -> Int -> V2 Int
forall a. a -> a -> V2 a
Vect.V2 (Int -> Int -> V2 Int) -> Parser Int -> Parser (Int -> V2 Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "x" Parser (Int -> V2 Int) -> Parser Int -> Parser (V2 Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "y") (Object -> Parser (V2 Int)) -> Parser Object -> Parser (V2 Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: "division"
    Int
interval <- Object
v Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "interval" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= 30

    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 -> V2 Int -> Int -> Config
Config Config
conf V2 Int
division Int
interval

new :: Config -> MiniLight AnimationLayer
new :: Config -> MiniLight AnimationLayer
new conf :: Config
conf = do
  Layer
layer <- Config -> MiniLight Layer
Layer.new (Config -> Config
layerConf Config
conf)
  let size :: V2 Int
size = Figure -> V2 Int
getFigureSize (Layer -> Figure
Layer.layer Layer
layer)

  AnimationLayer -> MiniLight AnimationLayer
forall (m :: * -> *) a. Monad m => a -> m a
return (AnimationLayer -> MiniLight AnimationLayer)
-> AnimationLayer -> MiniLight AnimationLayer
forall a b. (a -> b) -> a -> b
$ $WAnimationLayer :: Layer -> Int -> V2 Int -> Config -> AnimationLayer
AnimationLayer
    { layer :: Layer
layer    = Layer
layer
    , counter :: Int
counter  = 0
    , tileSize :: V2 Int
tileSize = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int -> Int -> Int) -> V2 Int -> V2 (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 Int
size V2 (Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Config -> V2 Int
division Config
conf
    , config :: Config
config   = Config
conf
    }