-- | Haskell implementations of SC3 UGens.
module Sound.SC3.UGen.HS where

import Data.List {- base -}
import qualified System.Random as R {- random -}

import Sound.SC3.Common.Math
import qualified Sound.SC3.Common.Math.Filter as Filter

-- | F = function, ST = state
type F_ST0 st o = st -> (o,st)
type F_ST1 st i o = (i,st) -> (o,st)

-- | U = uniform
type F_U2 n = n -> n -> n
type F_U3 n = n -> n -> n -> n
type F_U4 n = n -> n -> n -> n -> n
type F_U5 n = n -> n -> n -> n -> n -> n
type F_U6 n = n -> n -> n -> n -> n -> n -> n
type F_U7 n = n -> n -> n -> n -> n -> n -> n -> n
type F_U8 n = n -> n -> n -> n -> n -> n -> n -> n -> n
type F_U9 n = n -> n -> n -> n -> n -> n -> n -> n -> n -> n

-- | T = tuple
type T2 n = (n,n)
type T3 n = (n,n,n)
type T4 n = (n,n,n,n)
type T5 n = (n,n,n,n,n)
type T6 n = (n,n,n,n,n,n)
type T7 n = (n,n,n,n,n,n,n)
type T8 n = (n,n,n,n,n,n,n,n)
type T9 n = (n,n,n,n,n,n,n,n,n)

-- | avg = average
avg2 :: Fractional n => F_U2 n
avg2 :: F_U2 n
avg2 n
p n
q = (n
p F_U2 n
forall a. Num a => a -> a -> a
+ n
q) F_U2 n
forall a. Fractional a => a -> a -> a
/ n
2

avg3 :: Fractional n => F_U3 n
avg3 :: F_U3 n
avg3 n
p n
q n
r = (n
p n -> n -> n
forall a. Num a => a -> a -> a
+ n
q n -> n -> n
forall a. Num a => a -> a -> a
+ n
r) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
3

avg4 :: Fractional n => F_U4 n
avg4 :: F_U4 n
avg4 n
p n
q n
r n
s = (n
p n -> n -> n
forall a. Num a => a -> a -> a
+ n
q n -> n -> n
forall a. Num a => a -> a -> a
+ n
r n -> n -> n
forall a. Num a => a -> a -> a
+ n
s) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
4

avg5 :: Fractional n => F_U5 n
avg5 :: F_U5 n
avg5 n
p n
q n
r n
s n
t = (n
p n -> n -> n
forall a. Num a => a -> a -> a
+ n
q n -> n -> n
forall a. Num a => a -> a -> a
+ n
r n -> n -> n
forall a. Num a => a -> a -> a
+ n
s n -> n -> n
forall a. Num a => a -> a -> a
+ n
t) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
5

avg9 :: Fractional n => F_U9 n
avg9 :: F_U9 n
avg9 n
p n
q n
r n
s n
t n
u n
v n
w n
x = (n
p n -> n -> n
forall a. Num a => a -> a -> a
+ n
q n -> n -> n
forall a. Num a => a -> a -> a
+ n
r n -> n -> n
forall a. Num a => a -> a -> a
+ n
s n -> n -> n
forall a. Num a => a -> a -> a
+ n
t n -> n -> n
forall a. Num a => a -> a -> a
+ n
u n -> n -> n
forall a. Num a => a -> a -> a
+ n
v n -> n -> n
forall a. Num a => a -> a -> a
+ n
w n -> n -> n
forall a. Num a => a -> a -> a
+ n
x) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
9

-- | fir = finite impulse response
fir1 :: F_U2 n -> F_ST1 n n n
fir1 :: F_U2 n -> F_ST1 n n n
fir1 F_U2 n
f (n
n,n
z0) = (F_U2 n
f n
n n
z0,n
n)

fir2 :: F_U3 n -> F_ST1 (T2 n) n n
fir2 :: F_U3 n -> F_ST1 (T2 n) n n
fir2 F_U3 n
f (n
n,(n
z1,n
z0)) = (F_U3 n
f n
n n
z0 n
z1,(n
z0,n
n))

fir3 :: F_U4 n -> F_ST1 (T3 n) n n
fir3 :: F_U4 n -> F_ST1 (T3 n) n n
fir3 F_U4 n
f (n
n,(n
z2,n
z1,n
z0)) = (F_U4 n
f n
n n
z0 n
z1 n
z2,(n
z1,n
z0,n
n))

fir4 :: F_U5 n -> F_ST1 (T4 n) n n
fir4 :: F_U5 n -> F_ST1 (T4 n) n n
fir4 F_U5 n
f (n
n,(n
z3,n
z2,n
z1,n
z0)) = (F_U5 n
f n
n n
z0 n
z1 n
z2 n
z3,(n
z2,n
z1,n
z0,n
n))

