1 unit files;
2 { Open and close files, interpret command line, do input, do most output}
3 
4 interface  uses globals, multfile;
5 
6 procedure readParagraph (var P: paragraph; var no: line_nos;
7   var L: paragraph_index0);
styleFileFoundnull8 function styleFileFound: boolean;
9 procedure processOption(j: char);
10 procedure OpenFiles;
11 procedure CloseFiles;
12 procedure putLine (line: string);
13 procedure put(line: string; putspace: boolean);
14 procedure tex3 (s: string);
endOfInfilenull15 function endOfInfile: boolean;
16 
17 implementation uses control, strings, utility;
18 
19 const  param_leader = '-';
20        stylefilename: string = 'mtxstyle.txt';
21 
22 var teststyle: integer;
23 
endOfInfilenull24 function endOfInfile: boolean;
25   begin endOfInfile:=eofAll; end;
26 
27 procedure tex3 (s: string);
28   begin
29     if pmx_preamble_done then
30       if s[1]='%' then putLine(s)
31       else if first_paragraph then putLine('\'+s+'\')
32       else putLine('\\'+s+'\')
33     else putLine(s);
34   end;
35 
36 procedure putLine (line: string);
37   begin  if outlen+length(line) > pmxlinelength-1 then writeln(outfile);
38     writeln(outfile,line); outlen:=0;
39   end;
40 
41 procedure put(line: string; putspace: boolean);
42   var l: integer;
43   begin l:=length(line);
44     if l>pmxlinelength then error('Item longer than PMX line length',print);
45     if outlen+l > pmxlinelength-1 then
46     begin putLine(''); put(line,false) end
47     else begin if putspace and (outlen>0) and (line[1]<>' ') then
48         line:=' '+line;
49       write(outfile,line); inc(outlen,l);
50     end
51   end;
52 
styleFileFoundnull53 function styleFileFound: boolean;
54 begin styleFileFound := teststyle<>0; end;
55 
56 procedure helpmessage;
57 begin
58   writeln('Usage: prepmx [-bcfnhimtuvwDH0123456789] MTXFILE [TEXDIR] [STYLEFILE]')
59 end;
60 
61 procedure bighelpmessage;
62 begin helpmessage; writeln;
63   writeln('MTXFILE: name of .mtx file without its extension');
64   writeln('TEXDIR: directory where the TeX file made by PMX goes, default is ./');
65   writeln('STYLEFILE: name of a file containing style definitions.  Default is');
66   writeln('  mtxstyle.txt.  This feature is now deprecated; use Include: STYLEFILE');
67   writeln('  in the preamble of the .mtx file instead.');
68   writeln('Options:  (can also be entered separately: -b -c ...)');
69   writeln('  -b: disable unbeamVocal');
70   writeln('  -c: disable doChords');
71   writeln('  -f: enable solfaNoteNames');
72   writeln('  -h: display this message and quit');
73   writeln('  -i: enable ignoreErrors');
74   writeln('  -m: disable doLyrics');
75   writeln('  -n: enable instrumentNames');
76   writeln('  -t: disable doUptext');
77   writeln('  -u: disable uptextOnRests');
78   writeln('  -v: enable beVerbose');
79   writeln('  -w: enable pedanticWarnings');
80   writeln('  -D: enable debugMode');
81   writeln('  -0123456789: select Case');
82   writeln('  -H: print enabled status of all options');
83   writeln('All the above, and some other, options can be enabled or disabled');
84   writeln('  in the preamble.  What you do there overrides what you do here.')
85 end;
86 
87 procedure processOption(j: char);
88   begin  case j of
89   'b': setFeature('unbeamVocal',false);
90   'c': setFeature('doChords',false);
91   'f': setFeature('solfaNoteNames',true);
92   'h': begin bighelpmessage; halt(255) end;
93   'i': setFeature('ignoreErrors',true);
94   'm': setFeature('doLyrics',false);
95   'n': setFeature('instrumentNames',true);
96   't': setFeature('doUptext',false);
97   'u': setFeature('uptextOnRests',false);
98   'v': setFeature('beVerbose',true);
99   'w': setFeature('pedanticWarnings',true);
100   'D': setFeature('debugMode',true);
101   '0'..'9': choice:=j;
102   'H': printFeatures(true);
103   else write(j); error(': invalid option',not print);
104   end;
105 end;
106 
107 procedure OpenFiles;
108 var i, j, l, fileid, testin: integer;
109     infilename, outfilename, basename, param, ext: string;
110   procedure checkExistingFile;
111     var tryfile: file;
112   begin
113 {$I-}
114     assign(tryfile,basename);  reset(tryfile);  testin := ioresult;
115 {$I+}
116     if testin<>0 then exit else close(tryfile);
117     writeln('There exists a file named ',basename,'.  I am treating this');
118     error('  as a fatal error unless you specify -i',not print);
119   end;
120 begin
121   fileid:=0;  line_no:=0;  paragraph_no:=0;
122   for i:=1 to ParamCount do
123   begin param:=ParamStr(i);
124     if param[1]=param_leader then
125       for j:=2 to length(param) do processOption(param[j])
126     else if fileid=0 then fileid:=i
127     else if texdir='' then texdir:=param
128     else stylefilename:=param;
129   end;
130   if fileid=0 then
131   begin helpmessage; writeln('Try "prepmx -h" for more information.'); halt(255) end
132   else basename:=paramstr(fileid);
133   l:=length(basename);
134   if (l>4) and (basename[l-3]='.') then
135   begin ext:=substr(basename,l-2,3); toUpper(ext); if ext='MTX' then
136     begin warning('.mtx extension deleted from basename',not print);
137       shorten(basename,l-4);
138     end;
139   end;
140   if pos1('.',basename)>0 then checkExistingFile;
141   infilename := basename+'.mtx';  outfilename := basename+'.pmx';
142 {$I-}
143   pushFile(infilename);
144   assign(outfile,outfilename);  rewrite(outfile);
145   assign(stylefile,stylefilename);  reset(stylefile);  teststyle := ioresult;
146   if (teststyle<>0) and (stylefilename<>'mtxstyle.txt') then
147      writeln('Can''t read ',stylefilename);
148 {$I+}
149   if fileError then fatalError('Input file '+infilename+' not found');
150   outfile_open := true;  writeln('Writing to ',basename,'.pmx');
151 end;
152 
153 procedure CloseFiles;
154 begin  close(outfile); closeAll; if teststyle=0 then close(stylefile);
155 end;
156 
157 procedure readParagraph (var P: paragraph; var no: line_nos;
158                          var L: paragraph_index0);
159   var another: boolean;
160       filename, buffer: string;
161 begin
162   L:=0; buffer:=readData; line_no:=currentLineNo;
163   if isEmpty(buffer) then exit;
164   if debugMode then writeln('>>>> ',buffer);
165   inc(paragraph_no);
166 { Handle directives affecting the processing of the input file }
167   repeat another:=false;
168     if startsWithIgnoreCase(buffer,'SUSPEND') then
169       begin ignore_input:=true; another:=true; if beVerbose then
170         writeln('-->> Suspending input file ',currentFilename,
171           ' at line ', line_no);
172       end;
173     if startsWithIgnoreCase(buffer,'RESUME') then
174       begin ignore_input:=false; another:=true; if beVerbose then
175         writeln('-->> Resuming input file ',currentFilename,
176           ' at line ', line_no);
177     end;
178     if startsWithIgnoreCase(buffer,'INCLUDE:') then
179     begin predelete(buffer,8); filename:=nextWord(buffer,' ',' ');
180       pushfile(filename); another:=true;
181     end;
182     if another then begin buffer:=readLine; line_no:=currentLineNo; end;
183   until not another;
184 { Normal paragraph input}
185   repeat
186     if L<lines_in_paragraph then
187       begin inc(L); P[L]:=buffer; buffer:=''; no[L]:=line_no;
188       end
189     else warning('Paragraph too long: skipping line',not print);
190     buffer:=readLine; line_no := currentLineNo;
191     if debugMode then writeln(line_no,' >> ', buffer);
192   until isEmpty(buffer);
193   skipBlanks;  { needed to identify final paragraph }
194 end;
195 
196 end.
197