{-# 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 =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Double -> Matrix
frame forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Maybe Double -> Maybe Int -> NonEmpty (Double, Duration)
evenlySpacedFrames
(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)
(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)
where
noise :: V.Vector Double
noise :: Vector Double
noise = forall g a. RandomGen g => g -> (StateGenM g -> State g a) -> a
runStateGen_ StdGen
rgen forall a b. (a -> b) -> a -> b
$ \StateGenM StdGen
g ->
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (Int
rows forall a. Num a => a -> a -> a
* Int
cols) (forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Double
0, Double
1) StateGenM StdGen
g)
frame :: Double -> Matrix
frame :: Double -> Matrix
frame Double
t = 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 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)