-- | A warp is a mapping from the space @[0,1]@ to a user defined space @[l,r]@.
module Sound.Sc3.Common.Math.Warp where

import Numeric {- base -}

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

-- | A warp function is lhs -> rhs -> x -> y
type Warp_f t = t -> t -> t -> t

{- | Linear real value map.

> map (warp_lin 1 2) [0,1/2,1] == [1,3/2,2]
> map (warp_lin (-1) 1) [0,1/2,1] == [-1,0,1]
-}
warp_lin :: Fractional t => Warp_f t
warp_lin :: forall t. Fractional t => Warp_f t
warp_lin t
l t
r t
n = let z :: t
z = t
r forall a. Num a => a -> a -> a
- t
l in t
n forall a. Num a => a -> a -> a
* t
z forall a. Num a => a -> a -> a
+ t
l

{- | Inverse of 'warp_lin'

> map (warp_lin_inv 1 2) [1,3/2,2] == [0,1/2,1]
> map (warp_lin_inv (-1) 1) [-1,0,1] == [0,1/2,1]
-}
warp_lin_inv :: Fractional t => Warp_f t
warp_lin_inv :: forall t. Fractional t => Warp_f t
warp_lin_inv t
l t
r t
n = let z :: t
z = t
r forall a. Num a => a -> a -> a
- t
l in (t
n forall a. Num a => a -> a -> a
- t
l) forall a. Fractional a => a -> a -> a
/ t
z

{- | The left and right must both be non zero and have the same sign.

> map (warp_exp 1 2) [0,0.5,1] == [1,2 ** 0.5,2]
> import Sound.Sc3.Plot {- hsc3-plot -}
> plot_p1_ln [map (warp_exp 1 2) [0,0.01 .. 1]]
-}
warp_exp :: Floating a => Warp_f a
warp_exp :: forall a. Floating a => Warp_f a
warp_exp a
l a
r a
n = let z :: a
z = a
r forall a. Fractional a => a -> a -> a
/ a
l in (a
z forall a. Floating a => a -> a -> a
** a
n) forall a. Num a => a -> a -> a
* a
l

warp_exp_inv :: Floating a => Warp_f a
warp_exp_inv :: forall a. Floating a => Warp_f a
warp_exp_inv a
l a
r a
n = let z :: a
z = a
r forall a. Fractional a => a -> a -> a
/ a
l in forall a. Floating a => a -> a -> a
logBase a
z (a
n forall a. Fractional a => a -> a -> a
/ a
l)

{- | Cosine warp

> map (warp_cos 1 2) [0,0.25,0.5,0.75,1]
> plot_p1_ln [map (warp_cos 1 2) [0,0.01 .. 1]]
-}
warp_cos :: Floating t => Warp_f t
warp_cos :: forall a. Floating a => Warp_f a
warp_cos t
l t
r t
n = forall t. Fractional t => Warp_f t
warp_lin t
0 (t
r forall a. Num a => a -> a -> a
- t
l) (t
0.5 forall a. Num a => a -> a -> a
- (forall a. Floating a => a -> a
cos (forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* t
n) forall a. Fractional a => a -> a -> a
/ t
2))

warp_cos_inv :: Floating a => Warp_f a
warp_cos_inv :: forall a. Floating a => Warp_f a
warp_cos_inv a
l a
r a
n = forall a. Floating a => a -> a
acos (a
1.0 forall a. Num a => a -> a -> a
- (forall t. Fractional t => Warp_f t
warp_lin_inv a
0 (a
r forall a. Num a => a -> a -> a
- a
l) a
n forall a. Num a => a -> a -> a
* a
2)) forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi

{- | Sine warp

> map (warp_sin 1 2) [0,0.25,0.5,0.75,1]
> plot_p1_ln [map (warp_sin 1 2) [0,0.01 .. 1]]
-}
warp_sin :: Floating t => Warp_f t
warp_sin :: forall a. Floating a => Warp_f a
warp_sin t
l t
r t
n = forall t. Fractional t => Warp_f t
warp_lin t
0 (t
r forall a. Num a => a -> a -> a
- t
l) (forall a. Floating a => a -> a
sin (forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* t
0.5 forall a. Num a => a -> a -> a
* t
n))

