module Csound.Catalog.Wave.Ac(
    pulseWidth,
    xanadu1, xanadu2, stringPad, toneWheel,
    guitar, harpsichord, xing,
    fmMod, filteredChorus, plainString, fmTubularBell,
    delayedString, melody, rhodes,
) where

import Data.List

import Csound.Base hiding (filt)

-- |
--
-- > aout = pulseWidth amplitude cps
pulseWidth :: Sig -> Sig -> Sig
pulseWidth :: Sig -> Sig -> Sig
pulseWidth Sig
amp Sig
cps = Sig
asignal
    where
        ilforate :: Sig
ilforate  =     Sig
2.3         -- LFO SPEED IN Hz
        isawlvl :: Sig
isawlvl   =     Sig
0.5         -- LEVEL OF SAWTOOTH WAVEFORM
        ipwmlvl :: Sig
ipwmlvl   =     Sig
0.5         -- LEVEL OF PULSE WAVEFORM
        ipwm :: Sig
ipwm    =     Sig
0.2         -- DC OFFSET OF PULSE width
        ipwmlfo :: Sig
ipwmlfo   =     Sig
0.1         -- DEPTH OF PULSE WIDTH MODULATION
        ivcffrq :: Sig
ivcffrq   =     Sig
800         -- CUTOFF OF GLOBAL LOW PASS FILTER
        ienvflt :: Sig
ienvflt   =     Sig
200         -- MAX CHANGE IN LPF CUTOFF BY ENVELOPE
        ikbdflt :: Sig
ikbdflt   =     Sig
0.1         -- RELATIVE CHANGE IN LPF CUTOFF TO PITCH
        -- the oscillators
        klfo :: Sig
