{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Imj.Graphics.Interpolation.Evolution
(
Evolution(..)
, mkEvolutionEaseQuart
, mkEvolution
, getDeltaTimeToNextFrame
, getValueAt
, drawMorphingAt
, EaseClock(..)
, mkEaseClock
) where
import GHC.Show(showString)
import Imj.Prelude
import Control.Monad.IO.Class(MonadIO)
import Control.Monad.Reader.Class(MonadReader)
import Imj.Graphics.Class.DiscreteInterpolation
import Imj.Graphics.Class.DiscreteMorphing
import Imj.Graphics.Math.Ease
import Imj.Iteration
{-# INLINABLE mkEvolutionEaseQuart #-}
mkEvolutionEaseQuart :: DiscreteDistance v
=> Successive v
-> Float
-> Evolution v
mkEvolutionEaseQuart = mkEvolution invQuartEaseInOut
{-# INLINABLE mkEvolution #-}
mkEvolution :: DiscreteDistance v
=> (Float -> Float)
-> Successive v
-> Float
-> Evolution v
mkEvolution ease s duration =
let nSteps = distanceSuccessive s
lastFrame = Frame $ pred nSteps
in Evolution s lastFrame duration (discreteAdaptor ease nSteps)
newtype EaseClock = EaseClock (Evolution NotWaypoint) deriving (Show)
newtype NotWaypoint = NotWaypoint () deriving(Show)
instance DiscreteDistance NotWaypoint where
distance = error "don't use distance on NotWaypoint"
mkEaseClock :: Float
-> Frame
-> (Float -> Float)
-> EaseClock
mkEaseClock duration lastFrame ease =
let nSteps = fromIntegral $ succ lastFrame
in EaseClock $ Evolution (Successive []) lastFrame duration (discreteAdaptor ease nSteps)
data Evolution v = Evolution {
_evolutionSuccessive :: !(Successive v)
, _evolutionLastFrame :: !Frame
, _evolutionDuration :: Float
, _evolutionInverseEase :: Float -> Float
}
instance (Show v) => Show (Evolution v) where
showsPrec _ (Evolution a b c _) = showString $ "Evolution{" ++ show a ++ show b ++ show c ++ "}"
getDeltaTimeToNextFrame :: Evolution v
-> Frame
-> Maybe Float
getDeltaTimeToNextFrame (Evolution _ lastFrame@(Frame lastStep) duration easeValToTime) frame@(Frame step)
| frame < 0 = error "negative frame"
| frame >= lastFrame = Nothing
| otherwise = Just dt
where
nextStep = succ step
thisValue = fromIntegral step / fromIntegral lastStep
targetValue = fromIntegral nextStep / fromIntegral lastStep
dt = duration * (easeValToTime targetValue - easeValToTime thisValue)
{-# INLINABLE getValueAt #-}
getValueAt :: DiscreteInterpolation v
=> Evolution v
-> Frame
-> v
getValueAt (Evolution s@(Successive l) lastFrame _ _) frame@(Frame step)
| frame <= 0 = head l
| frame >= lastFrame = last l
| otherwise = interpolateSuccessive s step
{-# INLINABLE drawMorphingAt #-}
drawMorphingAt :: (DiscreteMorphing v, Draw e, MonadReader e m, MonadIO m)
=> Evolution v
-> Frame
-> m ()
drawMorphingAt (Evolution s _ _ _) (Frame step) =
drawMorphingSuccessive s $ assert (step >= 0) step