1/* Part of plumdrum
    2	Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL)
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/

recip ---> X:natural  % duration is 1/X except for X=0, then duration=2
         ; dots(X:natural,N:natural)   % add N dots, means (1/X)*(3/2)^N

pitch_class ---> a ; b ; c ; d ; e ; f ; g
               ; sharp(pitch_class)
               ; flat(pitch_class).

barline_attribute ---> double
                ; ortho(list(barline_ortho))
                ; number(natural)
                ; number(natural,natural)
                ; pause.

barline_ortho ---> normal ; heavy ; partial1 ; partial2 ; invisible ; repeat.

   43:- module(humutils,
   44		[	nat//1
   45		,	float//1
   46		,	charsex//4
   47		,	pitchclass//1
   48		,	pitchclass//2
   49		,	pitch//2
   50		,	recip//1
   51		,	bar//1
   52		,	recip_to_rational/2
   53		,	rep_shared//2
   54		,	peek//1
   55		]).   56
   57:- use_module(library(clp/bounds)).   58:- use_module(library(dcg_core)).   59:- use_module(library(dcg_pair)).   60:- use_module(library(dcg_macros)).   61:- use_module(library(snobol)).   62
   63:- set_prolog_flag(double_quotes,codes).   64
   65% --------------- DCG utilities ----------------------------------------

 peek(+X:list(A))// is semidet

peek(-X:list(A))// is nondet

Works in a list(A) DCG and unifies X with the first one or two elements of the list being parsed. Can be used in a DCG to peek the first one or two elements of the unparsed % list without removing them.

   73peek([C],L,L) :- L=[C|_].
   74peek([C1,C2],L,L) :- L=[C1,C2|_].

 charsex(+Type:char_type, +ExFirst:list(code), +Exclude:list(code), -Chars:list(code))// is nondet

Parses characters of char_type Type excluding characters in Exclude. In addition, the first character is not allowed to be in ExFirst. NB: ordering of clauses means charsex will read as much as possible and only get to shorter parses on backtracking. Character types as defined by char_type/2 but adding type text defined as the union of types graph and space.

   84charsex(T,Z1,Z,[X|Y]) --> [X], 
   85	{ ctype(X,T), \+member(X,Z1), \+member(X,Z) }, 
   86	charsex(T,[],Z,Y).
   87charsex(_,_,_,[]) --> [].
   88
   89% Augmented char_type sort of thing
   90ctype(A,text) :- !, (char_type(A,graph); char_type(A,space)).
   91ctype(A,T) :- char_type(A,T).

 nat(-Number:natural)// is nondet

Parse or generate a natural number, ie a non-negative integer.

   95nat(I) --> 
   96	(	{integer(I)} -> {I>=0, number_codes(I,A)}, A
   97	;	charsex(digit,[],[],A), {A=[_|_], number_codes(I,A)}).

 float(-X:float)// is semidet

Can parse or generate a float as part of a list-of-codes DCG.

  101float(X) --> 
  102	(	{number(X)} -> {number_codes(X,A)}, A
  103	;	charsex(digit,[],[],A), 
  104		(	".",charsex(digit,[],[],B)
  105		->	{"."=[Dot],append(A,[Dot|B],C)}
  106		;	{C=A}
  107		),
  108		{C=[_|_], number_codes(X,C)}
  109	).

 pitch(P:pitch_class, O:integer)// is semidet

Parses a pitch in Humdrum Kern syntax. The grammar is

pitch --> pitch_octave, modifiers.
pitch_octave --> {member(N,"abcdefg")}, +[N]  % each extra N goes up 1 octave
               ; {member(N,"ABCDEFG")}, +[N]. % each extra N goes down 1 octave
modifiers --> +"#"    % one or more sharps
            ; +"-"    % one or more flats
            ; "n"     % explicity natural
            ; "".     % implicit natural

+X --> X ; X, +X.     % one or more copies of X.

  125pitch(P,O) --> pitch_oct(N,O), wrap_mods(N,P).
  126
  127wrap_mods(N,Q) --> sharpen(N,P), iterate(sharpen,P,Q), \+sharpen(Q,_).
  128wrap_mods(N,Q) --> flatten(N,P), iterate(flatten,P,Q), \+flatten(Q,_).
  129wrap_mods(N,N) --> maybe("n"), \+sharpen(N,_), \+flatten(N,_).
  130
  131sharpen(A,sharp(A)) --> "#".
  132flatten(A,flat(A)) --> "-".

 pitchclass(P:pitch_class)// is semidet

 pitchclass(C:oneof([lower,upper]), P:pitch_class)// is semidet

Parses a pitch class in upper or lower case forms.

  137pitchclass(P) --> pitchclass(lower,P).
  138pitchclass(Case,P) --> pitchname(Case,N), wrap_mods(N,P).
  139
  140% base pitch names in upper or lower case
  141pitchname(upper,N) --> [UNC], 
  142	{member(UNC,"ABCDEFG"), to_lower(UNC,NC), char_code(N,NC)}.
  143pitchname(lower,N) --> [NC], 
  144	{member(NC,"abcdefg"), char_code(N,NC)}.
  145
  146% absolute pitch with octave but without sharps or flats
  147% parsing direction
  148pitch_oct(N,O)  --> {var(O)}, pitchname(lower,N), !, rep_shared(K,pitchname(lower,N)), {O is K+4}.
  149pitch_oct(N,O)  --> {var(O)}, pitchname(upper,N), !, rep_shared(K,pitchname(upper,N)), {O is 3-K}.
  150
  151pitch_oct(N,O)  --> {nonvar(O)}, 
  152	(	{O >= 4}
  153	->	{K is O-3}, rep(K,pitchname(lower,N))
  154	; 	{K is 4-O}, rep(K,pitchname(upper,N))
  155	).

 rep_shared(N:natural, P:phrase)// is nondet

Equivalent to P repeated N times. Any variables in P are shared between iterations.

  160rep_shared(K,P) --> P, rep_shared(J,P), {succ(J,K)}.
  161rep_shared(0,_) --> [].
  162
  163% -------------------- Durations --------------------------------------

 recip_to_rational(+R:recip, -D:rational) is det

Converts duration from recip format to rational number.

  168recip_to_rational(dots(R,N),D) :- !, 
  169	recip_to_rational(R,D0), 
  170	rep(N,mul(1 rdiv 2),1,C),
  171	D1 is D0*(2 - C),
  172	D=D1.
  173
  174recip_to_rational(0,2)         :- !.
  175recip_to_rational(1,1)         :- !.
  176recip_to_rational(R,1 rdiv R)  :- R>0.

 recip(-R:recip)// is semidet

Parses a duration as a recip term.

  180recip(D) --> nat(R), \+any("0123456789"), iterate(dottify,R,D).
  181
  182dottify(dots(A,N),dots(A,M)) --> !, ".", {succ(N,M)}.
  183dottify(A,dots(A,1)) --> ".".
  184
  185mul(X,Y,Z) :- Z is Y*X.
  186
  187
  188
  189% ---------------- BAR lines -------------------
  190
  191
  192nth_lower(N,C) :- nth1(N,"abcdefghijklmnopqrstuvwxyz",C).

 bar(-Attrs:list(bar_attributes))// is semidet

Parses Humdrum bar signifiers. See module header for data type.

  197bar(Attrs) --> "=", run_left(bar_attrs,Attrs,[]).
  198
  199bar_attrs -->
  200	maybe(bar_double), 
  201	maybe(bar_number),
  202	maybe(bar_pause),
  203	(bar_ortho; nop).
  204
  205bar_double --> \> span("="), \< [double].
  206bar_number --> \> (nat(N), [C]), {nth_lower(M,C)}, \< [number(N,M)].
  207bar_number --> \> nat(N), \< [number(N)].
  208bar_pause --> \> ";",\< [pause].
  209bar_ortho --> \> seqmap(bar_ortho,O), {O\=[]}, \< [ortho(O)].
  210
  211bar_ortho(normal)    --> "|".
  212bar_ortho(heavy)     --> "!".
  213bar_ortho(repeat)    --> ":".
  214bar_ortho(partial1)  --> "'".
  215bar_ortho(partial2)  --> "`".
  216bar_ortho(invisible) --> "-"