warp_sin_inv :: Floating t => Warp_f t
warp_sin_inv :: forall a. Floating a => Warp_f a
warp_sin_inv t
l t
r t
n = forall a. Floating a => a -> a
asin (forall t. Fractional t => Warp_f t
warp_lin_inv t
0 (t
r forall a. Num a => a -> a -> a
- t
l) t
n) forall a. Fractional a => a -> a -> a
/ (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ t
2)

{- | Fader warp.  Left and right values are ordinarily zero and one.

> map (warp_amp 0 1) [0,0.5,1] == [0,0.25,1]

> plot_p1_ln [map (warp_amp 0 2) [0,0.01 .. 1]]
> plot_p1_ln [map (warp_amp_inv 0 1 . warp_amp 0 1) [0,0.01 .. 1]]
-}
warp_amp :: Num a => Warp_f a
warp_amp :: forall a. Num a => Warp_f a
warp_amp a
l a
r a
n = (a
n forall a. Num a => a -> a -> a
* a
n) forall a. Num a => a -> a -> a
* (a
r forall a. Num a => a -> a -> a
- a
l) forall a. Num a => a -> a -> a
+ a
l

warp_amp_inv :: Floating a => Warp_f a
warp_amp_inv :: forall a. Floating a => Warp_f a
warp_amp_inv a
l a
r a
n = forall a. Floating a => a -> a
sqrt ((a
n forall a. Num a => a -> a -> a
- a
l) forall a. Fractional a => a -> a -> a
/ (a
r forall a. Num a => a -> a -> a
- a
l))

{- | DB fader warp. Left and right values are ordinarily negative
infinity and zero.  An input of @0@ gives @-180@.

> map (round . warp_db (-180) 0) [0,0.5,1] == [-180,-12,0]

> plot_p1_ln [map (warp_db (-60) 0) [0,0.01 .. 1]]
> plot_p1_ln [map (warp_db_inv 0 60) [0 .. 60]]
-}
warp_db :: (Eq a, Floating a) => Warp_f a
warp_db :: forall a. (Eq a, Floating a) => Warp_f a
warp_db a
l a
r a
n =
  let n' :: a
n' = if a
n forall a. Eq a => a -> a -> Bool
== a
0 then -a
180 else forall a. Floating a => a -> a
Math.amp_to_db (a
n forall a. Num a => a -> a -> a
* a
n)
  in forall a. Fractional a => a -> a -> a -> a -> a -> a
Math.sc3_linlin a
n' (-a
180) a
0 a
l a
r

warp_db_inv :: Floating a => Warp_f a
warp_db_inv :: forall a. Floating a => Warp_f a
warp_db_inv a
l a
r a
n = forall a. Floating a => a -> a
sqrt (forall a. Floating a => a -> a
Math.db_to_amp (forall a. Fractional a => a -> a -> a -> a -> a -> a
Math.sc3_linlin a
n a
l a
r (-a
180) a
0))

{- | A curve warp given by a real /n/.

> warp_curve (-3) 1 2 0.25 == 1.5552791692202022
> warp_curve (-3) 1 2 0.50 == 1.8175744761936437

> plot_p1_ln [map (warp_curve (-3) 1 2) [0,0.01 .. 1]]
> plot_p1_ln (map (\c -> map (warp_curve c 1 2) [0,0.01 .. 1]) [0,3,6,9])
> plot_p1_ln [map (warp_curve_inv 7 20 20000 . warp_curve 7 20 20000) [0,0.01 .. 1]]
-}
warp_curve :: (Ord a, Floating a) => a -> Warp_f a
warp_curve :: forall a. (Ord a, Floating a) => a -> Warp_f a
warp_curve a
k a
l a
r a
n =
  if forall a. Num a => a -> a
