diff options
Diffstat (limited to 'Build/source/utils/mtx/mtx-0.60d/mtxline.pas')
-rw-r--r-- | Build/source/utils/mtx/mtx-0.60d/mtxline.pas | 447 |
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. |