path: root/dviware/dvitty/dvitty.p

(******************************************************************************
 * bogart:/usr/alla/zap/dvitty/dvitty.p  1986-09-21 01:54:52,
 *               bugfixes from Tor Lillqvist (santra!tml) added.
 * 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:
 *
 * Internet: zap@nada.kth.se   UUCP: {uunet,mcvax}!enea!nada.kth.se!zap
 *)

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       }
                     nxt : printlistptr;  { next item in list                 }
                 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 :  begin
                           foo:=signed4;
                           rule(advance, signed4, foo);
                       end;
                133 :  putcharacter(getbyte);
                134 :  putcharacter(get2);
                135 :  putcharacter(get3);
                136 :  putcharacter(signed4);
                137 :  begin
                           foo:=signed4;
                           rule(stay, signed4, foo);
                       end;
                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;
          temp : lineptr;
    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;
            temp:=currentline;
            currentline:=currentline^.next;
            dispose(temp);
        until currentline=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.