impose+ 0.2-12 / usr / bin / impose

#!/usr/bin/perl 
######################################################################
#  An imposition program for doing automatic balanced twoup
#  imposition.
#
#  Copyright (C) 1999 Dov Grobgeld <dov@imagic.weizmann.ac.il>
#  
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
# 
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
# 
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# 
#  For more details see the file COPYING.
######################################################################

my $VERSION = 0.2;

use strict;

my($height,$width,$rtl,$scaling,$pages,$rotdir,$xright,$xleft,$ytop,$ybot);
my($no_tumble, $gutter, $do_stdout, $noglue, $noevenodd, $bboxfile);
my(@bbox,@oddbbox, @evenbbox, $lastbbox);
my($filename, $path, $do_erase_tmp);
my($evenwidth, $evenheight);
my($oddwidth, $oddheight);
my($verbose);

while($_=$ARGV[0],/^-/) {
    shift;

    /^-help/   && do { print <<EOHELP; exit; };
impose - create 2-up files

Syntax:
    impose {options} filename

Description:
    Produces a new file filename.imposed that is a 2-up version of the
    file filename.

Options:
    -letter       Use letter size paper (sets width and height).
    -height h     Set paper height h.
    -width w      Set paper width w.
    -scale s      Force scale of imposed pages to be s.
    -noscale      Equal to -scale 1.0
    -pages p      How many pages bboxx should probe to find document bbox. 
    -xm           Left and right margins along the long side of the page. 
                  Default 30.
    -xrm          Separate right x-margin.
    -xlm          Separate left x-margin.
    -ym           Margin at the top of the page. Default is 40.
    -gutter       Gutter space between the two columns.
    -noglue       Don\'t rubber band extra white space.
    -bbox         Manually set bbox so bboxx won\'t be run.
    -noevenodd    Don\'t use different bounding boxes for even and odd pages.
    -evenbbox     Set even page bbox.
    -oddbbox      Set odd page bbox.
    -lastbbox     Use bbox information of last run of $0.
    -stdout       Print output to stdout.
    -rtl          Do RTL layout of pages
    -v            Verbose operation
    
Author:
    Dov Grobgeld
EOHELP

    /^-letter/ && do { $height = 792; $width=612; next; };
    /^-height/ && do { $height = shift; next; };
    /^-rtl/    && do { $rtl++; next; };
    /^-width/  && do { $width = shift; next; };
    /^-scale/  && do { $scaling = shift; next; };
    /^-noscal/ && do { $scaling=1.0; next; };
    /^-pages/  && do { $pages = shift; next; };
    /^-ud/     && do { $rotdir='R'; next; };
    /^-xm/     && do { $xright = $xleft = shift; next; };
    /^-xrm/    && do { $xright = shift; next; };
    /^-xlm/    && do { $xleft = shift; next; };
    /^-ym/     && do { $ytop = $ybot = shift; next; };
    /^-tmarg/  && do { $ytop = shift; next; };
    /^-bmarg/  && do { $ybot = shift; next; };
    /^-notumble/ && do { $no_tumble++; next; };
    /^-ybot/   && do { $ybot = shift; next; };
    /^-gutter/ && do { $gutter = shift; next; };
    /^-stdout/ && do { $do_stdout++; next; };
    /^-noglue/ && do { $noglue++; next; };
    /^-noevenodd/ && do { $noevenodd++; next };
    /^-bboxfile/ && do { $bboxfile=shift; next; };
    /^-bbox/   && do { $bbox[0]=shift; $bbox[1]=shift; $bbox[2]=shift; $bbox[3]=shift; next; }; 
    /^-evenbbox/  && do { $evenbbox[0]=shift; $evenbbox[1]=shift; $evenbbox[2]=shift; $evenbbox[3]=shift; next; }; 
    /^-oddbbox/  && do { $oddbbox[0]=shift; $oddbbox[1]=shift; $oddbbox[2]=shift; $oddbbox[3]=shift; next; }; 
    /^-lastbbox/ && do { $lastbbox++; next };
    /^-v/ && do {$verbose++; next; };
    die "Unknown option $_!\n";
}

# defaults
$height=842 unless $height;
$width=595 unless $width;
$xright=30 unless $xright;
$xleft=30 unless $xleft;
$gutter=40 unless $gutter;
$ytop=30 unless $ytop;
$ybot=30 unless $ybot;
$pages=6 unless defined $pages;
$rotdir="L" unless $rotdir;

$filename = shift or do {
    $filename = "/tmp/$ENV{USER}-tmp.ps";
    open(TMP, ">$filename");
    while(<>) { print TMP; }
    close(TMP);
    $do_stdout++;
    $do_erase_tmp++;
};
#die "Couldn't get filename!\n";
-f $filename || die "No such file $filename!\n";

