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 :: forall (es :: [Effect]).
(Ui :> es) =>
Transition -> Float -> Float -> Eff es Float
animate Transition
transition Float
from Float
to = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  uiIO $ do
    case transition of
      Tween Ease
ease Float
dur Float
delay -> Context
-> WidgetId -> Float -> Float -> Float -> Ease -> Float -> IO ()
startAnimationEaseDelay Context
ctx WidgetId
wid Float
from Float
to Float
dur Ease
ease Float
delay
      Spring SpringParams
params -> do
        running <- Context -> WidgetId -> IO (Maybe Animation)
lookupAnimation Context
ctx WidgetId
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 :: forall (es :: [Effect]).
(Ui :> es) =>
Transition -> Float -> Eff es Float
animateTo Transition
transition Float
target = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  ctx <- askContext
  uiIO $ do
    case transition of
      Tween Ease
ease Float
dur Float
delay -> do
        cur <- Context -> WidgetId -> IO Float
getAnimationValue Context
ctx WidgetId
wid
        manim <- lookupAnimation ctx wid
        case manim of
          Just Animation
a | Animation -> Ease -> Float -> Float -> Float -> Bool
easeSameSpec Animation
a Ease
ease Float
dur Float
delay Float
target -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Maybe Animation
Nothing | Float -> Float -> Bool
approxEq Float
cur Float
target -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Maybe Animation
_ -> Context
-> WidgetId -> Float -> Float -> Float -> Ease -> Float -> IO ()
startAnimationEaseDelay Context
ctx WidgetId
wid Float
cur Float
target Float
dur Ease
ease Float
delay
      Spring SpringParams
params -> Context -> WidgetId -> SpringParams -> Float -> IO ()
startSpring Context
ctx WidgetId
wid SpringParams
params Float
target
    getAnimationValue ctx wid

-- | 'animateTo' for every component of a composite value.
animateToA :: (Animatable a, Ui :> es) => Transition -> a -> Eff es a
animateToA :: forall a (es :: [Effect]).
(Animatable a, Ui :> es) =>
Transition -> a -> Eff es a
animateToA Transition
transition = (Float -> Eff es Float) -> a -> Eff es a
forall a (es :: [Effect]).
(Animatable a, Ui :> es) =>
(Float -> Eff es Float) -> a -> Eff es a
animateComponents (Transition -> Float -> Eff es Float
forall (es :: [Effect]).
(Ui :> es) =>
Transition -> Float -> Eff es Float
animateTo Transition
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 :: forall a (es :: [Effect]).
(Animatable a, Ui :> es) =>
(Float -> Eff es Float) -> a -> Eff es a
animateComponents Float -> Eff es Float
animateComponent a
target = Eff es a -> Eff es a
forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
scope (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ do
  components <-
    ((Int, Float) -> Eff es Float) -> [(Int, Float)] -> Eff es [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
      (\(Int
index, Float
value) -> Int -> Eff es Float -> Eff es Float
forall k (es :: [Effect]) a.
(Hashable k, Ui :> es) =>
k -> Eff es a -> Eff es a
withKey (Int
index :: Int) (Float -> Eff es Float
animateComponent Float
value))
      ([Int] -> [Float] -> [(Int, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (a -> [Float]
forall a. Animatable a => a -> [Float]
toComponents a
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 :: forall (es :: [Effect]). (Ui :> es) => Float -> Eff es Float
pulse Float
periodSec = do
  t <- Eff es Double
forall (es :: [Effect]). (Ui :> es) => Eff es Double
uiTime
  let
    period = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0.001 (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
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 :: forall r (es :: [Effect]).
(HasResponse r, Ui :> es) =>
r -> Eff es ()
keepAnimating r
resp = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  uiIO (startAnimation ctx (respId resp) 0 1 1e9)