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; if para_len<2 then fatalerror('empty lyrics paragraph'); 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; TeXtype2(comment+' Paragraph '+toString(paragraph_no)+' line '+ toString(line_no)+' bar '+toString(bar_no)); TeXtype2('\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 linemaxlyrlen 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 v1tag[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.