Path: utzoo!utgpu!water!watmath!clyde!rutgers!husc6!bbn!uwmcsd1!ig!agate!violet.berkeley.edu!forags
From: forags@violet.berkeley.edu (;;;;KB37)
Newsgroups: comp.lang.postscript
Subject: Re: Ascii file to postscript translator
Message-ID: <6967@agate.BERKELEY.EDU>
Date: 12 Feb 88 17:32:12 GMT
References: <202@halibut.NOSC.MIL>
Sender: usenet@agate.BERKELEY.EDU
Reply-To: forags@violet.berkeley.edu.UUCP (Al Stangenberger)
Distribution: na
Organization: University of California, Berkeley
Lines: 811

Following is a Turbo-Pascal program which was posted to the net some time
ago.  It isn't perfect, but it does a pretty good job of translating files.

--------------- cut here ---------------
PROGRAM Postscript;

{$U+}

{ASCII menu driven listing program that generates PostScript
commands to the Apple LaserWriter.  Allows selction of
bold and normal fonts, font size and line spacing.  Output
can go to a disk file (output.ps) or directly to the printer.

Limitations: Handling tabs is limited to move to an absolute
location on the line.  Program is not smart about the actual
widths of characters in different fonts... it just uses an
average width per character of fontsize/2.  Program cannot
handle tabs and font change escapes on the same line.  Epson
font change escapes ESC G for bold and ESC H for normal are
used.  Bold font and normal font do not mix too well on the same
line.  Spacing for a tab is based on an average of 8 nominal
characters... as a result the tab spacing after some text with
capital letters may not be wide enough and the text starting
after the tab may overlap with previous text.  (On the other
hand, the worst case width of 8 characters is too large for
normal use).

Can be invoked with filename as a parameter: nlist filename

Free for non-commercial use only.

(C) Copywrite Nate Liskov 27 Jan 1986}

{ Version 1.0 - Original Version }
{ Version 1.1 - Fonts for LaserWriter Plus Added }
{ Version 1.2 - Landscape Format Option Added - Apr 1987 }

TYPE
  DateTimeStr = STRING[26];
  OnorOff     = ARRAY[1..2] OF STRING[3];
  pageform    = ARRAY[1..2] OF STRING[9];
  fonttype    = ARRAY[1..33] OF STRING[28];
  outfile     = ARRAY[1..2] OF STRING[21];
  parmtype    = STRING[127];
  maxspaces   = STRING[255];

VAR
    linecount, n, m, page, linelength, entryline : integer;
    topspaces, bottomspaces, leftmargin, rightmargin, lm, rm : integer;
    option   : char;
    pagestr  : STRING[3];
    filename : STRING[45];
    temp, lineout     : STRING[255];
    right, left : maxspaces;
    source, sink   : text;
    linesize, header, automatic, maxline : integer;
    x        : parmtype;
    hellfreezesover : boolean;
    datetimestamp: datetimestr;
    yposition,linesperpage,linespacing,nfont,bfont,currentfont,
        nout,pagefeed,fontsize,pagetype : integer;

  CONST
    onoff: onoroff = ('On ','Off');
    pageformat: pageform = ('Portrait ','Landscape');
    font: fonttype = ('Helvetica','Times-Roman','Courier',
                      'Helvetica-Oblique','Times-Italic','Courier-Oblique',
                      'Helvetica-Bold','Times-Bold','Courier-Bold',
                      'Helvetica-BoldOblique','Times-BoldItalic',
                      'Courier-BoldOblique','AvantGuarde-Book',
                      'AvantGuard-BookOblique','AvantGuarde-Demi',
                      'AvantGuarde-DemiOblique','Bookman-Demi',
                      'Bookman-DemiItalic','Bookman-Light',
                      'Bookman-LightItalic','Helvetica-Narrow',
                      'Helvetica-Narrow-Bold','Helvetica-Narrow-BoldOblique',
                      'Helvetica-Narrow-Oblique','NewCenturySchlbk-Roman',
                      'NewCenturySchlbk-Bold','NewCenturySchlbk-Italic',
                      'NewCenturySchlbk-BoldItalic','Palatino-Roman',
                      'Palatino-Bold','Palatino-Italic','Palatino-BoldItalic',
                      'ZapfChancery-MediumItalic');
    output: outfile = ('Printer','Disk File: Output.ps');

