hmt-0.14: Haskell Music Theory

Safe HaskellSafe-Inferred

Music.Theory.Pitch

Contents

Description

Common music notation pitch values.

Synopsis

Documentation

type PitchClass = IntegerSource

Pitch classes are modulo twelve integers.

type Octave = IntegerSource

Octaves are Integers, the octave of middle C is 4.

type Octave_PitchClass i = (i, i)Source

Octave and PitchClass duple.

data Note_T Source

Enumeration of common music notation note names (C to B).

Constructors

C 
D 
E 
F 
G 
A 
B 

data Pitch Source

Common music notation pitch value.

Constructors

Pitch 

Instances

pitch_pp :: Pitch -> StringSource

Pretty printer for Pitch (unicode, see alteration_symbol).

 pitch_pp (Pitch E Flat 4) == "E♭4"
 pitch_pp (Pitch F QuarterToneSharp 3) == "F𝄲3"

pitch_pp_ascii :: Pitch -> StringSource

Pretty printer for Pitch (ASCII, see alteration_ly_name).

 pitch_pp_ascii (Pitch E Flat 4) == "ees4"
 pitch_pp_ascii (Pitch F QuarterToneSharp 3) == "fih3"

note_to_pc :: Integral i => Note_T -> iSource

Transform Note_T to pitch-class number.

 map note_to_pc [C,E,G] == [0,4,7]

alteration_to_diff :: Integral i => Alteration_T -> Maybe iSource

Transform Alteration_T to semitone alteration. Returns Nothing for non-semitone alterations.

 map alteration_to_diff [Flat,QuarterToneSharp] == [Just (-1),Nothing]

alteration_to_diff_err :: Integral i => Alteration_T -> iSource

Transform Alteration_T to semitone alteration.

 map alteration_to_diff_err [Flat,Sharp] == [-1,1]

alteration_to_fdiff :: Fractional n => Alteration_T -> nSource

Transform Alteration_T to fractional semitone alteration, ie. allow quarter tones.

 alteration_to_fdiff QuarterToneSharp == 0.5

fdiff_to_alteration :: (Fractional n, Eq n) => n -> Maybe Alteration_TSource

Transform fractional semitone alteration to Alteration_T, ie. allow quarter tones.

 map fdiff_to_alteration [-0.5,0.5] == [Just QuarterToneFlat
                                       ,Just QuarterToneSharp]

alteration_symbol :: Alteration_T -> CharSource

Unicode has entries for Musical Symbols in the range U+1D100 through U+1D1FF. The 3/4 symbols are non-standard, here they correspond to MUSICAL SYMBOL FLAT DOWN and MUSICAL SYMBOL SHARP UP.

 map alteration_symbol [minBound .. maxBound] == "𝄫𝄭♭𝄳♮𝄲♯𝄰𝄪"

alteration_ly_name :: Alteration_T -> StringSource

The Lilypond ASCII spellings for alterations.

 map alteration_ly_name [Flat .. Sharp] == ["es","eh","","ih","is"]

alteration_raise_quarter_tone :: Alteration_T -> Maybe Alteration_TSource

Raise Alteration_T by a quarter tone where possible.

 alteration_raise_quarter_tone Flat == Just QuarterToneFlat
 alteration_raise_quarter_tone DoubleSharp == Nothing

alteration_lower_quarter_tone :: Alteration_T -> Maybe Alteration_TSource

Lower Alteration_T by a quarter tone where possible.

 alteration_lower_quarter_tone Sharp == Just QuarterToneSharp
 alteration_lower_quarter_tone DoubleFlat == Nothing

alteration_edit_quarter_tone :: (Fractional n, Eq n) => n -> Alteration_T -> Maybe Alteration_TSource

Edit Alteration_T by a quarter tone where possible, -0.5 lowers, 0 retains, 0.5 raises.

alteration_clear_quarter_tone :: Alteration_T -> Alteration_TSource

Simplify Alteration_T to standard 12ET by deleting quarter tones.

 Data.List.nub (map alteration_clear_quarter_tone [minBound..maxBound])

pitch_clear_quarter_tone :: Pitch -> PitchSource

Simplify Pitch to standard 12ET by deleting quarter tones.

 let p = Pitch A QuarterToneSharp 4
 in alteration (pitch_clear_quarter_tone p) == Sharp

pitch_to_octpc :: Integral i => Pitch -> Octave_PitchClass iSource

Pitch to Octave and PitchClass notation.

 pitch_to_octpc (Pitch F Sharp 4) == (4,6)

pitch_to_midi :: Integral i => Pitch -> iSource

Pitch to midi note number notation.

 pitch_to_midi (Pitch A Natural 4) == 69

