path: root/Master/bin/alpha-linux/a2ping

#! /bin/sh
eval '(exit $?0)' && eval 'PERL_BADLANG=x;export PERL_BADLANG;: \
;exec perl -x -S -- "$0" ${1+"$@"};#'if 0;
eval 'setenv PERL_BADLANG x;exec perl -x -S -- "$0" $argv:q;#'.q+
#!perl -w
package Htex::a2ping;  $0=~/(.*)/s;unshift@INC,'.';do($1);die$@if$@;__END__+if !1;
# This Perl script was generated by JustLib2 at Wed Apr 23 09:14:13 2003.
# Don't touch/remove any lines above; http://www.inf.bme.hu/~pts/justlib
#
# This program is free software, licensed under the GNU GPL, >=2.0.
# This software comes with absolutely NO WARRANTY. Use at your own risk!
#
package just; BEGIN{$INC{'just.pm'}='just.pm'}
BEGIN{ $just::VERSION=2 }
sub end(){1}
sub main(){}

BEGIN{$ INC{'strict.pm'}='strict.pm'} {
package strict;
use just;
# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001
require 5.002;
sub bits {
  (grep{'refs'eq$_}@_ && 2)|
  (grep{'subs'eq$_}@_ && 0x200)|
  (grep{'vars'eq$_}@_ && 0x400)|
  ($@ || 0x602)
}
sub import { shift; $^H |= bits @_ }
sub unimport { shift; $^H &= ~ bits @_ }
just::end}

BEGIN{$ INC{'integer.pm'}='integer.pm'} {
package integer;
use just;
# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001
sub import   { $^H |= 1 }
sub unimport { $^H &= ~1 }
just::end}

BEGIN{$ INC{'Pts/string.pm'}='Pts/string.pm'} {
package Pts::string;
# by pts@fazekas.hu at Sat Dec 21 21:32:18 CET 2002
use just;
use integer;
use strict;

#** @param $_[0] a string
#** @param $_[1] index of first bit to return. Bit 128 of byte 0 is index 0.
#** @param $_[2] number of bits to return (<=32)
#** @return an integer (negative on overflow), bit at $_[1] is its MSB
sub get_bits_msb($$$) {
  # assume: use integer;
  my $loop=$_[1];
  my $count=$_[2];
  my $ret=0;
  ($ret+=$ret+(1&(vec($_[0],$loop>>3,8)>>(7-($loop&7)))), $loop++) while $count--!=0;
  $ret
}

#** @param $_[0] a string
#** @return value if $_[0] represents a floating point numeric constant
#**   in the C language (without the LU etc. modifiers) -- or undef. Returns
#**   undef for integer constants
sub c_floatval($) {
  my $S=$_[0];
  no integer; # very important; has local scope
  return 0.0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+|[0-9]+\.])(?:[eE][+-]?[0-9]+)?\Z(?!\n)/;
  undef
}

#** @param $_[0] a string
#** @return value if $_[0] represents a floating point or integer numeric
#**   constant in the C language (without the LU etc. modifiers) -- or undef
sub c_numval($) {
  my $S=$_[0];
  no integer; # very important; has local scope
  return 0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+(?:[eE][+-]?[0-9]+)?|[0-9]+\.?)\Z(?!\n)/;
  undef
}

#** @param $_[0] a string
#** @return the integer value of $_[0] in C -- or undef
sub c_intval($) {
  my $S=$_[0];
  my $neg=1;
  $neg=-1 if $S=~s@\A([+-])@@ and '-'eq$1;
  return $neg*hex $1 if $S=~/\A0[xX]([0-9a-fA-F]+)\Z(?!\n)/;
  return $neg*oct $1 if $S=~/\A0([0-7]+)\Z(?!\n)/;
  return $neg*$1     if $S=~/\A([0-9]+)\Z(?!\n)/;
  undef
}

sub import {
  no strict 'refs';
  my $package = (caller())[0];
  shift; # my package
  for my $p (@_ ? @_ : qw{get_bits_msb c_floatval c_numval c_intval}) { *{$package."::$p"}=\&{$p} }
}

just::end}

BEGIN{$ INC{'Htex/dimen.pm'}='Htex/dimen.pm'} {
package Htex::dimen;
# by pts@fazekas.hu at Sat Dec 21 21:26:15 CET 2002
use just;
use integer;
use strict;
use Pts::string qw(c_numval);

my %bp_mul;
{ no integer; %bp_mul=(
  'bp'=>1, # 1 bp = 1 bp (big point)
  'in'=>72, # 1 in = 72 bp (inch)
  'pt'=>72/72.27, # 1 pt = 72/72.27 bp (point)
  'pc'=>12*72/72.27, # 1 pc = 12*72/72.27 bp (pica)
  'dd'=>1238/1157*72/72.27, # 1 dd = 1238/1157*72/72.27 bp (didot point) [about 1.06601110141206 bp]
  'cc'=>12*1238/1157*72/72.27, # 1 cc = 12*1238/1157*72/72.27 bp (cicero)
  'sp'=>72/72.27/65536, # 1 sp = 72/72.27/65536 bp (scaled point)
  'cm'=>72/2.54, # 1 cm = 72/2.54 bp (centimeter)
  'mm'=>7.2/2.54, # 1 mm = 7.2/2.54 bp (millimeter)
) }

#** @param $_[0] a (real or integer) number, optionally postfixed by a
#**        TeX dimension specifier (default=bp)
#** @return the number in bp, or undef
sub dimen2bp($) {
  no integer;
  my $S=$_[0];
  my $mul;
  $mul=$bp_mul{$1} if $S=~s/\s*([a-z][a-z0-9]+)\Z(?!\n)// and exists $bp_mul{$1};
  my $val=c_numval($S);
  $val*=$mul if defined $val and defined $mul;
  $val
}

just::end}

BEGIN{$ INC{'Htex/papers.pm'}='Htex/papers.pm'} {
package Htex::papers;
# contains paper size information
# by pts@fazekas.hu at Sun Dec 22 00:30:58 CET 2002
use just;
use integer;
use strict;
use Htex::dimen;

my @papers=(
#
# paper.txt
# by pts@fazekas.hu at Tue Jan 16 18:21:59 CET 2001
# by pts@fazekas.hu at Tue Jan 16 19:13:16 CET 2001
#
# Examined: dvips, gs, libpaperg
#
# all units are measured in Big Points (bp)
# 72 bp == 1 in
# 2.54 cm == 1 in
#
# papername	width	height
qw{Comm10	297	684},
qw{Monarch	279	540},
qw{halfexecutive 378	522},

qw{Legal	612	1008},
qw{Statement	396	612},
qw{Tabloid	792	1224},
qw{Ledger	1224	792},
qw{Folio	612	936},
qw{Quarto	610	780},
qw{7x9		504	648},
qw{9x11		648	792},
qw{9x12		648	864},
qw{10x13	720	936},
qw{10x14	720	1008},
qw{Executive	540	720},

qw{ISOB0	2835	4008},
qw{ISOB1	2004	2835},
qw{ISOB2	1417	2004},
qw{ISOB3	1001	1417},
qw{ISOB4	 709	1001},
qw{ISOB5	 499	 709},
qw{ISOB6	 354	 499},
qw{ISOB7	 249	 354},
qw{ISOB8	 176	 249},
qw{ISOB9	 125	 176},
qw{ISOB10	 88	 125},
qw{jisb0	2916	4128},
qw{jisb1	2064	2916},
qw{jisb2	1458	2064},
qw{jisb3	1032	1458},
qw{jisb4	 729	1032},
qw{jisb5	 516	 729},
qw{jisb6	 363	 516},

qw{C7		230	323},
qw{DL		312	624},

qw{a3		842	1190},	# defined by Adobe
qw{a4		595	842},	# defined by Adobe; must precede a4small

# a4small should be a4 with an ImagingBBox of [25 25 570 817].},
qw{a4small	595	842},
qw{letter	612	792},	# must precede lettersmall
# lettersmall should be letter with an ImagingBBox of [25 25 587 767].
qw{lettersmall	612	792},
# note should be letter (or some other size) with the ImagingBBox
# shrunk by 25 units on all 4 sides.
qw{note		612	792},
qw{letterLand	792	612},
# End of Adobe-defined page sizes

qw{a0		2380	3368},
qw{a1		1684	2380},
qw{a2		1190	1684},
qw{a5		421	595},
qw{a6		297	421},
qw{a7		210	297},
qw{a8		148	210},
qw{a9		105	148},
qw{a10		74	105},
qw{b0		2836	4008},
qw{b1		2004	2836},
qw{b2		1418	2004},
qw{b3		1002	1418},
qw{b4		709	1002},
qw{b5		501	709}, # defined by Adobe

qw{a0Land	3368	2380},
qw{a1Land	2380	1684},
qw{a2Land	1684	1190},
qw{a3Land	1190	842},
qw{a4Land	842	595},
qw{a5Land	595	421},
qw{a6Land	421	297},
qw{a7Land	297	210},
qw{a8Land	210	148},
qw{a9Land	148	105},
qw{a10Land	105	74},
qw{b0Land	4008	2836},
qw{b1Land	2836	2004},
qw{b2Land	2004	1418},
qw{b3Land	1418	1002},
qw{b4Land	1002	709},
qw{b5Land	709	501},

qw{c0		2600	3677},
qw{c1		1837	2600},
qw{c2		1298	1837},
qw{c3		918	1298},
qw{c4		649	918},
qw{c5		459	649},
qw{c6		323	459},

# vvv U.S. CAD standard paper sizes
qw{archE	2592	3456},
qw{archD	1728	2592},
qw{archC	1296	1728},
qw{archB	864	1296},
qw{archA	648	864},

qw{flsa		612	936},	# U.S. foolscap
qw{flse		612	936},	# European foolscap
qw{halfletter	396	612},
qw{csheet	1224	1584},	# ANSI C 17x22
qw{dsheet	1584	2448},	# ANSI D 22x34
qw{esheet	2448	3168},	# ANSI E 34x44
qw{17x22	1224	1584},	# ANSI C 17x22
qw{22x34	1584	2448},	# ANSI D 22x34
qw{34x44	2448	3168},	# ANSI E 34x44
);

#** Converts a numeric paper size to a well-defined paper name. Tolerance is
#** 8.5bp
#** @param $_[0] width, in bp
#** @param $_[1] height, in bp
#** @return () or ("papername", ret.paper.width.bp, ret.paper.height.bp)
sub valid_bp($$;$$) {
  no integer;
  my ($W1,$H1)=(defined$_[2]?$_[2]:0,defined$_[3]?$_[3]:0);
  my ($WW,$HH)=(Htex::dimen::dimen2bp($_[0])-$W1, Htex::dimen::dimen2bp($_[1])-$H1);
  # Dat: 1mm == 720/254bp; 3mm =~ 8.5bp
  no integer;
  for (my $I=0; $I<@papers; $I+=3) {
    return @papers[$I,$I+1,$I+2] if abs($papers[$I+1]-$WW)<=8.5 and abs($papers[$I+2]-$HH)<=8.5;
  }
  ()
}

#** @param $_[0] (width width_unit "," height height_unit)
#** @return () or ("papername", width.bp, height.bp)
sub valid($) { # valid_papersize
  my $S=lc$_[0];
  $S=~/^\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*,\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*\Z(?!\n)/ ?
    valid_bp("$1$3","$4$6") : ();
}

#** @param $_[0] (width width_unit? ("," || "x") height height_unit?) || (papername)
#** @return () or ("papername"?, width.bp, height.bp)
sub any($) {
  my $S=lc$_[0];
  if ($S=~/\A[a-z]\w+\Z(?!\n)/) {
    for (my $I=0; $I<@papers; $I+=3) {
      return @papers[$I,$I+1,$I+2] if lc($papers[$I]) eq $S;
    }
  }
  return () if $S!~/^\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*[,xX]\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*\Z(?!\n)/;
  # ^^^ Dat: [xX] is xdvi-style, [,] is dvips-style spec
  my($w,$h)=($1.$3, $4.$6);
  my @L=valid_bp($w,$h);
  @L ? @L : (undef,Htex::dimen::dimen2bp($w),Htex::dimen::dimen2bp($h))
}

just::end}

BEGIN{$  INC{'Htex/a2ping.pm'}='Htex/a2ping.pm'}

package Htex::a2ping;
# a2ping.pl -- convert between PS, EPS and PDF and other page description formats
# by pts@fazekas.hu et al. at Wed Apr 16 14:54:13 CEST 2003
# a2ping.pa created at Sun Apr 20 22:25:47 2003
#
# This file contains perldoc(1) documentation. Search for `=head1'.
# See revision history at end of this file.
#

use just +1; # a JustLib application
use strict;
use integer;
use Htex::papers;
BEGIN { $Htex::a2ping::VERSION="2.77p" }

# Imp: gs(704?!) sometimes finds too small bbox, see Univers.eps
# Imp: respect bbox in METAPOST %! (not EPS), don't use Compute-GS T-
# Imp: -sPDFPassword=...
# Imp: `a2ping.pl -v jf.eps pdf1: t.pdf' PDF1: must be forced to have --below
# Imp: option to `clip' an EPS to the specified bbox -- does file size decrease?
# Imp: fix bug a2ping -v ~/a2ping_bug.ps a2ping_bug.pdf; running type1fix on
#      all fonts with dff.pl has fixed the problem
# Imp: post-process PNG etc. written by sam2p
# Imp: better help and docs
# Imp: respect full /MediaBox for a PDF -> EPS|PDF1 conversion
# Imp: --ll x,y command line option
# Imp: Htex/a2ping.pa -v ../image/tuzv.ps t.pdf  (1st and second page different)
# Imp: also save+restore /pdfmark ??
# Imp: fix /MediaBox an all PDF pages if !$ll_zero
# Imp: PDF -> PDF1 conversion with gs -sDEVICE=pdfwrite
# Imp: direct PDF to PCL5 conversion with gs
# Imp: remove %%BeginDefaults | %%PageMedia: plain | %%EndDefaults (pdftops(1))
# Imp: fix completely bogus margin and papersize handling:
#      ../justlib2/Htex/a2ping.pa --duplex=force-short -v -p:a3 -r force-unknown tuzv.ps t.pdf
# Imp: careful distinction between PDF and PDF1
# Imp: psnup support (-1 -2 -3 -4 ...)
# Imp: idempotent PS -> PS, add other header
# Imp: use convert(1) etc.
# Imp: possibly disable compute-pipe
# Imp: $header_remove_p ??
# Imp: --leftright option instead of --below
# Imp: pdfboxes.pl, get offset from gs
# Imp: detect error messages from GS, abort...
# Imp: use all pdftops + gs + acroread
# Imp: possibly accept /PageSize from %%DocumentMedia
# Imp: /DocumentMedia seems to screw up sub-pt placement in gv(1)
#
# Dat: example: a2ping.pl --extra=-c:ijg:50 -r86 nn1.eps nn1.jpg
# Dat: calling ``showpage'' is not required for -sDEVICE=pdfwrite with gs 6.50,
#      but -sDEVICE=pgmraw depends on it
# Dat: the functionality of pdfboxes.pl cannot be provided here with a shorter
#      implementation, because gs always outputs the content stream of the PDF
#      objects first
# Dat: pdftops -eps writes negative bbox correctly
# Dat: markedEPS: include pdfmarks
# Dat: gs 7.04 gdevdjet.[ch], gdevdljm.[ch]
# Dat: to be undeffed in setpagedevice: /.MarginsHWResolution /PageSize
#      /ImagingBBox /HWResolution /HWSize /.MediaSize (we undef all)

