diff options
author | Peter Breitenlohner <peb@mppmu.mpg.de> | 2012-04-16 16:25:45 +0000 |
---|---|---|
committer | Peter Breitenlohner <peb@mppmu.mpg.de> | 2012-04-16 16:25:45 +0000 |
commit | f5c726a0125d88c06f92182b01eea1716f052ca0 (patch) | |
tree | 79db8530e041ec4cd6a3ed1f9bbce69ecc53113f /Build/source/utils/mtx/mtx-0.60d/lyrics.pas | |
parent | b517e15e9fb22ebb6d36127ff64470f8a00309d0 (diff) |
mtx 0.60d
git-svn-id: svn://tug.org/texlive/trunk@25987 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/utils/mtx/mtx-0.60d/lyrics.pas')
-rw-r--r-- | Build/source/utils/mtx/mtx-0.60d/lyrics.pas | 455 |
1 files changed, 455 insertions, 0 deletions
diff --git a/Build/source/utils/mtx/mtx-0.60d/lyrics.pas b/Build/source/utils/mtx/mtx-0.60d/lyrics.pas new file mode 100644 index 00000000000..14d7f5046eb --- /dev/null +++ b/Build/source/utils/mtx/mtx-0.60d/lyrics.pas @@ -0,0 +1,455 @@ +unit lyrics; +{ Everything related to lyrics } + +interface uses globals; + +procedure initLyrics; +procedure clearTags; +procedure reviseLyrics; +procedure lyrTranslate(var P: string; var numbered: boolean); +procedure getSyllable(voice: voice_index; var pretex: string); +function lyricsReport (voice: voice_index): string; +procedure maybeLyrics (voice: voice_index; parline: paragraph_index; + w: string); +procedure extractLyrtag (voice: voice_index; var note: string); +procedure lyricsAdjust (voice: voice_index; var note: string); +procedure assignLyrics(stave: stave_index; var lyrassign: string); +procedure lyricsParagraph; +function hasVerseNumber(voice: voice_index): boolean; + +implementation uses control, strings, mtxline, status, files, utility; + +{ Symbols used in strings of melismatype } +const + beam_melisma = '['; + inhibit_beam_melisma = '<'; + slur_melisma = '('; + inhibit_slur_melisma = '{'; + +type + other_index = 1..10; + other_index0 = 0..10; + melismatype = string; + haslyrtype = (nolyr, haslyr); + auxtype= (normal, aux); + assigntype = (asbefore, newassign); + inittype = (virgin,active); + lyrinfotype = record + lyr_adjust, slur_level, slur_change, beam_level, beam_change: integer; + melisma: melismatype; + numbered: boolean; + end; + + lyrlinetype = (none_given, global_lyrics, local_lyrics); + lyrtagtype = record + lyrsource: lyrlinetype; + has_lyrics: haslyrtype; + auxiliary: auxtype; + new_assign: assigntype; + initialized: inittype; + linecount: integer; + tags: string; + end; + +const maxLyrNums=64; + lyrtaglength=40; + LyrNum: integer=0; + +var lyrmodealter, oldlyrmodealter: array[stave_index] of boolean; + tag, oldtag: array[voice_index] of lyrtagtype; + lyrinfo: array[voice_index] of lyrinfotype; + numberedParagraph: array[1..maxLyrNums] of string[lyrtaglength]; + +const lyr_adjust_undef = -12345; + interstave = 24; + +{ Information flow for verse numbers: at the SetLyrics stage, the first +line of each lyrics paragraph is checked for a verse number, and if +found, the paragraph tag is remembered. At the AssignLyrics stage, +the first time that paragraph is encountered, the particular voice +is marked in lyrinfo as being numbered. When that voice is later processed, +the mark in lyrinfo is interrogated and turned off: if it was on, the +mtxVerse pre-TeX string is put into the output. } + +function hasVerseNumber(voice: voice_index): boolean; +begin hasVerseNumber:=lyrinfo[voice].numbered; + lyrinfo[voice].numbered:=false; +end; + +function isNumberedLyricsParagraph(tag: string): boolean; + var i: integer; +begin + for i:=1 to LyrNum do if tag=numberedParagraph[i] then + begin isNumberedLyricsParagraph:=true; exit; end; + isNumberedLyricsParagraph:=false; +end; + +function anyTagNumbered(tags: string): boolean; + var s: string; +begin anyTagNumbered:=false; + if curtail(tags,'}')>0 then delete1(tags,1); + repeat s:=getNextWord(tags,',',dummy); + if s='' then exit; + if isNumberedLyricsParagraph(s) then + begin anyTagNumbered:=true; exit; end; + until false; +end; + +{ Save the tag in the numberedParagraph list, stripping off braces if any } +procedure markNumbered(tag: string); +begin if LyrNum >= maxLyrNums then + begin error('Too many numbered lines in the lyrics',not print); exit; end; + inc(LyrNum); + if curtail(tag,'}')>0 then delete1(tag,1); + numberedParagraph[LyrNum] := tag; +end; + +{ --- end of procedures to keep track of verse numbering --- } + +procedure lyricsParagraph; + var first, w: string; + l, line: paragraph_index0; + i, nother: other_index0; + other: array[other_index] of string[lyrtaglength]; + numbered: boolean; +begin if not doLyrics then exit; + w:=NextWord(P[1],blank,dummy); l:=length(w); line_no := orig_line_no[1]; + if w[l]<>'}' then w:=w+'}'; + first:=GetNextWord(w,dummy,'}'); nother:=0; + while w<>'' do + begin if w[1]='=' then predelete(w,1); + if w[1]<>'{' then w:='{'+w; + inc(nother); other[nother]:=GetNextWord(w,dummy,'}'); + end; + if beVerbose then + begin write('---- Paragraph ', paragraph_no, ' starting at line ', line_no, + ' has lyrics headed ',first); + for i:=1 to nother do write('=',other[i]); writeln; + end; + tex3(comment+' Paragraph '+toString(paragraph_no)+' line '+ + toString(line_no)+' bar '+toString(bar_no)); + tex3('\mtxSetLyrics'+first+'{%'); + for line:=2 to para_len do + begin lyrTranslate(P[line],numbered); + if numbered then if (line>2) then warning( + 'Verse number not in first line of paragraph treated as lyrics',print) + else + begin markNumbered(first); for i:=1 to nother do markNumbered(other[i]); + end; + line_no:=orig_line_no[line]; + if (length(P[line])>max_lyrics_line_length) and pmx_preamble_done + then error('Lyrics line too long',print); + if pmx_preamble_done then + if line=2 then put('\\\:'+P[line],putspace) + else put('\\\ ' + P[line],putspace) + else put(P[line],putspace); + if line<para_len then + if pmx_preamble_done then putLine(' %\') + else putLine(' %') + else if pmx_preamble_done then putLine('}\') + else putLine('}') + end; + for i:=1 to nother do tex3('\mtxCopyLyrics'+first+other[i]); +end; + +function songraise(voice: voice_index): string; + var s: string; +begin with tag[voice] do with lyrinfo[voice] do + if (initialized=virgin) and (lyr_adjust=0) then songraise:='' else + begin + if auxiliary=aux then s:='Aux' else s:=''; + songraise:='\mtx'+s+'LyricsAdjust{'+toString(PMXinstr(voiceStave(voice))) + +'}{'+toString(lyr_adjust)+'}'; + end; +end; + +function lyricsReport (voice: voice_index): string; + var l: string; +begin with tag[voice] do + if (has_lyrics=nolyr) or (lyrsource=none_given) and (tags='') then + lyricsReport := ' but has no own lyrics' + else begin + l := ' with '; + if auxiliary=aux then l := l + 'auxiliary '; + l := l + 'lyrics '; + if lyrsource=local_lyrics then l:= l + 'locally defined as "' + else l := l + 'labelled "'; + l := l + tags + '"'; + if anyTagNumbered(tags) then l := l + ' with verse numbers'; + lyricsReport := l; + end; +end; + +procedure initLyrics; { at the start only } + var stave: stave_index; + voice: voice_index; +begin for voice:=1 to nvoices do + with lyrinfo[voice] do with tag[voice] do + begin has_lyrics:=nolyr; lyr_adjust:=lyr_adjust_undef; + melisma:=''; slur_level:=0; beam_level:=0; auxiliary:=aux; + lyrsource:=none_given; new_assign := asbefore; initialized := virgin; + end; + for stave:=1 to nstaves do oldlyrmodealter[stave] := false; +end; + +procedure registerLyrics (voice: voice_index; w: string); +begin + with tag[voice] do + begin oldtag[voice].tags:=tags; + oldtag[voice].lyrsource:=lyrsource; + lyrsource:=global_lyrics; + case length(w) of + 0: tags := ''; + 1: FatalError('M-Tx system error in registerLyrics'); + else tags := w; + end; + end; +end; + +procedure extractLyrtag (voice: voice_index; var note: string); + { inline lyrics change } +begin with tag[voice] do + if has_lyrics=nolyr then + error3(voice,'Inline lyrics change on no-lyrics line') + else begin registerLyrics(voice,note); { was: ''); } + note:='\mtxAssignLyrics{'+toString(PMXinstr(voiceStave(voice)))+'}'+note; + if auxiliary=aux then note:='\mtxAuxLyr{'+note+'}\' else note:=note+'\'; + end; +end; + +procedure clearTags; { at start of paragraph analyis } + var voice: voice_index; +begin + oldtag:=tag; + for voice:=1 to nvoices do with tag[voice] do + begin + lyrsource:=none_given; tags := ''; linecount:=0; + end; +end; + +procedure maybeLyrics (voice: voice_index; parline: paragraph_index; + w: string); + { during paragraph analysis, parline had L:, already stripped } + var k: voice_index0; + procedure convertlyrics(var lyn: string; voice: voice_index; mx: auxtype); + const setlyr: string = '%%\\\mtxSetLyrics'; + maxlyrlen = PMXlinelength-15; + var btag, thistag, w: string; + numbered: boolean; + begin + w:=NextWord(lyn,blank,dummy); with tag[voice] do + begin + if w='' then tags:='' + else begin + has_lyrics:=haslyr; auxiliary:=mx; + if w[1]='{' then registerLyrics(voice,w) + else begin lyrsource:=local_lyrics; + inc(linecount); thistag:=toString(10*voice+linecount); + btag := '{'+thistag+'}'; + if tags='' then tags:=btag + else begin tags[length(tags)]:=','; tags:=tags+thistag+'}'; end; + trim(lyn); lyrTranslate(lyn,numbered); + if numbered then markNumbered(thistag); + if length(lyn)+length(btag)>maxlyrlen then + lyn := setlyr + btag + '{\'^J'\\\:' + lyn +'}\' + else lyn:= setlyr + btag + '{' + lyn +'}\'; + end; + end; + end; + end; +begin if not dolyrics then exit; + if (length(w)=1) and (voice=0) then + warning('Lyrics line above top voice should be labelled',print); + if length(w)=1 then {* Standard lyrics line -------- } + begin k:=voice; if k=0 then k:=1; convertlyrics(P[parline],k,normal); + end + else {* Labelled lyrics line -- } + begin predelete(w,1); k:=findVoice(w); + if k=0 then error('Lyrics line belongs to unknown voice',print) + else convertlyrics(P[parline],k,aux); + end; +end; + +procedure reviseLyrics; { after paragraph analysis } + var voice : voice_index; + stave : stave_index; +begin + for voice:=1 to nvoices do with tag[voice] do + begin if (oldtag[voice].lyrsource=global_lyrics) and + (lyrsource=none_given) then + begin tags:=oldtag[voice].tags; lyrsource:=global_lyrics; end; + new_assign := + assigntype(ord((has_lyrics=haslyr) and (tags<>oldtag[voice].tags))); + if tags='' then has_lyrics := nolyr; + oldtag[voice].tags := tags; + oldtag[voice].lyrsource := lyrsource; + end; + for stave:=1 to nstaves do with tag[first_on_stave[stave]] do + lyrmodealter[stave] := not aloneOnStave(stave) and + (has_lyrics=haslyr) and (auxiliary=normal); +end; + +procedure assignLyrics(stave: stave_index; var lyrassign: string); + { at start of new block } + var atag, instr, l: string; + v1, v2, voice: voice_index; + begin lyrassign:=''; instr := toString(pmxinstr(stave)); + v1:=first_on_stave[stave]; v2:=v1+number_on_stave[stave]-1; + if v1<v2 then { don't reassign if other voice takes over }; + if (tag[v1].auxiliary=tag[v2].auxiliary) and + (tag[v1].has_lyrics<>tag[v2].has_lyrics) then + for voice:=v1 to v2 do with tag[voice] do + if new_assign=newassign then new_assign:=assigntype(has_lyrics); + for voice:=v1 to v2 do lyrinfo[voice].numbered:=false; + for voice:=v1 to v2 do + with tag[voice] do if new_assign=newassign then + begin atag:=tags; if atag='' then atag:='{}'; + l := '\mtxAssignLyrics{' + instr + '}' + atag; + if auxiliary=aux then l:='\mtxAuxLyr{' + l + '}'; + lyrassign := lyrassign + l; + if tags='' then has_lyrics:=nolyr; + if (has_lyrics=haslyr) and (initialized=virgin) then + with lyrinfo[voice] do + begin if (auxiliary=aux) and upper(voice) then + lyr_adjust:=interstave else lyr_adjust:=0; + lyrassign := lyrassign + songraise(voice); + initialized := active; + end; + if anyTagNumbered(atag) then lyrinfo[voice].numbered:=true; + end; + if lyrmodealter[stave]<>oldlyrmodealter[stave] then + begin if lyrmodealter[stave] then + lyrassign := lyrassign + '\mtxLyrModeAlter{' + instr + '}' + else lyrassign := lyrassign + '\mtxLyrModeNormal{' + instr + '}'; + oldlyrmodealter[stave] := lyrmodealter[stave]; + end; + end; + +procedure lyricsAdjust (voice: voice_index; var note: string); + { inline at-word } + var adj: integer; + force, put_above, put_below: boolean; +begin with lyrinfo[voice] do with tag[voice] do + begin predelete(note,1); + force:=note[1]='='; if force then predelete(note,1); + put_above:=note[1]='^'; if put_above then predelete(note,1); + put_below:=note[1]='v'; if put_below then predelete(note,1); + if note<>'' then getNum(note,adj) else adj:=0; + if has_lyrics=nolyr then begin note:=''; exit; end; + if put_above then lyr_adjust:=interstave + else if put_below then lyr_adjust:=0; + if force then lyr_adjust:=adj else inc(lyr_adjust,adj); + note:=songraise(voice); if note<>'' then note:='\\'+note+'\'; + end +end; + +procedure lyrTranslate(var P: string; var numbered: boolean); + var k, l, number: integer; + Q, w: string; +begin { Test for starting number } w:=NextWord(P,blank,dummy); + numbered:=false; + if endsWith(w,'.') then begin getNum(w,number); numbered:=number<>0 end; + {Translate lyrics link } Q := ''; l:=length(P); + for k:=1 to l-1 do + if (P[k]<>'_') or (P[k+1]='_') or (P[k+1]=' ') or (pos1(P[k+1],digits)>0) + then Q := Q+P[k] + else if (k>1) and (P[k-1]='\') then Q := Q+'mtxLowLyrlink ' + else Q := Q+'\mtxLyrlink '; + Q:=Q+P[l]; + P := Q; +end; + +type melismaEnd = (beam, slur); + +function removeLast(var s: string; t: string): char; + var i,l: integer; +begin l:=length(s); + for i:=l downto 1 do if pos1(s[i],t)>0 then + begin removeLast:=s[i]; delete1(s,i); exit; end; + removeLast := dummy; +end; + +function OpenMelisma(s: string): boolean; +begin OpenMelisma := (pos1(slur_melisma,s)>0) or (pos1(beam_melisma,s)>0); +end; + +{ Append mtxBM or mtxEM to pretex when appropriate } +procedure getSyllable(voice: voice_index; var pretex: string); + var BM, EM: boolean; + procedure startMelismas (t: string); + var open_before, open_now: boolean; + i, k: integer; + begin k:=length(t); + for i:=1 to k do with lyrinfo[voice] do + begin open_before := OpenMelisma(melisma); + melisma := melisma + t[i]; + open_now := OpenMelisma(melisma); + BM := BM or (open_now and not open_before) + end; + end; + function endMelisma(voice: integer): boolean; + var found: char; + i: integer; + count: array[melismaEnd] of integer; + t: melismaEnd; + begin EM := false; + count[slur] := -lyrinfo[voice].slur_change; + count[beam] := -lyrinfo[voice].beam_change; + for t:=beam to slur do for i:=1 to count[t] do with lyrinfo[voice] do + begin + case t of + slur: found := removeLast(melisma,slur_melisma+inhibit_slur_melisma); + beam: found := removeLast(melisma,beam_melisma+inhibit_beam_melisma); + end; + if found=dummy then + error3(voice,'Ending a melisma that was never started'); + EM := EM or (not openMelisma(melisma) + and (pos1(found,slur_melisma+beam_melisma)>0)) + end; + endMelisma := EM + end; + procedure startSlurMelisma(voice: voice_index); + const start: array[boolean] of char = (slur_melisma,inhibit_slur_melisma); + var slurs: string; + k: integer; + begin slurs:=''; + for k:=1 to lyrinfo[voice].slur_change do + slurs:=start[noSlurMelisma(voice,1-k)]+slurs; + startMelismas(slurs) + end; + procedure startBeamMelisma(voice: voice_index); + const start: array[boolean] of char = (beam_melisma,inhibit_beam_melisma); + var beams: string; + k: integer; + begin beams:=''; + for k:=1 to lyrinfo[voice].beam_change do + beams:=start[noBeamMelisma(voice)]+beams; + startMelismas(beams) + end; + function startMelisma(voice: integer): boolean; + begin BM:=false; startSlurMelisma(voice); startBeamMelisma(voice); + startMelisma := BM + end; + var t: integer; +begin with tag[voice] do with lyrinfo[voice] do + begin if has_lyrics<>haslyr then exit; + t:=slur_level; slur_level:=slurLevel(voice); slur_change:=slur_level-t; + t:=beam_level; beam_level:=beamLevel(voice); beam_change:=beam_level-t; + if startMelisma(voice) then if auxiliary=aux + then pretex:=pretex+'\mtxAuxBM' else pretex:=pretex+'\mtxBM'; + if endMelisma(voice) then if auxiliary=aux + then pretex:=pretex+'\mtxAuxEM' else pretex:=pretex+'\mtxEM' + end +end; + +procedure getSyllable1(voice: voice_index; var pretex: string); +begin with lyrinfo[voice] do + begin + writeln('voice=',voice, ', slurchange=',slur_change, + ', melisma=',melisma, ', beamchange=', beam_change) + end; + getSyllable1(voice,pretex); + if pretex<>'' then writeln('pretex = ',pretex) +end; + +end. |