summaryrefslogtreecommitdiff
path: root/Build/source/utils/mtx/mtx-0.60d/mtxline.pas
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/utils/mtx/mtx-0.60d/mtxline.pas')
-rw-r--r--Build/source/utils/mtx/mtx-0.60d/mtxline.pas447
1 files changed, 447 insertions, 0 deletions
diff --git a/Build/source/utils/mtx/mtx-0.60d/mtxline.pas b/Build/source/utils/mtx/mtx-0.60d/mtxline.pas
new file mode 100644
index 00000000000..cd3e0b27bcc
--- /dev/null
+++ b/Build/source/utils/mtx/mtx-0.60d/mtxline.pas
@@ -0,0 +1,447 @@
+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,
+ 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, 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: 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; 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]); 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');
+ inc(nbar,nbars);
+ if nbar>max_bars then error3(voice,'Bars per line limit exceeded');
+ 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);
+begin with info[voice] do
+ begin
+ writeln ('In voice "', voice_label[voice], '" near word ', here, ':');
+ writeln(' ':word_bound[here],'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 writeln('Inserting macro '+playtag+' text "'
+ +macro_text[playID]+'"');
+ writeln('Buffer before insert: ',buf);
+ 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
+'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;
+']': 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 (voice<nvoices) then
+ upper:=(voice_stave=info[voice+1].voice_stave)
+ else upper:=false;
+end;
+
+procedure describeVoice(voice: voice_index; describe_lyr: string);
+ var bar, w: integer;
+begin with info[voice] do
+ begin write('Voice `',voice_label[voice],''' is on line ',mus);
+ if vocal then
+ begin write(', is vocal'); writeln(describe_lyr); end
+ else
+ begin if chord>0 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<nvoices do
+ begin word:=GetNextWord(line,blank,dummy);
+ if word='' then begin writeln; exit; end;
+ inc(i); write(word,' ');
+ k:=findVoice(word);
+ if k=0 then error('This voice is not in the style',print);
+ selected[k]:=true;
+ end;
+ writeln;
+ end;
+
+end.