-- |
--   Module:     Control.Varying.Tween
--   Copyright:  (c) 2016 Schell Scivally
--   License:    MIT
--   Maintainer: Schell Scivally <efsubenovex@gmail.com>
--
--   Tweening is a technique of generating intermediate samples of a type
--   __between__ a start and end value. By sampling a running tween
--   each frame we get a smooth animation of a value over time.
--
--   At first release `varying` is only capable of tweening numerical
--   values of type @(Fractional t, Ord t) => t@ that match the type of
--   time you use. At some point it would be great to be able to tween
--   arbitrary types, and possibly tween one type into another (pipe
--   dreams).

--
{-# LANGUAGE Rank2Types   #-}
module Control.Varying.Tween
  ( -- * Tweening types
    Easing
  , TweenT
  , Tween
    -- * Running tweens
  , runTweenT
  , scanTween
  , tweenStream
    -- * Creating tweens
    -- $creation
  , tween
  , tween_
  , constant
  , withTween
  , withTween_
    -- * Interpolation functions
    -- $lerping
  , linear
  , easeInCirc
  , easeOutCirc
  , easeInExpo
  , easeOutExpo
  , easeInSine
  , easeOutSine
  , easeInOutSine
  , easeInPow
  , easeOutPow
  , easeInCubic
  , easeOutCubic
  , easeInQuad
  , easeOutQuad
    -- * Writing your own tweens
    -- $writing
  ) where

import Control.Varying.Core
import Control.Varying.Event
import Control.Varying.Spline
import Control.Arrow
import Control.Applicative
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity

--------------------------------------------------------------------------------
-- $lerping
-- These pure functions take a `c` (total change in value, ie end - start),
-- `t` (percent of duration completion) and `b` (start value) and result in
-- and interpolation of a value. To see what these look like please check
-- out http://www.gizma.com/easing/.
--------------------------------------------------------------------------------
-- | Ease in quadratic.
easeInQuad :: (Num t, Fractional t, Real f) => Easing t f
easeInQuad c t b =  c * realToFrac (t*t) + b

-- | Ease out quadratic.
easeOutQuad :: (Num t, Fractional t, Real f) => Easing t f
easeOutQuad c t b =  (-c) * realToFrac (t * (t - 2)) + b

-- | Ease in cubic.
easeInCubic :: (Num t, Fractional t, Real f) => Easing t f
easeInCubic c t b =  c * realToFrac (t*t*t) + b

-- | Ease out cubic.
easeOutCubic :: (Num t, Fractional t, Real f) => Easing t f
easeOutCubic c t b =  let t' = realToFrac t - 1 in c * (t'*t'*t' + 1) + b

-- | Ease in by some power.
easeInPow :: (Num t, Fractional t, Real f) => Int -> Easing t f
easeInPow power c t b =  c * (realToFrac t^power) + b

-- | Ease out by some power.
easeOutPow :: (Num t, Fractional t, Real f) => Int -> Easing t f
easeOutPow power c t b =
    let t' = realToFrac t - 1
        c' = if power `mod` 2 == 1 then c else -c
        i  = if power `mod` 2 == 1 then 1 else -1
    in c' * ((t'^power) + i) + b

-- | Ease in sinusoidal.
easeInSine :: (Floating t, Real f) => Easing t f
easeInSine c t b =  let cos' = cos (realToFrac t * (pi / 2))
                               in -c * cos' + c + b

-- | Ease out sinusoidal.
easeOutSine :: (Floating t, Real f) => Easing t f
easeOutSine c t b =  let cos' = cos (realToFrac t * (pi / 2)) in c * cos' + b

