unit preamble; {$X+} { Interpret preamble paragraph, compose PMX preamble } interface uses globals; function thisCase: boolean; procedure preambleDefaults; procedure interpretCommands; procedure doPreamble; procedure doPMXpreamble; procedure respace; procedure restyle; function startString(voice: voice_index0): string; procedure augmentPreamble(control_para: boolean); function omitLine(line: paragraph_index): boolean; procedure nonMusic; procedure setOnly(line: string); function isCommand(command: string): boolean; const known = true; implementation uses control, mtxline, strings, files, status, utility; const blank = ' '; colon = ':'; semicolon = ';'; comma = ','; known_styles: integer = 12; max_styles = 24; warn_redefine: boolean = false; type command_type = ( none, title, composer, pmx, tex, options, msize, bars, shortnote, style, sharps, flats, meter, space, pages, systems, width, height, enable, disable, range, name, indent, poet, part, only, octave, start ); line_type = ( unknown, colon_line, command_line, comment_line, plain_line ); style_index = 1..max_styles; style_index0 = 0..max_styles; const c1 = title; cn = start; commands: array[command_type] of string[16] = ( 'NONE', 'TITLE', 'COMPOSER', 'PMX', 'TEX', 'OPTIONS', 'SIZE', 'BARS/LINE', 'SHORT', 'STYLE', 'SHARPS', 'FLATS', 'METER', 'SPACE', 'PAGES', 'SYSTEMS', 'WIDTH', 'HEIGHT', 'ENABLE', 'DISABLE', 'RANGE', 'NAME', 'INDENT', 'POET', 'PART', 'ONLY', 'OCTAVE', 'START'); cline: array[command_type] of string = ( '', '', '', '', '', '', '', '', '1/4', (* short *) '', '0', '', 'C', '', '1', '1', (* systems *) '190mm', '260mm', '', '', '', '', '', '', '', '', '', '' ); redefined: array[command_type] of boolean = ( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false ); (** Known styles *) known_style: array[style_index] of string = ( 'SATB: Voices S,A T,B; Choral; Clefs G F', 'SATB4: Voices S A T B; Choral; Clefs G G G8 F', 'SINGER: Voices Voice; Vocal; Clefs G', 'PIANO: Voices RH LH; Continuo; Clefs G F', 'ORGAN: Voices RH LH Ped; Continuo; Clefs G F F', 'SOLO: Voices V; Clefs G', 'DUET: Voices V1 Vc; Clefs G F', 'TRIO: Voices V1 Va Vc; Clefs G C F', 'QUARTET: Voices V1 V2 Va Vc; Clefs G G C F', 'QUINTET: Voices V1 V2 Va Vc1 Vc2; Clefs G G C F F', 'SEXTET: Voices V1 V2 Va1 Va2 Vc1 Vc2; Clefs G G C C F F', 'SEPTET: Voices V1 V2 Va1 Va2 Vc1 Vc2 Cb; Clefs G G C C F F F', '', '', '', '', '', '', '', '', '', '', '', ''); var old_known_styles: style_index; style_used: array[style_index] of boolean; omit_line: array[paragraph_index] of boolean; orig_style_line: array[style_index] of style_index0; orig_range_line: integer; var nclefs, n_pages, n_systems, n_sharps, ngroups: integer; part_line, title_line, composer_line, pmx_line, options_line, start_line, voices, clefs: string; group_start, group_stop: array[1..maxgroups] of integer; instr_name: array[stave_index] of string[40]; style_supplied: boolean; { ------------------ Styles ------------------ } function voiceCount(s: string): voice_index0; var i, l: integer; begin l:=length(s); for i:=1 to l do if s[i]=comma then s[i]:=blank; voiceCount:=wordCount(s); end; function findStyle(s: string): style_index0; var i: style_index0; begin i:=0; s:=s+colon; findStyle:=0; while i0 then known_style[sn] := S else if known_styles < max_styles then begin inc(known_styles); known_style[known_styles] := S; end else error('Can''t add another style - table full',print); end; procedure readStyles; var eofstyle: boolean; S: string; l: style_index0; begin if styleFileFound then eofstyle:=true else eofstyle := eof(stylefile); l:=0; while not eofstyle do begin readln(stylefile,S); if S<>'' then begin addStyle(S); inc(l); orig_style_line[known_styles]:=l; end; eofstyle := eof(stylefile); end; end; procedure applyStyle(s, stylename: string; first_inst, first_stave: stave_index); var clef, subline, subcommand: string; i, last_inst, last_stave: stave_index0; continuo, toosoon, vocal: boolean; begin last_inst:=first_inst-1; toosoon := false; continuo:=false; vocal := false; subline:=GetNextWord(s,blank,colon); while s<>'' do begin subline:=GetNextWord(s,semicolon,dummy); i:=curtail(subline,semicolon); subcommand:=GetNextWord(subline,blank,dummy); if equalsIgnoreCase(subcommand,'VOICES') then begin voices:=voices+' '+subline; last_stave := first_stave + wordCount(subline) - 1; last_inst := first_inst + voiceCount(subline) - 1; end else if equalsIgnoreCase(subcommand,'CLEFS') then begin clef:=subline; clefs:=clefs+' '+clef; end else if equalsIgnoreCase(subcommand,'VOCAL') then if last_instlast_stave-first_stave+1 then error( 'Number of clefs does not match number of voices',print); if (first_stave=last_stave) or continuo then instr_name[first_stave]:=stylename else for i:=first_stave to last_stave do instr_name[i]:=''; if continuo then begin inc(ninstr); stave[ninstr] := first_stave; for i:=first_stave to last_stave do instr[i]:=ninstr; end else for i:=first_stave to last_stave do begin inc(ninstr); stave[ninstr] := i; instr[i] := ninstr; end; end; procedure applyStyles; var n1, n2, sn: integer; s: string; begin voices:=''; clefs:=''; ninstr:=0; while cline[style]<>'' do begin n1:=voiceCount(voices)+1; n2:=wordCount(voices)+1; s:=GetNextWord(cline[style],blank,comma); curtail(s,comma); sn:=findStyle(s); if sn=0 then error ('Style ' + s +' unknown',print); line_no := orig_style_line[sn]; applyStyle(known_style[sn],s,n1,n2); style_used[sn] := true; end; end; { ------------------------------------------------------------- } procedure wipeCommands; var c: command_type; begin for c:=c1 to cn do cline[c]:=''; end; function omitLine(line: paragraph_index): boolean; begin omitLine := (line>0) and omit_line[line] end; procedure setName; var i: integer; begin if not redefined[name] then exit; setFeature('instrumentNames',true); for i:=1 to ninstr do instr_name[i] := getNextWord(cline[name],blank,dummy); end; procedure setIndent; begin if redefined[indent] then fracindent := cline[indent]; end; procedure setInitOctave; begin if redefined[octave] then initOctaves(cline[octave]); end; procedure setVoices(var line: string); var k: integer; s, w: string; procedure checkLabel(w: string); var j: voice_index; begin for j:=1 to nvoices do if w=voice_label[j] then begin warning('Voice label '+w+' not unique',print); exit; end; if length(w)>2 then exit; if pos1(w[1],'CLU')>0 then if length(w)>1 then if pos1(w[2],'123456789')=0 then exit else else else if pos1(w[1],'123456789')=0 then exit; error('Voice label '+w+' conflicts with reserved label',print); end; begin nvoices:=0; nstaves:=0; repeat s:=GetNextWord(line,blank,dummy); if length(s)>0 then begin inc(nstaves); k:=0; first_on_stave[nstaves] := nvoices + 1; repeat w:=GetNextWord(s,blank,comma); curtail(w, comma); if w<>'' then begin inc(k); if k<=2 then begin inc(nvoices); checkLabel(w); voice_label[nvoices]:=w; if instr_name[nstaves]='' then instr_name[nstaves]:=w; setStavePos(nvoices,nstaves,k); end end; until w=''; if k>2 then error('More than two voices per stave: ' + s,print); if k=2 then instr_name[nstaves]:='\mtxTwoInstruments{' + voice_label[nvoices-1] + '}{'+ voice_label[nvoices] + '}'; number_on_stave[nstaves] := k; end until length(line)=0; for k:=1 to nvoices do selected[k]:=true; end; procedure setClefs(line: string); var s: string; begin nclefs:=0; repeat s:=getnextword(line,blank,dummy); if s<>'' then begin inc(nclefs); if length(s)=1 then clef[nclefs]:=s[1] else clef[nclefs]:=s[2]; end; until s=''; end; procedure setDimension(line: string; lno: command_type); var l, n, p: integer; begin if line = '' then exit; l := length(line); n := 0; p := 0; repeat n := n+1; if line[n]='.' then p:=p+1; until (n>l) or not ((line[n]='.') or (line[n]>='0') and (line[n]<='9')); if (n=p) or (p>1) or not ((line[n]='i') or (line[n]='m') or (line[n]='p')) then error('Dimension must be a number followed by in, mm or pt',print); cline[lno] := 'w' + substr(line,1,n); end; procedure setSize(line: string); var i: stave_index0; word: string; begin i:=0; while i20 then musicsize:=20; end; function findCommand(var command: string): command_type; var j: command_type; begin curtail(command,':'); if equalsIgnoreCase(command,'STYLE') then style_supplied := true; for j:=c1 to cn do if equalsIgnoreCase(command,commands[j]) then begin findCommand:=j; exit; end; findCommand:=none; end; function isCommand(command: string): boolean; begin isCommand:=findCommand(command)<>none end; function mustAppend(command: command_type): boolean; begin mustAppend := command=tex end; procedure doEnable(var line: string; choice: boolean); var word: string; begin repeat word:=GetNextWord(line,blank,dummy); if word<>'' then if not setFeature(word,choice) then Error('No such feature: '+word,not print) until word='' end; procedure setRange(line: string); var v,p: integer; vl: string; begin line_no := orig_range_line; for v:=1 to nvoices do begin vl := voice_label[v]; p:=pos(vl+'=',line); if p>0 then begin if length(line)0 then begin n_pages:=0; n_systems:=nbars end; end; getNum(cline[sharps],n_sharps); setSpace(cline[space]); setSize(cline[msize]); getTwoNums(cline[shortnote],num, den); if den=0 then den:=1; short_note := (num*64) div den; if cline[flats]<>'' then begin getNum(cline[flats],n_sharps); n_sharps:=-n_sharps; end; setName; setIndent; setInitOctave; setOnly(cline[only]); setRange(cline[range]); setDimension(cline[width],width); setDimension(cline[height],height); if options_line <>'' then begin warning('"Options" is cryptic and obsolescent.', not print); writeln(' Use "Enable" and "Disable" instead.') end; for i:=1 to length(options_line) do processOption(options_line[i]); end; procedure preambleDefaults; var i: integer; begin xmtrnum0:=0; fracindent:='0'; musicsize:=20; start_line:=''; some_vocal:=false; ngroups:=0; style_supplied := false; for i:=1 to maxvoices do setVocal(i,false); for i:=1 to maxstaves do stave_size[i]:=unspec; for i:=0 to maxstaves do nspace[i]:=unspec; { next line seems to be spurious. 0.63a RDT } { begin nspace[i]:=unspec; stave_size[i]:=unspec; end; } n_pages:=1; n_systems:=1; readStyles; old_known_styles := known_styles; for i:=1 to lines_in_paragraph do omit_line[i]:=false; end; procedure preambleGuess(maybe_voices: voice_index); begin case maybe_voices of 1: cline[style] := 'Solo'; 2: cline[style] := 'Duet'; 3: cline[style] := 'Trio'; 4: cline[style] := 'Quartet'; 5: cline[style] := 'Quintet'; 6: cline[style] := 'Sextet'; 7: cline[style] := 'Septet'; else begin error('I cannot guess a style',not print); exit; end; end; writeln('I guess this piece is a ',cline[style], ' for strings in C major.'); writeln(' Why not provide a STYLE in the setup paragraph to make sure?'); end; { ------------------------------------------------------------------ } procedure nonMusic; var i: paragraph_index; begin for i:=1 to para_len do doCommand(P[i]); setOnly(cline[only]); wipeCommands; end; function thisCase: boolean; begin thisCase:=true; if not startsWithIgnoreCase(P[1],'case:') then exit; thisCase:=(choice<>' ') and (pos1(choice,P[1])>0); P[1]:='%'; end; procedure augmentPreamble(control_para: boolean); var i: paragraph_index; l: line_type; s: array[line_type] of integer; begin if not thisCase then exit; for l:=unknown to plain_line do s[l]:=0; for i:=1 to para_len do begin line_no:=orig_line_no[i]; l:=doCommand(P[i]); inc(s[l]); if (l=comment_line) and (P[i,2]=comment) then begin predelete(P[i],2); putLine(P[i]); end; if not control_para and (l=unknown) then error('Unidentifiable line',print); end; if not control_para and (s[command_line]>0) and (s[plain_line]>0) then error('Mixture of preamble commands and music',not print); end; procedure doPreamble; var i: paragraph_index; maybe_voices: voice_index0; begin maybe_voices:=0; if not style_supplied then begin {augmentPreamble(not known);} if not style_supplied then warning('No STYLE supplied',not print); for i:=1 to para_len do if maybeMusicLine(P[i]) then inc(maybe_voices); if maybe_voices>0 then preambleGuess(maybe_voices) else error('No voices found',not print); end end; procedure respace; var i, j: stave_index; begin for i:=ninstr downto 2 do begin j:=ninstr-i+1; if nspace[j]<>unspec then TeXtype2('\mtxInterInstrument{'+toString(i-1)+ '}{'+toString(nspace[j])+'}'); end; if nspace[ninstr]<>unspec then TeXtype2('\mtxStaffBottom{'+ toString(nspace[ninstr])+'}'); must_respace:=false; end; procedure restyle; begin must_restyle:=false; end; function clefno ( cl: char ): integer; begin case cl of 'G','0','t','8': clefno:=0; 's','1': clefno:=1; 'm','2': clefno:=2; 'a','3': clefno:=3; 'n','4': clefno:=4; 'r','5': clefno:=5; 'F','b','6': clefno:=6; 'C': clefno:=3; else begin warning('Unknown clef code "' + cl + '" - replaced by treble',print); clefno:=0; end; end end; procedure doTenorClefs; var i: voice_index; c: char; begin for i:=1 to nclefs do begin c:=clef[i]; if (c='8') or (c='t') then putLine('\\mtxTenorClef{' + toString(PMXinstr(i)) + '}\' ); end; end; procedure insertTeX; begin if redefined[tex] then TeXtype2(cline[tex]); end; procedure doPMXpreamble; const clefcode: string[8]='0123456'; var i, j: integer; clefs: string; function pmxMeter: string; var denom, num: integer; begin if meternum=0 then begin num := beatsPerLine; {* denom := 0; *} old_meter_word := meterChange(num,meterdenom,true); end else begin num := meternum; {* denom := pmdenom; *} end; { CMO: unconditonally assign value of pmdenom to denom } denom := pmdenom; pmxMeter := toString(num) + ' ' + toString(PMXmeterdenom(meterdenom)) + ' ' + toString(pmnum) + ' ' + toString(denom); end; function sizecode(k: integer): string; begin sizecode:='\mtxNormalSize'; case k of 13: if musicsize=20 then sizecode:='\mtxTinySize' else sizecode:='\mtxSmallSize'; 16: if musicsize=20 then sizecode:='\mtxSmallSize'; 20: if musicsize=16 then sizecode:='\mtxLargeSize'; 24: if musicsize=20 then sizecode:='\mtxLargeSize' else sizecode:='\mtxHugeSize'; 29: sizecode:='\mtxHugeSize'; else error('Valid sizes are 13, 16, 20, 24, 29',print); end; end; begin if composer_line <> '' then putline(composer_line); if title_line <> '' then putline('\mtxTitleLine{'+title_line+'}'); putLine('---'); if instrumentNames and not redefined[indent] then fracindent:='0.12'; write(outfile, nstaves); write(outfile, ' ', -ninstr); stave[ninstr+1]:=nstaves+1; for j:=ninstr downto 1 do write(outfile, ' ', stave[j+1] - stave[j]); writeln(outfile, ' ', pmxMeter, ' ',xmtrnum0:8:5, ' ',n_sharps, ' ', n_pages, ' ',n_systems, ' ',musicsize, ' ',fracindent); for i:=1 to ninstr do if not instrumentNames then putLine('') else putLine('\mtxInstrName{'+instr_name[ninstr+1-i]+'}'); clefs:=''; for i:=nclefs downto 1 do clefs:=clefs+clefcode[1+clefno(clef[i])]; putLine(clefs); if texdir='' then texdir := './'; putLine(texdir); pmx_preamble_done:=true; insertTeX; respace; for j:=1 to ngroups do writeln(outfile,'\\mtxGroup{'+toString(j)+'}{' +toString(ninstr+1-group_start[j])+'}{' +toString(ninstr+1-group_stop[j])+'}\'); for j:=1 to ninstr do if (stave_size[j]<>unspec) then putLine( '\\mtxSetSize{'+toString(ninstr+1-j)+'}{'+sizecode(stave_size[j])+'}\'); if part_line <> '' then begin putLine('Ti'); putLine(part_line); end; if composer_line <> '' then begin putLine('Tc'); putLine('\mtxPoetComposer'); end; if title_line <> '' then begin write(outfile,'Tt'); if nspace[0] <> unspec then write(outfile,toString(nspace[0])); writeln(outfile); putLine('\mtxTitle'); end; if pmx_line <> '' then putLine(pmx_line); doTenorClefs; if cline[width] <> '' then putLine(cline[width]); wipeCommands; end; function startString(voice: voice_index0): string; var s, w: string; j: voice_index; begin s:=start_line; for j:=1 to voice do w:=getNextWord(s,dummy,';'); curtail(w,';'); if w<>'' then startString:=w+' ' else startString:=w; end; end.