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

-- | 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
    ]