1:- module(mxml_chords, [ decode_pitch/4, decode_chord/2
2 , chord_pitches/2, ivals_triad_exts/3
3 , fifths_key/2, pc_name_num/2
4 , fifths_from_c/2
5 , pc_octave_midi/3
6 , pitch_midi/2
7 ]). 8
9:- use_module(library(clpfd)). 10:- use_module(library(listutils), [cons/3]). 11:- use_module(library(data/pair), [ map_select_key_value/5
12 , map_select_key_default_value/6
13 , select_key_default_value/5
14 ]). 15
17:- op(200,fx,#). 18:- op(200,fx,&). 19
20\N --> [a(N,0)].
21&N --> [a(N,-1)].
22#N --> [a(N,+1)].
23
25+other --> [].
26+major --> \1, \3, \5.
27+minor --> \1, &3, \5.
28+diminished --> \1, &3, &5.
29+augmented --> \1, \3, #5.
30+'suspended-second' --> \1, \2, \5.
31+'suspended-fourth' --> \1, \4, \5.
32+'power' --> \1, \5.
33
34+dominant --> +major, &7.
35+'major-seventh' --> +major, \7.
36+'minor-seventh' --> +minor, &7.
37+'augmented-seventh' --> +augmented, &7.
38+'diminished-seventh' --> +diminished, [a(7,-2)].
39+'half-diminished' --> +diminished, &7.
40+'major-minor' --> +minor, \7.
41+'major-sixth' --> +major, \6.
42+'minor-sixth' --> +minor, \6.
43+'dominant-ninth' --> +dominant, \9.
44+'augmented-ninth'--> +'augmented-seventh', \9.
45+'major-ninth' --> +'major-seventh', \9.
46+'minor-ninth' --> +'minor-seventh', \9.
47+'dominant-11th' --> +'dominant-ninth', \11.
48+'major-11th' --> +'major-ninth', \11.
49+'minor-11th' --> +'minor-ninth', \11.
50+'dominant-13th' --> +'dominant-11th', \13.
51+'major-13th' --> +'major-11th', \13.
52+'minor-13th' --> +'minor-11th', \13.
53
60
61triad(T) :- member(T, [major, minor, diminished, augmented, 'suspended-second', 'suspended-fourth', 'power']).
62ivals_triad_exts(Ivals, Triad, Exts) :-
63 triad(Triad), +(Triad, Ivals, Exts).
64
65expand_ival(I, a(I,0)) :- atomic(I).
66expand_ival(flat(I), a(D,A)) :- A #< 0, !, A1 #= A+1, expand_ival(I,a(D,A1)).
67expand_ival(sharp(I), a(D,A)) :- A #> 0, !, A1 #= A-1, expand_ival(I,a(D,A1)).
68
69decode_kind(Kind, KindIvals) :- phrase(+Kind, KindIvals).
70
71decode_chord(Props, chord(Root, Bass, SortedIvals)) :-
72 phrase(( map_select_key_value(decode_kind, kind, KindIvals),
73 map_select_key_value(decode_pitch('root-step','root-alter'), root, Root),
74 map_select_key_default_value(decode_pitch('bass-step','bass-alter'), bass, Root, Bass)
75 ), Props, Props1),
76 findall(D, member(degree-D, Props1), Degrees),
77 foldl(edit_intervals(KindIvals), Degrees, KindIvals, Ivals),
78 sort(Ivals, SortedIvals).
79
80edit_intervals(KindIvals, DegreeProps, Is1, Is2) :-
81 phrase(( select('degree-type'-Type),
82 select('degree-value'-Deg),
83 select_key_default_value('degree-alter', 0, Alter)
84 ), DegreeProps, []),
85 apply_ival_mod(Type, Deg, Alter, KindIvals, Is1, Is2).
86
88apply_ival_mod(add, 7, A, _) --> !, {A1 is A-1}, cons(a(7,A1)).
89apply_ival_mod(add, D, A, _) --> cons(a(D,A)).
90apply_ival_mod(subtract, D, A, K) --> {member(a(D,A0), K), A1 is A0 + A}, select(a(D,A1)).
91apply_ival_mod(alter, D, A, K) --> {member(a(D,A0), K), A1 is A0 + A}, select(a(D,A0)), cons(a(D,A1)).
92
93decode_pitch(StepKey, AlterKey, Props, a(Nominal, Alter)) :-
94 map_select_key_value((=), StepKey, Nominal, Props, _),
95 select_key_default_value(AlterKey, 0, Alter, Props, _).
96
97% alter_pitch(0, Nom, Nom).
98% alter_pitch(N, Nom, sharp(P)) :- N>0, M is N-1, alter_pitch(M,Nom,P).
99% alter_pitch(N, Nom, flat(P)) :- N<0, M is N+1, alter_pitch(M,Nom,P).
100
101% chord_pitches(end, []).
102chord_pitches(chord(Root, Bass, Ivals), B-Pitches) :-
103 pc_octave_midi(Root, 3, R),
104 pc_octave_midi(Bass, _, B),
105 R - 18 #=< B, B #< R - 6,
106 maplist(ival_semis, Ivals, Semitones),
107 maplist(plus(R), Semitones, Pitches).
108
109pc_octave_midi(a(D,A), O, NN) :-
110 nominal_semis(D, NN0),
111 NN #= NN0 + A + 12*(O+1).
112
113pitch_midi(pitch(PC,O), NN) :-pc_octave_midi(PC, O, NN).
114
115ival_semis(a(I,A), Semis) :-
116 degree_semis(I, Base),
117 Semis #= Base + A.
118
119nominal_semis('C', 0).
120nominal_semis('D', 2).
121nominal_semis('E', 4).
122nominal_semis('F', 5).
123nominal_semis('G', 7).
124nominal_semis('A', 9).
125nominal_semis('B', 11).
126
127degree_semis(1, 0).
128degree_semis(2, 2).
129degree_semis(3, 4).
130degree_semis(4, 5).
131degree_semis(5, 7).
132degree_semis(6, 9).
133degree_semis(7, 11).
134degree_semis(8, 12).
135degree_semis(9, 14).
136degree_semis(10, 16).
137degree_semis(11, 17).
138degree_semis(12, 19).
139degree_semis(13, 21).
140degree_semis(14, 23).
141degree_semis(15, 24).
142
143fifths_key(Fifths, Tonic-major) :- fifths_from_c(Fifths, Tonic).
144fifths_key(Fifths, Tonic-minor) :- Rel #= Fifths+3, fifths_from_c(Rel, Tonic).
145
146
147pc_name_num(a(N,A), Num) :-
148 Num #= (Base + A) mod 12,
149 int(Fifths), fifths_from_c(Fifths-2, a(N,A)),
150 nominal_semis(N,Base).
151
152int(N) :- N=0; between(1,inf,M), (N=M; N is -M).
153
154fifths_from_c(Fifths, a(N,A)) :-
155 F #= (Fifths) mod 7,
156 A #= (Fifths+1) div 7,
157 nominal_fifths(N, F),
158 label([Fifths]).
159
160nominal_fifths('C', 0).
161nominal_fifths('G', 1).
162nominal_fifths('D', 2).
163nominal_fifths('A', 3).
164nominal_fifths('E', 4).
165nominal_fifths('B', 5).
166nominal_fifths('F', 6)