-- | Ease in and out sinusoidal.
easeInOutSine :: (Floating t, Real f) => Easing t f
easeInOutSine c t b =  let cos' = cos (pi * realToFrac t)
                                  in (-c / 2) * (cos' - 1) + b

-- | Ease in exponential.
easeInExpo :: (Floating t, Real f) => Easing t f
easeInExpo c t b =  let e = 10 * (realToFrac t - 1) in c * (2**e) + b

-- | Ease out exponential.
easeOutExpo :: (Floating t, Real f) => Easing t f
easeOutExpo c t b =  let e = -10 * realToFrac t in c * (-(2**e) + 1) + b

-- | Ease in circular.
easeInCirc :: (Floating t, Real f, Floating f) => Easing t f
easeInCirc c t b = let s = realToFrac $ sqrt (1 - t*t) in -c * (s - 1) + b

-- | Ease out circular.
easeOutCirc :: (Floating t, Real f) => Easing t f
easeOutCirc c t b = let t' = (realToFrac t - 1)
                        s  = sqrt (1 - t'*t')
                    in c * s + b

-- | Ease linear.
linear :: (Floating t, Real f) => Easing t f
linear c t b = c * (realToFrac t) + b

type TweenT f t m = SplineT f t (StateT f m)
type Tween f t = TweenT f t Identity

runTweenT :: (Monad m, Num f)
          => TweenT f t m x -> f -> f -> m (Either x (t, TweenT f t m x), f)
runTweenT s dt = runStateT (runSplineT s dt)

scanTween :: (Functor m, Applicative m, Monad m, Num f)
          => TweenT f t m a -> t -> [f] -> m [t]
scanTween s t dts = evalStateT (scanSpline s t dts) 0

-- | Converts a tween into a continuous value stream. This is the tween version
-- of `outputStream`.
tweenStream :: (Applicative m, Monad m, Num f)
            => TweenT f t m x -> t -> VarT m f t
tweenStream s0 t0 = VarT $ f s0 t0 0
  where f s t l i = do (e, l1) <- runTweenT s i l
                       case e of
                         Left _ -> return (t, done t)
                         Right (b, s1) -> return (b, VarT $ f s1 b l1)
--------------------------------------------------------------------------------
-- $creation
-- The most direct route toward tweening values is to use 'tween'
-- along with an interpolation function such as 'easeInExpo'. For example,
-- @tween easeInExpo 0 100 10@, this will create a spline that produces a
-- number interpolated from 0 to 100 over 10 seconds. At the end of the
-- tween the spline will return the result value.
--------------------------------------------------------------------------------

-- | Creates a spline that produces a value interpolated between a start and
-- end value using an easing equation ('Easing') over a duration.  The
-- resulting spline will take a time delta as input.
-- Keep in mind `tween` must be fed time deltas, not absolute time or
-- duration. This is mentioned because the author has made that mistake
-- more than once ;)
--
-- `tween` concludes returning the latest output value.
tween :: (Applicative m, Monad m, Real f, Fractional f, Real t, Fractional t)
      => Easing t f -> t -> t -> f -> TweenT f t m t
tween f start end dur = SplineT g
  where c = end - start
        b = start
        g dt = do
          leftover <- get
          let t = dt + leftover

          if t == dur
            then do put 0
                    return $ Right (end, return end)
            else if t > dur
              then do put $ t - dur - dt
                      return $ Left end
              else do put t
                      return $ Right (f c (t/dur) b, SplineT g)

-- | A version of 'tween' that discards the result. It is simply
--
-- @
-- tween f a b c >> return ()
-- @
--
tween_ :: (Applicative m, Monad m, Real t, Fractional t, Real f, Fractional f)
       => Easing t f -> t -> t -> f -> TweenT f t m ()
tween_ f a b c = tween f a b c >> return ()

-- | A version of 'tween' that maps its output using the given constant
-- function.
-- @
-- withTween ease from to dur f = mapOutput (pure f) $ tween ease from to dur
-- @
withTween :: (Applicative m, Monad m, Real t, Fractional t, Real a, Fractional a)
          => Easing t a -> t -> t -> a -> (t -> x) -> TweenT a x m t
withTween ease from to dur f = mapOutput (pure f) $ tween ease from to dur

-- | A version of 'withTween' that discards its output.
withTween_ :: (Applicative m, Monad m, Real t, Fractional t, Real a, Fractional a)
           => Easing t a -> t -> t -> a -> (t -> x) -> TweenT a x m ()
withTween_ ease from to dur f = withTween ease from to dur f >> return ()

-- | Creates a tween that performs no interpolation over the duration.
constant :: (Applicative m, Monad m, Num t, Ord t)
         => a -> t -> TweenT t a m a
constant value duration = pure value `untilEvent_` after duration
--------------------------------------------------------------------------------
-- $writing
-- To create your own tweens just write a function that takes a start
-- value, end value and a duration and return an event stream.
--
-- @
-- tweenInOutExpo start end dur = do
--     (dt, x) <- tween easeInExpo start end (dur/2)
--     tween easeOutExpo x end $ dt + dur/2
-- @
--------------------------------------------------------------------------------
-- | An easing function. The parameters are often named `c`, `t` and `b`,
-- where `c` is the total change in value over the complete duration
-- (endValue - startValue), `t` is the current percentage (0 to 1) of the
-- duration that has elapsed and `b` is the start value.
--
-- To make things simple only numerical values can be tweened and the type
-- of time deltas much match the tween's value type. This may change in the
-- future :)
type Easing t f = t -> f -> t -> t