--------------------------------------------------------------------------------
{-# LANGUAGE TemplateHaskell #-}
module Patat.Transition.SlideLeft
    ( slideLeft
    ) where


--------------------------------------------------------------------------------
import qualified Data.Aeson.Extended       as A
import qualified Data.Aeson.TH.Extended    as A
import           Data.Foldable             (for_)
import           Data.List.NonEmpty        (NonEmpty ((:|)))
import           Data.Maybe                (fromMaybe)
import qualified Data.Vector               as V
import qualified Data.Vector.Mutable       as VM
import           Patat.PrettyPrint.Matrix
import           Patat.Size                (Size (..))
import           Patat.Transition.Internal


--------------------------------------------------------------------------------
data Config = Config
    { Config -> Maybe (FlexibleNum Double)
cDuration  :: Maybe (A.FlexibleNum Double)
    , Config -> Maybe (FlexibleNum Int)
cFrameRate :: Maybe (A.FlexibleNum Int)
    }


--------------------------------------------------------------------------------
slideLeft :: Config -> TransitionGen
slideLeft :: Config -> TransitionGen
slideLeft Config
config (Size Int
rows Int
cols) Matrix
initial Matrix
final StdGen
_rgen =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Matrix
f -> (Matrix
f, Double -> Duration
Duration Double
delay)) forall a b. (a -> b) -> a -> b
$
    Int -> Matrix
frame Int
0 forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map Int -> Matrix
frame [Int
1 .. Int
frames forall a. Num a => a -> a -> a
- Int
1]
  where
    duration :: Double
duration  = forall a. a -> Maybe a -> a
fromMaybe Double
1  forall a b. (a -> b) -> a -> b
$ forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe (FlexibleNum Double)
cDuration  Config
config
    frameRate :: Int
frameRate = forall a. a -> Maybe a -> a
fromMaybe Int
24 forall a b. (a -> b) -> a -> b
$ forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe (FlexibleNum Int)
cFrameRate Config
config

    frames :: Int
frames = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
duration forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frameRate :: Int
    delay :: Double
delay  = Double
duration forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
frames forall a. Num a => a -> a -> a
+ Int
1)

    frame :: Int -> Matrix
    frame :: Int -> Matrix
frame Int
idx = forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create forall a b. (a -> b) -> a -> b
$ do
        MVector s Cell
ini <- forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Matrix
initial
        MVector s Cell
fin <- forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Matrix
final
        MVector s Cell
mat <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
VM.replicate (Int
rows forall a. Num a => a -> a -> a
* Int
cols) Cell
emptyCell
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
rows forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
y -> do
            forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
VM.copy
                (forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y forall a. Num a => a -> a -> a
* Int
cols) (Int
cols forall a. Num a => a -> a -> a
- Int
offset) MVector s Cell
mat)
                (forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y forall a. Num a => a -> a -> a
* Int
cols forall a. Num a => a -> a -> a
+ Int
offset) (Int
cols forall a. Num a => a -> a -> a
- Int
offset) MVector s Cell
ini)
            forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
VM.copy
                (forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y forall a. Num a => a -> a -> a
* Int
cols forall a. Num a => a -> a -> a
+ Int
cols forall a. Num a => a -> a -> a
- Int
offset) Int
offset MVector s Cell
mat)
                (forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y forall a. Num a => a -> a -> a
* Int
cols) Int
offset MVector s Cell
fin)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Cell
mat
      where
        offset :: Int
offset = forall a. Ord a => a -> a -> a
max Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Int
cols forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
round :: Double -> Int) forall a b. (a -> b) -> a -> b
$
            forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
idx forall a. Num a => a -> a -> a
+ Int
1) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frames forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols


--------------------------------------------------------------------------------
$(A.deriveFromJSON A.dropPrefixOptions ''Config)