Project CMSSW displayed by LXR

0001 #!/usr/bin/env perl
0002 use warnings;
0003 use strict;
0004
0005 my $usage = "$0 [--media={a0,a1,a2,a3,a4,a5,a6}] [--margin=DIM] [--prefix=PFX] FILE...\n";
0006 my %sizes = ( 'a0' => [2379, 3364],
0007               'a1' => [1682, 2379],
0008               'a2' => [1189, 1682],
0009               'a3' => [841, 1189],
0010               'a4' => [595, 841],
0011               'a5' => [421, 595],
0012               'a6' => [298, 421] );
0013
0014 my $prefix = "A4";
0015 my $margin = 20;
0016 my $xsize = 595;
0017 my $ysize = 841;
0018
0019 while (scalar @ARGV && $ARGV[0] =~ /^--(.*)$/) {
0020   my $arg = $1;
0021   if ($1 =~ /^media=(.*)/) {
0022     die "media `$1' not recognised\n" if ! exists $sizes{$1};
0023     $xsize = $sizes{$1}[0];
0024     $ysize = $sizes{$1}[1];
0025     $prefix = uc($1);
0026   } elsif ($1 =~ /^margin=(.*)/) {
0027     $margin = $1;
0028   } elsif ($1 =~ /^prefix=(.*)/) {
0029     $prefix = $1;
0030   } else {
0031     print STDERR "unrecognised option `$arg'\n";
0032     die $usage;
0033   }
0034   shift(@ARGV);
0035 }
0036
0037 foreach my $file (@ARGV) {
0038   my $out = $file;
0039   $out =~ s|.*/||;
0040   $out = "$prefix-$out";
0041
0042   open(PS, "< $file") || die "$file: cannot read: $!\n";
0043   open(OUT, "> $out") || die "$out: cannot write: $!\n";
0044
0045   my $scale = 1;
0046   my @offset = (0, 0);
0047   my $swap = 0;
0048   my $xmargin = 0;
0049   my $ymargin = 0;
0050   my $didscale = 0;
0051
0052   while (<PS>) {
0053     if (/^\%\%(Page|)BoundingBox:\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*$/) {
0054       my ($llx, $lly, $urx, $ury) = ($2, $3, $4, $5);
0055       my ($width, $height) = ($urx - $llx, $ury - $lly);
0056       my $max = ($urx > $ury ? $urx : $ury);
0057       $swap = ($max eq $urx && $urx > $xsize - 2*$margin);
0058
0059       my $refx = (!$swap ? $urx : $ury);
0060       my $refy = (!$swap ? $ury : $urx);
0061       $scale = ($refx * $scale <= $xsize - 2*$margin
0062                 ? $scale : int(($xsize-2*$margin) / $refx * 100.0) / 100.0);
0063       $scale = ($refy * $scale <= $ysize - 2*$margin
0064                 ? $scale : int(($ysize-2*$margin) / $refy * 100.0) / 100.0);
0065
0066       my $nwidth  = (!$swap ? $width : $height) * $scale;
0067       my $nheight = (!$swap ? $height : $width) * $scale;
0068       my $nllx    = (!$swap ? $llx * $scale : $xsize - $margin - $ury * $scale);
0069       my $nlly    = (!$swap ? $lly : $llx) * $scale;
0070
0071       if ($nllx < $margin) {
0072         $xmargin = $margin - $nllx;
0073         $nllx = $margin;
0074       }
0075       if ($nlly < $margin) {
0076         $ymargin = $margin - $nlly;
0077         $nlly = $margin;
0078       }
0079       my @nbbox = (int($nllx), int($nlly),
0080                    int($nllx + $nwidth + .5),
0081                    int($nlly + $nheight + .5));
0082
0083       print OUT "%%" . ($1 ? $1 : "") . "Orientation: "
0084         . ($swap ? "Landscape\n" : "Portrait\n");
0085       $_ = "%%" . ($1 ? $1 : "") . "BoundingBox: " . join(" ", @nbbox) . "\n";
0086     }
0087     if (/^\%\%End(Setup|Prolog)/) {
0088       if (! $didscale) {
0089         $didscale = 1;
0090         print OUT "90 rotate 0 -$xsize $margin add translate\n" if ($swap);
0091         print OUT sprintf "%d %d translate\n",
0092           int(!$swap ? $xmargin : $ymargin),
0093           int(!$swap ? $ymargin : -$xmargin);
0094         print OUT "$scale $scale scale\n" if ($scale ne 1);
0095       }
0096     }
0097     print OUT;
0098   }
0099   close(OUT);
0100   close(PS);
0101 }