varying-0.7.1.0: app/Main.hs

module Main where

import           Control.Concurrent    (threadDelay)
import           Control.Varying
import           Data.Function         (fix)
import           Data.Functor.Identity (Identity (..))
import           Data.Time.Clock       (diffUTCTime, getCurrentTime)

-- | A simple 2d point type.
data Point = Point { px :: Float
                   , py :: Float
                   } deriving (Show, Eq)


-- | The duration (in seconds) to tween in each direction.
dur :: Float
dur = 3


-- | A novel, start-stop tween.
easeMiddle :: Monad m => Float -> Float -> Float -> TweenT Float Float m ()
easeMiddle start end t = do
  let change = end - start
  tween_ easeOutExpo start              (start + change/2) $ t/2
  tween_ easeInExpo  (start + change/2) end                $ t/2

-- An exponential tween back and forth from 0 to 50 over 1 seconds that
-- loops forever. This spline takes float values of delta time as input,
-- outputs the current x value at every step.
tweenx :: Monad m => TweenT Float Float m ()
tweenx = do
    -- Tween from 0 to 50 over 'dur' seconds
    easeMiddle 0 50 dur
    -- Chain another tween back to the starting position
    easeMiddle 50 0 dur
    -- Loop forever
    tweenx

-- A quadratic tween back and forth from 0 to 50 over 1 seconds that never
-- ends.
tweeny :: Monad m => TweenT Float Float m ()
tweeny = do
    easeMiddle 50 0 dur
    easeMiddle 0 50 dur
    tweeny

-- | Our Point value that varies over time continuously in x and y.
backAndForth :: Monad m => VarT m Float Point
backAndForth =
    -- Turn our splines into continuous output streams. We must provide
    -- a starting value since splines are not guaranteed to be defined at
    -- their edges.
    let x = tweenStream tweenx 0
        y = tweenStream tweeny 0
    in
    -- Construct a varying Point that takes time as an input.
    (Point <$> x <*> y)

main :: IO ()
main = do
  t <- getCurrentTime
  ($ t) . ($ backAndForth) $ fix $ \loop v lastT -> do
    thisT <- getCurrentTime
    -- Here we'll run in the Identity monad using a time delta provided by
    -- getCurrentTime and diffUTCTime.
    let dt = realToFrac $ diffUTCTime thisT lastT
        Identity (Point x y, vNext) = runVarT v dt
        xStr = replicate (round x) ' ' ++ "x" ++ replicate (50 - round x) ' '
        yStr = replicate (round y) ' ' ++ "y" ++ replicate (50 - round y) ' '
        str  = zipWith f xStr yStr
        f 'x' 'y' = '|'
        f 'y' 'x' = '|'
        f a ' '   = a
        f ' ' b   = b
        f _ _     = ' '
    putStrLn str
    threadDelay $ floor $ 1000000 / (20 :: Double)
    loop vNext thisT