module Data.Spline.Key (
Key(..)
, keyValue
, interpolateKeys
, normalizeSampling
) where
import Data.Aeson
import Linear
data Key a
= Hold a
| Linear a
| Cosine a
| CubicHermite a
| Bezier a a a
deriving (Eq,Show)
instance Functor Key where
fmap f k = case k of
Hold a -> Hold (f a)
Linear a -> Linear (f a)
Cosine a -> Cosine (f a)
CubicHermite a -> CubicHermite (f a)
Bezier l a r -> Bezier (f l) (f a) (f r)
instance (FromJSON a) => FromJSON (Key a) where
parseJSON = withObject "key" $ \o -> do
interpolation :: String <- o .: "interpolation"
value <- o .: "value"
if
| interpolation == "hold" -> pure (Hold value)
| interpolation == "linear" -> pure (Linear value)
| interpolation == "cosine" -> pure (Cosine value)
| interpolation == "cubic-hermite" -> pure (CubicHermite value)
| interpolation == "bezier" -> do
left <- o .: "left"
right <- o .: "right"
pure $ Bezier left value right
| otherwise -> fail "unknown interpolation mode"
keyValue :: Key a -> a
keyValue k = case k of
Hold a -> a
Linear a -> a
Cosine a -> a
CubicHermite a -> a
Bezier _ a _ -> a
interpolateKeys :: (Additive a,Floating s) => s -> Key (a s) -> Key (a s) -> a s
interpolateKeys s start end = case start of
Hold k -> k
Linear k -> lerp s b k
Cosine k -> lerp ((1 cos (s * pi)) * 0.5) b k
CubicHermite k -> lerp (s * s * (3 2 * s)) b k
Bezier _ k0 r0 -> case end of
Bezier l1 k1 _ -> interpolateBezier s k0 r0 l1 k1
_ -> interpolateBezier s k0 r0 r0 b
where
b = keyValue end
interpolateBezier :: (Additive a,Floating s)
=> s
-> a s
-> a s
-> a s
-> a s
-> a s
interpolateBezier s k0 r0 l1 k1 = (u ^+^ v) ^* s
where
u = k0 ^+^ (r0 ^-^ k0) ^* s
v = l1 ^+^ (k1 ^-^ l1) ^* s
normalizeSampling :: (Fractional s)
=> (a s -> s)
-> s
-> Key (a s)
-> Key (a s)
-> s
normalizeSampling sampler s k0 k1 = (s s0) / (s1 s0)
where
s0 = sampler (keyValue k0)
s1 = sampler (keyValue k1)