{-# Language Arrows #-}
module YampaSDL2.Animation
(
animate
, animateNumber
, animateV2
, animateColour
, linear
, easeIn
, easeOut
) where
import FRP.Yampa
import Linear.V2
import Data.Maybe
import FRP.Yampa.Event
import Data.List
import Data.Colour
type Curve = Double -> Extent
type Extent = Double
type Duration = Double
animate ::
(a -> a -> Extent -> a)
-> a
-> [(Duration, Curve,a)]
-> SF () a
animate _ a [] = constant a
animate f aB ((dur,curve,aE):rest) = switch (sf aB f dur) (cont f rest)
where sf propertyB animateF duration = proc _ -> do
currentRS <- f aB aE ^<< (boundExtent curve) ^<< (/duration) ^<< time -< ()
event <- after duration () -< ()
returnA -< (currentRS,tag event currentRS)
cont f rest propertyB = animate f propertyB rest
animateNumber :: Double -> Double -> Extent -> Double
animateNumber beginning end e = beginning + (end - beginning) * e
animateV2 :: V2 Double -> V2 Double -> Extent -> V2 Double
animateV2 beginning end e = beginning + (end - beginning)*V2 e e
animateColour :: AlphaColour Double -> AlphaColour Double -> Extent -> AlphaColour Double
animateColour beginning end e = blend e end beginning
linear = id
easeIn x = x*x
easeOut x = 1-(x-1)^2
boundExtent :: Curve -> Double -> Double
boundExtent f time
| f time < 0 = 0
| f time > 1 = 1
| otherwise = f time