module Csound.Catalog.Wave.Vowel(
vowels, loopVowels, oneVowel, Vowel,
maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH,
femaleA, femaleE, femaleIY, femaleO, femaleOO
) where
import Data.List(transpose)
import Csound.Base hiding (dur)
vowels :: D -> [(Vowel, D)] -> Vowel -> Sig -> Sig
vowels :: D -> [(Vowel, D)] -> Vowel -> Sig -> Sig
vowels = ([(D, D)] -> D -> Sig) -> D -> [(Vowel, D)] -> Vowel -> Sig -> Sig
vowelsBy [(D, D)] -> D -> Sig
mkEnv
where mkEnv :: [(D, D)] -> D -> Sig
mkEnv [(D, D)]
xs D
x = [D] -> Sig
linseg ( ( [D] -> [D] -> [D]
forall a. [a] -> [a] -> [a]
++ [D
x, D
1, D
x]) ([D] -> [D]) -> [D] -> [D]
forall a b. (a -> b) -> a -> b
$ (\(D
a, D
b) -> [D
a, D
b]) ((D, D) -> [D]) -> [(D, D)] -> [D]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(D, D)]
xs)
loopVowels :: D -> Sig -> [(Vowel, D)] -> Sig -> Sig
loopVowels :: D -> Sig -> [(Vowel, D)] -> Sig -> Sig
loopVowels D
maxDur Sig
xdur [(Vowel, D)]
params = ([(D, D)] -> D -> Sig) -> D -> [(Vowel, D)] -> Vowel -> Sig -> Sig
vowelsBy [(D, D)] -> D -> Sig
mkEnv D
maxDur [(Vowel, D)]
params Vowel
lastVowel
where
mkEnv :: [(D, D)] -> D -> Sig
mkEnv [(D, D)]
xs D
x = [Sig] -> Sig -> Sig
loopseg (([Sig] -> [Sig] -> [Sig]
forall a. [a] -> [a] -> [a]
++ [D -> Sig
sig D
x]) ([Sig] -> [Sig]) -> [Sig] -> [Sig]
forall a b. (a -> b) -> a -> b
$ (\(D
a, D
b) -> [D -> Sig
sig D
a, D -> Sig
sig D
b]) ((D, D) -> [Sig]) -> [(D, D)] -> [Sig]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(D, D)]
xs) (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
xdur)
lastVowel :: Vowel
lastVowel = (Vowel, D) -> Vowel
forall a b. (a, b) -> a
fst ((Vowel, D) -> Vowel) -> (Vowel, D) -> Vowel
forall a b. (a -> b) -> a -> b
$ [(Vowel, D)] -> (Vowel, D)
forall a. HasCallStack => [a] -> a
head [(Vowel, D)]
params
vowelsBy :: ([(D, D)] -> D -> Sig) -> D -> [(Vowel, D)] -> Vowel -> Sig -> Sig
vowelsBy :: ([(D, D)] -> D -> Sig) -> D -> [(Vowel, D)] -> Vowel -> Sig -> Sig
vowelsBy [(D, D)] -> D -> Sig
mkEnv D
maxDur [(Vowel, D)]
params Vowel
lastVowel Sig
cps = case [(Vowel, D)]
params of
[(Vowel
vow, D
_)] -> D -> Vowel -> Sig -> Sig
oneVowel D
maxDur Vowel
vow Sig
cps
[(Vowel, D)]
_ -> (Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
100) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig -> Sig -> Sig) -> [Sig] -> [Sig] -> [Sig] -> [Sig]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Sig -> Sig -> Sig -> Sig
harm
[Sig
fmt1, Sig
fmt2, Sig
fmt3, Sig
fmt4, Sig
fmt5]
[Sig
amp1, Sig
amp2, Sig
amp3, Sig
amp4, Sig
amp5]
[Sig
bw1, Sig
bw2, Sig
bw3, Sig
bw4, Sig
bw5]
where
([Vowel]
vs, [D]
dts) = [(Vowel, D)] -> ([Vowel], [D])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Vowel, D)]
params
[ Sig
fmt1, Sig
amp1, Sig
bw1, Sig
fmt2, Sig
amp2, Sig
bw2, Sig
fmt3, Sig
amp3, Sig
bw3
, Sig
fmt4, Sig
amp4, Sig
bw4, Sig
fmt5, Sig
amp5, Sig
bw5, Sig
ris, Sig
dur, Sig
dec
] = ([D] -> D -> Sig) -> [[D]] -> [D] -> [Sig]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[D]
xs D
lastV -> [(D, D)] -> D -> Sig
mkEnv ([D] -> [D] -> [(D, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [D]
xs [D]
dts) D
lastV) ([[D]] -> [[D]]
forall a. [[a]] -> [[a]]
transpose ([[D]] -> [[D]]) -> [[D]] -> [[D]]
forall a b. (a -> b) -> a -> b
$ (Vowel -> [D]) -> [Vowel] -> [[D]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vowel -> [D]
vowelParams [Vowel]
vs) (Vowel -> [D]
vowelParams Vowel
lastVowel)
harm :: Sig -> Sig -> Sig -> Sig
harm Sig
fmt Sig
amp Sig
bw = Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> D
-> Tab
-> Tab
-> D
-> Sig
fof Sig
amp Sig
cps Sig
fmt Sig
ioct Sig
bw Sig
ris Sig
dur Sig
dec D
iolaps Tab
sine Tab
sigmoid D
maxDur Sig -> [D] -> Sig
forall a. Tuple a => a -> [D] -> a
`withDs` [D
0, D
1]
ioct :: Sig
ioct = Sig
0
iolaps :: D
iolaps = D
20
oneVowel :: D -> Vowel -> Sig -> Sig
oneVowel :: D -> Vowel -> Sig -> Sig
oneVowel D
maxDur Vowel
v Sig
cps = (Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
100) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Sig] -> Sig
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sig] -> Sig) -> [Sig] -> Sig
forall a b. (a -> b) -> a -> b
$ (D -> D -> D -> Sig) -> [D] -> [D] -> [D] -> [Sig]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 D -> D -> D -> Sig
harm
[D
fmt1, D
fmt2, D
fmt3, D
fmt4, D
fmt5]
[D
amp1, D
amp2, D
amp3, D
amp4, D
amp5]
[D
bw1, D
bw2, D
bw3, D
bw4, D
bw5]
where
[ D
fmt1, D
amp1, D
bw1, D
fmt2, D
amp2, D
bw2, D
fmt3, D
amp3, D
bw3
, D
fmt4, D
amp4, D
bw4, D
fmt5, D
amp5, D
bw5, D
ris, D
dur, D
dec
] = Vowel -> [D]
vowelParams Vowel
v
harm :: D -> D -> D -> Sig
harm D
fmt D
amp D
bw = Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> D
-> Tab
-> Tab
-> D
-> Sig
fof (D -> Sig
sig D
amp) Sig
cps (D -> Sig
sig D
fmt) Sig
ioct (D -> Sig
sig D
bw) (D -> Sig
sig D
ris) (D -> Sig
sig D
dur) (D -> Sig
sig D
dec) D
iolaps Tab
sine Tab
sigmoid D
maxDur Sig -> [D] -> Sig
forall a. Tuple a => a -> [D] -> a
`withDs` [D
0, D
1]
ioct :: Sig
ioct = Sig
0
iolaps :: D
iolaps = D
20
vowelParams :: Vowel -> [D]
vowelParams :: Vowel -> [D]
vowelParams Vowel
v = (D -> D) -> [D] -> [D]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((D -> Tab -> D) -> Tab -> D -> D
forall a b c. (a -> b -> c) -> b -> a -> c
flip D -> Tab -> D
forall a. SigOrD a => a -> Tab -> a
table Tab
vowelTab (D -> D) -> (D -> D) -> D -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (D -> D -> D
forall a. Num a => a -> a -> a
+ D
index)) ([D] -> [D]) -> [D] -> [D]
forall a b. (a -> b) -> a -> b
$ (Int -> D) -> [Int] -> [D]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> D
int [Int
0 .. Int
17]
where index :: D
index = Vowel -> D
vowelIndex Vowel
v
newtype Vowel = Vowel { Vowel -> D
unVowel :: D }
instance Tuple Vowel where
tupleMethods :: TupleMethods Vowel
tupleMethods = (D -> Vowel) -> (Vowel -> D) -> TupleMethods Vowel
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods D -> Vowel
Vowel Vowel -> D
unVowel
instance Arg Vowel
maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH,
femaleA, femaleE, femaleIY, femaleO, femaleOO :: Vowel
maleA :: Vowel
maleA = D -> Vowel
Vowel D
0; maleE :: Vowel
maleE = D -> Vowel
Vowel D
1; maleIY :: Vowel
maleIY = D -> Vowel
Vowel D
2
maleO :: Vowel
maleO = D -> Vowel
Vowel D
3; maleOO :: Vowel
maleOO = D -> Vowel
Vowel D
4; maleU :: Vowel
maleU = D -> Vowel
Vowel D
5
maleER :: Vowel
maleER = D -> Vowel
Vowel D
6; maleUH :: Vowel
maleUH = D -> Vowel
Vowel D
7; femaleA :: Vowel
femaleA = D -> Vowel
Vowel D
8
femaleE :: Vowel
femaleE = D -> Vowel
Vowel D
9; femaleIY :: Vowel
femaleIY = D -> Vowel
Vowel D
10; femaleO :: Vowel
femaleO = D -> Vowel
Vowel D
11
femaleOO :: Vowel
femaleOO = D -> Vowel
Vowel D
12
vowelIndex :: Vowel -> D
vowelIndex :: Vowel -> D
vowelIndex = (D -> D -> D
forall a. Num a => a -> a -> a
* D
18) (D -> D) -> (Vowel -> D) -> Vowel -> D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vowel -> D
unVowel
vowelTab :: Tab
vowelTab :: Tab
vowelTab = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
doubles
[ Double
609, Double
0, Double
100, Double
1000, -Double
6, Double
100, Double
2450, -Double
12, Double
100
, Double
2700, -Double
11, Double
100, Double
3240, -Double
24, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
400, Double
0, Double
100, Double
1700, -Double
9, Double
100, Double
2300, -Double
8, Double
100
, Double
2900, -Double
11, Double
100, Double
3400, -Double
19, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
238, Double
0, Double
100, Double
1741, -Double
20, Double
100, Double
2450, -Double
16, Double
100
, Double
2900, -Double
20, Double
100, Double
4000, -Double
32, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
325, Double
0, Double
100, Double
700, -Double
12, Double
100, Double
2550, -Double
26, Double
100
, Double
2850, -Double
22, Double
100, Double
3100, -Double
28, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
360, Double
0, Double
100, Double
750, -Double
12, Double
100, Double
2400, -Double
29, Double
100
, Double
2675, -Double
26, Double
100, Double
2950, -Double
35, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
415, Double
0, Double
100, Double
1400, -Double
12, Double
100, Double
2200, -Double
16, Double
100
, Double
2800, -Double
18, Double
100, Double
3300, -Double
27, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
300, Double
0, Double
100, Double
1600, -Double
14, Double
100, Double
2150, -Double
12, Double
100
, Double
2700, -Double
15, Double
100, Double
3100, -Double
23, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
400, Double
0, Double
100, Double
1050, -Double
12, Double
100, Double
2200, -Double
19, Double
100
, Double
2650, -Double
20, Double
100, Double
3100, -Double
29, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
650, Double
0, Double
100, Double
1100, -Double
8, Double
100, Double
2860, -Double
13, Double
100
, Double
3300, -Double
12, Double
100, Double
4500, -Double
19, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
500, Double
0, Double
100, Double
1750, -Double
9, Double
100, Double
2450, -Double
10, Double
100
, Double
3350, -Double
14, Double
100, Double
5000, -Double
23, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
330, Double
0, Double
100, Double
2000, -Double
14, Double
100, Double
2800, -Double
11, Double
100
, Double
3450, -Double
50, Double
100, Double
4500, -Double
52, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
400, Double
0, Double
100, Double
840, -Double
12, Double
100, Double
2800, -Double
26, Double
100
, Double
3250, -Double
24, Double
100, Double
4500, -Double
31, Double
100, Double
0.003, Double
0.02, Double
0.007
, Double
280, Double
0, Double
100, Double
650, -Double
18, Double
100, Double
2200, -Double
48, Double
100
, Double
3450, -Double
50, Double
100, Double
4500, -Double
52, Double
100, Double
0.003, Double
0.02, Double
0.007
]