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


--------------------------------------------------------------------------------
import qualified Data.Aeson.Extended       as A
import qualified Data.Aeson.TH.Extended    as A
import           Data.Bifunctor            (first)
import           Data.Foldable             (for_)
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)
    }


--------------------------------------------------------------------------------
transition :: Config -> TransitionGen
transition :: Config -> TransitionGen
transition Config
config (Size Int
rows Int
cols) Matrix
initial Matrix
final StdGen
_rgen =
    (Double -> Matrix) -> (Double, Duration) -> (Matrix, Duration)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Double -> Matrix
frame ((Double, Duration) -> (Matrix, Duration))
-> NonEmpty (Double, Duration) -> NonEmpty (Matrix, Duration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe Double -> Maybe Int -> NonEmpty (Double, Duration)
evenlySpacedFrames
        (FlexibleNum Double -> Double
forall a. FlexibleNum a -> a
A.unFlexibleNum (FlexibleNum Double -> Double)
-> Maybe (FlexibleNum Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe (FlexibleNum Double)
cDuration  Config
config)
        (FlexibleNum Int -> Int
forall a. FlexibleNum a -> a
A.unFlexibleNum (FlexibleNum Int -> Int) -> Maybe (FlexibleNum Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe (FlexibleNum Int)
cFrameRate Config
config)
  where
    frame :: Double -> Matrix
    frame :: Double -> Matrix
frame Double
t = (forall s. ST s (MVector s Cell)) -> Matrix
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s Cell)) -> Matrix)
-> (forall s. ST s (MVector s Cell)) -> Matrix
forall a b. (a -> b) -> a -> b
$ do
        MVector s Cell
ini <- Matrix -> ST s (MVector (PrimState (ST s)) Cell)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Matrix
initial
        MVector s Cell
fin <- Matrix -> ST s (MVector (PrimState (ST s)) Cell)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Matrix
final
        MVector s Cell
mat <- Int -> Cell -> ST s (MVector (PrimState (ST s)) Cell)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
VM.replicate (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols) Cell
emptyCell
        [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
y -> do
            MVector (PrimState (ST s)) Cell
-> MVector (PrimState (ST s)) Cell -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
VM.copy
                (Int -> Int -> MVector s Cell -> MVector s Cell
forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols) (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) MVector s Cell
mat)
                (Int -> Int -> MVector s Cell -> MVector s Cell
forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) MVector s Cell
ini)
            MVector (PrimState (ST s)) Cell
-> MVector (PrimState (ST s)) Cell -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
VM.copy
                (Int -> Int -> MVector s Cell -> MVector s Cell
forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) Int
offset MVector s Cell
mat)
                (Int -> Int -> MVector s Cell -> MVector s Cell
forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols) Int
offset MVector s Cell
fin)
        MVector s Cell -> ST s (MVector s Cell)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Cell
mat
      where
        offset :: Int
offset = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
cols (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round :: Double -> Int) (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$
            Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols


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