#!/usr/bin/perl
# 
# Copyright (C) Koji Nakamaru
#
# Author: Koji Nakamaru (nakamaru at gmail.com)
# Modified: Apr 30 2005
#   * changed the contact information.
# Modified: Jul 15 2002
#   * modified regexps for parsing options
#   * scalelinewidth option
#   * minlinewidth option
#   * bboxexpander option
# Created: Jul 10 2002
# Keywords: postscript, eps
#
# 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, 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 GNU Emacs; see the file COPYING.  If not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#

use Getopt::Long;
use POSIX;

$opt_foreground = "";
$opt_background = "";
$opt_nongray = 0;
$opt_scalelinewidth = 1;
$opt_minlinewidth = 0;
$opt_bboxexpander = "0 0";

$usage = <<"EOF";
Usage: perl epsrv.pl [options] < in.eps > out.eps
Options:
  --help
        print usage.
  --foreground="r g b"
        use the specified foreground color for reverted grays,
        where each component should be in [0, 1].
  --background="r g b"
        clear background with the specified rgb color,
        where each component should be in [0, 1].
  --nongray
        also revert non-gray colors.
  --scalelinewidth=s
        scale the line width by s,
        which should be >= 0.
  --minlinewidth=m
        set the minimum linewidth to m point (1/72 inch),
        which should be >= 0.
  --bboxexpander="dx dy"
        expand the bounding box by (dx, dy), specified in
        point. negative values shrink the bounding box.
EOF

sub warn
{
    my ($msg) = @_;
    print STDERR "epsrv.pl: warning - ", $msg, "\n";
}

sub error
{
    my ($msg) = @_;
    print STDERR "epsrv.pl: ", $msg, "\n";
    exit 1;
}

if (! GetOptions('help',
		 'foreground=s',
		 'background=s',
		 'nongray',
		 'scalelinewidth=f',
		 'minlinewidth=f',
		 'bboxexpander=s')) {
    print STDERR $usage;
    exit 1;
}
if ($opt_help) {
    print STDERR $usage;
    exit 1;
}
if ($opt_foreground ne ""
    and ! ($opt_foreground =~ /\s*([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s*/
	   and 0.0 <= $1 and $1 <= 1.0
	   and 0.0 <= $2 and $2 <= 1.0
	   and 0.0 <= $3 and $3 <= 1.0)) {
    error "incorrect foreground specification: $opt_foreground";
}
if ($opt_background ne ""
    and ! ($opt_background =~ /\s*([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s*/
	   and 0.0 <= $1 and $1 <= 1.0
	   and 0.0 <= $2 and $2 <= 1.0
	   and 0.0 <= $3 and $3 <= 1.0)) {
    error "incorrect background specification: $opt_background";
}
if ($opt_scalelinewidth <= 0) {
    error "incorrect scalelinewidth: $opt_scalelinewidth";
}
if ($opt_minlinewidth < 0) {
    error "incorrect minlinewidth: $opt_minlinewidth";
}
if (! ($opt_bboxexpander =~ /\s*([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s*/)) {
    error "incorrect bboxexpander: $opt_bboxexpander";
}
if (@ARGV != 0) {
    print STDERR $usage;
    exit 1;
}

if ($opt_foreground eq "") {
    $opt_foreground = "1 1 1";
}

binmode STDIN;
binmode STDOUT;
while (<>) {
    if (! /^%%BoundingBox:.*/
	and ! /^%%HiresBoundingBox:.*/
	and ! /^%%ExactBoundingBox:.*/
	and ! /^%%Orientation: Portrait/
	and ! /^%%EOF/) {
	print;
    }
    if (/^%%BoundingBox:\s*([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s+([0-9eE\.\-]+)/) {
	$llx = $1;
	$lly = $2;
	$urx = $3;
	$ury = $4;
	if ($opt_bboxexpander =~ /\s*([0-9eE\.\-]+)\s+([0-9eE\.\-]+)\s*/) {
	    $llx -= $1;
	    $lly -= $2;
	    $urx += $1;
	    $ury += $2;
	}
	$llx = floor($llx);
	$lly = floor($lly);
	$urx = ceil($urx);
	$ury = ceil($ury);
	if ($llx > $urx) {
	    $llx = $urx = int(($llx + $urx) / 2);
	}
	if ($lly > $ury) {
	    $lly = $ury = int(($lly + $ury) / 2);
	}
	if ($llx == $urx or $lly == $ury) {
	    warn "empty bounding box: $llx $lly $urx $ury";
	}
	print "%%BoundingBox: $llx $lly $urx $ury\n";
    } elsif (/^%%EndComments/) {
	if ($opt_background ne "") {
	    print <<"EOF";
gsave
$llx $lly moveto
$urx $lly lineto
$urx $ury lineto
$llx $ury lineto
$llx $lly lineto
closepath
$opt_background
systemdict /setrgbcolor known {
  setrgbcolor
}{
  3 -1 roll 0.299 mul
  3 -1 roll 0.587 mul
  3 -1 roll 0.114 mul
  add add setgray
} ifelse
fill
grestore
EOF
        }
        # * the following scheme fails if the eps-file directly uses
        #   systemdict.
	# * settransfer like the following does not work correctly for
	#   gs pdfwrite device:
	#   [ { 1 exch sub } /exec load currenttransfer /exec load ]
	#   cvx settransfer
	if ($opt_nongray) {
            print <<"EOF"
systemdict /setrgbcolor known {
  /setgray {
    1 exch sub
    $opt_foreground
    0 1 2 {
      pop 3 index mul 3 1 roll
    } for
    setrgbcolor
    pop
  } bind def
  [ /setcmykcolor /setcolor /sethsbcolor /setrgbcolor ] {
    dup systemdict exch known {
      {
        0
        currentrgbcolor
        2 index 2 index eq 2 index 2 index eq and {
          pop pop setgray
        }{
          0 1 2 {
            pop 1 exch sub 3 1 roll
          } for
          setrgbcolor
        } ifelse
      } bind
      dup
      0 3 index load put def
    }{
      pop
    } ifelse  
  } forall
}{
  /setgray {
    1 exch sub
    $opt_foreground
    3 -1 roll 0.299 mul
    3 -1 roll 0.587 mul
    3 -1 roll 0.114 mul
    add add mul setgray
  } bind def
} ifelse
0 setgray
EOF
        } else {
            print <<"EOF"
systemdict /setrgbcolor known {
  /setgray {
    1 exch sub
    $opt_foreground
    0 1 2 {
      pop 3 index mul 3 1 roll
    } for
    setrgbcolor
    pop
  } bind def
  [ /setcmykcolor /setcolor /sethsbcolor /setrgbcolor ] {
    dup systemdict exch known {
      {
        0
        currentrgbcolor
        2 index 2 index eq 2 index 2 index eq and {
          pop pop setgray
        }{
          pop pop pop
        } ifelse
      } bind
      dup
      0 3 index load put def
    }{
      pop
    } ifelse  
  } forall
}{
  /setgray {
    1 exch sub
    $opt_foreground
    3 -1 roll 0.299 mul
    3 -1 roll 0.587 mul
    3 -1 roll 0.114 mul
    add add mul setgray
  } bind def
} ifelse
0 setgray
EOF
	}
	if ($opt_scalelinewidth != 1 or $opt_minlinewidth != 0) {
	    print <<"EOF"
/setlinewidth {
  $opt_scalelinewidth mul
  dup $opt_minlinewidth lt {
    pop $opt_minlinewidth
  } if
  setlinewidth
} bind def
1 setlinewidth
EOF
        }
    }
}
print "%%EOF\n";