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
   16% MusicXML chord kinds, as DCG rules for spitting out intervals.
   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
   24% shorthand names for sequences of intervals
   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
   54% 'Neapolitan' -->
   55% 'Italian' -->
   56% 'French' -->
   57% 'German' -->
   58% 'pedal' --> 
   59% 'Tristan' -->
   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
   87% K is the list of degrees coming from the chord kind.
   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)