#!/pkg/gnu/bin/perl

# This Perl script converts 4-up PostScript handouts for CS242
# which do not use nup.pre.ps to 1-up format.  You must change
# the first line to point to your own directory where perl is stored.
#
# This program works with the files present in mid-February 1996.
# If the way 4-up files are produced is changed, it may no longer work. 
#
# This program is a filter, which reads the 4-up PostScript from 
# the standard input and writes 1-up PostScript to the standard output.

$pagect = 0;
$warned = 0;

while (<STDIN>) {

	$x = $_;
	chop($x);

	#Warn if input might be in wrong 4-up format for this program
	if ($x =~ /nup.pre.ps/) {
		if ($warned == 0) {
			print STDERR "The input might be using nup.pre.ps\n";
			$warned = 1;
		}
	}

	#Change the %%Pages: comment to defer the page count
	#because there may be trailing blank pages which can be discarded
	if ($x =~ /^%%Pages: ([0-9]+) ([0-9]+)/) {
		$page_order = $2;
		print "%%Pages: (atend)\n";
	}

	#Delete "%%BeginProcSet: PStoPS 1 15" through "%%EndProcSet"
	elsif ($x eq "%%BeginProcSet: PStoPS 1 15") {
		&delete_through("%%EndProcSet");
	}

	#Delete "/userdict/PStoPSxform PStoPSmatrix matrix currentmatix" through
	#" matrix invertmatrix put"
	elsif ($x eq "userdict/PStoPSxform PStoPSmatrix matrix currentmatrix") 
	{
		&delete_through(" matrix invertmatrix put");
	}

	#Delete first %%Page: comment and following lines
	elsif ($x =~ /^%%Page:/) {
		&delete_through("PStoPSxform concat");
	}

	#Delete "PStoPSsaved restore" through "PStoPSxform concat"
	elsif ($x eq "PStoPSsaved restore") {
		&delete_through("PStoPSxform concat");
	}

	#Copy anything else
	else {
		#but precede calls to bop by %Page: comment
		if ($x =~ /^([0-9]+) bop /) {
			$z = $1;
			$z = $z + 1;
			print "%%Page: $z $z\n";
			$pagect = $pagect + 1;
		}
		print "$x\n";
	}
}

#Emit trailer with page count
print "%%Trailer\n";
print "end\n";
print "userdict /end-hook known{end-hook}if\n";
print "%%Pages: $pagect $page_order\n";
print "%%EOF\n";

#Consume input until an occurrence of a line equal to the argument
sub delete_through {
	while (<STDIN>) {
		chop;
		if ($_ eq $_[0]) {
			last;
		}
	}
}