{-# LANGUAGE TemplateHaskell #-}
module Patat.Transition.Dissolve
( transition
) where
import qualified Data.Aeson.Extended as A
import qualified Data.Aeson.TH.Extended as A
import Data.Bifunctor (first)
import qualified Data.Vector as V
import Patat.PrettyPrint.Matrix
import Patat.Size (Size (..))
import Patat.Transition.Internal
import System.Random.Stateful
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
noise :: V.Vector Double
noise :: Vector Double
noise = StdGen
-> (StateGenM StdGen -> State StdGen (Vector Double))
-> Vector Double
forall g a. RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ StdGen
rgen ((StateGenM StdGen -> State StdGen (Vector Double))
-> Vector Double)
-> (StateGenM StdGen -> State StdGen (Vector Double))
-> Vector Double
forall a b. (a -> b) -> a -> b
$ \StateGenM StdGen
g ->
Int
-> StateT StdGen Identity Double -> State StdGen (Vector Double)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols) ((Double, Double)
-> StateGenM StdGen -> StateT StdGen Identity Double
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *).
StatefulGen g m =>
(Double, Double) -> g -> m Double
uniformRM (Double
0, Double
1) StateGenM StdGen
g)
frame :: Double -> Matrix
frame :: Double -> Matrix
frame Double
t = (Double -> Cell -> Cell -> Cell)
-> Vector Double -> Matrix -> Matrix -> Matrix
forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
V.zipWith3
(\Double
treshold Cell
l Cell
r -> if Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
treshold then Cell
l else Cell
r)
Vector Double
noise
Matrix
initial
Matrix
final
$(A.deriveFromJSON A.dropPrefixOptions ''Config)