#!/u/smann/bin/perl -s

# Put n x n pages of conforming postscript output on a single page.
# Special cases for dvitps output with psfig figures.
#	Flags:
#		-seascape 	input is seascape format
#		-landsscape	input is landscape format
#		-nooutline	don't put boxes around pages
#		-fixcp		use a fixed clippath (for braindead
#				printers like the NeXT).
#		-nocp		draw to page instead of clippath

$[ = 1;			# set array base to 1

$outpage = 0;
$inpage = 0;
$subpage = -1;

# The fixed clippath
$llx = 18;
$lly = 18;
$urx = 594;
$ury = 774;


if ( $help ) {
	die "psproof [-seascape] [-landscape] [-nooutline] [-fixcp] [-nocp] [n] {files}\n";
}

if ( $#ARGV==0 || $ARGV[1]!~/^\d+$/) {
	$two = 1;
	$nx = 2;
	$ny = 1;
} else {
	$n=shift;
	$nx=$ny=$n;
	warn "dim are ($nx,$ny)\n";
}
die "?" unless $nx>0 && $ny>0;

if ( $seascape ) {
	$xo= 1; $yo= 1; $dx=-1; $dy=-1;
} elsif ( $landscape ) {
	$xo= 0; $yo= 0; $dx= 1; $dy= 1;
} else {	#portrait
	$xo= 0; $yo= 1; $dx= 1; $dy=-1;
}
if ( $two ) {
	$scalex = $scaley = 0.647;	# empirically determined
} else {
	$scalex=1. / $nx;
	$scaley=1. / $ny;
}

while (<>) {
	if (/^gsave initgraphics$/ && !$beyondprolog) {
		# dvitps init, change the scaling right after it does the 
		# initgraphics, but before it changes the state into 
		# DocumentInitState
		die "?" if $foundgsave;
		$foundgsave=1;
		print "gsave\n";	# leave out initgraphics just in case
		&doclip;
	} elsif (/^%%EndProlog/) {
		if ($beyondprolog) { die "2 EndPrologs\n"; }
		$beyondprolog=1;
		printf "/showsmbox %s def\n", $nooutline?"false":"true";
		print "/smbox {\n";
		print "	showsmbox\n";
		print "	{ 0 0 moveto 612 0 rlineto\n";
		print "		0 792 rlineto -612 0 rlineto\n";
		print "		closepath stroke\n";
		print "	} if\n";
		print "} def\n";
		# could consider rebinding /showpage
		print;
	} elsif (/\/showpage/) {
		print;
	} elsif (/\bshowpage\b/) {
		# warn "Removing showpage from $_";
		s/showpage//;
		print;
	} elsif (/^%%Page:\s*(\S+)\s+(\S+)/) {
#		die "?" if !$beyondprolog;
		$inpage++;
		warn "** Found page $2, expected page $inpage\n" 
		    unless $inpage==$2;
		$subpage=($subpage+1)%($nx*$ny);
		if ($outpage) {
			print "grestore % restore subpage CTM\n";
			if ( ! $nooutline ) { print "smbox\n"; }
			print "grestore % restore page CTM\n";
		}
		if ($subpage==0) {
			$outpage++;
			if ($outpage!=1) {
				print "showpage\n";
				print "grestore % restore global CTM\n\n";
			}
			$f=$inpage; $e=$inpage+$nx*$ny-1;
			# only correct on last page if #pages is at top of file
			$e=$inpages if ($inpages && $e>$inpages);
			$pagenames="$f-$e";
			print "%%Page: $pagenames $outpage\n";
			print "gsave % save global CTM\n";
			&doclip;
		}
		# subpage is 0..n-1
		$x=$subpage%$nx;		# x changes more rapidly
		$y=int($subpage/$nx);
		print "%%Subpage: ($x,$y) out of ($nx,$ny)\n";
		print "gsave % save page CTM\n";
		if ($seascape || $landscape) { $t=$x; $x=$y; $y=$t; }
		$px=($xo*($nx-1) + $x*$dx) *72*8.5;
		$py=($yo*($ny-1) + $y*$dy) *72*11;
		print "$px $py translate\n";
		print "0 0 moveto 612 0 rlineto 0 792 rlineto -612 0 rlineto\n";
		print "closepath clip newpath\n";
		print "gsave % save subpage CTM\n";
	} elsif (/^%%Trailer/) {
		die "?" unless $beyondprolog;
		$beyondtrailer=1;
		print "grestore % restore subpage2 CTM\n";
		if ( ! $nooutline ) { print "smbox\n"; }
		print "grestore % restore page2 CTM\n";
		print "showpage\n";
		print "grestore % restore global2 CTM\n";
		print;
	} elsif (/^%%Pages:\s*(\S+)\s*$/) {
		if ($beyondprolog) {
			die "?" unless $beyondtrailer;
			print "%%Pages: $outpage\n";
		} else {
			$pages=$1;
			if ($pages=~/\d+/) {
				$inpages=int(($pages-1)/($nx*$ny)+1);
				$wpages=$inpages;
			}
			print "%%Pages: $pages\n";
		}
	} elsif (/^(% )*%%Subpage/) {
		print "% $_";
	} else {
		print;
	}
}

warn "Pages: $inpage in	-> $outpage out\n";
warn "Number of pages don't match\n" unless !$wpages || $wpages==$outpage;

sub doclip
{
	if ( !$nocp ) {
		# Change CTM so that the 8.5x11 inches are actually inside 
		# the clippath so we get a predictable printable area.
		if ( $fixcp ) {
			print "$llx $lly moveto $urx $lly lineto\n";
			print "$urx $ury lineto $llx $ury lineto\n";
			print "closepath pathbbox newpath\n";
		} else {
			print "clippath pathbbox newpath\n"; # llx lly urx ury
		}
		print "4 copy exch pop sub neg /dy exch def pop\n";
		print "4 copy pop exch pop sub neg /dx exch def\n";
		print "pop pop translate\n";
		print "dx 612 div	dy 792 div	scale\n";
	}
	# If two per page, we need to rotate
	if ( $two ) {
		print "90 rotate\n";
	}
	# This is the real rescale
	print "$scalex $scaley scale\n";
	# Center the pages if we're doing two per page
	if ( $two ) {
		print "0 612 $scalex div 792 sub 2 div 792 add neg translate\n";
	}
}