unit mtxline; { Break input up into words, classify them. Supply words and information about them. } interface uses globals; type music_word = (other, abcdefg, zword, lyrtag, lparen, rparen, rlparen, lbrac, rbrac, pmxprefix, pmxl, macro, endmacro, mword, oword, rword, nextvoice, barword, texword, atword, FirstOnly, err ); const bind_left: array[music_word] of boolean = ( false, false, true, false, false, true, true, false, true, true, true, false, true, false, true, false, true, false, false, false, false, false ); { changed bind_left[barword] to false } var selected: array[voice_index] of boolean; procedure error3(voice: voice_index; message: string ); procedure warning3(voice: voice_index; message: string ); procedure getNextMusWord (var buf, note: string; var nscan: music_word); function MusicWord(voice, n: integer): string; function nextMusicWord(voice: voice_index): string; function thisNote(voice: voice_index): music_word; function nextNote(voice: voice_index): music_word; function getMusicWord(voice: voice_index): string; procedure gotoBar(voice: voice_index; bar_no: integer); function endOfBar(voice: voice_index; bar_no: integer): boolean; function getBar(voice:voice_index; bar: integer): string; function upper(voice: voice_index): boolean; procedure clearLabels; function findVoice(w: string): voice_index0; procedure selectVoices(line: string); procedure resetInfo(voice: voice_index; var buf: string); procedure setVocal(voice: voice_index; voc: boolean); function isVocal(voice: voice_index): boolean; procedure setStavePos(voice: voice_index; stave, pos: stave_index); function voiceStave(voice: voice_index): stave_index; function voicePos(voice: voice_index): stave_index; function aloneOnStave(stave: stave_index): boolean; function companion(voice: voice_index): voice_index; procedure appendNote(voice: voice_index; nscan: music_word); procedure appendToLine(voice: voice_index; note: string); procedure markBar(voice: voice_index); function numberOfBars(voice: voice_index): integer; procedure barForward(voice: voice_index; nbars: integer); procedure regroup(voice: voice_index); function beatsPerLine: integer; procedure setExtraLength(voice: voice_index; ext: integer); function ExtraLength(voice: voice_index): integer; function musicLineNo(voice: voice_index): paragraph_index0; procedure setMusicLineNo(voice: voice_index; lno: paragraph_index); function chordLineNo(voice: voice_index): paragraph_index0; procedure setChordLineNo(voice: voice_index; lno: paragraph_index); procedure skipChordBar(voice: voice_index); procedure describeVoice(voice: voice_index; describe_lyr: string); function maybeMusicLine(l: string): boolean; function musicLine(voice: voice_index): string; implementation uses strings, notes, control, utility; const name: array[music_word] of string[9] = ( '?', 'note', 'znote', 'lyricsTag', '(', ')', ')(', '[', ']', '_','PMX<', 'macro', 'endMacro', 'meter', 'ornament', 'rest', '//', 'BAR', 'TeX', '@', 'firstonly', 'ERROR'); type word_scan = array[1..max_words] of music_word; line_info = record here, nword: word_index0; nbar: bar_index0; voice_pos, voice_stave, mus, chord: paragraph_index0; extra: integer; vocal: boolean; bar_bound: array[bar_index0] of word_index0; word_bound, orig_word_bound: array[word_index0] of integer; scan: word_scan; end; var info: array[voice_index] of line_info; { ------------------------------------------------------------- } function beatsPerLine: integer; var voice: voice_index; begin for voice:=1 to nvoices do with info[voice] do if (nbar>0) or (extra>0) then begin if extra mod one_beat > 0 then error3(voice,'Line length not an integer number of beats'); beatsPerLine := nbar*meternum + extra div one_beat; end; end; procedure skipChordBar(voice: voice_index); begin with info[voice] do if chord>0 then if P[chord]=barsym then predelete(P[chord],1); end; function getBar(voice: voice_index; bar: integer): string; begin with info[voice] do getBar := substr(P[mus],word_bound[bar_bound[bar-1]]+1, word_bound[bar_bound[bar]]-word_bound[bar_bound[bar-1]]); end; function musicLine(voice: voice_index): string; begin musicLine:=P[musicLineNo(voice)]; end; function musicLineNo(voice: voice_index): paragraph_index0; begin musicLineNo := info[voice].mus; end; procedure setMusicLineNo(voice: voice_index; lno: paragraph_index); begin info[voice].mus := lno; end; function chordLineNo(voice: voice_index): paragraph_index0; begin chordLineNo := info[voice].chord; end; procedure setChordLineNo(voice: voice_index; lno: paragraph_index); begin info[voice].chord := lno; end; procedure setVocal(voice: voice_index; voc: boolean); begin info[voice].vocal:=voc; end; function isVocal(voice: voice_index): boolean; begin isVocal := info[voice].vocal; end; procedure setStavePos(voice: voice_index; stave, pos: stave_index); begin with info[voice] do begin voice_pos:=pos; voice_stave:=stave; end; end; function voiceStave(voice: voice_index): stave_index; begin voiceStave:=info[voice].voice_stave; end; function voicePos(voice: voice_index): stave_index; begin voicePos:=info[voice].voice_pos; end; function companion(voice: voice_index): voice_index; var s: integer; begin s:=info[voice].voice_stave; if number_on_stave[s]=1 then companion:=voice else if info[voice].voice_pos=1 then companion:=voice+1 else companion:=voice-1; end; procedure regroup(voice: voice_index); var i, j, j2: word_index0; begin j2 := 0; with info[voice] do begin if debugMode then write('Voice ',voice,' has ',nbar,' bars at '); if debugMode then for i:=1 to nbar+1 do write(bar_bound[i],' '); for i:=1 to nbar do begin j2:=bar_bound[i]; j:=j2+1; while (j<=here) and (bind_left[scan[j]] or (scan[j]=barword)) do begin inc(bar_bound[i]); inc(j) end; end; if extra>0 then bar_bound[nbar+1]:=here; if debugMode then begin write(' regrouped to '); for i:=1 to nbar+1 do write(bar_bound[i],' ') end; if debugMode then writeln; nword := here end; end; procedure resetInfo(voice: voice_index; var buf: string); begin with info[voice] do begin buf := P[mus]; P[mus]:=''; bar_bound[0]:=0; word_bound[0]:=0; orig_word_bound[0]:=0; nbar:=0; here := 0; end; end; procedure clearLabels; var voice: voice_index; begin for voice:=1 to nvoices do with info[voice] do begin chord:=0; mus:=0; end; end; procedure appendNote(voice: voice_index; nscan: music_word); begin with info[voice] do begin inc(here); if here>max_words then error3(voice,'Words per line limit exceeded'); scan[here]:=nscan; end; end; procedure appendToLine(voice: voice_index; note: string); begin if note<>'' then with info[voice] do begin P[mus]:=P[mus]+note+blank; word_bound[here]:=length(P[mus]); orig_word_bound[here]:=nextWordBound(orig_P[mus],note[1], orig_word_bound[here-1]); end; end; procedure markBar(voice: voice_index); begin with info[voice] do if nbar=0 then error3(voice,'Empty bar') else bar_bound[nbar]:=here end; function numberOfBars(voice: voice_index): integer; begin numberOfBars := info[voice].nbar; end; procedure barForward(voice: voice_index; nbars: integer); begin with info[voice] do begin if (nbar+nbars<0) then error3(voice, 'Next voice before bar is full'); if nbar+nbars>max_bars then error3(voice,'Bars per line limit exceeded'); inc(nbar,nbars); if nbars>0 then bar_bound[nbar]:=here; end; end; procedure setExtraLength(voice: voice_index; ext: integer); begin with info[voice] do begin extra:=ext; scan[here+1]:=other; end; end; function ExtraLength(voice: voice_index): integer; begin ExtraLength := info[voice].extra; end; function findVoice(w: string): voice_index0; var i: integer; begin curtail(w,':'); findVoice:=0; for i:=1 to nvoices do if w=voice_label[i] then begin findVoice:=i; exit end; getNum(w,i); if i=0 then exit; if (i>0) and (i<=nvoices) then findVoice:=i else error('Numeric label outside range 1..nvoices',print); end; procedure info3(voice: voice_index); var p: integer; begin with info[voice] do begin writeln ('In voice "', voice_label[voice], '" near word ', here, ':'); p:=orig_word_bound[here-1]-1; if p<0 then p:=0; writeln(' ':p,'V') end end; procedure error3(voice: voice_index; message: string ); begin info3(voice); error(' '+message,print) end; procedure warning3(voice: voice_index; message: string ); begin info3(voice); warning(' '+message,print) end; function nextMusicWord(voice: voice_index): string; begin nextMusicWord := MusicWord(voice,info[voice].here); end; function MusicWord(voice, n: integer): string; begin with info[voice] do if (n>0) and (n<=nword) then MusicWord := substr(P[mus],word_bound[n-1]+1, word_bound[n]-word_bound[n-1]-1) else MusicWord := ''; end; function thisNote(voice: voice_index): music_word; begin with info[voice] do thisNote := scan[here-1]; end; function nextNote(voice: voice_index): music_word; begin with info[voice] do nextNote := scan[here]; end; function endOfBar(voice: voice_index; bar_no: integer): boolean; begin with info[voice] do endOfBar := here > bar_bound[bar_no]; end; procedure gotoBar(voice: voice_index; bar_no: integer); begin with info[voice] do here := bar_bound[bar_no-1]+1; end; function getMusicWord(voice: voice_index): string; begin with info[voice] do begin line_no := orig_line_no[mus]; GetMusicWord := MusicWord(voice,here); inc(here); end end; function maybeMusicLine(l: string): boolean; var w: string; nscan: music_word; begin w:=GetNextWord(l,blank,dummy); maybeMusicLine := false; if pos1(w[1],'abcdefgr()[]{}CMm')=0 then begin maybeMusicLine := false; exit end; if pos1(':',w)=0 then begin maybeMusicLine := true; exit end; GetNextMusWord(w,l,nscan); maybeMusicLine := nscan=abcdefg; end; const macro_initialized: boolean=false; nmacros = 99; var macro_text: array[1..nmacros] of string; procedure macroInit; var i: integer; begin if macro_initialized then exit else macro_initialized:=true; for i:=1 to nmacros do macro_text[i]:='' end; function identifyMacro(s: string): integer; var k: integer; begin predelete(s,2); getNum(s,k); identifyMacro:=k end; procedure GetNextMusWord (var buf, note: string; var nscan: music_word); var maybe_error: string; procedure expandThisMacro; var playtag: string[10]; playID: integer; w: string; begin macroInit; if length(note)=1 then error('Can''t terminate a macro that has not been started',print); playID:=identifyMacro(note); playtag:=toString(playID); if (playID<1) or (playID>99) then error('Macro ID '+playtag+' is not in range 1..99',print); if note[2]='P' then begin if macro_text[playID]='' then warning('Macro '+playtag+ ' inserts empty text: did you define it before use?',print); if length(macro_text[playID])+length(buf)>255 then error('Expansion of macro '+playtag+' causes buffer overflow',print) else begin if debugMode then begin writeln('Inserting macro '+playtag+' text "' +macro_text[playID]+'"'); writeln('Buffer before insert: ',buf) end; buf:=macro_text[playID]+buf; exit end end; if pos1(note[2],'SR')=0 then error('Second character '+note[2]+ ' of macro word should be in "PRS"',print); macro_text[playID]:=''; repeat w:=getNextWord(buf,blank,dummy); if w='' then error('Macro definition '+playtag+ ' should be terminated on the same input line',print); if w='M' then begin if debugMode then writeln('Macro '+playtag+' is: '+macro_text[playID]); break end; if (w[1]='M') and (length(w)>1) then if (w[2]<>'P') or (identifyMacro(w)=playID) then error(w+' not allowed inside macro definition '+playtag,print); macro_text[playID]:=macro_text[playID]+w+' ' until false; if note[2]='R' then begin note[2]:='P'; buf:=note+' '+buf end end; begin note:=GetNextWord(buf,blank,dummy); if note='' then exit; if (note[1]='M') and expandMacro then begin expandThisMacro; GetNextMusWord(buf,note,nscan); exit end; if note[1]='\' then begin maybe_error:=''; if note[length(note)]<>'\' then maybe_error:=note; while (buf<>'') and (note[length(note)]<>'\') do note:=note+' '+GetNextWord(buf,blank,dummy); if note[length(note)]<>'\' then error('Unterminated TeX literal',print); nscan:=texword; if maybe_error<>'' then warning('Possible unterminated TeX literal: '+maybe_error,print); exit; end; if solfaNoteNames then begin translateSolfa(note[1]); if note[1]='"' then predelete(note,1); end; case note[1] of '_': begin nscan:=pmxprefix;delete1(note,1); end; 'a'..'g': nscan:=abcdefg; 'z': nscan:=zword; '(': nscan:=lparen; '{': if note[length(note)]='}' then nscan:=lyrtag else nscan:=lparen; ')': if pos1('(',note)=0 then nscan:=rparen else nscan:=rlparen; '}': if pos1('{',note)=0 then nscan:=rparen else nscan:=rlparen; '[': nscan:=lbrac; ']': if note='][' then nscan:=other else nscan:=rbrac; '@': nscan:=atword; 'm': nscan:=mword; 'r': nscan:=rword; '#','-','n','x','?','s','t','D': nscan:=pmxl; 'M': if note='M' then nscan:=endMacro else nscan:=macro; 'G': if pos1('A',note)>0 then nscan:=pmxl else nscan:=other; '1'..'9': if pos1('/',note)>0 then nscan:=mword else nscan:=pmxl; 'o': nscan:=oword; 'A', 'V': nscan:=FirstOnly; '/': if note='//' then nscan:=nextvoice else if note='/' then begin note:='//'; warning('/ changed to //',print); nscan:=nextvoice; end else begin error('Word starts with /: do you mean \?',print); nscan:=err; end; else if pos1('|',note)>0 then nscan:=barword else nscan:=other; end; end; function upper(voice: voice_index): boolean; begin with info[voice] do if (voice_pos=1) and (voice0 then write(' and has chords on line ',chord); writeln; end; if debugMode then with info[voice] do begin write('Line has ', nbar, ' bars'); if extra>0 then writeln(' + ', extra, '/64 notes') else writeln; write('Bars:'); for bar:=1 to nbar do write(' ',getBar(voice,bar),' '); writeln; write('Word types:'); for w:=1 to nword do write(' ',name[scan[w]]); writeln; end; end; end; function aloneOnStave(stave: stave_index): boolean; var v: voice_index; begin if number_on_stave[stave]<>2 then aloneOnStave:=true else begin v:=first_on_stave[stave]; aloneOnStave:= (info[v].mus=0) or (info[v+1].mus=0) end end; procedure selectVoices(line: string); var i, k: integer; word: string; begin for k:=1 to nvoices do selected[k]:=false; write('Voice change to: ',line,' = '); i:=0; while i