[GLOBAL] PROCEDURE beginnofill( var outfile : text );
begin
if (fill) and (listnestlevel = 0) then
begin
writeln(outfile,'{\obeylines \obeyspaces % - begin no fill');
fill := false
end
else
begin
writeln(outfile,'% - RNOTOTEX obeylines, obeyspaces already active');
writeln( log,'% - RNOTOTEX obeylines, obeyspaces already active')
end
end;
[GLOBAL] PROCEDURE endnofill( var outfile : text );
begin
if (not fill) and (listnestlevel = 0) then
begin
writeln(outfile,'} % - end of no fill');
fill := true
end
else
begin
writeln(outfile,'% - RNOTOTEX obeylines, obeyspaces not active');
writeln( log,'% - RNOTOTEX obeylines, obeyspaces not active')
end
end;
[GLOBAL] PROCEDURE writeflagname( var outfile : text; f : dsrflagclasses );
begin
case f of
notaflag : write(outfile,'?????');
control : write(outfile,'CONTROL');
uppercase : write(outfile,'UPPERCASE');
lowercase : write(outfile,'LOWERCASE');
quote : write(outfile,'QUOTE');
space : write(outfile,'SPACE');
underline : write(outfile,'UNDERLINE');
bold : write(outfile,'BOLD');
overstrike : write(outfile,'OVERSTRIKE');
hyphenate : write(outfile,'HYPYENATE');
capitalize : write(outfile,'CAPITALIZE');
endfootnote : write(outfile,'END FOOTNOTE');
comment : write(outfile,'COMMENT');
substitute : write(outfile,'SUBSTITUTE')
end
end;
[GLOBAL] FUNCTION isastylespecifier( arg : argument ) : styletype;
label
routineexit;
var
s : pckstr;
classification : styletype;
begin
s := argliteral( arg, TRUE );
classification := undetermined;
if (s.body[1] = 'D') and (s.length = 1) then
begin
classification := decimal;
goto routineexit
end;
if (s.body[1] = 'O') and (s.length = 1) then
begin
classification := octal;
goto routineexit
end;
if (s.body[1] = 'H') and (s.length = 1) then
begin
classification := hexidecimal;
goto routineexit
end;
if (s.body = 'RU') and (s.length = 2) then
begin
classification := romanupper;
goto routineexit
end;
if (s.body = 'RL') and (s.length = 2) then
begin
classification := romanlower;
goto routineexit
end;
if (s.body = 'RM') and (s.length = 2) then
begin
classification := romanmixed;
goto routineexit
end;
if (s.body = 'LU') and (s.length = 2) then
begin
classification := letterupper;
goto routineexit
end;
if (s.body = 'LL') and (s.length = 2) then
begin
classification := letterlower;
goto routineexit
end;
if (s.body = 'LM') and (s.length = 2) then
begin
classification := lettermixed;
goto routineexit
end;
routineexit : isastylespecifier := classification
end;
[GLOBAL] PROCEDURE initflagtable;
var
f : dsrflagclasses;
begin
for f := notaflag to substitute do
case f of
notaflag : begin
flagtable[f].representation := blank;
flagtable[f].turnedon := false
end;
control : begin
flagtable[f].representation := '.';
flagtable[f].turnedon := true
end;
uppercase : begin
flagtable[f].representation := '^';
flagtable[f].turnedon := true
end;
lowercase : begin
flagtable[f].representation := '\';
flagtable[f].turnedon := true
end;
quote : begin
flagtable[f].representation := '_';
flagtable[f].turnedon := true
end;
space : begin
flagtable[f].representation := '#';
flagtable[f].turnedon := true
end;
underline : begin
flagtable[f].representation := '&';
flagtable[f].turnedon := true
end;
bold : begin
flagtable[f].representation := '*';
flagtable[f].turnedon := false
end;
overstrike : begin
flagtable[f].representation := '%';
flagtable[f].turnedon := false
end;
hyphenate : begin
flagtable[f].representation := '=';
flagtable[f].turnedon := false
end;
break : begin
flagtable[f].representation := '|';
flagtable[f].turnedon := false
end;
period : begin
flagtable[f].representation := '+';
flagtable[f].turnedon := false
end;
capitalize : begin
flagtable[f].representation := '<';
flagtable[f].turnedon := false
end;
endfootnote : begin
flagtable[f].representation := '!';
flagtable[f].turnedon := false
end;
comment : begin
flagtable[f].representation := '!';
flagtable[f].turnedon := true
end;
substitute : begin
flagtable[f].representation := '$';
flagtable[f].turnedon := false
end
end { case }
end; {initflagtable}
[GLOBAL] FUNCTION flagclass( ch : char ) : dsrflagclasses;
var
class : dsrflagclasses;
foundclass : boolean;
begin
class := control;
foundclass := false;
while (class <> substitute) and ( not foundclass) do
if (ch = flagtable[class].representation) and (flagtable[class].turnedon)then
foundclass := true
else
class := succ(class);
if foundclass then
if inliteral then
if class = control then
flagclass := control
else
flagclass := notaflag
else
flagclass := class
else
flagclass := notaflag
end;
[GLOBAL] PROCEDURE initcharreader(var f : text );
begin
reset(f);
lastinputchar := blank;
read(f, currentchar);
totallines := 0;
totalchars := 0;
columncounter := 1;
if ord(currentchar) = tab then
begin
tabrecord.tabread := true;
tabrecord.charcountintab := ncharsintab
end
else
begin
tabrecord.tabread := false;
tabrecord.charcountintab := 0
end
end;
[GLOBAL] PROCEDURE getnextchar( var f : text; var gotten : boolean );
function nexttabcolumn( startingcolumn : integer ) : integer;
var
i : integer;
begin
i := startingcolumn;
repeat
i := i + 1
until (i-1) mod ncharsintab = 0;
nexttabcolumn := i;
writeln(log,'nexttabcolumn input = ',startingcolumn:1,', output = ',i:1)
end;
begin
gotten := false;
if NOT eof(f) then
if NOT eoln(f) then
with tabrecord do
begin
lastinputchar := currentchar;
gotten := true;
columncounter := columncounter + 1;
if (tabread) and (charcountintab > 0) then
begin
currentchar := blank;
charcountintab := charcountintab - 1;
if charcountintab = 0 then tabread := false
end
else
begin
totalchars := totalchars + 1;
read( f, currentchar );
if currentchar < blank then
begin
if ord(currentchar) = tab then
begin
tabread := true;
charcountintab := nexttabcolumn( columncounter ) - columncounter-1;
writeln(log,'charcountintab = ',charcountintab)
end;
currentchar := blank
end
end
end
end;
[GLOBAL] PROCEDURE startunderline( var outfile : text; class : enhancmentstates);
begin
if class <> notenhanced then
case underlineactive of
notenhanced : begin
write(outfile,'\underline{');
underlineactive := class
end;
singlecharenhanced : nullstatement;
enhancmentlocked : nullstatement
end;
underlineactive := class
end;
[GLOBAL] PROCEDURE stopunderline( var outfile : text );
begin
case underlineactive of
notenhanced : nullstatement;
singlecharenhanced : begin
write(outfile,'} ');
underlineactive := notenhanced
end;
enhancmentlocked : nullstatement
end
end;
[GLOBAL] PROCEDURE startbold( var outfile : text; class : enhancmentstates);
begin
if class <> notenhanced then
case boldactive of
notenhanced : begin
write(outfile,'{\bf ');
boldactive := class
end;
singlecharenhanced : nullstatement;
enhancmentlocked : nullstatement
end;
boldactive := class
end;
[GLOBAL] PROCEDURE stopbold( var outfile : text );
begin
case boldactive of
notenhanced : nullstatement;
singlecharenhanced : begin
write(outfile,'} ');
boldactive := notenhanced
end;
enhancmentlocked : nullstatement
end
end;
[GLOBAL] PROCEDURE passblanks( var infile, outfile : text; writethem : boolean );
var
gotten, keeppassing : boolean;
begin
keeppassing := true;
gotten := true;
repeat
if (currentchar = blank) and (gotten) then
begin
if writethem then write(outfile, blank );
getnextchar(infile, gotten)
end
else
keeppassing := false
until NOT keeppassing
end;
[GLOBAL] PROCEDURE texwrite( var f : text; ch : char );
const
maxtrys = 2;
var
ntrys : integer;
written : boolean;
begin
ntrys := 0;
written := false;
repeat
if (inputcontainstexcommands) or (inliteral) then
write(f, ch, error := continue)
else
if ch >= blank then
if ch in ['#','$','%','&','_','^','{','}','~'] then
write(f, '\',ch, error := continue)
else
if ch = '\' then
write(f,'\backslash ', error := continue)
else
write(f, ch, error := continue);
if status(f) > 0 then
begin
writeln(f, error := continue);
ntrys := ntrys + 1
end
else
written := true
until (written) or (ntrys > maxtrys);
if ntrys > maxtrys then
errorexit('TEXWRITE','error writing to output')
end;
[GLOBAL] PROCEDURE writecurrentchar( var infile, outfile : text );
var
gotten : boolean;
begin
if capitalizetext then
currentchar := capchar( currentchar );
if lowercasetext then
currentchar := lcchar( currentchar );
case flagclass(currentchar) of
notaflag : begin
stopunderline( outfile );
stopbold( outfile );
texwrite(outfile, currentchar)
end;
control : begin
stopunderline( outfile );
stopbold( outfile );
texwrite(outfile, currentchar)
end;
uppercase : begin
getnextchar(infile, gotten);
if gotten then
case flagclass(currentchar) of
underline : startunderline( outfile, enhancmentlocked);
bold : startbold( outfile, enhancmentlocked );
otherwise texwrite(outfile, capchar(currentchar))
end
end;
lowercase : begin
getnextchar(infile, gotten);
if gotten then
case flagclass(currentchar) of
underline : begin
if underlineactive <> notenhanced then
write(outfile,'} ');
underlineactive := notenhanced
end;
bold : begin
if boldactive <> notenhanced then
write(outfile,'} ');
boldactive := notenhanced
end;
otherwise texwrite(outfile, lcchar(currentchar))
end
end;
quote : begin
getnextchar(infile, gotten);
if gotten then
texwrite(outfile, currentchar )
end;
space : write(outfile,'\ ');
underline : begin
getnextchar(infile, gotten );
if gotten then
begin
startunderline( outfile, singlecharenhanced);
texwrite(outfile, currentchar)
end
else
texwrite(outfile, currentchar)
end;
bold : begin
getnextchar(infile, gotten);
if gotten then
begin
startbold( outfile, singlecharenhanced);
texwrite(outfile, currentchar)
end
else
texwrite(outfile, currentchar)
end;
overstrike : begin
getnextchar(infile, gotten);
if gotten then
begin
startbold( outfile, singlecharenhanced);
texwrite(outfile, currentchar)
end
else
texwrite(outfile, currentchar)
end;
hyphenate : write(outfile,'--');
break : writeln(outfile,'\linebreak');
period : write(outfile,'\nonfrenchspacing ');
capitalize : begin
getnextchar( infile, gotten);
if gotten then
texwrite(outfile, capchar(currentchar))
end;
endfootnote : begin
if (columncounter = 1) and (infootnote) then
begin
if not fill then
endnofill( outfile );
writeln(outfile,'} % - end of footnote');
writeln( log,'} % - end of footnote');
infootnote := false;
if startnofillagain then
begin
startnofillagain := false;
beginnofill( outfile )
end
end
else
texwrite(outfile, currentchar)
end;
comment : begin
if flagclass(lastinputchar) = control then
write(outfile,'% ')
else
texwrite(outfile,currentchar)
end;
substitute : texwrite(outfile, currentchar)
end { case }
end;
[GLOBAL] PROCEDURE newline( var infile, outfile : text; putcrlf : boolean );
var
gotten : boolean;
begin
if eoln(infile) then
begin
readln(infile);
totallines := totallines + 1;
columncounter := 1
end;
if putcrlf then
writeln(outfile);
while (eoln(infile)) and (not eof(infile)) do
begin
readln(infile);
writeln(outfile);
columncounter := 1;
totallines := totallines + 1
end;
if not eof(infile) then
begin
read(infile, currentchar);
totalchars := totalchars + 1;
lastinputchar := blank
end;
if ord(currentchar) = tab then
begin
tabrecord.charcountintab := ncharsintab;
tabrecord.tabread := true
end
else
begin
tabrecord.charcountintab := 0;
tabrecord.tabread := false
end;
if currentchar < blank then currentchar := blank
end;
[GLOBAL] PROCEDURE changeflagchar( flag : dsrflagclasses; newchar:char);
begin
flagtable[flag].representation := newchar;
write(log,'[internal flag representation change for ');
writeflagname(log, flag);
writeln(log,' to "',newchar,'"]')
end;
[GLOBAL] PROCEDURE turnflagon( flag : dsrflagclasses );
begin
flagtable[flag].turnedon := true;
write(log,'[internal flag ');
writeflagname(log, flag);
writeln(log,' enabled]')
end;
[GLOBAL] PROCEDURE turnflagoff( flag : dsrflagclasses );
begin
flagtable[flag].turnedon := false;
write(log,'[internal flag ');
writeflagname(log, flag);
writeln(log,' disabled]')
end;
[GLOBAL] PROCEDURE texwritearg( var outfile : text; arg : argument );
var
s : pckstr;
i, l : integer;
begin
s := argliteral( arg, false );
l := length( s );
for i := 1 to l do texwrite(outfile, s.body[i]);
write(outfile, blank)
end;
