1:- module(musicxml,
    2          [ musicxml_score/2
    3          , score_prop/2
    4          , score_part_prop/3
    5          , score_part_events/3
    6          , score_part_chords/3
    7          , score_part_slices/3
    8          , score_part_notes/3
    9          , slices_notes/2
   10          , events_slices/2
   11          ]).

Reading and interpreting MusicXML files

This module provides tools for handling MusicXML files. Some of the types used are defined as follows:

chord ---> chord(pitch_class, pitch_class, list(interval)).
pitch ---> rest; pitch(pitch_class, octave).

octave      == integer.
pitch_class == alterable(nominal).
interval    == alterable(degree).

alterable(A) ---> a(A, integer).

nominal ---> 'A'; 'B'; 'C'; 'D'; 'E'; 'F'; 'G'.
degree  ---> 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14.

An 'alterable' in this context is something that can have a number of sharps or flats associated with it, including pitch classes and scale degrees. The event type is a pair of a time spec and a payload type. The time spec can be a number (a time point), a span (a pair of start and end time), or a tagged union of points and spans. Tied objects (notes) are specified by a pair of bools indicating if the object is tied to the previous and next objects respectively.

event(T, X) == pair(T, X).
ties == pair(bool, bool)
span == pair(number, number)
time_spec ---> point(number); span(span).
score_token ---> end; bar; change(chord); slice(list(tied(Pitch))).
tied(A) == pair(ties, A).

