#!/usr/bin/env perl

#    
if($#ARGV<1){
print << "EEE"
  usage: $0 [options] -- PS-files
            [-v] (verbose)
            [-NX] (panels in x)
            [-NY] (panels in y)
	    [-or] (orientation  por/psc portrait/landscape, def=por
	    [--]  files follow
	    writes to stdout
	    requires: ghostscript
	    author: J.Raeder, re-written from lousy shell-script 2001-09-20
EEE
}

#..... process command line options
$iv=1; $nx=0; $ny=0; $nf=-1; $xlm=0; $ylm=0; $or='por';
$spreadx=1.0; $spready=1.0; $scale=1.0;
while(@ARGV){
  $s=$ARGV[0];
  if($s eq '-v'){ $iv=1; }
  if($s eq '-or'){ shift(@ARGV); $or=$ARGV[0]; }
  if($s eq '-NX'){ shift(@ARGV); $nx=$ARGV[0]; }
  if($s eq '-NY'){ shift(@ARGV); $ny=$ARGV[0]; }
  if($s eq '-spreadx'){ shift(@ARGV); $spreadx=$ARGV[0]; }
  if($s eq '-spready'){ shift(@ARGV); $spready=$ARGV[0]; }
  if($s eq '-scale'){ shift(@ARGV); $scale=$ARGV[0]; }
  if($s eq '--'){ shift(@ARGV); $nf=0; }
  if($nf>=0){$flist[$nf++]=$ARGV[0];}
  shift(@ARGV);
}
if($iv>0){ print stderr "$0 files:"; for($i=0;$i<$nf;$i++){ print stderr " $flist[$i]"; } print stderr "\n"; }

#...... use ghostscript to determine true bounding boxes
for($j=0;$j<$nf;$j++){
  system('/bin/rm -f tmp.ps.fixbox.*');
  $l=0; open FF,"<$flist[$j]"; while(<FF>){ chop;
  if( ! ( /BoundingBox/ || /psmarksize/ ) ){$ll[$l++]=$_;} } close(FF);  # eliminate old boundigbox
  open FF,">tmp.ps.fixbbox.ps";for($i=0;$i<$l;$i++){print FF "$ll[$i]\n";} close(FF);
  system("echo quit | gs -quiet -sDEVICE=bbox tmp.ps.fixbbox.ps > tmp.ps.fixbbox.01 2>&1");
  if($iv>0){print STDERR "ps.fixbbox:read $l\n";}
  open FF,"<tmp.ps.fixbbox.01";
  $b='%could not get it';while(<FF>){chop; if(/%%BoundingBox:/){$b=$_;} } close(FF);
  if($iv>0){print STDERR "ps.fixbbox:new bbox: $b\n";}
  if($b =~ /%%BoundingBox/){ @a=split(' ',$b);
  $x1[$j]=$a[1]; $y1[$j]=$a[2]; $xl[$j]=$a[3]-$a[1]; $yl[$j]=$a[4]-$a[2]; }
  else{ print stderr "error $0 could not get bounding box from file $flist[$j]\n"; exit; }
  if($xl[$j]>$xlm){$xlm=$xl[$j];} if($yl[$j]>$ylm){$ylm=$yl[$j];}
}
  system('/bin/rm -f tmp.ps.fixbox.*');

#..... now figure out the layout and scaling
if(($nx==0)||($ny==0)){
  if($or eq 'por'){$xx=8.5;$yy=11.0;} if($or eq 'lsc'){$xx=11.0;$yy=8.5;} $x=$xlm; $y=$ylm;
  $fb=0; $mx=1; $my=1;
  for($kx=1;$kx<=40;$kx++){ for($ky=1;$ky<=40;$ky++){
    if($kx*$ky>=$nf){
      $sx=$xx/$kx;
      $sy=$yy/$ky;
      $fx=$sx/$x;
      $fy=$sy/$y;
      $ff=$fx;
      if($fy<$ff){$ff=$fy;}
      if($ff>=$fb){$fb=$ff; $mx=$kx; $my=$ky;}
    }
  }}
  $nx=$mx; $ny=$my;
}
if($or eq 'por'){$sc=&min((612.0/($xlm*$nx)),(796.0/($ylm*$ny))); }
if($or eq 'lsc'){$sc=&min((796.0/($xlm*$nx)),(612.0/($ylm*$ny))); }
$sc=$scale*0.95*$sc;  $sci=1.0/$sc; 

if($iv>0){print stderr "nx,ny,xlm,ylm,sc= $nx $ny $xlm $ylm $sc\n";}

print "%\!\n";
if($or eq 'lsc'){ print "612 0 translate 90 rotate\n"; }

$j=-1;
for($iy=1;$iy<=$ny;$iy++){
for($ix=1;$ix<=$nx;$ix++){
  $j=$j+1;
  if($j<$nf){
    if($or eq 'por'){$xxl=8.5*72.0; $yyl=11.0*72.0;}
    if($or eq 'lsc'){$xxl=11.*72.0; $yyl=8.50*72.0;}
    $xxc=($ix-0.5)*$xxl/$nx; $xxc=0.5*$xxl+$spreadx*0.95*($xxc-0.5*$xxl);
    $yyc=($iy-0.5)*$yyl/$ny; $yyc=0.5*$yyl+$spready*0.95*($yyc-0.5*$yyl);
    if($iv>0){print stderr "ix,iy,xxc,yyx $ix $iy $xxc $yyc\n";}
    $tx=$xxc-$sc*$x1[$j]-0.5*$sc*$xl[$j];
    $ty=$yyc-$sc*$y1[$j]-0.5*$sc*$yl[$j];
  #  if($or eq 'por'){$ty=11.*72-$ty; }
  #  if($or eq 'lsc'){$ty=8.5*72-$ty; }
    print "gsave\n";
    print $tx,' ',$ty," translate\n";
    print " $sc $sc scale\n";
    open FF,"<$flist[$j]"; while(<FF>){ chop; s/showpage//g;
      if( ! /%BoundingBox/ ){ print "$_\n"; }
    }  close(FF);
  #    print "newpath $x1[$j] $y1[$j] moveto ",$x1[$j]+$xl[$j],' ',$y1[$j]+$yl[$j]," lineto stroke\n";
  #    print "newpath $x1[$j] $y1[$j] moveto ",$xl[$j],' ',$yl[$j]," lineto stroke\n";
    print 1.0/$sc,' ',1.0/$sc," scale\n";
    print -$tx,' ',-$ty," translate\n";
    print "grestore\n";
  }
}}
print "showpage\n";

sub min{ local($a,$b)=@_;local($c); $c=$a; if($b<$a){$c=$b;} return($c); }
sub max{ local($a,$b)=@_;local($c); $c=$a; if($b>$a){$c=$b;} return($c); }
sub abs{ local($a)=@_;local($c); $c=$a; if($a<0){$c=-$a;} return($c); }

