module NanoUI.Animation
  ( Ease (..)
  , Animation (..)
  , SpringParams (..)
  , presetBouncy
  , presetSmooth
  , presetStiff
  , springEps
  , applyEase
  , approxEq
  , animInProgress
  , animationValue
  , easeSameSpec
  , stepAnim
  , writeRest
  ) where

import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import NanoUI.Types (clamp01)

-- Cubic Bezier easing. X control points are clamped to [0, 1] (CSS-style).
-- t=0 and t=1 return the endpoints so Newton cannot pop the first/last frame.
evaluateBezier :: Float -> Float -> Float -> Float -> Float -> Float
evaluateBezier :: Float -> Float -> Float -> Float -> Float -> Float
evaluateBezier Float
x1 Float
y1 Float
x2 Float
y2 Float
t0
  | Float
t0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = Float
0
  | Float
t0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
1 = Float
1
  | Bool
otherwise =
      let p1 :: Float
p1 = Float -> Float
clamp01 Float
x1
          p2 :: Float
p2 = Float -> Float
clamp01 Float
x2
          tau :: Float
tau = Float -> Float -> Float -> Float -> Int -> Float
solveBezierX Float
p1 Float
p2 Float
t0 Float
0.5 Int
0
       in Float -> Float -> Float -> Float
sampleBezier Float
y1 Float
y2 Float
tau

sampleBezier :: Float -> Float -> Float -> Float
sampleBezier :: Float -> Float -> Float -> Float
sampleBezier Float
p1 Float
p2 Float
u =
  let one :: Float
one = Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
u
   in Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
one Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
one Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
p1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
one Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
p2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u

bezierDeriv :: Float -> Float -> Float -> Float
bezierDeriv :: Float -> Float -> Float -> Float
bezierDeriv Float
p1 Float
p2 Float
u =
  let one :: Float
one = Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
u
   in Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
one Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
one Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
p1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
6 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
one Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
p2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
p1) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
p2)

solveBezierX :: Float -> Float -> Float -> Float -> Int -> Float
solveBezierX :: Float -> Float -> Float -> Float -> Int -> Float
solveBezierX Float
p1 Float
p2 Float
targetT Float
estimate Int
iter
  | Int
iter Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 = Float
estimate
  | Bool
otherwise =
      let currentX :: Float
currentX = Float -> Float -> Float -> Float
sampleBezier Float
p1 Float
p2 Float
estimate
          errorVal :: Float
errorVal = Float
currentX Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
targetT
       in if Float -> Float
forall a. Num a => a -> a
abs Float
errorVal Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1e-4
            then Float
estimate
            else
              let deriv :: Float
deriv = Float -> Float -> Float -> Float
bezierDeriv Float
p1 Float
p2 Float
estimate
                  safeDeriv :: Float
safeDeriv =
                    if Float -> Float
forall a. Num a => a -> a
abs Float
deriv Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1e-6
                      then if Float
deriv Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 then Float
1e-6 else -Float
1e-6
                      else Float
deriv
                  nextEst :: Float
nextEst = Float -> Float
clamp01 (Float
estimate Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
errorVal Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
safeDeriv)
               in Float -> Float -> Float -> Float -> Int -> Float
