-- | Common music notation tempo indications.
module Music.Theory.Tempo_Marking where

import Data.List {- base -}

import Music.Theory.Duration
import Music.Theory.Duration.Rq
import Music.Theory.Time_Signature

-- | A tempo marking is in terms of a common music notation 'Duration'.
type Tempo_Marking = (Duration,Rational)

-- | Duration of a Rq value, in seconds, given indicated tempo.
--
-- > rq_to_seconds (quarter_note,90) 1 == 60/90
rq_to_seconds :: Tempo_Marking -> Rq -> Rational
rq_to_seconds :: Tempo_Marking -> Rational -> Rational
rq_to_seconds (Duration
d,Rational
n) Rational
x =
    let d' :: Rational
d' = Duration -> Rational
duration_to_rq Duration
d
        s :: Rational
s = Rational
60 forall a. Fractional a => a -> a -> a
/ Rational
n
    in (Rational
x forall a. Num a => a -> a -> a
* Rational
s) forall a. Fractional a => a -> a -> a
/ Rational
d'

-- | The duration, in seconds, of a pulse at the indicated time
--   signature and tempo marking.
--
-- > import Music.Theory.Duration.Name
-- > pulse_duration (6,8) (quarter_note,60) == 1/2
pulse_duration :: Time_Signature -> Tempo_Marking -> Rational
pulse_duration :: Time_Signature -> Tempo_Marking -> Rational
pulse_duration Time_Signature
t (Duration
x,Rational
i) =
    let j :: Rational
j = forall a. Fractional a => a -> a
recip (Time_Signature -> Duration -> Rational
ts_duration_pulses Time_Signature
t Duration
x)
        s :: Rational
s = Rational
60 forall a. Fractional a => a -> a -> a
/ Rational
i
    in Rational
j forall a. Num a => a -> a -> a
* Rational
s

-- | The duration, in seconds, of a measure at the indicated time
--   signaure and tempo marking.
--
-- > measure_duration (3,4) (quarter_note,90) == 2
-- > measure_duration (6,8) (quarter_note,120) == 3/2
measure_duration :: Time_Signature -> Tempo_Marking -> Rational
measure_duration :: Time_Signature -> Tempo_Marking -> Rational
measure_duration (Integer
n,Integer
d) Tempo_Marking
t = Time_Signature -> Tempo_Marking -> Rational
pulse_duration (Integer
n,Integer
d) Tempo_Marking
t forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n

-- | 'Fractional' variant of 'measure_duration'.
measure_duration_f :: Fractional c => Time_Signature -> Tempo_Marking -> c
measure_duration_f :: forall c. Fractional c => Time_Signature -> Tempo_Marking -> c
measure_duration_f Time_Signature
ts = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time_Signature -> Tempo_Marking -> Rational
measure_duration Time_Signature
ts

-- | Italian terms and markings from Wittner metronome (W.-Germany).
-- <http://wittner-gmbh.de/>
metronome_table_wittner :: Num n => [(String,(n,n))]
metronome_table_wittner :: forall n. Num n => [(String, (n, n))]
metronome_table_wittner =
    [(String
"Largo",(n
40,n
60))
    ,(String
"Larghetto",(n
60,n
66))
    ,(String
"Adagio",(n
66,n
76))
    ,(String
"Andante",(n
76,n
108))
    ,(String
"Moderato",(n
108,n
120))
    ,(String
"Allegro",(n
120,n
168))
    ,(String
"Presto",(n
168,n
208))]

-- | Italian terms and markings from Nikko Seiki metronome (Japan).
-- <http://nikkoseiki.com/>
metronome_table_nikko :: Num n => [(String,(n,n))]
metronome_table_nikko :: forall n. Num n => [(String, (n, n))]
metronome_table_nikko =
    [(String
"Grave",(n
40,n
46))
    ,(String
"Largo",(n
46,n
52))
    ,(String
"Lento",(n
52,n
56))
    ,(String
"Adagio",(n
56,n
60))
    ,(String
"Larghetto",(n
60,n
66))
    ,(String
"Adagietto",(n
66,n
72))
    ,(String
"Andante",(n
72,n
80))
    ,(String
"Andantino",(n
80,n
88))
    ,(String
"Maestoso",(n
88,n
96))
    ,(String
"Moderato",(n
96,n
108))
    ,(String
"Allegretto",(n
108,n
120))
    ,(String
"Animato",(n
120,n
132))
    ,(String
"Allegro",(n
132,n
144))
    ,(String
"Assai",(n
144,n
160))
    ,(String
"Vivace",(n
160,n
184))
    ,(String
"Presto",(n
184,n
208))
    ,(String
"Prestissimo",(n
208,n
240))]

-- | Lookup metronome mark in table.
--
-- > mm_name metronome_table_nikko 72 == Just "Andante"
mm_name :: Ord a => [(String,(a,a))] -> a -> Maybe String
mm_name :: forall a. Ord a => [(String, (a, a))] -> a -> Maybe String
mm_name [(String, (a, a))]
tbl a
x =
    let f :: (a, (a, a)) -> Bool
f (a
_,(a
p,a
q)) = a
x forall a. Ord a => a -> a -> Bool
>= a
p Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
< a
q
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall {a}. (a, (a, a)) -> Bool
f [(String, (a, a))]
tbl)