#!/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 warnings;
use strict;

my $margin    = '1';
my $papersize = 'a4';


our ($opt_d, $opt_r);
our $opt_m = 1; # in centimeters
our ($opt_w, $opt_h) = (21.0, 29.7); # in centimeters, A4
our ($opt_l, $opt_s) = (2, 1); # Default: 2 pages per page

our $opt_D = 'L'; # 'L' or 'R'. How to rotate, if required.

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

# Calculate the maximal bounding box
#
my $pid;
my ($x1, $y1, $x2, $y2) = (2**16, 2**16, -2**16, -2**16);
my $cmdline = "gs -sDEVICE=bbox -dBATCH -dNOPAUSE - 2>&1";


open *KIDIN, "<&STDIN";

#open *FIN, '-|', 'gs', '-sDEVICE=bbox', '-dBATCH', '-dNOPAUSE', '-'
#open *FIN, '-|', 'gs -sDEVICE=bbox -dBATCH -dNOPAUSE - 2>&1'
open3 "<&KIDIN", ">&FIN", *FIN, 
             'gs', '-sDEVICE=bbox', '-dBATCH', '-dNOPAUSE', '-'
           or die "Can't run: '$cmdline'";
my $n = 0;
while (<FIN>) {
    if ($_ =~ m/^\%\%BoundingBox: (\d+) (\d+) (\d+) (\d+)/) {
	    $x1 = $1 if $1 < $x1;
	    $y1 = $2 if $2 < $y1;
	    $x2 = $3 if $3 > $x2;
	    $y2 = $4 if $4 > $y2;
        print STDERR "[", ++$n, "] ";
    }
}
close FIN;

print STDERR "\n";

seek STDIN, 0, 0;

die "Error calculating bounding box" if (($x1 >= $x2) || ($y1 >= $y2));
#print "Bounding box: ($x1,$y1), ($x2,$y2)\n";
my @bbox = ($x1, $y1, $x2, $y2);

#
# Calculate pstops specification
#
#my @views = &calculate_views_short_x_long($opt_s, $opt_l, $opt_r);
my @views = &calculate_views_short_x_long(1, 1, 3);

my $spec = scalar(@views);
for (my $i = 0; $i < scalar(@views); $i++) {
    my $s = &calc_pstops_page(\@bbox, $views[$i]);
    $spec .= ($i ? '+' : ':') . $i. $s;
}
my ($w, $h) = ($opt_w * $units_per_cm, $opt_h * $units_per_cm);
$w = int($w + .5);
$h = int($h + .5);
my $ps_size_spec = "\%\%BeginFeature: *PageSize ($w $h)\n<< /PageSize [$w $h] >> setpagedevice\n\%\%EndFeature\n";

#
# Dry run? Only print the specification
#
#$cmdline = "pstops -w$w -h$h '$spec' $in_file";
#if ($opt_d) {
#    print "$cmdline $out_file\nAnd add after the first '\%\%EndComments':\n$ps_size_spec";
#    exit(0);
#}

#
# Run the program and filter the output
#

my $PStoPSclip_hack = 1;
#$out_file = '-' unless $out_file;
#(open FOUT, ">$out_file") or die "Can't create '$out_file': $!\n";
open2 *FIN, "<&STDIN", 'pstops', "-w$w", "-h$h", "$spec"
    or die "Can't run '$cmdline': $!\n";