### program identification
my $program = "a2ping.pl";
my $filedate="2004-04-28"; # my $filedate="2001/03/05";
my $copyright = "Written by <pts\@fazekas.hu> from April 2003.
This is free software, GNU GPL >=2.0. There is NO WARRANTY.
(epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.)\n";
# "Contains modifications by pts\@fazekas.hu";
my $title = "$program $Htex::a2ping::VERSION, $filedate -- $copyright\n";

### ghostscript command name
my($quote,$GS)=("'","gs");
($quote,$GS) = ("\"","gswin32c") if $^O eq 'MSWin32' or $^O =~ /cygwin/i;

# --- help functions

sub fnq($) {
  my $fn=$_[0];
  return $fn if $fn!~y@-a-zA-Z0-9/.+_@@c;
  $fn=~s@'@\\'@g if $quote eq "'";
  $quote.$fn.$quote
}

sub debug {
  print STDERR "* @_\n" if $::opt_verbose;
}
sub warning {
  print STDERR "$0: warning: @_\n";
}
sub error {
  my $s=$title; $title="";
  die "$s$0: @_\n";
}

# unlink temporary files?
my $tmpunlink_p=1;
my $tmpsig=1;
my %tmpfiles;
my $tmpdir=exists $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp';
$tmpdir="." if (!-d $tmpdir or !-w $tmpdir) and -w '.';
sub cleanup() {
  unlink keys %tmpfiles;
  exit 125;
}
END { unlink keys %tmpfiles; }
sub temp_unlink($) {
  if (exists $tmpfiles{$_[0]}) {
    unlink $_[0] if $tmpunlink_p;
    delete $tmpfiles{$_[0]};
  }
}
sub temp_prefix() {
  my $prog0=$program;
  $prog0=~y@a-zA-Z0-9@_@c;
  if ($tmpsig) {
    $tmpsig=0;
    $SIG{INT}=$SIG{TERM}=$SIG{HUP}=$SIG{QUIT}=\&cleanup;
  }
  return "$tmpdir/$prog0-$$-".int(rand(1<<30))."-"; # 30: nonnegative
}

#** @return arg rounded down to int
sub floor($) {
  # Dat: Perl int() rounds towards zero
  no integer;
  $_[0] < 0 ? -int(-$_[0]) : int($_[0])
}

#** @return arg rounded up to int
sub ceil($) {
  no integer;
  $_[0]==int($_[0]) ? $_[0] : 1+ ($_[0] < 0 ? -int(-$_[0]) : int($_[0]))
}


just::main;

# ---

sub FL_PAGE1_STOP(){1} # is file format single-page?
sub FL_SET_PAGESIZE_OK(){2}
sub FL_PDFMARK(){4}
sub FL_NEED_SHOWPAGE(){8} # does gs -sDEVICE=... need showpage?
sub FL_SAMPLED(){16} # is it a sampled (raster, pixel-based)
sub FL_ANY_ORIGIN_OK(){32} # (llx,lly) may be anything, not just (0,0)
sub FL_HAS_ANTIALIAS(){64}
sub FL_VIA_SAM2P(){128} # sam2p(1) can convert PNM to such a format
sub FL_OK_SAM2P(){256}

my %fmts=( # Name=>[flags]
  'EPS'=>[FL_PAGE1_STOP],
  'markedEPS'=>[FL_PAGE1_STOP|FL_PDFMARK], # Imp: should we have FL_SET_PAGESIZE_OK?
  'PDF1'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_PDFMARK],
  'PDF'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
  'PS'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
  'markedPS'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
  'PCL5'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
  # ^^^ Dat: no FL_HAS_ANTIALIAS -- would need lj5gray, which is loonger
  # ^^^ Dat: no FL_SAMPLED, because cannot set resolution
  'PBM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_OK_SAM2P], # Dat FL_HAS_ANTIALIAS produces obscure image
  'PGM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
  'PPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
  # Now come the FileFormats supported via sam2p
  'PNG'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
  'XWD'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
  'BMP'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
  'TIFF'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
  'JPEG'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
  'GIF'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
  'XPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
);
my %fmt_aliases=qw(MARKEDPS markedPS  MARKEDEPS markedEPS  PCL PCL5
  UNMARKEDPS PS  UNMARKEDEPS EPS  EPDF PDF1  MEPS markedEPS);
# Dat: .ps will be unmarked PS
# Imp: sometimes markedEPS for .eps?
my %fmt_exts=qw(eps EPS  epsi EPS  epsf EPS  eps2 EPS  ps PS  ps2  PS
  pcl PCL5  pcl5 PCL5  pbm PBM  pgm PGM  pnm PPM  ppm PPM  pdf PDF  png PNG
  xwd XWD  bmp  BMP  rle BMP  tif TIFF  tiff TIFF  jpg JPEG  jpe JPEG
  jpg JPEG  gif GIF  xpm XPM);

### usage
# vvv deprecated options:
#   --outfile=<file>: write result to <file>
#   --debug:          verbose debug informations       (default: $bool[$::opt_verbose])
#   --(no)filter:     d. read standard input           (default: false)
#   --(no)gs        d. run Ghostscript to create PDF
my $usage=
"${title}Usage:  $program [options] <inputfile> [[<outformat>:] <outputfile>]
Run with --doc to read documentation as a UNIX man(1) page.
Options: --help print this help message
--(no)compress  use compression                   (def: best)
--(no)hires     scan HiResBoundingBox             (def: yes)
--(no)exact     scan ExactBoundingBox             (def: no)
--(no)verbose   verbose debug informations        (def: no)
--(no)below     allow below+left_from baseline    (def: no)
--(no)tmpunlink unlink temporary files            (def: yes)
--(no)antialias render shades at outlines (def: scale3no) (=scale3yes =no =yes)
--gs-cmd=       path to Ghostscript               (def: gs or gswin32c)
--gs-ccmd=      path to Ghostscript, 4 bbox calc  (def: gs or gswin32c)
--gsextra=      extra arg to gs
--extra=        extra arg to external prg (i.e pdftops)
--bboxfrom=     adsc|compute-gs|pagesize          (def: guess)
--papersize=    unchanged|force-unknown|600bpx5cm (def: default) (bp)
--threshold=    min color for 1 in 8->1 bit conv  (def: 128)
Possible input formats: PS EPS PDF JPEG GIF TIFF PNG PNM PCX BMP LBM XPM TGA
Possible output formats: @{[sort keys %fmts]}
Examples for producing 'test.pdf':
  * $program test.eps
  * produce postscript | $program -v - test.pdf
Example: look for HiResBoundingBox and produce corrected PostScript:
  * $program -d --nogs -hires test.ps>testcorr.ps
";
sub errorUsage {
  die "$usage\U!\E!\U!\E Error: @_\n";
}

# --- @ARGV parsing

### default option values
my @extra=();
my @gsextra=();
#** Output file format (string)
my $FileFormat=undef;
$::opt_help=0;
$::opt_verbose=0;
my %vals_compression=map{$_=>1} qw(best none flate zip);
$::opt_compression='best';
#** Prefer %%HiResBoundingBox over %%BoundingBox, but emit both
$::opt_hires=1;
$::opt_exact=0;
# $::opt_filter=0; # deprecated
# $::opt_outputfile=undef; # deprecated
$::opt_below=undef;
$::opt_antialias=undef; # render shades at path outlines for better readability
$::opt_gs_cmd=undef;
$::opt_extra="";
$::opt_duplex="default";
$::opt_threshold=128;
my %vals_antialias=map{$_=>1} qw(no yes scale3yes scale3no);
my %vals_duplex=map{$_=>1} qw(force-unknown force-simplex force-long
  force-short unchanged default-simplex default-long default-short);
# ^^^ short: duplex printing, will bind short edge of paper (ideal for
#     duplexing psnup -2)
#** Dat: force-unknown is forced by /setpagedevice/load def
$::opt_resolution="default"; # unchanged force-unknown 600x600 (DPI)
$::opt_papersize="default"; # unchanged force-unknown 600bpx600cm (bp)
#** --bboxfrom=adsc sets %%BoundingBox from the 1st page if no ADSC comment in non-EPS ps
my %vals_bboxfrom=map{$_=>1} qw(adsc compute-gs guess pagesize);
$::opt_bboxfrom="guess";
my $InputFilename;
my $OutputFilename;

sub is_page1_stop() { 0!=($fmts{$FileFormat}[0]&FL_PAGE1_STOP) }
sub is_set_pagesize_ok() { 0!=($fmts{$FileFormat}[0]&FL_SET_PAGESIZE_OK) }
sub is_pdfmark() { 0!=($fmts{$FileFormat}[0]&FL_PDFMARK) }
sub is_need_showpage() { 0!=($fmts{$FileFormat}[0]&FL_NEED_SHOWPAGE) }
sub is_sampled() { 0!=($fmts{$FileFormat}[0]&FL_SAMPLED) }
sub is_any_origin_ok() { 0!=($fmts{$FileFormat}[0]&FL_ANY_ORIGIN_OK) }
sub is_has_antialias() { 0!=($fmts{$FileFormat}[0]&FL_HAS_ANTIALIAS) }
sub is_via_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_VIA_SAM2P) }
sub is_ok_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_OK_SAM2P) }

# ---

sub show_doc() {
  # run `pod2man __FILE__ | man -l -', same as `perldoc __FILE', but perldoc(1)
  # is missing from some Debian sites that have pod2man.
  my @path=split/:+/,$ENV{PATH};
  my $pod2man_='pod2man --center="a2ping: advanced PS, PDF, EPS converter" ';
  $pod2man_=q~perl -ne 'if($a>1){print}elsif($a&&/^=head1/){$a=2}else{$a=!/\S/}' ~
    if !grep { -x "$_/pod2man" } @path;
  my $pager='';
  for my $pageri ((defined $ENV{PAGER} ? $ENV{PAGER}: ''),'less','most','more','view -  ','vim -R -  ','vi -  ','joe -rdonly -asis -','pager') {
    next if $pageri!~/^(\S+)/;
    my $pagert="/$1";
    if (grep { -x $_.$pagert } @path) { $pager=$pageri; last }
  }
  $pager=q~perl -pe 's@\010_@@g;s@.\010@@gs' | ~.$pager
    if substr($pager,-2)eq'  ' or $pager=~/\A(?:view|vim?|joe|emacs|mcedit|nano|nano-tiny|ae)\b/;
    # ^^^ Dat: these cannot handle underline/bold backspace directly
  $ENV{PAGER}=$pager;
  my $man='';
  if (substr($pod2man_,0,5)ne 'perl ') {
    $man=' | man -l -'; # calls $PAGER
    if ((!grep { -x "$_/man" } @path) or qx(man -l 2>&1)=~/\binvalid option\b/) {
      $man=' | nroff -Tlatin1 -mandoc'; # Linux, no need for eqn(1), tbl(1) etc.
      if (!grep { -x "$_/nroff" } @path) { $man='' } # just write it
    }
  }
  my $cmd=$pod2man_.fnq(__FILE__).$man;
  if ($cmd!~/[|] man -l -\Z(?!\n)/) {
    if (!length $pager) {
      die unless open PIPE, "$cmd|";
      print while sysread PIPE, $_, 4096;
      die "$0: error showing doc\n" unless close PIPE;
      exit 0;
    }
    $cmd.=' | $PAGER';
  }
  ##die $cmd;
  $ENV{LESS}="" if !defined $ENV{LESS};
  $ENV{LESS}="$ENV{LESS}R"; # show ANSI escapes
  die "$0: exec ($cmd) failed: $!\n" if !exec $cmd;
}

die $usage if !@ARGV or (1==@ARGV and $ARGV[0] eq '-h' or $ARGV[0] eq '--help'
  or $ARGV[0] eq 'help');
show_doc() if 1==@ARGV and $ARGV[0] eq '--doc' or $ARGV[0] eq 'doc';

