Chris@10: :- module(chord_parser,[chord/4,tokenise/2,parse/2]).
Chris@10: 
Chris@10: /**
Chris@10:  * A SWI DCG for parsing chord textual representation
Chris@10:  * as defined in Harte, 2005 (ISMIR proceedings)
Chris@10:  *
Chris@10:  * Yves Raimond, C4DM, Queen Mary, University of London
Chris@10:  */
Chris@10: 
Chris@10: :- use_module(library('semweb/rdf_db')).
Chris@10: 
Chris@10: 
Chris@10: parse(ChordSymbol,RDF) :-
Chris@10: 	tokenise(ChordSymbol,Tokens),
Chris@10: 	phrase(chord(ChordSymbol,RDF2),Tokens),
Chris@10: 	clean(RDF2,RDF3),
Chris@10: 	((add_image_link(RDF3,RDF,[],_, ''),!);(RDF3=RDF)).
Chris@10: 
Chris@10: 
Chris@10: clean(Description,Rest) :-
Chris@10: 	member(rdf(A,'http://purl.org/ontology/chord/without_interval',I1),Description),
Chris@10: 	member(rdf(I1,'http://purl.org/ontology/chord/degree',D),Description),
Chris@10: 	member(rdf(I1,'http://purl.org/ontology/chord/modifier',M),Description),
Chris@10: 	select(rdf(A,'http://purl.org/ontology/chord/interval',I2),Description,R1),
Chris@10: 	select(rdf(I2,'http://purl.org/ontology/chord/degree',D),R1,R2),
Chris@10: 	select(rdf(I2,'http://purl.org/ontology/chord/modifier',M),R2,Rest),!.
Chris@10: clean(Description,Rest) :-
Chris@10: 	member(rdf(A,'http://purl.org/ontology/chord/without_interval',I1),Description),
Chris@10: 	member(rdf(I1,'http://purl.org/ontology/chord/degree',D),Description),
Chris@10: 	\+member(rdf(I1,'http://purl.org/ontology/chord/modifier',M),Description),
Chris@10: 	select(rdf(A,'http://purl.org/ontology/chord/interval',I2),Description,R1),
Chris@10: 	select(rdf(I2,'http://purl.org/ontology/chord/degree',D),R1,Rest),
Chris@10: 	\+member(rdf(I2,'http://purl.org/ontology/chord/modifier',M),Rest),!.
Chris@10: clean(Description,Description).
Chris@10: 
Chris@10: 
Chris@10: add_image_link(DescIn, DescOut, IntsIn, IntsOut, _) :-
Chris@10: 	member(rdf(_, 'http://purl.org/ontology/chord/interval', I), DescIn),
Chris@10: 	member(rdf(I,'http://purl.org/ontology/chord/degree',literal(type(_,D))),DescIn),
Chris@10: 	\+member(D, IntsIn),
Chris@10: 	append([D], IntsIn, I2),
Chris@10: 	add_image_link(DescIn, DescOut, I2, IntsOut).
Chris@10: 
Chris@10: add_image_link(DescIn, DescOut, IntsIn, IntsIn) :-
Chris@10: 	member(rdf(C,'http://purl.org/ontology/chord/interval',_), DescIn),
Chris@10: 	%root_for_chord(DescIn,C,Root),
Chris@10: 	%sort(IntsIn, SortedInts),
Chris@10: 	%concat_atom(SortedInts,',',Ints),
Chris@10: 	atom_concat('http://purl.org/ontology/chord/symbol/',Symbol,C),
Chris@10: 	format(atom(Image),'http://rvw.doc.gold.ac.uk/omras2/widgets/chord/~w',[Symbol]),
Chris@10: 	append([rdf(C,'http://xmlns.com/foaf/0.1/depiction', Image)],DescIn, DescOut).
Chris@10: 	
Chris@10: 
Chris@10: root_for_chord(RDF, C, Root) :-
Chris@10: 	member(rdf(C,'http://purl.org/ontology/chord/root',RNote), RDF),
Chris@10: 	atom_concat('http://purl.org/ontology/chord/note/',Root,RNote).
Chris@10: 
Chris@10: root_for_chord(RDF, C, Root) :-
Chris@10: 	member(rdf(C,'http://purl.org/ontology/chord/root',RNote), RDF),
Chris@10: 	member(rdf(RNote,'http://purl.org/ontology/chord/natural',Natural), RDF),
Chris@10: 	atom_concat('http://purl.org/ontology/chord/note/',RootNat,Natural),
Chris@10: 	member(rdf(RNote,'http://purl.org/ontology/chord/modifier', M), RDF),
Chris@10: 	modifier(M,MText),
Chris@10: 	atom_concat(RootNat,MText,Root).
Chris@10: 
Chris@10: modifier('http://purl.org/ontology/chord/flat', T) :- T='b'.
Chris@10: modifier('http://purl.org/ontology/chord/sharp', T) :- T='s'.
Chris@10: modifier('http://purl.org/ontology/chord/doubleflat', T) :- T='bb'.
Chris@10: modifier('http://purl.org/ontology/chord/doublesharp', T) :- T='ss'.
Chris@10: 	
Chris@10: 	
Chris@10: % DCG
Chris@10: 
Chris@10: namespace('http://purl.org/ontology/chord/symbol/').
Chris@10: 
Chris@10: chord(Symbol,
Chris@10: 	[
Chris@10: 		rdf(ID,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/Chord')
Chris@10: 	,	rdf(ID,'http://www.w3.org/2002/07/owl#sameAs','http://purl.org/ontology/chord/noChord')
Chris@10: 	]
Chris@10: 	) -->
Chris@10: 	{namespace(NS),atom_concat(NS,Symbol,ID)},
Chris@10: 	['N'].
Chris@10: chord(Symbol,
Chris@10: 	[
Chris@10: 		rdf(ID,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/Chord')
Chris@10: 	,	rdf(ID,'http://purl.org/ontology/chord/root',NoteURI)
Chris@10: 	,	rdf(ID,'http://purl.org/ontology/chord/base_chord',ShorthandURI)
Chris@10: 	|	Tail
Chris@10: 	]
Chris@10: 	) --> 
Chris@10: 	{namespace(NS),atom_concat(NS,Symbol,ID)},
Chris@10: 	note(NoteURI,T1), 
Chris@10: 	[':'],
Chris@10: 	shorthand(ShorthandURI),
Chris@10: 	optdegreelist(ID,T2),
Chris@10: 	optdegree(ID,T3),
Chris@10: 	!,
Chris@10: 	{shorthand_rdf(ID,ShorthandURI,ShorthandRDF),flatten([ShorthandRDF,T1,T2,T3],Tail)}.
Chris@10: chord(Symbol,
Chris@10: 	[
Chris@10: 		rdf(ID,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/Chord')
Chris@10: 	,	rdf(ID,'http://purl.org/ontology/chord/root',NoteURI)
Chris@10: 	|	Tail
Chris@10: 	]
Chris@10: 	) -->
Chris@10: 	{namespace(NS),atom_concat(NS,Symbol,ID)},
Chris@10: 	note(NoteURI,T1),
Chris@10: 	[':'],
Chris@10: 	['('],
Chris@10: 	degreelist(ID,T2),
Chris@10: 	[')'],
Chris@10: 	optdegree(ID,T3),!,
Chris@10: 	{flatten([T1,T2,T3],Tail)}.
Chris@10: chord(Symbol,
Chris@10: 	[
Chris@10: 		rdf(ID,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/Chord')
Chris@10: 	,	rdf(ID,'http://purl.org/ontology/chord/root',NoteURI)
Chris@10: 	,	rdf(ID,'http://purl.org/ontology/chord/base_chord','http://purl.org/ontology/chord/maj')
Chris@10: 	|	Tail
Chris@10: 	]
Chris@10: 	) -->
Chris@10: 	{namespace(NS),atom_concat(NS,Symbol,ID)},
Chris@10: 	note(NoteURI,T1),
Chris@10: 	optdegree(ID,T2),!,
Chris@10: 	{shorthand_rdf(ID,'http://purl.org/ontology/chord/maj',ShorthandRDF),flatten([T1,T2,ShorthandRDF],Tail)}.
Chris@10: chord([]) --> [].
Chris@10: 
Chris@10: note(ID,[
Chris@10: 		rdf(ID,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/Note')
Chris@10: 	,	rdf(ID,'http://purl.org/ontology/chord/modifier',Modifier)
Chris@10: 	,	rdf(ID,'http://purl.org/ontology/chord/natural',NoteURI)	
Chris@10: 	]) -->
Chris@10: 	{rdf_bnode(ID)},
Chris@10: 	natural(NoteURI),
Chris@10: 	modifier(Modifier),!.
Chris@10: note(NoteURI,[]) -->
Chris@10:         natural(NoteURI).
Chris@10: 
Chris@10: optdegreelist(ID,Triples) -->
Chris@10: 	['('],degreelist(ID,Triples),[')'],!.
Chris@10: optdegreelist(_,[]) --> [].
Chris@10: 
Chris@10: optdegree(ID,[rdf(ID,'http://purl.org/ontology/chord/bass',BassNode),rdf(BassNode,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval')|Triples]) -->
Chris@10: 	{rdf_bnode(BassNode)},
Chris@10: 	['/'],degree(BassNode,Triples),!.
Chris@10: optdegree(_,[]) --> [].
Chris@10: 
Chris@10: natural('http://purl.org/ontology/chord/note/A') --> ['A'].
Chris@10: natural('http://purl.org/ontology/chord/note/B') --> ['B'].
Chris@10: natural('http://purl.org/ontology/chord/note/C') --> ['C'].
Chris@10: natural('http://purl.org/ontology/chord/note/D') --> ['D'].
Chris@10: natural('http://purl.org/ontology/chord/note/E') --> ['E'].
Chris@10: natural('http://purl.org/ontology/chord/note/F') --> ['F'].
Chris@10: natural('http://purl.org/ontology/chord/note/G') --> ['G'].
Chris@10: 
Chris@10: modifier('http://purl.org/ontology/chord/doubleflat') --> ['b','b'].
Chris@10: modifier('http://purl.org/ontology/chord/doublesharp') --> ['s','s'].
Chris@10: modifier('http://purl.org/ontology/chord/flat') --> ['b'].
Chris@10: modifier('http://purl.org/ontology/chord/sharp') --> ['s']. %will perhaps have to change it
Chris@10: 
Chris@10: degreelist(URI,[
Chris@10: 		rdf(URI,'http://purl.org/ontology/chord/without_interval',Interval)
Chris@10: 	,	rdf(Interval,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval')
Chris@10: 	|	Tail
Chris@10: 	]) --> 
Chris@10: 	{rdf_bnode(Interval)},
Chris@10: 	['*'],
Chris@10: 	degree(Interval,T1),
Chris@10: 	[','],
Chris@10: 	degreelist(URI,T2),
Chris@10: 	{append(T1,T2,Tail)}.
Chris@10: degreelist(URI,[
Chris@10: 		rdf(URI,'http://purl.org/ontology/chord/without_interval',Interval)
Chris@10: 	,	rdf(Interval,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval')
Chris@10: 	|	Tail
Chris@10: 	]) --> 
Chris@10: 	['*'],
Chris@10: 	{rdf_bnode(Interval)},
Chris@10: 	degree(Interval,Tail).
Chris@10: degreelist(URI,[
Chris@10: 		rdf(URI,'http://purl.org/ontology/chord/interval',Interval)
Chris@10: 	,	rdf(Interval,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval')
Chris@10: 	|	Tail
Chris@10: 	]) -->
Chris@10: 	{rdf_bnode(Interval)},
Chris@10: 	degree(Interval,T1),
Chris@10: 	[','],
Chris@10: 	degreelist(URI,T2),
Chris@10: 	{append(T1,T2,Tail)}.
Chris@10: degreelist(URI,[
Chris@10: 		rdf(URI,'http://purl.org/ontology/chord/interval',Interval)
Chris@10: 	,	rdf(Interval,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval')
Chris@10: 	|	Tail
Chris@10: 	]) -->
Chris@10: 	{rdf_bnode(Interval)},
Chris@10: 	degree(Interval,Tail).
Chris@10: 
Chris@10: 
Chris@10: degree(IntervalURI,[rdf(IntervalURI,'http://purl.org/ontology/chord/degree',literal(type('http://www.w3.org/2001/XMLSchema#int',Interval)))]) -->
Chris@10: 	interval(Interval).
Chris@10: %No more than two modifiers - hardcoded
Chris@10: degree(IntervalURI,
Chris@10: 	[
Chris@10: 		rdf(IntervalURI,'http://purl.org/ontology/chord/modifier',ModifierURI)
Chris@10: 	,	rdf(IntervalURI,'http://purl.org/ontology/chord/degree',literal(type('http://www.w3.org/2001/XMLSchema#int',Interval)))
Chris@10: 	]) --> 
Chris@10: 	modifier(ModifierURI),
Chris@10: 	interval(Interval).
Chris@10: 
Chris@10: 
Chris@10: interval(N) --> 
Chris@10: 	[N], 
Chris@10: 	{member(N,['1','2','3','4','5','6','7','8','9','10','11','12','13','14','15','16','17','18','19','20','21','22','23','24'])}.
Chris@10: 
Chris@10: shorthand('http://purl.org/ontology/chord/maj') --> 
Chris@10: 	['maj'].
Chris@10: shorthand('http://purl.org/ontology/chord/min') --> 
Chris@10: 	['min'].
Chris@10: shorthand('http://purl.org/ontology/chord/dim') --> 
Chris@10: 	['dim'].
Chris@10: shorthand('http://purl.org/ontology/chord/aug') -->
Chris@10: 	['aug'].
Chris@10: shorthand('http://purl.org/ontology/chord/maj7') -->
Chris@10: 	['maj7'].
Chris@10: shorthand('http://purl.org/ontology/chord/min7') -->
Chris@10: 	['min7'].
Chris@10: shorthand('http://purl.org/ontology/chord/seventh') -->
Chris@10: 	['7'].
Chris@10: shorthand('http://purl.org/ontology/chord/dim7') -->
Chris@10: 	['dim7'].
Chris@10: shorthand('http://purl.org/ontology/chord/hdim7') -->
Chris@10: 	['hdim7'].
Chris@10: shorthand('http://purl.org/ontology/chord/minmaj7') -->
Chris@10: 	['minmaj7'].
Chris@10: shorthand('http://purl.org/ontology/chord/maj6') -->
Chris@10: 	['maj6'].
Chris@10: shorthand('http://purl.org/ontology/chord/min6') -->
Chris@10: 	['min6'].
Chris@10: shorthand('http://purl.org/ontology/chord/ninth') -->
Chris@10: 	['9'].
Chris@10: shorthand('http://purl.org/ontology/chord/maj9') -->
Chris@10: 	['maj9'].
Chris@10: shorthand('http://purl.org/ontology/chord/min9') -->
Chris@10: 	['min9'].
Chris@10: shorthand('http://purl.org/ontology/chord/sus4') -->
Chris@10: 	['sus4'].
Chris@10: shorthand('http://purl.org/ontology/chord/sus2') -->
Chris@10: 	['sus2'].
Chris@10: 	
Chris@10: 
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/maj',['1','3','5']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/min',['1',flat('3'),'5']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/dim',['1',flat('3'),flat('5')]).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/aug',['1','3',sharp('5')]).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/maj7',['1','3','5','7']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/seventh',['1','3','5',flat('7')]).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/min7',['1',flat('3'),'5',flat('7')]).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/dim7',['1',flat('3'),flat('5'),doubleflat('7')]).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/hdim7',['1',flat('3'),flat('5'),flat('7')]).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/minmaj7',['1',flat('3'),'5','7']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/maj6',['1','3','5','6']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/min6',['1',flat('3'),'5','6']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/ninth',['1','3','5',flat('7'),'9']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/maj9',['1','3','5','7','9']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/min9',['1',flat('3'),'5',flat('7'),'9']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/sus4',['1','4','5']).
Chris@10: shorthand_intervals('http://purl.org/ontology/chord/sus2',['1','2','5']).
Chris@10: 	
Chris@10: shorthand_rdf(Chord,Shorthand,RDF) :-
Chris@10: 	shorthand_intervals(Shorthand,Intervals),
Chris@10: 	intervals_to_rdf(Chord,Intervals,RDF).
Chris@10: 	
Chris@10: intervals_to_rdf(Chord,[flat(H)|T],[rdf(Chord,'http://purl.org/ontology/chord/interval',SI),rdf(SI,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval'),rdf(SI,'http://purl.org/ontology/chord/degree',literal(type('http://www.w3.org/2001/XMLSchema#int',H))),rdf(SI,'http://purl.org/ontology/chord/modifier','http://purl.org/ontology/chord/flat')|T2]) :-
Chris@10: 	!,rdf_bnode(SI),
Chris@10: 	intervals_to_rdf(Chord,T,T2).
Chris@10: 	
Chris@10: intervals_to_rdf(Chord,[doubleflat(H)|T],[rdf(Chord,'http://purl.org/ontology/chord/interval',SI),rdf(SI,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval'),rdf(SI,'http://purl.org/ontology/chord/degree',literal(type('http://www.w3.org/2001/XMLSchema#int',H))),rdf(SI,'http://purl.org/ontology/chord/modifier','http://purl.org/ontology/chord/doubleflat')|T2]) :-
Chris@10:         !,rdf_bnode(SI),
Chris@10:         intervals_to_rdf(Chord,T,T2).
Chris@10: 
Chris@10: intervals_to_rdf(Chord,[sharp(H)|T],[rdf(Chord,'http://purl.org/ontology/chord/interval',SI),rdf(SI,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval'),rdf(SI,'http://purl.org/ontology/chord/degree',literal(type('http://www.w3.org/2001/XMLSchema#int',H))),rdf(SI,'http://purl.org/ontology/chord/modifier','http://purl.org/ontology/chord/sharp')|T2]) :-
Chris@10:         !,rdf_bnode(SI),
Chris@10:         intervals_to_rdf(Chord,T,T2).
Chris@10: 
Chris@10: intervals_to_rdf(Chord,[doublesharp(H)|T],[rdf(Chord,'http://purl.org/ontology/chord/interval',SI),rdf(SI,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval'),rdf(SI,'http://purl.org/ontology/chord/degree',literal(type('http://www.w3.org/2001/XMLSchema#int',H))),rdf(SI,'http://purl.org/ontology/chord/modifier','http://purl.org/ontology/chord/doublesharp')|T2]) :-
Chris@10:         !,rdf_bnode(SI),
Chris@10:         intervals_to_rdf(Chord,T,T2).
Chris@10: 
Chris@10: intervals_to_rdf(Chord,[H|T],[rdf(Chord,'http://purl.org/ontology/chord/interval',SI),rdf(SI,'http://www.w3.org/1999/02/22-rdf-syntax-ns#type','http://purl.org/ontology/chord/ScaleInterval'),rdf(SI,'http://purl.org/ontology/chord/degree',literal(type('http://www.w3.org/2001/XMLSchema#int',H)))|T2]) :-
Chris@10:         rdf_bnode(SI),
Chris@10:         intervals_to_rdf(Chord,T,T2).
Chris@10: 
Chris@10: intervals_to_rdf(_,[],[]).
Chris@10: 
Chris@10: 
Chris@10: 
Chris@10: %tokeniser 
Chris@10: 
Chris@10: %tokens - the order is actually important (longer first)
Chris@10: 
Chris@10: token(minmaj7).
Chris@10: token(maj9).
Chris@10: token(maj7).
Chris@10: token(maj6).
Chris@10: token(maj).
Chris@10: token(min9).
Chris@10: token(min7).
Chris@10: token(min6).
Chris@10: token(min).
Chris@10: token(dim7).
Chris@10: token(dim).
Chris@10: token(aug).
Chris@10: token('7').
Chris@10: token(hdim7).
Chris@10: token('9').
Chris@10: token(sus4).
Chris@10: token(sus2).
Chris@10: 
Chris@10: token('A').
Chris@10: token('B').
Chris@10: token('C').
Chris@10: token('D').
Chris@10: token('E').
Chris@10: token('F').
Chris@10: token('G').
Chris@10: 
Chris@10: token('10').
Chris@10: token('11').
Chris@10: token('12').
Chris@10: token('13').
Chris@10: token('14').
Chris@10: token('15').
Chris@10: token('16').
Chris@10: token('17').
Chris@10: token('18').
Chris@10: token('19').
Chris@10: token('1').
Chris@10: token('20').
Chris@10: token('21').
Chris@10: token('22').
Chris@10: token('23').
Chris@10: token('24').
Chris@10: token('2').
Chris@10: token('3').
Chris@10: token('4').
Chris@10: token('5').
Chris@10: token('6').
Chris@10: token('7').
Chris@10: token('8').
Chris@10: token('9').
Chris@10: 
Chris@10: %token('#').
Chris@10: token(s).
Chris@10: token(':').
Chris@10: token('b').
Chris@10: token('/').
Chris@10: token('(').
Chris@10: token(')').
Chris@10: token(',').
Chris@10: token('*').
Chris@10: token('N').
Chris@10: 
Chris@10: 
Chris@10: tokenise(Atom,Tokens) :-
Chris@10: 	atom_chars(Atom,Chars),
Chris@10: 	tokenise_l(Chars,Tokens),!.
Chris@10: tokenise_l([],[]) :- !.
Chris@10: tokenise_l(Chars,[Token|Tail]) :-
Chris@10: 	grab_token(Chars,Token,CharRest),
Chris@10: 	tokenise_l(CharRest,Tail).
Chris@10: 
Chris@10: grab_token([H|T1],Atom,CharRest) :-
Chris@10: 	token(Token),atom_chars(Token,[H|T2]),
Chris@10: 	grab_token2(T1,T2,H,Atom,CharRest).
Chris@10: grab_token2(Tail,[],Atom,Atom,Tail) :- !.
Chris@10: grab_token2([H|T1],[H|T2],At,Atom,CharRest) :-
Chris@10: 	atom_concat(At,H,NewAt),
Chris@10: 	grab_token2(T1,T2,NewAt,Atom,CharRest).
Chris@10: 
Chris@10: 
Chris@10: