diff options
| author | Karl Berry <karl@freefriends.org> | 2008-03-03 19:18:05 +0000 |
|---|---|---|
| committer | Karl Berry <karl@freefriends.org> | 2008-03-03 19:18:05 +0000 |
| commit | 7bbf709741ef5b977ec1bcd88c8e368a6939663f (patch) | |
| tree | 75e1c210eee5d394cf8763ef90d551a11db64f4c /Build | |
| parent | 20f85acea2ef177600a91ca346aa58165364a515 (diff) | |
update a2ping into scripts, symlink in bins
git-svn-id: svn://tug.org/texlive/trunk@6834 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build')
| -rw-r--r-- | Build/source/texk/tetex/Makefile.in | 13 | ||||
| -rwxr-xr-x | Build/source/texk/tetex/a2ping | 2399 |
2 files changed, 2 insertions, 2410 deletions
diff --git a/Build/source/texk/tetex/Makefile.in b/Build/source/texk/tetex/Makefile.in index 0e157776789..dd05256ad4e 100644 --- a/Build/source/texk/tetex/Makefile.in +++ b/Build/source/texk/tetex/Makefile.in @@ -14,9 +14,7 @@ SCRIPTS = \ texconfig texconfig-dialog texconfig-sys texdoc texdoctk \ texlinks thumbpdf updmap updmap-sys -LINKEDPERLSCRIPTS = e2pall epstopdf pdfcrop pkfix ps2eps - -PDFSCRIPTS = a2ping +LINKEDPERLSCRIPTS = a2ping e2pall epstopdf pdfcrop pkfix ps2eps CONTEXTSCRIPTS = \ ctxtools exatools luatools makempy mpstools mptopdf mtxtools \ @@ -33,7 +31,7 @@ manpgs = \ ovf2ovp ovp2ovf ps2frag pslatex rubibtex rumakeindex texconfig texdoc \ texdoctk thumbpdf ttf2afm updmap -all: $(SCRIPTS) $(PDFSCRIPTS) +all: $(SCRIPTS) default: all install: install-data install-exec @@ -93,13 +91,6 @@ install-exec: install-linkedscripts for s in $(CONTEXTSCRIPTS); do \ $(INSTALL_SCRIPT) $(srcdir)/context/$$s $(scriptdir)/$$s; \ done - if test -f $(bindir)/pdftex; then \ - for s in $(PDFSCRIPTS); do \ - $(INSTALL_SCRIPT) $(srcdir)/$$s $(scriptdir)/$$s; \ - done; \ - else \ - true; \ - fi cd $(scriptdir) && rm -f allec kpsepath kpsexpand texhash; \ ln -s allcm allec; \ ln -s kpsetool kpsepath; \ diff --git a/Build/source/texk/tetex/a2ping b/Build/source/texk/tetex/a2ping deleted file mode 100755 index 82d202b022e..00000000000 --- a/Build/source/texk/tetex/a2ping +++ /dev/null @@ -1,2399 +0,0 @@ -#! /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 |