*/

   47:- use_module(library(xpath)).   48:- use_module(library(zlib), [gzopen/3, zopen/3]).   49:- use_module(library(sgml), [load_xml/3]).   50:- use_module(library(insist)).   51:- use_module(library(dcg_core), [get//1, trans//2, seqmap//2, seqmap//3]).   52:- use_module(library(dcg_pair)). % includes transduce/3
   53:- use_module(library(dcg_macros)).   54:- use_module(library(snobol), [arbno//1]).   55:- use_module(library(math), [add/3]).   56:- use_module(library(listutils), [cons/3, map_filter/3]).   57:- use_module(library(mxml_chords), [pitch_midi/2, decode_chord/2, decode_pitch/4]).   58
   59%% musicxml_score(+Source:source, -Score:xml) is det.
   60%  Read MusicXML from Source and unify Score with XML data structure.
   61%  Source can be a file name or =|stream(StreamHandle)|=
   62%  as recognised by load_xml/3.
   63musicxml_score(File, Score) :-
   64   setup_call_cleanup(file_source(File, Source, Release),
   65                      load_xml(Source, Doc, [space(remove)]),
   66                      Release),
   67   findall(Score, xpath(Doc, //'score-partwise', Score), Scores),
   68   insist(Scores = [Score], multiple_scores_in(File)).
   69
   70file_source(File, File, true) :- atom_concat(_, '.xml', File), !.
   71file_source(File, Stream, close(Stream)) :- atom_concat(_,'.xml.gz', File), !, 
   72   gzopen(File, read, Stream).
   73file_source(File, Uncompressed, close(Uncompressed)) :- atom_concat(_,'.mxl', File), !, 
   74   open(File, read, Compressed, []),
   75   zopen(Compressed, Uncompressed, [format(deflate)]).
 score_prop(+S:xml, -P:score_prop) is nondet
Valid props:
score_prop ---> parts(list(pid))
              ; title(atom)
              ; software(atom)
              ; date(atom).
   86score_prop(S, parts(Ps)) :- findall(P, xpath(S, 'part-list'/'score-part'(@id), P), Ps).
   87score_prop(S, date(Date)) :- xpath(S, identification/encoding/'encoding-date'(text), Date).
   88score_prop(S, software(So)) :- xpath(S, identification/encoding/software(text), So).
   89score_prop(S, title(Title)) :- xpath(S, credit/'credit-words'(text), Title).
   90
   91
   92%% score_part_prop(+S:xml, +P:pid, -P:part_prop) is nondet.
   93%  Also verifies that measure numbers are contiguous. Valid props:
   94%  ==
   95%  part_prop ---> divisions(nat)   % time is counted in this fraction of a crochet.
   96%               ; fifths(integer)  % number of sharps (+ve) or flats (-ve) in key sig
   97%               ; n_measures(nat). % number of measures in part
   98%  ==
   99score_part_prop(S, PartId, Prop) :-
  100   xpath(S, 'part'(@id=PartId), Part),
  101   findall(A, xpath(Part, //attributes, A), As),
  102   insist(As=[Attribs], too_many_attributes(As)),
  103   ( attribs_prop(Attribs, Prop)
  104   ; part_prop(Part, Prop)
  105   ).
  106
  107attribs_prop(Attribs, divisions(Div)) :- xpath(Attribs, divisions(number), Div).
  108attribs_prop(Attribs, fifths(Fifths)) :- xpath(Attribs, key/fifths(number), Fifths).
  109
  110part_prop(Part, n_measures(NMeasures)) :-
  111   findall(M, part_numbered_measure(Part, M), NumberedMeasures),
  112   length(NumberedMeasures, NMeasures),
  113   pairs_keys_values(NumberedMeasures, MNums, _),
  114   insist(numlist(1,NMeasures,MNums), bad_measure_numbers(MNums)).
  115
  116part_numbered_measure(Part, N-Content) :- 
  117   xpath(Part, measure, M),
  118   xpath(M, /self(@number(number)), N),
  119   M=element(_,_,Content).
  120
  121% ----------- decoding MusicXML measures ---------------------------------
  122
  123score_part_measures(Score, PartId, Measures) :-
  124   xpath(Score, 'part'(@id=PartId), Part),
  125   findall(M, xpath(Part, measure, element(_,_,M)), RawMeasures),
  126   maplist(decode1(measure, []), RawMeasures, Measures).
  127
  128decode_record(Elements) -->
  129   \< [element(El, Ats, Content)],
  130   ( {member(El, Elements)}, \> [El-Val], {decode1(El, Ats, Content, Val)}
  131   ; { maplist(dif(El), Elements),
  132      debug(musixml,"WARNING: Not processing element ~w",[El]) }
  133   ).
  134
  135decode1(El, Ats, Content, Val) :- insist(decodex(El, Ats, Content, Val)).
  136
  137decodex(El, Ats, _, Ats) :- attr(El), !.
  138decodex(El, _, [Content], Val) :- leaf(El, Content, Val).
  139decodex(El, _, Content, Val) :- transduce(in(El), Content, Val).
  140
  141attr(tie).
  142
  143in(measure) --> decode_record([harmony, note, backup, forward]).
  144in(harmony) --> decode_record([root, kind, bass, degree, offset]).
  145in(root)    --> decode_record(['root-step', 'root-alter']).
  146in(bass)    --> decode_record(['bass-step', 'bass-alter']).
  147in(degree)  --> decode_record(['degree-value', 'degree-alter', 'degree-type']).
  148in(note)    --> decode_record([pitch, duration, chord, rest, tie, voice]).
  149in(backup)  --> decode_record([duration]).
  150in(forward) --> decode_record([duration]).
  151in(pitch)   --> decode_record([step, alter, octave]).
  152
  153leaf(El,C,V) :- member(El, [alter, octave, duration, offset, voice, 'root-alter', 'degree-alter', 'bass-alter', 'degree-value']), atom_number(C,V).
  154leaf(El,C,C) :- member(El, [step, kind, 'root-step', 'bass-step', 'degree-type']).
 events_slices(+Events:list(event(time_spec,score_token)), -Slices:list(event(span,list(tied(pitch))))) is det
  158events_slices(Events, Slices) :- 
  159   map_filter(event_slice, Events, Slices).
  160
  161events_chords(Events, Chords) :- 
  162   map_filter(event_chord_change, Events, Changes),
  163   extend_durations(Changes, Chords).
 score_part_slices(+S:xml, +P:pid, -Slices:list(event(span,list(tied(pitch))))) is det
  166score_part_slices(Score, PartId, Slices) :-
  167   score_part_events(Score, PartId, Events),
  168   events_slices(Events, Slices).
 score_part_notes(+S:xml, +P:pid, -Notes:list(event(span,pitch))) is det
  171score_part_notes(Score, PartId, Notes) :-
  172   score_part_slices(Score, PartId, Slices),
  173   slices_notes(Slices, Notes).
 score_part_chords(+S:xml, +P:pid, -Chords:list(event(span,chord))) is det
  176score_part_chords(Score, PartId, Chords) :-
  177   score_part_events(Score, PartId, Events),
  178   events_chords(Events, Chords).
  179
  180event_chord_change(point(T)-change(C), T-C).
  181event_chord_change(point(T)-end, T-end).
  182event_slice(span(T)-slice(S), T-S).
  183
  184extend_durations([T-D | Cs], Es) :- seqmap(ext, Cs, Es, T-D, _).
  185ext(T2-D2, (T1-T2)-D1, T1-D1, T2-D2).
 score_part_events(+S:xml, +P:pid, -Events:list(event(time_spec,score_token))) is det
  189score_part_events(Score, PartId, Events) :-
  190   decode_measures(Score, PartId, Dur, Events, [point(Dur)-end]).
  191
  192decode_measures(Score, PartId, Dur) -->
  193   { score_part_measures(Score, PartId, Measures),
  194     score_part_prop(Score, PartId, divisions(Div)) },
  195   run_left(seqmap(transduce_measure(Div), Measures), 0, Dur).
  196
  197transduce_measure(Div, MeasureItems, T1-[ span(T1-T2)-bar| L1], T2-L2) :-
  198   insist(arbno(measure_item(Div), T1-(MeasureItems-L1), T2-([]-L2))).
  199
  200measure_item(Div) -->
  201   trans(Start, End) <\> (simultaneous_notes(Propss) <\> [ span(Start-End)-slice(Tokens) ]),
  202   {  maplist(member(duration-Dur), Propss),
  203      insist(maplist(member(voice-1), Propss)),
  204      maplist(decode_tied_note, Propss, Notes),
  205      exclude(is_rest, Notes, Tokens),
  206      add(Dur rdiv Div, Start, End)
  207   }.
  208
  209measure_item(Div) --> 
  210   get(T) <\> ([harmony-Props] <\> [point(TC)-change(Chord)]),
  211   {  select(offset-Offset, Props, Props1)
  212   -> TC is T + Offset rdiv Div
  213   ;  Props = Props1, TC = T
  214   },
  215   {insist(decode_chord(Props1, Chord))}.
  216
  217measure_item(Div) -->
  218   trans(Start, End) <\> (\< [forward-Props]),
  219   {  member(duration-Dur, Props),
  220      add(Dur rdiv Div, Start, End)
  221   }.
  222
  223measure_item(Div) -->
  224   trans(Start, End) <\> (\< [backup-Props]),
  225   {  member(duration-Dur, Props),
  226      add(-Dur rdiv Div, Start, End)
  227   }.
  228
  229is_rest(_-rest).
  230
  231chord_note(Chord, Props) --> 
  232   [note-Props], {membership(chord-_, Props,Chord)}.
  233
  234simultaneous_notes([Props1 | Propss]) -->
  235   chord_note(false, Props1),
  236   seqmap(chord_note(true), Propss).
  237
  238decode_tied_note(Props, Ties-Note) :-
  239   decode_ties(Props, Ties),
  240   decode_note(Props, Note).
  241
  242decode_note(Props, pitch(PitchClass, Oct)) :-
  243   member(pitch-PProps, Props),
  244   \+member(rest-_, Props),
  245   decode_pitch(step, alter, PProps, PitchClass),
  246   member(octave-Oct, PProps).
  247
  248decode_note(Props, rest) :-
  249   member(rest-_, Props),
  250   \+member(pitch-_, Props).
  251
  252decode_ties(Props, TiedBack-TiedFwd) :-
  253   is_tied(stop, Props, TiedBack),
  254   is_tied(start, Props, TiedFwd).
  255
  256is_tied(Type, Props, true) :- member(tie-TProps, Props), member(type=Type, TProps), !.
  257is_tied(_, _, false).
  258
  259membership(X, Xs, F) :- member(X,Xs) -> F=true; F=false.
 slices_notes(+Slices:list(event(span,list(tied(pitch)))), -Notes:list(event(span,pitch))) is det
Converts a sequence of time slices each containing multiple tied notes into a sequence of complete, possibly overlapping note events (without rests).
  265slices_notes(Slices, Notes) :- seqmap(process_slice, Slices, []-Notes, []-[]).
  266process_slice(T-Notes) --> seqmap(process_slice_note(T), Notes).
  267process_slice_note(T, (Back-Fwd)-Pitch) --> insist_dcg(process_ties(T, Back, Fwd, Pitch)).
  268
  269process_ties(T1-T2, false, false, Pitch) --> \> [ (T1-T2)-Pitch ].
  270process_ties(T1-_, false, true, Pitch) --> {pitch_midi(Pitch, NN)}, cons(NN-(T1-T2)) <\> [ (T1-T2)-Pitch ].
  271process_ties(_-T2,  true, false, Pitch) --> {pitch_midi(Pitch, NN)}, \< select(NN-(_-T2)).
  272% process_ties(T1-_, false, true, Pitch) --> cons(Pitch-(T1-T2)) <\> [ (T1-T2)-Pitch ].
  273% process_ties(_-T2,  true, false, Pitch) --> \< select(Pitch-(_-T2)).
  274process_ties(_, true, true, _) --> []. % check pitch is pending?
  275
  276insist_dcg(G, S1, S2) :- insist(call_dcg(G, S1, S2))