#!/usr/local/bin/perl

#to-do
## -draft doesn't seem to work.
## -when it double-prints for overstriking, only print the in the lines
##  as much as is needed for the overstriking.
## -if input is only one page, make default '-1'

##
## BLURB:
## A filter to convert from text to pretty PostScript.
## It is meant as a much more flexible replacement for the 'a2ps' by
## Miguel Santana (miguel@imag.imag.fr).  This program uses none of
## his code, though.
##
##
## Jeffrey Friedl (jfriedl@omron.co.jp)
## Omron Corp.
## Sep-91
##
##
## General usage is
##	a2ps [options] [files ...]
## There are an unbelievable number of options... see the man page.
##
## This code has been written so that if the user makes any errors in
## argument specification, no stdout is generated (only an error message
## to stderr).
##
## This file really contains two seperate programs... this perl program
## and the PostScript canned code (the <DATA> to the perl program) that
## is used by it.  The PostScript canned code is meant to be as flexable
## as possible, in case someone wants to use it for something similiar.
##
## December 1994 update: I've recently really learned Postscript, and I see
## that I do some Bad PostScript Things with this program. Sorry.
##
##

##
## HISTORY
## $version = "960205.5 ";
##  960205.5 reduced output volume for non-bold lines.
##  
##  941030.4 Added support for vt100/xterm underline escape sequences.
##
##  941024.3 ack! Just realized that -a4 didn't work
##
##  Thu Apr 23 13:30:58 EDT 1992 jfriedl@omron.co.jp
##  Made tabs print right when combined with -n (line numbers).
##
##  Sep 91 jfriedl@omron.co.jp
##  PDN (pretty darn nice) version generally done.
##

## To-do
# draft doesn't seem to work.
# 
# when it double-prints for overstriking, only print the in the lines
# as much as is needed for the overstriking.
#
# if input is only one page, make default '-1'
#
# Have -lp or -cl automatically adjust to a 'reasonable' value based upon
# the other (a particular character ratio could be used).
#


