#!/usr/bin/env perl
# epstotiff - A script to transform an EPS file to TIFF
# based on epstopdf 1999/05/06 v2.5 by Sebastian Rahtz, Heiko Oberdiek, et al
#
# It needs a Level 2 PS interpreter.

use warnings;

### program identification
my $program = "epstotiff";
my $filedate="2002/05/23";
my $fileversion="0.2";
my $copyright = "Copyright 2000 Stewart C. Russell\n (based on epstopdf 1999/05/06 v2.5,\n  Copyright 1998,1999 by Sebastian Rahtz et al.)";
my $title = "\U$program\E $fileversion, $filedate - $copyright\n";

### ghostscript command name
my $GS = "gs";
$GS = "gswin32c" if $^O eq 'MSWin32';
$GS = "gswin32c" if $^O =~ /cygwin/;

### options
$::opt_help=0;
$::opt_debug=0;
# $::opt_compress=1;
$::opt_gs=1;			# not used, but kept
$::opt_hires=0;
$::opt_exact=0;
$::opt_filter=0;
$::opt_outfile="";
# added tiff options
$::opt_type="tiffg4"; # tiff24nc or tiffg4 seem to be the only options
$::opt_resolution=100;		# dpi
$::opt_talpha=1;		# 1 (off), 2 or 4 bits of alpha
$::opt_galpha=1;
# added showpage fudge
$::opt_showpage=0;

### usage
my @bool = ("false", "true");
my $usage = <<"END_OF_USAGE";
${title}Syntax:  $program [options] <eps file>
Options:
  --help:           print usage
  --outfile=<file>: write result to <file>
  --(no)filter:     read standard input   (default: $bool[$::opt_filter])
  --(no)hires:      scan HiResBoundingBox (default: $bool[$::opt_hires])
  --(no)exact:      scan ExactBoundingBox (default: $bool[$::opt_exact])
  --(no)debug:      debug informations    (default: $bool[$::opt_debug])
  --(no)showpage:   add showpage fudge    (default: $bool[$::opt_showpage])
  --type=<gsdev>    gs TIFF device type   (default: $::opt_type)
  --resolution=dpi  output resolution     (default: $::opt_resolution)
  --talpha=[124]    text alpha bits       (default: $::opt_talpha)
  --galpha=[124]    graphics alpha bits   (default: $::opt_galpha)
Examples for producing 'test.tif':
  * $program test.eps
  * produce postscript | $program --filter >test.tif
  * produce postscript | $program -f -d -o=test.tif
END_OF_USAGE

### process options
use Getopt::Long;
GetOptions (
  "help!",
  "debug!",
  "showpage!",
  "filter!",
  "hires!",
  "exact!",
  "outfile=s",
  "type=s",
  "resolution=i",
  "talpha=i",
  "galpha=i"
) or die $usage;

### help functions
sub debug {
  print STDERR "* @_\n" if $::opt_debug;
}
sub warning {
  print STDERR "==> Warning: @_!\n";
}
sub error {
  die "$title!!! Error: @_!\n";
}
sub errorUsage {
  die "$usage\n!!! Error: @_!\n";
}

### option help
die $usage if $::opt_help;

### get input filename
my $InputFilename = "";
if ($::opt_filter) {
  @ARGV == 0 or 
    die errorUsage "Input file cannot be used with filter option";
  $InputFilename = "-";
  debug "Input file: standard input";
}
else {
  @ARGV > 0 or die errorUsage "Input filename missing";
  @ARGV < 2 or die errorUsage "Unknown option or too many input files";
  $InputFilename = $ARGV[0];
  -f $InputFilename or error "'$InputFilename' does not exist";
  debug "Input filename:", $InputFilename;
}

my $GSOPTS = "";
### option compress -- NOT NEEDED
# $GSOPTS = "-dUseFlateCompression=false " unless $::opt_compress;

### option resolution
my $resolution=$::opt_resolution;
if ($resolution < 1) {		# fix res to default if a useless one set
  $resolution=600;
}
$GSOPTS .= "-r$resolution ";
debug "Resolution: $resolution dpi";

### option talpha
my $textalpha=$::opt_talpha;
if ($textalpha > 4) {		# set ceiling on alpha bits
  $textalpha=4;
}
if ($textalpha > 1) {		# switch alpha on if required
  $GSOPTS .= "-dTextAlphaBits=$textalpha ";
  debug "Text Alpha Bits: $textalpha";
}

### option galpha
my $graphicsalpha=$::opt_galpha;
if ($graphicsalpha > 4) {		# set ceiling on alpha bits
  $graphicsalpha=4;
}
if ($graphicsalpha > 1) {		# switch alpha on if required
  $GSOPTS .= "-dGraphicsAlphaBits=$graphicsalpha ";
  debug "Graphics Alpha Bits: $graphicsalpha";
}

