#!/usr/bin/perl -w
use strict;
require 5.002;
# ************************************************************ #
# perl: psfix
# PURPOSE: general program for adjusting size,rotation,scaling of
#   postscript images.
# NOTES: 
# SCCS: @(#)psfix.pl	1.3 5/26/92
# HISTORY:
#       murray - Apr 29, 1992: Created.
# ************************************************************ #

#
# port to perl5 by Denis N. Antonioli <antonio@ifi.unizh.ch>
#  1.0  27 4 1997
#

# ##################################################################### #
# (C) 1992 D Murray Laing, D.M.Laing@uk.ac.edinburgh
#          c/o Department of Chemical Engineering,
#              University of Edinburgh,
#              Edinburgh,
#              Scotland
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License version 2 as
#    published by the Free Software Foundation.
# 
#    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., 675 Mass Ave, Cambridge, MA 02139, USA.
# ###################################################################### #

# ============================================================ #
# Set Up PSMulti Search Paths
# ============================================================ #

my @DefaultPSMultiLibPath=( '/usr/share/psmulti' );

if ( defined $ENV{'PSMULTILIBPATH'} ) {
	unshift(@INC,split(/:/,$ENV{'PSMULTILIBPATH'}));
    @::PSPPIncludePath=split(/:/, $ENV{'PSMULTILIBPATH'});
} else {
	unshift(@INC, @DefaultPSMultiLibPath);
    @::PSPPIncludePath=@DefaultPSMultiLibPath;
}


%::StandardBBox=( 'page',   '/Default',
				 'a5',     '20 20 401 574'   ,
				 'a4',     '20 20 574 822'   ,
				 'a3',     '20 20 822 1168'  ,
				 'a2',     '20 20 1168 1664' ,
				 'letter', '18 3 594 789'  ,
				 'note',   '29 30 583 761' ,
				 'legal',  '64 36 548 972'
				 );

# ============================================================ #
#             Variables
# ============================================================ #
my($verbose, $StdinTmpFile, $OutFile, $InFile, $TmpFile);
my($Border, $MarginX, $MarginY, $Rotate, $ScaleX, $ScaleY);
my($JustX, $JustY, $DoShowpage, $SelectBy, $SelectPage);
my($usefbbox, $LPageBBox, $ImageBBox, @ImageBBox, $DynamicFit, $FitBBox);
my(@LPageBBox, @FitBBox, $TM, @TM, @order);
my($dsc_ok, %DSC); 
# ============================================================ #
#             Error Handling Routine
# ============================================================ #

my $ProgName = $0;
$ProgName = $1 if ( $0 =~ m|.*/([^/]*)|o );

sub error {
    print STDERR "$ProgName: @_\n";
    exit 1;
}

sub warning {
    print STDERR "$ProgName: @_\n";
}

sub info {
	print STDERR "$ProgName: @_\n" if defined $verbose;
}

# ============================================================ #
#    Define Subroutine and Load Libraries
# ============================================================ #

require "bbox-util.pl";
require "dsc-util.pl";
require "pspp-util.pl";

sub round {
	my($num, $acc)=@_;
    my($raised, $floor);
    
    $acc=0 unless defined $acc;

    $raised=$num*10**$acc;
    $floor=int($raised);

    $floor++ if ( $raised - $floor > 0.5 );

    $floor/(10**$acc);
}

# ============================================================ #
#                    Argument Processing
# ============================================================ #

