A new psresize!

1 files changed, 377 insertions, 0 deletions

diff --git a/psresize2.pl b/psresize2.pl
new file mode 100755
index 0000000..a5311bd
--- /dev/null
+++ b/psresize2.pl
@@ -0,0 +1,377 @@
+#!/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 qw(:config no_ignore_case bundling); 
+use Pod::Usage;
+use IPC::Open2;
+use IPC::Open3;
+use POSIX qw(floor);
+use strict;
+
+
+
+#
+# Options & arguments 
+#
+
+my ($outwidth,$outheight, $inwidth,$inheight);
+my $margin;
+my $crop;
+my $rotdir = 'L';
+my $quiet;
+my $man;
+my $help;
+
+# TODO: "-m h1cm:v3cm": horizontal, vertical
+GetOptions( "w|width=s"    => \$outwidth,
+            "h|height=s"   => \$outheight,
+            "p|paper=s"    => sub { &papersize ($_[1],\$outwidth,\$outheight) },
+            "W|Width=s"    => \$inwidth,
+            "H|Height=s"   => \$inheight,
+            "P|Paper=s"    => sub { &papersize ($_[1],\$inwidth,\$inheight) },
+            "m|margin=s"   => \$margin,
+            "c|crop"       => \$crop,
+            "r|rotation=s" => \$rotdir,
+            "q|quiet"      => \$quiet,
+            "help"         => \$help,
+            "man"          => \$man )
+    or  pod2usage(2);
+
+pod2usage(1)  if  (defined $help  or $#ARGV > 1);
+pod2usage(-exitstatus => 0, -verbose => 2)  if  defined $man;
+
+# Input and output files
+my ($infile, $outfile) = @ARGV;
+
+
+
+#
+# Default values
+#
+
+# Default margin
+unless (defined $margin) {
+    $margin = 0;
+    $margin = "1cm" if defined $crop;
+}
+
+# Default output papersize
+&papersize ("a4", \$outwidth, \$outheight)
+    unless  (defined $outwidth  and  defined $outheight);
+
+# Default unit: point
+map {&topoints ($_)} ( \$outwidth, \$outheight,
+                       \$inwidth, \$inheight,
+                       \$margin );
+
+# Rotation
+if (lc $rotdir eq "left" or uc $rotdir eq 'L') {
+    $rotdir = 'L'
+} elsif (lc $rotdir eq "right" or uc $rotdir eq 'R') {
+    $rotdir = 'R'
+} else {
+    die "Unknown rotation direction: `$rotdir'"
+}
+
+
+# Open input and output files
+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;
+}
+
+
+
+#
+# Bounding box
+#
+my @bbox;
+if (defined $crop) {
+    # Calculate the maximal bounding box
+
+    # Need to duplicate FIN, since it will be closed in the parent process
+    open *KIDFIN, "<&FIN"  or  die "Can't dup FIN: $!";
+    
+    my $pid = open3 "<&KIDFIN", ">&GS", *GS, 
+                    '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 (<GS>) {
+        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 GS;
+    print STDERR "\n";
+    
+    # No zombie processes
+    waitpid $pid, 0;
+    
+    die "Error when calculating bounding box" if ($x0 >= $x1 || $y0 >= $y1);
+    @bbox = ($x0, $y0, $x1, $y1);
+
+    # Let's go back to the beginning of the input
+    seek FIN, 0, 0  or  die "$!";
+
+} elsif (defined $inwidth and defined $inheight) {
+    @bbox = (0, 0, $inwidth, $inheight);
+} else {
+    # Guess page size from the input file
+
+    # Duplicate the input filehandle, to avoid to seek into it
+    open *FIN2, "<&FIN"  or  die "Can't dup FIN: $!";
+    while (<FIN2>) {
+        if ($_ =~ m/^\%\%BoundingBox: (\d+) (\d+) (\d+) (\d+)/) {
+            @bbox = ($1, $2, $3, $4);
+            last;
+        }
+    }
+    die "Cannot guess input page size!"  unless  @bbox;
+    close FIN2;
+}
+
+
+
+#
+# Calculate PStoPS specification
+#
+my ($x0,$x1) = &calculate_coordinates($outwidth , $margin);
+my ($y0,$y1) = &calculate_coordinates($outheight, $margin);
+
+my $spec = 0 . &calc_pstops_page(@bbox, $x0, $y0, $x1, $y1);
+
+
+
+#
+# Run the program and filter the output
+#
+
+my $pid = open2 *FINPS2PS, "<&FIN",
+                'pstops', "-w$outwidth", "-h$outheight", "$spec"
+              or die "Can't run `pstops -w$outwidth -h$outheight $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 $outwidth $outheight\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 ($outwidth $outheight)
+<< /PageSize [$outwidth $outheight] >> 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);
+
+    # Check if rotation required
+    my $rotation = (($wf > $hf) xor ($wt > $ht));
+
+    # Scale factor width / height
+    my ($sw, $sh);
+    if ($rotation) {
+        ($sw, $sh) = ($ht / $wf,  $wt / $hf);
+    } else {
+        ($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) );
+
+    # First, PStoPs scales, then rotates, then moves
+    ($cxf, $cyf) = ($cxf * $scale, $cyf * $scale);
+    if ($rotation) {
+        if ($rotdir eq 'L') {
+            ($cxf, $cyf) = (-$cyf, $cxf);
+        } else {
+            ($cxf, $cyf) = ($cyf, -$cxf);
+        }
+    } else {
+        $rotdir = '';
+    }
+    my ($movex, $movey) = ($cxt - $cxf,  $cyt - $cyf);
+
+    # Generate the summary
+    return sprintf( '%s@%.3f(%.3f,%.3f)', $rotdir, $scale, $movex, $movey);
+}
+
+
+#
+# Calculate the begining and ending coordinates, after shaving 2 times
+# the margin
+#
+sub calculate_coordinates {
+    my ($length, $margin) = @_;
+    my $skip     = $length - $margin;
+    my $outwidth = $skip - $margin;
+    my @coords = ( &round( &round($skip) - $outwidth ), &round($skip) );
+    return @coords;
+}
+
+
+#
+# Round a float number
+# 
+sub round {
+    return floor ($_[0] + .5);
+}
+
+
+#
+# In-place convert the given length into postscript points
+#
+sub topoints {
+    my $l = $_;
+    return unless defined $$l;
+ 
+    $$l =~ /^([+-]?\d*\.?\d+)(\w*)$/  or  die "Unable to parse `$$l'";
+
+    my $r = $1;
+    if ($2 eq "" or $2 eq "pt") {
+        # nothing
+    } elsif ($2 eq "in") {
+        $r *= 72;
+    } elsif ($2 eq "cm") {
+        $r *= 72/2.54;
+    } elsif ($2 eq "mm") {
+        $r *= 72/25.4;
+    } else {
+        die "Unknown unit: `$2'";
+    }
+    $$l = &round ($r);
+}
+
+
+#
+# In-place set the given width and length to the predefined papersize
+#
+sub papersize {
+    my ($p,$w,$h) = @_;
+
+    if ($p eq "a0") {
+        ($$w,$$h) = ("841mm",  "1189mm");
+    } elsif ($p eq "a1") {
+        ($$w,$$h) = ("594mm",  "841mm");
+    } elsif ($p eq "a2") {
+        ($$w,$$h) = ("420mm",  "594mm");
+    } elsif ($p eq "a3") {
+        ($$w,$$h) = ("297mm",  "420mm");
+    } elsif ($p eq "a4") {
+        ($$w,$$h) = ("210mm",  "297mm");
+    } elsif ($p eq "a5") {
+        ($$w,$$h) = ("148mm",  "210mm");
+    } elsif ($p eq "letter") {
+        ($$w,$$h) = ("8.5in",  "11in");
+    } elsif ($p eq "legal") {
+        ($$w,$$h) = ("8.5in",  "14in");
+    } elsif ($p eq "tabloid") {
+        ($$w,$$h) = ("11in",   "17in");
+    } elsif ($p eq "statement") {
+        ($$w,$$h) = ("5.5in",  "8.5in");
+    } elsif ($p eq "executive") {
+        ($$w,$$h) = ("7.25in", "10.5in");
+    } elsif ($p eq "folio") {
+        ($$w,$$h) = ("8.27in", "13in");
+    } elsif ($p eq "quarto") {
+        ($$w,$$h) = ("9in",    "11in");
+    } elsif ($p eq "10x14") {
+        ($$w,$$h) = ("10in",   "14in");
+    } else {
+        die "Unknown paper size: `$p'";
+    }
+}