Animate.hs

module NanoUI.Widgets.Animate
  ( Transition (..)
  , animate
  , animateTo
  , animateToA
  , pulse
  , keepAnimating
  )
where

import Control.Monad (when)
import Data.Maybe (isNothing)
import Effectful (Eff, type (:>))
import NanoUI.Animatable (Animatable (..))
import NanoUI.Animation (SpringParams)
import NanoUI.Context
  ( Ease (..)
  , approxEq
  , easeSameSpec
  , getAnimationValue
  , lookupAnimation
  , setAnimationValue
  , startAnimation
  , startAnimationEaseDelay
  , startSpring
  )
import NanoUI.Monad (Ui, askContext, nextId, scope, uiIO, uiTime, withKey)
import NanoUI.Widgets.Node (HasResponse, respId)

-- | How an animated value moves.
data Transition
  = -- | Eased tween: duration and start delay, in seconds.
    Tween !Ease !Float !Float
  | -- | Damped spring; retargets from its current position and velocity.
    Spring !SpringParams

-- | Animate from @from@ to @to@. It starts over from @from@ once it has
-- finished (a tween completes, a spring settles) or its tween changes, so
-- calling it every frame cycles.
animate :: Ui :> es => Transition -> Float -> Float -> Eff es Float
animate transition from to = do
  wid <- nextId
  ctx <- askContext
  uiIO $ do
    case transition of
      Tween ease dur delay -> startAnimationEaseDelay ctx wid from to dur ease delay
      Spring params -> do
        running <- lookupAnimation ctx wid
        when (isNothing running) (setAnimationValue ctx wid from)
        startSpring ctx wid params to
    getAnimationValue ctx wid

-- | Animate from the current value toward @target@. An unchanged target keeps
-- the running animation; a new one retargets from wherever the value is.
animateTo :: Ui :> es => Transition -> Float -> Eff es Float
animateTo transition target = do
  wid <- nextId
  ctx <- askContext
  uiIO $ do
    case transition of
      Tween ease dur delay -> do
        cur <- getAnimationValue ctx wid
        manim <- lookupAnimation ctx wid
        case manim of
          Just a | easeSameSpec a ease dur delay target -> pure ()
          Nothing | approxEq cur target -> pure ()
          _ -> startAnimationEaseDelay ctx wid cur target dur ease delay
      Spring params -> startSpring ctx wid params target
    getAnimationValue ctx wid

-- | 'animateTo' for every component of a composite value.
animateToA :: (Animatable a, Ui :> es) => Transition -> a -> Eff es a
animateToA transition = animateComponents (animateTo transition)

-- Component keys are local to one composite value, not its parent widget.
animateComponents ::
  (Animatable a, Ui :> es) => (Float -> Eff es Float) -> a -> Eff es a
animateComponents animateComponent target = scope $ do
  components <-
    mapM
      (\(index, value) -> withKey (index :: Int) (animateComponent value))
      (zip [0 ..] (toComponents target))
  pure (fromComponents components)

-- | A smoothly oscillating value in @[0,1]@ driven by the real-time clock, with
-- the given period in seconds (e.g. @pulse 6@ sweeps once every six seconds).
-- The time is captured in 'Double' (see 'NanoUI.Monad.uiTime'), so the sweep
-- stays sub-frame smooth even on long-running processes. The value is
-- re-evaluated each frame, like 'animate'.
pulse :: Ui :> es => Float -> Eff es Float
pulse periodSec = do
  t <- uiTime
  let
    period = max 0.001 (realToFrac periodSec :: Double)
  pure (realToFrac (0.5 + 0.5 * sin (2 * pi * t / period)) :: Float)

-- | Keep a widget animating indefinitely so the frame loop never idles. Widgets
-- driven by the wall clock ('pulse', or drawing from 'NanoUI.Monad.uiTime')
-- rather than by a frame-counted animation would otherwise stop repainting
-- once other animations settle.
--
-- > bar <- progressBar' =<< pulse 6
-- > keepAnimating bar
keepAnimating :: (HasResponse r, Ui :> es) => r -> Eff es ()
keepAnimating resp = do
  ctx <- askContext
  uiIO (startAnimation ctx (respId resp) 0 1 1e9)