##
## Prepend any args found in the environmental variable A2PS_INIT to
## the list of args.  If it looks simple to split, we'll just do it
## ourselves. However, if there are special characters (quoting, etc),
## we'll let the shell do it.
##
## If there is an arg "-ninit" on the command line, A2PS_INIT is not used.
##
if (($_ = $ENV{'A2PS_INIT'}) && !grep($_ eq '-ninit', @ARGV)) {
    local(@extra_args);
    if (m/[^\w\s!@#%^-_=+~.,:]/) {
	## characters meaningful to the shell... must pass to /bin/sh
	@extra_args = qx{for arg in $_; do echo \$arg; done};
#	@extra_args = qx{/bin/sh -c 'for arg do echo \$arg; done' x $_};
	die "$0: Error in call to shell to parse\n" .
	    "env. var 'A2PS_INIT' value: $_\n" if $? != 0;
	chop (@extra_args);
    } else {
	## Nothing special... we can do ourselves. Split on whitespce.
	@extra_args = split;
    }
    ## If there is an arg "-init" on the command line, the arguments taken
    ## from A2PS_INIT will be printed to stderr (as well as be used).
    if (grep($_ eq '-init', @ARGV)) {
	local($count) = 0;
	grep(print(STDERR "$0: init arg #".++$count.": $_\n"), @extra_args);
    }
    unshift(@ARGV, @extra_args);
}

## Check options requested, etc.
&FigureOptions();
unshift(@ARGV, '-') if $#ARGV < $[;	#default is standard input

## Do a quick pre-check to see if all the files exist. "-" is stdin.
foreach $file (@ARGV) {
	local($name) = (($file eq '-') ? 'stdin' : qq/file "$file"/);
	open(TEST, "<$file") || die "$0: can't open \"$file\" for read.\n";
	die qq/$0: $name is empty... use '-z' to print anyway.\n/ if
		-z $file && ($file ne "-") && ($opt_empty_file_bad eq 'true');
	die "$0: $file doesn't seem to be text... use '-b' to print anyway.\n"
		 if ($opt_print_binary_files eq 'false') && -B TEST;
}

## Check for errors in any -hbar or -vbar argument.
@show_bar_routine = &ShowBars;

##
## Print out the PostScript preamble.
## This contains our selected options and choices.
## It will be followed by the canned PostScript program selects
## default options, and uses them all to profide functions for priting.
## This finally is followed by the use of the functions to show text,
## kick out new pages, etc.
##
## The canned PostScript code will select default options for most of
## the following, but we set them anyway since we know them.
##


push(@fonts, "Courier");
push(@fonts, "Times-Bold") if $opt_show_header eq 'true';
push(@fonts, "Helvetica") if $opt_date eq 'true';
push(@fonts, "Times-Roman") if ($opt_big_page_nums eq 'true')
			       || defined($opt_draft);

print "%!PS-Adobe-1.0
%%Pages: (atend)
%%DocumentFonts: @fonts
%%EndComments
% This file generated by $0
 /inch {72 mul} bind def
 /LinesPerPage# $opt_linesperpage def
 /CharsPerLine# $opt_charsperline def
 /ChopLongLines? false def % may be chopped by the prog, but not by the PS code
 /TwoPages? $opt_2 def
 /FilesRenumbered? $opt_renumber_sheets def
 /WantBoxes? $opt_boxes def
 /ShowSheetNum? $opt_number_sheets def
 /ShowPageNum? $opt_show_page_num def
 /ShowDate? $opt_date def
 /MarkEOL? $opt_mark_eol def
 /ShowBigPageNum? $opt_big_page_nums def
 /ShowTitle? $opt_show_title def
 /ShowHeader? $opt_show_header def
 /ShowLegend? $opt_show_legend def
";
printf(" /EOLmark  (\\%03o) def\n", $opt_eolmark) if $opt_mark_eol eq 'true';
printf(" /ChopMark (\\%03o) def\n", $opt_chopmark) if
	($opt_mark_chop eq 'true') && ($opt_fold_lines eq 'false');
printf(" /FoldMark  (\\%03o) def\n", $opt_foldmark) if
	$opt_mark_fold eq 'true' && ($opt_fold_lines eq 'true');

## Optional options (hence the name) we set only if specifically requested.
## If not set, the canned PostScript code will select "reasonable" defaults.

print " /WantLandscape? false def\n" if defined($opt_lport);
print " /WantLandscape? true  def\n" if defined($opt_lland);
print " /DateText ( ". &GetDate .") def\n" if $opt_date eq 'true';
print " /DraftText ($opt_draft) def\n" if defined($opt_draft);
print " /TopMargin#    $opt_ptm def\n" if defined($opt_ptm);
print " /BottomMargin# $opt_pbm def\n" if defined($opt_pbm);
print " /LeftMargin#   $opt_plm def\n" if defined($opt_plm);
print " /RightMargin#  $opt_prm def\n" if defined($opt_prm);
print " /CenterMargin# $opt_pcm def\n" if defined($opt_pcm);
print " /LogicalPageTopMargin#    $opt_ltm def\n" if defined($opt_ltm);
print " /LogicalPageBottomMargin# $opt_lbm def\n" if defined($opt_lbm);
print " /LogicalPageLeftMargin#   $opt_llm def\n" if defined($opt_llm);
print " /LogicalPageRightMargin#  $opt_lrm def\n" if defined($opt_lrm);
print " /SegregatedFiles? $opt_seg def\n" if defined($opt_seg);
printf(" /DraftTextGray# %f def\n",$opt_draft_gray/100) if defined($opt_draft_gray);
printf(" /BigNumGray# %f def\n",$opt_bn_gray/100)    if defined($opt_bn_gray);
printf(" /HorizBarGray# %f def\n",$opt_hbar_gray/100)if defined($opt_hbar_gray);
printf(" /VertBarGray# %f def\n",$opt_vbar_gray/100) if defined($opt_vbar_gray);
printf(" /SheetHeight#  %.0f def\n", $opt_sheetheight);
printf(" /SheetWidth#  %.0f def\n",  $opt_sheetwidth);

## print the canned PostScript code.
&PrintHeader();

## Print the routine to show gray bars (if there is one).
## We'll temporarily set the output-field-separator to newline for this.
$tmp = $,; $, = "\n";
print @show_bar_routine;
$, = $tmp; undef @show_bar_routine;

## If we're to squish lines:
##   now that we've told the PS code how long lines are, we'll fool ourselves
##   into thinking the line length is longer (as long as the squish
##   line-length).  This will cause us to pass lines up to that length
##   to the PS code to be squished if need be.
##
##   As a special case, if the first character of the squish value
##   is '+', we'll use that to _extend_ the length of the line.
##
if ($opt_squishlines =~ m/^\+/) {
    $opt_charsperline += $opt_squishlines;
} elsif ($opt_squishlines > $opt_charsperline ) {
    $opt_charsperline = $opt_squishlines;
}

## If we're acting like "cat -v", the characters that we'll pay attention
## to change depending upon $opt_special_chars. We'll make that distinction
## here, to save having to do it later.
if ($opt_catv eq 'true') {
    $vlist = ($opt_special_chars eq 'true')
	 ? '[\000-\007\012\013\015-\037\177-\377]'
	 : '[\000-\037\177-\377]';
}

##
## Run through the arguments (list of files), printing each.
##
$SIG{'INT'} = 'cleanup' if defined($opt_tmpfile);
sub cleanup { unlink "$opt_tmpfile"; exit 1;}

$sheetnum = 0;
$logicalpagecounter = 0;

while (($ARGV = shift) ne '') {
    open(INFILE, "<$ARGV") || die "$0: can't open \"$ARGV\"\n";

    ## if the title text is not null
    ##   use it
    ## otherwise, use the filename if it is not "-" (in which case use nothing)

    &NewFile(($opt_title_text ne '') ? $opt_title_text
				     : (("$ARGV" eq '-') ? '' : "$ARGV"));
    close(INFILE);
}
print "ForceNewSheet\n"; # Force the last sheet to be kicked out.
print "%%Trailer\n";
print "%%Pages: $pagenum\n";
exit 0;

##
## Process a file. First (and only) arg is the title to use.
##
sub NewFile
{
    local($title) = @_;	         ## Title to print in the header.
    local($linenum) = 0;         ## Line number in the current logical page.
    local($printedlinenum) = 0;  ## Line number of the file being printed.
    local($pagenum) = 0;         ## Logical page number being printed.
    local($guaranteedtext) = 0;  ## Used in stripping trailining lines.
    local($cl);	## Current Line ... line currently being massaged for output
    local($ul);	## Underline Line ... copy of $cl (see BackSpace code below)
    local($bl); ## Bold Line;
    local(@PreReadLines);	 ## see getline below.
    local($len2print, $part2print);
    local($line_number_offset) = 0;

    ##
    ## Normally, we read from <INFILE> only. However, in certain cases
    ## we'll want to peek forward in the file, but then go back and
    ## continue from where we left off. We can use tell() and seek() if
    ## it's a real file.  Otherwise, we'll save what we read as we peek
    ## ahead, and put them into @PreReadLines.
    ##
    ## Thus, 'getline' should return the first line in @preReadLines if
    ## it exists. Otherwise, return from <INFILE>
    ##
    sub getline
    {
	if (defined(@PreReadLines)) {
	    local($line) = shift(@PreReadLines);
	    return $line if defined($line);
	    undef(@PreReadLines);
	}
	## No pre-read lines (or none left).. actually read the next line.
	return ($line = <INFILE>);
    }

    $logicalpagecounter++;
    if ((defined($opt_seg) && $opt_seg eq 'true') || $opt_renumber_sheets eq 'true')
    {
	$logicalpagecounter++ if ($opt_2 ne 'true') || !($logicalpagecounter & 1);
    }
    if ($opt_2 ne 'true' || ($logicalpagecounter & 1)) {
	$sheetnum++;
	print "%%Page: ? $sheetnum\n";
	$firstpageoffile = 1;
    }
    print "($title) NewFile\n";

    ## If we're going to be printing to a temporary file,
    ## open it now and divert further output to it.

    if (defined($opt_tmpfile)) {
	if (open(TMP, ">$opt_tmpfile")) {
	    select(TMP);
	} else {
	    warn "$0: can't open temp file \"$opt_tmpfile\",\n" .
		 "trying again with -ntmp\n";
	    undef($opt_tmpfile);
	}
    }

    undef($cl); ## "current line" being massaged for output.
    undef($ul); ## copy of $cl for underlining (it'll make sense later).
    undef($bl); ## copy of $cl for embolding.

    ##
    ## Forever, or at least until we run out of file to print....
    ## This is the main output loop.
    ##
    for (;;) {
	##
    	## If we have no current line, try to read one from the file.
	## If the line is blank, and we're stripping trailing blank lines,
	## peek forward in the file to see if there is any more real text,
	## and quit if there's not.
	##
	if (!defined($cl))
	{
	    last if !($cl = &getline);	## Read the next line
	    chop $cl; # remove newline	## Chuck the NL

	    ## If stripping trailing whitespace from each line, do it now.
	    $cl =~ s/\s+$// if $opt_strip_trail_blanks eq 'true';

	    ##
	    ## If we wish to strip trailing blank lines, we do it as follows:
	    ##      If we have a blank line
	    ##   	Peek forward in the file, line-by-line for
	    ##		either a non-blank line, or the end of the file.
	    ##		If we reach the end of the file,
	    ##		    stop processing this file immediately.
	    ##		If we find text, note the location at which
	    ##		we are guaranteed to find text.
	    ##
	    ## The last item (guaranteed text) is so that we don't have
	    ## to bother checking if the subsequent intervening blank
	    ## lines should be stripped, as we know that all blank lines
	    ## up to a certain point (the line pointed-to by 'guaranteedtext')
	    ## should not be stripped.  This is an important optimization
	    ## for long spans of blank lines that are followed by some text.
	    ##
	    if (($opt_strip_trail_bl_lines eq 'true') &&
		$guaranteedtext <= $printedlinenum && $cl =~ m/^\s*$/)
	    {
		## An empty line... peek to see if this is one of some
		## number of trailing blank lines.
		local($more2come) = 'false';
		local(@tmp_PreReadLines);

		## Note our spot in the input file.
		local($mark) = (-f INFILE) ? tell(INFILE) : 0;

		$guaranteedtext = $printedlinenum;

		while(($more2come eq 'false') && ($_ = &getline)) {
		    if (m/\S/) {
			## We found more text, so we'll go back to our
			## file marker and note that we indeed have more.
			seek(INFILE, $mark, 0)      if $mark != 0;
			push(@tmp_PreReadLines, $_) if $mark == 0;
			$more2come = 'true';
		    } else {
			## Although we don't know if we'll find more text
			## or not (we didn't this line, that's for sure),
			## we'll update $guaranteedtext so that IF we DO
			## find more text, it'll be set.  IF we DON'T find
			## more text, we'll be returning right away, and
			## the value of this variable won't matter.
		        $guaranteedtext++;
			if ($mark == 0) {
			    ## We're saving lines. May as well save space
			    ## and strip trailing blanks now...
			    $_ = "\n" if $opt_strip_trail_blanks eq 'true';
			    push(@tmp_PreReadLines, $_);
			}
		    }
		}
 		## If we had no more, we're done now.
		last if $more2come eq 'false';
		push(@PreReadLines, @tmp_PreReadLines);
 	    }

	    ## Prepend the line number if so requested.
	    ++$printedlinenum;
	    if ($opt_number_lines eq 'true') {
		local($tmp) = sprintf('%4d ', $printedlinenum);
		$line_number_offset = length($tmp); #note the length
	        $cl = $tmp . $cl; ##prepend the number
	    }

	    ####
	    #### If any VT100 escape codes for underining or bold,
	    #### pluck them as well.
	    ####
	    if ($cl =~ m/\e\[[41]m/) {
		$ul = $cl; ## copy into $ul (see description below).
		$bl = $cl;

		$cl =~ s/\e\[\d*m//g; ## In $cl, them all;
		$ul =~ s/\e\[[0123 56789]m//g;
		$bl =~ s/\e\[[0 23456789]m//g;

		$ul =~ s/\e\[4m([^\e]*)\e\[m/'_'  x length($1)/eg;
		$bl =~ s/\e\[1m([^\e]*)\e\[m/"\0" x length($1)/eg;

		$ul =~ s/\e\[\d*m//g; ## remove anything left over
		$bl =~ s/\e\[\d*m//g;

		undef $bl if $bl eq $cl;
		undef $ul if $ul eq $cl;
	    }

	    ##
	    ## If we're transforming control characters a'la "cat -v",
	    ## cycle through all control characters present and replace
	    ## them with their corresponding escape sequence.
	    ##
	    if (($opt_catv eq 'true') && $cl =~ m/$vlist/o) {
		$cl =~ s/($vlist)/sprintf("\\%03o", unpack('C', $1))/eo;
		$ul =~ s/($vlist)/sprintf("\\%03o", unpack('C', $1))/eo
			if defined $ul;
		$bl =~ s/($vlist)/sprintf("\\%03o", unpack('C', $1))/eo
			if defined $bl;
	    }

	    ##
	    ## If we're doing magic things with backspace, and if this
	    ## line has a backspce, we'll do our stuff..
	    ##
	    if (($opt_special_chars eq 'true') && $cl =~ m//)
	    {
		##
		## If the line has a backspace, we'll assume that it's for
		## the purpose of overstriking (most likely underlineing).
		## We'll transform the one line with the backspace(s) into
		## two lines... one without the backspaces nor what was
		## backed over, and another without the backspaces nor
		## what was written over what was backed-over. For example,
		##
		##    an under^H^H^H^H^H_____lined word		<ORIG $CL
		##
		## would be transformed into the two lines:
		##
		##    an _____lined word                        <NEW $CL
		##    an underlined word			<NEW $UL
		##
		## When we write the two, we'll overwrite them, and it'll
		## appear as intended.  There are two ways to do
		## underlining... that show above, and that as shown by
		##
		##    an u^H_n^H_d^H_e^H_r^H_lined word
		##
		## which would be transformed into the same two lines as
		## the first example.
		##
		$ul = $cl if !defined $ul; # get a copy to transform.

		## Get rid of the backspace, and what they back over, from $cl
		1 while $cl =~ s/[^]//;
		1 while $bl =~ s/[^]//;

		## This one's a bit more difficult... remove the backspaces,
		## and what would be written after them, from $ul.
		while ($ul =~ m/(+)/, $count = length($1)) {
		   last if !($ul =~ s/{$count}[^]{$count}//);
		}
	    }

	    ####
	    ####
	    ####  Now we have $cl, and perhaps a somewhat-changed copy $ul.
	    ####  And perhaps a $bl.

	    ## Processing for tabs, if there are any and we're doing them.
	    if (($opt_special_chars eq 'true') && $cl =~ m/\t/)
	    {
		local($loc, $replacement);
		while ($loc = index($cl, "\t"), $loc >= 0) {
			$loc -= $line_number_offset;
			$replacement = ' ' x ($opt_tab - $loc % $opt_tab);
			$cl =~ s/\t/$replacement/;
		}
	    }
	    ## Same for $ul, if there is a $ul.
	    if (defined($ul) && ($opt_special_chars eq 'true') && $ul =~ m/\t/)
	    {
		local($loc, $replacement);
		while ($loc = index($ul, "\t"), $loc >= 0) {
			$replacement = ' ' x ($opt_tab - $loc % $opt_tab);
			$ul =~ s/\t/$replacement/;
		}
	    }
	    ## Same for $bl, if there is a $bl.
	    if (defined($bl) && ($opt_special_chars eq 'true') && $bl =~ m/\t/)
	    {
		local($loc, $replacement);
		while ($loc = index($bl, "\t"), $loc >= 0) {
			$replacement = ' ' x ($opt_tab - $loc % $opt_tab);
			$bl =~ s/\t/$replacement/;
		}
	    }
	} else {
	    ##
	    ## We stil had some line left over from the previous one.
	    ## Some long line was folded, and $cl (and perhaps an associated
	    ## $ul and/or $bl) is what was not printed (and hence folded).
	    ##
	    ## If we're numbering lines, we must add a blank left margin
	    ## so that we don't print where the line number would go in
	    ## a non-folded line.
	    ##
	    if ($opt_number_lines eq 'true') {
	        $cl = '     ' . $cl;
	        $ul = '     ' . $ul if defined($ul);
	        $bl = '     ' . $bl if defined($bl);
	    }

	    ## If we're flushing right, prepend padding.
	    if (($opt_flush_left eq 'false') &&
	       ($pad = $opt_charsperline - length($cl)) > 0) {
	        $cl = (' ' x $pad) . $cl;
	        $ul = (' ' x $pad) . $ul if defined($ul);
	        $bl = (' ' x $pad) . $bl if defined($bl);
	    }
	}

	####
	#### Now have a line (or more if $ul and/or $bl is defined)
	####  to put out.
	####

	## If it's the first on the page, issue the new page.
	if ($linenum == 0) {
	    if (!defined($firstpageoffile) &&
		(($opt_2 ne 'true') || (++$logicalpagecounter & 1))) {
			++$sheetnum;
			print "%%Page: ? $sheetnum\n";
	    }
	    undef($firstpageoffile);

	    ++$pagenum;
	    print "NewPage %page: $pagenum\n";
	    
	}

	##
	## Now to actually print the line.  If there is a $ul, that gets
	## printed first, but the page position is not moved.  $cl will
	## then be printed over it.
	##

	local($part2print);
	##
	## Choose how much of $cl (and $ul if it exists) to print:
	##   If we're not checking for special characters, or if we are
	##   but there are no form-feeds, the take a length up to
	##   charsperline characters.  Otherwise, take characters up to
	##   the form-feed.
	##
	(($opt_special_chars eq 'true')
	      && ($len2print = index($cl, "\f"), $len2print >= $[))
        || ($len2print = $opt_charsperline);

	if (defined($ul)) {
	    ## Select not that part of $ul to print (may be all of $ul).
	    $part2print = substr($ul, 0, $len2print);

	    ## Replace $ul with what will NOT be printed (if anything).
	    $ul = substr($ul, length($part2print));


	    ## Hide any PostScript-control characters.
	    $part2print =~ s/\s+$//; ## remove trailing spaces;
	    $part2print =~ s/([(\\)])/\\$1/g;

	    ## print.
	    print "($part2print) s\n";
	}

	if (defined($bl)) {
	    ## Select not that part of $bl to print (may be all of $bl).
	    $part2print = substr($bl, 0, $len2print);

	    ## Replace $bl with what will NOT be printed (if anything).
	    $bl = substr($bl, length($part2print));

	    for ($i = 0; $i < length($part2print); $i++) {
		substr($part2print, $i, 1) =
		substr($part2print, $i, 1) eq "\0" ? substr($cl, $i, 1) : " ";
	    }

	    ## Hide any PostScript-control characters.
	    $part2print =~ s/\s+$//; ## remove trailing spaces;
	    $part2print =~ s/([(\\)])/\\$1/g;

	    ## print.
   if ($part2print !~ m/^\s*$/) {
       print "gsave  mBoldDelta mBoldDelta rmoveto ($part2print) s grestore\n";
       print "gsave           0  BoldDelta rmoveto ($part2print) s grestore\n";
       print "gsave   BoldDelta mBoldDelta rmoveto ($part2print) s grestore\n";
   }
	}

	##
	## Now do the same with $cl...
	##
	$part2print = substr($cl, 0, $len2print);
	$cl = substr($cl, length($part2print));
	$part2print =~ s/([(\\)])/\\$1/g;

	if ($cl =~ /^[^\f]/) {
	    if ($opt_fold_lines eq 'true') {
		print "/IgnoreNextEOL? true def\n";
		print "/ShowFoldMark? true def\n" if $opt_mark_fold eq 'true';
	    } else {
		print "/ShowChopMark? true def\n" if $opt_mark_chop eq 'true';
	    }
	}
	print "($part2print)S\n";

	##
	## If we're looking out for formfeeds, shove a new line if
	## we see one.
	##
	## If we're done with this line (either because we printed all
	## there is, or we're not wrapping), mark them done (or, more
	## precicely, unmark them undone).
	##
	if (($opt_special_chars eq 'true') && $cl =~ /^\f/) {
		$cl = substr($cl, 1);		## nib the ff off
		$ul = substr($ul, 1) if defined($ul);
		$linenum = $opt_linesperpage;	## force an endpage out.
	} elsif (($opt_fold_lines eq 'false') || ("$cl" eq '')) {
		undef($cl);
		undef($ul);
	}

	## if we're at the end of a page, chuck it out.
	if (++$linenum >= $opt_linesperpage) {
		print "EndPage\n";
		$linenum = 0;
	}
    }

    ## clean up the last page..
    print "EndPage\n" if $linenum != 0;

    ##
    ## Now we've processed the complete file, and know the number of logical
    ## pages printed.  If we sent the processed file to a temporary file,
    ## pre-output the total number of pages, followed by the processed output
    ## from the temporary file.
    ##
    ## Then, redirect output back to stdout.
    ##
    if (defined($opt_tmpfile)) {
	select(STDOUT);			      ## Redirect output to stdout.
	print "/TotalPages# $pagenum def\n";  ## Pre-output the page total.
	close(TMP);
	## reopen tmp, dump the contents to stdout, reclose tmp, remove it.
	open(TMP,"<$opt_tmpfile")
		|| die "$0: can't reopen temporary file \"$opt_tmpfile\".\n";
	print $_ while ($_ = <TMP>);
	close(TMP);
	unlink "$opt_tmpfile";
    }
}


##############################################################################
##############################################################################

sub FigureOptions
{
    # set defaults:
    $opt_2 = 'true';			# two pages per sheet.
    $opt_number_lines = 'false';		# don't number lines.
    $opt_fold_lines = 'true';		# fold lines.
    $opt_flush_left = 'false';		# flush right folded lines.
    $opt_catv = 'true';			# act like cat -v.
    $opt_special_chars = 'true';		# interperet TAB, BS, etc.
    $opt_renumber_sheets = 'false';	# don't renumber sheets per file.
    $opt_boxes = 'true';			# put boxes around logical pages.
    $opt_show_header = 'true';		# show header
    $opt_show_title = 'true';		# show title in header
    $opt_title_text = '';		# null means to use the file name.
    $opt_tab = 8;			# chars between tab stops.
    $opt_number_sheets = 'true';		# use sheet numbers.
    $opt_show_page_num = 'true';		# show page numbers.
    $opt_big_page_nums = 'false';		# don't show BIG page number.
    $opt_date = 'true';			# show date.
    $opt_strip_trail_bl_lines = 'true';	# strip a file's trailing blank lines.
    $opt_strip_trail_blanks = 'true';	# strip a line's trailing whitespace
    $opt_charsperline = 85;		# char per line.
    $opt_linesperpage = 75;		# lines per page.
    $opt_squishlines = 0;		# no lines to squish.
    $opt_tmpfile = "/tmp/a2ps.tmp.$$";	# temporary-file name
    $opt_mark_eol = 'false';		# put a mark at the EOL point.
    $opt_mark_fold = 'false';		# mark where lines have been folded
    $opt_mark_chop = 'true';		# mark where lines have been chopped
    $opt_chopmark = 0266;		# paragraph mark... very visual
    $opt_eolmark =  0267;		# bullet
    $opt_foldmark = 0250;		# circle with cross
    $opt_show_legend = 'true';		# show meaning of various marks.
    $opt_empty_file_bad = 'true';		# die if a file to print has zero size
    $opt_sheetheight= 11  *72;		# 11 inches high
    $opt_sheetwidth =  8.5*72;		# 8.5 inches wide (USA defaults)
    $opt_print_binary_files = 'false';	# won't try to print non-text files

    ##
    ## Returns a length (in points) as represented by ARGV[0]
    ## (which is shifted). A lone number, or one with 'i' appended, is taken
    ## as inches (there are 72 points/inch).  A number with 'c' or 'cm'
    ## appended is taken as centimeters (28.346456 points/cm).  A number
    ## with 'p', 'pt', 'pts', or 'ps' appended is taken as a raw point value.
    ##
    sub LenArg
    {
	$_ = shift(@ARGV);
	die(qq/$0: expecting argument to "$ARGV".\n/) if (m/^-./i);
	return int($1 * 72        + 0.5) if (m/^\s*(\d+)\s*i?\s*$/i);
	return int($1 * 28.346456 + 0.5) if (m/^\s*(\d+)\s*cm?\s*$/i);
	return int($1) if (m/^\s*(\d+)\s*pt?s?\s*$/);
	die(qq/$0: don't understand "$_" arg to "$ARGV"\n/) if (m/^\s*\d/i);
	die(qq/$0: expecting length argument to "$ARGV"\n/);
    }

    ##
    ## If $ARGV[0] is not a flag, shift it and return it.  Otherwise,
    ## return the first arg to the subroutine, which can be thought of
    ## as a default argument.
    ##
    sub OptStringArg
    {
	return $_[0] if $ARGV[0] =~ m/^-./;
	return shift(@ARGV);
    }

    ##
    ## Returns and shifts the integer $ARGV[0]. If it's not an integer,
    ## an error is reported. The integer must be greater than 0.
    ##
    sub IntArg
    {
	$_ = shift(@ARGV);
	die(qq/$0: expecting argument to "$ARGV".\n/) if (m/^-./i);
	return $1 if (m/^\s*(\+?[1-9][0-9]*)\s*$/);
	die(qq/$0: expecting integer argument to "$ARGV"\n/);
    }

    ##
    ## Like IntArg but accepts an octal number.
    ##
    sub OctalArg
    {
	$_ = shift(@ARGV);
	die(qq/$0: expecting argument to "$ARGV".\n/) if (m/^-./i);
	return oct("$1") if (m/^\s*0*([1-7][0-7]*)\s*$/);
	die(qq/$0: expecting octal argument to "$ARGV"\n/);
    }

    while (($ARGV[0] =~ m/^-./) && ($ARGV = shift(@ARGV)))
    {
	## two/one logical page/sheet
	if    ($ARGV eq '-2') {$opt_2 = 'true';}
	elsif ($ARGV eq '-1') {$opt_2 = 'false';}

	## do/don't number lines a'la "cat -n"
	elsif ($ARGV eq '-n')  {$opt_number_lines = 'true';}
	elsif ($ARGV eq '-nn') {$opt_number_lines = 'false';}

	## do/don't fold long lines [fold/chop long lines]
	## don't/do chop long lines.
	elsif (($ARGV eq '-f') || ($ARGV eq '-nc'))  {$opt_fold_lines = 'true';}
	elsif (($ARGV eq '-nf' || ($ARGV eq '-c')))  {$opt_fold_lines = 'false';}

	## flush folded partial-lines left/right
	elsif ($ARGV eq '-fl') {$opt_flush_left = 'true';}
	elsif ($ARGV eq '-fr') {$opt_flush_left = 'false';}

	## do/don't print a'la "cat -v"
	elsif ($ARGV eq '-v')  {$opt_catv = 'true';}
	elsif ($ARGV eq '-nv') {$opt_catv = 'false';}

	## do/don't do special stuff with BS, FF, TAB
	elsif ($ARGV eq '-i')  {$opt_special_chars = 'true';}
	elsif ($ARGV eq '-ni') {$opt_special_chars = 'false';}

	## set physical Top, Bottom, Left, Right, Center margin
	## (center margin is space between two logical pages)
	elsif ($ARGV eq '-ptm') {$opt_ptm = &LenArg;}
	elsif ($ARGV eq '-pbm') {$opt_pbm = &LenArg;}
	elsif ($ARGV eq '-plm') {$opt_plm = &LenArg;}
	elsif ($ARGV eq '-prm') {$opt_prm = &LenArg;}
	elsif ($ARGV eq '-pcm') {$opt_pcm = &LenArg;}

	## set Top, Bottom, Left, Right margin within logical page
	elsif ($ARGV eq '-ltm') {$opt_ltm = &LenArg;}
	elsif ($ARGV eq '-lbm') {$opt_lbm = &LenArg;}
	elsif ($ARGV eq '-llm') {$opt_llm = &LenArg;}
	elsif ($ARGV eq '-lrm') {$opt_lrm = &LenArg;}

	## set the width/height.
	## -usa gives 8.5"/11", -a4 gives A4 size.
	elsif ($ARGV eq '-sw')  {$opt_sheetwidth = &LenArg;}
	elsif ($ARGV eq '-sh')  {$opt_sheetheight = &LenArg;}

	elsif ($ARGV eq '-usa') {$opt_sheetheight=11*72;$opt_sheetwidth=8.5*72;}
	elsif ($ARGV eq '-a4')  {$opt_sheetheight=841; $opt_sheetwidth = 594;}

	## -lport = force portrait layout
	## -lland = force landscape layout
	## -ldef  = choose default (based upon pages/sheet)
	## -w     = one page wide landscape printing
	elsif ($ARGV eq '-lport') {$opt_lport = 'true'; undef($opt_lland); }
	elsif ($ARGV eq '-lland') {$opt_lland = 'true'; undef($opt_lport); }
	elsif ($ARGV eq '-ldef')  {undef($opt_lland); undef($opt_lport); }
	elsif ($ARGV eq '-w') {
		$opt_2 = 'false';
		$opt_lland = 'true'; undef($opt_lport);
		$opt_charsperline = int(0.5 + $opt_charsperline *
			(($opt_sheetheight / $opt_sheetwidth) ** 2));
	}

	## do/don't renumber sheets on a per-file basis
	elsif ($ARGV eq '-r')  {$opt_renumber_sheets = 'true';}
	elsif ($ARGV eq '-nr') {$opt_renumber_sheets = 'false';}

	## -seg  = force each file to be segregated to its own set of sheets
	## -nseg = force an unused leftover logical page to be used as
	##         the first logcal page of the next file
	## -defseg = default (-r -> -seg, -nr -> -nseg)
	elsif ($ARGV eq '-seg')    {$opt_seg = 'true'; }
	elsif ($ARGV eq '-nseg')   {$opt_seg = 'false';}
	elsif ($ARGV eq '-defseg') {undef($opt_seg); }

	## do/don't write "draft" all across the page
	## If "do", an optional text arg says what to write.
	elsif ($ARGV eq '-draft')  {$opt_draft = &OptStringArg('draft');}
	elsif ($ARGV eq '-ndraft') {undef($opt_draft);}

	## do/don't show boxes surrounding the logical pages.
	elsif (($ARGV eq '-box')  || ($ARGV eq '-ns')) {$opt_boxes = 'true';}
	elsif (($ARGV eq '-nbox') || ($ARGV eq '-s'))  {$opt_boxes = 'false';}

	## do/don't show the logcial-page header
	elsif ($ARGV eq '-h')   {$opt_show_header = 'true';}
	elsif ($ARGV eq '-nh')  {$opt_show_header = 'false';}

	## do/don't show the title.
	## If "do", an optional text arg says what to write if not the filename
	elsif ($ARGV eq '-nT')  {$opt_show_title = 'false';}
	elsif ($ARGV eq '-T')   {$opt_show_title = 'true';
			         $opt_title_text = &OptStringArg('');}

	## "-t ##" or "-t##" set the tab-stop (default 8, obviously)
	elsif ($ARGV eq '-t')    {$opt_tab = &IntArg;}
	elsif ($ARGV =~ '^-t([1-9][0-9]*)$') {$opt_tab = $1;}

	## do/don't number sheets.
	elsif ($ARGV eq '-sn')  {$opt_number_sheets = 'true';}
	elsif ($ARGV eq '-nsn') {$opt_number_sheets = 'false';}

	## do/don't show the BIG page number
	elsif ($ARGV eq '-bn')  {$opt_big_page_nums = 'true';}
	elsif ($ARGV eq '-nbn') {$opt_big_page_nums = 'false';}

	## do/don't show the page number
	elsif ($ARGV eq '-pn')  {$opt_show_page_num = 'true';}
	elsif ($ARGV eq '-npn') {$opt_show_page_num = 'false';}

	## do/don't show the date.
	elsif ($ARGV eq '-d')  {$opt_date = 'true';}
	elsif ($ARGV eq '-nd') {$opt_date = 'false';}

	## do/don't strip trailing blank lines
	elsif ($ARGV eq '-stbl')  {$opt_strip_trail_bl_lines = 'true';}
	elsif ($ARGV eq '-nstbl') {$opt_strip_trail_bl_lines = 'false';}

	## do/don't strip trailing blanks from each line
	elsif ($ARGV eq '-stb')  {$opt_strip_trail_blanks = 'true';}
	elsif ($ARGV eq '-nstb') {$opt_strip_trail_blanks = 'false';}

        ## do/don't stip all trailing blanks and lines
	elsif ($ARGV eq '-strip')  { $opt_strip_trail_bl_lines =
				     $opt_strip_trail_blanks = 'true';}
	elsif ($ARGV eq '-nstrip') { $opt_strip_trail_bl_lines =
				     $opt_strip_trail_blanks = 'false';}

	## do/don't put a marker at the end of the line.
	elsif ($ARGV eq '-meol')  {$opt_mark_eol = 'true';}
	elsif ($ARGV eq '-nmeol') {$opt_mark_eol = 'false';}

	## do/don't put a marker at the end of a line that's been folded.
	elsif ($ARGV eq '-mfold')  {$opt_mark_fold = 'true';}
	elsif ($ARGV eq '-nmfold') {$opt_mark_fold = 'false';}

	## do/don't put a marker at the end of a line that's been chopped.
	elsif ($ARGV eq '-mchop')  {$opt_mark_chop = 'true';}
	elsif ($ARGV eq '-nmchop') {$opt_mark_chop = 'false';}

	## do all marking / do no marking
	## if marking, also asserts: -nstrip -fl
	##
	elsif ($ARGV eq '-mark') {
	    $opt_mark_chop = $opt_mark_fold = $opt_mark_eol = 'true';
	    $opt_strip_trail_bl_lines = $opt_strip_trail_blanks = 'false';
	    $opt_flush_left = 'true';
        }
	elsif ($ARGV eq '-nmark')
	    {$opt_mark_chop = $opt_mark_fold = $opt_mark_eol = 'false';}

	## accept an octal character code for the various marks
	elsif ($ARGV eq '-chopmark') {$opt_chopmark = &OctalArg;}
	elsif ($ARGV eq '-eolmark')  {$opt_eolmark  = &OctalArg;}
	elsif ($ARGV eq '-foldmark') {$opt_foldmark = &OctalArg;}

	elsif ($ARGV eq '-legend')  {$opt_show_legend = 'true';}
	elsif ($ARGV eq '-nlegend') {$opt_show_legend = 'false';}

	## set the characters per line , lines per page
	elsif ($ARGV eq '-cl') {$opt_charsperline = &IntArg;}
	elsif ($ARGV eq '-lp') {$opt_linesperpage = &IntArg;}

	##
	## Normally lines longer than the 'charsperline' value are either
	## folded or chopped (based upon other options).
	##
	## If '-squish ##' is given, lines longer than 'charsperline' BUT
        ## not longer than the '##' value are printed in an appropriately
	## smaller font to allow it to fit on the line.  Only lines longer
	## than the '##' value are folded/chopped.
	##
	## As a special case for the '##' value, if the first character
	## is '+', it is added to the 'charsperline' value.
	##
	elsif ($ARGV eq '-squish')  {$opt_squishlines = &IntArg;}
	elsif ($ARGV eq '-nsquish') {$opt_squishlines = 0;}

	## do/don't use a temporary file when printing.
	##
	## Normally, the PS output is temporairly dirvertd to a file
	## in order to determine the total number of pages printed (after
	## which the temp file is dumped to stdout).
	##
	## If a temp file is not used, the page number will print
	## as "Page X" rather than "Page X of Y".
	##
	## The option "-tmp" may be optionally followed by the name of
	## a temporary file to use.
	##
	elsif ($ARGV eq '-tmp')  {$opt_tmpfile = &OptStringArg("/tmp/a2ps.tmp.$$");}
	elsif ($ARGV eq '-ntmp') {undef($opt_tmpfile);}

	## do/don't allow printing of empty files
	elsif ($ARGV eq '-z')  { $opt_empty_file_bad = 'false'; }
	elsif ($ARGV eq '-nz') { $opt_empty_file_bad = 'true'; }

	## do/don't preappend the env. var. A2PS_INIT to the arg list.
	## These don't perform any actions.  The prescence or abscence
	## of "-ninit" will have been noted when A2PS_INIT was being checked,
	## as goes the same for "-init".  Thus here, just ignore these.
	elsif ($ARGV eq '-init')  { }
	elsif ($ARGV eq '-ninit') { }

	## Turn on vertical/horizontal gray bars.
	## See the subroutine "ShowBars" for info on the representation
	## of the optional arg allowed.
	elsif ($ARGV eq '-vbar')  {$opt_vert_bars = &OptStringArg('8');}
	elsif ($ARGV eq '-hbar')  {$opt_horiz_bars = &OptStringArg('4');}

	## Set the grayness of various things. Arg must be in range [1-99].
	elsif ($ARGV eq '-bngray')
	    { die "$0: '-bngray' arg out of range.\n"
		if ($opt_bn_gray = &IntArg)>99; }
	elsif ($ARGV eq '-vbargray')
	    { die "$0: '-vbargray' arg out of range.\n"
		if ($opt_vbar_gray = &IntArg)>99; }
	elsif ($ARGV eq '-hbargray')
	    { die "$0: '-hbargray' arg out of range.\n"
		if ($opt_hbar_gray = &IntArg)>99; }
	elsif ($ARGV eq '-draftgray')
	    { die "$0: '-draftgray' arg out of range.\n"
		if ($opt_draft_gray = &IntArg)>99; }

	## do/don't allow printing of binary files
	elsif ($ARGV eq '-b')  {$opt_print_binary_files = 'true';}
	elsif ($ARGV eq '-nb') {$opt_print_binary_files = 'false';}

	##
	## The pseudo-option '--' means "no more options".
	##
	elsif ($ARGV eq '--') { last; }

	else { die(qq/$0: unknown flag "$ARGV".\n/); }
    }
}

##
## Return the date as a string in a nicely readable format.
##
sub GetDate
{
    local($min, $hour, $mday, $mon, $year, $wday) = (localtime)[1..6];
    local($m, @days, @months);
    @days = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
    @months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep',
               'Oct', 'Nov', 'Dec');

    $m = $hour >= 12 ? 'pm' : 'am';
    $hour -= 12 if $hour > 12;
    return sprintf('%s, %s %d 19%02d, %d:%02d%s',
	$days[$wday], $months[$mon], $mday, $year, $hour, $min, $m);
}

sub PrintHeader
{
   print <DATA>;
}

##
## Generates the routine to show horizonal and vertical gray bars
## if any were requested.
##
## We want to output this routine after the canned PostScript code, but
## we want to generate beforehand so we can check for errors before
## we generate any output.
##
## To facillitate this, it will "print" to an array, and return that
## array to be actually printed later if there were indeed no errors.
##
sub ShowBars
{
    local(@x); ## ouput will accumulate in this array.

    ## Only have work to do if the user specified any bars.
    return @x if !defined($opt_horiz_bars) && !defined($opt_vert_bars);

    ##
    ## This interperts the argument given to both the horizontal and
    ## vertical bar options.
    ##     usage: InterpretBarArg(type, arg, max, routine)
    ## TYPE will be either 'horiz bar arg' or 'vert bar arg', and is used
    ##     for printing errors.
    ## ARG is the text of the argument itself.
    ## MAX is the maximum extent of the numbers.. either the number of chars
    ##     on a line (for vert bars) or lines on a page (for horiz bars).
    ## ROUTINE is either 'ShowHorizBars' or 'ShowVertBars' and indicates
    ##     which routine in the canned PostScript code to call.
    ##
    sub InterpretBarArg
    {
	local($type, $arg, $max, $routine) = @_;

	$arg =~ s/\s+//g; ## strip all blanks

	## Arg of the form "#" means: on and off every # units, starting off."
	## Arg of the form "+#" means: on and off every # units, starting on."
	if ($arg =~ /^(\+?)([1-9][0-9]*)$/) {
	    local($start, $stride, $width) = (($1 eq '+')?0:$2, $2*2, $2-1);
	    push(@x, "  $start $stride $max { dup $width add $routine } for");
	}

	## Arg of the form "#1.#2" means: on #1 units, off #2 units, start off.
	## Arg of the form "+#1.#2" means: on #1 units, off #2 units, start on.
	elsif ($arg =~ /^(\+?)([1-9][0-9]*)\.([1-9][0-9]*)$/) {
	    local($start, $stride, $width) = (($1 eq '+')?0:$2, $2+$3, $2-1);
	    push(@x,"  $start $stride $max { dup $width add $routine } for");
	}

	##
	## Otherwise, arg should be a comma-separeted list of ranges,
	## with units 1-based in nature (i.e. the line #1 is the top line).
	##
	## For example       -5,7,9,11-15,20-
	## Is the same as:   1,2,3,4,5,7,9,11,12,13,14,15,20,21....$max
	##
	## Since the PostScript commands that draw the bars are 0-based,
	## we'll subtract one from all the numbers.
	##
	else {
	  foreach $subarg (split(',', $arg)) {
	    die "$: empty sub-range in $type\n" if $subarg eq '';
	    if ($subarg =~ /^([1-9][0-9]*)$/) {
		push(@x,sprintf("  %d %d $routine", $1-1, $1-1));
	    } elsif ($subarg =~ /^-([1-9][0-9]*)$/) {
		push(@x,sprintf("  0 %d $routine", $1-1));
	    } elsif ($subarg =~ /^([1-9][0-9]*)-$/) {
		push(@x,sprintf("  %d %d $routine", $1-1, $max-1));
	    } elsif ($subarg =~ /^([1-9][0-9]*)-([1-9][0-9]*)$/) {
		die "$0: flipfloped range '$subarg' in $type\n" if ($2<$1);
		push(@x,sprintf("  %d %d $routine", $1-1, $2-1));
	    } else {
		die "$0: don't understand '$subarg' in $type\n";
	    }
	  }
	}
    }

    push(@x,"/ShowGrayBars\n{\n  gsave");
    if (defined($opt_vert_bars)) {
	push(@x,'  VertBarGray# setgray');
	&InterpretBarArg('vert. bar list', $opt_vert_bars,
		$opt_linesperpage, 'ShowVertBar');
    }
    if (defined($opt_horiz_bars)) {
	push(@x,'  HorizBarGray# setgray');
	&InterpretBarArg('horiz. bar list', $opt_horiz_bars,
		$opt_charsperline, 'ShowHorizBar');
    }
    push(@x,"  grestore\n} def");
    return @x;
}

__END__
%-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%- The text until the next long '%-%%%%%%' line static PS which is affected
%- by the defines leading up to here.
%-

% Just like 'def', but only defines if currently undefined.
/default {currentdict 2 index known false eq {def} {pop pop} ifelse} bind def

% returns true if the key on the stack is defined, false otherwise
/defined? {currentdict exch known} bind def

/inch   {72    mul} bind def
/cm     {28.35 mul} bind def

%
% STACK USAGE: <string> StringSize <xwidth> <yheight>
%
% Returns the true width and height of the string. If the string has
% descenders, the apparent (printed) height above the baseline won't be
% larger than strings without descenders. However, the height as returnd
% by this function WILL reflect that added true height.
%
/StringSize
{
    dup stringwidth pop exch
    gsave newpath 0 0 moveto false charpath pathbbox grestore
    /_string_size_y2 exch def pop
    /_string_size_y1 exch def pop
    _string_size_y2 _string_size_y1 sub
} bind def

% like above, but width value squishes out leading and trailing whitespace
/TrueStringSize
{
    gsave newpath 0 0 moveto false charpath pathbbox grestore
    /_string_size_y2 exch def /_string_size_x2 exch def
    /_string_size_y1 exch def /_string_size_x1 exch def
    _string_size_x2 _string_size_x1 sub
    _string_size_y2 _string_size_y1 sub
} bind def

%
% STACK USAGE: <string> StringDescent <ynum>
%
% Returns the amount the string descends below the baseline.
% A negative return value is how much above the baseline the string floats.
%
/StringDescent
{
    gsave newpath 0 0 moveto false charpath pathbbox grestore
    pop pop exch pop neg
} bind def

% STACK USAGE: <string> LeadingWhiteLength <xnum>
% Returns the width of the string's leading whitespace
/LeadingWhiteLength
{
    gsave newpath 0 0 moveto false charpath pathbbox grestore pop pop pop
} bind def

/TwoPages?         true default
/WantLandscape?    TwoPages? default
/WantBoxes?        true default
/ShowSheetNum?     TwoPages? ShowPageNum? not or default
/ShowBigPageNum?  false default
/ChopLongLines?   false default
/FilesRenumbered? false default
/SegregatedFiles? FilesRenumbered? default
/MarkEOL? false default
/ShowHeader? true default
/ShowLegend? false default

MarkEOL? { /EOLmark (\267) default } if %default EOL marker is a bullet.

ShowHeader? {
    /ShowPageNum?      true default

    /DateText defined? {/ShowDate? true  default}
	{/ShowDate? false default /DateText ( ) default} ifelse

    /TitleText defined? {/ShowTitle? true  default}
	{/ShowTitle? false default /TitleText ( ) default} ifelse
} {
    /ShowTitle false def
    /ShowPageNum? false def
    /ShowDate? false def
} ifelse

/DraftText defined? {/ShowDraft? true  default}
    {/ShowDraft? false default /DraftText (D r a f t) default} ifelse

/SheetHeight#  11.0 inch round default % height of physical sheet
/SheetWidth#    8.5 inch round default % width of physical sheet

% If we want landscape, we do the following and from then on, it's as if
% our sheet were naturally that way (and must redo this after each showpage)
WantLandscape? {
    SheetHeight# SheetWidth# /SheetHeight# exch def /SheetWidth# exch def
    SheetHeight# 0 translate 90 rotate
} if

/TopMargin#    0.4 inch round default
/BottomMargin# 0.4 inch round default
/LeftMargin#   0.4 inch round default
/RightMargin#  0.4 inch round default
/CenterMargin# SheetWidth# 50 div round default

% Force header hight to be zero if we're not showing the header.
ShowHeader? {
    /HeaderHeight# SheetHeight# 30 div round default
} {
    /HeaderHeight# 0 def
} ifelse

% Page refers to the logical page...
/PageHeight#
    SheetHeight# BottomMargin# sub TopMargin# sub HeaderHeight# sub round def
/PageWidth# SheetWidth# LeftMargin# sub RightMargin# sub
    TwoPages? {CenterMargin# sub 2 div} if round def

/LogicalPageTopMargin#    PageHeight# 80 div round default
/LogicalPageBottomMargin# PageHeight# 80 div round default
/LogicalPageLeftMargin#   PageWidth#  60 div round default
/LogicalPageRightMargin#  PageHeight# 80 div round default

/TrueTextFieldWidth#
    PageWidth# LogicalPageLeftMargin# sub LogicalPageRightMargin# sub round def
/TrueTextFieldHeight#
    PageHeight# LogicalPageTopMargin# sub LogicalPageBottomMargin# sub round def

/TextFontName       /Courier       default
/TitleTextFontName  /Times-Bold    default
/SheetNumFontName   /Times-Roman   default
/BigNumFont         /Times-Roman   default
/DraftTextFontName  /Times-Bold    default
/DateFontName       /Helvetica     default

/DraftTextGray#        0.93  default
/DraftTextMargin#      4     default
/DraftPrintTimes#      5     default
/DraftTextHeightRatio# 0.125 default

/BigNumGray#             0.96 default
/BigNumHeightProportion# 0.8  default
/BigNumWidthProportion#  0.8  default

/SheetNumFontSize# 12 default

/TitleTextHeightRatio# 0.9 default
/DateTextHeightRatio#  0.5 default

% title size depends upon what else is going there
ShowDate? ShowPageNum? eq {
    ShowDate? {/MaxTitleTextWidthRatio# 0.45 default}
	      {/MaxTitleTextWidthRatio# 0.90 default} ifelse
} {
    ShowDate? {/MaxTitleTextWidthRatio# 0.45 default}
	      {/MaxTitleTextWidthRatio# 0.60 default} ifelse
} ifelse

/LinesPerPage# defined? false eq {
    /CharsPerLine# 85 default
    TextFontName findfont setfont (M) stringwidth pop CharsPerLine# mul
    TrueTextFieldWidth# exch div
    TrueTextFieldHeight# exch div round /LinesPerPage# exch def
} {
    /CharsPerLine# defined? false eq {
	% If lines/page defined but not chars/line, keep the font nice
	% and get as many chars as happen to fit.
	TrueTextFieldHeight# LinesPerPage# div
        TextFontName findfont setfont (M) stringwidth pop mul
	TrueTextFieldWidth# exch div round /CharsPerLine# exch def
   } if
} ifelse

% Knowing the chars/line, lines/page, and size of the page,
% find a font that fits.
/TextFont
    TextFontName findfont dup setfont
    (M) stringwidth pop /cwidth# exch def    /cheight# 1 def
    TrueTextFieldWidth# cwidth# CharsPerLine# mul div
    dup /CharWidth# exch def  		%note char width
    TrueTextFieldHeight# cheight# LinesPerPage# mul div
    dup /LineHeight# exch def  		%note the line height
    matrix scale makefont def

/BoldDelta CharWidth# 25 div def
/mBoldDelta 0 BoldDelta sub def

/Side# 0 default
/Page# 0 default
/Sheet# 0 default
/TotalPages# 0 default
/IgnoreNextEOL? false def
/ShowChopMark? false def
/ShowFoldMark? false def

/CalcTitleTextFont
{
    /TitleTextFont
      TitleTextFontName findfont
      HeaderHeight# TitleTextHeightRatio# mul scalefont dup setfont
      TitleText stringwidth pop PageWidth# MaxTitleTextWidthRatio# mul div
      dup 1 le {pop 1 1} {1 exch div 1} ifelse
      matrix scale makefont def
} bind def

ShowHeader?
{
    % Get the fonts for the date text and header text

    /DateFont
	DateFontName findfont
	HeaderHeight# DateTextHeightRatio#  mul scalefont def

    % PageNumberFont is the same as the DateFont
    /PageNumFont DateFont def

    ShowTitle? { CalcTitleTextFont } if
} if

ShowDraft? {
    /DraftTextFont
       DraftTextFontName findfont
       PageHeight# DraftTextHeightRatio# mul scalefont def
} if

ShowSheetNum? {
    /SheetNumFont SheetNumFontName findfont SheetNumFontSize# scalefont def
} if

%
% Engrays a horizontal line.
%    USAGE: startline endline ShowHorizLine --
% Starting and ending values are line numbers to gray.
% For example, "1 1 ShowHorizLine" engrays a single line, the 2nd from
% the top (the numbers are zero based).
%
/HorizBarGray# 0.90 default
/ShowHorizBar
{
    /tmpend# exch 1 add LineHeight# mul LogicalPageTopMargin# add def
    /tmpstart# exch LineHeight# mul LogicalPageTopMargin# add def
    newpath markx# marky# tmpstart# sub moveto
	    PageWidth# 0 rlineto
	    0 tmpstart# tmpend# sub 1 add rlineto
	    PageWidth# neg 0 rlineto
    closepath fill
} def

%
% Engrays a vertical line (a column in all lines).
% Analagous to ShowHorizLine above.
% 	USAGE: startcol endcol ShowHorizLine --
% Values are column numbers (zero based).
%
/VertBarGray#  0.50 default
/ShowVertBar
{
    /tmpend# exch 1 add TrueTextFieldWidth# mul CharsPerLine# div
	    LogicalPageLeftMargin# add round def
    /tmpstart# exch TrueTextFieldWidth# mul CharsPerLine# div
	    LogicalPageLeftMargin# add round def
    newpath markx# tmpstart# add marky# moveto
	    0 PageHeight# neg rlineto
	    tmpend# tmpstart# sub 0 rlineto
	    0 PageHeight# rlineto
    closepath fill
} def

%
%  Called just before a new logical page's data is given.  Magical.
%
/NewPage
{
    /Page# Page# 1 add def

    initclip % no clipping at the start of a page.

    % calculate where the upper-lefthand corner of the _text_ box is
    /markx# LeftMargin# Side# 1 eq {PageWidth# add CenterMargin# add} if def
    /marky# SheetHeight# TopMargin# sub HeaderHeight# sub def

    % Draw box around logical page if so requested.
    WantBoxes?
    {
	% draw box around logial page

	newpath markx# marky# moveto %move to upper-lefthand corner
	PageWidth# 0 rlineto 0 0 PageHeight# sub rlineto
	0 PageWidth# sub 0 rlineto
	closepath stroke
    } if

    % If it's the first logical page, and if so requested, write the legend.
    % The legend shows the various marks used to at the end of lines...
    %  EOL marker, chopped line, folded line, etc.
    ShowLegend? Page# 1 eq and {
	TextFont setfont
	markx# marky# PageHeight# sub LineHeight# 1.5 mul sub moveto
	(   ) show
	/ChopMark defined? { ChopMark show ( chopped-line      ) show } if
	/EOLmark  defined? { EOLmark  show ( end-of-line       ) show } if
	/FoldMark defined? { FoldMark show ( folded-line       ) show } if
    } if

    ShowHeader?
    {
	% Draw box around the header

	newpath markx# marky# moveto %move to upper-lefthand corner
	PageWidth# 0 rlineto 0 HeaderHeight# rlineto
	0 PageWidth# sub 0 rlineto closepath stroke

	% Draw the date
	ShowDate?
	{
	    DateFont setfont
	    markx# marky# moveto 0 DateText StringDescent 2 mul rmoveto
	    DateText show
	} if

	% Draw the page number
	ShowPageNum?
	{
	    PageNumFont setfont
	    TotalPages# 0 eq
	    {
		0 0 moveto
	           (Page ) false charpath
		   Page# 10 string cvs false charpath
		   (X) 10 string cvs false charpath
		   pathbbox pop newpath %stack: gomi gomi delta-X

		markx# PageWidth# add exch sub	%now have desired X
		marky# (g) StringDescent 2 mul add moveto
 		pop pop % remove gomi

		(Page ) show
		Page# 10 string cvs show
	    } {
		0 0 moveto
	           (Page ) false charpath
		   Page# 10 string cvs false charpath
		   ( of ) 10 string cvs false charpath
		   TotalPages# 10 string cvs false charpath
		   (X) 10 string cvs false charpath
		   pathbbox pop newpath %stack: gomi gomi delta-X

		markx# PageWidth# add exch sub	%now have desired X
		marky# (g) StringDescent 2 mul add moveto
 		pop pop % remove gomi

		(Page ) show
		Page# 10 string cvs show
		( of ) 10 string cvs show
		TotalPages# 10 string cvs show
	    } ifelse
	} if

	% Draw the header text
	ShowTitle?
	{
	    TitleTextFont setfont TitleText StringSize
	    HeaderHeight# exch sub 2 div marky# add exch
	    PageWidth# exch sub 2 div markx# add exch
	    moveto TitleText dup StringDescent 0 exch rmoveto show
	} if
    } if

    % Set the clipping region to be just inside the page boundry
    newpath markx# 1 add marky# 1 sub moveto PageWidth# 2 sub 0 rlineto
    0 PageHeight# 2 sub neg rlineto          PageWidth# 2 sub neg 0 rlineto
    closepath clip newpath

    /ShowGrayBars defined? { ShowGrayBars } if

    % Draw the "Draft" text
    ShowDraft?
    {
	gsave
	DraftTextGray# setgray

	% Set the clipping region
	markx# DraftTextMargin# add marky# DraftTextMargin# sub moveto
	PageWidth# DraftTextMargin# 2 mul sub 0 rlineto
	0 PageHeight# DraftTextMargin# 2 mul sub neg rlineto
	PageWidth# DraftTextMargin# 2 mul sub neg 0 rlineto
	closepath clip newpath

	DraftTextFont setfont

	%position for the first writing
	DraftText StringSize /tmpy# exch def /tmpx# exch def
	markx# tmpx# 2 div sub marky# tmpy# 2 div sub moveto
	DraftText StringDescent 0 exch rmoveto

	/Jmp# PageWidth# dup mul PageHeight# dup mul add sqrt
	DraftPrintTimes# 1 add div 0 exch sub def

	% set the tilt to run from upper-left through to lower-right
	PageWidth# PageHeight# atan rotate

	% move 1/2 jumping distance to begin with

	0 Jmp# 2 div rmoveto
	DraftPrintTimes#
	{
	    0 Jmp# rmoveto
	    gsave DraftText true charpath fill grestore
	} repeat
	grestore
    } if

    % draw the page number Really Big.
    ShowBigPageNum?
    {
	BigNumFont findfont dup setfont
	Page# 10 string cvs TrueStringSize /tmpy# exch def /tmpx# exch def
	PageWidth# BigNumHeightProportion# mul tmpx# div
	PageHeight# BigNumWidthProportion# mul tmpy# div
	matrix scale makefont setfont

	Page# 10 string cvs
	  dup TrueStringSize /tmpy# exch def /tmpx# exch def
	    markx# PageWidth# tmpx# sub 2 div add
	    marky# PageHeight# sub PageHeight# tmpy# sub 2 div add
	    moveto
	  dup LeadingWhiteLength neg 1 index StringDescent rmoveto
	    gsave BigNumGray# setgray
	  false charpath fill grestore
    } if

%    gsave  % matches the one in EndPage later

    % now leave things ready for the text
    markx# LogicalPageLeftMargin# add
    marky# LineHeight# sub LogicalPageTopMargin# sub moveto
    TextFont setfont
} bind def

%
% Physically kick out a sheet.
% Place the sheet number on the bottom if we're doing that.
%
/KickoutPage
{
    /Sheet# Sheet# 1 add def

    /Side# 0 def
    ShowSheetNum? {
	SheetNumFont setfont
	SheetWidth# LeftMargin# sub
	BottomMargin# SheetNumFontSize# 1.5 mul sub moveto
	Sheet# 10 string cvs show
   } if
   showpage

   % reinstall our page style
   WantLandscape? { SheetHeight# 0 translate 90 rotate } if
} bind def

%
% End of a logical page
%
/EndPage
{
%    grestore  % matches the one at the end of NewPage

    TwoPages? {Side# 0 eq {/Side# 1 def} {KickoutPage} ifelse}
	      {KickoutPage} ifelse
} bind def

%
% Called after EndPage to force a new sheet.
% Also should be called at the end of processing to make sure all
% pages are out.
/ForceNewSheet
{
    Side# 1 eq {KickoutPage} if
} bind def

% Sets up for a new file.  Expects to find the header text on the stack.
% If ShowHeader? flag is off, it will stay off.
/NewFile
{
    % Save the header text, get a font for it.
    /TitleText exch def
    ShowTitle? {CalcTitleTextFont} if

    % Must we kick out a new page with a new file?
    SegregatedFiles? { ForceNewSheet } if

    % Reset the sheet number with a new file? (weird things will happen
    %  if both SegregatedFiles? and FilesRenumbered? are true, and
    %  a file starts on an righthand logical page)
    FilesRenumbered? {/Sheet# 0 def} if

    % Erase any idea of total pages, as we're starting a new file
    /TotalPages# 0 def
    /Page# 0 def 	% also starting out with a fresh page count
} bind def

%
% STACK USAGE: <string> S -
%
% Puts the string in the next line on the current logical page.
% If the string is too large to print within the TrueTextFieldWidth#,
% the font is shrunk to make it fit.
%
/S
{
    gsave
      ChopLongLines? false eq {
	  dup stringwidth pop truncate TrueTextFieldWidth# gt {
	    currentfont
	    TrueTextFieldWidth# 2 index stringwidth pop div
	    1 matrix scale makefont setfont
	  } if
      } if
      show

      % If ShowChopMark? is set, show a chop-mark.
      % Otherwise, if ShowFoldMark? is set, show a fold-mark.
      % Otherwise, show an EOL mark if that's set.

      ShowChopMark? {
	ChopMark show
	/ShowChopMark? false def         % reset it
      } {
	ShowFoldMark?
        {
	    FoldMark show
  	} {
	    IgnoreNextEOL? not MarkEOL? and { EOLmark show } if
	} ifelse
      } ifelse
      /ShowFoldMark? false def  % reset for next line.
      /IgnoreNextEOL? false def % eset for next line.

    grestore
    0 0 LineHeight# sub rmoveto
} bind def

% STACK USAGE: <string> S -
%
% Simply show the string and move back to the starting place.
%
/s
{
	currentpoint 3 -1 roll show moveto
} bind def

%-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%EndProlog
