-- | Names for common music notation durations.
module Music.Theory.Duration.Name where

import Music.Theory.Duration {- hmt -}

-- * Constants

breve,whole_note,half_note,quarter_note,eighth_note,sixteenth_note,thirtysecond_note :: Duration
breve :: Duration
breve = Integer -> Int -> Rational -> Duration
Duration Integer
0 Int
0 Rational
1
whole_note :: Duration
whole_note = Integer -> Int -> Rational -> Duration
Duration Integer
1 Int
0 Rational
1
half_note :: Duration
half_note = Integer -> Int -> Rational -> Duration
Duration Integer
2 Int
0 Rational
1
quarter_note :: Duration
quarter_note = Integer -> Int -> Rational -> Duration
Duration Integer
4 Int
0 Rational
1
eighth_note :: Duration
eighth_note = Integer -> Int -> Rational -> Duration
Duration Integer
8 Int
0 Rational
1
sixteenth_note :: Duration
sixteenth_note = Integer -> Int -> Rational -> Duration
Duration Integer
16 Int
0 Rational
1
thirtysecond_note :: Duration
thirtysecond_note = Integer -> Int -> Rational -> Duration
Duration Integer
32 Int
0 Rational
1

dotted_breve,dotted_whole_note,dotted_half_note,dotted_quarter_note,dotted_eighth_note,dotted_sixteenth_note,dotted_thirtysecond_note :: Duration
dotted_breve :: Duration
dotted_breve = Integer -> Int -> Rational -> Duration
Duration Integer
0 Int
1 Rational
1
dotted_whole_note :: Duration
dotted_whole_note = Integer -> Int -> Rational -> Duration
Duration Integer
1 Int
1 Rational
1
dotted_half_note :: Duration
dotted_half_note = Integer -> Int -> Rational -> Duration
Duration Integer
2 Int
1 Rational
1
dotted_quarter_note :: Duration
dotted_quarter_note = Integer -> Int -> Rational -> Duration
Duration Integer
4 Int
1 Rational
1
dotted_eighth_note :: Duration
dotted_eighth_note = Integer -> Int -> Rational -> Duration
Duration Integer
8 Int
1 Rational
1
dotted_sixteenth_note :: Duration
dotted_sixteenth_note = Integer -> Int -> Rational -> Duration
Duration Integer
16 Int
1 Rational
1
dotted_thirtysecond_note :: Duration
dotted_thirtysecond_note = Integer -> Int -> Rational -> Duration
Duration Integer
32 Int
1 Rational
1

double_dotted_breve,double_dotted_whole_note,double_dotted_half_note,double_dotted_quarter_note,double_dotted_eighth_note,double_dotted_sixteenth_note,double_dotted_thirtysecond_note :: Duration
double_dotted_breve :: Duration
double_dotted_breve = Integer -> Int -> Rational -> Duration
Duration Integer
0 Int
2 Rational
1
double_dotted_whole_note :: Duration
double_dotted_whole_note = Integer -> Int -> Rational -> Duration
Duration Integer
2 Int
2 Rational
1
double_dotted_half_note :: Duration
double_dotted_half_note = Integer -> Int -> Rational -> Duration
Duration Integer
2 Int
2 Rational
1
double_dotted_quarter_note :: Duration
double_dotted_quarter_note = Integer -> Int -> Rational -> Duration
Duration Integer
4 Int
2 Rational
1
double_dotted_eighth_note :: Duration
double_dotted_eighth_note = Integer -> Int -> Rational -> Duration
Duration Integer
8 Int
2 Rational
1
double_dotted_sixteenth_note :: Duration
double_dotted_sixteenth_note = Integer -> Int -> Rational -> Duration
Duration Integer
16 Int
2 Rational
1
double_dotted_thirtysecond_note :: Duration
double_dotted_thirtysecond_note = Integer -> Int -> Rational -> Duration
Duration Integer
32 Int
2 Rational
1