hmt-0.20: Haskell Music Theory
Safe HaskellSafe-Inferred
LanguageHaskell2010

Music.Theory.Pitch.Spelling.Cluster

Description

Spelling for chromatic clusters.

Synopsis

Documentation

cluster_normal_order :: [PitchClass] -> [PitchClass] Source #

Form of cluster with smallest outer boundary interval.

cluster_normal_order [0,1,11] == [11,0,1]

cluster_normal_order_octpc :: Octave -> [PitchClass] -> [OctPc] Source #

Normal order starting in indicated octave.

cluster_normal_order_octpc 3 [0,1,11] == [(3,11),(4,0),(4,1)]

cluster_is_multiple_octave :: [PitchClass] -> Bool Source #

True if sort of cluster is not equal to cluster_normal_order.

map cluster_is_multiple_octave [[0,1,11],[1,2,3],[1,2,11]] == [True,False,True]

spell_cluster_table :: [([PitchClass], [(Note, Alteration)])] Source #

Spelling table for chromatic and near-chromatic clusters, pitch-classes are in cluster order.

let f (p,q) = (p == map T.note_alteration_to_pc_err q)
in all f spell_cluster_table

spell_cluster_octpc :: [OctPc] -> Maybe [Pitch] Source #

Spell an arbitrary sequence of OctPc values.

fmap (map T.pitch_pp_iso) (spell_cluster_octpc [(3,11),(4,3),(4,11),(5,1)])

spell_cluster_c4 :: [PitchClass] -> Maybe [Pitch] Source #

Spelling for chromatic clusters. Sequence must be ascending. Pitch class 0 maps to c4, if there is no 0 then all notes are in octave 4.

let f = (fmap (map T.pitch_pp) . spell_cluster_c4)
map f [[11,0],[11],[0,11]] == [Just ["B3","C4"],Just ["B4"],Nothing]
fmap (map T.pitch_pp) (spell_cluster_c4 [10,11]) == Just ["A♯4","B4"]

spell_cluster_c :: Octave -> [PitchClass] -> Maybe [Pitch] Source #

Variant of spell_cluster_c4 that runs pitch_edit_octave. An octave of 4 is the identitiy, 3 an octave below, 5 an octave above.

fmap (map T.pitch_pp) (spell_cluster_c 3 [11,0]) == Just ["B2","C3"]
fmap (map T.pitch_pp) (spell_cluster_c 3 [10,11]) == Just ["A♯3","B3"]

spell_cluster_f :: (PitchClass -> Octave) -> [PitchClass] -> Maybe [Pitch] Source #

Variant of spell_cluster_c4 that runs pitch_edit_octave so that the left-most note is in the octave given by f.

import Data.Maybe
let f n = if n >= 11 then 3 else 4
let g = map T.pitch_pp .fromJust . spell_cluster_f f
let r = [["B3","C4"],["B3"],["C4"],["A♯4","B4"]]
map g [[11,0],[11],[0],[10,11]] == r
map (spell_cluster_f (const 4)) [[0,11],[11,0],[6,7],[7,6]]

spell_cluster_left :: Octave -> [PitchClass] -> Maybe [Pitch] Source #

Variant of spell_cluster_c4 that runs pitch_edit_octave so that the left-most note is in octave o.

fmap (map T.pitch_pp) (spell_cluster_left 3 [11,0]) == Just ["B3","C4"]
fmap (map T.pitch_pp) (spell_cluster_left 3 [10,11]) == Just ["A♯3","B3"]