{ my($I,$optname,$optval);
  my %optmap=qw(o outputfile  outfile outputfile  r resolution  h help
    f filter  d verbose  v verbose  debug verbose  p papersize
    c compression  compress compression  h hires  b below  e exact  x extra);
  #** Options that have a mandatory argument
  my %argopt1=qw(outputfile 1 duplex 1 resolution 1 extra 1 compression 1 gs-cmd 1
    gs-ccmd 1
    papersize 1 paper 1 bboxfrom 1 antialias 1 gsextra 1 threshold 1); # 1 arg
  my %argnone=qw(help 1 verbose 1 noverbose 1 nocompress 1 noantialias 1); # 0 arg
  my %argmaybe=qw();  # 0 or 1 arg
  my %argbool=qw(hires 1 exact 1 below 1 gs 1 filter 1 tmpunlink 1
    approx 1); # boolean arg
  # Dat: --noverbose --nocompress
  my $opts_ok=1;
  for ($I=0; $I<@ARGV; $I++) {
    if ($ARGV[$I]eq '--') {
      $OutputFilename=$InputFilename if defined $InputFilename and
        !defined $OutputFilename and $opts_ok;
      $opts_ok=0;
    } elsif ($opts_ok and $ARGV[$I]=~/\A--+(\w[\w-]*)(?:[:=](.*))?\Z(?!\n)/s) {
      $optname=lc$1; $optval=$2;
    } elsif ($opts_ok and $ARGV[$I]=~/\A-(\w)(.*)\Z(?!\n)/s) {
      $optname=lc$1;
      if (length($2)==0) { $optval=undef }
      elsif (index(":=",substr($2,0,1))>=0) { $optval=substr($2,1) }
      else { $optval=$2 }
    } elsif ($opts_ok and !defined $FileFormat and defined $InputFilename and $ARGV[$I]=~s@\A(\w+):@@) {
      my $fmtag=uc$1;
      # errorUsage "invalid FileFormat tag: $fmtag" if $fmtag!~s@:\Z(?!\n)@@;
      if (exists $fmts{$fmtag}) { $FileFormat=$fmtag }
      elsif (exists $fmt_aliases{$fmtag}) { $FileFormat=$fmt_aliases{$fmtag} }
      else { errorUsage "Unknown FileFormat tag: $fmtag" }
      if (0!=length($ARGV[$I])) {
        errorUsage "Multiple output filenames" if defined $OutputFilename;
        $OutputFilename=$ARGV[$I];
      }
      next
    } elsif (!defined $InputFilename) { $InputFilename=$ARGV[$I]; next }
    elsif (!defined $OutputFilename) { $OutputFilename=$ARGV[$I]; next }
    else { errorUsage "Too many arguments (multiple input/output files?)" }
    $optname=$optmap{$optname} if exists $optmap{$optname};
    if (exists $argopt1{$optname} and !defined $optval) {
      errorUsage "Argument expected for --$optname" if $I==@ARGV;
      $optval=$ARGV[++$I];
    }
    # Dat: $optname and $optval are now correct
    errorUsage "No argument expected for --$optname=$optval" if exists $argnone{$optname} and defined $optval;
    if (substr($optname,0,2)eq"no" and exists $argbool{substr($optname,2)}) {
      $optname=substr($optname,2);
      errorUsage "No argument expected for no --no$optname=$optval" if defined $optval;
      $optval="no";
    }
    if (exists $argbool{$optname}) {
      # same as sam2p GenBuffer::parseBool, understands:
      #   on  true  yes ja   igen oui enable  1 true  vrai? right sure allowed
      #   off false no  nein nem  non disable 0 false faux? wrong nope disallowed
      $optval=(!defined($optval) or 0==length($optval)
               or $optval=~/\Ao[nu]/i or $optval!~/\A[fndw0]/i) ? 1 : 0;
    } elsif (!exists $argopt1{$optname} and !exists $argnone{$optname} and !exists $argmaybe{$optname}) {
      errorUsage "Unknown option --$optname, see --help"
    }
    # vvv application-specific
       if ($optname eq "help") { die $usage }
    elsif ($optname eq "help") { show_doc() }
    elsif ($optname eq "noverbose") { $::opt_verbose=0 }
    elsif ($optname eq "nocompress") { $::opt_compression='none' }
    elsif ($optname eq "verbose") { $::opt_verbose++ }
    elsif ($optname eq "hires")  { $::opt_hires =$optval }
    elsif ($optname eq "exact")  { $::opt_exact =$optval }
    elsif ($optname eq "below")  { $::opt_below =$optval }
    elsif ($optname eq "approx") { $::opt_approx=$optval }
    elsif ($optname eq "threshold")  { $::opt_threshold=$optval+0 } # Imp: accept only int 0..256
    elsif ($optname eq "filter") {
      # errorUsage "Multiple input filenames" if defined $InputFilename;
      # $InputFilename='-';
      errorUsage "Multiple output filenames" if defined $OutputFilename;
      $OutputFilename='-';
    } elsif ($optname eq "tmpunlink") { $tmpunlink_p=$optval }
    elsif ($optname eq "gs")     { $FileFormat=$optval ? 'PDF1' : 'markedEPS' }
    elsif ($optname eq "compression") {
      errorUsage "--$optname expects one of: @{[keys%vals_compression]}" if !exists $vals_compression{$optval};
      $::opt_compression=$optval;
      $::opt_compression='zip' if $::opt_compression eq 'flate';
    } elsif ($optname eq "outputfile") {
      errorUsage "Multiple output filenames" if defined $OutputFilename;
      $OutputFilename=$optval;
    } elsif ($optname eq "gs-cmd") {
      errorUsage "Multiple --gs-cmd" if defined $::opt_gs_cmd;
      $::opt_gs_cmd=$optval;
    } elsif ($optname eq "gs-ccmd") {
      errorUsage "Multiple --gs-ccmd" if defined $::opt_gs_ccmd;
      $::opt_gs_ccmd=$optval;
    } elsif ($optname eq "extra") { push @extra, $optval }
    elsif ($optname eq "gsextra") { push @gsextra, $optval }
    elsif ($optname eq "duplex") {
      errorUsage "--$optname expects one of: @{[keys%vals_duplex]}" if !exists $vals_duplex{$optval};
      $::opt_duplex=$optval
    } elsif ($optname eq "bboxfrom") {
      errorUsage "--$optname expects one of: @{[keys%vals_bboxfrom]}" if !exists $vals_bboxfrom{$optval};
      $::opt_bboxfrom=$optval
    } elsif ($optname eq "noantialias") {
      $::opt_antialias='no'
    } elsif ($optname eq "antialias") {
      errorUsage "--$optname expects one of: @{[keys%vals_antialias]}" if !exists $vals_antialias{$optval};
      $::opt_antialias=$optval
    } elsif ($optname eq "resolution") {
      if ($optval eq "unchanged" or $optval eq "force-unknown") { }
      elsif ($optval=~/^(\d+(?:[.]\d+)?)\Z(?!\n)/) { $optval="$1x$1" }
      elsif ($optval=~/^(\d+(?:[.]\d+)?[x,]\d+(?:[.]\d+)?)\Z(?!\n)/) { }
      else { errorUsage "--Resultion expects unchanged | force-unknown | DPI | XDPIxYDPI" }
      $::opt_resolution=$optval
    } elsif ($optname eq "papersize" or $optname eq"paper") {
      if ($optval eq "unchanged" or $optval eq "force-unknown") { $::opt_papersize=$optval }
      else {
        my @L=Htex::papers::any($optval);
        errorUsage "invalid or unknown for --papersize" if !@L;
        $::opt_papersize="$L[1],$L[2]" # width, height
      }
    } else { die } # unreachable    
  } # NEXT opt
  errorUsage "Too many arguments (multiple input/output files?)" if $I!=@ARGV;
  # splice @ARGV, 0, $I;
}

$GS=$::opt_gs_cmd if defined $::opt_gs_cmd;
my $CGS=$GS;
$CGS=$::opt_gs_ccmd if defined $::opt_gs_ccmd;
$GS.= " -dSAFER"; # -dWRITESYSTEMDICT
$CGS.=" -dSAFER"; # -dWRITESYSTEMDICT

### get input and output filename
if (!defined $InputFilename and defined $OutputFilename) { # --filter
  $InputFilename='-';
} elsif (!defined $InputFilename) {
  errorUsage "Input filename missing"
} elsif (!defined $OutputFilename) {
  $FileFormat='PDF1' if !defined $FileFormat;
  if ($FileFormat eq 'PDF1' or $FileFormat eq 'PDF') {
    if (($OutputFilename=$InputFilename) ne '-') {
      $OutputFilename =~ s/\.[^\.]*$//;
      $OutputFilename .= ".pdf";
    }
  } else {
    $OutputFilename = '-'; # standard output
  }
}
print STDERR $title if $::opt_verbose;
$title="";

# Dat: no more @ARGV
errorUsage "please specify <outformat>" if
  !defined $FileFormat and ($OutputFilename!~m@[.]([^/.]+)\Z(?!\n)@ or
  !defined($FileFormat=$fmt_exts{lc$1}));
$::opt_below=is_any_origin_ok() if !defined $::opt_below;
error "--below=1 invalid for FileFormat $FileFormat" if $::opt_below and
  !is_any_origin_ok() and $FileFormat ne 'PDF1' and $FileFormat ne 'EPS' and
  $FileFormat ne 'markedEPS';
error "--below=0 invalid for FileFormat $FileFormat" if !$::opt_below and
  is_any_origin_ok();
$::opt_antialias=is_has_antialias() ?
  (is_sampled() ? 'scale3no' : 'yes') : 'no' if
  !defined $::opt_antialias;

if ($FileFormat eq 'PBM' and ($::opt_antialias eq 'scale3yes' or
  $::opt_antialias eq 'scale3no')) {
} elsif ($::opt_antialias ne 'no' and !is_has_antialias()) {
  $::opt_antialias='no';
  warning "--AntiAlias ignored for FileFormat $FileFormat"
}
if ($::opt_antialias eq 'scale3no' or $::opt_antialias eq 'scale3yes') {
  $::opt_resolution="72,72" if $::opt_resolution eq 'unchanged' or $::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'default';
  # ^^^ GS raster default
  my @L=split/[,x]/,$::opt_resolution;
  @L=(@L,@L); # Imp: ..
  $L[0]*=3; $L[1]*=3;
  $::opt_resolution="$L[0],$L[0]";
}

### option compress
my $GSOPTS=join("  ",map{fnq$_}@gsextra);
# $GSOPTS.=" -r72 -sPAPERSIZE=a4 "; # default -- will be overridden by `setpagedevice'
# ^^^ Dat: default does only harm; user should specify on command line

### option BoundingBox types
#**** pts ****
# scan all of them and find the best
{ my $BBprint = "%%BoundingBox:";
  $BBprint = "%%HiResBoundingBox:" if $::opt_hires;
  $BBprint = "%%ExactBoundingBox:" if $::opt_exact;
  debug "Strongest BoundingBox comment:", $BBprint;
}
my $BBregex='%%(Hi[Rr]es|Exact|)BoundingBox:';

if (!is_set_pagesize_ok()) {
  if ($::opt_papersize ne'default' and $::opt_papersize ne'force-unknown') {
    error "Cannot set --PaperSize for FileFormat $FileFormat"
  } else { $::opt_papersize='force-unknown' }
} elsif ($::opt_papersize eq'default') { $::opt_papersize='unchanged' }

if ($::opt_resolution eq'default') { $::opt_resolution='force-unknown' }
error "Cannot set --Resolution for FileFormat $FileFormat (must be markedPS or sampled)"
  if $FileFormat ne 'markedPS' and !is_sampled()
  and $::opt_resolution ne'force-unknown';
error "Bad --Resolution=$::opt_resolution" if $::opt_resolution ne 'unchanged'
  and $::opt_resolution ne 'force-unknown' and $::opt_resolution!~/\A(\d+)+[,x](\d+)\Z(?!\n)/;

if ($FileFormat ne 'markedPS' and $FileFormat ne 'PCL5') {
  if ($::opt_duplex ne'default' and $::opt_duplex ne'force-unknown') {
    error "Cannot set --Duplex for FileFormat $FileFormat (must be markedPS or PCL5)"
  } else { $::opt_duplex='force-unknown' }
} elsif ($::opt_duplex eq'default') { $::opt_duplex='force-unknown' }

debug "Doing --PaperSize $::opt_papersize" if $::opt_papersize ne 'force-unknown';
debug "Doing --Duplex $::opt_duplex" if $::opt_duplex ne 'force-unknown';
debug "Doing --Resolution $::opt_resolution" if $::opt_resolution ne 'force-unknown';
debug "Doing --AntiAlias=$::opt_antialias" if $::opt_antialias ne 'no';

### option outfile
if ($OutputFilename eq '-') {
  debug "Output file: standard output";
} else {
  debug "Output filename: $OutputFilename";
  #error "$OutputFilename: won't overwrite input file with itself"
  #  if $OutputFilename eq $InputFilename;
}

### option gs
debug "Output FileFormat: $FileFormat";
$::opt_compression='zip' if $::opt_compression ne 'none';
if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') {
  debug "Ghostscript ps2pdf command: $GS  $GSOPTS";
  debug "Compression: $::opt_compression";
} elsif ($FileFormat eq 'PCL5') {
  debug "Ghostscript ps2ljet command: $GS  $GSOPTS";
} elsif (is_sampled()) {
  debug "Ghostscript ps2sampled command: $GS  $GSOPTS";
}

#**** pts ****
sub read_error() { error "read $InputFilename: $!" }
my $bytes_left=-1; # -1==unlimited
my $already_read=0;
sub dem1($){defined$_[0]?$_[0]:-1}
#** @param $_[0] number of bytes to read, or undef to read a line
#** @return the string read
sub readIN(;$) {
  my $S;
  ## return "" if $bytes_left==0;
  ## print STDERR "READ($_[0])\n";
  if (defined $_[0]) { read_error if 0>dem1 read IN, $S, $_[0] }
  else {
    $!=0; # clean up error code
    $S=<IN>;
    read_error if !defined($S) and $!;
    $S="" if !defined $S; # EOF
  }
  if ($bytes_left<0) { # unlimited
  } elsif (length($S)>=$bytes_left) {
    $S=substr($S, 0, $bytes_left);
    $bytes_left=0;
  } else { $bytes_left-=length($S) }
  $already_read+=length($S);
  $S
}

sub open_OUT() {
  error "Cannot write outfile '$OutputFilename'" unless
    open(OUT, $OutputFilename eq '-' ? ">-" : "> $OutputFilename")
}