solveBezierX Float
p1 Float
p2 Float
targetT Float
nextEst (Int
iter Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

data SpringParams = SpringParams
  { SpringParams -> Float
springStiffness :: {-# UNPACK #-} !Float
  , SpringParams -> Float
springDamping :: {-# UNPACK #-} !Float
  , SpringParams -> Float
springMass :: {-# UNPACK #-} !Float
  }
  deriving (SpringParams -> SpringParams -> Bool
(SpringParams -> SpringParams -> Bool)
-> (SpringParams -> SpringParams -> Bool) -> Eq SpringParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpringParams -> SpringParams -> Bool
== :: SpringParams -> SpringParams -> Bool
$c/= :: SpringParams -> SpringParams -> Bool
/= :: SpringParams -> SpringParams -> Bool
Eq, Int -> SpringParams -> ShowS
[SpringParams] -> ShowS
SpringParams -> String
(Int -> SpringParams -> ShowS)
-> (SpringParams -> String)
-> ([SpringParams] -> ShowS)
-> Show SpringParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpringParams -> ShowS
showsPrec :: Int -> SpringParams -> ShowS
$cshow :: SpringParams -> String
show :: SpringParams -> String
$cshowList :: [SpringParams] -> ShowS
showList :: [SpringParams] -> ShowS
Show)

presetBouncy :: SpringParams
presetBouncy :: SpringParams
presetBouncy = SpringParams {springStiffness :: Float
springStiffness = Float
180, springDamping :: Float
springDamping = Float
12, springMass :: Float
springMass = Float
1}

presetSmooth :: SpringParams
presetSmooth :: SpringParams
presetSmooth = SpringParams {springStiffness :: Float
springStiffness = Float
120, springDamping :: Float
springDamping = Float
20, springMass :: Float
springMass = Float
1}

presetStiff :: SpringParams
presetStiff :: SpringParams
presetStiff = SpringParams {springStiffness :: Float
springStiffness = Float
300, springDamping :: Float
springDamping = Float
30, springMass :: Float
springMass = Float
1}

springEps :: Float
springEps :: Float
springEps = Float
1e-3

maxSubstep :: Float
maxSubstep :: Float
maxSubstep = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
30

maxSubsteps :: Int
maxSubsteps :: Int
maxSubsteps = Int
32

stepSpring :: SpringParams -> Float -> Float -> Float -> Float -> (Float, Float)
stepSpring :: SpringParams -> Float -> Float -> Float -> Float -> (Float, Float)
stepSpring SpringParams
params Float
x Float
v Float
target Float
dt
  | Float
dt Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = (Float
x, Float
v)
  | Bool
otherwise = Float -> Float -> Float -> Int -> (Float, Float)
go Float
x Float
v Float
dt Int
0
  where
    go :: Float -> Float -> Float -> Int -> (Float, Float)
go !Float
pos !Float
vel Float
remain Int
n
      | Float
remain Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1e-8 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxSubsteps = (Float
pos, Float
vel)
      | Bool
otherwise =
          let h :: Float
h = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
maxSubstep Float
remain
              (Float
pos', Float
vel') = SpringParams -> Float -> Float -> Float -> Float -> (Float, Float)
rk4 SpringParams
params Float
pos Float
vel Float
target Float
h
           in Float -> Float -> Float -> Int -> (Float, Float)
go Float
pos' Float
vel' (Float
remain Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
h) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

rk4 :: SpringParams -> Float -> Float -> Float -> Float -> (Float, Float)
rk4 :: SpringParams -> Float -> Float -> Float -> Float -> (Float, Float)
rk4 SpringParams
params Float
x Float
v Float
xTarget Float
dt =
  let k1v :: Float
k1v = Float -> Float -> Float
accel Float
x Float
v
      k1x :: Float
k1x = Float
v
      k2v :: Float
k2v = Float -> Float -> Float
accel (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k1x) (Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k1v)
      k2x :: Float
k2x = Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k1v
      k3v :: Float
k3v = Float -> Float -> Float
accel (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k2x) (Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k2v)
      k3x :: Float
k3x = Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k2v
      k4v :: Float
k4v = Float -> Float -> Float
accel (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k3x) (Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k3v)
      k4x :: Float
k4x = Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dt Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k3v
      xNext :: Float
xNext = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
dt Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
6) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
k1x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k2x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k3x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
k4x)
      vNext :: Float
vNext = Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
dt Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
6) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
k1v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k2v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
k3v Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
k4v)
   in (Float
xNext, Float
vNext)
  where
    k :: Float
k = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (SpringParams -> Float
springStiffness SpringParams
params)
    c :: Float
c = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (SpringParams -> Float
springDamping SpringParams
params)
    m :: Float
m = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1e-6 (SpringParams -> Float
springMass SpringParams
params)
    accel :: Float -> Float -> Float
accel Float
pos Float
vel = (-Float
k Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
pos Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
xTarget) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
vel) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m

data Ease
  = EaseLinear
  | EaseInQuad
  | EaseOutQuad
  | EaseInOutQuad
  | EaseInCubic
  | EaseOutCubic
  | EaseInOutCubic
  | EaseOutBack
  | EaseCubicBezier
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
  deriving (Ease -> Ease -> Bool
(Ease -> Ease -> Bool) -> (Ease -> Ease -> Bool) -> Eq Ease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ease -> Ease -> Bool
== :: Ease -> Ease -> Bool
$c/= :: Ease -> Ease -> Bool
/= :: Ease -> Ease -> Bool
Eq, Int -> Ease -> ShowS
[Ease] -> ShowS
Ease -> String
(Int -> Ease -> ShowS)
-> (Ease -> String) -> ([Ease] -> ShowS) -> Show Ease
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ease -> ShowS
showsPrec :: Int -> Ease -> ShowS
$cshow :: Ease -> String
show :: Ease -> String
$cshowList :: [Ease] -> ShowS
showList :: [Ease] -> ShowS
Show)