fir8 :: F_U9 n -> F_ST1 (T8 n) n n
fir8 :: F_U9 n -> F_ST1 (T8 n) n n
fir8 F_U9 n
f (n
n,(n
z7,n
z6,n
z5,n
z4,n
z3,n
z2,n
z1,n
z0)) = (F_U9 n
f n
n n
z0 n
z1 n
z2 n
z3 n
z4 n
z5 n
z6 n
z7,(n
z6,n
z5,n
z4,n
z4,n
z2,n
z1,n
z0,n
n))

-- | iir = infinite impulse response
iir1 :: F_U2 n -> F_ST1 n n n
iir1 :: F_U2 n -> F_ST1 n n n
iir1 F_U2 n
f (n
n,n
y0) = let r :: n
r = F_U2 n
f n
n n
y0 in (n
r,n
r)

iir2 :: F_U3 n -> F_ST1 (T2 n) n n
iir2 :: F_U3 n -> F_ST1 (T2 n) n n
iir2 F_U3 n
f (n
n,(n
y1,n
y0)) = let r :: n
r = F_U3 n
f n
n n
y0 n
y1 in (n
r,(n
y0,n
r))

-- | ff = feed-forward, fb = feed-back
iir2_ff_fb :: (n -> n -> n -> T2 n) -> F_ST1 (T2 n) n n
iir2_ff_fb :: (n -> n -> n -> T2 n) -> F_ST1 (T2 n) n n
iir2_ff_fb n -> n -> n -> T2 n
f (n
n,(n
y1,n
y0)) = let (n
r,n
y0') = n -> n -> n -> T2 n
f n
n n
y0 n
y1 in (n
r,(n
y0,n
y0'))

biquad :: F_U5 n -> F_ST1 (T4 n) n n
biquad :: F_U5 n -> F_ST1 (T4 n) n n
biquad F_U5 n
f (n
n,(n
x1,n
x0,n
y1,n
y0)) = let r :: n
r = F_U5 n
f n
n n
x0 n
x1 n
y0 n
y1 in (n
r,(n
x0,n
n,n
y0,n
r))

-- | sos = second order section
sos_f :: Num n => T5 n -> F_U5 n
sos_f :: T5 n -> F_U5 n
sos_f (n
a0,n
a1,n
a2,n
b1,n
b2) n
x n
x1 n
x2 n
y1 n
y2 = n
a0n -> n -> n
forall a. Num a => a -> a -> a
*n
x n -> n -> n
forall a. Num a => a -> a -> a
+ n
a1n -> n -> n
forall a. Num a => a -> a -> a
*n
x1 n -> n -> n
forall a. Num a => a -> a -> a
+ n
a2n -> n -> n
forall a. Num a => a -> a -> a
*n
x2 n -> n -> n
forall a. Num a => a -> a -> a
- n
b1n -> n -> n
forall a. Num a => a -> a -> a
*n
y1 n -> n -> n
forall a. Num a => a -> a -> a
- n
b2n -> n -> n
forall a. Num a => a -> a -> a
*n
y2

sos :: Num n => T5 n -> F_ST1 (T4 n) n n
sos :: T5 n -> F_ST1 (T4 n) n n
sos T5 n
p = F_U5 n -> F_ST1 (T4 n) n n
forall n. F_U5 n -> F_ST1 (T4 n) n n
biquad (T5 n -> F_U5 n
forall n. Num n => T5 n -> F_U5 n
sos_f T5 n
p)

-- | hp = high pass
hpz1 :: Fractional n => F_ST1 n n n
hpz1 :: F_ST1 n n n
hpz1 = F_U2 n -> F_ST1 n n n
forall n. F_U2 n -> F_ST1 n n n
fir1 (\n
n n
z0 -> n
0.5 F_U2 n
forall a. Num a => a -> a -> a
* (n
n F_U2 n
forall a. Num a => a -> a -> a
- n
z0))

hpz2 :: Fractional n => F_ST1 (T2 n) n n
hpz2 :: F_ST1 (T2 n) n n
hpz2 = F_U3 n -> F_ST1 (T2 n) n n
forall n. F_U3 n -> F_ST1 (T2 n) n n
fir2 (\n
n n
z0 n
z1 -> n
0.25 n -> n -> n
forall a. Num a => a -> a -> a
* (n
n n -> n -> n
forall a. Num a => a -> a -> a
- (n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n
z0) n -> n -> n
forall a. Num a => a -> a -> a
+ n
z1))

-- | lp = low pass
lpz1 :: Fractional n => F_ST1 n n n
lpz1 :: F_ST1 n n n
lpz1 = F_U2 n -> F_ST1 n n n
forall n. F_U2 n -> F_ST1 n n n
fir1 F_U2 n
forall a. Fractional a => a -> a -> a
avg2

lpz2 :: Fractional n => F_ST1 (T2 n) n n
lpz2 :: F_ST1 (T2 n) n n
lpz2 = F_U3 n -> F_ST1 (T2 n) n n
forall n. F_U3 n -> F_ST1 (T2 n) n n
fir2 (\n
n n
z0 n
z1 -> n
0.25 n -> n -> n
forall a. Num a => a -> a -> a
* (n
n n -> n -> n
forall a. Num a => a -> a -> a
+ (n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n
z0) n -> n -> n
forall a. Num a => a -> a -> a
+ n
z1))

-- | bp = band pass
bpz2 :: Fractional n => F_ST1 (T2 n) n n
bpz2 :: F_ST1 (T2 n) n n
bpz2 = F_U3 n -> F_ST1 (T2 n) n n
forall n. F_U3 n -> F_ST1 (T2 n) n n
fir2 (\n
n n
_z0 n
z1 -> n
0.5 n -> n -> n
forall a. Num a => a -> a -> a
* (n
n n -> n -> n
forall a. Num a => a -> a -> a
- n
z1))

-- | br = band reject
brz2 :: Fractional n => F_ST1 (T2 n) n n
brz2 :: F_ST1 (T2 n) n n
brz2 = F_U3 n -> F_ST1 (T2 n) n n
forall n. F_U3 n -> F_ST1 (T2 n) n n
fir2 (\n
n n
_z0 n
z1 -> n
0.5 n -> n -> n
forall a. Num a => a -> a -> a
* (n
n n -> n -> n
forall a. Num a => a -> a -> a
+ n
z1))

-- | mavg = moving average
mavg5 :: Fractional n => F_ST1 (T4 n) n n
mavg5 :: F_ST1 (T4 n) n n
mavg5 = F_U5 n -> F_ST1 (T4 n) n n
forall n. F_U5 n -> F_ST1 (T4 n) n n
fir4 F_U5 n
forall n. Fractional n => F_U5 n
avg5

mavg9 :: Fractional n => F_ST1 (T8 n) n n
mavg9 :: F_ST1 (T8 n) n n
mavg9 = F_U9 n -> F_ST1 (T8 n) n n
forall n. F_U9 n -> F_ST1 (T8 n) n n
fir8 F_U9 n
forall n. Fractional n => F_U9 n
avg9

-- | Sample rate (SR) to radians per sample (RPS).
--
-- > sr_to_rps 44100 == 0.00014247585730565955
sr_to_rps :: Floating n => n -> n
sr_to_rps :: n -> n
sr_to_rps n
sr = n
forall n. Floating n => n
two_pi n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
sr

resonz_f :: Floating n => T3 n -> (n -> n -> n -> T2 n)
resonz_f :: T3 n -> n -> n -> n -> T2 n
resonz_f T3 n
param n
x n
y1 n
y2 =
    let (n
a0,n
b1,n
b2) = T3 n -> T3 n
forall n. Floating n => (n, n, n) -> (n, n, n)
Filter.resonz_coef T3 n
param
        y0 :: n
y0 = n
x n -> n -> n
forall a. Num a => a -> a -> a
+ n
b1 n -> n -> n
forall a. Num a => a -> a -> a
* n
y1 n -> n -> n
forall a. Num a => a -> a -> a
+ n
b2 n -> n -> n
forall a. Num a => a -> a -> a
* n
y2
    in (n
a0 n -> n -> n
forall a. Num a => a -> a -> a
* (n
y0 n -> n -> n
forall a. Num a => a -> a -> a
- n
y2),n
y0)

-- | ir = initialization rate
resonz_ir :: Floating n => T3 n -> F_ST1 (T2 n) n n
resonz_ir :: T3 n -> F_ST1 (T2 n) n n
resonz_ir T3 n
p = (n -> n -> n -> T2 n) -> F_ST1 (T2 n) n n
forall n. (n -> n -> n -> T2 n) -> F_ST1 (T2 n) n n
iir2_ff_fb (T3 n -> n -> n -> n -> T2 n
forall n. Floating n => T3 n -> n -> n -> n -> T2 n
resonz_f T3 n
p)

-- | rlpf = resonant low pass filter
rlpf_f :: Floating n => (n -> n -> n) -> T3 n -> F_U3 n
rlpf_f :: (n -> n -> n) -> T3 n -> F_U3 n
rlpf_f n -> n -> n
max_f T3 n
param n
x n
y1 n
y2 =
    let (n
a0,n
b1,n
b2) = (n -> n -> n) -> T3 n -> T3 n
forall n. Floating n => (n -> n -> n) -> (n, n, n) -> (n, n, n)
Filter.rlpf_coef n -> n -> n
max_f T3 n
param
    in n
a0 n -> n -> n
forall a. Num a => a -> a -> a
* n
x n -> n -> n
forall a. Num a => a -> a -> a
+ n
b1 n -> n -> n
forall a. Num a => a -> a -> a
* n
y1 n -> n -> n
forall a. Num a => a -> a -> a
+ n
b2 n -> n -> n
forall a. Num a => a -> a -> a
* n
y2

rlpf_ir :: (Floating n, Ord n) => T3 n -> F_ST1 (T2 n) n n
rlpf_ir :: T3 n -> F_ST1 (T2 n) n n
rlpf_ir T3 n
p = F_U3 n -> F_ST1 (T2 n) n n
forall n. F_U3 n -> F_ST1 (T2 n) n n
iir2 ((n -> n -> n) -> T3 n -> F_U3 n
forall n. Floating n => (n -> n -> n) -> T3 n -> F_U3 n
rlpf_f n -> n -> n
forall a. Ord a => a -> a -> a
max T3 n
p)

bw_hpf_ir :: Floating n => T2 n -> F_ST1 (T4 n) n n
bw_hpf_ir :: T2 n -> F_ST1 (T4 n) n n
bw_hpf_ir (n
sample_rate,n
f) = T5 n -> F_ST1 (T4 n) n n
forall n. Num n => T5 n -> F_ST1 (T4 n) n n
sos (Bool -> n -> n -> T5 n
forall n. Floating n => Bool -> n -> n -> (n, n, n, n, n)
Filter.bw_lpf_or_hpf_coef Bool
True n
sample_rate n
f)

bw_lpf_ir :: Floating n => T2 n -> F_ST1 (T4 n) n n
bw_lpf_ir :: T2 n -> F_ST1 (T4 n) n n
bw_lpf_ir (n
sample_rate,n
f) = T5 n -> F_ST1 (T4 n) n n
forall n. Num n => T5 n -> F_ST1 (T4 n) n n
sos (Bool -> n -> n -> T5 n
forall n. Floating n => Bool -> n -> n -> (n, n, n, n, n)
Filter.bw_lpf_or_hpf_coef Bool
False n
sample_rate n
f)

white_noise :: (R.RandomGen g, Fractional n, R.Random n) => F_ST0 g n
white_noise :: F_ST0 g n
white_noise = (n, n) -> F_ST0 g n
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
R.randomR (-n
1.0,n
1.0)

brown_noise_f :: (Fractional n, Ord n) => n -> n -> n
brown_noise_f :: n -> n -> n
brown_noise_f n
x n
y1 =
    let z :: n
z = n
x n -> n -> n
forall a. Num a => a -> a -> a
+ n
y1
    in if n
z n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
1.0 then n
2.0 n -> n -> n
forall a. Num a => a -> a -> a
- n
z else if n
z n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< (-n
1.0) then (-n
2.0) n -> n -> n
forall a. Num a => a -> a -> a
- n
z else n
z

brown_noise :: (R.RandomGen g, Fractional n, R.Random n, Ord n) => F_ST0 (g,n) n
brown_noise :: F_ST0 (g, n) n
brown_noise (g
g,n
y1) =
    let (n
n,g
g') = F_ST0 g n
forall g n. (RandomGen g, Fractional n, Random n) => F_ST0 g n
white_noise g
g
        r :: n
r = n -> n -> n
forall n. (Fractional n, Ord n) => n -> n -> n
brown_noise_f (n
n n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
8.0) n
y1
    in (n
r,(g
g',n
r))

-- | <http://musicdsp.org/files/pink.txt>
pk_pinking_filter_f :: Fractional a => (a, a, a, a, a, a, a) -> a -> (a, (a, a, a, a, a, a, a))
pk_pinking_filter_f :: (a, a, a, a, a, a, a) -> a -> (a, (a, a, a, a, a, a, a))
pk_pinking_filter_f (a
b0,a
b1,a
b2,a
b3,a
b4,a
b5,a
b6) a
w =
  let b0' :: a
b0' = a
0.99886 a -> a -> a
forall a. Num a => a -> a -> a
* a
b0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.0555179
      b1' :: a
b1' = a
0.99332 a -> a -> a
forall a. Num a => a -> a -> a
* a
b1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.0750759
      b2' :: a
b2' = a
0.96900 a -> a -> a
forall a. Num a => a -> a -> a
* a
b2 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.1538520
      b3' :: a
b3' = a
0.86650 a -> a -> a
forall a. Num a => a -> a -> a
* a
b3 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.3104856
      b4' :: a
b4' = a
0.55000 a -> a -> a
forall a. Num a => a -> a -> a
* a
b4 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5329522
      b5' :: a
b5' = -a
0.7616 a -> a -> a
forall a. Num a => a -> a -> a
* a
b5 a -> a -> a
forall a. Num a => a -> a -> a
- a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.0168980
      p :: a
p = a
b0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b2 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b3 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b4 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b5 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b6 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5362
      b6' :: a
b6' = a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.115926
  in (a
p,(a
b0',a
b1',a
b2',a
b3',a
b4',a
b5',a
b6'))

-- | <http://musicdsp.org/files/pink.txt>
pk_pinking_filter_economy_f :: Fractional a => (a, a, a) -> a -> (a, (a, a, a))
pk_pinking_filter_economy_f :: (a, a, a) -> a -> (a, (a, a, a))
pk_pinking_filter_economy_f (a
b0,a
b1,a
b2) a
w =
  let b0' :: a
b0' = a
0.99765 a -> a -> a
forall a. Num a => a -> a -> a
* a
b0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.0990460
      b1' :: a
b1' = a
0.96300 a -> a -> a
forall a. Num a => a -> a -> a
* a
b1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.2965164
      b2' :: a
b2' = a
0.57000 a -> a -> a
forall a. Num a => a -> a -> a
* a
b2 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
1.0526913
      p :: a
p = a
b0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b2 a -> a -> a
forall a. Num a => a -> a -> a
+ a
w a -> a -> a
forall a. Num a => a -> a -> a
* a
0.1848
  in (a
p,(a
b0',a
b1',a
b2'))

-- | dt must not be zero.
decay_f :: Floating a => a -> a -> a -> a -> a
decay_f :: a -> a -> a -> a -> a
decay_f a
sr a
dt a
x a
y1 =
    let b1 :: a
b1 = a -> a
forall a. Floating a => a -> a
exp (a -> a
forall a. Floating a => a -> a
log a
0.001 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
dt a -> a -> a
forall a. Num a => a -> a -> a
* a
sr))
    in a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
b1 a -> a -> a
forall a. Num a => a -> a -> a
* a
y1

-- | Given time /dt/ in frames construct 'iir1' 'lag' function.
--   dt must not be zero.
lag_f_frames :: Floating a => a -> a -> a -> a
lag_f_frames :: a -> a -> a -> a
lag_f_frames a
dt a
x a
y1 = let b1 :: a
b1 = a -> a
forall a. Floating a => a -> a
exp (a -> a
forall a. Floating a => a -> a
log a
0.001 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
dt) in a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
b1 a -> a -> a
forall a. Num a => a -> a -> a
* (a
y1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x)

-- | 'lag_f_frames' with /dt/ in seconds.
lag_f :: Floating a => a -> a -> a -> a -> a
lag_f :: a -> a -> a -> a -> a
lag_f a
sr a
dt = a -> a -> a -> a
forall a. Floating a => a -> a -> a -> a
lag_f_frames (a
dt a -> a -> a
forall a. Num a => a -> a -> a
* a
sr)

lag :: Floating t => t -> F_ST1 t (t,t) t
lag :: t -> F_ST1 t (t, t) t
lag t
sr ((t
i,t
t),t
st) = let r :: t
r = t -> t -> t -> t -> t
forall a. Floating a => a -> a -> a -> a -> a
lag_f t
sr t
t t
i t
st in (t
r,t
r)

slope :: Num t => t -> F_ST1 t t t
slope :: t -> F_ST1 t t t
slope t
sr = F_U2 t -> F_ST1 t t t
forall n. F_U2 n -> F_ST1 n n n
fir1 (\t
n t
z0 -> (t
n F_U2 t
forall a. Num a => a -> a -> a
- t
z0) F_U2 t
forall a. Num a => a -> a -> a
* t
sr)

latch :: F_ST1 t (t,Bool) t
latch :: F_ST1 t (t, Bool) t
latch ((t
n,Bool
b),t
y1) = let r :: t
r = if Bool
b then t
n else t
y1 in (t
r,t
r)

as_trig :: (Fractional t,Ord t) => F_ST1 t t Bool
as_trig :: F_ST1 t t Bool
as_trig (t
n,t
y1) = (t
y1 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0.0 Bool -> Bool -> Bool
&& t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0.0,t
n)

phasor :: RealFrac t => F_ST1 t (Bool,t,t,t,t) t
phasor :: F_ST1 t (Bool, t, t, t, t) t
phasor ((Bool
trig,t
rate,t
start,t
end,t
resetPos),t
ph) =
    let r :: t
r = if Bool
trig then t
resetPos else t -> t -> t -> t
forall n. RealFrac n => n -> n -> n -> n
sc3_wrap t
start t
end (t
ph t -> t -> t
forall a. Num a => a -> a -> a
+ t
rate)
    in (t
ph,t
r)

-- > Sound.SC3.Plot.plot_fn_r1_ln (\x -> mod_dif x 0 1) (0,4)
mod_dif :: RealFrac a => a -> a -> a -> a
mod_dif :: a -> a -> a -> a
mod_dif a
i a
j a
m =
  let d :: a
d = a -> a -> a
forall a. Num a => a -> a -> a
absdif a
i a
j a -> a -> a
forall n. RealFrac n => n -> n -> n
`sc3_mod` a
m
      h :: a
h = a
m a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5
  in a
h a -> a -> a
forall a. Num a => a -> a -> a
- a -> a -> a
forall a. Num a => a -> a -> a
absdif a
d a
h

{-
-- > Sound.SC3.Plot.plot_fn_r1_ln (\x -> modDif x 0 1) (0,4)
modDif :: BinaryOp a => a -> a -> a -> a
modDif i j m =
  let d = absDif i j `modE` m
      h = m * 0.5
  in h - absDif d h
-}

-- | * LIST PROCESSING

l_apply_f_st0 :: F_ST0 st o -> st -> [o]
l_apply_f_st0 :: F_ST0 st o -> st -> [o]
l_apply_f_st0 F_ST0 st o
f st
st = let (o
r,st
st') = F_ST0 st o
f st
st in o
r o -> [o] -> [o]
forall a. a -> [a] -> [a]
: F_ST0 st o -> st -> [o]
forall st o. F_ST0 st o -> st -> [o]
l_apply_f_st0 F_ST0 st o
f st
st'

-- > take 10 (l_white_noise 'α')
l_white_noise :: (Enum e, Fractional n, R.Random n) => e -> [n]
l_white_noise :: e -> [n]
l_white_noise e
e = F_ST0 StdGen n -> StdGen -> [n]
forall st o. F_ST0 st o -> st -> [o]
l_apply_f_st0 F_ST0 StdGen n
forall g n. (RandomGen g, Fractional n, Random n) => F_ST0 g n
white_noise (Int -> StdGen
R.mkStdGen (e -> Int
forall a. Enum a => a -> Int
fromEnum e
e))

-- > take 10 (l_brown_noise 'α')
l_brown_noise :: (Enum e, Fractional n, Ord n, R.Random n) => e -> [n]
l_brown_noise :: e -> [n]
l_brown_noise e
e = F_ST0 (StdGen, n) n -> (StdGen, n) -> [n]
forall st o. F_ST0 st o -> st -> [o]
l_apply_f_st0 F_ST0 (StdGen, n) n
forall g n.
(RandomGen g, Fractional n, Random n, Ord n) =>
F_ST0 (g, n) n
brown_noise (Int -> StdGen
R.mkStdGen (e -> Int
forall a. Enum a => a -> Int
fromEnum e
e),n
0.0)

l_apply_f_st1 :: F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 :: F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 st i o
f st
st [i]
xs =
    case [i]
xs of
      [] -> []
      i
x:[i]
xs' -> let (o
r,st
st') = F_ST1 st i o
f (i
x,st
st) in o
r o -> [o] -> [o]
forall a. a -> [a] -> [a]
: F_ST1 st i o -> st -> [i] -> [o]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 st i o
f st
st' [i]
xs'

l_lag :: Floating t => t -> [t] -> [t] -> [t]
l_lag :: t -> [t] -> [t] -> [t]
l_lag t
sr [t]
i [t]
t = F_ST1 t (t, t) t -> t -> [(t, t)] -> [t]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 (t -> F_ST1 t (t, t) t
forall t. Floating t => t -> F_ST1 t (t, t) t
lag t
sr) t
0 ([t] -> [t] -> [(t, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [t]
i [t]
t)

l_slope :: Floating t => t -> [t] -> [t]
l_slope :: t -> [t] -> [t]
l_slope t
sr = F_ST1 t t t -> t -> [t] -> [t]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 (t -> F_ST1 t t t
forall t. Num t => t -> F_ST1 t t t
slope t
sr) t
0

-- > let rp = repeat
-- > take 10 (l_phasor (rp False) (rp 1) (rp 0) (rp 4) (rp 0)) == [0,1,2,3,0,1,2,3,0,1]
l_phasor :: RealFrac n => [Bool] -> [n] -> [n] -> [n] -> [n] -> [n]
l_phasor :: [Bool] -> [n] -> [n] -> [n] -> [n] -> [n]
l_phasor [Bool]
trig [n]
rate [n]
start [n]
end [n]
resetPos =
    let i :: [(Bool, n, n, n, n)]
i = [Bool] -> [n] -> [n] -> [n] -> [n] -> [(Bool, n, n, n, n)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 [Bool]
trig [n]
rate [n]
start [n]
end [n]
resetPos
    in F_ST1 n (Bool, n, n, n, n) n -> n -> [(Bool, n, n, n, n)] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 n (Bool, n, n, n, n) n
forall t. RealFrac t => F_ST1 t (Bool, t, t, t, t) t
phasor ([n] -> n
forall a. [a] -> a
head [n]
start) [(Bool, n, n, n, n)]
i

l_phasor_osc :: RealFrac n => n -> n -> [n] -> [n]
l_phasor_osc :: n -> n -> [n] -> [n]
l_phasor_osc n
sr n
k [n]
f =
    let rp :: a -> [a]
rp = a -> [a]
forall a. a -> [a]
repeat
    in [Bool] -> [n] -> [n] -> [n] -> [n] -> [n]
forall n. RealFrac n => [Bool] -> [n] -> [n] -> [n] -> [n] -> [n]
l_phasor (Bool -> [Bool]
forall a. a -> [a]
rp Bool
False) ((n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (n -> n -> n -> n
forall a. Fractional a => a -> a -> a -> a
cps_to_incr n
sr n
k) [n]
f) (n -> [n]
forall a. a -> [a]
rp n
0) (n -> [n]
forall a. a -> [a]
rp n
k) (n -> [n]
forall a. a -> [a]
rp n
0)

l_sin_osc :: (Floating n, RealFrac n) => n -> [n] -> [n]
l_sin_osc :: n -> [n] -> [n]
l_sin_osc n
sr [n]
f = (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map n -> n
forall a. Floating a => a -> a
sin (n -> n -> [n] -> [n]
forall n. RealFrac n => n -> n -> [n] -> [n]
l_phasor_osc n
sr n
forall n. Floating n => n
two_pi [n]
f)

l_cos_osc :: (Floating n, RealFrac n) => n -> [n] -> [n]
l_cos_osc :: n -> [n] -> [n]
l_cos_osc n
sr [n]
f = (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map n -> n
forall a. Floating a => a -> a
cos (n -> n -> [n] -> [n]
forall n. RealFrac n => n -> n -> [n] -> [n]
l_phasor_osc n
sr n
forall n. Floating n => n
two_pi [n]
f)

l_hpz1 :: Fractional n => [n] -> [n]
l_hpz1 :: [n] -> [n]
l_hpz1 = F_ST1 n n n -> n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 n n n
forall n. Fractional n => F_ST1 n n n
hpz1 n
0

l_hpz2 :: Fractional n => [n] -> [n]
l_hpz2 :: [n] -> [n]
l_hpz2 = F_ST1 (T2 n) n n -> T2 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 (T2 n) n n
forall n. Fractional n => F_ST1 (T2 n) n n
hpz2 (n
0,n
0)

l_lpz1 :: Fractional n => [n] -> [n]
l_lpz1 :: [n] -> [n]
l_lpz1 = F_ST1 n n n -> n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 n n n
forall n. Fractional n => F_ST1 n n n
lpz1 n
0

l_lpz2 :: Fractional n => [n] -> [n]
l_lpz2 :: [n] -> [n]
l_lpz2 = F_ST1 (T2 n) n n -> T2 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 (T2 n) n n
forall n. Fractional n => F_ST1 (T2 n) n n
lpz2 (n
0,n
0)

l_bpz2 :: Fractional n => [n] -> [n]
l_bpz2 :: [n] -> [n]
l_bpz2 = F_ST1 (T2 n) n n -> T2 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 (T2 n) n n
forall n. Fractional n => F_ST1 (T2 n) n n
bpz2 (n
0,n
0)

l_brz2 :: Fractional n => [n] -> [n]
l_brz2 :: [n] -> [n]
l_brz2 = F_ST1 (T2 n) n n -> T2 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 (T2 n) n n
forall n. Fractional n => F_ST1 (T2 n) n n
brz2 (n
0,n
0)

l_bw_hpf :: Floating n => T2 n -> [n] -> [n]
l_bw_hpf :: T2 n -> [n] -> [n]
l_bw_hpf T2 n
p = F_ST1 (T4 n) n n -> T4 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 (T2 n -> F_ST1 (T4 n) n n
forall n. Floating n => T2 n -> F_ST1 (T4 n) n n
bw_hpf_ir T2 n
p) (n
0,n
0,n
0,n
0)

l_bw_lpf :: Floating n => T2 n -> [n] -> [n]
l_bw_lpf :: T2 n -> [n] -> [n]
l_bw_lpf T2 n
p = F_ST1 (T4 n) n n -> T4 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 (T2 n -> F_ST1 (T4 n) n n
forall n. Floating n => T2 n -> F_ST1 (T4 n) n n
bw_lpf_ir T2 n
p) (n
0,n
0,n
0,n
0)

l_resonz_ir :: Floating n => T3 n -> [n] -> [n]
l_resonz_ir :: T3 n -> [n] -> [n]
l_resonz_ir T3 n
p = F_ST1 (T2 n) n n -> T2 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 (T3 n -> F_ST1 (T2 n) n n
forall n. Floating n => T3 n -> F_ST1 (T2 n) n n
resonz_ir T3 n
p) (n
0,n
0)

l_rlpf_ir :: (Floating n, Ord n) => T3 n -> [n] -> [n]
l_rlpf_ir :: T3 n -> [n] -> [n]
l_rlpf_ir T3 n
p = F_ST1 (T2 n) n n -> T2 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 (T3 n -> F_ST1 (T2 n) n n
forall n. (Floating n, Ord n) => T3 n -> F_ST1 (T2 n) n n
rlpf_ir T3 n
p) (n
0,n
0)

l_mavg5 :: Fractional n => [n] -> [n]
l_mavg5 :: [n] -> [n]
l_mavg5 = F_ST1 (T4 n) n n -> T4 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 (T4 n) n n
forall n. Fractional n => F_ST1 (T4 n) n n
mavg5 (n
0,n
0,n
0,n
0)

l_mavg9 :: Fractional n => [n] -> [n]
l_mavg9 :: [n] -> [n]
l_mavg9 = F_ST1 (T8 n) n n -> T8 n -> [n] -> [n]
forall st i o. F_ST1 st i o -> st -> [i] -> [o]
l_apply_f_st1 F_ST1 (T8 n) n n
forall n. Fractional n => F_ST1 (T8 n) n n
mavg9 (n
0,n
0,n
0,n
0,n
0,n
0,n
0,n
0)

{-

import Sound.SC3.Plot {- hsc3-plot -}
import Sound.SC3.Plot.FFT {- hsc3-plot -}

let n = take 4096 (l_white_noise 'α')
let plotTable1 = plot_p1_ln . return

plotTable1 n
plotTable1 (take 4096 (l_brown_noise 'α'))

plotTable1 (l_lpz1 n)
plotTable1 (l_lpz2 n)
plotTable1 (l_hpz1 n)
plotTable1 (l_hpz2 n)

plotTable1 (rfft_pure n)
plotTable1 (rfft_pure (l_lpz1 n))
plotTable1 (rfft_pure (l_lpz2 n))
plotTable1 (rfft_pure (l_hpz1 n))
plotTable1 (rfft_pure (l_hpz2 n))
plotTable1 (rfft_pure (l_bpz2 n))
plotTable1 (rfft_pure (l_brz2 n))
plotTable1 (rfft_pure (l_bw_lpf (44100,9000) n))
plotTable1 (rfft_pure (l_bw_hpf (44100,9000) n))
plotTable1 (rfft_pure (l_resonz_ir (sr_to_rps 44100,440,0.1) n))
plotTable1 (rfft_pure (l_rlpf_ir (sr_to_rps 44100,1200,0.1) n))

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

plot_fft1_mnn 44100 (rfft_pure (l_bw_lpf (44100,midi_to_cps 60) n))
plot_fft1_mnn 44100 (rfft_pure (l_resonz_ir (sr_to_rps 44100,midi_to_cps 69,0.1) n))
plot_fft1_mnn 44100 (rfft_pure (l_rlpf_ir (sr_to_rps 44100,midi_to_cps 86,0.1) n))

plotTable1 (l_mavg9 (rfft_pure n))
plotTable1 (l_mavg9 (rfft_pure (l_lpz2 n)))
plotTable1 (l_mavg9 (rfft_pure (l_hpz2 n)))
plotTable1 (l_mavg9 (rfft_pure (l_bpz2 n)))
plotTable1 (l_mavg9 (l_mavg9 (l_mavg9 (l_mavg9 (rfft_pure (l_brz2 n))))))

plotTable1 (take 512 (l_sin_osc 48000 (repeat 440)))
plotTable1 (take 512 (l_cos_osc 48000 (repeat 440)))

-}