-- | Interpolation functions, ie. for envelope segments.  Present naming is for qualified import.
module Sound.Sc3.Common.Math.Interpolate where

import Sound.Sc3.Common.Math {- hsc3 -}

{- | An interpolation function takes three arguments.
     x0 is the left or begin value, x1 is the right or end value, t is a (0,1) index.
-}
type Interpolation_f t = t -> t -> t -> t

-- | Clip x to (0,1) and run f.
--
-- > interpolate linear (-1,1) 0.5 == 0
interpolate :: (Num t,Ord t) => Interpolation_f t -> (t,t) -> t -> t
interpolate :: forall t. (Num t, Ord t) => Interpolation_f t -> (t, t) -> t -> t
interpolate Interpolation_f t
f (t
l,t
r) t
x = if t
x forall a. Ord a => a -> a -> Bool
< t
0 then t
l else if t
x forall a. Ord a => a -> a -> Bool
> t
1 then t
r else Interpolation_f t
f t
l t
r t
x

-- | Step function, ignores t and returns x1.
step :: Interpolation_f t
step :: forall t. Interpolation_f t
step t
_ t
x1 t
_ = t
x1

{- | Linear interpolation funtion.

> map (linear 1 10) [0,0.25 .. 1] == [1,3.25,5.5,7.75,10]

> import Sound.Sc3.Plot {- hsc3-plot -}
> plot_fn_r1_ln (linear (-1) 1) (0,1)
-}
linear :: Num t => Interpolation_f t
linear :: forall t. Num t => Interpolation_f t
linear t
x0 t
x1 t
t = t
t forall a. Num a => a -> a -> a
* (t
x1 forall a. Num a => a -> a -> a
- t
x0) forall a. Num a => a -> a -> a
+ t
x0

{- | Exponential interpolation.
     x0 must not be zero and (x0,x1) must not span zero.

> plot_fn_r1_ln (exponential 0.001 1) (0,1)
> plot_fn_r1_ln (exponential 1 2) (0,1)
> plot_fn_r1_ln (exponential 20 20000) (0,1)
-}
exponential :: Floating t => Interpolation_f t
exponential :: forall t. Floating t => Interpolation_f t
exponential t
x0 t
x1 t
t = t
x0 forall a. Num a => a -> a -> a
* ((t
x1 forall a. Fractional a => a -> a -> a
/ t
x0) forall a. Floating a => a -> a -> a
** t
t)

{- | Variant that allows x0 to be zero, though (x0,x1) must not span zero.

> plot_fn_r1_ln (exponential_0 0 1) (0,1)
> plot_fn_r1_ln (exponential_0 0 (-1)) (0,1)
-}
exponential_0 :: (Eq t,Floating t) => Interpolation_f t
exponential_0 :: forall t. (Eq t, Floating t) => Interpolation_f t
exponential_0 t
x0 t
x1 =
    let epsilon :: t
epsilon = t
1e-6
        x0' :: t
x0' = if t
x0 forall a. Eq a => a -> a -> Bool
== t
0 then t
epsilon forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
signum t
x1 else t
x0
    in forall t. Floating t => Interpolation_f t
exponential t
x0' t
x1

-- | 'linear' of 'exponential_0' of (0,1), ie. allows (x0,x1) to span zero.
--
-- > plot_fn_r1_ln (exponential_lin (-1) 1) (0,1)
exponential_lin :: (Eq t,Floating t) => Interpolation_f t
exponential_lin :: forall t. (Eq t, Floating t) => Interpolation_f t
exponential_lin t
x0 t
x1 t
t = forall t. Num t => Interpolation_f t
linear t
x0 t
x1 (forall t. (Eq t, Floating t) => Interpolation_f t
exponential_0 t
0 t
1 t
t)

-- | 'linear' with t transformed by sine function over (-pi/2,pi/2).
--
-- > plot_fn_r1_ln (sine (-1) 1) (0,1)
sine :: Floating t => Interpolation_f t
sine :: forall t. Floating t => Interpolation_f t
sine t
x0 t
x1 t
t =
    let t' :: t
t' = - forall a. Floating a => a -> a
cos (forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* t
t) forall a. Num a => a -> a -> a
* t
0.5 forall a. Num a => a -> a -> a
+ t
0.5
    in forall t. Num t => Interpolation_f t
linear t
x0 t
x1 t
t'

-- | If x0 '<' x1 rising sine segment (0,pi/2), else falling segment (pi/2,pi).
--
-- > plot_fn_r1_ln (welch (-1) 1) (0,1)
-- > plot_fn_r1_ln (welch 1 (-1)) (0,1)
welch :: (Ord t, Floating t) => Interpolation_f t
welch :: forall t. (Ord t, Floating t) => Interpolation_f t
welch t
x0 t
x1 t
t =
    if t
x0 forall a. Ord a => a -> a -> Bool
< t
x1
    then t