#** @param $_[0] temp file extension (e.g ".img")
#** @param $_[1] preprint
#** @param $_[2] bool: force pipe even if seekable?
sub fix_pipe_in($$$) {
  my $c="";
  if ($_[2] or (length($c=readIN(1))!=0 and !seek IN,-1,1)) { # we cannot seek back
    # Dat: ^^^ test seekability instead of $InputFilename eq '-'
    my($ext,$preprint)=@_;
    my $tifn;
    # $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
    $tifn=temp_prefix()."M$ext";
    error "Cannot open temp input: $tifn" unless open TI, "> $tifn";
    $tmpfiles{$tifn}=1;
    die unless print TI $preprint, $c;
    print TI or die while length($_=readIN 4096);
    die unless close TI;
    $InputFilename=$tifn;
    debug "Temp input file: $InputFilename";
    die unless open IN, "< $tifn";
    die unless seek IN, length($preprint), 0;
    $already_read=length($preprint);
    $bytes_left=-1; # unlimited, since readIN() has copied only part
    # $bytes_left++ if $bytes_left>=0; # ungetc($c)
    # temp_unlink $tifn; # do it later (at END{})
  } else {
    $already_read--; $bytes_left++ if $bytes_left>=0; # BUGFIX at Fri May 14 00:21:18 CEST 2004
  }
}

my $temp_out_fn;

#** Does overwrite $temp_out_fn. Fine.
sub fix_force_out($) {
  my($ext)=$_[0];
  # $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
  $temp_out_fn=temp_prefix()."O$ext";
  # error "Cannot save output: $!" unless open SAVEOUT, ">&OUT"; # always STDOUT; maybe not open yet
  error "Cannot open temp output: $temp_out_fn" unless open OUT, "> $temp_out_fn";
  $tmpfiles{$temp_out_fn}=1;
  # $OutputFilename=$temp_out_fn;
  debug "Temp output file: $temp_out_fn";
  # temp_unlink $temp_out_fn; # do it later (at END{})
  return $temp_out_fn;
}

#** @param $_[0] temp file extension (e.g ".img")
#** @return new output filename
sub fix_pipe_out($) {
  if (!defined $temp_out_fn) {
    return $OutputFilename if $OutputFilename ne '-';
    return fix_force_out($_[0]);
  }
  $temp_out_fn
}
sub fix_close_out() {
  # error "closing filter out: $? $!" unless close OUT;
  if (defined $temp_out_fn) {
    my $buf;
    die unless open FCO, "< $temp_out_fn";
    print STDOUT $buf while sysread FCO, $buf, 4096;
    die unless close FCO;
    temp_unlink $temp_out_fn;
    undef $temp_out_fn;
  }
}

sub do_system {
  my($progname)=splice@_,0,1;
  debug "Running: $progname  @extra @_";
  error "prog $progname failed: $? $!"
    if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found
}

sub do_exec {
  my($progname)=splice@_,0,1;
  if (scalar keys %tmpfiles) {
    # Cannot exec() right now, because we have to unlink some temporary files
    # later.
    do_system $progname, @_;
  } else {
    debug "Execing: $progname  @extra @_";
    1 if exec $progname, @extra, @_;
    # ^^^ Dat: $OutputFilename eq '-' should be OK
    error "exec failed: $!";
  }
  exit(0);
}

#sub shq($) {
#  my $S=$_[0];
#  return $S if $S!~y@A-Za-z0-9_,:./-@@c and length($S)>0;
#  $S=~s@'@'\\''@g;
#  return "'$S'"
#}

### open input file
if ($InputFilename eq '-') {
  debug "Input file: standard input";
  open(IN, "<&STDIN") or error "cannot open standard input";
} else {
  # -f $InputFilename or error "input file missing: $InputFilename"; # Imp: named pipe?
  open(IN,"< $InputFilename") or error "cannot open input file: $InputFilename";
  debug "Input filename:", $InputFilename;
  if ($InputFilename eq $OutputFilename) {
    # error "same input and output file: $InputFilename";
    my $ext=$InputFilename=~m@([.][^./]+)\Z(?!\n)@ ? $1 : "";
    binmode IN; $bytes_left=-1;
    fix_pipe_in($ext, "", 1); # Dat: defined later
  }
}
binmode IN;

