#!/usr/local/bin/perl
# up:
# PostScript n-up print utility.  This script takes conforming PS
# files, and prints them n-up, where n is controlled by a symbolic
# name (taken from argv[0] or the command line), and the page
# positioning and scaling are looked up in a configuration file.
#
# usage: up [-n name] [-f config] [file ...]
#
# jgreely@cis.ohio-state.edu, 89/10/23
#

# set the name from $0 (argv[0]), after stripping a path
#
@foo = split(/\//,$0);
$name=pop(@foo);

$HOME=$ENV{"HOME"};

# set a default prolog in case the config file doesn't have one
# make sure that plines is 2 larger than the number of definitions in
# the prolog (used to get dictionary size).
#
$plines=10;
$prolog = <<EOF;
/inch {72 mul} def
/moveU {0 11 inch translate} def
/moveR {8.5 inch 0 translate} def
/moveD {0 -11 inch translate} def
/moveL {-8.5 inch 0 translate} def
/rotR {-90 rotate} def
/rotL {90 rotate} def
EOF

# search for a configuration file.  The *last* one found is used
#
$config = "./up.rc";
@search_path = ("/usr/lib/up.rc","/usr/local/lib/up.rc","$HOME/.uprc",
                "./up.rc"); 
foreach $file (@search_path) {
	$config = $file if (-f $file && -r $file);
}

# check for options on command line.
#
while ($_ = $ARGV[0],/^-/) {
	shift;
	last if /^-\-$/;
	/^-[Ff]/ && ($config = shift,next);
	/^-[Nn]/ && ($name = shift,next);
	die "usage: up [-f config] [-n name] [file ...]\n";
}

# read relevant section of configuration file.	For complete format
# description, see the provided up.rc file or uprc(5).
#  Basically, read the config file until we find a line containing a
# name field equal to the current name.	 Once we do, read all name-
# value pairs up until a line containing just a '.', placing them all
# into an associative array.
#
open(config) ||
  die "can't find file '$config', stopped";
$in_rec = 0;
while(<config>) {
	chop;
	next if /^\s*#|^\s*$/;	# skip comment and blank lines
	if (/^prolog\s*=/) {
		do read_prolog();
		next;
	}
	next unless ($in_rec || /$name/);
	($field,$value) = split(/\s*=\s*/);
	if (($field eq "name") && ($value eq $name)) {
		$in_rec++;
		next;
	}
	last if /^\.$/;
	$var{$field} = $value;
}
close(config);
die "no such record '$name' in file '$config', stopped" unless $in_rec;
$modulus = $var{"modulus"};
die "invalid modulus == $modulus, stopped" unless $modulus;

$_ = <>;
if (/^%!PS-Adobe/) {
	print <<EOF;
%!PS-Adobe-2.0
%%Pages: (atend)
EOF
}else{
	die "Not conforming PostScript (no %!PS-Adobe), stopped";
}

# read comment section (up to first non-%% line, or %%EndComments)
#
while (<>) {
	if (!/^%%/) {
		do print_prologue();
		print;
		last;
	}
	if (/^%%EndComments/) {
		print;
		do print_prologue();
		last;
	}
	print;
}

while (<>) {
	#
	# to use slightly busted NeXT previewer
	#
	next if /^%%Pages:/;
	if (/^%%Page:/) {
		do enter_page();
		next;
	}
	if (/^%%Trailer/) {
		do print_trailer();
		next;
	}
	print;
}
# print actual page count.  This must be the last trailer comment
# printed.
#
print "%%Pages: $sheet\n";
exit(0);

# the prolog consists of simple command definitions you want to make
# available to the configuration routines.  None of them do anything
# complicated, but why make life more difficult for the user?
#
sub print_prologue {
	print <<EOF;
%%BeginProcSet: up_prolog 1 $$
/UpDict$$ $plines 3 add dict def
UpDict$$ begin
$prolog
/UpShowpage {showpage} bind def
/UpState {} def
end
/showpage {} def
%%EndProcSet: up_prolog 1 $$
EOF
}

# basically, at the beginning of a page, pull the number from the page
# header, take it modulo $modulus, and print things based on that #
# number.  If it's 1, end the previous sheet (if there is one),
# increment the sheet number, and print a sheet header.	 For all
# pages, print the appropriate page motion command.
#
sub enter_page {
	$page++;
	($foo,$bar,$oldpage) = split;
	die "Help! page number mismatch, stopped" if ($oldpage != $page);
	$temp = $page % $modulus;
	if ($temp == 1) {
		if ($sheet++) {
			print 
			  "UpDict$$ begin UpState restore UpShowpage end\n";
		}
		print <<EOF;
%%Page: ? $sheet
UpDict$$ begin
save /UpState exch def
EOF
		print $sheet % 2 ? $var{'odd'} : $var{'even'},"\n";
		print $var{"scale"},"\n";
	}else{
		print "UpDict$$ begin\n";
	}
	$temp = $modulus unless $temp;
	print $var{$temp},"\n";
	print "end\n";
}

# print the trailer, which for us consists of a showpage (inserted
# before the trailer comment, to make it part of the last page).
#
sub print_trailer {
	print "UpDict$$ begin UpState restore UpShowpage end\n" if $page;
	print "%%Trailer\n";
}

# read the prolog from the configuration file.	All lines up to the
# the first one starting with '.' will be placed in $prolog
#
sub read_prolog {
	$prolog='';
	#plines=0;
	while (<config>) {
		last if /^\./;
		$prolog .= $_;
		$plines++;
	}
	chop($prolog);
	$plines+=3;
}
