1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
program prepmx;
uses control, strings, globals, preamble, lyrics, mtx, analyze,
mtxline, status, uptext, notes, files, utility;
{ CMO: addition/change by Christian Mondrup }
{* M-Tx preprocessor to PMX Dirk Laurie }
const version = '0.61';
version_date = '<11 December 2015>';
{* See file "Corrections" for updates later than those listed below
}
{* Changes since 0.52b
Uses mtx.tex file
More than one # or % per word treated correctly in uptext
Better way of handling line numbers in lyrics
}
{* To do next:
Take notice of recent improvements in musixtex, pmx and musixlyr
{* Current bugs:
{* Old bugs:
Does not check PMX syntax
{* Weaknesses that may later cause bugs:
Decisions sometimes made on note, sometimes on scan
Can 'here' overrun?
Where does one note stop and the next begin?
See comment on '!' in uptext
}
chord_flat = 't';
chord_left = 'l';
blind = true;
visible = false;
var
last_bar: boolean;
multibar: string;
repeat_sign: string;
bar_of_line, bars_of_rest, rest_spacing: integer;
{ --------------- Bars and rests --------------- }
procedure writeRepeat(var bar: string);
var repcode: string;
begin if bar='' then exit;
repcode:='';
if bar='||' then repcode:='Rd'
else if (bar='|]') then repcode:='RD'
else if bar='|:' then repcode:='Rl'
else if bar=':|:' then repcode:='Rlr'
else if bar=':|' then repcode:='Rr'
else if last_bar and (bar='|') then repcode:='Rb';
if repcode<>'' then putLine(' '+repcode);
bar:='';
end;
procedure supplyRests(voice: voice_index);
begin
if multi_bar_rest then
begin put(multibar,putspace); exit; end;
if (bar_of_line=1) and pedanticWarnings then
begin write('Bar ', bar_no, ' Voice ', voice);
warning(' Filling missing voice with rests',not print);
end;
if pickup>0 then
put(rests(pickup,meterdenom,visible),nospace);
put(pause+' ',putspace);
end;
procedure countBars(note: string);
var k, adjust, sign: integer;
begin predelete(note,2); k:=pos1('+',note); sign:=1;
if k=0 then
begin k:=pos1('-',note); if k>0 then sign:=-1; end;
if k>0 then
begin note[k]:='/'; getTwoNums(note,bars_of_rest,adjust); end
else begin getNum(note,bars_of_rest); adjust:=0; end;
rest_spacing := 14 + adjust*sign;
end;
(* FIXME This procedure had a serious bug. It now has a smaller bug.
Basically there should be a test on whether a break between staves
is a break between instruments, in which case the procedure is (now)
right; or a break between staves of the same instrument, in which
case a '|' instead of a '&' should be output (as it was). If the Space
feature is not used, the bug does not show up. *)
procedure putMBRest;
var i: stave_index;
begin
put('\\\def\atnextbar{\znotes',nospace);
for i:=1 to nstaves do
begin put('\mbrest{'+toString(bars_of_rest)+'}{'+toString(rest_spacing)
+'}0',nospace);
if i<nstaves then put('&',nospace) else putLine('\en}\');
end;
putline('\\\advance\barno'+toString(bars_of_rest-1)+'\');
inc(bar_no,bars_of_rest-1);
end;
{ ---------------------------------------------------------------- }
procedure processLine(voice: voice_index; bar_no: integer);
var chords, note, cutnote, pretex: string;
par_line: paragraph_index;
ngrace, nmulti: integer;
no_chords, no_uptext: boolean;
procedure output(note: string);
begin if note<>'' then
begin { pretex is saved up until a spacing note or rest comes }
if endsWith(note,'\') and (note[2]<>'\') then
begin curtail(note,'\'); pretex:=pretex+note; note:=''; exit end;
if (pretex<>'') and isNoteOrRest(note) then
begin note:=pretex+'\ '+note; pretex:='' end;
if (outlen>0) and (note[1]<>' ') then note:=' '+note;
put(note,nospace);
end;
if thisNote(voice)=nextvoice then putLine('');
end;
procedure maybeDotted(var note: string);
begin if length(note)<2 then exit;
if note[2]='"' then
begin note[2]:=note[1]; pretex:=pretex+'\mtxDotted' end
end;
procedure addChords;
var w, nt, labels: string;
j, mus_line: integer;
chord_line: paragraph_index0;
arpeggio, tieme: boolean;
lab: char;
pitches: int5;
procedure outChord;
var k: integer;
begin if nt='' then exit; tieme:=nt[1]='{'; if tieme then predelete(nt,1);
if (nt='') or (nt[1]<'a') or (nt[1]>'g') then
error('Must have a note name at the start of "'+nt
+'", not "'+nt[1]+'"',print);
renewChordPitch(voice,nt);
chords := chords+' z'+nt; nt:='';
for k:=1 to length(labels) do if chordPitch(voice)=pitches[k] then
begin chords:=chords+' s'+labels[k]+'t'; labels[k]:=' ' end;
if tieme then begin chordTie(voice,lab); chords:=chords+' s'+lab+'t' end
end;
begin saveStatus(voice);
getChordTies(voice, pitches, labels);
chords:=''; chord_line:=chordLineNo(voice);
if chord_line=0 then no_chords:=true;
if no_chords then exit;
w := getNextWord(P[chord_line],blank,dummy);
if (w=barsym) or (w='') then no_chords:=true;
if (w=tilde) or no_chords then exit;
mus_line:=line_no; line_no:=orig_line_no[chord_line];
arpeggio := w[1]='?'; if arpeggio then
begin chords:=' ?'; predelete(w,1); end;
j:=1; nt:='';
while j<=length(w) do
begin
if (w[j]='{') or ((nt<>'{') and (w[j]>='a') and (w[j]<='g')) then outChord
else if w[j]=chord_flat then w[j]:='f'
else if w[j]=chord_left then w[j]:='e';
nt:=nt+w[j]; j:=j+1
end;
if nt<>'' then outChord; if arpeggio then chords:=chords+' ?';
note:=note+chords;
for j:=1 to length(labels) do if labels[j]<>' ' then
error('Tie on chord note started but not finished',print);
line_no:=mus_line;
end;
function processOther(note: string): string;
begin
case thisNote(voice) of
other: if note[1]=grace_group then
begin if length(note)=1 then ngrace:=1
else ngrace := pos1(note[2],digits);
if ngrace>0 then dec(ngrace);
end;
{ For a zword, take note of pitch but do not change the contents }
{ Add spurious duration because repitch expects duration to be present }
zword: begin cutnote:=note; predelete(cutnote,1); insertchar('4',cutnote,2);
checkOctave(voice,cutnote); renewPitch(voice,cutnote)
end;
lyrtag: extractLyrtag(voice,note);
rbrac: endBeam(voice);
rparen, rlparen: endSlur(voice,note);
lbrac: beginBeam(voice,note);
lparen: begin maybeDotted(note); beginSlur(voice,note); end;
mword: error3(voice,'Meter change must be the first word of its bar');
atword: lyricsAdjust(voice, note);
end;
processOther:=note;
end;
procedure lookahead;
begin while bind_left[nextNote(voice)] do
note:=note+' '+processOther(getMusicWord(voice));
end;
var l: integer;
in_group: boolean;
procedure processNote;
begin
begin if hasVerseNumber(voice) then pretex:=pretex+'\mtxVerse';
l := pos1(multi_group,note);
if l>0 then scan1(note,l+1,nmulti);
activateBeamsAndSlurs(voice);
in_group:=false;
if ngrace>0 then begin in_group:=true; dec(ngrace) end else
if nmulti>0 then begin in_group:=true; dec(nmulti); end;
checkOctave(voice,note); renewPitch(voice,note);
if not in_group then
begin resetDuration(voice,durationCode(note)); markDebeamed(voice,note) end;
lookahead; getSyllable(voice,pretex);
addUptext(voice, no_uptext, pretex);
addChords;
end;
end;
begin
pretex:=''; no_chords:=false; no_uptext := false;
par_line:=musicLineNo(voice);
nmulti :=0; ngrace := 0; line_no:=orig_line_no[par_line];
repeat note:=getMusicWord(voice); if note='' then exit;
{ if debugMode then writeln(voice,' ',note); }
case thisNote(voice) of
rword: begin if multi_bar_rest then
begin countBars(note); note:=multibar;
if uptextOnRests then
addUptext(voice, no_uptext, pretex);
end
else begin
l := pos1(multi_group,note);
if l>0 then scan1(note,l+1,nmulti);
if nmulti>0 then begin in_group:=true; dec(nmulti); end;
if uptextOnRests then
addUptext(voice, no_uptext, pretex);
if not isPause(note) then resetDuration(voice,durationCode(note));
end
end;
abcdefg: processNote;
barword: begin
if voice=nvoices then
if endOfBar(voice,bar_no) then repeat_sign := note
else writeRepeat(note);
if note<>barsym then note:='';
no_chords:=false;
end;
FirstOnly: if voice<>nvoices then note:='' else
note:=processOther(note);
else note:=processOther(note);
end;
output(note);
until endOfBar(voice,bar_no);
if not no_chords then skipChordBar(voice);
end;
{ ------------------------------------------------------------------- }
procedure getMeterChange(voice: voice_index; var new_meter: string);
var pn1, pn2: integer;
w, new_command: string;
begin if nextNote(voice)<>mword then exit;
w:=getMusicWord(voice);
getMeter(w, meternum, meterdenom, pn1, pn2);
full_bar := meternum*(64 div meterdenom);
{ CMO: process denominator value with function PMXmeterdenom }
new_command := meterWord(meternum, PMXmeterdenom(meterdenom), pn1, pn2);
if (new_meter<>'') and (new_meter<>new_command)
then error3(voice,'The same meter change must appear in all voices');
new_meter:=new_command;
end;
procedure musicParagraph;
var j, nvoice: voice_index0;
new_meter, lyrassign: string;
procedure putPMXlines;
var i: paragraph_index;
begin for i:=1 to para_len do
if startsWith(P[i],double_comment) then
begin predelete(P[i],2); putLine(P[i]); P[i]:='%'; end;
end;
procedure processOneBar;
var m, cm: paragraph_index0;
n1, n2: integer;
voice, cvoice: voice_index;
ignore_voice, wrote_repeat, alone: boolean;
begin
if bar_of_line>1 then putLine(comment+'Bar '+toString(bar_no));
last_bar := (bar_of_line=nbars) and final_paragraph;
if last_bar and (repeat_sign='|') then repeat_sign:='';
writeRepeat(repeat_sign); new_meter := '';
for voice:=nvoices downto 1 do
if musicLineNo(voice)>0 then
begin gotoBar(voice,bar_of_line); getMeterChange(voice,new_meter);
end;
if last_bar and (new_meter='') and (nleft>pickup) and (meternum>0) then
new_meter := meterChange(nleft,64,true);
if new_meter<>'' then putLine(new_meter);
wrote_repeat := false; if multi_bar_rest then
begin n1:=64*meternum; n2:=meterdenom; cancel(n1,n2,1);
multibar:=rests(n1,n2,blind);
end;
for voice:=nvoices downto 1 do
begin ignore_voice:=not selected[voice]; cvoice:=companion(voice);
m:=musicLineNo(voice); cm:=musicLineNo(cvoice);
alone:=(voice=cvoice) or ((m>0) and (cm=0))
or ((m=0) and (cm=0) and (voice<cvoice)) or not selected[cvoice];
if selected[voice] then
begin
if m>0 then processLine(voice,bar_of_line)
else if alone then supplyRests(voice) else ignore_voice:=true;
if last_bar and (repeat_sign<>'') and not wrote_repeat then
begin writeRepeat(repeat_sign); wrote_repeat := true; end;
if not ignore_voice then
if alone or (voicePos(voice)=1) then putLine(' /')
else putLine(' //');
end;
end;
if multi_bar_rest then putMBRest;
inc(bar_no); pickup:=0; putLine('');
end;
procedure putMeter(new_meter_word: string);
begin if new_meter_word<>old_meter_word then putLine(new_meter_word);
old_meter_word := new_meter_word;
end;
begin
paragraphSetup(nvoice);
if nvoice=0 then begin nonMusic; exit end
else if nvoice>nvoices then
begin if nvoice=0 then
error('No voices! Did you remember to to supply a Style?',not print);
error('Paragraph has '+toString(nvoice)+
' voices but Style allows only '+toString(nvoices),not print); exit;
end;
if first_paragraph then includeStartString;
if pmx_preamble_done and (not final_paragraph or (nvoice>0)) then
putLine(comment +' Paragraph ' + toString(paragraph_no) +
' line ' + toString(orig_line_no[1]) + ' bar ' + toString(bar_no));
testParagraph; rememberDurations;
if beVerbose then describeParagraph;
{ ---- Knowing the score, we can start setting music ---------------- }
if not pmx_preamble_done then
begin doPMXpreamble;
put( comment + ' Paragraph ' + toString(paragraph_no) + ' line ' +
toString(orig_line_no[1]) + ' bar ',putspace);
if pickup>0 then putLine('0') else putLine('1');
end;
putPMXlines;
if must_restyle then restyle;
if some_vocal and ((nvoice>0) or not final_paragraph) then
for j:=1 to ninstr do
begin assignLyrics(j,lyrassign);
if lyrassign<>'' then putLine('\\'+lyrassign+'\');
end;
if must_respace then respace;
if (meternum=0) then putMeter(meterChange(beatsPerLine,meterdenom,true));
if nleft > 0 then inc(nbars);
if (nbars=0) and multi_bar_rest then nbars:=1;
for bar_of_line:=1 to nbars do
processOneBar;
restoreDurations;
end;
{ ----------------------------------------------------------------------- }
var no_commands_yet: boolean;
procedure doMusic;
begin first_paragraph:=true; pmx_preamble_done:=false; bar_no:=1;
repeat_sign:=''; must_respace:=false; must_restyle:=false;
repeat final_paragraph := endOfInfile;
orig_P := P;
if (para_len>0) and not ignore_input and thisCase then
begin if no_commands_yet then
begin interpretCommands; printFeatures(false);
one_beat := 64 div meterdenom; full_bar := meternum*one_beat;
if nvoices>standardPMXvoices then warning('You have '
+toString(nvoices)+' voices; standard PMX can only handle '
+toString(standardPMXvoices),not print);
initMTX; initUptext; initStatus; initLyrics;
no_commands_yet:=false
end;
if startsWithBracedWord(P[1]) then lyricsParagraph else
begin
musicParagraph; first_paragraph:=false;
writeRepeat(repeat_sign);
end
end;
readParagraph(P,orig_line_no,para_len);
until para_len=0;
end;
var control_paragraph, no_report_errors: boolean;
function isControlParagraph (var P: paragraph; para_len: paragraph_index)
: boolean;
var commands, labels, voices, guff, i: paragraph_index0;
w: string;
begin isControlParagraph:=true; commands:=0; labels:=0; voices:=0; guff:=0;
for i:=1 to para_len do
if not (startsWith(P[i],'%')) then
begin w:=nextWord(P[i],' ',':');
if not endsWith(w,':') then inc(guff)
else if (length(w)<3) or (findVoice(w)>0) then inc(voices)
else if isCommand(w) then inc(commands)
else inc(labels)
end;
if (voices+guff>commands) then isControlParagraph:=false
end;
procedure topOfPMXfile;
begin
putLine('---');
putLine('\def\mtxversion{'+version+'}');
putline('\def\mtxdate{'+version_date+'}');
putline('\input mtx');
end;
begin { ---- Main program ------------------------ }
this_version := version; this_version_date := version_date;
writeln ('==> This is M-Tx ' + version + ' (Music from TeXt) ' +
version_date );
mtxLevel(version); OpenFiles; no_commands_yet:=true; preambleDefaults;
no_report_errors:=false;
topOfPMXfile;
repeat readParagraph(P,orig_line_no,para_len);
control_paragraph:=isControlParagraph(P,para_len);
if control_paragraph then
begin augmentPreamble(no_report_errors);
no_report_errors:=true;
if para_len=0 then error('No music paragraphs!',not print)
end
until not control_paragraph;
doPreamble; doMusic;
if not pmx_preamble_done then error('No music paragraphs!',not print);
putline('% Coded by M-Tx');
CloseFiles;
writeln ('PrePMX done. Now run PMX.'); halt(0);
end.
|