### scan first line, check for DOS EPSF (and remove DOS headers)
my $header;
{ SCAN_AGAIN:
  my $S;
  $_=$header="";
  read_error if 0>read IN, $S, 4;
  error "$InputFilename: empty file" if 0==length($S);
  $already_read+=length($S);
  ##print tell(IN)." bar=$already_read\n";
  my $iff="?"; # Input File Format
  # vvv be permissive, since we have only 4 chars
  if ($S eq "\211PNG") { $iff="PNG" }
  elsif ($S=~/\A(\377+\330)\377/) { $iff="JPEG" }
  elsif ($S eq "MM\000\052" or $S eq "II\052\000") { $iff="TIFF" }
  elsif ($S=~m@\AP([1-6])[\s#]@) { $iff="PNM" }
  elsif ($S=~/\ABM/) { $iff="BMP" }
  elsif ($S eq "GIF8") { $iff="GIF" }
  elsif ($S eq "FORM") { $iff="LBM" }
  elsif ($S eq "/* X" or $S eq "/*XP") { $iff="XPM" }
  elsif ($S=~/\A\12[\0-\005]\001[\001-\10]/) { $iff="PCX" }
  elsif ($S=~/\A[\36-\77](?:\001[\001\11]|\0[\002\12\003\13])\0/) { $iff="TGA" }
  elsif ($S eq "\305\320\323\306") { $iff="DOS-EPSF" }
  elsif ($S eq "\033%-1") { $iff="UEL" }
  elsif (substr($S,0,1)eq'%') { $iff="P" } # PS, EPS or PDF
  
   # PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA
  if ($iff eq "DOS-EPSF") { # DOS EPSF header
    read_error if 30-4>read IN, $S, 30-4, 4;
    my ($eheader,$ps_ofs,$ps_len,$wmf_ofs,$wmf_len,$tif_ofs,$tif_len,$checksum)=
      unpack"A4VVVVVVv", $S;
    $already_read+=30-4;
    error "$InputFilename: bad DOS EPS" if $eheader ne "\305\320\323\306" or $ps_ofs<30;
    my($ps_end, $wmf_end, $tif_end)=($ps_ofs+$ps_len, $wmf_ofs+$wmf_len, $tif_ofs+$tif_len);
    $ps_ofs-=30;
    if (!seek IN, $ps_ofs, 1) {
      while ($ps_ofs>4096) { $ps_ofs-=4096; readIN 4096 }
      read_in $ps_ofs if $ps_ofs>0;
    }
    $bytes_left=($ps_end>$wmf_end and $ps_end>$tif_end) ? -1 : $ps_len;
    $S=readIN(1);
  } elsif ($iff eq "UEL") { # HP PJL UEL, untested
    $S.=readIN;
    $S=substr($S,1);
    error "$InputFilename: bad HP PJL UEL header: ".(~chomp($S)&&$S)
      if $S!~/\A%-12345X\@PJL ENTER LANGUAGE\s*=\s*POSTSCRIPT\s*\r?$/i;
    1 while length($S=readIN())!=0 and substr($S,0,4)ne'%!PS';
    die "$InputFilename: premature HP PJL UEL header" if length($S)==0;
  } elsif ($iff eq "P") {
    # no-op yet, see later
  } elsif ($iff eq "?") {
    error "unknown input image format: $InputFilename";
  } else { # some vector graphics format
    # Imp: why isn't sam2p(1) PNG -> PNG idempotent?
    my $sfmt=$FileFormat eq'markedEPS' || $FileFormat eq 'EPS' ? 'EPS'
           : $FileFormat eq'markedPS' || $FileFormat eq 'PS' ? 'PS' # Dat: emits no /PageSize
           : $FileFormat eq'PDF1' || $FileFormat eq 'PDF' ? 'PDF'
           : undef;
    if (defined $sfmt) {}
    elsif (is_via_sam2p() or is_ok_sam2p()) {$sfmt=$FileFormat; $::opt_approx=1}
    else { error "sam2p doesn't support our FileFormat $FileFormat" }
    fix_pipe_in ".img", $S, 0;
    if ($::opt_approx) {
      do_exec('sam2p', ("$sfmt:", '--', $InputFilename, $OutputFilename));
    } else {
      warning "post-processing of sam2p PDF output increases file size" if $sfmt eq 'PDF';
      $sfmt='EPS' if $sfmt eq 'PDF'; # Imp: PDF1<->PDF
      close IN;
      my $tpfn=temp_prefix()."Psimg";
      error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
      $tmpfiles{$tpfn}=1;
      die unless close TP;
      do_system('sam2p', ("$sfmt:", '--', $InputFilename, $tpfn));
      error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
      $already_read=0; $bytes_left=-1;
      $InputFilename=$tpfn; # '-'
      goto SCAN_AGAIN
    }
  }

  # now deal with PS, EPS and PDF
  if (substr($S,0,1) eq '%') {
    $S.=readIN;
    if (substr($S,0,4)eq'%PDF') {
      # error "$InputFilename: won't read a PDF file";
      if ($FileFormat eq 'PDF') { # convert PDF to PDF
        # !! PDF->PS->PDF
        open_OUT();
        $_=$S;
        debug "Doing a bit-by-bit copy";
        do {
          error "input error: $!" unless print OUT;
        } while (length($_=readIN 4096));
        close OUT; close IN;
        exit 0;
      } elsif ($FileFormat eq 'PDF1') { # Dat: remove extra pages by running pdftops and gs -sDEVICE=pdfwrite
        # !! Imp: possibly Run MetaPost output through full dvips (texc.pro) when prologues:=0
        # !! Imp: add full dvips %* font comment when prologues:=1 (design sizes missing :-()
	# Dat: no way to use $::opt_approx, because it doesn't remove extra pages
        fix_pipe_in ".pdf", $S, 0; # in case of stdin
        # Imp: option to open pdftops pipe instead of temp file
        # Dat: we rather use a temp file here for safety and early error detection
       do_input_pdftops: # come from EPS: and markedEPS:
        close IN; # after fix_pipe_in()
	my $tpfn=temp_prefix()."Peps";
        error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
        $tmpfiles{$tpfn}=1;
        die unless close TP;
        do_system qw(pdftops -f 1 -l 1 -eps -- ), $InputFilename, $tpfn;
        error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
	$already_read=0; $bytes_left=-1;
        $InputFilename=$tpfn; # '-'
        goto SCAN_AGAIN
      } elsif ($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS') { # convert PDF to EPS
        # Dat: limitation: markedEPS and EPS are treated the same
        # vvv Dat: pdftops(1) is part of the xpdf package
	# vvv Dat: pdftops(1) can emit to stdout
        fix_pipe_in ".pdf", $S, 0;
	if ($::opt_approx) {
          do_exec qw(pdftops -f 1 -l 1 -eps --), $InputFilename, $OutputFilename;
	} else { goto do_input_pdftops }
      } elsif ($FileFormat eq 'PS' or $FileFormat eq 'markedPS') {
        # Dat: limitation: markedEPS and EPS are treated the same
        fix_pipe_in ".pdf", $S, 0;
	close IN;
        # vvv we must query the BoundingBox first
        my $cmd="pdftops -f 1 -l 1 -eps ".fnq($InputFilename)." -";
        debug "pdftops bbox pipe: $cmd";
        error "pipe: $!" unless open PIPE, "$cmd |";
        my $line;
        error "expected PS document" if !defined($line=<PIPE>) or $line!~/^%!PS-Adobe-\d.*EPSF-\d/;
        my @L; # $papersize_x, $papersize_y
        while (<PIPE>) {
          last if /^%%EndComments/ or !/^%/;
          @L=($1,$2) if /^%%(?:Hires|Exact)BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i;
          @L=($1,$2) if /^%%BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i and !@L;
          # ^^^ Dat: HiRes has priority
          # ^^^ Dat: ignore llx and lly coordinates
        }
        1 while read PIPE, $line, 4096;
        error "closing PIPE: $?" unless close PIPE;
        error "BoundingBox not found in pdftops output" if !@L;
        debug "Got PaperSize: @L";
        $L[0]=ceil $L[0]; $L[1]=ceil $L[1]; # Dat: pdftops expects integer papersize :-( )
	if ($::opt_approx) {
          do_exec 'pdftops', '-paperw', $L[0], '-paperh', $L[1], $InputFilename, $OutputFilename;
	} else {
	  my $tpfn=temp_prefix()."Pps";
	  error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
	  $tmpfiles{$tpfn}=1;
	  die unless close TP;
          do_system 'pdftops', '-paperw', $L[0], '-paperh', $L[1], $InputFilename, $tpfn;
	  error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
	  $already_read=0; $bytes_left=-1;
	  $InputFilename=$tpfn; # '-'
	  goto SCAN_AGAIN
	}
      }
      error "cannot create from PDF: FileFormat $FileFormat";
     OK:
    }
    error "$InputFilename: EPS DSC must be %!PS-Adobe" if substr($S,0,4)ne'%!PS';
    # ^^^ Dat: mpost outputs "%!PS\n"
  } else {
    warning "$InputFilename: no PS ADSC header, BoundingBox not found\n"
  }
  $header=$S;
}

# Dat: Now we are converting from PS|EPS to EPS|markedEPS|PDF|PCL5|PGM
#      So we're converting from PS|EPS with Ghostscript 

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

my $ll_zero=0; # ($llx,$lly)==(0,0) in the output file
my $need_grestore=0; # 0 v 1
#** Applies %%*BoundingBox, %%EndComments, special setpagedevice, gsave..translate
#** @param $_[0] llx, may be undef to signify that bbox is undetected
#** @param $_[1] lly
#** @param $_[2] urx
#** @param $_[3] ury
#** @param $_[4] after_correct PostScript code (resolution, page size)
#** @return PostScript code to be printed after the header
sub CorrectBoundingBox($$$$$$$) {
  no integer;
  my $bbx="";
  my $pagedev_mark="";
  my $translate="";
  my ($llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored) = @_;
  if (defined $llx) {
    my ($xoffset, $yoffset) = (0, 0);
    my $old_bbox="$llx $lly $urx $ury"; # debug "Old BoundingBox: $old_bbox";
    # my ($width, $height) = ($urx - $llx, $ury - $lly);
    ($xoffset, $yoffset) = (-$llx, -$lly);
    # $::opt_below=0 if $lly>=0; # always move to (0,0)
    # my ($urxh,$uryh)=($urx,$ury);
    # my $no_translate=$::opt_below;
    #die $no_translate;
    ($llx,$lly,$urx,$ury)=(0,0,$urx-$llx,$ury-$lly) if !$::opt_below;
    $urx=1 if $urx<=0; # Dat: GS dislikes empty image; fix also negative image
    $ury=1 if $ury<=0;
    my($px,$py)=($urx,$ury);
    ($px,$py)=($1+0,$2+0) if $after_correct=~m@/PageSize\s*\[(\S+)\s+(\S+)+\]@;
    my @paper=Htex::papers::any("$px,$py");
    $paper[0]=defined $paper[0] ? "%%DocumentPaperSizes: $paper[0]\n" : "";
    $bbx.="%%BoundingBox: ".floor($llx)." ".floor($lly)." ".
                             ceil($urx)." ". ceil($ury)."\n";
    $bbx.="%%HiResBoundingBox: $llx $lly $urx $ury\n".
          "%%ExactBoundingBox: $llx $lly $urx $ury\n" if floor($llx)!=$llx
      or floor($lly)!=$lly or ceil($urx)!=$urx or ceil($ury)!=$ury;
    $bbx.="%%DocumentMedia: plain $px $py 0 () ()\n". # like pdftops(1)
          "$paper[0]";
    # ^^^ Imp: can DocumentMedia be non-integer? As of us, it can.
    # vvv we output a second /MediaBox here, and we'll remove the first one
    #     (written by GS) later
    # vvv Dat: old version of Ghostscript insisted on an integer /CropBox (??).
    #          we do not force it now
    $pagedev_mark.="mark /CropBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark();
    # die "$xoffset $yoffset $::opt_below";
    if ($xoffset==0 and $yoffset==0) { #**** pts ****
      $need_grestore=0;
      $ll_zero=1; # Dat: we do not insert extra /MediaBox here, gs -sDEVICE=pdfwrite will do
    } elsif ($::opt_below) {
      # Do not translate (set (0,0) to the origin) with --below or multi-page
      # file formats.
      $need_grestore=0;
      $ll_zero=0; # fix /MediaBox because it become non-(0,0)-based
      $pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if
        is_pdfmark(); # $FileFormat eq 'markedEPS' or $FileFormat eq 'markedPS';
      # Dat: markedPS and contains pdfmark!
    } else {
      # debug "Offset:", $xoffset, $yoffset; # no new information, see -$llx, -$lly
      $xoffset=0 if $xoffset==0; # get rid of `-0'
      $yoffset=0 if $yoffset==0; # get rid of `-0'
      if ($is_restored) { $translate="" } # save..restore does gsave..grestore
                   else { $translate="gsave "; $need_grestore=1 }
      $ll_zero=0;
      # vvv the /MediaBox is different from what gs dumps
      # $pagedev_mark=~s@/PageSize\s*\[[^\]]*]@/PageSize [$urx $ury]@; # BUGFIX at Tue Apr 22 10:08:17 CEST 2003
      $pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark();
      $translate.="$xoffset $yoffset translate\n"
    }
    my $new_bbox="$llx $lly $urx $ury";
    if ($old_bbox eq $new_bbox) {
      debug "Final BoundingBox: $new_bbox";
    } else {
      debug "Old BoundingBox: $old_bbox";
      debug "Final corrected BoundingBox: $new_bbox";
    }
    $pagedev_mark="/pdfmark where{pop}{/pdfmark/cleartomark load def}ifelse\n$pagedev_mark"
      if length($pagedev_mark)!=0;
  }
  # vvv Imp: `<<' -> `dict'
  # Dat: it is inherently impossible to tell GS that it shouldn't
  #      recompress the images already compressed in the EPS file, but keep
  #      them in their original, compressed form. So we rather instruct GS to
  #      recompress
  my $markpagedevices="";
  if (is_pdfmark()) {
    $markpagedevices="
/CompatibilityLevel 1.2 %PDF-1.2
/EmbedAllFonts true
/Optimize true % ignored by gs-6.70
/AutoRotatePages /None
/UseFlateCompression ".($::opt_compression ne 'none'?"true":"false")."
/AutoPositionEPSFiles false
/AutoFilterGrayImages false
/ConvertImagesToIndexed false
/DownsampleMonoImages false
/DownsampleGrayImages false
/DownsampleColorImages false
/AutoFilterColorImages false
/EncodeMonoImages true
/EncodeGrayImages true
/EncodeColorImages true
/AntiAliasMonoImages false
/AntiAliasGrayImages false
/AntiAliasColorImages false\n";
    $markpagedevices=(length($markpagedevices)!=0 ? "<< $markpagedevices >> setpagedevice\n" : "");
    $markpagedevices.="1 dict dup /ImagingBBox null put setpagedevice\n";
    $markpagedevices.="1 dict dup /Policies 1 dict dup /PageSize 3 put put setpagedevice\n"; # ripped from pdftops(1)
  }
  my $setpagesize="";
  # die defined $urx;
  # die is_set_pagesize_ok();
  # die $after_correct;
  if (defined $urx and is_set_pagesize_ok()
  and $::opt_papersize ne'force-unknown'
  and $after_correct!~m@/PageSize\s*\[@) { # Imp: m@/Pagesize ugly
    # Dat: true for FileFormat PGM
    # Dat: emit /PageSize even for PDF1
    # Dat: Ghostscript 6.70 rounds /PageSize down, but we need up when creating /MediaBox for PDF
    $setpagesize="2 dict dup /PageSize [".ceil($urx)." ".ceil($ury)."] put setpagedevice\n";
    # ^^^ Dat: PLRM.pdf doesn't forbid a non-integer /PageSize
  }
  my $bsetup=is_page1_stop()?"":"%%BeginSetup\n%%EndSetup\n";
  # ^^^ Dat: CUPS inserts its setpagedevice calls for /Duplex and /PageSize
  #     etc. just after the %%BeginSetup line (or, if missing, puts it in
  #     front of the first %%Page). We'd like this execution order: CUPS,
  #     ours, PStoPS (or psnup). (When we come after CUPS, we'll have a
  #     chance to override its settings.) So we emit a fake
  #     %%BeginSetup..%%EndSetup pair just before our code doing
  #     `setpagedevice'.
  # !! ?? run pstops first, and then a2ping.pl
  my $save=$is_restored?"save\n":"";
  $bbx.$fontsdefs."%%EndComments\n".$bsetup.$setpagesize.$markpagedevices.$pagedev_mark.$after_correct.$save.$translate
}

### scan header
my $to_OUT="";
my $after_code="";
my $do_fix_tumble=0;
my $is_restored=0;
if (1<length($header)) {
  my($llx,$lly,$urx,$ury);
  my($bbtype)='-'; # None
  my $allow_adsc_bb=1;
  my $after_correct="";
  my $do_bb_line=sub { # sub do_bbline($$)
    no integer;
    # Decreasing precedence of various BoundingBoxes:
    # The last valid *bbox entry has effect.
    # Active policy:
    #   normal mode : BoundingBox ExactBoundingBox HiResBoundingBox
    #   --hires mode: HiResBoundingBox BoundingBox ExactBoundingBox
    #   --exact mode: ExactBoundingBox BoundingBox HiResBoundingBox
    #   -hi -ex mode: ExactBoundingBox HiResBoundingBox BoundingBox
    # Another possible policy:
    #   normal mode : BoundingBox HiResBoundingBox==ExactBoundingBox
    #   --hires mode: HiResBoundingBox ExactBoundingBox BoundingBox
    #   --exact mode: ExactBoundingBox HiResBoundingBox BoundingBox
    #   -hi -ex mode: ExactBoundingBox==HiResBoundingBox BoundingBox
    my($S,$from)=@_;
    return if $S!~/^(?:$BBregex|set)$BBValues/oi;
    # print STDERR "($S)\n";
    my $E1=defined$1 ? $1 : "+";
    my $T=!defined($1) ? 'S' : uc substr $1,0,1; # '' || 'H' || 'E'
    # debug "Trying BoundingBox T-$bbtype: $llx $lly $urx $ury";
    if ($T eq 'S'
     or !$::opt_hires and !$::opt_exact and ($T eq '' or ($bbtype ne '' and ($T eq 'E' or $bbtype ne 'E')))
     or  $::opt_hires and !$::opt_exact and ($T eq 'H' or ($bbtype ne 'H' and ($T eq '' or $bbtype ne '')))
     or  $::opt_exact and !$::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq '' or $bbtype ne '')))
     or  $::opt_exact and  $::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq 'H' or $bbtype ne 'H')))
       ) {
      # if ($allow_bb) {
        ($bbtype,$llx,$lly,$urx,$ury)=($T,$2+0,$3+0,$4+0,$5+0);
        debug "Applying ${E1}BoundingBox$from T-$bbtype: $llx $lly $urx $ury";
      # }
    } else {
      my @L=($2+0,$3+0,$4+0,$5+0); # convert 0.00 to 0
      debug "Ignoring ${E1}BoundingBox$from T-$bbtype: @L";
    }
    # Dat: don't do $do_bb_line=sub{};# same as $allow_bb=0;
  };
  $header=~s@\r\n?\Z(?!\n)@@;
  my $after_comments=""; # after %%EndComments
  # my $res;
  { my $headEPSF;
    my $headPS="PS-Adobe-3.0";
    # vvv Imp: run this correction even w/o input EPS header
    if ($header!~s/\s+(EPSF-[.\d]+)$// or $::opt_bboxfrom ne 'guess') { # a PS not an EPS already
      # This is the compute-pipe routine.
      # To convert an [E]PS to an EPS:
      # -- find the end of the 1st page in the code, and remove everything after it
      # -- `pop' off the execution stack after the 1st page
      # -- `end' the dictionary stack after the 1st page
      # -- change the ADSC magic `%!PS-Adobe-...' to `%!PS-Adobe-3.0 EPSF-3.0'
      # -- remove the `%%Pages', `%%DocumentPaperSizes', `%%PageOrder:'
      #    (Ascending) comment from the ADSC header
      # -- possibly remove the `%%Page' ADSC comment [no]
      # -- ignore calls to = setpage setpagemargin setpageparams .setpagesize
      #    setpagedevice setpagetype setprintername setresolution a4 letter ...
      # -- surround the code by save ... pop* end* restore (implies gsave ... grestore)
      # -- possibly ignore calls to showpage [showpage is forced]
      $headEPSF=" EPSF-3.0";
      debug "Computing BBox info from non-EPS PS file";
      fix_pipe_in 'i.ps', "%!$headPS\n", 0;
      my $tfn=temp_prefix()."c.tgs";
      error "temp open $tfn: $!" unless open F, "> $tfn";
      $tmpfiles{$tfn}=1;
      ##print tell(IN)." car=$already_read\n";
      die "$0: $!\n" unless print F "% this is temporary gs command file created by $program".'
/DOCUT true def
/MAINFILE FN (r) file def
/DICTCOUNT countdictstack def
count /OPCOUNT exch def
<</BeginPage { % <PageCount> BeginPage -
    dup 1 eq {
      count OPCOUNT sub 1 sub (pop-count==) ..print ===
      countdictstack DICTCOUNT sub (end-count==) ..print ===
      DOCUT { (cut-offset==) ..print MAINFILE fileposition === flush } if
      (bbox-success\n) ..print
      quit
    } if
    .callbeginpage
  }
>> setpagedevice

% vvv do these after our call to /setpagedevice
.currentglobal true .setglobal
systemdict begin
/..paper.redef<< >>def
/..print/print load def
/setpageparams{pop pop pop pop (\nset-called-4==/setpageparams\n) ..print flush}def
/setpage{pop pop pop (\nset-called-3==/setpage\n) ..print flush}def
/setpagesize{pop pop (\nset-called-2==/setpagesize\n) ..print flush}def
/.setpagesize{pop pop (\nset-called-2==/.setpagesize\n) ..print flush}def
/setpagemargin{pop (\nset-called-1==/setpagemargin\n) ..print flush}def
{% anti-Windows-printer-driver `%%[ ProductName:` etc.
  dup type/stringtype eq{
    dup length 3 ge{
      dup 0 3 getinterval (%%[) eq{
        (\nset-called-1==/=\n) ..print flush
        (\nset-called-1==/print\n) ..print flush
  }if}if}if
  pop
}
dup/= exch def /print exch def
/setpagedevice{pop (\nset-called-1==/setpagedevice\n) ..print flush}def
/..sdict <<
  /PageSize { % [. .] PageSize -
    dup type /arraytype eq {
      dup length 2 ge {
        dup 0 get type dup /integertype eq exch /realtype eq or {
          dup 1 get type dup /integertype eq exch /realtype eq or {
            (\npapersize-x==) ..print dup 0 get ===
            (\npapersize-y==) ..print dup 1 get === (\n) ..print
          } if
        } if
      } if
    } if
    pop
  }
  /HWResolution { % [. .] PageSize -
    dup type /arraytype eq {
      dup length 2 ge {
        dup 0 get type dup /integertype eq exch /realtype eq or {
          dup 1 get type dup /integertype eq exch /realtype eq or {
            (\nresolution-x==) ..print dup 0 get ===
            (\nresolution-y==) ..print dup 1 get === (\n) ..print
          } if
        } if
      } if
    } if
    pop
  }
  /Duplex { % [. .] PageSize -
    dup type /booleantype eq {
      (\nsides-duplex==) ..print dup === (\n) ..print
    } if
    pop
  }
  /Tumble { % [. .] PageSize -
    dup type /booleantype eq {
      (\nsides-tumble==) ..print dup === (\n) ..print
    } if
    pop
  }
>> def
%/.setpagesize{pop pop (hehehe\n) print} def
% /a4{(hehehe\n) ..print} def % doesn"t work, has to be put into userdict
/setpagedevice{
  { % <key> <val>
    exch dup ..sdict exch known { % run all keys known in ..sdict
      ..sdict exch get exec
    } {pop pop} ifelse
  } forall
  (\nset-called-1==/setpagedevice\n) ..print flush
}def
/setpagetype{pop (\nset-called-1==/setpagetype\n) ..print flush}def
/setprintername{pop (\nset-called-1==/setprintername\n) ..print flush}def
/setresolution{pop (\nset-called-1==/setresolution\n) ..print flush}def
[ % Dat: fixed at Mon May 19 14:32:31 CEST 2003
  statusdict /.pagetypenames 2 copy known {get}{pop pop{}}ifelse
  % ^^^ Dat: may be {/a4 STRICT {(%END SIZES) .skipeof} if /a5}
  { /11x17/a3/a4/a4small/b5/ledger/legal/letter % GS 7.04
    /lettersmall/note/a0/a1/a2/a5/a6/a7/a8/a9/c0/c1/c2/c3/c4/c5/c6
    /a10/b0/b1/b2/b3/b4/b5/b6
    /isob0/isob1/isob2/isob3/isob4/isob5/isob6
    /jisb0/jisb1/jisb2/jisb3/jisb4/jisb5/jisb6
    /archE/archD/archC/archB/archA/flsa/flse/halfletter
    /tabloid/csheet/dsheet/esheet/executivepage/com10envelope
    /monarchenvelope/c5envelope/dlenvelope/folio/quarto
  }
]{{
  dup type /nametype eq { dup xcheck not { % Dat: fixed
    % dup ===
    dup ..paper.redef exch known {pop} {
      dup ..paper.redef exch null put
      dup userdict exch 2 copy known { 2 copy get
        1 index userdict exch undef
        % Stack: /a4 userdict /a4 {...}
        % 3 copy pop undef
        4 2 roll exch undef
      } { exch pop pop {} } ifelse
      % Stack: /a4 {595 842 //.setpagesize --exec--}
      % Stack: /a4 {595 842 {/statusdict --.systemvar-- --begin-- .setpagesize --end--} --exec--}
      { /get exec /pop (\nset-called-0==) ..print === flush } % dump
      dup length array copy cvx % make a copy for subsequent invocations
      2 copy exch 0 exch put exch pop % change /get to {...}
      2 copy exch 2 exch put % change /pop to /a4
      def % overwrite it in systemdict
    } ifelse
    true
  } if } if
  pop
}forall} forall
end % systemdict
.setglobal
systemdict readonly pop

(bbox-begin\n) ..print
MAINFILE cvx exec
(add-showpage==1\n) ..print
/DOCUT false def
showpage quit
';
      die unless close F;
      # vvv Imp: make it work on Win32 (no >&1 redirection)
      my $gs3=$CGS. # "-dPAGE1QUIT=".($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS' ? 'quit' : '{}').
        " -dWRITESYSTEMDICT -dNOPAUSE -sDEVICE=bbox -sFN=".fnq($InputFilename)." ".fnq($tfn)." 2>&1";
      debug "Ghostscript compute pipe: $gs3";
      my $res=`$gs3`;
      ## die $res;
      temp_unlink $tfn;
      ## print STDERR $res;
      error "not a GS output from $GS"
        if !defined $res # BUGFIX at Sun Mar  7 18:51:34 CET 2004
        or $res!~s/\A\w+ Ghostscript \d.*\n// # AFPL Ghostscript 6.50 (2000-12-02)
        or $res!~s/.*?^bbox-begin\n//m;
      if ($res!~s/\nbbox-success\n\Z(?!\n)/\n/) {
        warning # not `error', mpost(1) `prologues:=0; ... btex fonts' output won't compile 
          "BBox discovery was not successful";
        # !! continue only if MetaPost output?
        goto SKIP_BBOX_DISC;
      }
      #: Copyright (C) 2000 Aladdin Enterprises, Menlo Park, CA.  All rights reserved.
      #: This software comes with NO WARRANTY: see the file PUBLIC for details.
      #: set-called-0==/a4
      #: %%BoundingBox: 56 41 539 783
      #: %%HiResBoundingBox: 56.645998 41.849999 538.811984 782.351976
      #: pop-count==0
      #: end-count==1
      #: cut-offset==81898
      my $pop_count=0;
      my $end_count=0;
      my $cut_offset=-1;
      my $papersize_x=undef; # page_width
      my $papersize_y=undef; # page_height
      my $resolution_x=undef;
      my $resolution_y=undef;
      my $duplexi=0;
      my $tumblei=0;
      my %H;
      my $undefs="";
      my $bbc=0; # required
      for my $line (split/\n/, $res) {
        if ($line=~/^$BBregex$BBValues/oi) { $do_bb_line->($line," from Compute-GS"); $bbc++ }
        elsif ($line=~m@^set-called-(\d+)==/(\S+)$@) {
          if (not exists $H{$2}) {
            $H{$2}=1;
            $undefs.="/$2".(
              $1==0 ? "{}def\n" :
              $1==1 ? "/pop load def\n" :
                      "{".("pop "x$1)."}bind def\n"
            );
          }
          # Dat: Safe, restorable, EPS-wise: /setpagedevice {pop} def
          # Dat: Smart, documentwise /a4 dup where{dup wcheck{exch{}put}{pop{}def}ifelse}{pop}ifelse
        }
        elsif ($line=~/^pop-count==(\d+)$/) { $pop_count=$1+0 }
        elsif ($line=~/^end-count==(\d+)$/) { $end_count=$1+0 }
        elsif ($line=~/^cut-offset==(\d+)$/) { $cut_offset=$1+0 }
        elsif ($line=~/^papersize-x==([-+0-9eE.]+)$/) { no integer; $papersize_x=$1+0 }
        elsif ($line=~/^papersize-y==([-+0-9eE.]+)$/) { no integer; $papersize_y=$1+0 }
        elsif ($line=~/^resolution-x==([-+0-9eE.]+)$/) { no integer; $resolution_x=$1+0 }
        elsif ($line=~/^resolution-y==([-+0-9eE.]+)$/) { no integer; $resolution_y=$1+0 }
        elsif ($line=~/^sides-duplex==true$/) { $duplexi=1 }
        elsif ($line=~/^sides-dumplex==false$/) { $duplexi=2 }
        elsif ($line=~/^sides-tumble==true$/) { $tumblei=1 }
        elsif ($line=~/^sides-tumble==false$/) { $tumblei=2 }
        elsif (length($line)==0 or $line=~/^(?:Copyright |This software )/) {}
        elsif ($line=~/^Loading (\S+) font from.*[.][.][.]/) { debug "GS builtin font used: $1" }
        else { debug "unknown line ($line)" }
      }
      undef $papersize_y if !defined $papersize_x;
      die unless $allow_adsc_bb==1;
      # Dat: This only applies when converting fron non-EPS PS:
      #      Setting $allow_adsc_bb=0|1 now would disallow/allow the %%BoundingBox
      #      etc. ADSC comment override the bbox computed by -sDEVICE=bbox.
      #      When converting PS -> EPS, the PS file usually contains
      #      `%%BoundingBox: 0 0 paperwidth paperheight', but the figure
      #      itself is smaller.
      $bbtype='-';
      ## die "$papersize_x;;"; # PDF -sPAPERSIZE=a4
      #if ($::opt_papersize ne 'force-unknown' and $::opt_papersize ne 'unchanged') {
      #  # override bbox
      #  ($llx,$lly)=(0,0);
      #  ($urx,$ury)=split/,/,$::opt_papersize;
      #} elsif (!is_page1_stop() and defined $papersize_x and defined $papersize_y) {
      #}
      debug "PaperSize wd=${papersize_x}bp ht=${papersize_y}bp" if defined $papersize_x;
      if ($::opt_papersize eq 'force-unknown' or ($::opt_papersize eq 'unchanged' and !defined $papersize_x)) {}
      elsif ($::opt_papersize ne 'unchanged') {
        die if is_page1_stop();
        ($papersize_x,$papersize_y)=split/,/,$::opt_papersize;
        goto do_force_papersize
      } else {
        # Dat: no $do_bb_line here, because we've done it with $bbc++, and we'll also do it later
       do_force_papersize:
        die if is_page1_stop();
        # vvv ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y);
        # $do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize");
        $after_correct.="1 dict dup /PageSize [".ceil($papersize_x)." ".ceil($papersize_y)."] put setpagedevice\n";
        # ^^^ Dat: both PS and markedPS would benefit from /PaperSize
        # ^^^ Dat: will be put after CorrectBoundingBox
        # Dat: unneeded: $allow_adsc_bb=0 if $FileFormat eq 'PDF'; # force this into /CropBox (otherwise only /MediaBox)
      }
      if (defined $papersize_x and ($::opt_bboxfrom eq 'papersize' or ($::opt_bboxfrom eq 'guess' and is_set_pagesize_ok()))) {
        $allow_adsc_bb=0;
        $do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize"); # does ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y);
      }        
      $allow_adsc_bb=0 if ($::opt_bboxfrom eq 'compute-gs') ? ($bbc!=0)
                        : ($::opt_bboxfrom eq 'guess') ? ($bbc!=0 and is_page1_stop()) # Imp: is is_page1_stop() OK here?
                        : 0;
      if (!is_page1_stop()) {
        $pop_count=$end_count=0; # assume PS is correct
        $cut_offset=-1;
      }
      # if ($FileFormat ne 'EPS' and $FileFormat ne 'PS') { # device-specific (marked)
      # ^^^ Dat: $::opt_resolution and $::opt_duplex are already 'force-unknown' if $FileFormat is appropriate
      {
	$::opt_resolution=$resolution_x.','.$resolution_y if
	  $::opt_resolution eq 'unchanged' and defined $resolution_x and defined $resolution_y;

        # vvv Imp: move down like $::opt_resolution
	if ($::opt_duplex eq 'force-unknown' or ($::opt_duplex eq 'unchanged' and $duplexi==0)) { $do_fix_tumble=($duplexi==1 && $tumblei==1) }
        elsif ($::opt_duplex eq 'force-simplex') { do_simplex: $after_correct.="1 dict dup /Duplex false put setpagedevice\n" }
        elsif ($::opt_duplex eq 'force-long' ) { do_long: $after_correct.="2 dict dup /Duplex true put dup /Tumble false put setpagedevice\n" }
        elsif ($::opt_duplex eq 'force-short') { do_short: $do_fix_tumble=1; $after_correct.="2 dict dup /Duplex true put dup /Tumble true put setpagedevice\n" }
        else {
          $duplexi ||= $::opt_duplex eq 'default-simplex' ? 2 : 1;
          $tumblei ||= $::opt_duplex eq 'default-short'   ? 1 : 2;
          goto do_simplex if $duplexi!=1;
          goto do_long if $tumblei!=1;
          goto do_short;
        }
      }
      # vvv Dat: save...restore is _always_ necessary to undo the changes made
      #     in the file itself
      $is_restored=1; # $after_comments.="save\n"; 
      $after_comments.=$undefs; # after our precious setpagedevice calls
      # debug "pop_count=$pop_count;";
      # debug "end_count=$end_count;";
      # debug "cut_offset=$cut_offset;";
      $after_code.=("pop\n"x$pop_count).("end\n"x$end_count);
      if ($cut_offset>=0 and ($bytes_left==-1 or $cut_offset<$bytes_left)) {
        $bytes_left=$cut_offset-$already_read;
        ##print tell(IN)." ar=$already_read\n";
        debug "Cutting after showpage at $cut_offset -> $bytes_left";
        # ^^^ Dat: cutting after `showpage' makes PS -> EPS conversion easy
        # sleep 1000;
      }
      # Dat: don't unlink $tifn yet, we'll continue scanning it
      # Imp: verify EPS created
    } else { $headEPSF=" $1" }
   SKIP_BBOX_DISC:
    if ($::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'unchanged') {}
    else { $after_correct.="1 dict dup /HWResolution [@{[split/[x,]/,$::opt_resolution]}] put setpagedevice\n" }
    # ^^^ Dat: syntax already ok for $::opt_resolution
    $after_correct.="2 dict dup /TextAlphaBits 4 put dup /GraphicsAlphaBits 4 put setpagedevice\n" if
      $::opt_antialias eq 'yes' or $::opt_antialias eq 'scale3yes';

    $headEPSF="" if $FileFormat ne 'EPS' and $FileFormat ne 'markedEPS';
    $headPS=$1 if $header=~s/(PS-Adobe-[.\d]+)$//;
    $to_OUT.="%!$headPS$headEPSF\n";
  }

  debug "Scanning header for BoundingBox";
  my $do_atend=0;
  my $doing_atend=0;
  my $saved_pos;
  my $saved_bytes_left;
  my $creator_metapost_p=0; # HiResBoundingBox: after EndProlog
  my $creator_adobeps_p=0;
  my $had_pages=is_page1_stop(); # Dat: don't put `Pages:' to target EPS
  my $fontsdefs="";
  my %fontsnames;
  my @creator;
  read_again: while (length($_=readIN)) {
    ##print STDERR "(($_))\n";
    ### end of header
    next unless /\S/;
    y@\r@@d; chomp;
    if (!$doing_atend) {
      if (/^%%EndComments\b/i) {
        # Dat: EPSI created by ImageMagick has BeginDefaults+EndDefaults+BeginPreview
        # Dat: PS output by ADOBEPS4.DRV has BeginDefaults+PageBoundingBox+ViewingOrientation+PageFeatures+EndDefaults
        1 while length($_=readIN) and !/\S/;
        if (!/^%%BeginDefaults\b/i) { y@\r@@d; chomp; $after_comments.="$_\n"; last }
        1 while length($_=readIN) and !/\S/;
        if (!/^%%EndDefaults\b/i) { y@\r@@d; chomp; $after_comments.="%%BeginDefaults\n$_\n"; last }
        next
      } elsif (/^%%EndDefaults\b/i) { # EPSI created by ImageMagick
      } elsif (/^%%Creator:\s*ADOBEPS/i) { # ADOBEPS4.DRV
        # Emits ``%%BoundingBox 1 1 ...' instead of `0 0'
        $creator_adobeps_p=1;
      } elsif (/^%%Creator:\s*MetaPost\b/i) {
        $creator_metapost_p=1;
      } elsif ((substr($_,0,2)ne'%%' and substr($_,0,7)ne'%*Font:')
       and substr($_,0,5)ne'%EPS ' # epsincl.mp
       or !$creator_metapost_p and substr($_,0,5)eq'%%End'
       or /^%%Begin(?:Prolog|Setup)\b/i
         ) { $after_comments.="$_\n"; last }
    }
    if (/^%%BeginPreview\b/i) { # remove EPSI preview ballast ****pts****
      while (1) {
        error "Missing EPSI %%EndPreview" if !length($_=readIN);
        last if /^%%EndPreview\b/;
        y@\r@@d; chomp
      }
    } elsif (/^%%Creator:\s*(.*)/i) {
      push @creator, $1;
      $creator[-1]=~s@\s+\Z(?!\n)@@;
      $creator[-1]=~s@, a2ping .*@@; # remove old
    } elsif (/^%%(?:DocumentPaperSizes|PageOrder|DocumentMedia):/i) {
      # silently ignore these -- will be recalculated
    } elsif (/^%%Pages:\s+(\d+)\s*/i and !$had_pages) { # Not `%%Pages: (atend)'
      # Dat: don't `$do_atend=1' only for %%Pages
      $to_OUT.="$_\n"; $had_pages=1
    } elsif (/^%%Pages:/i) {
      # silently ignore these -- not significant for EPS
    } elsif (/^$BBregex$BBValues/oi) { ### BoundingBox with values
      s@($BBregex)\s*1\s+1\s+@$1 0 0 @ if $creator_adobeps_p;
      # vvv $bbtype may be possibly already set by compute-gs
      $do_bb_line->($_," from ADSC") if $allow_adsc_bb;
    } elsif (/^$BBregex\s*\(atend\)/oi) {
      ### BoundingBox with (atend)
      debug "At end $1BoundingBox";
      # warning "Cannot look for BoundingBox in the trailer with option --filter" if $::opt_filter;
      # ^^^ Dat: may be seekable anyway, omit warning
      $do_atend=1
    } elsif (/^%%Page:/i and !$creator_metapost_p) { # at Thu Sep 25 15:59:52 CEST 2003
      $after_comments.="$_\n"; last
    } elsif (/^%\*Font:\s+(\S+)\s+/) { # mpost(1) output
      ## debug $_;
      $fontsdefs.="$_\n"; # put in front (before `gsave ... translate')
      $fontsnames{$1}=1;
    } elsif (substr($_,0,5) eq '%EPS ') { # epsincl.mp
      $after_correct.="$_\n" if !$doing_atend; # before `gsave'
    } elsif ($doing_atend or /^%%End/) {
      # we might be in mid-line
    } else {
      $to_OUT.="$_\n"
    }
  }
  if ($doing_atend) { # already read (atend); restore file position
    seek(IN, $saved_pos, 0) or error "Input unseekable, cannot go back to line `: (atend)'";
    $bytes_left=$saved_bytes_left;
  } elsif ($do_atend) { # seek to near EOF and try again
    # error "Cannot leave line `: (atend)'" if ($saved_pos=tell IN)<0 or !seek(IN,0,1);
    fix_pipe_in "j.ps", $to_OUT, 0;
    die if ($saved_pos=tell IN)<0;
    $saved_bytes_left=$bytes_left;
    # vvv get the very last *BoundingBox entry from the last 4096 bytes
    if ($bytes_left>4096) {
      die unless seek(IN, $bytes_left-4096, 1);
      $bytes_left=4096;
    } elsif ($bytes_left<0) {
      die unless seek(IN, -4096, 2) or seek(IN, 0,0); # Dat: 0,0 for short files
    }
    $doing_atend=1; goto read_again;
  }
  # if (!$had_pages) { debug "Lying %%Pages: 1"; $to_OUT.="%%Pages: 1\n" }
  # ^^^ Dat: rather not lie !! go to (atend) if command line
  # vvv Dat: $bbtype ne'-' would be a bad idea
  warning "BoundingBox not found, try --bboxfrom=compute-gs" if !defined $llx; # !! compute-gs
  push @creator, "$program $Htex::a2ping::VERSION"; # if "@creator"!~/\ba2ping\b/;
  $to_OUT.="%%Creator: ".join(", ",@creator)."\n"; # before CorrectBoundingBox to be before `gsave' etc.
  $to_OUT.=CorrectBoundingBox $llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored;
  $to_OUT.=$after_comments;
  if (%fontsnames) { # !! save .. restore
    $to_OUT.="{@{[sort keys%fontsnames]}}{\ndup where{pop pop}{cvlit dup def}ifelse}forall\n";
    $to_OUT.="/fshow where{pop}{/fshow{exch findfont exch scalefont setfont show}bind def}ifelse\n";
  }
}

### open output file or pipe (do this as late as possible)
my $do_scale3_pnm=0;
my $scale3_pnm_fn;
my @pnm2sampled_cmd;
if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') {
  my $ofn=$ll_zero ? $OutputFilename : fix_pipe_out('.pdf');
  my $pipe = "$GS -q -dBATCH -sDEVICE=pdfwrite $GSOPTS -sOutputFile=".fnq($ofn)." -";
  debug "Ghostscript ps2pdf pipe:", $pipe;
  open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
} elsif ($FileFormat eq 'PCL5') {
  my $ofn=$do_fix_tumble ? fix_pipe_out('.pcl5') : $OutputFilename;
  # vvv ljet4 cannot do duplex, ljet4d can
  my $pipe = "$GS -q -dBATCH -sDEVICE=ljet4d $GSOPTS -sOutputFile=".fnq($ofn)." -";
  debug "Ghostscript ps2ljet pipe:", $pipe;
  open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
} elsif ($FileFormat eq 'PBM' or $FileFormat eq 'PGM' or $FileFormat eq 'PPM'
  or is_via_sam2p()) {
  $do_scale3_pnm=($::opt_antialias eq'scale3no' or $::opt_antialias eq 'scale3yes');
  my $device=$FileFormat eq 'PPM' || is_via_sam2p() ? 'ppmraw' :
    $FileFormat eq 'PBM' && $::opt_antialias eq 'no' ? 'pbmraw' : 'pgmraw';
  # Dat: -sDEVICE=pgm is ASCII, pgmraw is binary
  my $pipe ="$GS -q -dBATCH -sDEVICE=$device ";
  # $pipe.="-dTextAlphaBits=4 -dGraphicsAlphaBits=4 " if $::opt_antialias; # Dat: already done
  my $ofn=$OutputFilename;
  if (is_via_sam2p()) {
    # Dat: fortunately the following file format names are commin in sam2p(1)
    #      and a2ping.pl: PNG XWD BMP TIFF JPEG GIF XPM
    @pnm2sampled_cmd=('sam2p',"$FileFormat:",'--'); # Imp: use convert(1) if no sam2p(1)
    $ofn=fix_force_out('SS.pnm');
    push @pnm2sampled_cmd, $ofn, $OutputFilename;
  }
  if ($do_scale3_pnm) {
    $scale3_pnm_fn=$ofn;
    $ofn=fix_force_out('S3.pnm') if $do_scale3_pnm;
    # ^^^ Dat: this must be the last call to fix_force_out()
  }  
  $pipe.="$GSOPTS -sOutputFile=".fnq($ofn)." -";
  debug "Ghostscript ps2raster pipe:", $pipe;
  open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
} else { open_OUT() }

