--------------------------------------------------------------------------------
{-# LANGUAGE GADTs #-}
module Patat.Transition.Internal
    ( Duration (..)
    , threadDelayDuration

    , Transition (..)
    , TransitionGen
    , TransitionId
    , TransitionInstance (..)
    , newTransition
    , stepTransition

    , evenlySpacedFrames
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent       (threadDelay)
import qualified Data.Aeson               as A
import           Data.List.NonEmpty       (NonEmpty ((:|)))
import           Data.Maybe               (fromMaybe)
import           Data.Unique              (Unique, newUnique)
import qualified Patat.PrettyPrint        as PP
import           Patat.PrettyPrint.Matrix
import           Patat.Size               (Size (..))
import           System.Random            (StdGen, newStdGen)


--------------------------------------------------------------------------------
newtype Duration = Duration Double  -- Duration in seconds
    deriving (Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Duration -> ShowS
showsPrec :: Int -> Duration -> ShowS
$cshow :: Duration -> String
show :: Duration -> String
$cshowList :: [Duration] -> ShowS
showList :: [Duration] -> ShowS
Show)


--------------------------------------------------------------------------------
threadDelayDuration :: Duration -> IO ()
threadDelayDuration :: Duration -> IO ()
threadDelayDuration (Duration Double
seconds) =
    Int -> IO ()
threadDelay (Int -> IO ()) -> (Double -> Int) -> Double -> IO ()
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 -> IO ()) -> Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Double
seconds Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000


--------------------------------------------------------------------------------
data Transition where
    Transition :: A.FromJSON conf => (conf -> TransitionGen) -> Transition


--------------------------------------------------------------------------------
type TransitionGen =
    Size -> Matrix -> Matrix -> StdGen -> NonEmpty (Matrix, Duration)


--------------------------------------------------------------------------------
newtype TransitionId = TransitionId Unique deriving (TransitionId -> TransitionId -> Bool
(TransitionId -> TransitionId -> Bool)
-> (TransitionId -> TransitionId -> Bool) -> Eq TransitionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransitionId -> TransitionId -> Bool
== :: TransitionId -> TransitionId -> Bool
$c/= :: TransitionId -> TransitionId -> Bool
/= :: TransitionId -> TransitionId -> Bool
Eq)


--------------------------------------------------------------------------------
data TransitionInstance = TransitionInstance
    { TransitionInstance -> TransitionId
tiId     :: TransitionId
    , TransitionInstance -> Size
tiSize   :: Size
    , TransitionInstance -> NonEmpty (Matrix, Duration)
tiFrames :: NonEmpty (Matrix, Duration)
    }


--------------------------------------------------------------------------------
newTransition
    :: TransitionGen -> Size -> PP.Doc -> PP.Doc -> IO TransitionInstance
newTransition :: TransitionGen -> Size -> Doc -> Doc -> IO TransitionInstance
newTransition TransitionGen
tgen Size
termSize Doc
frame0 Doc
frame1 = do
    Unique
unique <- IO Unique
newUnique
    StdGen
rgen   <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
    let frames :: NonEmpty (Matrix, Duration)
frames = TransitionGen
tgen Size
size Matrix
matrix0 Matrix
matrix1 StdGen
rgen
    TransitionInstance -> IO TransitionInstance
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransitionInstance -> IO TransitionInstance)
-> TransitionInstance -> IO TransitionInstance
forall a b. (a -> b) -> a -> b
$ TransitionId
-> Size -> NonEmpty (Matrix, Duration) -> TransitionInstance
TransitionInstance (Unique -> TransitionId
TransitionId Unique
unique) Size
size NonEmpty (Matrix, Duration)
frames
  where
    -- The actual part we want to animate does not cover the last row, which is
    -- always empty.
    size :: Size
size    = Size
termSize {sRows = sRows termSize - 1}
    matrix0 :: Matrix
matrix0 = Size -> Doc -> Matrix
docToMatrix Size
size Doc
frame0
    matrix1 :: Matrix
matrix1 = Size -> Doc -> Matrix
docToMatrix Size
size Doc
frame1


--------------------------------------------------------------------------------
stepTransition :: TransitionId -> TransitionInstance -> Maybe TransitionInstance
stepTransition :: TransitionId -> TransitionInstance -> Maybe TransitionInstance
stepTransition TransitionId
transId TransitionInstance
trans | TransitionId
transId TransitionId -> TransitionId -> Bool
forall a. Eq a => a -> a -> Bool
/= TransitionInstance -> TransitionId
tiId TransitionInstance
trans = TransitionInstance -> Maybe TransitionInstance
forall a. a -> Maybe a
Just TransitionInstance
trans
stepTransition TransitionId
_       TransitionInstance
trans                         = case TransitionInstance -> NonEmpty (Matrix, Duration)
tiFrames TransitionInstance
trans of
    (Matrix, Duration)
_ :| []     -> Maybe TransitionInstance
forall a. Maybe a
Nothing
    (Matrix, Duration)
_ :| (Matrix, Duration)
f : [(Matrix, Duration)]
fs -> TransitionInstance -> Maybe TransitionInstance
forall a. a -> Maybe a
Just TransitionInstance
trans {tiFrames = f :| fs}


--------------------------------------------------------------------------------
-- | Given an optional duration and frame rate, generate a sequence of evenly
-- spaced frames, represented by a number ranging from [0 .. 1].
evenlySpacedFrames
    :: Maybe Double -> Maybe Int -> NonEmpty (Double, Duration)
evenlySpacedFrames :: Maybe Double -> Maybe Int -> NonEmpty (Double, Duration)
evenlySpacedFrames Maybe Double
mbDuration Maybe Int
mbFrameRate =
    Int -> (Double, Duration)
frame Int
0 (Double, Duration)
-> [(Double, Duration)] -> NonEmpty (Double, Duration)
forall a. a -> [a] -> NonEmpty a
:| (Int -> (Double, Duration)) -> [Int] -> [(Double, Duration)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Double, Duration)
frame [Int
1 .. Int
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    duration :: Double
duration  = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1  Maybe Double
mbDuration
    frameRate :: Int
frameRate = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
24 Maybe Int
mbFrameRate

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

    frame :: Int -> (Double, Duration)
frame Int
idx = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frames, Double -> Duration
Duration Double
delay)