while( $#ARGV >= 0 ) {
    $_=splice(@ARGV,0,1);

    if ( /^-v/ ) { $verbose=1; }

    elsif ( /^-o/ ) { $OutFile=splice(@ARGV,0,1); }

    # Add a special border #
    elsif ( /^-border$/ ) { $Border=splice(@ARGV,0,1); }
           
    # Margin #
    elsif ( /^-m(-?[0-9\.]+)/ ) { $MarginX=$1; $MarginY=$1; }
    elsif ( /^-m$/ ) {
		if ( $ARGV[0] =~ /^-?[\d\.]+$/ && $ARGV[1] =~ /^-?[\d\.]+$/ ) {
			($MarginX, $MarginY)=splice(@ARGV,0,2);
		} else {
          &error('Incorrect Margin Specification');
	  }
	}

    # Rotation Arguments #
    
    elsif ( /^-l$/ )           { $Rotate=-90; }
    elsif ( /^-p$/ )           { $Rotate=0; }
    elsif ( /^-r(-?[\d\.]+)/ ) { $Rotate=$1; }
    elsif ( /^-r$/ ) {
		if ( $ARGV[0] =~ /^-?[\d\.]+$/ ) {
			$Rotate=splice(@ARGV,0,1);
		} else {
          &error('Incorrect Rotation Specification');
	  }
	}

    # Scaling #
    
    elsif ( /^-s(-?[\d\.]+)$/ ) { $ScaleX=$1; $ScaleY=$1; }
    elsif ( /^-s$/ ) {
		if ( $ARGV[0] =~ /^-?[\d\.]+$/ && $ARGV[1] =~ /^-?[\d\.]+$/ ) {
			($ScaleX,$ScaleY)=splice(@ARGV,0,2);
		} else {
			&error('Incorrect Scaling Specification');
		}
	}

    elsif ( /^-maxpect/ )  { $ScaleX='/Ratio'; $ScaleY='/Ratio'; }
    elsif ( /^-maxxy/ )    { $ScaleX='/Max'; $ScaleY='/Max'; }
    elsif ( /^-maxx$/ )    { $ScaleX='/Max'; }
    elsif ( /^-maxy$/ )    { $ScaleY='/Max'; }

    # Justification #

    elsif( /^-j/ )        { ($JustX,$JustY)=splice(@ARGV,0,2); }

    elsif( /^-centerx/ )  { $JustX='/Center'; }
    elsif( /^-centery/ )  { $JustY='/Center'; }
    elsif( /^-left/ )     { $JustX='/Left'; }
    elsif( /^-right/ )    { $JustX='/Right'; }
    elsif( /^-top/ )      { $JustY='/Top'; }
    elsif( /^-bottom/ )   { $JustY='/Bottom'; }

    # Showpage or No Showpage #
    elsif ( /^-nsp/ ) { $DoShowpage='false'; }
    elsif ( /^-sp/ )  { $DoShowpage='true'; }
 
    # Page Selection #
    elsif (/^-select/ ) {
		$_=splice(@ARGV,0,1);
        
        if ( /^ordinal/ ) {
			$SelectBy='PageOrdinal';  $SelectPage=splice(@ARGV,0,1);
		} elsif ( /^label/ ) {
			$SelectBy='PageLabel';    $SelectPage=splice(@ARGV,0,1);
		} else {
			$SelectBy='PageOrdinal';  $SelectPage=$_;
		}
	}
   
    # Bounding Box to Fit to #

    elsif ( /^-usefbbox/ )  { $usefbbox=1; }
    
    elsif ( /^-fbbox/ ) { 
        if ( defined $::StandardBBox{$ARGV[0]} ) {
			$LPageBBox=$::StandardBBox{$ARGV[0]}; shift @ARGV;

		} elsif ( $ARGV[0] =~ /^-?\d+$/ && $ARGV[1] =~ /^-?\d+$/ &&
                $ARGV[2] =~ /^-?\d+$/ && $ARGV[3] =~ /^-?\d+$/
				 ) {
			$LPageBBox="$1 $2 $3 $4"; splice(@ARGV,0,4);
        } else {
			&error('Incorrect FitBBox Specification' );
		}
	}

    # Image Bounding Box #

    elsif ( /^-ibbox/ ) { 
        if ( defined $::StandardBBox{$ARGV[0]} ) {
			$ImageBBox=$::StandardBBox{$ARGV[0]}; shift @ARGV;
		} elsif ( $ARGV[0] =~ /^-?\d+$/ && $ARGV[1] =~ /^-?\d+$/ &&
                $ARGV[2] =~ /^-?\d+$/ && $ARGV[3] =~ /^-?\d+$/
				 ) {
			$ImageBBox="$1 $2 $3 $4";  splice(@ARGV,0,4);
		} else {
			&error('Incorrect ImageBBox Specification' );
		}
	}

    # Input File #
    elsif ( /^-$/ ) {
		require "file-util.pl";
        if ( ($InFile = &stdin_to_tmp("/tmp/$ProgName")) ) {
			$TmpFile=$InFile;
		} else {
			&error($@);
		}
	}

    elsif ( -f )  { $InFile=$_; }

    # Unknown Argmuent

    else { &error("Uknown argument $_"); }

}


# ============================================================ #
#     Open INPUT and OUTPUT File Pointers
# ============================================================ #

# Make Sure We Have Got a fixed file for input #

if( ! defined $InFile ) {
	require "file-util.pl";
    if ( ($InFile=&stdin_to_tmp("/tmp/$ProgName")) ) {
		$TmpFile=$InFile;
	} else {
		&error($@);
	}
}

# Open Input #
open(INPUT,"<$InFile") || &error($@);

# Open Output #
if ( ! defined $OutFile ) {
	*OUTPUT = *STDOUT;
} else {
	open(OUTPUT,">$OutFile") || &error($@);
}

# ============================================================ #
# Check whether document is conformant & that we are only
# trying to print one page.
# ============================================================ #

$dsc_ok = &read_dsc_param(\*INPUT,\%DSC);
if ( ! $dsc_ok ) {
	&info("Document non-conformant\n");
} elsif ( defined $DSC{'Pages'} && $DSC{'Pages'} > 1 && (! defined $SelectPage) ) {
	&error('Use psmulti to modify multipage documents');
}

# ============================================================ #
#    Now Check and Work Out the New Bounding Boxes
# ============================================================ #

if ( ! defined $ImageBBox ) {
    if ($DSC{'BoundingBox'} =~
         /(-?[\d\.]+)[\s,]+(-?[\d\.]+)[\s,]+(-?[\d\.]+)[\s,]+(-?[\d\.]+)/
		) {
      $ImageBBox="$1 $2 $3 $4";
  } else {
      $ImageBBox=$::StandardBBox{'a4'};
  }
}

if ( $ImageBBox eq '/Default' ) {
	$DynamicFit=1;
} else {
	@ImageBBox = split(/\s+/, $ImageBBox);
}

$LPageBBox = $::StandardBBox{'a4'} unless defined $LPageBBox;

if ( $LPageBBox eq '/Default' ) {
	$DynamicFit=1; $FitBBox = $LPageBBox;
} else {
	@LPageBBox=split(/\s+/, $LPageBBox);
	if( defined $MarginX && $MarginY ) {
		@FitBBox=&BBoxMargin(-$MarginX, -$MarginY, @LPageBBox);
	} else {
		@FitBBox=@LPageBBox;
	}

	$FitBBox=join(' ', @FitBBox);
}

if ( !($DynamicFit == 1 || defined $Border) ) {
    &info('Fitting in Bounding Box: ' . $FitBBox);

    $Rotate=0        unless defined $Rotate;
    $ScaleX='/Ratio' unless defined $ScaleX;
    $ScaleY='/Ratio' unless defined $ScaleY;
    $JustX='/Center' unless defined $JustX;
    $JustY='/Center' unless defined $JustY;

    @FitBBox=&BBoxFit(\@ImageBBox, \@FitBBox, \@TM,
                    $Rotate,$ScaleX,$ScaleY,$JustX,$JustY
                   );


    $FitBBox=sprintf('%d %d %d %d', @FitBBox);
    $TM = sprintf('%5.3f %5.3f %5.3f %5.3f %5.3f %5.3f', @TM);

    &info('Original Image Bounding Box: ' . $ImageBBox);
    &info("New Image Bounding Box:  $FitBBox");
    &info('New TM = [ ' . $TM . ' ]');
}

# ============================================================ #
#     Print Modified Image
# ============================================================ #

select OUTPUT;

# -------------------------------------------------- #
#                 DSC Header
# -------------------------------------------------- #

print '%!PS-Adobe-2.0 ';

if ( $DoShowpage eq 'false' )              { print 'EPSF-1.2'; }
elsif (  $DSC{'Magic'} =~ /(EPSF[^\s]*)/ ) { print $1; }
print "\n";

print "%%Creator: $ProgName (from $InFile)\n%%Pages: 1\n";

if ( $LPageBBox eq '/Default' ) {
	print "%%BoundingBox: Page Dependent\n";
} elsif ( $usefbbox || defined $Border ) {
	print "%%BoundingingBox: $LPageBBox\n";
} else {
	print "%%BoundingingBox: $FitBBox\n";
}

print "%%EndComments\n";

# -------------------------------------------------- #
#                My Prolog
# -------------------------------------------------- #

print "%%BeginProlog\n";

# First Define The Showpage operator if requested #
if ( $DoShowpage eq 'false' ) {
	print "/showpage {} def\n";
} elsif ( $DoShowpage eq 'true' ) {
	&pspp_cat('psfix-showpage.ps') || &error($@);
}


if ( defined $Border ) {
    # To Apply a PSmulti Border requires a significant bit of prolog #
    &pspp_cat('psfix-border.ps',
                {'StyleFile' => "border-$Border.ps",
				 'NoReset'  => 'true'
				 }
			  )
      || &error($@);

    print "/StartParam\n";
    foreach ( ('ImageBBox', 'LPageBBox', 'FitBBox',
              'Rotate', 'MarginX', 'MarginY', 'ScaleX', 'ScaleY')
            ) {
		my $value=eval "\$$_";
        if ( $value =~ /^\s*$/ ) { print '/Default'; }
        else { print $value; }
        print "/$_\n";
      }
    print "/EndParam\nBeginDocument\n";
  }

elsif ( $DynamicFit == 1 ) { 
	# Require BBox-util to dynamical scale and position image #

    $Rotate=0        unless defined $Rotate;
    $ScaleX='/Ratio' unless defined $ScaleX;
    $ScaleY='/Ratio' unless defined $ScaleY;
    $JustX='/Center' unless defined $JustX;
    $JustY='/Center' unless defined $JustY;

    &pspp_cat('bbox-util.ps') || &error($@);

    if ( $ImageBBox eq '/Default' ) {
		print "gsave newpath clippath flattenpath pathbbox grestore\n";
        if ( defined $MarginX && defined $MarginY ) {
			print "$MarginX -1 mul $MarginY -1 mul BBoxMargin\n"; 
		}
	} else {
		print "$ImageBBox\n";
	}

    if ( $FitBBox eq '/Default' ) {
		print "gsave newpath clippath flattenpath pathbbox grestore\n";
	} else {
		print "$FitBBox\n";
	}

    print "$Rotate /Rotate\n$ScaleX $ScaleY /Scale\n";
    print "$JustX $JustY /Justify\nBBoxFit\n";
} else {
    # If There is no border and no dynamic fit then prolog is simple #
    print "[ $TM ] concat\n";
}

# -------------------------------------------------- #
#               Document Body
# -------------------------------------------------- #

print "%*%%BeginDocument: $InFile\n";

if ( defined $SelectPage ) {
    if ( (! $dsc_ok) || (! &read_dsc(\*INPUT, \%DSC) ) ) {
		&error('Document non-conformant cannot select page');
	}

    @order = &page_order(\%DSC, $SelectPage, $SelectBy);

    if ( $#order > 0 ) {
		&error('Can only select one page from a document'); 
	}

    if ( $#order < 0 ) {
		&error('Invalid page specification given');
	}

    print "%*%%BeginProlog\n";
    &cat_region(\*INPUT, \*OUTPUT, $DSC{'BeginProlog'}, $DSC{'EndProlog'});
    print "%%EndProlog\n";

    if ( defined $DSC{'BeginSetup'} ) {
		print "%%BeginSetup\n";
        &cat_region(\*INPUT, \*OUTPUT, $DSC{'BeginSetup'}, $DSC{'EndSetup'});
        print "%%EndSetup\n";
	}

    print "%%Page: ? 1\n";
    print "%*%%Page: ? $order[0]\n";
    &cat_region(\*INPUT, \*OUTPUT,
                $DSC{"StartPage:$order[0]"}, $DSC{"EndPage:$order[0]"}
               );

    print "%%Trailer\n";
    &cat_region(\*INPUT, \*OUTPUT, $DSC{'Trailer'}, $DSC{'EndTrailer'});
    print "%%EndDocument\n";
    
} else {
	my $found_trailer;
    print "%%EndProlog\n%%Page: ? 1\n" unless $dsc_ok;

    seek(INPUT,0,0);
    
    while ( <INPUT> ) {
		# Make Sure We Keep the important DSC Comments
		# Comment out the others.

		if ( /^%%EndProlog/ || /^%%Page:/ ) {
			print $_ if $dsc_ok;
		} elsif ( /^%%Trailer/ ) {
            print $_; $found_trailer=1;
		} elsif ( /^%%BeginSetup/ || /^%%EndTrailer/ ) {
			print $_;
		} elsif ( /^%%/ ) {
			print "%*$_";
		} else {
			print $_;
		}
	}
    print "%*%%EndDocument\n";

    print "%%Trailer\n" unless defined $found_trailer;
}


# -------------------------------------------------- #
#                My Trailer
# -------------------------------------------------- #

# Close dictionary used to disable DoShowpage #
print "showpage\n" if $DoShowpage == 1;

# ============================================================ #
#                     Tidy Things Up
# ============================================================ #

close(INPUT);
close(OUTPUT);

unlink $TmpFile if ( defined $TmpFile && -f $TmpFile );