klfo        = Sig -> Sig
kr (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
osc Sig
ilforate
        asaw :: Sig
asaw        = Tab -> Sig -> Sig
oscBy ([Double] -> Tab
elins [-Double
1, Double
1]) Sig
cps
        apwm :: Sig
apwm        = Sig -> Tab -> Sig
forall a. SigOrD a => a -> Tab -> a
table (Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
asaw Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ (Sig
klfo Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
ipwmlfo Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
ipwm)) ([Double] -> Tab
lins [-Double
1, Double
50, -Double
1, Double
0, Double
1, Double
50, Double
1]) Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
1
        awaves :: Sig
awaves      = Sig
isawlvl Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
asaw Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
ipwmlvl Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
apwm
        -- the envelope
        -- the filters
        asignal :: Sig
asignal     = Sig
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig -> Sig
butlp Sig
awaves (Sig
ivcffrq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
ikbdflt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
ienvflt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
amp)

giwave :: Tab
giwave :: Tab
giwave = [Double] -> Tab
sines [Double
1, Double
0.5, Double
0.33, Double
0.25, Double
0.0, Double
0.1, Double
0.1, Double
0.1]

xanaduPlucks :: D -> D -> D -> (Sig, Sig, Sig)
xanaduPlucks :: D -> D -> D -> (Sig, Sig, Sig)
xanaduPlucks D
cps D
vibrAmp D
vibrCps = (Sig -> Sig
phi Sig
vib, Sig -> Sig
phi Sig
shift, Sig -> Sig
phi (-Sig
shift))
    where phi :: Sig -> Sig
phi Sig
asig = Sig -> Sig -> D -> Tab -> D -> Sig
pluck Sig
1 (Sig -> Sig
forall a. SigOrD a => a -> a
cpsoct (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
oct Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
asig) D
cps Tab
giwave D
1
          shift :: Sig
shift = Sig
8Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
1200
          vib :: Sig
vib = Sig -> Sig
kr (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Tab -> Sig
poscil (D -> Sig
sig D
vibrAmp) (D -> Sig
sig D
vibrCps) Tab
cosine
          oct :: Sig
oct = D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D -> D
forall a. SigOrD a => a -> a
octcps D
cps

-- |
--
-- > aout <- xanadu1 cps
xanadu1 :: D -> SE Sig
xanadu1 :: D -> SE Sig
xanadu1 D
cps = do
    Sig
_ <- D -> SE Sig
delayr D
2
    ~ [Sig
tap1, Sig
tap2, Sig
d1, Sig
d2] <- (Sig -> SE Sig) -> [Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> SE Sig
deltap3 [Sig
f1, Sig
f2, Sig
2, Sig
1.1]
    Sig -> SE ()
delayw (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig
g Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
damping
    Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
damping Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean [Sig
gleft, Sig
tap1, Sig
d1, Sig
gright, Sig
tap2, Sig
d2]
    where (Sig
g, Sig
gleft, Sig
gright) = D -> D -> D -> (Sig, Sig, Sig)
xanaduPlucks D
cps (D
1D -> D -> D
forall a. Fractional a => a -> a -> a
/D
120) (D
cpsD -> D -> D
forall a. Fractional a => a -> a -> a
/D
50)
          f1 :: Sig
f1 = [D] -> Sig
expseg [D
0.01, D
10, D
1]
          f2 :: Sig
f2 = [D] -> Sig
expseg [D
0.015, D
15, D
1.055]
          damping :: Sig
damping = Sig
1

-- |
--
-- > aout <- xanadu2 cps
xanadu2 :: D -> SE Sig
xanadu2 :: D -> SE Sig
xanadu2 D
cps = do
    Sig
_ <- D -> SE Sig
delayr D
0.4
    ~ [Sig
d1, Sig
d2] <- (Sig -> SE Sig) -> [Sig] -> SE [Sig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sig -> SE Sig
deltap3 [Sig
0.07, Sig
0.105]
    Sig -> SE ()
delayw (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ Sig
g Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
damping
    Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ Sig
damping Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean [Sig
d1, Sig
gleft, Sig
d2, Sig
gright]
    where (Sig
g, Sig
gleft, Sig
gright) = D -> D -> D -> (Sig, Sig, Sig)
xanaduPlucks D
cps (D
1D -> D -> D
forall a. Fractional a => a -> a -> a
/D
80) D
6.1
          damping :: Sig
damping = Sig
1

-- |
--
-- > stringPad amplitude cps
stringPad :: Sig -> Sig -> Sig
stringPad :: Sig -> Sig -> Sig
stringPad Sig
amp Sig
cps = Sig -> Sig -> Sig
blp (Sig
900 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
amp Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
300) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> Sig -> (Sig -> Sig) -> Sig -> Sig
chorusPitch Int
3 Sig
0.1 Sig -> Sig
f Sig
cps
    where f :: Sig -> Sig
f Sig
x = Sig -> Sig -> Tab -> Sig
poscil Sig
1 Sig
x Tab
giwave

-- | Tone wheel organ by Mikelson
--
-- > toneWheel cps
toneWheel :: D -> Sig
toneWheel :: D -> Sig
toneWheel D
cps = Sig
asignal
    where
        ikey :: D
ikey = D
12 D -> D -> D
forall a. Num a => a -> a -> a
* D -> D
forall a. SigOrD a => a -> a
int' (D
cps D -> D -> D
forall a. Num a => a -> a -> a
- D
6) D -> D -> D
forall a. Num a => a -> a -> a
+ D
100 D -> D -> D
forall a. Num a => a -> a -> a
* (D
cps D -> D -> D
forall a. Num a => a -> a -> a
- D
6)
        wheels :: [Tab]
wheels =
            [ BoolD -> Tab -> Tab -> Tab
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D
ikey D -> D -> D
forall a. Num a => a -> a -> a
- D
12 D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* D
12) Tab
gitonewheel1 Tab
gitonewheel2
            , BoolD -> Tab -> Tab -> Tab
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D
ikey D -> D -> D
forall a. Num a => a -> a -> a
+  D
7 D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* D
12) Tab
gitonewheel1 Tab
gitonewheel2
            , BoolD -> Tab -> Tab -> Tab
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (D
ikey      D -> D -> BoolD
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>* D
12) Tab
gitonewheel1 Tab
gitonewheel2
            , Tab
sine ]
        iphase :: D
iphase = D
0.5
        harm :: D -> D -> Int -> D -> Sig
harm D
w D
fqc Int
tabId D
phs = Sig -> Sig -> Tab -> Sig
poscil (D -> Sig
sig D
w) (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
fqc D -> D -> D
forall a. Num a => a -> a -> a
* D
cps) ([Tab]
wheels [Tab] -> Int -> Tab
forall a. [a] -> Int -> a
!! Int
tabId) Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` (D
iphase D -> D -> D
forall a. Fractional a => a -> a -> a
/ (D
ikey D -> D -> D
forall a. Num a => a -> a -> a
- D
phs))
        asignal :: Sig
asignal = ( Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
9) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ (D -> D -> Int -> D -> Sig) -> [D] -> [D] -> [Int] -> [D] -> [Sig]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 D -> D -> Int -> D -> Sig
harm
            [D
8,   D
8,      D
8,   D
8,   D
3,      D
2,     D
1,      D
0, D
4]
            [D
0.5, D
1.4983, D
1,   D
2,   D
2.9966, D
4, D
5.0397, D
5.9932, D
8]
            ([Int
0, Int
1, Int
2, Int
3] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
3)
            [-D
12, D
7, D
0, D
12, D
19, D
24, D
28, D
31, D
36]

        gitonewheel1 :: Tab
gitonewheel1 = [Double] -> Tab
sines [Double
1, Double
0.02, Double
0.01]
        gitonewheel2 :: Tab
gitonewheel2 = [Double] -> Tab
sines [Double
1, Double
0, Double
0.2, Double
0, Double
0.1, Double
0, Double
0.05, Double
0, Double
0.02]

-- | Guitar, Michael Gogins
--
-- > guitar cps
guitar :: D -> Sig
guitar :: D -> Sig
guitar D
cps = Sig
asignal
    where
        asigcomp :: Sig
asigcomp    = Sig -> Sig -> D -> Tab -> D -> Sig
pluck Sig
1 Sig
440 D
440 Tab
forall a. Default a => a
def D
1
        asig :: Sig
asig        = Sig -> Sig -> D -> Tab -> D -> Sig
pluck Sig
1 (D -> Sig
sig D
cps) D
cps Tab
forall a. Default a => a
def D
1
        af :: Sig -> Sig -> Sig -> Sig
af Sig
x Sig
cf Sig
wid = Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig -> Sig -> Sig
reson Sig
asig Sig
cf Sig
wid
        asignal :: Sig
asignal     = Sig -> Sig -> Sig
balance (Sig
0.4 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
asig Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Sig -> Sig -> Sig -> Sig
af Sig
0.6 Sig
110 Sig
80, Sig -> Sig -> Sig -> Sig
af Sig
1 Sig
220 Sig
100, Sig -> Sig -> Sig -> Sig
af Sig
0.6 Sig
440 Sig
80]) Sig
asigcomp

-- Harpsichord, James Kelley
--
-- > harpsicord cps
harpsichord :: D -> Sig
harpsichord :: D -> Sig
harpsichord D
cps = Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
asignal
    where
        aenvelope :: Sig
aenvelope   = Sig -> Sig
ar (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [D] -> Sig
transeg [D
1, D
10, -D
5.0, D
0]
        apluck :: Sig
apluck      = Sig -> Sig -> D -> Tab -> D -> Sig
pluck Sig
1 (D -> Sig
sig D
cps) D
cps Tab
forall a. Default a => a
def D
1
        aharp :: Sig
aharp       = Sig -> Sig -> Tab -> Sig
poscil Sig
aenvelope (D -> Sig
sig D
cps) ([Double] -> Tab
lins [-Double
1, Double
1024, Double
1, Double
1024, -Double
1])
        asignal :: Sig
asignal     = Sig
apluck Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig -> Sig -> Sig
balance Sig
apluck Sig
aharp

-- | Xing by Andrew Horner
--
-- > xing cycleDuration cps
xing :: D -> Sig -> Sig
xing :: D -> Sig -> Sig
xing D
xdur Sig
cps = Sig
asignal
    where
        amps :: [Sig] -> Sig -> Sig -> Sig -> D -> Sig
amps [Sig]
xs Sig
dt Sig
vib Sig
freq D
phs = Sig -> Sig
ar ([Sig] -> Sig -> Sig
loopseg [Sig]
xs (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
1D -> D -> D
forall a. Fractional a => a -> a -> a
/D
xdur)) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig -> Sig -> Tab -> Sig
poscil Sig
vibEnv Sig
freq Tab
sine Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
phs)
            where vibEnv :: Sig
vibEnv = Sig -> Sig
ar (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig -> Sig
loopseg [Sig
0, Sig
dt, Sig
vib, D -> Sig
sig D
xdur Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
dt, Sig
0] (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
1D -> D -> D
forall a. Fractional a => a -> a -> a
/D
xdur)

        f :: Sig -> D -> Sig
f Sig
vol D
freq = Sig -> Sig -> Tab -> Sig
poscil Sig
vol (D -> Sig
sig D
freq Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
cps) Tab
sine

        norm :: D
norm = D
32310
        asignal :: Sig
asignal = (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
1 D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
norm) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
            [ Sig -> D -> Sig
f ([Sig] -> Sig -> Sig -> Sig -> D -> Sig
amps [Sig]
env1 Sig
0.05 Sig
0.3 Sig
6.7  D
0.8) D
1
            , Sig -> D -> Sig
f ([Sig] -> Sig -> Sig -> Sig -> D -> Sig
amps [Sig]
env2 Sig
0.12 Sig
0.5 Sig
10.5 D
0  ) D
2.7
            , Sig -> D -> Sig
f ([Sig] -> Sig -> Sig -> Sig -> D -> Sig
amps [Sig]
env3 Sig
0.02 Sig
0.8 Sig
70   D
0  ) D
4.95
            ]

        env1 :: [Sig]
env1 = [ Sig
0,Sig
0.001,Sig
5200,Sig
0.001,Sig
800,Sig
0.001,Sig
3000,Sig
0.0025,Sig
1100,Sig
0.002
            , Sig
2800,Sig
0.0015,Sig
1500,Sig
0.001,Sig
2100,Sig
0.011,Sig
1600,Sig
0.03,Sig
1400,Sig
0.95
            , Sig
700,Sig
1,Sig
320,Sig
1,Sig
180,Sig
1,Sig
90,Sig
1,Sig
40,Sig
1,Sig
20,Sig
1,Sig
12,Sig
1,Sig
6,Sig
1,Sig
3,Sig
1,Sig
0,Sig
1,Sig
0]

        env2 :: [Sig]
env2 = [ Sig
0,Sig
0.0009,Sig
22000,Sig
0.0005,Sig
7300,Sig
0.0009,Sig
11000,Sig
0.0004,Sig
5500
            , Sig
0.0006,Sig
15000,Sig
0.0004,Sig
5500,Sig
0.0008,Sig
2200,Sig
0.055,Sig
7300,Sig
0.02
            , Sig
8500,Sig
0.38,Sig
5000,Sig
0.5,Sig
300,Sig
0.5,Sig
73,Sig
0.5,Sig
5,Sig
5,Sig
0,Sig
1,Sig
1]

        env3 :: [Sig]
env3 = [ Sig
0,Sig
0.001,Sig
3000,Sig
0.001,Sig
1000,Sig
0.0017,Sig
12000,Sig
0.0013
            , Sig
3700,Sig
0.001,Sig
12500,Sig
0.0018,Sig
3000,Sig
0.0012,Sig
1200,Sig
0.001
            , Sig
1400,Sig
0.0017,Sig
6000,Sig
0.0023,Sig
200,Sig
0.001,Sig
3000,Sig
0.001,Sig
1200
            , Sig
0.0015,Sig
8000,Sig
0.001,Sig
1800,Sig
0.0015,Sig
6000,Sig
0.08,Sig
1200,Sig
0.2
            , Sig
200,Sig
0.2,Sig
40,Sig
0.2,Sig
10,Sig
0.4,Sig
0,Sig
1,Sig
0]

-- | FM modulated left and right detuned chorusing, Thomas Kung
--
-- > fmMod cycleDuration cps
fmMod :: D -> Sig -> Sig
fmMod :: D -> Sig -> Sig
fmMod D
xdur Sig
cps = Sig
asignal
    where
        iattack :: Sig
iattack     = Sig
0.25
        irelease :: Sig
irelease    = Sig
0.3333
        ip6 :: Sig
ip6         = Sig
0.3
        ip7 :: Sig
ip7         = Sig
2.2
        ishift :: Sig
ishift      = Sig
4 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
12000
        ipch :: Sig
ipch        = Sig
cps
        ioct :: Sig
ioct        = Sig -> Sig
forall a. SigOrD a => a -> a
octcps Sig
cps
        amodi :: Sig
amodi       = Sig -> Sig
ar (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig -> Sig
loopseg [Sig
0, Sig
iattack, Sig
5, D -> Sig
sig D
xdur, Sig
2, Sig
irelease, Sig
0] (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
1 D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
xdur)
        amodr :: Sig
amodr       = Sig -> Sig
ar (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig -> Sig
loopseg [Sig
ip6, Sig
1, Sig
ip7, Sig
1, Sig
ip6] (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
0.5 D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
xdur)
        a1 :: Sig
a1          = Sig
amodi Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
amodr Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
amodr) Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2
        a2 :: Sig
a2          = Sig
amodi Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
amodr Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
amodr) Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2
        a1ndx :: Sig
a1ndx       = Sig -> Sig
forall a. Num a => a -> a
abs (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig
a1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
10
        a3 :: Sig
a3          = Sig -> Tab -> Sig
forall a. SigOrD a => a -> Tab -> a
tablei Sig
a1ndx (Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ Double -> Tab
bessels Double
20) Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` D
1
        ao1 :: Sig
ao1         = Sig -> Sig -> Tab -> Sig
poscil Sig
a1 Sig
ipch Tab
cosine
        a4 :: Sig
a4          = Sig -> Sig
forall a. Floating a => a -> a
exp (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ -Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a3 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
ao1
        ao2 :: Sig
ao2         = Sig -> Sig -> Tab -> Sig
poscil (Sig
a2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
ipch) Sig
cps Tab
cosine
        aleft :: Sig
aleft       = Sig -> Sig -> Tab -> Sig
poscil Sig
a4 (Sig
ao2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig -> Sig
forall a. SigOrD a => a -> a
cpsoct (Sig
ioct Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
ishift)) Tab
sine
        aright :: Sig
aright      = Sig -> Sig -> Tab -> Sig
poscil Sig
a4 (Sig
ao2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig -> Sig
forall a. SigOrD a => a -> a
cpsoct (Sig
ioct Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
ishift)) Tab
sine
        asignal :: Sig
asignal     = Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
aleft Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
aright)

-- | Filtered chorus, Michael Bergeman
--
-- > filteredChorus cycleDuration cps
filteredChorus :: D -> Sig -> Sig
filteredChorus :: D -> Sig -> Sig
filteredChorus D
xdur Sig
cps = Sig
asignal
    where
        D
a ~~ :: D -> D -> Sig
~~ D
b = [Sig] -> Sig -> Sig
loopseg [D -> Sig
sig D
a, Sig
1, D -> Sig
sig D
b, Sig
1, D -> Sig
sig D
a] (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
1 D -> D -> D
forall a. Fractional a => a -> a -> a
/ (D
xdur D -> D -> D
forall a. Num a => a -> a -> a
* D
2))
        filt :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
filt Sig
cf1 Sig
bw1 Sig
cf2 Sig
bw2 Sig
x = Sig -> Sig -> Sig
balance (Sig -> Sig -> Sig -> Sig
bp Sig
cf2 Sig
bw2 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> Sig
bp Sig
cf1 Sig
bw1 Sig
x) Sig
x
        harm :: Sig -> Sig
harm Sig
fqc = Sig -> Sig -> Tab -> Sig
poscil ((D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
idb)) Sig
fqc (Tab -> Sig) -> Tab -> Sig
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
sines
                            [ Double
0.28, Double
1, Double
0.74, Double
0.66, Double
0.78, Double
0.48, Double
0.05, Double
0.33, Double
0.12
                            , Double
0.08, Double
0.01, Double
0.54, Double
0.19, Double
0.08, Double
0.05, Double
0.16, Double
0.01, Double
0.11, Double
0.3, Double
0.02, Double
0.2]
        a1s :: Sig -> Sig
a1s Sig
x = [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> [Sig] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig
harm (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
forall a. SigOrD a => a -> a
cpsoct (Sig -> Sig
forall a. SigOrD a => a -> a
octcps Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
x))) [Sig
1, Sig
0.999, Sig
1.001]
        rvb :: Sig -> Sig -> Sig -> Sig
rvb Sig
dt Sig
dh Sig
x = Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig -> Sig -> Sig -> Sig
reverb2 Sig
x Sig
dt Sig
dh)

        idb :: D
idb = D
1.5

        asignal :: Sig
asignal = [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean
            [ Sig -> Sig -> Sig -> Sig
rvb Sig
5 Sig
0.3 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> Sig -> Sig -> Sig
filt (D
40 D -> D -> Sig
~~ D
800) Sig
40 (D
220 D -> D -> Sig
~~ D
440) ((D
440 D -> D -> Sig
~~ D
220) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.8) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
a1s (-Sig
0.01)
            , Sig -> Sig -> Sig -> Sig
rvb Sig
4 Sig
0.2 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> Sig -> Sig -> Sig
filt (D
800 D -> D -> Sig
~~ D
40) Sig
40 (D
440 D -> D -> Sig
~~ D
220) ((D
220 D -> D -> Sig
~~ D
440) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.8) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
a1s Sig
0.01
            ]

-- | Plain plucked string, Michael Gogins
--
-- > plainString cps
plainString :: D -> Sig
plainString :: D -> Sig
plainString D
cps = D -> Sig -> D -> Sig -> Sig -> Sig
wgpluck2 D
0.1 Sig
1.0 D
cps Sig
0.25 Sig
0.05

-- | Rhodes electric piano model, Perry Cook
--
-- > rhodes cps
rhodes :: Sig -> Sig
rhodes :: Sig -> Sig
rhodes Sig
cps = Sig
asignal
    where
        iindex :: Sig
iindex      = Sig
4.1
        icrossfade :: Sig
icrossfade  = Sig
3.1
        ivibedepth :: Sig
ivibedepth  = Sig
0.2
        iviberate :: Sig
iviberate   = Sig
6
        ifn1 :: Tab
ifn1        = Tab
sine
        ifn2 :: Tab
ifn2        = Tab
cosine
        ifn3 :: Tab
ifn3        = Tab
sine
        ifn4 :: Tab
ifn4        = [Double] -> Tab
sines [Double
0]
        ivibefn :: Tab
ivibefn     = Tab
sine
        asignal :: Sig
asignal     = Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Tab
-> Tab
-> Tab
-> Tab
-> Tab
-> Sig
fmrhode Sig
1 Sig
cps Sig
iindex Sig
icrossfade Sig
ivibedepth Sig
iviberate Tab
ifn1 Tab
ifn2 Tab
ifn3 Tab
ifn4 Tab
ivibefn

-- | Tubular bell model, Perry Cook
--
-- > fmTubularBell cps
fmTubularBell :: Sig -> Sig
fmTubularBell :: Sig -> Sig
fmTubularBell Sig
cps = Sig
asignal
    where
        iindex :: Sig
iindex      = Sig
1.5
        icrossfade :: Sig
icrossfade  = Sig
2.03
        ivibedepth :: Sig
ivibedepth  = Sig
0.2
        iviberate :: Sig
iviberate   = Sig
6
        ifn1 :: Tab
ifn1        = Tab
sine
        ifn2 :: Tab
ifn2        = [Double] -> Tab
sines [Double
1, Double
0.4, Double
0.2, Double
0.1, Double
0.1, Double
0.05]
        ifn3 :: Tab
ifn3        = Tab
sine
        ifn4 :: Tab
ifn4        = Tab
sine
        ivibefn :: Tab
ivibefn     = Tab
cosine
        asignal :: Sig
asignal     = Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig
fmbell Sig
1 Sig
cps Sig
iindex Sig
icrossfade Sig
ivibedepth Sig
iviberate Sig -> [Tab] -> Sig
forall a. Tuple a => a -> [Tab] -> a
`withTabs` [Tab
ifn1, Tab
ifn2, Tab
ifn3, Tab
ifn4, Tab
ivibefn]

-- | Delayed plucked string, Michael Gogins
--
-- > delayedString cps
delayedString :: D -> Sig
delayedString :: D -> Sig
delayedString D
cps = Sig
asignal
    where
        ioctave :: D
ioctave     = D -> D
forall a. SigOrD a => a -> a
octcps D
cps
        -- Detuning of strings by 4 cents each way
        idetune :: Sig
idetune     = Sig
4 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
1200
        kvibrato :: Sig
kvibrato    = Sig -> Sig -> Tab -> Sig
poscil (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
120) Sig
7 Tab
sine
        awave :: Sig -> Tab -> Sig
awave Sig
det Tab
fn = Sig -> Sig -> D -> Tab -> D -> Sig
pluck Sig
1 (Sig -> Sig
forall a. SigOrD a => a -> a
cpsoct (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig D
ioctave Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
det) D
cps Tab
fn D
1
        ag :: Sig
ag          = Sig -> Tab -> Sig
awave Sig
kvibrato  Tab
sine
        agleft :: Sig
agleft      = Sig -> Tab -> Sig
awave Sig
idetune    Tab
sine
        agright :: Sig
agright     = Sig -> Tab -> Sig
awave (- Sig
idetune) Tab
cosine
        imsleft :: D
imsleft     = D
0.2 D -> D -> D
forall a. Num a => a -> a -> a
* D
1000
        imsright :: D
imsright    = D
0.21 D -> D -> D
forall a. Num a => a -> a -> a
* D
1000
        noclick :: D -> Sig
noclick D
x   = [D] -> Sig
linseg [D
0, D
0.1, D
x, D
1, D
x]
        adelayleft :: Sig
adelayleft  = Sig -> Sig -> D -> Sig
vdelay Sig
ag (D -> Sig
noclick D
imsleft) (D
imsleft D -> D -> D
forall a. Num a => a -> a -> a
+ D
100)
        adelayright :: Sig
adelayright = Sig -> Sig -> D -> Sig
vdelay Sig
ag (D -> Sig
noclick D
imsright) (D
imsright D -> D -> D
forall a. Num a => a -> a -> a
+ D
100)
        asignal :: Sig
asignal     = [Sig] -> Sig
forall a. Fractional a => [a] -> a
mean [Sig
agleft, Sig
adelayleft, Sig
agright, Sig
adelayright]


-- | Melody (Chebyshev / FM / additive), Jon Nelson
--
-- > melody cycleDuration cps
melody :: D -> Sig -> SE Sig
melody :: D -> Sig -> SE Sig
melody D
xdur Sig
cps = do
    Sig
k1000 <- Sig -> Sig -> SE Sig
randi Sig
1 Sig
10
    let k100 :: Sig
k100 = Sig
cps Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ [Sig] -> Sig -> Sig
loopseg [Sig
0, Sig
0.5, Sig
1, D -> Sig
sig D
xdur, Sig
1] (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
1D -> D -> D
forall a. Fractional a => a -> a -> a
/D
xdur) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig -> Tab -> Sig
poscil Sig
1 (Sig
5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
k1000) Tab
sine
        -- a1-3 are for cheby with p6=1-4
        a1 :: Sig
a1   = Sig -> Sig -> Tab -> Sig
poscil Sig
k1 Sig
k100 ([Double] -> Tab
sines [Double
1, Double
0.4, Double
0.2, Double
0.1, Double
0.1, Double
0.05])
        a2 :: Sig
a2   = Sig -> Tab -> Sig
forall a. SigOrD a => a -> Tab -> a
tablei Sig
a1 Tab
ip6 Sig -> [D] -> Sig
forall a. Tuple a => a -> [D] -> a
`withDs` [D
1, D
0.5]
        a3 :: Sig
a3   = Sig -> Sig -> Sig
balance Sig
a2 Sig
a1
        -- try other waveforms as well
        a4 :: Sig
a4          = Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Sig
foscil Sig
1 (Sig
k100 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
0.04) Sig
1 Sig
2.005 Sig
k20 Tab
sine
        a5 :: Sig
a5          = Sig -> Sig -> Tab -> Sig
poscil Sig
1 Sig
k100 Tab
sine
        a6 :: Sig
a6          = Sig
a3 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
a4 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
a5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.8
        a7 :: Sig
a7          = Sig -> Sig -> D -> Sig
comb Sig
a6 Sig
0.5 (D
1 D -> D -> D
forall a. Fractional a => a -> a -> a
/ Sig -> D
ir Sig
cps)
        a8 :: Sig
a8          = Sig
a6 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.9 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
a7 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.1
        asignal :: Sig
asignal     = Sig -> Sig -> Sig
balance Sig
a8 Sig
a1
    Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
asignal
    where
        iattack :: D
iattack     = D
0.05
        isustain :: D
isustain    = D
xdur
        irelease :: D
irelease    = D
0.1
        ip6 :: Tab
ip6         = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
lins [-Double
1, Double
150, Double
0.1, Double
110, Double
0, Double
252, Double
0]
        -- Envelope for driving oscillator
        k1 :: Sig
k1          = [D] -> Sig
linseg [D
1, D
xdur, D
0.5] Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> D -> D -> D -> Sig
linenr Sig
0.5 (D
xdur D -> D -> D
forall a. Num a => a -> a -> a
* D
0.3) (D
xdur D -> D -> D
forall a. Num a => a -> a -> a
* D
0.2) D
0.01
        -- Power to partials
        k20 :: Sig
k20         = [D] -> Sig
linseg [D
1.485, D
iattack, D
1.5, D
isustain D -> D -> D
forall a. Num a => a -> a -> a
+ D
irelease, D
1.485]