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
]