-- EaseAnim start end duration elapsed ease delay delayReq
-- SpringAnim pos vel target params
data Animation
  = EaseAnim
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
      !Ease
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
  | SpringAnim
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
      {-# UNPACK #-} !Float
      !SpringParams
  deriving (Animation -> Animation -> Bool
(Animation -> Animation -> Bool)
-> (Animation -> Animation -> Bool) -> Eq Animation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Animation -> Animation -> Bool
== :: Animation -> Animation -> Bool
$c/= :: Animation -> Animation -> Bool
/= :: Animation -> Animation -> Bool
Eq, Int -> Animation -> ShowS
[Animation] -> ShowS
Animation -> String
(Int -> Animation -> ShowS)
-> (Animation -> String)
-> ([Animation] -> ShowS)
-> Show Animation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Animation -> ShowS
showsPrec :: Int -> Animation -> ShowS
$cshow :: Animation -> String
show :: Animation -> String
$cshowList :: [Animation] -> ShowS
showList :: [Animation] -> ShowS
Show)

-- True when this ease slot matches the call-site spec and target.
easeSameSpec :: Animation -> Ease -> Float -> Float -> Float -> Bool
easeSameSpec :: Animation -> Ease -> Float -> Float -> Float -> Bool
easeSameSpec (EaseAnim Float
_ Float
end Float
dur Float
_ Ease
ease Float
_ Float
delayReq) Ease
wantEase Float
wantDur Float
delay Float
target =
  Ease
ease Ease -> Ease -> Bool
forall a. Eq a => a -> a -> Bool
== Ease
wantEase
    Bool -> Bool -> Bool
&& Float -> Float -> Bool
approxEq Float
dur Float
wantDur
    Bool -> Bool -> Bool
&& Float -> Float -> Bool
approxEq Float
delay Float
delayReq
    Bool -> Bool -> Bool
&& Float -> Float -> Bool
approxEq Float
end Float
target
easeSameSpec Animation
_ Ease
_ Float
_ Float
_ Float
_ = Bool
False

-- Map unit progress through an easing curve. Input is clamped to [0, 1].
-- EaseOutBack may return a value outside that range (overshoot).
applyEase :: Ease -> Float -> Float
applyEase :: Ease -> Float -> Float
applyEase Ease
ease Float
t0 =
  let t :: Float
t = Float -> Float
clamp01 Float
t0
   in case Ease
ease of
        Ease
EaseLinear -> Float
t
        Ease
EaseInQuad -> Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
        Ease
EaseOutQuad -> Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t)
        Ease
EaseInOutQuad
          | Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.5 -> Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
          | Bool
otherwise -> -Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
4 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
        Ease
EaseInCubic -> Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
        Ease
EaseOutCubic ->
          let u :: Float
u = Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t
           in Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u
        Ease
EaseInOutCubic
          | Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.5 -> Float
4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
          | Bool
otherwise ->
              let u :: Float
u = -Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2
               in Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        Ease
EaseOutBack ->
          let c1 :: Float
c1 = Float
1.70158
              c3 :: Float
c3 = Float
c1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1
              u :: Float
u = Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1
           in Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u
        EaseCubicBezier Float
x1 Float
y1 Float
x2 Float
y2 -> Float -> Float -> Float -> Float -> Float -> Float
evaluateBezier Float
x1 Float
y1 Float
x2 Float
y2 Float
t

