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 :: 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)

-- | 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 :: 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. [a] -> a
head [(Vowel, D)]
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 :: ([(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 (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 (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


-- | Sings a single vowel with the given frequency.
--
-- > oneVowel maxDur vowel cps
--
-- * maxDur - total duration of the note.
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 (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 (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 (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

-- | Abstract type that represents a vowel.
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
-- 1 - male voice singing A
--    fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  [ Double
609,  Double
0,      Double
100,  Double
1000, -Double
6,     Double
100,  Double
2450, -Double
12,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
2700, -Double
11,  Double
100,  Double
3240, -Double
24,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 2 - male voice singing E
--  fmt1  amp1  bw1     fmt2  amp2  bw2   fmt3  amp3  bw3
  , Double
400,  Double
0,      Double
100,  Double
1700, -Double
9,     Double
100,  Double
2300, -Double
8,     Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
2900, -Double
11,  Double
100,  Double
3400, -Double
19,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 3 - male voice singing IY
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
238,  Double
0,      Double
100,  Double
1741, -Double
20,  Double
100,  Double
2450, -Double
16,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
2900, -Double
20,  Double
100,  Double
4000, -Double
32,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 4 - male voice singing O
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
325,  Double
0,      Double
100,  Double
700,  -Double
12,  Double
100,  Double
2550, -Double
26,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
2850, -Double
22,  Double
100,  Double
3100, -Double
28,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 5 - male voice singing OO
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
360,  Double
0,      Double
100,  Double
750,  -Double
12,  Double
100,  Double
2400, -Double
29,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5 ilris ildur ildec
  , Double
2675, -Double
26,  Double
100,    Double
2950, -Double
35,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 6 - male voice singing U
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
415,  Double
0,      Double
100,  Double
1400, -Double
12,  Double
100,  Double
2200, -Double
16,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
2800, -Double
18,  Double
100,  Double
3300, -Double
27,  Double
100,    Double
0.003,  Double
0.02, Double
0.007
-- 7 - male voice singing ER
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
300,  Double
0,      Double
100,  Double
1600, -Double
14,  Double
100,  Double
2150, -Double
12,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
2700, -Double
15,  Double
100,  Double
3100, -Double
23,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 8 - male voice singing UH
--  fmt1  amp1  bw1     fmt2  amp2  bw2   fmt3  amp3  bw3
  , Double
400,  Double
0,    Double
100,  Double
1050, -Double
12,  Double
100,  Double
2200, -Double
19,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
2650, -Double
20,  Double
100,  Double
3100, -Double
29,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 9 - female voice singing A
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
650,  Double
0,      Double
100,  Double
1100, -Double
8,     Double
100,  Double
2860, -Double
13,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
3300, -Double
12,  Double
100,  Double
4500, -Double
19,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 10 - female voice singing E
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
500,  Double
0,      Double
100,  Double
1750, -Double
9,   Double
100,  Double
2450, -Double
10,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
3350, -Double
14,  Double
100,  Double
5000, -Double
23,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 11 - female voice singing IY
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
330,  Double
0,      Double
100,  Double
2000, -Double
14,  Double
100,  Double
2800, -Double
11,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
3450, -Double
50,  Double
100,  Double
4500, -Double
52,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 12 - female voice singing O
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
400,  Double
0,      Double
100,  Double
840,  -Double
12,  Double
100,  Double
2800, -Double
26,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
3250, -Double
24,  Double
100,  Double
4500, -Double
31,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
-- 13 - female voice singing OO
--  fmt1  amp1  bw1     fmt2  amp2  bw2     fmt3  amp3  bw3
  , Double
280,  Double
0,      Double
100,  Double
650,  -Double
18,  Double
100,  Double
2200, -Double
48,  Double
100
--  fmt4  amp4  bw4     fmt5  amp5  bw5     ilris ildur ildec
  , Double
3450, -Double
50,  Double
100,  Double
4500, -Double
52,  Double
100,  Double
0.003,  Double
0.02, Double
0.007
    ]