#(open FIN, "$cmdline|") or die "Can't run '$cmdline': $!\n";
while (my $l = <FIN>) {
    # Optional, but nice: tune how "gv" will show the document
    next if $l =~ m/^\%\%DocumentMedia:/;
    if ($l =~ m/^\%\%BoundingBox:/) {
	(print "\%\%BoundingBox: 0 0 $w $h\n") or die "Can't print: $!";
	next;
    }
    (print $l) or die "Can't print: $!";
    chomp $l;
    # Important to print the document right
    if ('%%EndComments' eq $l) {
	(print $ps_size_spec) or die "Can't print: $!";
	last;
    }
}
while (my $l = <FIN>) {
    (print $l) or die "Can't print: $!";
    if ($PStoPSclip_hack && ($l =~ m/^userdict\/PStoPSclip{0 0 moveto$/)) {
	$l = <FIN>;
	$l =~ s/\./0./g; # Increase clipping box by 10
	(print $l) or die "Can't print: $!";
    }
}
#(close FIN) or die "Can't close '$cmdline': $!";
#(close FOUT) or die "Can't close '$out_file': $!";

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

#
# Calculate an item of the pstops specification
#
sub calc_pstops_page {
    my ($box_from, $box_to) = @_;
    #print 'bbox_from: ', join(' ', @$box_from), "\n";
    #print 'bbox_to:   ', join(' ', @$box_to), "\n";
    #
    # Check if rotation required
    #
    my ($width_from, $height_from) = ($box_from->[2] - $box_from->[0], 
				      $box_from->[3] - $box_from->[1]);
    my ($width_to, $height_to) = ($box_to->[2] - $box_to->[0], 
				  $box_to->[3] - $box_to->[1]);
    my $rotation = (($width_from > $height_from) xor ($width_to > $height_to));
    #
    # Scale factor
    #
    my ($scale1, $scale2);
    if ($rotation) {
	($scale1, $scale2) = ($height_to / $width_from, 
			      $width_to / $height_from);    
    } else {
	($scale1, $scale2) = ($width_to / $width_from, 
			      $height_to / $height_from);
    }
    my $scale = ($scale1 > $scale2) ? $scale2 : $scale1;
    #print "scale 1,2,common: [$scale1] [$scale2] [$scale]\n";
    #
    # Calculate the centers of the boxes
    #
    my ($cx, $cy) = (.5 * ($box_from->[0] + $box_from->[2]), 
		     .5 * ($box_from->[1] + $box_from->[3]));
    my ($cx_to, $cy_to) = (.5 * ($box_to->[0] + $box_to->[2]), 
			   .5 * ($box_to->[1] + $box_to->[3]));
    #
    # Fist, pstops scales, then rotates, then moves
    #
    ($cx, $cy) = ($cx * $scale, $cy * $scale);
    if ($rotation) {
	$rotation = $opt_D;
	if ('L' eq $rotation) {
	    ($cx, $cy) = (-$cy, $cx);
	} elsif ('R' eq $rotation) {
	    ($cx, $cy) = ($cy, -$cx);
	} else {
	    die "Unknown rotation";
	}
    }
    my ($movex, $movey) = ($cx_to - $cx, $cy_to - $cy);
    #
    # Generate the summary
    #
    my $s = sprintf('%s@%.3f(%.1f,%.1f)', $rotation, $scale, $movex, $movey);
    #print "pstops string: [$s]\n";
    return $s;
}

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

# 
# 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, $opt_m, $n) = @_;
    my $skip  = ($length - $opt_m) / $n;
    my $width = $skip - $opt_m;
    my @end_coords = map { int(.5 + $skip * $_) } (1..$n);
    my @coords = map { my @a = (int(.5 + $_ - $width), $_); \@a } @end_coords;
    #print "$n: "; map { print '[', $_->[0], ',', $_->[1], ']' } @coords; print "\n";
    return @coords;
}

#
# N_short_edge * N_long_edge views paer page
# (For A4, short == width, long == height)
#
sub calculate_views_short_x_long {
    my ($n_short_edge, $n_long_edge, $long_reverse) = @_;
    my ($pu_width, $pu_height, $pu_margin) 
	= ($opt_w * $units_per_cm, $opt_h * $units_per_cm, 
	   $opt_m * $units_per_cm);
    my @short_coordinates = 
	&calculate_coordinates($pu_width,  $pu_margin, $n_short_edge);
    my @long_coordinates  = 
	&calculate_coordinates($pu_height, $pu_margin, $n_long_edge);
    if ($long_reverse) {
	@long_coordinates = reverse @long_coordinates;
    }
    my @views;
    foreach my $x_coords (@short_coordinates) {
	foreach my $y_coords (@long_coordinates) {
	    my @view = ($x_coords->[0], $y_coords->[0], 
			$x_coords->[1], $y_coords->[1]);
	    push @views, \@view;
	}
    }
    return @views;
}