--------------------------------------------------------------------------------
{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show)


--------------------------------------------------------------------------------
threadDelayDuration :: Duration -> IO ()
threadDelayDuration :: Duration -> IO ()
threadDelayDuration (Duration Double
seconds) =
    Int -> IO ()
threadDelay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
seconds forall a. Num a => a -> a -> a
* Double
1000 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransitionId -> TransitionId -> Bool
$c/= :: TransitionId -> TransitionId -> Bool
== :: TransitionId -> TransitionId -> Bool
$c== :: 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   <- forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
    let frames :: NonEmpty (Matrix, Duration)
frames = TransitionGen
tgen Size
size Matrix
matrix0 Matrix
matrix1 StdGen
rgen
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: Int
sRows = Size -> Int
sRows Size
termSize forall a. Num a => a -> a -> a
- Int
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 forall a. Eq a => a -> a -> Bool
/= TransitionInstance -> TransitionId
tiId TransitionInstance
trans = forall a. a -> Maybe a
Just TransitionInstance
trans
stepTransition TransitionId
_       TransitionInstance
trans                         = case TransitionInstance -> NonEmpty (Matrix, Duration)
tiFrames TransitionInstance
trans of
    (Matrix, Duration)
_ :| []     -> forall a. Maybe a
Nothing
    (Matrix, Duration)
_ :| (Matrix, Duration)
f : [(Matrix, Duration)]
fs -> forall a. a -> Maybe a
Just TransitionInstance
trans {tiFrames :: NonEmpty (Matrix, Duration)
tiFrames = (Matrix, Duration)
f forall a. a -> [a] -> NonEmpty a
:| [(Matrix, Duration)]
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 forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map Int -> (Double, Duration)
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  Maybe Double
mbDuration
    frameRate :: Int
frameRate = forall a. a -> Maybe a -> a
fromMaybe Int
24 Maybe Int
mbFrameRate

    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 -> (Double, Duration)
frame Int
idx = (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, Double -> Duration
Duration Double
delay)