|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ T d ┃
Length: 47572 (0xb9d4)
Types: TextFile
Names: »dvitty.p«
└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
└─ ⟦this⟧ »EUUGD11/euug-87hel/sec1/dvitty/dvitty.p«
(******************************************************************************
* bogart:/usr/alla/zap/dvitty/dvitty.p 1986-08-15 20:24:31,
* Version to be sent to mod.sources ready.
* New option since last version:
* -Fprog Pipe output to prog. Can be used to get a different
* pager than the default.
* bogart:/usr/alla/zap/dvitty/dvitty.p 1986-01-13 21:49:31,
* Environment variable DVITTY is read and options can be set from it.
* These are the currently implemented options:
* -ofile Write output to file, else write to stdout,
* possibly piped through a pager if stdout is a tty.
* -plist Print pages whos TeX-page-number are in list.
* List is on the form 1,3:6,8 to choose pages
* 1,3-6 and 8. TeX-nrs can be negative: -p-1:-4,4
* -Plist Print pages whos sequential number are in list.
* -wn Print the lines with width n characters, default is
* 80. Wider lines gives better results.
* -q Don't try to pipe to a pager.
* -f Try to pipe to a pager if output is a tty.
* Default of -q and -f is a compile time option, a constant.
* -l Write '^L' instead of formfeed between pages.
* -u Don't try to find Scandinavian characters (they will
* print as a:s and o:s if this option is choosen).
* -s Scandinavian characters printed as }{|][\.
* Default of -s and -u is a compile time option, a constant.
* bogart:/usr/alla/zap/dvitty/dvitty.p 1986-01-10 18:51:03,
* Argument parsing, and random access functions (external, in C)
* and other OS-dependent stuff (in C). Removed private 'pager' &
* tries to pipe through PAGER (environment var) or, if PAGER not
* defined, /usr/ucb/more. Some changes for efficency.
* bogart:/usr/alla/svante/dvitty/dvitty.p 1985-07-15 20:51:00,
* The code for processing dvi-files running on UNIX (UCB-Pascal)
* but no argument parsing.
* VERA::SS:<SVANTE-LINDAHL.WORK>DVITTY.PAS.140, 30-Mar-85 05:43:56,
* Edit: Svante Lindahl
* VERA::SS:<SVANTE-LINDAHL.WORK>DVITTY.PAS.136, 15-Jan-85 13:52:59,
* Edit: Svante Lindahl, final Twenex version !!!??
* VERA::SS:<SVANTE-LINDAHL.WORK>DVITTY.PAS.121, 14-Jan-85 03:10:22,
* Edit: Svante Lindahl, cleaned up and fixed a lot of little things
* VERA::SS:<SVANTE-LINDAHL.WORK>DVITTY.PAS.25, 15-Dec-84 05:29:56,
* Edit: Svante Lindahl, COMND-interface, including command line scanning
* VERA::SS:<SVANTE-LINDAHL.WORK>DVITTY.PAS.23, 10-Dec-84 21:24:41,
* Edit: Svante Lindahl, added command line scanning with Rscan-JSYS
* VERA::<SVANTE-LINDAHL.DVITTY>DVITTY.PAS.48, 8-Oct-84 13:26:30,
* Edit: Svante Lindahl, fixed switch-parsing, destroyed by earlier patches
* VERA::<SVANTE-LINDAHL.DVITTY>DVITTY.PAS.45, 29-Sep-84 18:29:53,
* Edit: Svante Lindahl
*
* dvitty - get an ascii representation of a dvi-file, suitable for ttys
*
* This program, and any documentation for it, is copyrighted by Svante
* Lindahl. It may be copied for non-commercial use only, provided that
* any and all copyright notices are preserved.
*
* Please report any bugs and/or fixes to:
*
* UUCP: {seismo,mcvax,cernvax,diku,ukc,unido}!enea!ttds!zap
* ARPA: enea!ttds!zap@seismo.CSS.GOV
* or Svante_Lindahl_NADA%QZCOM.MAILNET@MIT-MULTICS.ARPA
* EAN: zap@cs.kth.sunet
*)
program dvitty(input, output);
const Copyright = 'dvitty.p Copyright (C) 1984, 1985, 1986 Svante Lindahl.';
{-----------------------------------------------------------------------}
{ The following two constants may be toggled before compilation to }
{ customize the default behaviour of the program for your site. }
{ Whichever their settings are, the defaults can be overridden at }
{ runtime. }
{-----------------------------------------------------------------------}
defscand = true; { default is Scandinavian, toggle this if you }
{ don't have terminals with Scand. nat. chars }
defpage = true; { default: try to pipe through a pager (like }
{ more) if stdout is tty and no -o switch }
pathlen = 40; { length of string for path to pager program }
defpath = '/usr/ucb/more '; { pathlen chars }
{------------------ end of customization constants ---------------------}
versionid = 2; { version number of dvifiles that pgm handles }
stackmax = 100; { allows 100 dvi-pushes }
verticalepsilon = 450000; { crlf when increasing v more than this }
rightmargin = 152; { nr of columns allowed to the right of h=0 }
leftmargin = -50; { give some room for negative h-coordinate }
stringlength = 100; { size of char-arrays for strings }
advance = true; { if advancing h when outputing a rule }
stay = false; { if not advancing h when outputing a rule }
absolute = 0;
relative = 1;
chffd = 12; { formfeed }
chspc = 32; { space }
chdel = 127; { delete }
{ some dvi op-codes (digit at end tells dvi-version-#) }
nop2 = 138; { no-op }
bop2 = 139; { beginning of page }
eop2 = 140; { end of page }
post2 = 248; { post-amble }
pre2 = 247; { pre-amble }
postpost2 = 249; { post-post-amble }
lastchar = 127; { highest char-code }
{-----------------------------------------------------------------------------}
type ubyte = 0..255; { dvi-files consists of eight-bit-bytes }
sbyte = -128..127; { UCB-pascal reads 16 bits if unsigned byte }
string = packed array [1..stringlength] of char;
pathtype = packed array [1..pathlen] of char;
charset = set of char;
stackitem = record
hh, vv, ww, xx, yy, zz : integer;
end;
stacktype = record { stack for dvi-pushes }
items : array [1..stackmax] of stackitem;
top : 0..stackmax;
end; { stacktype }
lineptr = ^linetype;
linetype = record { the lines of text to be output to outfile }
vv : integer; { vertical position of the line }
charactercount : integer; { pos of last char on line }
prev : lineptr; { preceding line }
next : lineptr; { succeding line }
text : packed array [leftmargin..rightmargin] of char;
end; { linetype }
printlistptr = ^printlisttype;
printlisttype = record { list of pages selected for output }
pag : integer; { the nr of the page }
all : boolean; { pages in intervall selected }
prv : printlistptr; { previous item in list }
nxt : printlistptr; { next item in list }
adr : integer; { nr of byte in file where bop is }
end; { printlisttype }
useagecodetype= (wrnge, { width switch arg out of range }
ign, { ignore cause, print'Usage:..' }
nan, { not a number where one expected }
gae, { garbage at end }
bdlst, { bad page-numberlist }
onef, { only one dvifile allowed }
bdopt, { bad option }
lngpth, { pathname too long (for -F) }
noarg); { argument expected }
errorcodetype = (illop, { illegal op-code }
stkof, { stack over-flow }
stkuf, { stack under-flow }
stkrq, { stack requirement }
badid, { id is not right }
bdsgn, { signature is wrong }
fwsgn, { too few signatures }
nopre, { no pre-amble where expected }
nobop, { no bop-command where expected }
nopp, { no postpost where expected }
bdpre, { unexpected preamble occured }
bdbop, { unexpected bop-command occured }
bdpst, { unexpected post-command occured }
bdpp, { unexpected postpost }
nopst, { no post-amble where expected }
illch, { character code out of range }
filop, { cannot access file }
filcr); { cannot creat file }
DVIfiletype = file of sbyte;
{-----------------------------------------------------------------------------}
var opcode : ubyte; { dvi-opcodes }
foo : integer; { utility variable, "register" }
h, v : integer; { coordinates, horizontal and vertical }
w, x, y, z : integer; { horizontal and vertical amounts }
outputtofile : boolean; { tells if output goes to file or stdout }
pager : boolean; { tells if output is piped to a pager }
pageswitchon : boolean; { true if user-set pages to print }
sequenceon : boolean; { false if pagesw-nrs refers to TeX-nrs }
scascii : boolean; { if true make Scand. nat. chars right }
noffd : boolean; { if true output ^L instead of formfeed }
ttywidth : integer; { max nr of chars per printed line }
path : pathtype; { name of the pager to run }
pathpgm : boolean; { use 'defpath' if this is true }
maxpagewidth : integer; { width of widest page in file }
charwidth : integer; { aprox width of charachter }
currentpage : printlistptr; { current page to print }
firstpage : printlistptr; { first page selected }
lastpage : printlistptr; { last page selected }
currentline : lineptr; { pointer to current line on current page }
firstline : lineptr; { pointer to first line on current page }
lastline : lineptr; { pointer to last line on current page }
firstcolumn : integer; { 1st column with something to print }
stack : stacktype;
DVIfile : DVIfiletype;
ERRfile : text;
DVIfilename : string;
OUTfilename : string;
{-----------------------------------------------------------------------------}
#include "sys.h" { headers for external C-routines }
{-----------------------------------------------------------------------------}
procedure errorexit(errorcode : errorcodetype);
begin
write(ERRfile,'dvitty: ');
case errorcode of
illop : writeln(ERRfile,'Illegal op-code found: ',opcode:0);
stkof : writeln(ERRfile,'Stack overflow.');
stkuf : writeln(ERRfile,'Stack underflow.');
stkrq : writeln(ERRfile,'Too much stack required : ',foo:0);
badid : writeln(ERRfile,'Id-byte is not correct: ',opcode:0);
bdsgn : writeln(ERRfile,'Bad signature: ',foo:0,' (not 223).');
fwsgn : writeln(ERRfile,foo:0,' signature bytes (min. 4).');
nopre : writeln(ERRfile,'Missing preamble.');
nobop : writeln(ERRfile,'Missing beginning-of-page command.');
nopp : writeln(ERRfile,'Missing post-post command.');
bdpre : writeln(ERRfile,'Preamble occured inside a page.');
bdbop : writeln(ERRfile,'BOP-command occured inside a page.');
bdpst : writeln(ERRfile,'Postamble occured before end-of-page.');
bdpp : writeln(ERRfile,'Postpost occured before post-command.');
nopst : writeln(ERRfile,'Missing postamble.');
illch : writeln(ERRfile,'Character code out of range, 0..127');
filop : writeln(ERRfile,'Cannot open dvifile');
filcr : writeln(ERRfile,'Cannot create outfile');
end;
if outputtofile then delete(output);
exit(-1);
end; { errorexit }
{-----------------------------------------------------------------------------}
procedure usage(uerr : useagecodetype);
begin
if uerr<>ign then begin
write(ERRfile,'dvitty: ');
case uerr of
ign : writeln(ERRfile, Copyright);
wrnge : writeln(ERRfile,'width arg out of range:16-132');
nan : writeln(ERRfile,'numeric argument expected');
gae : writeln(ERRfile,'garbage at end of argument');
bdlst : writeln(ERRfile,'mal-formed list of pagenumbers');
onef : writeln(ERRfile,'only one infile argument allowed');
noarg : writeln(ERRfile,'option argument expected');
lngpth : writeln(ERRfile,'path too long for -F');
bdopt : writeln(ERRfile,'bad option');
end;
end;
writeln(ERRfile,'Usage: dvitty [ options ] dvifile[.dvi]');
writeln(ERRfile,'Options are:');
writeln(ERRfile,
' -ofile Write output to file, else write to stdout.');
writeln(ERRfile,
' -plist Print pages whos TeX-page-number are in list.');
writeln(ERRfile,
' -Plist Print pages whos sequential number are in list.');
writeln(ERRfile,
' -wn Print the lines with width n characters, default 80.');
write(ERRfile,' -f Try to pipe to a pager if output is a tty');
if defpage then writeln(ERRfile,' (default).')
else writeln(ERRfile,'.');
write(ERRfile,' -q Don''t try to pipe to a pager');
if defpage then writeln(ERRfile,'.')
else writeln(ERRfile,' (default).');
writeln(ERRfile,
' -l Write ''^L'' instead of formfeed between pages.');
write(ERRfile,
' -u National Swedish characters printed as aaoAAO');
if defscand then writeln(ERRfile,'.')
else writeln(ERRfile,' (default).');
write(ERRfile,
' -s National Swedish characters printed as }{|][\');
if defscand then writeln(ERRfile,' (default).')
else writeln(ERRfile,'.');
exit(1);
end; { usage }
{-----------------------------------------------------------------------------}
procedure getname(var str : string);
var i : integer;
begin
i:=stringlength;
while (i>1) and (str[i]=' ') do i:=i-1;
if (i=1) and (str[1]=' ') then usage(ign);
if not ((i>=5) and (str[i]='i') and (str[i-1]='v')
and (str[i-2]='d') and (str[i-3]='.')) then begin
str[i+1]:='.';
str[i+2]:='d';
str[i+3]:='v';
str[i+4]:='i';
end;
DVIfilename:=str;
end; { getname }
{-----------------------------------------------------------------------------}
function getinteger(var j: integer; var str : string; def : integer) : integer;
var cum : integer;
sgn : boolean;
begin
if not (str[j] in ['0'..'9','-']) then getinteger:=def
else begin
cum:=0;
sgn:=false;
if str[j]='-' then begin
sgn:=true;
j:=j+1;
end;
if not (str[j] in ['0'..'9']) then getinteger:=def
else begin
while str[j] in ['0'..'9'] do begin
cum:=cum*10+ord(str[j])-ord('0');
j:=j+1;
end;
if sgn then getinteger:=-cum else getinteger:=cum;
end;
end;
end; { getinteger }
{-----------------------------------------------------------------------------}
procedure getpages(j : integer; var str : string);
var i : integer;
procedure plcnxt(pagnr : integer); { place page-nr next in list }
begin
currentpage:=lastpage;
currentpage^.pag:=pagnr;
new(lastpage);
lastpage^.all:=false;
lastpage^.nxt:=nil;
lastpage^.pag:=0;
currentpage^.nxt:=lastpage;
end; { plcnxt }
begin { getpages }
pageswitchon:=true;
new(firstpage);
firstpage^.all:=false;
firstpage^.nxt:=nil;
firstpage^.pag:=0;
lastpage:=firstpage;
currentpage:=firstpage;
if not (str[j] in ['1'..'9','-']) then usage(nan);
foo:=getinteger(j,str,0);
while foo<>0 do begin
plcnxt(foo);
if str[j]=',' then begin
j:=j+1;
if not (str[j] in ['1'..'9','-']) then usage(nan);
end else if str[j]=':' then begin
j:=j+1;
if not (str[j] in ['1'..'9','-']) then usage(nan);
foo:=getinteger(j,str,0);
if currentpage^.pag<0 then begin
if (foo>0) then begin
currentpage^.all:=true;
plcnxt(foo);
end else if foo<currentpage^.pag then
for i:=(currentpage^.pag-1) downto foo do plcnxt(i)
else usage(bdlst);
end else begin
if foo<currentpage^.pag then usage(bdlst);
for i:=(currentpage^.pag+1) to foo do plcnxt(i);
end;
if str[j]=',' then begin
j:=j+1;
if not (str[j] in ['1'..'9','-']) then usage(nan);
end;
end;
foo:=getinteger(j, str, 0);
end;
if str[j]<>' ' then usage(gae);
currentpage:=firstpage;
end; { getpages }
{-----------------------------------------------------------------------------}
procedure setoption(optch : char; var optset, optwarg : charset;
var str : string; var i : integer; j : integer);
var k : integer;
begin
while optch in optset do begin
case optch of
'q' : pager:=false;
'f' : pager:=true;
'l' : noffd:=true;
's' : scascii:=true;
'u' : scascii:=false;
'p' : begin
optset:=optset-['P']; { can't have both -P & -p }
getpages(j, str);
end;
'P' : begin
sequenceon:=true;
optset:=optset-['p']; { can't have both -P & -p }
getpages(j, str);
end;
'w' : begin
if not (str[j] in ['0'..'9','-']) then usage(nan);
ttywidth:=getinteger(j, str, 80);
if str[j]<>' ' then usage(gae);
if (ttywidth<16) or (ttywidth>132) then usage(wrnge);
end;
'o' : begin
for k:=1 to stringlength-j+1 do
OUTfilename[k]:=str[j+k-1];
for k:=stringlength-j+2 to stringlength do
OUTfilename[k]:=' ';
outputtofile:=true;
j:=stringlength;
end;
'F' : begin
for k:=1 to pathlen do
path[k]:=str[k+j-1];
if path[pathlen]<>' ' then usage(lngpth);
j:=stringlength;
pathpgm:=false;
end;
end;
optch:=str[j];
j:=j+1;
if optch in optwarg then if str[j]=' ' then begin
i:=i+1;
if i>=argc then usage(noarg);
argv(i, str);
j:=1;
end;
end;
end; { setoption }
{-----------------------------------------------------------------------------}
procedure getargs;
var i, j : integer;
str : string;
DVIfilenamefound : boolean;
optset, optwarg : charset;
optch : char;
begin
if argc<=1 then usage(ign);
pageswitchon:=false; { default: all pages }
sequenceon:=false; { default: selected pages are TeX-numbered }
outputtofile:=false; { default: write to stdout }
noffd:=false; { default: print formfeed between pages }
scascii:=defscand; { default: see compile time adjustable const }
pager:=defpage; { default: see compile time adjustable const }
path:=defpath; { default: use the default path to the pager }
pathpgm:=true; { default: - " - }
ttywidth:=80; { default }
DVIfilenamefound:=false;
optset:=['w','p','P','o','u','s','q','l','f','F']; { legal options }
optwarg:=['w','p','P','o','F']; { options with args }
i:=0;
while envargs(optch, str) do { get options from environ var DVITTY }
setoption(optch, optset, optwarg, str, i, 1);
i:=1;
while i<argc do begin
argv(i, str);
optch:=str[2]; { cache this one }
if str[1]<>'-' then begin
if DVIfilenamefound then usage(onef);
getname(str);
DVIfilenamefound:=true;
end else if optch in optset then begin
j:=3;
if (optch in optwarg) and (str[j]=' ') then begin
i:=i+1;
if i>=argc then usage(noarg);
argv(i, str);
j:=1;
end;
setoption(optch, optset, optwarg, str, i, j);
end else usage(bdopt);
i:=i+1;
end;
if not DVIfilenamefound then usage(ign)
end; { getargs }
{-----------------------------------------------------------------------------}
function getbyte : integer; { get next byte from dvi-file }
var b : sbyte;
begin
read(DVIfile, b);
if b<0 then getbyte:=b+256 else getbyte:=b
end; { getbyte }
{-----------------------------------------------------------------------------}
function get2 : integer; { returns the next two bytes, unsigned }
begin
foo:=getbyte;
get2:=foo*256+getbyte
end; { get2 }
{-----------------------------------------------------------------------------}
function get3 : integer; { returns the next three bytes, unsigned }
begin
foo:=getbyte;
foo:=foo*256+getbyte;
get3:=foo*256+getbyte
end; { get3 }
{-----------------------------------------------------------------------------}
function signedbyte : integer; { returns next byte fr dvi-file, signed }
var b : sbyte;
begin
read(DVIfile, b);
signedbyte:=b;
end; { signedbyte }
{-----------------------------------------------------------------------------}
function signed2 : integer; { returns the next two bytes, signed }
begin
read(DVIfile, foo);
signed2:=foo*256+getbyte
end; { signed2 }
{-----------------------------------------------------------------------------}
function signed3 : integer; { returns the next three bytes, signed }
begin
read(DVIfile, foo);
foo:=foo*256+getbyte;
signed3:=foo*256+getbyte
end; { signed3 }
{-----------------------------------------------------------------------------}
function signed4 : integer; { returns the next four bytes, signed }
begin
read(DVIfile, foo);
foo:=foo*256+getbyte;
foo:=foo*256+getbyte;
signed4:=foo*256+getbyte
end; { signed4 }
{-----------------------------------------------------------------------------}
function imin(a, b : integer) : integer; { returns the least of two int:s }
begin
if a<b then imin:=a
else imin:=b;
end;
{-----------------------------------------------------------------------------}
function skipnoops(goal : integer) : boolean; { skips by no-op commands }
begin { ret true if opcode=goal }
repeat
opcode:=getbyte;
until opcode<>nop2;
skipnoops:=(opcode=goal)
end; { skipnoops }
{-----------------------------------------------------------------------------}
function getline : lineptr; { returns an initialized line-object }
var i : integer;
temp : lineptr;
begin
new(temp);
with temp^ do begin
charactercount:=leftmargin-1; prev:=nil; next:=nil;
for i:=leftmargin to rightmargin do text[i]:=' '
end;
getline:=temp
end; { getline }
{-----------------------------------------------------------------------------}
function findline : lineptr; { find line where text should go, }
var temp : lineptr; { generate a new line if needed }
begin
if ((v>currentline^.vv) and (currentline=lastline))
or ((v<currentline^.vv) and (currentline=firstline))
or (v-lastline^.vv>verticalepsilon) then begin
temp:=getline;
with temp^ do begin
prev:=lastline;
vv:=v;
lastline^.next:=temp;
lastline:=temp
end
end else begin
temp:=lastline;
while (temp^.vv>v) and (temp<>firstline) do temp:=temp^.prev;
if abs(temp^.vv-v)>verticalepsilon then begin
if temp^.next^.vv-v < verticalepsilon then temp:=temp^.next
else if (temp=firstline) and (v<temp^.vv) then begin
temp:=getline;
with temp^ do begin
next:=firstline;
vv:=v;
firstline^.prev:=temp;
firstline:=temp
end
end else begin
currentline:=temp;
temp:=getline;
with temp^ do begin
next:=currentline^.next;
prev:=currentline;
currentline^.next:=temp;
currentline:=temp;
temp^.next^.prev:=temp;
vv:=v
end
end
end
end;
findline:=temp
end; { findline }
{-----------------------------------------------------------------------------}
procedure outchar(ch : char); { output ch to appropriate line }
var i, j : integer;
begin
if abs(v-currentline^.vv)>verticalepsilon
then currentline:=findline;
if (ord(ch) in [11..17, 25..31, 92, 123..126]) then
case ord(ch) of
11 : begin outchar('f'); ch:='f' end; { ligature }
12 : begin outchar('f'); ch:='i' end; { ligature }
13 : begin outchar('f'); ch:='l' end; { ligature }
14 : begin outchar('f');
outchar('f'); ch:='i' end; { ligature }
15 : begin outchar('f');
outchar('f'); ch:='l' end; { ligature }
16 : ch:='i';
17 : ch:='j';
25 : begin outchar('s'); ch:='s' end; { German double s }
26 : begin outchar('a'); ch:='e' end; { Dane/Norw ae }
27 : begin outchar('o'); ch:='e' end; { Dane/Norw oe }
28 : if scascii then ch:='|' { Dane/Norw /o }
else ch:='o';
29 : begin outchar('A'); ch:='E' end; { Dane/Norw AE }
30 : begin outchar('O'); ch:='E' end; { Dane/Norw OE }
31 : if scascii then ch:='\' { Dane/Norw /O }
else ch:='O';
92 : ch:='"'; { beginnig qoute }
123 : ch:='-';
124 : ch:='_';
125 : ch:='"';
126 : ch:='"';
end;
j:=round((h/maxpagewidth)*(ttywidth-1)+1.0);
if j>rightmargin then j:=rightmargin
else if j<leftmargin then j:=leftmargin;
with currentline^ do begin
foo:=leftmargin-1;
{-------------------------------------------------------------}
{ The following is very specialized code, it handles national }
{ Swedish characters. They are respectively: a and o with two }
{ dots ("a & "o) and a with a circle (Oa). In Swedish "ASCII" }
{ these characters replace }{|][ and \. TeX outputs these by }
{ first issuing the dots or circle and then backspace and set }
{ the a or o. When dvitty finds an a or o it searches in the }
{ near vicinity for the character codes that represent circle }
{ or dots and if one is found the corresponding national char }
{ replaces the special character codes. }
{-------------------------------------------------------------}
if scascii then begin
if (ch='a') or (ch='A') or (ch='o') or (ch='O') then begin
for i:=-(imin(-leftmargin, -(j-2)))
to imin(rightmargin, j+2) do
if ((ord(text[i])=127) or (ord(text[i])=23)) then
foo:=i;
if foo>=leftmargin then begin
j:=foo;
case ord(text[j]) of
127 : if ch='a' then ch:='{' else { dots }
if ch='A' then ch:='[' else
if ch='o' then ch:='|' else
if ch='O' then ch:='\';
23 : if ch='a' then ch:='}' else { circle }
if ch='A' then ch:=']'
end; { case }
end;
end;
end;
{----------------- end of 'Scandinavian code' ----------------}
if foo=leftmargin-1 then while (text[j]<>' ') and (j<rightmargin)
do begin
j:=j+1;
h:=h+charwidth
end;
if (scascii and ((ord(ch)>=chspc) or (ord(ch)=23))) or
(not scascii and (ord(ch)>=chspc) and (ord(ch)<>chdel)) then
begin
if j<rightmargin then text[j]:=ch
else text[rightmargin]:='@';
if j>charactercount then charactercount:=j;
if j<firstcolumn then firstcolumn:=j;
h:=h+charwidth
end
end { with currentline^ do }
end; { outchar }
{-----------------------------------------------------------------------------}
procedure setchar(charnr : integer);
{ should print characters with character code>127 from current font }
{ note that the parameter is a dummy, since ascii-chars are<=127 }
begin
outchar('#')
end; { setchar }
{-----------------------------------------------------------------------------}
procedure putcharacter(charnr : integer); { output character, don't change h }
var saveh : integer;
begin
saveh:=h;
if (charnr>=0) and (charnr<=lastchar) then outchar(chr(charnr))
else setchar(charnr);
h:=saveh;
end; { putcharacter }
{-----------------------------------------------------------------------------}
procedure rule(moving : boolean; rulewt, ruleht : integer);
{ output a rule (vertical or horizontal), increment h if moving is true }
var ch : char; { character to set rule with }
saveh, savev, wt : integer;
procedure ruleaux; { recursive procedure that does the job }
var lmh, rmh : integer;
begin
wt:=rulewt;
lmh:=h; { save left margin }
if h<0 then begin { let rules that start at negative h }
wt:=wt-h; { start at coordinate 0, but let it }
h:=0; { have the right length }
end;
while wt>0 do begin { output the part of the rule that }
rmh:=h; { goes on this line }
outchar(ch);
wt:=wt-(h-rmh); { decrease the width left on line }
end;
ruleht:=ruleht-verticalepsilon; { decrease the height }
if ruleht>verticalepsilon then begin { still more vertical? }
rmh:=h; { save current h (right margin) }
h:=lmh; { restore left margin }
v:=v-(verticalepsilon+(verticalepsilon div 10));
ruleaux;
h:=rmh; { restore right margin }
end;
end; { ruleaux }
begin { rule -- starts up the recursive routine }
if not moving then saveh:=h;
if (ruleht<=0) or (rulewt<=0) then h:=h+rulewt
else begin
savev:=v;
if (ruleht div rulewt)>0 then ch:='!'
else if ruleht>(verticalepsilon div 2) then ch:='='
else ch:='_';
ruleaux;
v:=savev;
end;
if not moving then h:=saveh;
end; { rule }
{-----------------------------------------------------------------------------}
procedure fontdef(param : integer); { ignore font-definition command }
begin
setpos(DVIfile, param+12, relative);
setpos(DVIfile, getbyte+getbyte, relative);
end; { fontdef }
{-----------------------------------------------------------------------------}
procedure horizontalmove(amount : integer; var worx : integer);
begin
if amount<>worx then
if abs(amount)<=(charwidth div 4) then worx:=amount
else begin
foo:=3*charwidth div 4;
if amount>0 then worx:=((amount+foo) div charwidth)*charwidth
else worx:=((amount-foo) div charwidth)*charwidth;
end;
h:=h+worx
end; { horizontalmove }
{-----------------------------------------------------------------------------}
function inlist(pagenr : integer) : boolean; { ret true if in list of pages }
begin
inlist:=false;
while (currentpage^.pag<0) and (currentpage^.pag<>pagenr)
and not currentpage^.all and (currentpage^.nxt<>nil) do
currentpage:=currentpage^.nxt;
if (currentpage^.all and (pagenr<currentpage^.pag))
or (currentpage^.pag=pagenr) then inlist:=true
else if pagenr>0 then begin
while (currentpage^.pag<>pagenr) and (currentpage^.nxt<>nil) do
currentpage:=currentpage^.nxt;
if currentpage^.pag=pagenr then inlist:=true
end
end; { inlist }
{-----------------------------------------------------------------------------}
function bop(var pagecounter, backpointer, pagenr : integer) : boolean;
begin
pagecounter:=pagecounter+1;
pagenr:=signed4;
setpos(DVIfile, 36, relative);
backpointer:=signed4;
if pageswitchon then
if sequenceon then bop:=inlist(pagecounter)
else bop:=inlist(pagenr)
else bop:=true;
end; { bop }
{-----------------------------------------------------------------------------}
procedure initpage(backpointer, pagenr, pagecounter : integer);
begin
h:=0; v:=0; { initialize coordinates }
x:=0; w:=0; y:=0; z:=0; { initialize amounts }
stack.top:=0; { initialize stack }
currentline:=getline; { initialize list of lines }
currentline^.vv:=0;
firstline:=currentline;
lastline:=currentline;
firstcolumn:=rightmargin;
if pageswitchon then
if (sequenceon and (pagecounter<>firstpage^.pag))
or (not sequenceon and (pagenr<>firstpage^.pag)) then
if noffd then writeln('^L') else writeln(chr(chffd));
if not pageswitchon then if backpointer<>-1 then
if noffd then writeln('^L') else writeln(chr(chffd));
end; { initpage }
{-----------------------------------------------------------------------------}
procedure dover2page;
begin
opcode:=getbyte;
while opcode<>eop2 do begin { process page until eop reached }
if opcode>postpost2 then errorexit(illop)
else if opcode<=lastchar then outchar(chr(opcode))
else if opcode in [128..170, 235..249] then
case opcode of
128 : setchar(getbyte);
129 : setchar(get2);
130 : setchar(get3);
131 : setchar(signed4);
132 : rule(advance, signed4, signed4);
133 : putcharacter(getbyte);
134 : putcharacter(get2);
135 : putcharacter(get3);
136 : putcharacter(signed4);
137 : rule(stay, signed4, signed4);
nop2: ; { no-op }
bop2: errorexit(bdbop);
141 : with stack do begin { push }
if top>stackmax-1 then errorexit(stkof);
top:=top+1;
with items[top] do begin
hh:=h; vv:=v; ww:=w;
xx:=x; yy:=y; zz:=z;
end;
end;
142 : with stack do begin { pop }
if top=0 then errorexit(stkuf);
with items[top] do begin
h:=hh; v:=vv; w:=ww;
x:=xx; y:=yy; z:=zz;
end;
top:=top-1;
end;
143 : h:=h+signedbyte;
144 : h:=h+signed2;
145 : h:=h+signed3;
146 : h:=h+signed4;
147 : horizontalmove(w, w);
148 : horizontalmove(signedbyte, w);
149 : horizontalmove(signed2, w);
150 : horizontalmove(signed3, w);
151 : horizontalmove(signed4, w);
152 : horizontalmove(x, x);
153 : horizontalmove(signedbyte, x);
154 : horizontalmove(signed2, x);
155 : horizontalmove(signed3, x);
156 : horizontalmove(signed4, x);
157 : v:=v+signedbyte;
158 : v:=v+signed2;
159 : v:=v+signed3;
160 : v:=v+signed4;
161 : v:=v+y;
162 : begin y:=signedbyte; v:=v+y end;
163 : begin y:=signed2; v:=v+y end;
164 : begin y:=signed3; v:=v+y end;
165 : begin y:=signed4; v:=v+y end;
166 : v:=v+z;
167 : begin z:=signedbyte; v:=v+z end;
168 : begin z:=signed2; v:=v+z end;
169 : begin z:=signed3; v:=v+z end;
170 : begin z:=signed4; v:=v+z end;
235, 236, 237, { ignore font changes }
238 : setpos(DVIfile, opcode-234, relative);
239 : setpos(DVIfile, getbyte, relative);
240 : setpos(DVIfile, get2, relative);
241 : setpos(DVIfile, get3, relative);
242 : setpos(DVIfile, signed4, relative);
243,244,245,
246 : fontdef(opcode-242);
pre2 : errorexit(bdpre);
post2 : errorexit(bdpst);
postpost2: errorexit(bdpp);
end;
opcode:=getbyte
end
end; { dover2page }
{-----------------------------------------------------------------------------}
procedure eop; { 'end of page', writes lines of page to output file }
var i, j : integer;
ch : char;
begin
if stack.top<>0 then
writeln(ERRfile, 'dvitty: warning - stack not empty at eop.');
currentline:=firstline;
repeat
with currentline^ do begin
if currentline<>firstline then begin
foo:=((vv-prev^.vv) div verticalepsilon)-1;
if foo>0 then foo:=imin(foo, 3);
for i:=1 to foo do writeln;
end;
if charactercount>=leftmargin then begin
i:=firstcolumn; j:=1; foo:=ttywidth-2;
repeat
ch:=text[i];
if (ord(ch)>=chspc) and (ord(ch)<>chdel) then
write(ch);
if j>foo then if charactercount>i+1 then begin
writeln('*');
write(' *');
j:=2
end;
i:=i+1; j:=j+1
until i>charactercount;
end
end;
writeln;
currentline:=currentline^.next;
until currentline^.next=nil;
end; { eop }
{-----------------------------------------------------------------------------}
procedure skipver2page; { skip past one page }
begin
opcode:=getbyte;
while opcode<>eop2 do begin
if opcode>postpost2 then errorexit(illop)
else if opcode in [128..170, 235..249] then
case opcode of
nop2,141, 142, 147, 152, 161, 166 : ;
128, 133, 143, 148, 153, 157, 162, 167, 235 :
setpos(DVIfile, 1, relative);
129, 134, 144, 149, 154, 158, 163, 168, 236 :
setpos(DVIfile, 2, relative);
130, 135, 145, 150, 155, 159, 164, 169, 237 :
setpos(DVIfile, 3, relative);
131, 136, 146, 151, 156, 160, 165, 170, 238 :
setpos(DVIfile, 4, relative);
132, 137 : setpos(DVIfile, 8, relative);
139 : errorexit(bdbop);
239 : setpos(DVIfile, getbyte, relative);
240 : setpos(DVIfile, get2, relative);
241 : setpos(DVIfile, get3, relative);
242 : setpos(DVIfile, signed4, relative);
243,244,245,
246 : fontdef(opcode-242);
pre2 : errorexit(bdpre);
post2 : errorexit(bdpst);
postpost2 : errorexit(bdpp);
end;
opcode:=getbyte;
end;
end; { skipver2page }
{-----------------------------------------------------------------------------}
procedure dopages; { process the pages in the DVI-file }
var pagecounter, backpointer, pagenr : integer;
begin
setpos(DVIfile, 0, absolute); { read the dvifile from the start }
pagecounter:=0;
if not skipnoops(pre2) then errorexit(nopre);
opcode:=getbyte; { check id in preamble, ignore rest of it }
if opcode<>versionid then errorexit(badid);
setpos(DVIfile, 12, relative);
setpos(DVIfile, getbyte, relative);
if not skipnoops(bop2) then errorexit(nobop) { should be at start }
else while opcode<>post2 do begin { of page now }
if opcode<>bop2 then errorexit(nobop)
else begin
if not bop(pagecounter, backpointer, pagenr) then skipver2page
else begin
initpage(backpointer, pagenr, pagecounter);
dover2page;
eop;
end;
repeat opcode:=getbyte until opcode<>nop2
end
end;
end; { dopages }
{-----------------------------------------------------------------------------}
procedure postamble; { find and process postamble, use random access }
var size, count : integer;
begin
size:=sizef(DVIfile); { get size of file }
count:=-1;
repeat { back file up past signature bytes (223), to id-byte }
if size=0 then errorexit(nopst);
size:=size-1;
setpos(DVIfile, size, absolute);
opcode:=getbyte;
count:=count+1; { has to be at least 4 sign-bytes }
until opcode<>223;
if count<4 then begin foo:=count; errorexit(fwsgn); end;
if opcode<>versionid then errorexit(badid);
setpos(DVIfile, size-4, absolute); { back up to back-pointer }
setpos(DVIfile, signed4, absolute); { back up to start of postamble }
if getbyte<>post2 then errorexit(nopst);
setpos(DVIfile, 20, relative);
maxpagewidth:=signed4;
charwidth:=maxpagewidth div ttywidth;
foo:=get2;
if foo>stackmax then errorexit(stkrq); { too much stack required }
end; { postamble }
(*****************************************************************************
*
* M A I N
*)
begin
rewrite(ERRfile, '/dev/tty'); { get a pascal file }
tostderr(ERRfile); { and redirect it to stderr }
getargs; { read the command line arguments }
if not readp(DVIfilename) then
errorexit(filop); { can't open dvifile }
reset(DVIfile, DVIfilename);
if outputtofile then begin { open the outfile }
if not writep(OUTfilename) then
errorexit(filcr); { can't create outfile }
rewrite(output, OUTfilename);
pager:=false;
end else
if ttyp(output) and pager then { try to pipe to a pager }
pager:=popenp(output, path, pathpgm);
postamble; { seek and process the postamble }
dopages; { time to do the actual work! }
if pager then pcloseit(output); { have to use pclose if popened }
end.