x0 forall a. Num a => a -> a -> a
+ (t
x1 forall a. Num a => a -> a -> a
- t
x0) forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (forall a. Floating a => a
half_pi forall a. Num a => a -> a -> a
* t
t)
    else t
x1 forall a. Num a => a -> a -> a
- (t
x1 forall a. Num a => a -> a -> a
- t
x0) forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (forall a. Floating a => a
half_pi forall a. Num a => a -> a -> a
- (forall a. Floating a => a
half_pi forall a. Num a => a -> a -> a
* t
t))

{- | Curvature controlled by single parameter c.
     Zero is 'linear', increasing c approaches 'exponential' and continues past it.
     The value for c at which the curve is close to exponential depends on the range.

> plot_p1_ln (map (\c-> map (curve c (-1) 1) [0,0.01 .. 1]) [-6,-4 .. 6])
> plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [curve 4.4 1 100,exponential 1 100,curve 4.5 1 100])
> plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [exponential 20 20000,curve 7 20 20000])
> plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [fader 0 2,curve 2 0 2])
-}
curve :: (Ord t, Floating t) => t -> Interpolation_f t
curve :: forall t. (Ord t, Floating t) => t -> Interpolation_f t
curve t
c t
x0 t
x1 t
t =
    if forall a. Num a => a -> a
abs t
c forall a. Ord a => a -> a -> Bool
< t
0.0001
    then forall t. Num t => Interpolation_f t
linear t
x0 t
x1 t
t
    else let d :: t
d = t
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
exp t
c
             n :: t
n = t
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
exp (t
t forall a. Num a => a -> a -> a
* t
c)
         in t
x0 forall a. Num a => a -> a -> a
+ (t
x1 forall a. Num a => a -> a -> a
- t
x0) forall a. Num a => a -> a -> a
* (t
nforall a. Fractional a => a -> a -> a
/t
d)

{- | Square of 'linear' of 'sqrt' of x0 and x1, therefore neither may be negative.

> plot_fn_r1_ln (squared 0 1) (0,1)
> plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [curve 2.05 0 1,squared 0 1])
-}
squared :: Floating t => Interpolation_f t
squared :: forall t. Floating t => Interpolation_f t
squared t
x0 t
x1 t
t =
    let x0' :: t
x0' = forall a. Floating a => a -> a
sqrt t
x0
        x1' :: t
x1' = forall a. Floating a => a -> a
sqrt t
x1
        l :: t
l = forall t. Num t => Interpolation_f t
linear t
x0' t
x1' t
t
    in t
l forall a. Num a => a -> a -> a
* t
l

{- | Cubic variant of 'squared'.

> plot_fn_r1_ln (cubed 0 1) (0,1)
> plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [curve 3.25 0 1,cubed 0 1])
-}
cubed :: Floating t => Interpolation_f t
cubed :: forall t. Floating t => Interpolation_f t
cubed t
x0 t
x1 t
t =
    let x0' :: t
x0' = t
x0 forall a. Floating a => a -> a -> a
** (t
1forall a. Fractional a => a -> a -> a
/t
3)
        x1' :: t
x1' = t
x1 forall a. Floating a => a -> a -> a
** (t
1forall a. Fractional a => a -> a -> a
/t
3)
        l :: t
l = forall t. Num t => Interpolation_f t
linear t
x0' t
x1' t
t
    in t
l forall a. Num a => a -> a -> a
* t
l forall a. Num a => a -> a -> a
* t
l

-- | x0 until end, then immediately x1.
--
-- > plot_fn_r1_ln (hold 0 1) (0,2)
hold :: (Num t,Ord t) => Interpolation_f t
hold :: forall t. (Num t, Ord t) => Interpolation_f t
hold t
x0 t
x1 t
t = if t
t forall a. Ord a => a -> a -> Bool
>= t
1 then t
x1 else t
x0

{- | Fader curve, equal to 'squared' when x1 > x0.

> plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [squared 0 1,fader 0 1])
> plot_p1_ln (map (\f -> map f [0,0.01 .. 1]) [curve 2 1 0,fader 1 0])
-}
fader :: (Num t,Ord t) => Interpolation_f t
fader :: forall t. (Num t, Ord t) => Interpolation_f t
fader t
x0 t
x1 t
t =
  let rng :: t
rng = t
x1 forall a. Num a => a -> a -> a
- t
x0
      sqr :: a -> a
sqr a
i = a
i forall a. Num a => a -> a -> a
* a
i
  in forall a. Num a => a -> a
sqr (if t
rng forall a. Ord a => a -> a -> Bool
> t
0 then t
t else t
1 forall a. Num a => a -> a -> a
- (t
1 forall a. Num a => a -> a -> a
- t
t)) forall a. Num a => a -> a -> a
* t
rng forall a. Num a => a -> a -> a
+ t
x0