abs a
k forall a. Ord a => a -> a -> Bool
< a
0.001
  then forall t. Fractional t => Warp_f t
warp_lin a
l a
r a
n
  else let e :: a
e = forall a. Floating a => a -> a
exp a
k
           a :: a
a = (a
r forall a. Num a => a -> a -> a
- a
l) forall a. Fractional a => a -> a -> a
/ (a
1 forall a. Num a => a -> a -> a
- a
e)
           b :: a
b = a
l forall a. Num a => a -> a -> a
+ a
a
       in a
b forall a. Num a => a -> a -> a
- ((a
e forall a. Floating a => a -> a -> a
** a
n) forall a. Num a => a -> a -> a
* a
a)

warp_curve_inv :: (Ord a, Floating a) => a -> Warp_f a
warp_curve_inv :: forall a. (Ord a, Floating a) => a -> Warp_f a
warp_curve_inv a
k a
l a
r a
n =
  if forall a. Num a => a -> a
abs a
k forall a. Ord a => a -> a -> Bool
< a
0.001
  then forall t. Fractional t => Warp_f t
warp_lin a
l a
r a
n
  else let e :: a
e = forall a. Floating a => a -> a
exp a
k
           a :: a
a = (a
r forall a. Num a => a -> a -> a
- a
l) forall a. Fractional a => a -> a -> a
/ (a
1 forall a. Num a => a -> a -> a
- a
e)
           b :: a
b = a
l forall a. Num a => a -> a -> a
+ a
a
       in forall a. Floating a => a -> a
log ((a
b forall a. Num a => a -> a -> a
- a
n) forall a. Fractional a => a -> a -> a
/ a
a) forall a. Fractional a => a -> a -> a
/ a
k

{- | Select warp functions by name.  Numerical names are interpreted as /curve/ values for 'warpCurve'.

> let Just w = warp_named "lin"
> let Just w = warp_named "-3"
> let Just w = warp_named "6"
> plot_p1_ln [map ((fst w) 1 2) [0,0.01 .. 1]]
-}
warp_named :: (Floating t, RealFrac t) => String -> Maybe (Warp_f t, Warp_f t)
warp_named :: forall t.
(Floating t, RealFrac t) =>
String -> Maybe (Warp_f t, Warp_f t)
warp_named String
nm =
    case String
nm of
      String
"lin" -> forall a. a -> Maybe a
Just (forall t. Fractional t => Warp_f t
warp_lin,forall t. Fractional t => Warp_f t
warp_lin_inv)
      String
"exp" -> forall a. a -> Maybe a
Just (forall a. Floating a => Warp_f a
warp_exp,forall a. Floating a => Warp_f a
warp_exp_inv)
      String
"sin" -> forall a. a -> Maybe a
Just (forall a. Floating a => Warp_f a
warp_sin,forall a. Floating a => Warp_f a
warp_sin_inv)
      String
"cos" -> forall a. a -> Maybe a
Just (forall a. Floating a => Warp_f a
warp_cos,forall a. Floating a => Warp_f a
warp_cos_inv)
      String
"amp" -> forall a. a -> Maybe a
Just (forall a. Num a => Warp_f a
warp_amp,forall a. Floating a => Warp_f a
warp_amp_inv)
      String
"db" -> forall a. a -> Maybe a
Just (forall a. (Eq a, Floating a) => Warp_f a
warp_db,forall a. Floating a => Warp_f a
warp_db_inv)
      String
_ -> case forall a. Real a => ReadS a -> ReadS a
readSigned forall a. RealFrac a => ReadS a
readFloat String
nm of
             [(t
c,String
"")] -> forall a. a -> Maybe a
Just (forall a. (Ord a, Floating a) => a -> Warp_f a
warp_curve t
c,forall a. (Ord a, Floating a) => a -> Warp_f a
warp_curve_inv t
c)
             [(t, String)]
_ -> forall a. Maybe a
Nothing