Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Common music notation intervals.
Synopsis
- data Interval_Type
- data Interval_Quality
- = Diminished
- | Minor
- | Perfect
- | Major
- | Augmented
- data Interval = Interval {}
- interval_ty :: Note -> Note -> Interval_Type
- interval_q_tbl :: Integral n => [(Interval_Type, [(n, Interval_Quality)])]
- interval_q :: Interval_Type -> Int -> Maybe Interval_Quality
- interval_q_reverse :: Interval_Type -> Interval_Quality -> Maybe Int
- interval_semitones :: Interval -> Int
- interval :: Pitch -> Pitch -> Interval
- invert_interval :: Interval -> Interval
- quality_difference_m :: Interval_Quality -> Interval_Quality -> Maybe Int
- quality_difference :: Interval_Quality -> Interval_Quality -> Int
- pitch_transpose :: Interval -> Pitch -> Pitch
- circle_of_fifths :: Pitch -> ([Pitch], [Pitch])
- parse_interval_type :: String -> Maybe (Interval_Type, Octave)
- parse_interval_quality :: Char -> Maybe Interval_Quality
- interval_type_degree :: (Interval_Type, Octave) -> Int
- interval_quality_pp :: Interval_Quality -> Char
- parse_interval :: String -> Maybe Interval
- parse_interval_err :: String -> Interval
- interval_pp :: Interval -> String
- std_interval_names :: ([String], [String])
Documentation
data Interval_Type Source #
Interval type or degree.
Instances
data Interval_Quality Source #
Interval quality.
Instances
Common music notation interval. An Ordering
of LT
indicates
an ascending interval, GT
a descending interval, and EQ
a
unison.
interval_ty :: Note -> Note -> Interval_Type Source #
Interval type between Note
values.
map (interval_ty C) [E,B] == [Third,Seventh]
interval_q_tbl :: Integral n => [(Interval_Type, [(n, Interval_Quality)])] Source #
Table of interval qualities. For each Interval_Type
gives
directed semitone interval counts for each allowable Interval_Quality
.
For lookup function see interval_q
, for reverse lookup see
interval_q_reverse
.
interval_q :: Interval_Type -> Int -> Maybe Interval_Quality Source #
Lookup Interval_Quality
for given Interval_Type
and semitone count.
interval_q Unison 11 == Just Diminished interval_q Third 5 == Just Augmented interval_q Fourth 5 == Just Perfect interval_q Unison 3 == Nothing
interval_q_reverse :: Interval_Type -> Interval_Quality -> Maybe Int Source #
Lookup semitone difference of Interval_Type
with Interval_Quality
.
interval_q_reverse Third Minor == Just 3 interval_q_reverse Unison Diminished == Just 11
interval_semitones :: Interval -> Int Source #
Semitone difference of Interval
.
interval_semitones (interval (Pitch C Sharp 4) (Pitch E Sharp 5)) == 16 interval_semitones (interval (Pitch C Natural 4) (Pitch D Sharp 3)) == -9
interval :: Pitch -> Pitch -> Interval Source #
Determine Interval
between two Pitch
es.
interval (T.Pitch T.C T.Sharp 4) (T.Pitch T.D T.Flat 4) == Interval Second Diminished EQ 0 interval (T.Pitch T.C T.Sharp 4) (T.Pitch T.E T.Sharp 5) == Interval Third Major LT 1
invert_interval :: Interval -> Interval Source #
Apply ord_invert
to interval_direction
of Interval
.
invert_interval (Interval Third Major LT 1) == Interval Third Major GT 1
quality_difference_m :: Interval_Quality -> Interval_Quality -> Maybe Int Source #
The signed difference in semitones between two Interval_Quality
values when applied to the same Interval_Type
. Can this be written
correctly without knowing the Interval_Type?
quality_difference_m Minor Augmented == Just 2 quality_difference_m Augmented Diminished == Just (-3) quality_difference_m Major Perfect == Nothing
quality_difference :: Interval_Quality -> Interval_Quality -> Int Source #
Erroring variant of quality_difference_m
.
pitch_transpose :: Interval -> Pitch -> Pitch Source #
Transpose a Pitch
by an Interval
.
transpose (Interval Third Diminished LT 0) (Pitch C Sharp 4) == Pitch E Flat 4
circle_of_fifths :: Pitch -> ([Pitch], [Pitch]) Source #
Make leftwards (perfect fourth) and and rightwards (perfect
fifth) circles from Pitch
.
let c = circle_of_fifths (Pitch F Sharp 4) in map pitch_to_pc (snd c) == [6,1,8,3,10,5,12,7,2,9,4,11]
parse_interval_type :: String -> Maybe (Interval_Type, Octave) Source #
Parse a positive integer into interval type and octave displacement.
mapMaybe parse_interval_type (map show [1 .. 15])
parse_interval_quality :: Char -> Maybe Interval_Quality Source #
Parse interval quality notation.
mapMaybe parse_interval_quality "dmPMA" == [minBound .. maxBound]
interval_type_degree :: (Interval_Type, Octave) -> Int Source #
Degree of interval type and octave displacement. Inverse of
parse_interval_type
.
map interval_type_degree [(Third,0),(Second,1),(Unison,2)] == [3,9,15]
interval_quality_pp :: Interval_Quality -> Char Source #
Inverse of 'parse_interval_quality.
parse_interval :: String -> Maybe Interval Source #
Parse standard common music interval notation.
let i = mapMaybe parse_interval (words "P1 d2 m2 M2 A3 P8 +M9 -M2") in unwords (map interval_pp i) == "P1 d2 m2 M2 A3 P8 M9 -M2"
mapMaybe (fmap interval_octave . parse_interval) (words "d1 d8 d15") == [-1,0,1]
interval_pp :: Interval -> String Source #
Pretty printer for intervals, inverse of parse_interval
.
std_interval_names :: ([String], [String]) Source #
Standard names for the intervals within the octave, divided into perfect, major and minor at the left, and diminished and augmented at the right.
let {bimap f (p,q) = (f p,f q) ;f = mapMaybe (fmap interval_semitones . parse_interval)} in bimap f std_interval_names