csound-catalog-0.7.4: src/Csound/Catalog/Wave/Vowel.hs
module Csound.Catalog.Wave.Vowel(
-- * Singing a vowel.
--
-- | It's best to use this functions with vibrato.
--
-- > vibrato 0.12 5 $ oneVowel maleA 330
vowels, loopVowels, oneVowel, Vowel,
-- * Vowels
maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH,
femaleA, femaleE, femaleIY, femaleO, femaleOO
) where
import Data.List(transpose)
import Csound.Base hiding (dur)
-- | Sings a sequence of vowels with the given frequency.
--
-- > vowels maxDur [(vowel1, dur1), (vowel2, dur2), (vowel3, dur3), ...] lastVowel cps
--
-- * maxDur - total duration of the note
--
-- * @vowel1@, @vowel2@, ... lastVowel -- vowels
--
-- * dur1, dur2, ... - durations
--
-- * cps - frequency of the note.
vowels :: D -> [(Vowel, D)] -> Vowel -> Sig -> Sig
vowels = vowelsBy mkEnv
where mkEnv xs x = linseg ( ( ++ [x, 1, x]) $ (\(a, b) -> [a, b]) =<< xs)
-- | Sings a loop of vowels with the given frequency.
--
-- > loopVowels maxDur xdur [(vowel1, dur1), (vowel2, dur2), (vowel3, dur3), ...] cps
--
-- * maxDur - total duration of the note
--
-- * xdur - the duration of the loop of vowels.
--
-- * @vowel1@, @vowel2@, ... -- vowels
--
-- * dur1, dur2, ... - durations
--
-- * cps - frequency of the note.
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
-- | Generic construcotr for the signals that interpolate between vowel sounds.
-- It takes a function that constructs an envelope to proceed from one vowel to another.
-- The envelope function takes two parameters. It's list of vowels with durations
-- and the value of the final vowel.
--
-- > vowelsBy makeEnvelope vowelSquence lastVowel cps
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
-- | Sings a single vowel with the given frequency.
--
-- > oneVowel maxDur vowel cps
--
-- * maxDur - total duration of the note.
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
-- | Abstract type that represents a vowel.
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
-- 1 - male voice singing A
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
[ 609, 0, 100, 1000, -6, 100, 2450, -12, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2700, -11, 100, 3240, -24, 100, 0.003, 0.02, 0.007
-- 2 - male voice singing E
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 400, 0, 100, 1700, -9, 100, 2300, -8, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2900, -11, 100, 3400, -19, 100, 0.003, 0.02, 0.007
-- 3 - male voice singing IY
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 238, 0, 100, 1741, -20, 100, 2450, -16, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2900, -20, 100, 4000, -32, 100, 0.003, 0.02, 0.007
-- 4 - male voice singing O
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 325, 0, 100, 700, -12, 100, 2550, -26, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2850, -22, 100, 3100, -28, 100, 0.003, 0.02, 0.007
-- 5 - male voice singing OO
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 360, 0, 100, 750, -12, 100, 2400, -29, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2675, -26, 100, 2950, -35, 100, 0.003, 0.02, 0.007
-- 6 - male voice singing U
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 415, 0, 100, 1400, -12, 100, 2200, -16, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2800, -18, 100, 3300, -27, 100, 0.003, 0.02, 0.007
-- 7 - male voice singing ER
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 300, 0, 100, 1600, -14, 100, 2150, -12, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2700, -15, 100, 3100, -23, 100, 0.003, 0.02, 0.007
-- 8 - male voice singing UH
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 400, 0, 100, 1050, -12, 100, 2200, -19, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 2650, -20, 100, 3100, -29, 100, 0.003, 0.02, 0.007
-- 9 - female voice singing A
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 650, 0, 100, 1100, -8, 100, 2860, -13, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 3300, -12, 100, 4500, -19, 100, 0.003, 0.02, 0.007
-- 10 - female voice singing E
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 500, 0, 100, 1750, -9, 100, 2450, -10, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 3350, -14, 100, 5000, -23, 100, 0.003, 0.02, 0.007
-- 11 - female voice singing IY
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 330, 0, 100, 2000, -14, 100, 2800, -11, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007
-- 12 - female voice singing O
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 400, 0, 100, 840, -12, 100, 2800, -26, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 3250, -24, 100, 4500, -31, 100, 0.003, 0.02, 0.007
-- 13 - female voice singing OO
-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3
, 280, 0, 100, 650, -18, 100, 2200, -48, 100
-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec
, 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007
]