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