my $unlink_OutputFilename;
END { unlink $unlink_OutputFilename if defined $unlink_OutputFilename }
$unlink_OutputFilename=$OutputFilename;

die unless binmode OUT;
#die $to_OUT;
# !! remove setpagedevice from EPS->EPS, but keep EPS->PGM
# vvv needed by EPS->PGM conversion !!
if (is_need_showpage() and is_page1_stop()) {
  $to_OUT.="/showpage{showpage quit}bind def\n"; # don't call showpage twice
  $after_code.="showpage\n";
}  
error "write OUT" if !print OUT $to_OUT;
$to_OUT="";

### print rest of file
sub OVERLAP_LENGTH(){4096} # `%%TrailerLength: 1162' by ADOBEPS4.DRV
my $extra_trailer="%%Trailer\n";
##undef $unlink_OutputFilename; die;
{ my $overlap=""; # keeps OVERLAP_LENGTH chars
  my $S;
  # print OUT while length($_=readIN 4096);
  while (length($S=readIN 4096)) { # Dat: 4096>=OVERLAP_LENGTH
    #if (length($S)<OVERLAP_LENGTH) { $S="$overlap$S"; $overlap=""; }
    #die if length($S)<OVERLAP_LENGTH; # happens sometimes
    #print OUT $overlap, substr($S,0,length($S)-OVERLAP_LENGTH());
    #$overlap=substr($S,-OVERLAP_LENGTH(),OVERLAP_LENGTH);
    next if length($overlap.=$S)<OVERLAP_LENGTH;
    print OUT substr($overlap,0,length($overlap)-OVERLAP_LENGTH());
    $overlap=substr($overlap,-OVERLAP_LENGTH());
  }
  if ($overlap=~s@\r?\n%%Trailer\r?\n(.*?)\Z(?!\n)@\n%%Trailer\n@s) {
    my $S=$1;
    $S=~y@\r@@d;
    $S=~s@\n%%TrailerLength:.*$@@m; # ADOBEPS4.DRV
    $overlap.=$S;
    $extra_trailer="";
  }
  $overlap=~s@(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]*\Z(?!\n)@@;
  # vvv Dat: would move %%Trailer after dvips output `end userdict /end-hook known{end-hook}if'
  # $overlap=~s@(?:[\n\r\0\f]+%%Trailer)?(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]+\Z(?!\n)@@;
  print OUT $overlap;
}