if ($filename =~ m|/([^/]*)$|) {
    $filename = $1;
    $path = $`;
}
else {
    $path = ".";
}

# get the bounding box
if ($bboxfile) {
    open(BB,"$bboxfile");
    $_=<BB>; @oddbbox=split;
    $_=<BB>; @evenbbox=split;
    @oddbbox = @evenbbox unless @evenbbox;
    close(BB);
}
elsif ($lastbbox && -e "/tmp/bboxx-$ENV{USER}") {
    open(BB,"/tmp/bboxx-$ENV{USER}");
    $_=<BB>; @oddbbox=split;
    $_=<BB>; @evenbbox=split;
    close(BB);
    # print "oddbbox = @oddbbox\n";
    # print "evenbbox = @evenbbox\n";
}
elsif (@bbox) {
    @oddbbox=@bbox;
    @evenbbox=@bbox;
}
elsif (!@oddbbox || !@evenbbox) {
    @oddbbox=(0,0,0,0);
    @evenbbox=(0,0,0,0);
    &getboundingboxes("$path/$filename", @oddbbox, @evenbbox);
}

@evenbbox = @oddbbox if $noevenodd;

# record the bboxx information
open(BB, ">/tmp/bboxx-$ENV{USER}");
print BB "@oddbbox\n@evenbbox\n";
close(BB);

# Do page calculations
$oddwidth = $oddbbox[2]-$oddbbox[0];
$oddheight = $oddbbox[3]-$oddbbox[1];
$evenwidth = $evenbbox[2]-$evenbbox[0];
$evenheight = $evenbbox[3]-$evenbbox[1];

# Check for lone page...
if ($evenwidth <= 0) {
    $evenwidth = $oddwidth;
    $evenheight = $oddheight;
}

unless ($scaling) {
    $scaling = ($height/2 - $gutter/2 - $xleft) / $oddwidth;
    if ($oddheight*$scaling > $width - $ytop - $ybot) {
        $scaling = ($width - $ytop - $ybot) / $oddheight;
    }
}

# for ($oddheight,$oddweight,$evenheight, $evenwidth) { $_*= $scaling } # perl5

$oddheight *= $scaling;
$oddwidth *= $scaling;
$evenheight *= $scaling;
$evenwidth *= $scaling;

# scale bboxes
foreach (@oddbbox) { $_ = sprintf("%.1f",$_*$scaling); }
foreach (@evenbbox) { $_ = sprintf("%.1f",$_*$scaling); }

# readjust xleft, ytop, and gutter in a TeX glue like manner
unless ($noglue) {
    my $mpg = $height - $oddwidth - $evenwidth; # xmargins + gutter
    my $r = $xleft/($gutter+$xleft+$xright);
    my $r1= $xright/($gutter+$xleft+$xright);
    $xleft= $mpg*$r;
    $xright= $mpg*$r1;
    $gutter= $mpg*(1-$r-$r1);
    my $ym = $width - $oddheight;      # ymargins
    my $s = $ytop / ($ytop + $ybot);
    $ytop = $ym * $s;
    $ybot = $ym * (1-$s);
} 

my $shifty = sprintf("%.1f", $ytop+$oddbbox[3]);
my $shiftoddx = sprintf("%.1f",$xleft-$oddbbox[0]);
my $shiftevenx = sprintf("%.1f", $height-$xright-$evenwidth - $evenbbox[0]);
$scaling= sprintf("%.4f", $scaling);

my($pstops_prm, $pstops_swtch);
if ($rtl) {
    $pstops_prm = "2:1${rotdir}\@${scaling}($shifty,$shiftoddx)+0${rotdir}\@${scaling}($shifty,$shiftevenx)";
}
else {
    $pstops_prm = "2:0${rotdir}\@${scaling}($shifty,$shiftoddx)+1${rotdir}\@${scaling}($shifty,$shiftevenx)";
}

$pstops_swtch = " -q " unless $verbose;

my $out = "|fixtd -tumble" unless $no_tumble;
$out .= "> '$filename.imposed'" unless $do_stdout;
my $cmd="pstops $pstops_swtch '$pstops_prm' '$path/$filename' $out";
print STDERR $cmd,"\n" if $verbose;
system $cmd;
unlink "$path/$filename" if $do_erase_tmp;

sub getboundingboxes {
    my ($filename) = $_[0];
    my($bboxinfo);

    # This should really only look for some reasonable amount of pages...
    $pages = "-pages $pages" if $pages;
    my $cmd= "bboxx -evenodd $pages '$filename'";
    print STDERR "$cmd\n" if $verbose;
    $_ = `$cmd`;
    print STDERR if $verbose;

    # Get the odd pages bounding box
    my ($llx,$lly,$urx,$ury) = /Odd: \s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/;

    $_[1] = $llx;
    $_[2] = $lly;
    $_[3] = $urx;
    $_[4] = $ury;

    # Get the even pages bounding box
    ($llx,$lly,$urx,$ury) = /Even: \s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/;
    $_[5] = $llx;
    $_[6] = $lly;
    $_[7] = $urx;
    $_[8] = $ury;
}