hdf-0.14: Sound/DF/Uniform/GADT/UGen.hs

-- | Data flow node functions, or unit generators.
module Sound.DF.Uniform.GADT.UGen where

import Data.Int {- base -}
import Data.Maybe {- base -}

import Sound.DF.Uniform.GADT.DF
import Sound.DF.Uniform.LL.K

-- * Tuples

-- | Duplicate a value into a tuple.
--
-- > split 1 == (1,1)
split :: a -> (a,a)
split p = (p,p)

-- | Reversed tuple constructor, (ie. @flip (,)@)
--
-- > swap 2 1 == (1,2)
swap :: a -> b -> (b,a)
swap = flip (,)

-- * Math

-- | Two pi.
--
-- > two_pi == 6.283185307179586
two_pi :: Floating a => a
two_pi = 2.0 * pi

-- | Midi note number to cycles per second.
--
-- > midi_cps 69 == 440
midi_cps :: Floating a => a -> a
midi_cps a = 440.0 * (2.0 ** ((a - 69.0) * (1.0 / 12.0)))

-- | Multiply and add.
--
-- > map (mul_add 2 3) [1,2] == [5,7] && map (mul_add 3 4) [1,2] == [7,10]
mul_add :: Num a => a -> a -> a -> a
mul_add m a = (+ a) .(* m)

-- | Calculate feedback multipler in comb filter circuit given /delay/
-- and /decay/ times.
--
-- > calc_fb 0.2 3.0 == 0.6309573444801932
calc_fb :: Floating a => a -> a -> a
calc_fb delayt decayt = exp ((log 0.001 * delayt) / decayt)

-- | Linear range conversion.
--
-- > map (\i -> lin_lin i (-1) 1 0 1) [-1,-0.9 .. 1.0]
--
-- > do {s <- lf_saw 1.0 0.0
-- >    ;o <- sin_osc (lin_lin s (-1.0) 1.0 220.0 440.0) 0.0
-- >    ;audition [] (out1 (o * 0.1))}
lin_lin :: Fractional a => a -> a -> a -> a -> a -> a
lin_lin i in_l in_r out_l out_r =
    let s = (out_r - out_l) / (in_r - in_l)
        o = out_l - (s * in_l)
    in (i * s) + o

-- | Exponential range conversion.
--
-- > map (\i -> lin_exp i 1 2 1 3) [1,1.1 .. 2]
--
-- > do {s <- lf_saw 0.25 0.0
-- >    ;o <- sin_osc (lin_exp (s + 1.0) 0.0 2.0 220.0 440.0) 0.0
-- >    ;audition [] (out1 (o * 0.1))}
lin_exp :: Floating a => a -> a -> a -> a -> a -> a
lin_exp i in_l in_r out_l out_r =
    let rt = out_r / out_l
        rn = 1.0 / (in_r - in_l)
        rr = rn * negate in_l
    in out_l * (rt ** (i * rn + rr))

-- | Constrain p in (-q,q).
--
-- > let r = -10 : -10 : [-10,-9 .. 10]
-- > in map (flip clip2 10) [-12,-11 .. 12] == r
clip2 :: (Num a, Ord a) => a -> a -> a
clip2 p q =
    let nq = negate q
    in min q (max p nq)

-- | /sr/ = sample rate, /r/ = cycle (two-pi), /hz/ = frequency
--
-- > hz_to_incr 48000 128 375 == 1
-- > hz_to_incr 48000 two_pi 458.3662361046586 == 6e-2
hz_to_incr :: Fractional a => a -> a -> a -> a
hz_to_incr sr r hz = (r / sr) * hz

-- | Inverse of 'hz_to_incr'.
--
-- > incr_to_hz 48000 128 1 == 375
incr_to_hz :: Fractional a => a -> a -> a -> a
incr_to_hz sr r ic = ic / (r / sr)