### close files
error "closing IN: $?" unless close IN;
# ^^^ SUXX: gs always exit(0), if exists
# vvv Dat: $after_code is pop+end
print OUT "\n$extra_trailer$after_code",
  ("grestore\n"x$need_grestore),
  ("restore\n"x$is_restored),
  "%%EOF\n";
error "closing gs filter: $? $!" unless close OUT;

# --- PNM scaling routines for --antialias=scale3*

sub pnm_gettok($) {
  my ($fh,$S,$C)=($_[0],"");
  while (1) {
    die "unexpected EOF" if !defined($C=getc($fh));
    if ($C eq'#') { <$fh> } # ignore rest of line
    elsif ($C=~y@ \n\r\t@@) { last if length($S)!=0 }
    else { $S.=$C }
  }
  $S
}

my @div9=(0,0,0,0,0,map { $_, $_, $_, $_, $_, $_, $_, $_, $_ } 1..255, 255);

#** @param $_[0] length always divisible by 3
sub p5_avg_lines($$$$) {
  use integer;
  my $len=length($_[0]);
  my $olen=$len/3;
  while ($len>0) {
    vec($_[3],--$olen,8)=$div9[
      vec($_[0],$len-1,8)+vec($_[0],$len-2,8)+vec($_[0],$len-3,8)+
      vec($_[1],$len-1,8)+vec($_[1],$len-2,8)+vec($_[1],$len-3,8)+
      vec($_[2],$len-1,8)+vec($_[2],$len-2,8)+vec($_[2],$len-3,8)];
    $len-=3;
  }
}

#** @param $_[0] length always divisible by 9
sub p6_avg_lines($$$$) {
  # Imp: why is it lighter than: convert -scale '33.3333%' a3.pbm a3r.pgm
  use integer;
  my $len=length($_[0]);
  my $olen=$len/3;
  while ($len>0) {
    vec($_[3],--$olen,8)=$div9[
      vec($_[0],$len-1,8)+vec($_[0],$len-4,8)+vec($_[0],$len-7,8)+
      vec($_[1],$len-1,8)+vec($_[1],$len-4,8)+vec($_[1],$len-7,8)+
      vec($_[2],$len-1,8)+vec($_[2],$len-4,8)+vec($_[2],$len-7,8)];
    $len-=6 if 0==--$len%3;
  }
}

# ---

