-- | Names specific to western music tradition
module Temporal.Music.Western(
    -- * Volume
    -- ** Levels
    -- | Dynamics values form 8-level equally spaced grid. 
    -- They are from quietest
    -- to loudest: piano pianissimo (ppp), pianissimo (pp), piano (p),
    -- mezzo piano (mp), mezzo forte (mf), forte (f), fortissimo (ff),
    -- forte fortissimo (fff).
    Dynamics(..),

    -- ** short-cuts
    ppp', pp', p', mp', mf', f', ff', fff',

    -- ** Envelops
    dim, cresc, 

    -- ** Volume level constants
    
    -- * Score    
    -- ** Forms    
    rondo, reprise, 
    
    -- ** Tempo
    -- | Tempo terms specify not a rigid value but tempo range. So all
    -- terms are functions from relative power of term (it's value
    -- of type Double from 0 to 1) to some tempo value. Zero means
    -- lowest value from tempo range and one means highest value.
    Tempo, 
	lento, largo, larghetto, grave, adagio, adagietto,
    andante, andantino, moderato, allegretto,
    allegro, vivace, presto, prestissimo,

    -- * Note
    NoteW, DrumW,
    Note(..), Drum,    
    absNote, absDrum,
    
    -- ** Rests    
    bnr, wnr, qnr, hnr, enr, snr, tnr, 
    dbnr, dwnr, dqnr, dhnr, denr, dsnr, dtnr,
    
    -- ** Notes
    
    bn, wn, hn, qn, en, sn, tn, 
    dbn, dwn, dhn, dqn, den, dsn, dtn,
    
    -- ** Drums
    bd, wd, hd, qd, ed, sd, td, 
    dbd, dwd, dhd, dqd, ded, dsd, dtd
) where

import Temporal.Music.Notation



import Temporal.Music.Notation.Note(Note(..), Drum,
    absNote, absDrum,
    bnr, wnr, qnr, hnr, enr, snr, tnr, 
    dbnr, dwnr, dqnr, dhnr, denr, dsnr, dtnr) 

import qualified Temporal.Music.Notation.Note as N



---------------------------------------
-- volume levels

-- | Dynamics levels. Default defined volume 
-- defined in 'Vol' class is (1e-5, 1).
data Dynamics = PPP | PP | P | MP | MF | F | FF | FFF
    deriving (Show, Eq, Enum, Bounded)

instance Seg Dynamics

instance Vol Dynamics where
    volume = Volume (1e-5, 1)

-- short-cuts

ppp', pp', p', mp', mf', f', ff', fff' :: LevelFunctor a => a -> a

ppp' = setLevel PPP
pp'  = setLevel PP 
p'   = setLevel P
mp'  = setLevel MP
mf'  = setLevel MF
f'   = setLevel F
ff'  = setLevel FF
fff' = setLevel FFF

-- | diminuendo
dim :: LevelFunctor a => Accent -> Score a -> Score a
dim v = dynamics ((-v) *)

-- | crescendo
cresc :: LevelFunctor a => Accent -> Score a -> Score a
cresc v = dynamics (v * )

---------------------------------------
-- forms

-- | rondo form
--
-- >rondo a b c = line [a, b, a, c, a]
rondo :: Score a -> Score a -> Score a -> Score a
rondo a b c = line [a, b, a, c, a]

-- | reprise form
--
-- >reprise a b1 b2 = line [a, b1, a, b2]
reprise :: Score a -> Score a -> Score a -> Score a
reprise a b c = line [a, b, a, c]

---------------------------------------
-- tempo

type Tempo = Double

largoRange, larghettoRange, 
	adagioRange, adagiettoRange, 
    andanteRange, andantinoRange,
	moderatoRange, allegroRange,
    allegrettoRange, vivaceRange,
	prestoRange, prestissimoRange :: (Double, Double)

largoRange       = ( 40, 60) 
larghettoRange   = ( 60, 66) 
adagioRange      = ( 66, 76)
adagiettoRange   = ( 70, 80)
andanteRange     = ( 76, 80)
andantinoRange   = ( 80,100)
moderatoRange    = (101,110)
allegrettoRange  = (115,125)
allegroRange     = (120,139)
vivaceRange      = (135,160)
prestoRange      = (168,200)
prestissimoRange = (200,230)

getTempo :: (Tempo, Tempo) -> Double -> Tempo
getTempo (a, b) x = a + (b - a) * x

-- | very slow (40-60 bpm), like largo
lento :: Double -> Tempo
lento       = largo

-- | very slow (40-60 bpm)
largo :: Double -> Tempo
largo       = getTempo largoRange

-- | rather broadly (60-66 bpm)
larghetto :: Double -> Tempo
larghetto   = getTempo larghettoRange

-- | slow and sloemn (60 - 66 bpm)
grave :: Double -> Tempo
grave = larghetto

-- | slow and stately (literally "at ease") (66-76 bpm)
adagio :: Double -> Tempo
adagio      = getTempo adagioRange

-- | rather slow (70-80 bpm)
adagietto :: Double -> Tempo 
adagietto = getTempo adagiettoRange

-- | at awalking pace (76-80 bpm)
andante :: Double -> Tempo 
andante     = getTempo andanteRange

-- | slightly faster then andante (80-100 bpm)
andantino :: Double -> Tempo 
andantino     = getTempo andantinoRange

-- | moderately (101-110 bpm)
moderato :: Double -> Tempo
moderato    = getTempo moderatoRange

-- | moderately fast (115-125 bpm)
allegretto :: Double -> Tempo
allegretto     = getTempo allegrettoRange

-- | fast, at 'march tempo' (120-139 bpm)
allegro :: Double -> Tempo
allegro     = getTempo allegroRange

-- | lively and fast (135-160 bpm)
vivace :: Double -> Tempo
vivace = getTempo vivaceRange

-- | very fast (168-200 bpm)
presto :: Double -> Tempo
presto      = getTempo prestoRange

-- | extremely fast (200 - 230 bpm)
prestissimo :: Double -> Tempo
prestissimo = getTempo prestissimoRange

-- Note

-- | Western 'Note' (eight volume levels and twelve tones)
type NoteW p a = Note Dynamics p a

-- | Western 'Drum' note (eight volume levels)
type DrumW a = Drum Dynamics a

-- shortcuts

-- notes
bn, wn, hn, qn, en, sn, tn, 
    dbn, dwn, dhn, dqn, den, dsn, dtn :: 
    Pch p => Tone p -> Score (NoteW p a)

bn = N.bn
wn = N.wn
hn = N.hn
qn = N.qn
en = N.en
sn = N.sn
tn = N.tn
dbn = N.dbn
dwn = N.dwn
dhn = N.dhn
dqn = N.dqn
den = N.den
dsn = N.dsn
dtn = N.dtn

-- drums

bd, wd, hd, qd, ed, sd, td, 
    dbd, dwd, dhd, dqd, ded, dsd, dtd :: 
    Accent -> Score (DrumW a)

bd = N.bd
wd = N.wd
hd = N.hd
qd = N.qd
ed = N.ed
sd = N.sd
td = N.td
dbd = N.dbd
dwd = N.dwd
dhd = N.dhd
dqd = N.dqd
ded = N.ded
dsd = N.dsd
dtd = N.dtd