-- | Linear pan.
--
-- > map (lin_pan2 1) [-1,0,1] == [(1,0),(0.5,0.5),(0,1)]
--
-- > do {o <- sin_osc 440.0 0.0
-- >    ;l <- sin_osc 0.5 0.0
-- >    ;let (p,q) = lin_pan2 (o * 0.1) l
-- >     in audition [] (out2 p q)}
lin_pan2 :: Fractional t => t -> t -> (t, t)
lin_pan2 p q =
    let q' = (q / 2) + 0.5
    in (p * (1 - q'),p * q')

-- * Environment

-- | Compile time sample rate constant.
k_sample_rate :: Fractional n => n
k_sample_rate = 48000

-- | Environment value, equal to @'two_pi' / 'w_sample_rate'@.
w_radians_per_sample :: DF Float
w_radians_per_sample = two_pi / w_sample_rate

-- * Tbl

-- | Add guard point.
--
-- > tbl_guard [1,2,3] == [1,2,3,1]
tbl_guard :: [a] -> [a]
tbl_guard t =
    case t of
      [] -> []
      i:_ -> t ++ [i]

-- | Generate guarded sin table.
--
-- > map (round . (* 100)) (tbl_sin 12) == [0,50,87,100,87,50,0,-50,-87,-100,-87,-50,0]
tbl_sin :: Floating n => Int -> [n]
tbl_sin n =
    let f = sin . (* 2) . (* pi) . (/ fromIntegral n) . fromIntegral
    in tbl_guard (map f [0 .. n - 1])

-- * Phasor

-- | If 'q >= p' then 'q - p' else 'q'.
clipr :: K_Num a => DF a -> DF a -> DF a
clipr p q = select2 (q `df_gte` p) (q - p) q

-- | 'clip2' variant.
--
-- > do {o <- sin_osc 440 0
-- >    ;audition [] (out1 (df_clip2 (o * 2) 0.1))}
df_clip2 :: K_Num a => DF a -> DF a -> DF a
df_clip2 p q =
    let nq = negate q
    in df_min q (df_max p nq)

-- | Single place infinite impulse response filter with indicated
-- initial value.
--
-- > import Data.Int
-- > import Sound.DF.Uniform.GADT
-- > import Sound.DF.Uniform.LL.K
--
-- > draw (iir1 (0::Int32) (+) 1)
-- > draw (iir1 (0::Float) (+) 1)
iir1 :: (K' a) => a -> (Binary_Op (DF a)) -> DF a -> DF a
iir1 y0 f i = rec_h y0 (split . f i)

-- | /r/ = right hand edge, /ip/ = initial phase, /x/ = increment
--
-- > draw (phasor 9.0 (4.5::Float) 0.5)
-- > draw (phasor 9 (0::Int32) 1)
phasor :: K_Num a => DF a -> a -> DF a -> DF a
phasor r ip = iir1 ip (\x y1 -> clipr r (x + y1))

-- * Array

-- | Allocate /n/ second array, variant of 'df_vec'.
a_alloc_sec :: V_Id -> Float -> DF (Vec Float)
a_alloc_sec k z =
    let z' = ceiling (z * k_sample_rate) + 1 + 1
    in df_vec k (replicate z' 0)

-- | Array delay with /phasor/ argument for write index.
a_delay_ph :: DF (Vec Float) -> DF Float -> DF Int32 -> DF Int32 -> DF Float
a_delay_ph a s n wi =
  let ri = clipr n (wi + 1)
  in mrg (a_read a ri) (a_write a wi s)

-- | Array delay.
--
-- > do {a <- df_vec_m [0,1,2]
-- >    ;draw (a_delay a 0.0 0)}
--
-- > let {f = sin_osc 0.1 0.0
-- >     ;o = sin_osc (f * 200.0 + 600.0) 0.0
-- >     ;a = df_vec (V_Id 0) (replicate 48000 0)
-- >     ;d = a_delay a o 24000}
-- > in audition [] (out2 (o * 0.1) (d * 0.05))
a_delay :: DF (Vec Float) -> DF Float -> DF Int32 -> DF Float
a_delay a s n = a_delay_ph a s n (phasor n 0 1)

-- | Array fill function (sin).
--
-- > do {i <- phasor 64 0 1
-- >    ;a = a_tbl_sin (V_Id 0) 64
-- >    ;let s = a_read a i
-- >     in audition [] (out1 (s * 0.2))}
a_tbl_sin :: V_Id -> Int -> DF (Vec Float)
a_tbl_sin k = df_vec k . tbl_sin

-- | Linear interpolating variant of 'a_read'.
--
-- > let {i = phasor 64.0 0 (hz_to_incr k_sample_rate 64.0 330.0)
-- >     ;a = a_tbl_sin (V_Id 0) 64
-- >     ;s = a_lerp a i}
-- > in audition [] (out1 (s * 0.2))
a_lerp :: DF (Vec Float) -> DF Float -> DF Float
a_lerp a i =
    let i_f = df_floorf i
        i_c = df_ceilf i
        z = i - i_f
        p = a_read a (df_lrintf i_f)
        q = a_read a (df_lrintf i_c)
    in (p * (1.0 - z)) + (q * z)

-- * Osc

-- | 'phasor' for table of /z/ places. /ip/ is in (0,1).
--
-- > draw (phasor 64.0 (0.0::Float) (hz_to_incr k_sample_rate 64.0 330.0))
-- > draw (tbl_phasor 64 0.0 330.0)
tbl_phasor :: Int -> Float -> DF Float -> DF Float
tbl_phasor z ip f =
  let z_r = fromIntegral z
      z_c = K z_r
      ip_c = ip * z_r
  in phasor z_c ip_c (hz_to_incr w_sample_rate z_c f)

-- | Table lookup oscillator. /ip/ is in (0,1).
--
-- > let {a = a_tbl_sin (V_Id 0) 256
-- >     ;f = a_osc a 4.0 0.0
-- >     ;o = a_osc a (f * 200.0 + 400.0) 0.0}
-- > in audition [] (out1 (o * 0.1))
--
-- Cancellation:
--
-- > let {a = a_tbl_sin (V_Id 0) 256
-- >     ;o1 = a_osc a 440.0 0.0
-- >     ;o2 = a_osc a 440.0 0.5}
-- > in audition [] (out1 (o1 + o2))
a_osc :: DF (Vec Float) -> DF Float -> Float -> DF Float
a_osc a f ip =
    let z = fromMaybe 0 (df_tbl_size a)
        p = tbl_phasor z ip f
    in a_lerp a p

-- * Filter constructors.

-- | Single sample delay with indicated initial value.
--
-- > draw (unit_delay (0::Int32) 1)
-- > draw (unit_delay (0.0::Float) 1.0)
--
-- > let {c = counter 0.0 1.0
-- >     ;d = unit_delay 0.0 c}
-- > in audition_text 12 (out2 c d)
unit_delay :: K' a => a -> DF a -> DF a
unit_delay y0 s = rec_h y0 (\i -> (i,s))

-- | Two place infinite impulse response filter.  Inputs are: /f/=
-- function @(\x0 y1 y2 -> y0)@, /i/ = input signal.
--
-- > let {c1 = iir2 (\x y1 _ -> x + y1) 0.001
-- >     ;o1 = sin_osc (c1 + 220.0) 0
-- >     ;c2 = iir2 (\x _ y2 -> x + y2) 0.001
-- >     ;o2 = sin_osc (c2 + 220.0) 0}
-- > in audition [] (out2 (o1 * 0.1) (o2 * 0.1))
iir2 :: K_Num a => (Ternary_Op (DF a)) -> DF a -> DF a
iir2 f i =
    rec_h
    0
    (split . (\y1 -> let y2 = unit_delay 0 y1
                     in f i y1 y2))

-- | Single place finite impulse response filter.
fir1 :: K' a => a -> (DF a -> DF a -> DF b) -> DF a -> DF b
fir1 z0 f i = f i (unit_delay z0 i)

-- | Two place finite impulse response filter.
fir2 :: (Ternary_Op (DF Float)) -> DF Float -> DF Float
fir2 f i =
  let x1 = unit_delay 0.0 i
      x2 = unit_delay 0.0 x1
  in f i x1 x2

-- | Ordinary biquad filter section.
biquad :: (Quinary_Op (DF Float)) -> DF Float -> DF Float
biquad f i =
    rec_h
    0.0
    (split . (\y1 -> let x1 = unit_delay 0.0 i
                         x2 = unit_delay 0.0 x1
                         y2 = unit_delay 0.0 y1
                     in f i x1 x2 y1 y2))

-- * Counter

-- | Counter from indicated initial value.
--
-- > draw (counter (0::Int32) 1)
-- > draw (counter (0.0::Float) 1.0)
--
-- > audition_text 10 (out1 (counter 0.0 1.0))
counter :: K_Num a => a -> DF a -> DF a
counter y0 n = unit_delay y0 (iir1 y0 (+) n)

-- * Buffer

-- | Buffer delay.
--
-- > draw (buf_delay 0 0.0 0)
buf_delay :: DF Int32 -> DF Float-> DF Int32 -> DF Float
buf_delay b s n =
    let wi = phasor n 0 1
        ri = clipr n (wi + 1)
    in mrg (b_read b ri) (b_write b wi s)

-- | Non-interpolating comb filter.  Inputs are: /b/ = buffer index,
-- /i/ = input signal, /dl/ = delay time, /dc/ = decay time.
--
-- All times are in seconds.  The decay time is the time for the
-- echoes to decay by @60@ decibels. If this time is negative then the
-- feedback coefficient will be negative, thus emphasizing only odd
-- harmonics at an octave lower.
--
-- > draw (out1 (buf_comb_n 0 0.0 0.0 0.0))
--
-- Comb used as a resonator. The resonant fundamental is equal to
-- reciprocal of the delay time.
--
-- > import qualified Sound.SC3 as S
--
-- > let {n = white_noise 0
-- >     ;dt = let f x = lin_exp (x + 2.0) 1.0 2.0 0.0001 0.01
-- >           in f (lf_saw 0.1 0.0)
-- >     ;c = buf_comb_n 0 (n * 0.1) dt 0.2}
-- > in audition [S.b_alloc 0 48000 1] (out1 c)
--
-- Comb used as an echo.
--
-- > let {i = impulse 0.5 0.0
-- >     ;n = white_noise 0
-- >     ;e = decay (i * 0.5) 0.2
-- >     ;c = buf_comb_n 0 (e * n) 0.2 3.0}
-- > in audition [S.b_alloc 0 48000 1] (out1 c)
buf_comb_n :: DF Int32 -> DF Float -> DF Float -> DF Float -> DF Float
buf_comb_n b s dlt dct = do
  let n = df_lrintf (dlt * w_sample_rate)
      fb = calc_fb dlt dct
      c i = let x = buf_delay b i n
            in split (s + (fb * x))
  rec_h 0.0 c

-- * Comb

-- | Array variant of 'buf_comb_n'.  Max delay time is in seconds.
--
-- > let {n = white_noise 0
-- >     ;dt = let f x = lin_exp (x + 2.0) 1.0 2.0 0.0001 0.01
-- >           in f (lf_saw 0.1 0.0)
-- >     ;c = comb_n (V_Id 0) 0.1 (n * 0.1) dt 0.2}
-- > in audition [] (out1 c)
--
-- > let {i = impulse 0.5 0.0
-- >     ;n = white_noise 0
-- >     ;e = decay (i * 0.5) 0.2
-- >     ;c = comb_n (V_Id 0) 0.2 (e * n) 0.2 3.0}
-- > in audition [] (out1 c)
comb_n :: V_Id -> Float -> DF Float -> DF Float -> DF Float -> DF Float
comb_n k z s dlt dct =
  let a = a_alloc_sec k z
      n = df_lrintf (dlt * w_sample_rate)
      fb = calc_fb dlt dct
      c i = let x = a_delay a i n
            in split (s + (fb * x))
  in rec_h 0.0 c

-- * Noise

-- | 'Int32' linear congruential generator, hence signed modulo of
-- @2^32@.  Note that the state and all internal math is 32bit.
--
-- See <http://en.wikipedia.org/wiki/Linear_congruential_generator>
-- for possible parameters.
lcg_i32 :: Int32 -> Int32 -> Int32 -> DF Int32
lcg_i32 a c x0 =
    let tilde f g = rec_h x0 (\i -> let r = f i in (r,g r))
    in ((K c) +) `tilde` (* (K a))

-- | 'lcg_i32' 1103515245 12345, so in (minBound,maxBound).
lcg_glibc :: Int32 -> DF Int32
lcg_glibc = lcg_i32 1103515245 12345

-- | 'abs' of 'lcg_glibc, so in (0,maxBound).
randi :: Int32 -> DF Int32
randi = abs . lcg_glibc

-- | 'i32_to_normal_f32' of 'randi', so in (0,1).
--
-- > audition_text 24 (out1 (randf 0))
randf :: Int32 -> DF Float
randf = i32_to_normal_f32 . randi

-- | White noise (-1,1).  Generates noise whose spectrum has equal
-- power at all frequencies.
--
-- > audition_text 24 (out1 (white_noise 0))
--
-- > let n = white_noise 0 * 0.1
-- > in draw (out1 (n - n))
--
-- > let {n = white_noise 0 * 0.1
-- >     ;m = white_noise 5 * 0.1}
-- > in audition [] (out1 (n - m))
white_noise :: Int32 -> DF Float
white_noise = i32_to_normal_f32 . lcg_glibc

-- | 'iir1' brown noise function.
brown_noise_f :: Binary_Op (DF Float)
brown_noise_f x y1 =
    let z = x + y1
        r = select2 (z `df_lt` (-1.0)) ((-2.0) - z) z
    in select2 (z `df_gt` 1.0) (2.0 - z) r

-- | Brown noise (-1,1).  Generates noise whose spectrum falls off in
-- power by 6 dB per octave.
--
-- > let n = brown_noise 0
-- > in audition [] (out1 (n * 0.1))
--
-- > let {n = brown_noise 0
-- >     ;f = lin_exp n (-1.0) 1.0 64.0 9600.0
-- >     ;o = sin_osc f 0}
-- > in audition [] (out1 (o * 0.1))
brown_noise :: Int32 -> DF Float
brown_noise k =
    let w = white_noise k
        w8 = w / 8.0
    in iir1 0.0 brown_noise_f w8

-- * Osc

-- | Sine oscillator.  Inputs are: /f/ = frequency (in hz), /ip/ =
-- initial phase.
--
-- > let o = sin_osc 440.0 0.0
-- > in audition [] (out1 (o * 0.1))
--
-- Used as both Oscillator and LFO.
--
-- > let {f = sin_osc 4.0 0.0
-- >     ;o = sin_osc (f * 200.0 + 400.0) 0.0}
-- > in audition [] (out1 (o * 0.1))
--
-- Cancellation.
--
-- > let {o1 = sin_osc 440.0 0.0
-- >     ;o2 = sin_osc 440.0 pi}
-- > in audition [] (out1 (o1 + o2))
sin_osc :: DF Float -> Float -> DF Float
sin_osc f ip =
    let p = phasor two_pi ip (hz_to_incr w_sample_rate two_pi f)
    in sin p

-- | Impulse oscillator (non band limited).
-- Outputs non band limited single sample impulses.
-- Inputs are: /f/ = frequency (in hertz), /ip/ = phase offset (0..1)
--
-- > let o = impulse 800.0 0.0
-- > in audition [] (out1 (o * 0.1))
--
-- > let {f = sin_osc 0.25 0.0 * 2500.0 + 2505.0
-- >     ;o = impulse f 0.0}
-- > in audition [] (out1 (o * 0.1))
impulse :: DF Float -> Float -> DF Float
impulse f ip =
    let i = hz_to_incr w_sample_rate 1.0 f
        p = phasor 1.0 ip i
        x1 = unit_delay 0.0 p
        s = (x1 `df_lt` 0.5) `df_and` (p `df_gte` 0.5)
    in select2 s 1.0 0.0

-- * LF Osc.

-- | Non-band limited sawtooth oscillator.  Output ranges from -1 to +1.
-- Inputs are: /f/ = frequency (in hertz), /ip/ = initial phase (0,2).
--
-- > let o = lf_saw 500.0 1.0
-- > in audition [] (out1 (o * 0.1))
--
-- Used as both Oscillator and LFO.
--
-- > let {f = lf_saw 4.0 0.0
-- >     ;o = lf_saw (f * 400.0 + 400.0) 0.0}
-- > in audition [] (out1 (o * 0.1))
lf_saw :: DF Float -> Float -> DF Float
lf_saw f ip =
    let p = phasor 2.0 ip (hz_to_incr w_sample_rate 2.0 f)
    in p - 1.0

-- | Non-band-limited pulse oscillator. Outputs a high value of one
-- and a low value of zero. Inputs are: /f/ = frequency (in hertz),
-- /ip/ = initial phase (0,1), /w/ = pulse width duty cycle (0,1).
--
-- > let {o1 = lf_pulse 3.0 0.0 0.3 * 200.0 + 200.0
-- >     ;o2 = lf_pulse o1 0.0 0.2 * 0.1}
-- > in audition [] (out1 o2)
lf_pulse :: DF Float -> Float -> DF Float -> DF Float
lf_pulse f ip w =
    let p = phasor 1.0 ip (hz_to_incr w_sample_rate 1.0 f)
    in select2 (p `df_gte` w) 0.0 1.0

-- * Filters

-- | Two zero fixed midpass filter.
bpz2 :: DF Float -> DF Float
bpz2 = fir2 (\x _ x2 -> (x - x2) * 0.5)

-- | Two zero fixed midcut filter.
brz2 :: DF Float -> DF Float
brz2 = fir2 (\x _ x2 -> (x + x2) * 0.5)

-- | Two point average filter
lpz1 :: DF Float -> DF Float
lpz1 = fir1 0 (\x x1 -> (x + x1) * 0.5)

-- | Two zero fixed lowpass filter
lpz2 :: DF Float -> DF Float
lpz2 = fir2 (\x x1 x2 -> (x + (2.0 * x1) + x2) * 0.25)

-- | Given /cf/ construct 'iir1' one-pole function.
one_pole_f :: Fractional a => a -> Binary_Op a
one_pole_f cf x y1 = ((1.0 - abs cf) * x) + (cf * y1)

-- | One pole filter.
--
-- > let {n = white_noise 0
-- >     ;f = one_pole (n * 0.5) 0.95}
-- > in audition [] (out1 f)
one_pole :: DF Float -> DF Float -> DF Float
one_pole i cf = iir1 0.0 (one_pole_f cf) i

-- | Given /cf/ construct 'fir1' one-zero function.
one_zero_f :: Fractional a => a -> Binary_Op a
one_zero_f cf x x1 = ((1.0 - abs cf) * x) + (cf * x1)

-- | One zero filter.
--
-- > let {n = white_noise 0
-- >     ;f = one_zero (n * 0.5) 0.5}
-- > in audition [] (out1 f)
one_zero :: DF Float -> DF Float -> DF Float
one_zero i cf = fir1 0 (one_zero_f cf) i

-- | Given coefficients construct 'biquad' 'sos' function.
sos_f :: Num a => a -> a -> a -> a -> a -> Quinary_Op a
sos_f a0 a1 a2 b1 b2 x x1 x2 y1 y2 = a0*x + a1*x1 + a2*x2 + b1*y1 + b2*y2

-- | Second order filter section.
sos :: DF Float -> DF Float -> DF Float -> DF Float -> DF Float -> DF Float -> DF Float
sos i a0 a1 a2 b1 b2 = biquad (sos_f a0 a1 a2 b1 b2) i

-- | Given /f/ and /rq/ construct 'iir2' 'resonz' function.
resonz_f :: DF Float -> DF Float -> Ternary_Op (DF Float)
resonz_f f rq x y1 y2 =
    let ff = f * w_radians_per_sample
        b = ff * rq
        r = 1.0 - b * 0.5
        two_r = 2.0 * r
        r2 = r * r
        ct = (two_r * cos ff) / (1.0 + r2)
        b1 = two_r * ct
        b2 = negate r2
        a0 = (1.0 - r2) * 0.5
        y0 = x + b1 * y1 + b2 * y2
    in a0 * (y0 - y2)

-- | A two pole resonant filter with zeroes at z = +/- 1. Based on
-- K. Steiglitz, \"A Note on Constant-Gain Digital Resonators\",
-- /Computer Music Journal/, vol 18, no. 4, pp. 8-10, Winter 1994.
-- The reciprocal of Q is used rather than Q because it saves a divide
-- operation inside the unit generator.
--
-- Inputs are: /i/ = input signal, /f/ = resonant frequency (in
-- hertz), /rq/ = bandwidth ratio (reciprocal of Q);where /rq/ =
-- bandwidth / centerFreq.
--
-- > let {n = white_noise 0
-- >     ;r = resonz (n * 0.5) 440.0 0.1}
-- > in audition [] (out1 r)
--
-- Modulate frequency
--
-- > let {n = white_noise 0
-- >     ;f = lf_saw 0.1 0.0 * 3500.0 + 4500.0
-- >     ;r = resonz (n * 0.5) f 0.05}
-- > in audition [] (out1 r)
resonz :: DF Float -> DF Float -> DF Float -> DF Float
resonz i f rq = iir2 (resonz_f f rq) i

-- | Given /f/ and /r/ construct 'iir2' 'rlpf' function.
rlpf_f :: DF Float -> DF Float -> Ternary_Op (DF Float)
rlpf_f f r x y1 y2 =
    let qr = df_max (K 0.001) r
        pf = f * w_radians_per_sample
        d = tan (pf * qr * 0.5)
        c = (1.0 - d) / (1.0 + d)
        b1 = (1.0 + c) * cos pf
        b2 = negate c
        a0 = (1.0 + c - b1) * 0.25
    in a0 * x + b1 * y1 + b2 * y2

-- | Resonant low pass filter. Inputs are: /i/ = input signal, /f/ =
-- frequency (hertz), /rq/ = reciprocal of Q (resonance).
--
-- > let {n = white_noise 0
-- >     ;f = sin_osc 0.5 0.0  * 40.0 + 220.0
-- >     ;r = rlpf n f 0.1}
-- > in audition [] (out1 r)
rlpf :: DF Float -> DF Float -> DF Float -> DF Float
rlpf i f r = iir2 (rlpf_f f r) i

-- | 5-tuple
type T5 t = (t,t,t,t,t)

-- | 2nd order Butterworth high-pass filter coefficients.
--
-- > hpf_c 48000.0 (440.0 :: DF Float)
hpf_c :: Floating t => t -> t -> T5 t
hpf_c sr f =
    let c = tan ((pi * f) / sr)
        c2 = c ** 2.0
        s2 = sqrt 2.0
        a0 = (1.0 + (s2 * c) + c2) ** (-1.0)
        a1 = -2.0 * a0
        a2 = a0
        b1 = 2 * (c2 - 1.0) * a0
        b2 = (1.0 - (s2 * c) + c2) * a0
    in (a0,a1,a2,b1,b2)

-- | 'sos' of 'hpf_c'.
hpf :: DF Float -> DF Float -> DF Float
hpf i f =
    let sr = w_sample_rate
        (a0,a1,a2,b1,b2) = hpf_c sr f
    in sos i a0 a1 a2 b1 b2

-- * Triggers

-- | `df_gt` @0@.
positive :: K_Num a => DF a -> DF Bool
positive x = x `df_gt` 0

-- | 'df_not' of 'positive'.
non_positive :: K_Num a => DF a -> DF Bool
non_positive = df_not . positive

-- | 'fir1' /trigger/ function.
trigger_f :: K_Num a => DF a -> DF a -> DF Bool
trigger_f x x1 = positive x `df_and` non_positive x1

-- | True on non-positive to positive transition.
trigger :: K_Num a => DF a -> DF Bool
trigger = fir1 0 trigger_f

-- | Count 'True' values at input.
--
-- > let n = white_noise 0
-- > in audition_text 12 (out2 n (count_true (trigger n)))
count_true :: K_Num a => DF Bool -> DF a
count_true s = rec_h 0 (\y1 -> split (select2 s (y1 + 1) y1))

-- | Pulse divider at 'Bool'.
pulse_divider :: DF Bool -> DF Int32 -> DF Int32 -> DF Bool
pulse_divider tr n st =
    let c = count_true tr + st
    in tr `df_and` ((c `df_mod` n) `df_eq` 0)

-- | SC3 @PulseDivider@.
--
-- > let n = white_noise 0
-- > in audition_text 12 (out2 n (pulse_divider' n 2 1))
pulse_divider' :: K_Num a => DF a -> DF Int32 -> DF Int32 -> DF a
pulse_divider' tr n =
    let f x = select2 x 1 0
    in f . pulse_divider (trigger tr) n

-- | Sample and hold. Holds input signal value when triggered.  Inputs
-- are: /i/ = input signal, /t/ = trigger.
--
-- > let {n = white_noise 0
-- >     ;i = impulse 9.0 0.0
-- >     ;l = latch n (trigger i)
-- >     ;o = sin_osc (l * 400.0 + 500.0) 0.0}
-- > in audition [] (out1 (o * 0.2))
latch :: K_Num a => DF a -> DF Bool -> DF a
latch i t = iir1 0 (select2 t) i

-- * Decays

-- | Given /dt/ construct 'iir1' 'decay' function.
decay_f :: DF Float -> Binary_Op (DF Float)
decay_f dt x y1 =
    let b1 = exp (log 0.001 / (dt * w_sample_rate))
    in x + b1 * y1

-- | Exponential decay. Inputs are: /i/ = input signal, /t/ = decay
-- time.  This is essentially the same as Integrator except that
-- instead of supplying the coefficient directly, it is caculated from
-- a 60 dB decay time. This is the time required for the integrator to
-- lose 99.9 % of its value or -60dB. This is useful for exponential
-- decaying envelopes triggered by impulses.
--
-- Used as an envelope.
--
-- > let {n = brown_noise 0
-- >     ;f = lf_saw 0.1 0.0
-- >     ;i = impulse (lin_lin f (-1.0) 1.0 2.0 5.0) 0.25
-- >     ;e = decay i 0.2}
-- > in audition [] (out1 (e * n))
decay :: DF Float -> DF Float -> DF Float
decay i dt = iir1 0.0 (decay_f dt) i

-- | Exponential decay (equivalent to @decay dcy - decay atk@).
decay2 :: DF Float -> DF Float -> DF Float -> DF Float
decay2 i atk dcy = decay i dcy - decay i atk

-- * Delays

-- | Single sample delay.
delay1 :: K_Num a => DF a -> DF a
delay1 = iir1 0 (\_ y1 -> y1)

-- | Two sample delay.
delay2 :: K_Num a => DF a -> DF a
delay2 = iir2 (\_ _ y2 -> y2)

-- * Lags

-- | Given /t/ construct 'iir1' 'lag' function.
lag_f :: DF Float -> Binary_Op (DF Float)
lag_f t x y1 =
    let b1 = exp (log (0.001 / (t * w_sample_rate)))
    in x + b1 * (y1 - x)

-- | Simple averaging filter.  Inputs are: /i/ = input signal, /t/ =
-- lag time.
--
-- > let {s = sin_osc 0.05 0.0
-- >     ;f = lin_lin s (-1.0) 1.0 220.0 440.0
-- >     ;o = sin_osc f 0.0
-- >     ;f' = lag f 1.0
-- >     ;o' = sin_osc f' 0.0}
-- > in audition [] (out2 (o * 0.2) (o' * 0.2))
lag :: DF Float -> DF Float -> DF Float
lag i t = iir1 0 (lag_f t) i

-- | Nested lag filter.
lag2 :: DF Float -> DF Float -> DF Float
lag2 i t = lag (lag i t) t

-- | Twice nested lag filter.
lag3 :: DF Float -> DF Float -> DF Float
lag3 i t = lag (lag (lag i t) t) t