# tiff24nc or tiffg4 seem to be the only options that work
### option type
my $gsdev = $::opt_type;
if (($textalpha > 1) or ($graphicsalpha > 1)) {	# use alpha-capable device
  $gsdev = "tiff24nc" if ($gsdev =~ /^tiff/);
}
debug "Output device: $gsdev";

# showpage option
debug "Trailing showpage added" if $::opt_showpage;

### option BoundingBox types
my $BBName = "%%BoundingBox:";
!($::opt_hires and $::opt_exact) or
  error "Options --hires and --exact cannot be used together";
$BBName = "%%HiResBoundingBox:" if $::opt_hires;
$BBName = "%%ExactBoundingBox:" if $::opt_exact;
debug "BoundingBox comment:", $BBName;

### option outfile
my $OutputFilename = $::opt_outfile;
if ($OutputFilename eq "") {
  if ($::opt_gs) {
    $OutputFilename = $InputFilename;
    if (!$::opt_filter) {
      $OutputFilename =~ s/\.[^\.]*$//;
      $OutputFilename .= ".tif";
    }
  }
  else {			# this shouldn't ever happen
    $OutputFilename = "-"; # standard output
  }
}
if ($::opt_filter) {
  debug "Output file: standard output";
}
else {
  debug "Output filename:", $OutputFilename;
}

### option gs
if ($::opt_gs) {
  debug "Ghostscript command:", $GS;
#  debug "Compression:", ($::opt_compress) ? "on" : "off";
}

### open input file
open(IN,"<$InputFilename") or error "Cannot open", 
  ($::opt_filter) ? "standard input" : "'$InputFilename'";
binmode IN;

### open output file
if ($::opt_gs) {
  my $pipe = "$GS -q -sDEVICE=$gsdev $GSOPTS " .
    "-sOutputFile=$OutputFilename - -c quit";
  debug "Ghostscript pipe:", $pipe;
  open(OUT,"|$pipe") or error "Cannot open Ghostscript for piped input";
}
else {				# this can never happen
  open(OUT,">$OutputFilename") or error "Cannot write '$OutputFilename";
}

#
### nothing tiff specific after here
#

### scan first line
my $header = 0;
$_ = <IN>;
if (/%!/) {
  # throw away binary junk before %!
  s/(.*)%!/%!/o;
}
$header = 1 if /^%/;
debug "Scanning header for BoundingBox";
print OUT;

### variables and pattern for BoundingBox search
my $bbxpatt = '[0-9eE\.\-]';
               # protect backslashes: "\\" gets '\'
my $BBValues = "\\s*($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)";
my $BBCorrected = 0;

sub CorrectBoundingBox {
  my ($llx, $lly, $urx, $ury) = @_;
  debug "Old BoundingBox:", $llx, $lly, $urx, $ury;
  my ($width, $height) = ($urx - $llx, $ury - $lly);
  my ($xoffset, $yoffset) = (-$llx, -$lly);
  debug "New BoundingBox: 0 0", $width, $height;
  debug "Offset:", $xoffset, $yoffset;

  print OUT "%%BoundingBox: 0 0 $width $height\n";
  print OUT "<< /PageSize [$width $height] >> setpagedevice\n";
  print OUT "gsave $xoffset $yoffset translate\n";
}

### scan header
if ($header) {
  while (<IN>) {

    ### end of header
    if (!/^%/ or /^%%EndComments/) {
      print OUT;
      last;
    }

    ### BoundingBox with values
    if (/^$BBName$BBValues/) {
      CorrectBoundingBox $1, $2, $3, $4;
      $BBCorrected = 1;
      last;
    }

    ### BoundingBox with (atend)
    if (/^$BBName\s*\(atend\)/) {
      debug $BBName, "(atend)";
      if ($::opt_filter) {
        warning "Cannot look for BoundingBox in the trailer",
                "with option --filter";
        last;
      }
      my $pos = tell(IN);
      debug "Current file position:", $pos;

      # looking for %%BoundingBox
      while (<IN>) {
        # skip over included documents
        if (/^%%BeginDocument/) {
          while (<IN>) {
            last if /^%%EndDocument/;
          }
        }
        if (/^$BBName$BBValues/) {
          CorrectBoundingBox $1, $2, $3, $4;
          $BBCorrected = 1;
          last;
        }
      }

      # go back
      seek(IN, $pos, 0) or error "Cannot go back to line '$BBName (atend)'";
      last;
    }
    
    # print header line
    print OUT;
  }
}

### print rest of file
while (<IN>) {
  print OUT;
}

### close files
close(IN);
print OUT "grestore\n" if $BBCorrected;
print OUT "showpage\n" if $::opt_showpage;
close(OUT);
warning "BoundingBox not found" unless $BBCorrected;
debug "Ready.";
;