#!/usr/bin/perl -w

=head1 SYNOPSIS

psnup2.pl - a better psnup

For details, see http://consodoc.com/psnup2/

=head1 USAGE

psnup2.pl -d -m <margin> -w <page_width> -h <page_height>
          -l <n_long_edge> -s <n_short_edge> -r <reverse> -D
          SOURCE [DEST]

-d  If specified, only prints out the command.
-m  Margin, in centimeters, that should be kept around the page. Default to 1.
-w  Resulting page width, in centimeters. Default to 21.
-h  Resulting page height, in centimeters. Default to 29.7.
-l  Number of pages to fit on the long edge. Default to 2.
-s  Number of pages to fit on the short edge. Default to 1.
-r  If specified, the order is reversed on the long edge.
-D  Rotation direction, if needed ("L" or "R"). Default to "L".

=head1 REQUIRE

Requires psutils installed and available in the command line
http://www.tardis.ed.ac.uk/~ajcd/psutils/

=head1 AUTHOR

Public domain, (c) Oleg Parashchenko, Lionel Guy

=head1 VERSION

Version: 0.0.5, 23 October 2008

=cut

use Getopt::Long; 
use IPC::Open2;
use IPC::Open3;
use POSIX qw(floor);
use warnings;
use strict;

# TODO: units
# TODO: "-m h1cm:v3cm": horizontal, vertical
my $opt_m    = '1'; # in centimeters

my $papersize = 'a4';

my ($opt_w, $opt_h) = (21.0, 29.7); # in centimeters, A4

my $units_per_cm = 72 * .3937; # 1 centimeters = .393700787 inches, 1 inch = 72 PostScript units5

die "Too many arguments" if $#ARGV > 1;

my ($infile, $outfile) = @ARGV;


if (defined $infile && $infile ne "-") {
    open *FIN, '<', "$infile"  or  die "Can't read `$infile': $!";

} else {
    *FIN = *STDIN;
}

if (defined $outfile && $outfile ne "-") {
    open *FOUT, '>', "$outfile"  or  die "Can't create `$outfile': $!";
} else {
    *FOUT = *STDOUT;
}



#
# Calculate the maximal bounding box
#

my $pid;

# need to duplicate FIN, since it will be closed in the parent process
open *KIDFIN, "<&FIN"  or  die "Can't dup FIN: $!";

$pid = open3 "<&KIDFIN", ">&FINGS", *FINGS, 
             'gs', '-sDEVICE=bbox', '-dBATCH', '-dNOPAUSE', '-'
           or die "Can't run: `gs -sDEVICE=bbox -dBATCH -dNOPAUSE -'";
my $n = 0;
my ($x0, $y0, $x1, $y1) = (1<<16, 1<<16, -(1<<16), -(1<<16));
while (<FINGS>) {
    if ($_ =~ m/^\%\%BoundingBox: (\d+) (\d+) (\d+) (\d+)/) {
	    $x0 = $1 if $1 < $x0;
	    $y0 = $2 if $2 < $y0;
	    $x1 = $3 if $3 > $x1;
	    $y1 = $4 if $4 > $y1;
        print STDERR "[", ++$n, "] ";
    }
}
close FINGS;
print STDERR "\n";

# No zombie processes
waitpid $pid, 0;

die "Error when calculating bounding box" if ($x0 >= $x1 || $y0 >= $y1);
my @bbox = ($x0, $y0, $x1, $y1);


# Let's go back to the beginning of the input
seek FIN, 0, 0  or  die "$!";



#
# Calculate pstops specification
#
# (rounded) width, height, and margin
my ($w, $h, $margin) = map { &round ($_ * $units_per_cm) }
                           ($opt_w, $opt_h, $opt_m);

($x0,$x1) = &calculate_coordinates($w, $margin);
($y0,$y1) = &calculate_coordinates($h, $margin);

my $spec = 0 . &calc_pstops_page(@bbox, $x0, $y0, $x1, $y1);



#
# Run the program and filter the output
#

$pid = open2 *FINPS2PS, "<&FIN", 'pstops', "-w$w", "-h$h", "$spec"
           or die "Can't run `pstops -w$w -h$h $spec': $!\n";
my $l;
# Header and comments
while (defined ($l = <FINPS2PS>)  &&  $l ne "\%\%EndComments\n") {
    # Optional, but nice: tune how "gv" will show the document
    next if $l =~ m/^\%\%DocumentMedia:/;

    if ($l =~ m/^\%\%BoundingBox:/) {
	    print FOUT "\%\%BoundingBox: 0 0 $w $h\n"  or  die "Can't print: $!";
	    next;
    }
    print FOUT $l  or  die "Can't print: $!";
}

# Important to print the document right
# TODO: die "Can't print: $!"
print FOUT  <<  "EOF";
\%\%EndComments
\%\%BeginFeature: *PageSize ($w $h)
<< /PageSize [$w $h] >> setpagedevice
\%\%EndFeature
EOF


# Body
while (<FINPS2PS>) {
    print FOUT $_  or  die "Can't print: $!";

    # PStoPSclip hack: increase clipping box by 10
    if ($_ =~ m/^userdict\/PStoPSclip{0 0 moveto$/) {
        $l = <FINPS2PS>;
	    $l =~ s/\./0./g;
	    print FOUT $l  or  die "Can't print: $!";
    }
}

close FIN;
close FOUT;

# No zombie processes
waitpid $pid, 0;



# =========================================================

#
# Calculate an item of the pstops specification
#
sub calc_pstops_page {
    my ($fx0, $fy0, $fx1, $fy1,
        $tx0, $ty0, $tx1, $ty1) = @_;

    # From and to width / height
    my ($wf, $hf) = ($fx1 - $fx0,  $fy1 - $fy0);
    my ($wt, $ht) = ($tx1 - $tx0,  $ty1 - $ty0);

    # Scale factor width / height
    my ($sw, $sh) = ($wt / $wf,  $ht / $hf);

    # We take the smallest scale
    my $scale = ($sw > $sh) ? $sh : $sw;
    
    # Calculate the centers of the boxes
    my ($cxf, $cyf) = ( .5 * ($fx0 + $fx1),  .5 * ($fy0 + $fy1) );
    my ($cxt, $cyt) = ( .5 * ($tx0 + $tx1),  .5 * ($ty0 + $ty1) );

    # Fist, pstops scales, then moves

    my ($movex, $movey) = ($cxt - $cxf * $scale,  $cyt - $cyf * $scale);

    # Generate the summary
    return sprintf( '@%.3f(%.3f,%.3f)', $scale, $movex, $movey);
}

# =========================================================

# 
# Calculate coordinates of splitting the dimension on K chunks
# Returns an array, each item is a reference to an array of two
#   elements: the begin and end coordinates
#
sub calculate_coordinates {
    my ($length, $margin) = @_;
    my $skip   = $length - $margin;
    my $width  = $skip - $margin;
    my @coords = ( &round( &round($skip) - $width ), &round($skip) );
    return @coords;
}

# Round a float number
sub round {
    return floor ($_[0] + .5);
}