PROCEDURE init;
  BEGIN
    nfont := 1 ;              {default normal font is helvetica}
    bfont := 7;               {default bold font is helvetica-bold}
    nout := 1;                {default output is to printer}
    pagefeed := 1;            {default is to do page feed}
    pagetype := 1;            {default is portrait page format}
    fontsize := 10;
    linespacing := 12;
    linesize := 1152 DIV fontsize;
    linesperpage := 792 DIV linespacing;
    header   := 1;           {default is header line on}
    automatic := 2;          {default is zero margins}
    topspaces := 2;
    bottomspaces := 0;
    leftmargin := 0;
    rightmargin := 0;
    right := '';
    left := '';
    entryline := 22;
    IF paramcount<>0
      THEN BEGIN
             filename := paramstr(1);
             assign(source,filename);
          END
      ELSE filename := '';
    assign(sink,'output.ps');
    hellfreezesover := false;
  END;

FUNCTION DateTime: DateTimeStr;

TYPE
  regpack = RECORD
              ax,bx,cx,dx,bp,si,ds,es,flags: integer;
            END;
  dayname = STRING[3];

  TYPE monthname = ARRAY[1..12] OF STRING[3];

    CONST mon: monthname = ('Jan','Feb','Mar','Apr','May','Jun',
                            'Jul','Aug','Sep','Oct','Nov','Dec');

VAR
  recpack:       regpack;                {record for MsDos call}
  day,hours,minutes,seconds:     STRING[2];
  year:          STRING[4];
  month,dx,cx,daynumber,yearnumber:         integer;
  dayoftheweek : dayname;

FUNCTION DayofWeek(juliandate:real): dayname;
{finds day of week for 10 feb 1985 or later}

TYPE  daynames = ARRAY[1..7] OF STRING[3];

  CONST day: daynames = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');

VAR   daynumber : real;

BEGIN
  daynumber := (juliandate + 1.5)/7;
  daynumber := daynumber -349444.0;   {sun 10 feb 1985}
  WHILE daynumber > 32000 DO
    daynumber := daynumber - 32000;
  daynumber := (daynumber - trunc(daynumber))*7;
  dayofweek := day[round(daynumber)+1];
END;

FUNCTION juliandate(daynumber, monthnumber, yearnumber:integer): real;

VAR  a,b,c,d : real;

BEGIN
  IF monthnumber < 3
    THEN
      BEGIN
        yearnumber := yearnumber -1;
        monthnumber := monthnumber + 12;
      END;
  a := trunc(yearnumber/100)*1.0;
  b := 2-a+trunc(a/4)*1.0;
  c := 365.0 * yearnumber+trunc(yearnumber/4);
  d := trunc(30.6001*(monthnumber+1));
  juliandate := b+c+d+1720994.5+daynumber;
{  writeln('julian date ',b+c+d+1720994.5+daynumber:10:1);}
END;