approxEq :: Float -> Float -> Bool
approxEq :: Float -> Float -> Bool
approxEq Float
a Float
b = Float -> Float
forall a. Num a => a -> a
abs (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1e-4

{-# INLINE animInProgress #-}
animInProgress :: Animation -> Bool
animInProgress :: Animation -> Bool
animInProgress (EaseAnim Float
start Float
end Float
dur Float
elapsed Ease
_ Float
delay Float
_) =
  Bool -> Bool
not (Float -> Float -> Bool
approxEq Float
start Float
end)
    Bool -> Bool -> Bool
&& Float
dur Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
    Bool -> Bool -> Bool
&& (Float
delay Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
|| Float
elapsed Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
dur)
animInProgress (SpringAnim Float
pos Float
vel Float
target SpringParams
_) =
  Float -> Float
forall a. Num a => a -> a
abs (Float
pos Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
target) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
springEps Bool -> Bool -> Bool
|| Float -> Float
forall a. Num a => a -> a
abs Float
vel Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
springEps

{-# INLINE animationValue #-}
animationValue :: Animation -> Float
animationValue :: Animation -> Float
animationValue a :: Animation
a@(EaseAnim Float
start Float
end Float
dur Float
elapsed Ease
ease Float
delay Float
_)
  | Bool -> Bool
not (Animation -> Bool
animInProgress Animation
a) = Float
end
  | Float
delay Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 = Float
start
  | Bool
otherwise =
      let t :: Float
t = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 (Float
elapsed Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0.001 Float
dur)
       in Float
start Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
end Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
start) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Ease -> Float -> Float
applyEase Ease
ease Float
t
animationValue (SpringAnim Float
pos Float
_ Float
_ SpringParams
_) = Float
pos

stepAnim :: Float -> Animation -> Animation
stepAnim :: Float -> Animation -> Animation
stepAnim Float
dt a :: Animation
a@(EaseAnim Float
start Float
end Float
dur Float
elapsed Ease
ease Float
delay Float
delayReq)
  | Bool -> Bool
not (Animation -> Bool
animInProgress Animation
a) = Animation
a
  | Float
delay Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 =
      let remain :: Float
remain = Float
delay Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dt
       in if Float
remain Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
            then Float
-> Float -> Float -> Float -> Ease -> Float -> Float -> Animation
EaseAnim Float
start Float
end Float
dur Float
elapsed Ease
ease Float
remain Float
delayReq
            else Float -> Animation -> Animation
stepAnim (Float -> Float
forall a. Num a => a -> a
negate Float
remain) (Float
-> Float -> Float -> Float -> Ease -> Float -> Float -> Animation
EaseAnim Float
start Float
end Float
dur Float
elapsed Ease
ease Float
0 Float
delayReq)
  | Bool
otherwise =
      let next :: Float
next = Float
elapsed Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dt
       in if Float
next Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
dur
            then Float
-> Float -> Float -> Float -> Ease -> Float -> Float -> Animation
EaseAnim Float
end Float
end Float
0 Float
0 Ease
ease Float
0 Float
0
            else Float
-> Float -> Float -> Float -> Ease -> Float -> Float -> Animation
EaseAnim Float
start Float
end Float
dur Float
next Ease
ease Float
0 Float
delayReq
stepAnim Float
dt (SpringAnim Float
pos Float
vel Float
target SpringParams
params) =
  let (Float
pos', Float
vel') = SpringParams -> Float -> Float -> Float -> Float -> (Float, Float)
stepSpring SpringParams
params Float
pos Float
vel Float
target Float
dt
   in if Float -> Float
forall a. Num a => a -> a
abs (Float
pos' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
target) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
springEps Bool -> Bool -> Bool
&& Float -> Float
forall a. Num a => a -> a
abs Float
vel' Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
springEps
        then Float -> Float -> Float -> SpringParams -> Animation
SpringAnim Float
target Float
0 Float
target SpringParams
params
        else Float -> Float -> Float -> SpringParams -> Animation
SpringAnim Float
pos' Float
vel' Float
target SpringParams
params

writeRest :: IntMap Float -> Int -> Animation -> IntMap Float
writeRest :: IntMap Float -> Int -> Animation -> IntMap Float
writeRest IntMap Float
rest Int
key Animation
a =
  let end :: Float
end = case Animation
a of
        EaseAnim Float
_ Float
e Float
_ Float
_ Ease
_ Float
_ Float
_ -> Float
e
        SpringAnim Float
_ Float
_ Float
t SpringParams
_ -> Float
t
   in if Float -> Float -> Bool
approxEq Float
end Float
0
        then Int -> IntMap Float -> IntMap Float
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
key IntMap Float
rest
        else Int -> Float -> IntMap Float -> IntMap Float
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key Float
end IntMap Float
rest