pitch_to_fmidi :: Pitch -> DoubleSource

Pitch to fractional midi note number notation.

 pitch_to_fmidi (Pitch A QuarterToneSharp 4) == 69.5

pitch_to_pc :: Pitch -> PitchClassSource

Extract PitchClass of Pitch

 pitch_to_pc (Pitch A Natural 4) == 9
 pitch_to_pc (Pitch F Sharp 4) == 6

pitch_compare :: Pitch -> Pitch -> OrderingSource

Pitch comparison, implemented via pitch_to_fmidi.

 pitch_compare (Pitch A Natural 4) (Pitch A QuarterToneSharp 4) == LT

type Spelling n = n -> (Note_T, Alteration_T)Source

Function to spell a PitchClass.

octpc_to_pitch :: Integral i => Spelling i -> Octave_PitchClass i -> PitchSource

Given Spelling function translate from OctPC notation to Pitch.

octpc_nrm :: Integral i => Octave_PitchClass i -> Octave_PitchClass iSource

Normalise OctPC value, ie. ensure PitchClass is in (0,11).

 octpc_nrm (4,16) == (5,4)

octpc_trs :: Integral i => i -> Octave_PitchClass i -> Octave_PitchClass iSource

Transpose OctPC value.

 octpc_trs 7 (4,9) == (5,4)
 octpc_trs (-11) (4,9) == (3,10)

octpc_to_midi :: Integral i => Octave_PitchClass i -> iSource

OctPC value to integral midi note number.

 octpc_to_midi (4,9) == 69

midi_to_octpc :: Integral i => i -> Octave_PitchClass iSource

Inverse of octpc_to_midi.

 midi_to_octpc 69 == (4,9)

midi_to_pitch :: Integral i => Spelling i -> i -> PitchSource

Midi note number to Pitch.

 let r = ["C4","E♭4","F♯4"]
 in map (pitch_pp . midi_to_pitch pc_spell_ks) [60,63,66] == r

fmidi_to_pitch :: RealFrac n => Spelling Integer -> n -> PitchSource

Fractional midi note number to Pitch.

 import Music.Theory.Pitch.Spelling
 pitch_pp (fmidi_to_pitch pc_spell_ks 65.5) == "F𝄲4"
 pitch_pp (fmidi_to_pitch pc_spell_ks 66.5) == "F𝄰4"
 pitch_pp (fmidi_to_pitch pc_spell_ks 67.5) == "A𝄭4"
 pitch_pp (fmidi_to_pitch pc_spell_ks 69.5) == "B𝄭4"

pitch_note_raise :: Pitch -> PitchSource

Raise Note_T of Pitch, account for octave transposition.

 pitch_note_raise (Pitch B Natural 3) == Pitch C Natural 4

pitch_note_lower :: Pitch -> PitchSource

Lower Note_T of Pitch, account for octave transposition.

 pitch_note_lower (Pitch C Flat 4) == Pitch B Flat 3

pitch_rewrite_threequarter_alteration :: Pitch -> PitchSource

Rewrite Pitch to not use 3/4 tone alterations, ie. re-spell to 1/4 alteration.

 let {p = Pitch A ThreeQuarterToneFlat 4
     ;q = Pitch G QuarterToneSharp 4}
 in pitch_rewrite_threequarter_alteration p == q

pitch_edit_octave :: (Integer -> Integer) -> Pitch -> PitchSource

Apply function to octave of PitchClass.

 pitch_edit_octave (+ 1) (Pitch A Natural 4) == Pitch A Natural 5

note_t_transpose :: Note_T -> Int -> Note_TSource

Modal transposition of Note_T value.

 note_t_transpose C 2 == E

Frequency (CPS)

midi_to_cps :: (Integral i, Floating f) => i -> fSource

Midi note number to cycles per second.

 map midi_to_cps [60,69] == [261.6255653005986,440.0]

fmidi_to_cps :: Floating a => a -> aSource

Fractional midi note number to cycles per second.

 map fmidi_to_cps [69,69.1] == [440.0,442.5488940698553]

cps_to_midi :: (Integral i, Floating f, RealFrac f) => f -> iSource

Frequency (cycles per second) to midi note number.

 map cps_to_midi [261.6,440] == [60,69]

cps_to_fmidi :: Floating a => a -> aSource

Frequency (cycles per second) to fractional midi note number.

 cps_to_fmidi 440 == 69
 cps_to_fmidi (fmidi_to_cps 60.25) == 60.25

octpc_to_cps :: (Integral i, Floating n) => Octave_PitchClass i -> nSource

midi_to_cps of octpc_to_midi.

 octpc_to_cps (4,9) == 440