source: trunk/doc/epstosmth

#!/usr/bin/env perl

# Copyright 1998-2001 by Sebastian Rahtz et al.
# epstopdf 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.
#
# epstopdf 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 epstopdf; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;

# A script to transform an EPS file so that:
#   a) it is guarenteed to start at the 0,0 coordinate
#   b) it sets a page size exactly corresponding to the BoundingBox
# This means that when Ghostscript renders it, the result needs no
# cropping, and the PDF MediaBox is correct.
#   c) the result is piped to Ghostscript and a PDF version written
#
# It needs a Level 2 PS interpreter.
# If the bounding box is not right, of course, you have problems...
#
# The only thing I have not allowed for is the case of
# "%%BoundingBox: (atend)", which is more complicated.
#
# Sebastian Rahtz, for Elsevier Science
#
# now with extra tricks from Hans Hagen's texutil.
#
# History
#  1999/05/06 v2.5 (Heiko Oberdiek)
#    * New options: --hires, --exact, --filter, --help.
#    * Many cosmetics: title, usage, ...
#    * New code for debug, warning, error
#    * Detecting of cygwin perl
#    * Scanning for %%{Hires,Exact,}BoundingBox.
#    * Scanning only the header in order not to get a wrong
#      BoundingBox of an included file.
#    * (atend) supported.
#    * uses strict; (earlier error detecting).
#    * changed first comment from '%!PS' to '%!';
#    * corrected (atend) pattern: '\s*\(atend\)'
#    * using of $bbxpat in all BoundingBox cases,
#      correct the first white space to '...Box:\s*$bb...'
#    * corrected first line (one line instead of two before 'if 0;';
#  2000/11/05 v2.6 (Heiko Oberdiek)
#    * %%HiresBoundingBox corrected to %%HiResBoundingBox
#  2001/03/05 v2.7 (Heiko Oberdiek)
#    * Newline before grestore for the case that there is no
#      whitespace at the end of the eps file.
#  2006/05/09 v2.8 (David W. Rankin, Jr.)
#    * option --pdfvers to specify the Ghostscript command to set
#      the PDF version output.

my $IsWin32 = ($^O =~ /MSWin32/i);

### program identification
my $program = "epstosmth";
my $filedate="2006/05/09";
my $fileversion="2.8";
my $copyright = "Copyright 1998-2001 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';

if ($IsWin32) {
  $GS = `kpsecheck --ghostscript`;
  $GS =~ m/^dll\s*:\s*(.+)/mio;
  $GS = $1;
  $GS =~ s/gsdll32.dll/gswin32c.exe/io;
  if ($GS eq "") {
    $GS = "gswin32c.exe";
  }
  $GS = "\"$GS\"" if ($GS =~ m/\s/);
}

### options
$::opt_help=0;
$::opt_debug=0;
$::opt_compress=1;
$::opt_gs=1;
$::opt_hires=0;
$::opt_exact=0;
$::opt_filter=0;
$::opt_outfile="";
$::opt_pdfvers="";
$::opt_gsdev="pdfwrite";
$::opt_gsopt="";

### 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)gs:         run ghostscript        (default: $bool[$::opt_gs])
  --(no)compress:   use compression        (default: $bool[$::opt_compress])
  --(no)pdfvers:    PDF Version for Output (default: [GhostScript's default])
  --(no)hires:      scan HiResBoundingBox  (default: $bool[$::opt_hires])
  --(no)exact:      scan ExactBoundingBox  (default: $bool[$::opt_exact])
  --(no)debug:      debug informations     (default: $bool[$::opt_debug])
  --gsdev=<dev>:    select gs device
  --gsopt=<opts>:   additional gs options
Examples for producing 'test.pdf':
  * $program test.eps
  * produce postscript | $program --filter >test.pdf
  * produce postscript | $program -f -d -o=test.pdf
Example: look for HiResBoundingBox and produce corrected PostScript:
  * $program -d --nogs -hires test.ps>testcorr.ps
END_OF_USAGE

### process options
use Getopt::Long;
GetOptions (
  "help!",
  "debug!",
  "filter!",
  "compress!",
  "gs!",
  "hires!",
  "exact!",
  "pdfvers=s",
  "outfile=s",
  "gsdev=s",
  "gsopt=s",
) 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;
}

### option compress
my $GSOPTS = "$::opt_gsopt ";

debug "gs opts:", $GSOPTS;

$GSOPTS .= "-dUseFlateCompression=false " unless $::opt_compress;

### option pdfvers (GhostScript PDF Compatability options)
$GSOPTS .= "-dCompatibilityLevel=$::opt_pdfvers " unless $::opt_pdfvers eq "";

### 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/\.[^\.]*$//;
      if ($::opt_gsdev =~ m/^pdf/) {
        $OutputFilename .= '.pdf';
      } elsif ($::opt_gsdev =~ m/^png/) {
        $OutputFilename .= '.png';
      } elsif ($::opt_gsdev =~ m/^jpeg/) {
        $OutputFilename .= '.jpg';
      } else {
        $OutputFilename .= ($::opt_gsdev eq "" ? ".pdf" : ".$::opt_gsdev");
      }
    }
  }
  else {
    $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=$::opt_gsdev $GSOPTS " .
          "-sOutputFile=$OutputFilename - -c quit";
  debug "Ghostscript pipe:", $pipe;
  open(OUT,"|$pipe") or error "Cannot open Ghostscript for piped input";
}
else {
  open(OUT,">$OutputFilename") or error "Cannot write '$OutputFilename";
}

### 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 "\ngrestore\n" if $BBCorrected;
close(OUT);
warning "BoundingBox not found" unless $BBCorrected;
debug "Ready.";
;