diff options
Diffstat (limited to 'Master/bin/alpha-linux/a2ping')
| -rwxr-xr-x | Master/bin/alpha-linux/a2ping | 2399 |
1 files changed, 2399 insertions, 0 deletions
diff --git a/Master/bin/alpha-linux/a2ping b/Master/bin/alpha-linux/a2ping new file mode 100755 index 00000000000..82d202b022e --- /dev/null +++ b/Master/bin/alpha-linux/a2ping @@ -0,0 +1,2399 @@ +#! /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 |