BEGIN
  WITH recpack DO
    BEGIN
      ax := $2a shl 8;
    END;
  MsDos(recpack);                        { call function }
  WITH recpack DO
    BEGIN
      str(cx,year);                        {convert to string}
      yearnumber := cx;
      daynumber := dx MOD 256;
      str(daynumber,day);                     { " }
      month := dx shr 8;
    END;
  WITH recpack DO
    BEGIN
      ax := $2c shl 8;
    END;
  MsDos(recpack);
  WITH recpack DO
    BEGIN
      str(cx shr 8,hours);
      IF (cx shr 8)<10
        THEN hours := '0'+hours;
      str(cx MOD 256,minutes);
      IF (cx MOD 256)<10
        THEN minutes := '0'+minutes;
      str(dx shr 8,seconds);
      IF (dx shr 8)<10
        THEN seconds := '0'+seconds;
    END;
  dayoftheweek := (dayofweek(juliandate(daynumber,month,yearnumber)));
  IF daynumber > 9
    THEN
      datetime := dayoftheweek+' '+day+' '+mon[month]+' '+year
                  +'   '+hours+':'+minutes+':'+seconds
    ELSE
      datetime := dayoftheweek+' '+' '+day+' '+mon[month]+' '+year+'   '
                  +hours+':'+minutes+':'+seconds;
END;


PROCEDURE optionline;
  BEGIN
    gotoxy(1,entryline);
    normvideo;
    writeln('   Enter Option Choice                                                ');
    gotoxy(36,entryline);
  END;

PROCEDURE menu;  {gives main menu options}
  BEGIN
    clrscr;
    lowvideo;
    writeln('Postscript File Listing Utility for Apple LaserWriter - Version 1.2');
    writeln('   ____________(C) 1986 Nathan Liskov_____________');
    writeln;
    writeln('   0 := Font Size                : ',fontsize);
    writeln('   1 := Line Spacing             : ',linespacing,'   (',linesperpage,
            ' lines per page)');
    writeln('   2 := Page Feed                : ',onoff[pagefeed]);
    writeln('   3 := Normal Font              : ',font[nfont]);
    writeln('   4 := Bold Font                : ',font[bfont]);
    writeln('   5 := Header Line              : ',onoff[header]);
    writeln('   6 := Output Goes To           : ',output[nout]);
    writeln('   7 := Extra Top Blank Lines    : ',topspaces);
    writeln('   8 := Extra Bottom Blank Lines : ',bottomspaces);
    writeln('   9 := Automatic L/R Margins    : ',onoff[automatic]);
    writeln('   L := Extra Left Margin        : ',leftmargin);
    writeln('   R := Extra Right Margin       : ',rightmargin);
    writeln('   P := Page Format              : ',pageformat[pagetype]);
    writeln;
    normvideo;
    writeln('   F := File Name                : ',filename);
    writeln;
    writeln('   G := GO         Q := QUIT');
    writeln;
    optionline;
    page := 0;
  END;

PROCEDURE get_file;
  BEGIN
    gotoxy(1,entryline);
    write('   Enter name of file to list: ');
    readln(filename);
    assign(source,filename);
    gotoxy(36,18);
    write(filename,'                                           ');
    optionline;
  END;

PROCEDURE settopmargin;
  BEGIN
    gotoxy(1,entryline);
    write('   Enter number of extra top spaces: ');
    readln(topspaces);
    gotoxy(36,11);
    write(topspaces,'            ');
    optionline;
  END;

PROCEDURE setbottommargin;
  BEGIN
    gotoxy(1,entryline);
    write('   Enter number of extra bottom spaces: ');
    readln(bottomspaces);
    gotoxy(36,12);
    write(bottomspaces,'            ');
    optionline;
  END;

FUNCTION spaces(n:integer): maxspaces;

  VAR
    tmp: STRING[255];
    m: integer;
  BEGIN
    tmp := '';
    FOR m :=1 TO n DO
      tmp := tmp + ' ';
    spaces := tmp;
  END;

PROCEDURE setleftmargin;
  BEGIN
    gotoxy(1,entryline);
    write('   Enter number of extra left margin spaces: ');
    readln(leftmargin);
    left := spaces(leftmargin);
    gotoxy(36,14);
    write(leftmargin,'             ');
    optionline;
  END;

PROCEDURE setfontsize;
  BEGIN
    gotoxy(1,entryline);
    write('   Enter new fontsize: ');
    readln(fontsize);
    IF pagetype = 1 THEN linesize := 1152 DIV fontsize
    ELSE linesize := 1512 DIV fontsize;
    gotoxy(36,4);
    write(fontsize,'             ');
    optionline;
  END;

PROCEDURE setlinespacing;
  BEGIN
    gotoxy(1,entryline);
    write('   Enter new linespacing: ');
    readln(linespacing);
    IF pagetype = 1 THEN linesperpage := 792 DIV linespacing
    ELSE linesperpage := 612 DIV linespacing;
    gotoxy(36,5);
    write(linespacing,'   (',linesperpage,' lines per page)    ');
    optionline;
  END;


PROCEDURE setrightmargin;
  BEGIN
    gotoxy(1,entryline);
    write('   Enter number of extra right margin spaces: ');
    readln(rightmargin);
    right := spaces(rightmargin);
    gotoxy(36,15);
    write(rightmargin,'             ');
    optionline;
  END;

PROCEDURE setpageformat;
  BEGIN
    IF pagetype = 1
    THEN pagetype := 2
    ELSE pagetype := 1;
    gotoxy(36,16);
    write(pageformat[pagetype],'           ');
    IF pagetype = 1 THEN linesize := 1152 DIV fontsize
    ELSE linesize := 1512 DIV fontsize;
    IF pagetype = 1 THEN linesperpage := 792 DIV linespacing
    ELSE linesperpage := 612 DIV linespacing;
    gotoxy(36,5);
    write(linespacing,'   (',linesperpage,' lines per page)    ');
    optionline;
  END;


PROCEDURE setfont(n:integer);

  BEGIN
    IF nout = 1
      THEN
        IF n = nfont then writeln(lst,'normalfont')
        ELSE writeln(lst,'boldfont')
      ELSE
        IF n=nfont then writeln(sink,'normalfont')
        ELSE writeln(sink,'boldfont');
  END;

PROCEDURE page_feed;
  BEGIN
    IF nout = 1
      THEN BEGIN
             writeln(lst,' showpage');
             writeln(lst,'saveobj2 restore');
             writeln(lst,'/saveobj2 save def');
      END
      ELSE BEGIN
             writeln(sink,' showpage');
             writeln(sink,'saveobj2 restore');
             writeln(sink,'/saveobj2 save def');
      END;
    setfont(nfont);
    linecount := 1;
    page := page + 1;
  END;

PROCEDURE output_line;

  TYPE
      txt = STRING [255];

  VAR
       restofline,textpiece,templine : txt;
       ypos : STRING[4];
       startofpiece,leadingblanks : integer;

PROCEDURE escape(ch :char ; VAR txtline : txt);
    {adds \ escape for postscript}

  VAR
       lineout,restofline,remainder : txt;
       m : integer;
  BEGIN
    restofline := txtline;
    lineout := '';
    remainder := '';
    IF pos(ch,txtline) = 0
      THEN lineout := txtline;
    WHILE pos(ch,restofline) > 0 DO
      BEGIN
        m := pos(ch,restofline);
        lineout := lineout + copy(restofline,1,m-1) + '\' + ch;
        restofline := copy(restofline,m+1,length(restofline)-m);
        remainder := restofline;
      END;
      txtline := lineout + remainder;
  END;


PROCEDURE dosubpiece(VAR txtpiece : txt);
                {process text piece without tabs or font escapes}
  BEGIN
    escape('\',txtpiece);
    escape(')',txtpiece);
    escape('(',txtpiece);
    IF nout = 1
      THEN BEGIN
             writeln(lst,'('+txtpiece+')' + ' s ');
         END
      ELSE BEGIN
             writeln(sink,'('+txtpiece+')' + ' s ');
         END;
  END;

PROCEDURE dotextpiece(VAR textpiece : txt);  {process text that may have tabs}

  VAR
      m,xposition : integer;
      xpos,ypos : STRING[4];
      txtpiece : txt;
  BEGIN
    IF pagetype = 1 THEN yposition := 792-linespacing*linecount
    ELSE yposition := 612-linespacing*linecount;
    str(yposition,ypos);
    str((leadingblanks+startofpiece-1)*fontsize div 2  + 45,xpos);
    WHILE pos(chr(9),textpiece)>0 DO
      BEGIN
        IF nout = 1
          THEN
            write(lst,' ',xpos,' ',ypos,' mto ')
          ELSE
            write(sink,' ',xpos,' ',ypos,' mto ');
        m := pos(chr(9),textpiece);
        txtpiece := copy(textpiece,1,m-1);
        dosubpiece(txtpiece);
        xposition := startofpiece + m-1;
        xposition := ((xposition-1) DIV 8 + 1)*8;
        startofpiece := xposition+1;
        xposition := (leadingblanks+xposition)*fontsize div 2 + 45;
        str(xposition,xpos);
        textpiece := copy(textpiece,m+1,length(textpiece)-m);
      END;
    IF length(textpiece)>0
      THEN BEGIN
             IF nout = 1
               THEN BEGIN
                      write(lst,' ',xpos,' ',ypos,' mto ');
                      dosubpiece(textpiece);
                 END
               ELSE BEGIN
                      write(sink,' ',xpos,' ',ypos,' mto ');
                      dosubpiece(textpiece);
                 END;
        END;
END;

  BEGIN     {output_line}
    IF pos(chr(12),temp)>0   {assume form feed is only character on a line}
      THEN BEGIN
             page_feed;
             exit;
         END;
{compute number of leading blanks}
    leadingblanks := 0;
    templine := copy(temp,leadingblanks+1,length(temp)-leadingblanks);
    WHILE pos(' ',templine) = 1 DO
      BEGIN
        leadingblanks := leadingblanks+1;
        templine := copy(templine,2,length(templine)-1);
      END;
    temp := templine;   {temp has leading blanks stripped off}
{look for enable or disable bold}
    restofline := temp;
    WHILE (pos(chr(27)+'G',restofline)>0) OR (pos(chr(27)+'H',restofline)>0) DO
      BEGIN
        IF pos(chr(27)+'G',restofline)>0   {esc G enables bold}
          THEN BEGIN
                 m := pos(chr(27)+'G',restofline);
                 textpiece := copy(restofline,1,m-1);
                 startofpiece := length(temp)-length(restofline)+1;
                 restofline := copy(restofline,m+2,length(restofline));
                 IF length(textpiece) <> 0
                   THEN dotextpiece(textpiece);
                 setfont(bfont);
                 currentfont := bfont;
            END;
        IF pos(chr(27)+'H',restofline)>0   {esc H disables bold}
          THEN BEGIN
                 m := pos(chr(27)+'H',restofline);
                 textpiece := copy(restofline,1,m-1);
                 startofpiece := length(temp)-length(restofline)+1;
                 restofline := copy(restofline,m+2,length(restofline));
                 IF length(textpiece) <> 0
                   THEN dotextpiece(textpiece);
                 setfont(nfont);
                 currentfont := nfont;
            END;
      END;
    IF length(restofline)>0
      THEN BEGIN
             startofpiece := length(temp)-length(restofline)+1;
             dotextpiece(restofline);
        END;
END;

PROCEDURE title; {prints filename, datetime, and page number on each page}

  VAR
      nspaces : integer;
  BEGIN
    nspaces := (linesize - 36- length(filename)) DIV 2;
    IF nfont IN [3,6,9,12]   {test for courier font}
      THEN     nspaces := (linesize - 36- length(filename)) DIV 4;
    temp := 'File: '+ filename + spaces(nspaces);
    temp := temp + datetimestamp + spaces(nspaces) + 'Page ';
    str(page:3,pagestr);
    temp := temp + pagestr;
    output_line;
    write('.');
    linecount := 2;
  END;

PROCEDURE insertblankline;
  BEGIN
    temp := '';
    output_line;
    write('.');
    linecount := linecount + 1;
  END;

PROCEDURE inserttoplines;
  BEGIN
    FOR n := 1 TO topspaces DO
      insertblankline;
  END;

PROCEDURE composeline;       {inserts left and right margin spaces}

  VAR
    len : integer;
  BEGIN
    len := linesize
           - leftmargin - rightmargin;
    m := (length(temp)-1) DIV len + 1;
   {number of sublines per line of input is m}
    lineout := '';
    FOR n := 1 TO m DO
      BEGIN
        lineout := lineout+left+ copy(temp,(n-1)*len+1,len) +right;
      END;
    IF length(lineout) > 255
      THEN BEGIN
             writeln;
             writeln('Warning....Line in excess of 255 characters in length.');
        END;
   END;

PROCEDURE automaticmargins;
{sets margins so longest line in file is centered}
  BEGIN
    reset(source);
    lm := leftmargin;
    rm := rightmargin;
    maxline := 0;
    REPEAT
      readln(source,temp);
      m := length(temp);
      IF m > maxline
        THEN maxline := m;
    UNTIL EOF(source);
    close(source);
    leftmargin := (linesize-maxline) div 2;
    IF nfont IN [3,6,9,12]   {test for courier font}
      THEN leftmargin := (linesize-maxline) div 4;
    IF leftmargin < 0
      THEN leftmargin := 0;
      rightmargin := 0;
    right := spaces(rightmargin);
    left := spaces(leftmargin);
    END;

PROCEDURE printfile;

  VAR
       n : integer;
       ypos : STRING[4];
       siz : STRING [3];

  BEGIN
    datetimestamp := datetime;
    IF automatic = 1
      THEN automaticmargins;
    IF nout = 2 THEN rewrite(sink);
    reset(source);
    str(fontsize,siz);
    IF nout = 1
      THEN BEGIN
             writeln(lst,'/saveobj1 save def');
             writeln(lst,'/mto {moveto} def');
             writeln(lst,'/s {show} def');
             writeln(lst,'/normalfont {/'+font[nfont]+' findfont '+siz+' '+ ' scalefont setfont} def');
             writeln(lst,'/boldfont {/'+font[bfont]+' findfont '+siz+' '+ ' scalefont setfont} def');
             writeln(lst,'clippath pathbbox');
             writeln(lst,'/ymax exch def /xmax exch def /ymin exch def /xmin exch def');
             writeln(lst,'xmin ymin translate');
             writeln(lst,'0.98 0.98 scale');
             IF pagetype = 2 THEN writeln(lst,'612 0 translate 90 rotate');
           writeln(lst,'/saveobj2 save def');
           END
      ELSE BEGIN
             writeln(sink,'/saveobj1 save def');
             writeln(sink,'/mto {moveto} def');
             writeln(sink,'/s {show} def');
             writeln(sink,'/normalfont {/'+font[nfont]+' findfont '+siz+' '+ ' scalefont setfont} def');
             writeln(sink,'/boldfont {/'+font[bfont]+' findfont '+siz+' '+ ' scalefont setfont} def');
             writeln(sink,'clippath pathbbox');
             writeln(sink,'/ymax exch def /xmax exch def /ymin exch def /xmin exch def');
             writeln(sink,'xmin ymin translate');
             writeln(sink,'0.98 0.98 scale');
             IF pagetype = 2 THEN writeln(sink,'612 0 translate 90 rotate');
             writeln(sink,'/saveobj2 save def');
           END;
    setfont(nfont);
    page := 1;
    linecount := 1;
    linelength := linesize -rightmargin-leftmargin;
    IF linelength <= 0
      THEN BEGIN
             clrscr;
             writeln('ERROR...Illegal margin size');
             halt;
        END;
    writeln;
    REPEAT     {for every line in file}
      IF linecount =1
        THEN BEGIN
               writeln;
               write('Page ',page,' ');              {status info to screen}
               IF (header = 1) AND (pagefeed =1)
                  THEN  title;
               IF (topspaces >0) AND (pagefeed =1)
                 THEN inserttoplines;
             END;
      readln(source,temp);                   {read in one line}
      composeline;
      FOR n := 1 TO 1 + (length(lineout)-1) DIV linesize DO
        BEGIN  {process piece of full line}
          temp := copy(lineout,(n-1)*linesize+1,linesize);
          output_line;
          linecount := linecount + 1;
          write('.');
          IF (linecount > (9*linesperpage DIV 10) - bottomspaces) AND (pagefeed =1)
            THEN page_feed;
          IF linecount =1
            THEN BEGIN {do after page break}
                   writeln;
                   write('Page ',page,' ');         {status info to screen}
                   IF (header = 1) AND (pagefeed=1)
                     THEN title;
                   IF (topspaces >0) AND (pagefeed=1)
                     THEN inserttoplines;
              END;
        END;  {processing pieces of long line}
    UNTIL eof(source);     {done all lines}
    close(source);
            {final page feed to eject last page}
    IF nout = 1
      THEN BEGIN
             writeln(lst,' showpage');
      END
      ELSE BEGIN
             writeln(sink,' showpage');
      END;
    IF automatic = 1      {restore margin values}
      THEN BEGIN
             leftmargin := lm;
             left := spaces(leftmargin);
             rightmargin := rm;
             right := spaces(rightmargin);
        END;
    menu;
  END;

PROCEDURE quit;       {restores default conditions on printer}
  BEGIN
    IF nout = 1
      THEN BEGIN
             writeln(lst,'saveobj2 restore');
             writeln(lst,'saveobj1 restore');
             write(lst,'');
      END
      ELSE BEGIN
             writeln(sink,'saveobj2 restore');
             writeln(sink,'saveobj1 restore');
             write(sink,'');
      END;
      IF nout = 2
        THEN close(sink);
    clrscr;
    halt;
  END;

PROCEDURE action;
  BEGIN
    CASE option OF
      '0': setfontsize;
      '1': setlinespacing;
      '2': BEGIN
             IF pagefeed = 1
               THEN pagefeed := 2
               ELSE pagefeed := 1;
             gotoxy(36,6);
             write(onoff[pagefeed],'      ');
             optionline;
           END;
      '3': BEGIN
             nfont := (nfont MOD 33 + 1) MOD 34;
             gotoxy(36,7);
             write(font[nfont],'                      ');
             optionline;
           END;
      '4': BEGIN
             bfont := (bfont MOD 33 + 1) MOD 34;
             gotoxy(36,8);
             write(font[bfont],'                      ');
             optionline;
           END;
      '5': BEGIN
             IF header=1
               THEN header := 2
               ELSE header := 1;
             gotoxy(36,9);
             write(onoff[header],'      ');
             optionline;
           END;
      '6': BEGIN
             IF nout=1
               THEN nout := 2
               ELSE nout := 1;
             gotoxy(36,10);
             write(output[nout],'                  ');
             optionline;
           END;
      '7': settopmargin;
      '8': setbottommargin;
      '9': BEGIN
             IF automatic=1
               THEN automatic := 2
               ELSE automatic := 1;
             gotoxy(36,13);
             write(onoff[automatic],'    ');
             optionline;
           END;
      'l': setleftmargin;
      'L': setleftmargin;
      'r': setrightmargin;
      'R': setrightmargin;
      'F': get_file;
      'f': get_file;
      'G': IF filename <> ''
             THEN printfile;
      'g': IF filename <> ''
             THEN printfile;
      'Q': quit;
      'q': quit;
      'p': setpageformat;
      'P': setpageformat;
    END;
END;

BEGIN
  init;
  menu;
  REPEAT
    gotoxy (35,entryline);
    REPEAT
      read (kbd,option)
    UNTIL option
               IN ['0','1','2','3','4','5','6','g','G','q','Q','7','8','f','F',
                    'r','R','l','L','9','p','P'];
    action;
  UNTIL hellfreezesover = true;
END.

------------------------

Al Stangenberger                    Dept. of Forestry & Resource Mgt.
forags@violet.berkeley.edu          145 Mulford Hall - Univ. of Calif.
uucp:  ucbvax!ucbviolet!forags      Berkeley, CA  94720
BITNET: FORAGS AT UCBVIOLE          (415) 642-4424