if (!$ll_zero and ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1')) { # correct /MediaBox if not (0,0)-based
  ### ****pts**** remove incorrect /MediaBox produced by gs
  my $tfn=temp_prefix()."p.tgs";
  error "temp open $tfn: $!" unless open F, "> $tfn";
  $tmpfiles{$tfn}=1;
  die unless print F "% this is temporary gs command file created by $program".'
  GS_PDF_ProcSet begin
  pdfdict begin
  FN (r) file pdfopen begin
  % vvv keep file offsets, because `pdffindpageref` overrides it with contents
  /OFT Objects 0 get dup length array copy def
  % vvv Dat: the generation number is assumed to be 0
  % vvv Dat: modifies Objects[0]
  1 pdffindpageref 0 get
  Objects 0 OFT put
  readxrefentry ===
  currentdict pdfclose end end end
  ';
  die unless close F;
  
  my $gs2="$GS -dNODISPLAY -dBATCH -sFN=".fnq(fix_pipe_out(undef))." -q ".fnq($tfn);
  debug "Ghostscript dup pipe: $gs2";
  my $offset=`$gs2`;
  chomp $offset;
  temp_unlink $tfn;
  if ($offset=~/\A\d+\Z(?!\n)/) {
    # Dat: now $offsets is a file position containing our /Page object
    die unless open F, "+< ".fix_pipe_out(undef);
    die unless binmode F;
    die unless seek F, $offset+=0, 0;
    my $pageobj;
    die unless 32<read F, $pageobj, 4096;
    if ($pageobj=~m@\A(.*?/Type\s*/Page\b.*?)(/MediaBox\s*\[0 0 [^\]]*\]).*?/MediaBox\b@s) {
      substr($pageobj, length($1), length($2))=" "x length($2);
      # ^^^ overwrite first buggy /MediaBox definition with spaces
      die unless seek F, $offset, 0;
      die unless print F $pageobj;
      debug "old /MediaBox destroyed.";
    } else {
      debug "warning: double /MediaBox not found at $offset";
    }
    die unless close F;
  } else {
    debug "warning: gs failed to locate double /MediaBox";
  }
}
if ($FileFormat eq 'PCL5' and $do_fix_tumble) {
  # stupid Ghostscript ignores /Tumble true with -sDEVICE=ljet4
  #  2 dict dup /Duplex true  /Tumble false put setpagedevice % long     HP PCL5e "\033&l1S"
  #  2 dict dup /Duplex true  /Tumble true  put setpagedevice % short    HP PCL5e "\033&l2S"
  #  2 dict dup /Duplex false /Tumble false put setpagedevice % simplex  HP PCL5e "\033&l0S"
  # HP PCL5e gs header "\033E\033&l2A\033&l1S\033&l0o0l0E\033&l-180u36Z"
  die unless open F, "+< ".fix_pipe_out(undef);
  die unless binmode F;
  my $pageobj;
  die unless 32<read F, $pageobj, 4096;
  if ($pageobj=~s@\033&l1S.*@\033&l2S@s) {
    die unless seek F, 0, 0;
    die unless print F $pageobj;
    debug "fixed /Tumble true (short).";
  } elsif ($pageobj=~m@\033&l0S@) {
    debug "no need to fix to /Tumble.";
  } else {
    debug "warning: /Duplex /Tumble settings not found"
  }
  die unless close F;
}
if ($do_scale3_pnm) {
  # Imp: scale down the file in place, ovoid early overwrite
  # Imp: possibly call an external C program that is faster
  debug "Scaling down PNM by 3x3";
  die unless open F, "> $scale3_pnm_fn";
  die unless binmode F;
  die unless open FIN, "< ".fix_pipe_out(undef);
  my $hd;
  die "PNMraw expected\n" if read(FIN,$hd,2)!=2 or $hd!~/\AP[456]/;
  my $wd=pnm_gettok(*FIN); die "width expected\n"  if $wd!~/\A(\d+)\Z(?!\n)/;
  my $wd3=$hd eq 'P4' ? ($wd+7)>>3 : $hd eq 'P5' ? $wd : $wd*3; # bw/grayscale/RGB
  my $ht=pnm_gettok(*FIN); die "height expected\n" if $ht!~/\A(\d+)\Z(?!\n)/;
  if ($hd ne 'P4') {
    my $mx=pnm_gettok(*FIN); die "max==255 expected, got: $mx\n" if $mx ne '255';
  }
  $wd+=0; $ht+=0;
  { use integer;
    my $phd=($hd eq 'P5' and $FileFormat eq 'PBM') ? "P4 ".(($wd+2)/3)." ".(($ht+2)/3)."\n"
      : ($hd eq 'P6' ? 'P6' : 'P5')."\n# reduced-3x3\n".
      (($wd+2)/3)." ".(($ht+2)/3)." 255\n";
    die if !print F $phd;
  }

  my($l1,$l2,$l3);
  my $ret="";
  if ($hd eq 'P4') {
    while ($ht>0) {
      die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
      if (--$ht==0) { $l2=$l1 }
      else {
	die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
	if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
	else { $ht--;
	  die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
	}
      }
      $l1=unpack("B$wd",$l1); $l1=~y@10@\000\377@;  $l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0;
      $l2=unpack("B$wd",$l2); $l2=~y@10@\000\377@;  $l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0;
      $l3=unpack("B$wd",$l3); $l3=~y@10@\000\377@;  $l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0;
      p5_avg_lines($l1, $l2, $l3, $ret);
      die if !print F $ret;
    }
  } elsif ($hd eq 'P5') {
    while ($ht>0) {
      die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
      $l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0;
      if (--$ht==0) { $l2=$l1 }
      else {
	die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
	$l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0;
	if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
	else { $ht--;
	  die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
	  $l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0;
	}
      }
      p5_avg_lines($l1, $l2, $l3, $ret);
      if ($FileFormat eq 'PBM') {
        my $I=length($ret);
	while ($I--) { vec($ret,$I,8)=vec($ret,$I,8)<$::opt_threshold } # [\0\1]
	# ^^^ grayscale>=$::opt_threshold will be white
        $ret=pack"B".length($ret),$ret;
      }
      die if !print F $ret;
    }
  } elsif ($hd eq 'P6') {
    while ($ht>0) {
      die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
      $l1.=substr($l1,-9+length($l1)%9) if length($l1)%9!=0;
      if (--$ht==0) { $l2=$l1 }
      else {
	die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
	$l2.=substr($l2,-9+length($l2)%9) if length($l2)%9!=0;
	if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
	else { $ht--;
	  die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
	  $l3.=substr($l3,-9+length($l3)%9) if length($l3)%9!=0;
	}
      }
      p6_avg_lines($l1, $l2, $l3, $ret);
      die if !print F $ret;
    }
  }
  die unless close F;
  temp_unlink $temp_out_fn;
  undef $temp_out_fn;
}
if (@pnm2sampled_cmd) { # $scale3_pnm_fn -> $OutputFilename
  do_system @pnm2sampled_cmd; # Dat: uses @extra -- really share that?
  temp_unlink $scale3_pnm_fn;
}
fix_close_out();
undef $unlink_OutputFilename;
if ($OutputFilename eq '-') {
  debug "Done OK, stdout is $FileFormat"
} elsif (-f $OutputFilename) {
  debug "Done OK, created $FileFormat file $OutputFilename (".(-s _)." bytes)";
} else {
  error "missing $OutputFilename"
}
just::end __END__

Dat: `=item * foo' is wrong, puts big space between `*' and `foo'

=begin man

.ds pts-dev \*[.T]
.do if '\*[.T]'ascii'  .ds pts-dev tty
.do if '\*[.T]'ascii8' .ds pts-dev tty
.do if '\*[.T]'latin1' .ds pts-dev tty
.do if '\*[.T]'nippon' .ds pts-dev tty
.do if '\*[.T]'utf8'   .ds pts-dev tty
.do if '\*[.T]'cp1047' .ds pts-dev tty
.do if '\*[pts-dev]'tty' \{\
.ll 79
.pl 33333v
.nr IN 2n
.\}
.ad n

=end

=head1 NAME

a2ping.pl -- convert between PS, EPS and PDF and other page description
formats

=head1 SYNOPSIS

Z<> B<a2ping.pl> [B<-->]B<help>
 B<a2ping.pl> [B<-->]B<doc>
 B<a2ping.pl> [I<options>] <I<inputfile>> [[I<outformat>:] I<outputfile>]

=head1 DESCRIPTION

B<a2ping> is a UNIX command line utility written in Perl that
converts many raster image and vector graphics formats to EPS or PDF and
other page description formats. Accepted input file formats are: PS
(PostScript), EPS, PDF, PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX,
TGA. Accepted output formats are: EPS, PCL5, PDF, PDF1, PBM, PGM, PPM,
PS, markedEPS, markedPS, PNG, XWD, BMP, TIFF, JPEG, GIF, XPM.
B<a2ping> delegates the low-level work to
Ghostscript (GS), B<pdftops> and B<sam2p>. B<a2ping> fixes many glitches
during the EPS to EPS conversion, so its output is often more compatible
and better embeddable than its input.

Without the C<--below> option, it is guarenteed to start at the 0,0
coordinate. C<--below>, C<--hires> and C<-v> are recommended options.

The page size is set exactly corresponding to the BoundingBox.
This means that when Ghostscript renders it, the result needs no
cropping, and the PDF MediaBox is correct.

If the bounding box is not right, of course, you have problems. If you
feed crap in, you get crap. But you can supply the
B<--bboxfrom=compute-gs> option to make GS recompute the bounding box.

The name of the input file doesn't matter -- B<a2ping> detects the file
format based on the first few bytes of the file. The name of the output
file matters if I<outformat> is missing from the command line: then the
extension of the output file determines the FileFormat (I<outformat>).

=head1 EXTERNAL PROGRAMS

The internal file format of B<a2ping.pl> is PS/EPS. Everything read is
first converted to PS or EPS, then processed by B<a2ping.pl>, then
converted to the output format.

To analyse the bounding box and other properties of non-EPS PS files
(and EPS files with option B<--bboxfrom> other than B<=guess>), GS is
used. Converting PS to EPS involves this analysis.

To write PDF files, GS is used.

To read PDF files, B<pdftops> from the B<xpdf> package is used.

Sampled input formats are PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX
and TGA. To read sampled input formats, B<sam2p> is used. B<sam2p> is
a raster image converter written in C++ by the author of B<a2ping.pl>.

Extra output formats are PNG, XWD, BMP, TIFF, JPEG, GIF and XPM. To
write extra output formats, B<sam2p> and GS are used.

PNM output formats are PGM, PGM and PPM. To write PNM output formats, GS
is used.


=head1 TIPS AND TRICKS

=over 2

=item *

Call with the B<-v> option to see progress and debug messages.

=item *

If your EPS contains a wrong bounding box, you can fix it by running
C<a2ping.pl -v --bboxfrom=compute-gs thefile.eps -->

=item *

You can specify B<-> as I<inputfile> to get stdin and as I<outputfile>
to get stdout. This works even for PDF files (which must be seekable),
because B<a2ping> copies them to a temporary file automatically.

=item *

If I<inputfile> and I<outputfile> are the same, B<a2ping> copies the
I<inputfile> to a temporary location first. However, this usage is
recommended only if there is a backup of the file to be restored in case
B<a2ping> doesn't produce the desired result.

=item *

If you specify B<--> as I<outputfile>, it will be the same as I<inputfile>.

=item *

B<a2ping> respects B<--Duplex> for FileFormat PCL5, even though GS doesn't.

=item *

If you have an incompatible PS that GS can read but your printer cannot print,
just run C<a2ping.pl foo.ps PDF: - | a2ping.pl - PS: foo.ps>

=item *

If you have a PS coming from Win32 (often with extension C<.prn>), run
it through B<a2ping>. It will remove the resolution changes and the
progress text printed to the terminal (which confuses gv(1) and makes
some filters in the print queue emit incorrect output).

=item *

B<a2ping> does antialiasing (B<--antialias=scale3no>) of glyphs and
curves when emitting a sampled image (FileFormats such as PGM and PPM).
This improves readability of the glyphs. B<=yes> instructs GS to do
internal antialiasing, but it usually doesn't improve much. B<=scale3no>
turns off GS internal antialiasing, but makes it render everything 3x3
as big, and then scales it back down. B<=scale3no> turns on both 3x3
scaling and GS internal antialiasing, which results in thicker lines and
worse quality in general.

=item *

When creating a PBM file, antialiasing usually doesn't improve the
quality, so it is switched off by default. But if you set
B<--antialias=scale3no> or B<--antialias=scale3yes>, GS will render a PGM file,
and the value of B<--threshold> determines the minimum intensity for white in
the final PBM.

=item *

If you need a bigger sampled output file, specify a larger
B<--Resolution>. The default is B<--Resolution=72>. If your sampled output file
is going to be really big, you should specify B<--AntiAlias=yes> instead of
the default B<--AntiAlias=scale3no> to speed up conversion.

=back


=head1 MISC

=over 2

=item *

Doesn't depend on the filename or extension of the input file.

=item *

Conversion from EPS to PDF: fixes glitches etc., calls gs
-sDEVICE=pdfwrite

=item *

Conversion from EPS to EPS: fixes various glitches, moves (llx,lly) to
(0,0), removes binary junk from the beginning of the EPS etc.

=item *

Conversion from PDF to PDF: keeps the file intact

=item *

Conversion from PDF to EPS: calls pdftops -eps (of the xpdf package)

=item *

Conversion from PS to EPS: keeps 1st page only, removes setpagedevice etc.

=back

=head1 AUTHORS

The author of B<a2ping> is Szabó Péter <F<pts@fazekas.hu>>.

B<a2ping> is inspired by and historically based on the B<epstopdf> Perl
script modified by Thomas Esser, Sept. 1998, but his modifications have
been removed from B<a2ping>, and also B<a2ping> and B<epstopdf> do not
share common code anymore.  B<epstopdf> is written by Sebastian Rahtz,
for Elsevier Science. B<epstopdf> contained extra tricks from Hans Hagen's
texutil.

=head1 HISTORY

=head2 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;';

=head2 2000/11/05 v2.6 (Heiko Oberdiek)

 * %%HiresBoundingBox corrected to %%HiResBoundingBox

=head2 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.

=head2 2003/02/02 (Szabó Péter)

 * option --below
 * removes DOS EPSF binary junk correctly
 * adds all 3 BoundingBox DSC comments
 * reads all 3 BoundingBox DSC comments, and picks the best
 * forces BoundingBox to be an integer
 * adds %%EndComments and proper %!PS-Adobe-?-? EPSF-?.? header
 * adds %%Pages:
 * adds invocation syntax: a2ping <infile.eps> <outfile.eps|pdf>
 * can convert PDF to EPS (by calling pdftops(1)) and PDF to PDF
 * emulates work for PDF input

=head2 2003/04/16 (Szabó Péter)

 * added PS and sam2p support, renamed to a2ping
 * sam2p and pdftops if $InputFilename eq '-';
 * remove PJL UEL header from the beginning
 * works for PS non-EPS files for input
 * input support for PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA via sam2p
 * removes ^L (form feed) from end of EPS file
 * -x=-c:rle to add sam2p options

=head2 2003/04/26 (Szabó Péter)

 * omit the unnecessary setpagedevice calls when creating normal eps
 * --noverbose --nocompress supported differently
 * no more option defaults :-(
 * justlib2
 * multi-page output with PS:, PDF:, PCL5:
 * after `a2ping -pa4', file out.pcl says: `HP PCL printer data - A4 page
   size', instead of `US letter'
 * justlib2-ified doesn't depend on Getopt::Long anymore
 * fully supports filtering (stdin and/or stdout), PDF and PCL5 output to
   pipe (!$$ll_zero)
 * adds DSC ``%%DocumentMedia: plain 612 792 0 () ()''
 * BoundingBox precedence for EPS input: --PageSize, %%*BoundingBox,
   setpagedevice. Precedence for other inputs: --PageSize, setpagedevice,
   %%*BoundingBox

=head2 2003/09/25 (Szabó Péter)

 * --bboxfrom=adsc: %%BoundingBox overrides -sDEVICE=bbox
 * improved bbox discovery
 * many bugfixes
 * MetaPost EPS input fixes for prologues:=0;
 * a2ping.pl -v --papersize=50,60 --bboxfrom=compute-gs t.ps t2.ps
 * consistent bbox, --PageSize, /PageSize handling
 * consistent --Resolution and --Duplex handling

=head2 2003/12/02 (Szabó Péter)

 * --bboxfrom=compute-gs option to fix PS -> EPS bbox (gs -sDEVICE=bbox), tuzv.eps

=head2 2004/02/10 v2.77 (Szabó Péter)

 * the compute-pipe routine is now run unless --bboxfrom=guess with EPS
 * added --gsextra=
 * added --antialias=
 * added FileFormat PBM, PGM, PPM
 * separated FileFormat features to FL_* constants
 * added --doc
 * there is no default FileFormat (PDF) anymore