{-|
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX
-}
module Reanimate.Transition
  ( Transition
  , signalT
  , mapT
  , overlapT
  , chainT
  , effectT
  , fadeT
  ) where

import           Reanimate.Animation (Animation, dropA, duration, lastA, parA, pause, seqA, signalA,
                                      takeA)
import           Reanimate.Ease      (Signal)
import           Reanimate.Effect    (Effect, applyE, fadeInE, fadeOutE)

-- | A transition transforms one animation into another.
type Transition = Animation -> Animation -> Animation

-- | Apply a signal to the timing of a transition.
signalT :: Signal -> Transition -> Transition
signalT :: Signal -> Transition -> Transition
signalT = (Animation -> Animation) -> Transition -> Transition
mapT ((Animation -> Animation) -> Transition -> Transition)
-> (Signal -> Animation -> Animation)
-> Signal
-> Transition
-> Transition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal -> Animation -> Animation
signalA

-- | Map the result of a transition.
mapT :: (Animation -> Animation) -> Transition -> Transition
mapT :: (Animation -> Animation) -> Transition -> Transition
mapT Animation -> Animation
fn Transition
t Animation
a Animation
b = Animation -> Animation
fn (Transition
t Animation
a Animation
b)

-- | Apply transition only to @N@ seconds of the first
--   animation and to the last @N@ seconds of the second animation.
--
--   Example:
--
-- @
-- 'overlapT' 0.5 'fadeT' 'Reanimate.Builtin.Documentation.drawBox' 'Reanimate.Builtin.Documentation.drawCircle'
-- @
--
--   <<docs/gifs/doc_overlapT.gif>>
overlapT :: Double -> Transition -> Transition
overlapT :: Double -> Transition -> Transition
overlapT Double
overlap Transition
t Animation
a Animation
b =
    Animation
aBefore Transition
`seqA` Transition
t Animation
aOverlap Animation
bOverlap Transition
`seqA` Animation
bAfter
  where
    aBefore :: Animation
aBefore  = Double -> Animation -> Animation
takeA (Animation -> Double
duration Animation
a Double -> Signal
forall a. Num a => a -> a -> a
- Double
overlap) Animation
a
    aOverlap :: Animation
aOverlap = Double -> Animation -> Animation
lastA Double
overlap Animation
a
    bOverlap :: Animation
bOverlap = Double -> Animation -> Animation
takeA Double
overlap Animation
b
    bAfter :: Animation
bAfter   = Double -> Animation -> Animation
dropA Double
overlap Animation
b


-- | Create a transition between two animations by applying an effect to each respective animation.
effectT :: Effect -- ^ Effect to be applied to the first animation.
        -> Effect -- ^ Effect to be applied to the second animation.
        -> Transition
effectT :: Effect -> Effect -> Transition
effectT Effect
eA Effect
eB Animation
a Animation
b = Effect -> Animation -> Animation
applyE Effect
eA Animation
a Transition
`parA` Effect -> Animation -> Animation
applyE Effect
eB Animation
b

-- | Combine a list of animations using a given transition.
--
--   Example:
--
-- @
-- 'chainT' ('overlapT' 0.5 'fadeT') ['Reanimate.Builtin.Documentation.drawBox', 'Reanimate.Builtin.Documentation.drawCircle', 'Reanimate.Builtin.Documentation.drawProgress']
-- @
--
--   <<docs/gifs/doc_chainT.gif>>
chainT :: Transition -> [Animation] -> Animation
chainT :: Transition -> [Animation] -> Animation
chainT Transition
_ []     = Double -> Animation
pause Double
0
chainT Transition
t (Animation
x:[Animation]
xs) = Transition -> Animation -> [Animation] -> Animation
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Transition
t Animation
x [Animation]
xs

-- | Fade out left-hand-side animation while fading in right-hand-side animation.
--
--   Example:
--
-- @
-- 'Reanimate.Builtin.Documentation.drawBox' `'fadeT'` 'Reanimate.Builtin.Documentation.drawCircle'
-- @
--
--   <<docs/gifs/doc_fadeT.gif>>
fadeT :: Transition
fadeT :: Transition
fadeT = Effect -> Effect -> Transition
effectT Effect
fadeOutE Effect
fadeInE