1#! /bin/sh 2eval '(exit $?0)' && eval 'PERL_BADLANG=x;export PERL_BADLANG;: \ 3;exec perl -x -S -- "$0" ${1+"$@"};#'if 0; 4eval 'setenv PERL_BADLANG x;exec perl -x -S -- "$0" $argv:q;#'.q+ 5#!perl -w 6package Htex::a2ping; $0=~/(.*)/s;unshift@INC,'.';do($1);die$@if$@;__END__+if !1; 7# This Perl script was generated by JustLib2 at Wed Apr 23 09:14:13 2003. 8# Don't touch/remove any lines above; http://www.inf.bme.hu/~pts/justlib 9# 10# This program is free software, licensed under the GNU GPL, >=2.0. 11# This software comes with absolutely NO WARRANTY. Use at your own risk! 12# 13# !! Imp: merge back to a2ping.pa 14# !! Ghostcript compute pipe too slow 15# $ a2ping.pl -v debrecen-hyph.ps de brecen-hyph.pdf 16# a2ping.pl 2.77p, 2004-04-28 -- Written by <pts@fazekas.hu> from April 2003. 17# This is free software, GNU GPL >=2.0. There is NO WARRANTY. 18# (epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.) 19# * Strongest BoundingBox comment: %%HiResBoundingBox: 20# * Doing --PaperSize unchanged 21# * Output filename: debrecen-hyph.pdf 22# * Output FileFormat: PDF 23# * Ghostscript ps2pdf command: gs -dSAFER 24# * Compression: zip 25# * Input filename: debrecen-hyph.ps 26# * Computing BBox info from non-EPS PS file 27# * Ghostscript compute pipe: gs -dSAFER -dWRITESYSTEMDICT -dNOPAUSE -sDEVICE=bbox -sFN=debrecen-hyph.ps /tmp/a2ping_pl-16977-298938572-c.tgs 2>&1 28# * Applying BoundingBox from Compute-GS T-: 71 81 539 769 29# * Applying HiResBoundingBox from Compute-GS T-H: 71.837998 81.971997 538.235984 768.113977 30# * Scanning header for BoundingBox 31# * Applying BoundingBox from ADSC T-: 0 0 596 842 32# * Final BoundingBox: 0 0 596 842 33# * Ghostscript ps2pdf pipe: gs -dSAFER -q -dBATCH -sDEVICE=pdfwrite -sOutputFile =debrecen-hyph.pdf - 34# * Done OK, created PDF file debrecen-hyph.pdf (338451 bytes) 35# 36package just; BEGIN{$INC{'just.pm'}='just.pm'} 37BEGIN{ $just::VERSION=2 } 38sub end(){1} 39sub main(){} 40 41BEGIN{$ INC{'strict.pm'}='strict.pm'} { 42package strict; 43use just; 44# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001 45require 5.002; 46sub bits { 47 (grep{'refs'eq$_}@_ && 2)| 48 (grep{'subs'eq$_}@_ && 0x200)| 49 (grep{'vars'eq$_}@_ && 0x400)| 50 ($@ || 0x602) 51} 52sub import { shift; $^H |= bits @_ } 53sub unimport { shift; $^H &= ~ bits @_ } 54just::end} 55 56BEGIN{$ INC{'integer.pm'}='integer.pm'} { 57package integer; 58use just; 59# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001 60sub import { $^H |= 1 } 61sub unimport { $^H &= ~1 } 62just::end} 63 64BEGIN{$ INC{'Pts/string.pm'}='Pts/string.pm'} { 65package Pts::string; 66# by pts@fazekas.hu at Sat Dec 21 21:32:18 CET 2002 67use just; 68use integer; 69use strict; 70 71#** @param $_[0] a string 72#** @param $_[1] index of first bit to return. Bit 128 of byte 0 is index 0. 73#** @param $_[2] number of bits to return (<=32) 74#** @return an integer (negative on overflow), bit at $_[1] is its MSB 75sub get_bits_msb($$$) { 76 # assume: use integer; 77 my $loop=$_[1]; 78 my $count=$_[2]; 79 my $ret=0; 80 ($ret+=$ret+(1&(vec($_[0],$loop>>3,8)>>(7-($loop&7)))), $loop++) while $count--!=0; 81 $ret 82} 83 84#** @param $_[0] a string 85#** @return value if $_[0] represents a floating point numeric constant 86#** in the C language (without the LU etc. modifiers) -- or undef. Returns 87#** undef for integer constants 88sub c_floatval($) { 89 my $S=$_[0]; 90 no integer; # very important; has local scope 91 return 0.0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+|[0-9]+\.])(?:[eE][+-]?[0-9]+)?\Z(?!\n)/; 92 undef 93} 94 95#** @param $_[0] a string 96#** @return value if $_[0] represents a floating point or integer numeric 97#** constant in the C language (without the LU etc. modifiers) -- or undef 98sub c_numval($) { 99 my $S=$_[0]; 100 no integer; # very important; has local scope 101 return 0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+(?:[eE][+-]?[0-9]+)?|[0-9]+\.?)\Z(?!\n)/; 102 undef 103} 104 105#** @param $_[0] a string 106#** @return the integer value of $_[0] in C -- or undef 107sub c_intval($) { 108 my $S=$_[0]; 109 my $neg=1; 110 $neg=-1 if $S=~s@\A([+-])@@ and '-'eq$1; 111 return $neg*hex $1 if $S=~/\A0[xX]([0-9a-fA-F]+)\Z(?!\n)/; 112 return $neg*oct $1 if $S=~/\A0([0-7]+)\Z(?!\n)/; 113 return $neg*$1 if $S=~/\A([0-9]+)\Z(?!\n)/; 114 undef 115} 116 117sub import { 118 no strict 'refs'; 119 my $package = (caller())[0]; 120 shift; # my package 121 for my $p (@_ ? @_ : qw{get_bits_msb c_floatval c_numval c_intval}) { *{$package."::$p"}=\&{$p} } 122} 123 124just::end} 125 126BEGIN{$ INC{'Htex/dimen.pm'}='Htex/dimen.pm'} { 127package Htex::dimen; 128# by pts@fazekas.hu at Sat Dec 21 21:26:15 CET 2002 129use just; 130use integer; 131use strict; 132use Pts::string qw(c_numval); 133 134my %bp_mul; 135{ no integer; %bp_mul=( 136 'bp'=>1, # 1 bp = 1 bp (big point) 137 'in'=>72, # 1 in = 72 bp (inch) 138 'pt'=>72/72.27, # 1 pt = 72/72.27 bp (point) 139 'pc'=>12*72/72.27, # 1 pc = 12*72/72.27 bp (pica) 140 'dd'=>1238/1157*72/72.27, # 1 dd = 1238/1157*72/72.27 bp (didot point) [about 1.06601110141206 bp] 141 'cc'=>12*1238/1157*72/72.27, # 1 cc = 12*1238/1157*72/72.27 bp (cicero) 142 'sp'=>72/72.27/65536, # 1 sp = 72/72.27/65536 bp (scaled point) 143 'cm'=>72/2.54, # 1 cm = 72/2.54 bp (centimeter) 144 'mm'=>7.2/2.54, # 1 mm = 7.2/2.54 bp (millimeter) 145) } 146 147#** @param $_[0] a (real or integer) number, optionally postfixed by a 148#** TeX dimension specifier (default=bp) 149#** @return the number in bp, or undef 150sub dimen2bp($) { 151 no integer; 152 my $S=$_[0]; 153 my $mul; 154 $mul=$bp_mul{$1} if $S=~s/\s*([a-z][a-z0-9]+)\Z(?!\n)// and exists $bp_mul{$1}; 155 my $val=c_numval($S); 156 $val*=$mul if defined $val and defined $mul; 157 $val 158} 159 160just::end} 161 162BEGIN{$ INC{'Htex/papers.pm'}='Htex/papers.pm'} { 163package Htex::papers; 164# contains paper size information 165# by pts@fazekas.hu at Sun Dec 22 00:30:58 CET 2002 166use just; 167use integer; 168use strict; 169use Htex::dimen; 170 171my @papers=( 172# 173# paper.txt 174# by pts@fazekas.hu at Tue Jan 16 18:21:59 CET 2001 175# by pts@fazekas.hu at Tue Jan 16 19:13:16 CET 2001 176# 177# Examined: dvips, gs, libpaperg 178# 179# all units are measured in Big Points (bp) 180# 72 bp == 1 in 181# 2.54 cm == 1 in 182# 183# papername width height 184qw{Comm10 297 684}, 185qw{Monarch 279 540}, 186qw{halfexecutive 378 522}, 187 188qw{Legal 612 1008}, 189qw{Statement 396 612}, 190qw{Tabloid 792 1224}, 191qw{Ledger 1224 792}, 192qw{Folio 612 936}, 193qw{Quarto 610 780}, 194qw{7x9 504 648}, 195qw{9x11 648 792}, 196qw{9x12 648 864}, 197qw{10x13 720 936}, 198qw{10x14 720 1008}, 199qw{Executive 540 720}, 200 201qw{ISOB0 2835 4008}, 202qw{ISOB1 2004 2835}, 203qw{ISOB2 1417 2004}, 204qw{ISOB3 1001 1417}, 205qw{ISOB4 709 1001}, 206qw{ISOB5 499 709}, 207qw{ISOB6 354 499}, 208qw{ISOB7 249 354}, 209qw{ISOB8 176 249}, 210qw{ISOB9 125 176}, 211qw{ISOB10 88 125}, 212qw{jisb0 2916 4128}, 213qw{jisb1 2064 2916}, 214qw{jisb2 1458 2064}, 215qw{jisb3 1032 1458}, 216qw{jisb4 729 1032}, 217qw{jisb5 516 729}, 218qw{jisb6 363 516}, 219 220qw{C7 230 323}, 221qw{DL 312 624}, 222 223qw{a3 842 1190}, # defined by Adobe 224qw{a4 595 842}, # defined by Adobe; must precede a4small 225 226# a4small should be a4 with an ImagingBBox of [25 25 570 817].}, 227qw{a4small 595 842}, 228qw{letter 612 792}, # must precede lettersmall 229# lettersmall should be letter with an ImagingBBox of [25 25 587 767]. 230qw{lettersmall 612 792}, 231# note should be letter (or some other size) with the ImagingBBox 232# shrunk by 25 units on all 4 sides. 233qw{note 612 792}, 234qw{letterLand 792 612}, 235# End of Adobe-defined page sizes 236 237qw{a0 2380 3368}, 238qw{a1 1684 2380}, 239qw{a2 1190 1684}, 240qw{a5 421 595}, 241qw{a6 297 421}, 242qw{a7 210 297}, 243qw{a8 148 210}, 244qw{a9 105 148}, 245qw{a10 74 105}, 246qw{b0 2836 4008}, 247qw{b1 2004 2836}, 248qw{b2 1418 2004}, 249qw{b3 1002 1418}, 250qw{b4 709 1002}, 251qw{b5 501 709}, # defined by Adobe 252 253qw{a0Land 3368 2380}, 254qw{a1Land 2380 1684}, 255qw{a2Land 1684 1190}, 256qw{a3Land 1190 842}, 257qw{a4Land 842 595}, 258qw{a5Land 595 421}, 259qw{a6Land 421 297}, 260qw{a7Land 297 210}, 261qw{a8Land 210 148}, 262qw{a9Land 148 105}, 263qw{a10Land 105 74}, 264qw{b0Land 4008 2836}, 265qw{b1Land 2836 2004}, 266qw{b2Land 2004 1418}, 267qw{b3Land 1418 1002}, 268qw{b4Land 1002 709}, 269qw{b5Land 709 501}, 270 271qw{c0 2600 3677}, 272qw{c1 1837 2600}, 273qw{c2 1298 1837}, 274qw{c3 918 1298}, 275qw{c4 649 918}, 276qw{c5 459 649}, 277qw{c6 323 459}, 278 279# vvv U.S. CAD standard paper sizes 280qw{archE 2592 3456}, 281qw{archD 1728 2592}, 282qw{archC 1296 1728}, 283qw{archB 864 1296}, 284qw{archA 648 864}, 285 286qw{flsa 612 936}, # U.S. foolscap 287qw{flse 612 936}, # European foolscap 288qw{halfletter 396 612}, 289qw{csheet 1224 1584}, # ANSI C 17x22 290qw{dsheet 1584 2448}, # ANSI D 22x34 291qw{esheet 2448 3168}, # ANSI E 34x44 292qw{17x22 1224 1584}, # ANSI C 17x22 293qw{22x34 1584 2448}, # ANSI D 22x34 294qw{34x44 2448 3168}, # ANSI E 34x44 295); 296 297#** Converts a numeric paper size to a well-defined paper name. Tolerance is 298#** 8.5bp 299#** @param $_[0] width, in bp 300#** @param $_[1] height, in bp 301#** @return () or ("papername", ret.paper.width.bp, ret.paper.height.bp) 302sub valid_bp($$;$$) { 303 no integer; 304 my ($W1,$H1)=(defined$_[2]?$_[2]:0,defined$_[3]?$_[3]:0); 305 my ($WW,$HH)=(Htex::dimen::dimen2bp($_[0])-$W1, Htex::dimen::dimen2bp($_[1])-$H1); 306 # Dat: 1mm == 720/254bp; 3mm =~ 8.5bp 307 no integer; 308 for (my $I=0; $I<@papers; $I+=3) { 309 return @papers[$I,$I+1,$I+2] if abs($papers[$I+1]-$WW)<=8.5 and abs($papers[$I+2]-$HH)<=8.5; 310 } 311 () 312} 313 314#** @param $_[0] (width width_unit "," height height_unit) 315#** @return () or ("papername", width.bp, height.bp) 316sub valid($) { # valid_papersize 317 my $S=lc$_[0]; 318 $S=~/^\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*,\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*\Z(?!\n)/ ? 319 valid_bp("$1$3","$4$6") : (); 320} 321 322#** @param $_[0] (width width_unit? ("," || "x") height height_unit?) || (papername) 323#** @return () or ("papername"?, width.bp, height.bp) 324sub any($) { 325 my $S=lc$_[0]; 326 if ($S=~/\A[a-z]\w+\Z(?!\n)/) { 327 for (my $I=0; $I<@papers; $I+=3) { 328 return @papers[$I,$I+1,$I+2] if lc($papers[$I]) eq $S; 329 } 330 } 331 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)/; 332 # ^^^ Dat: [xX] is xdvi-style, [,] is dvips-style spec 333 my($w,$h)=($1.$3, $4.$6); 334 my @L=valid_bp($w,$h); 335 @L ? @L : (undef,Htex::dimen::dimen2bp($w),Htex::dimen::dimen2bp($h)) 336} 337 338just::end} 339 340BEGIN{$ INC{'Htex/a2ping.pm'}='Htex/a2ping.pm'} 341 342package Htex::a2ping; 343# a2ping.pl -- convert between PS, EPS and PDF and other page description formats 344# by pts@fazekas.hu et al. at Wed Apr 16 14:54:13 CEST 2003 345# a2ping.pa created at Sun Apr 20 22:25:47 2003 346# 347# This file contains perldoc(1) documentation. Search for `=head1'. 348# See revision history at end of this file. 349# 350 351use just +1; # a JustLib application 352use strict; 353use integer; 354use Htex::papers; 355BEGIN { $Htex::a2ping::VERSION="2.77p" } 356 357# Imp: option to ignore `%%Orientation: Portrait', which gs respects and rotates by 90 degrees if necessary 358# Imp: gs(704?!) sometimes finds too small bbox, see Univers.eps 359# Imp: respect bbox in METAPOST %! (not EPS), don't use Compute-GS T- 360# Imp: -sPDFPassword=... 361# Imp: `a2ping.pl -v jf.eps pdf1: t.pdf' PDF1: must be forced to have --below 362# Imp: option to `clip' an EPS to the specified bbox -- does file size decrease? 363# Imp: fix bug a2ping -v ~/a2ping_bug.ps a2ping_bug.pdf; running type1fix on 364# all fonts with dff.pl has fixed the problem 365# Imp: post-process PNG etc. written by sam2p 366# Imp: better help and docs 367# Imp: respect full /MediaBox for a PDF -> EPS|PDF1 conversion 368# Imp: --ll x,y command line option 369# Imp: Htex/a2ping.pa -v ../image/tuzv.ps t.pdf (1st and second page different) 370# Imp: also save+restore /pdfmark ?? 371# Imp: fix /MediaBox an all PDF pages if !$ll_zero 372# Imp: PDF -> PDF1 conversion with gs -sDEVICE=pdfwrite 373# Imp: direct PDF to PCL5 conversion with gs 374# Imp: remove %%BeginDefaults | %%PageMedia: plain | %%EndDefaults (pdftops(1)) 375# Imp: fix completely bogus margin and papersize handling: 376# ../justlib2/Htex/a2ping.pa --duplex=force-short -v -p:a3 -r force-unknown tuzv.ps t.pdf 377# Imp: careful distinction between PDF and PDF1 378# Imp: psnup support (-1 -2 -3 -4 ...) 379# Imp: idempotent PS -> PS, add other header 380# Imp: use convert(1) etc. 381# Imp: possibly disable compute-pipe 382# Imp: $header_remove_p ?? 383# Imp: --leftright option instead of --below 384# Imp: pdfboxes.pl, get offset from gs 385# Imp: detect error messages from GS, abort... 386# Imp: use all pdftops + gs + acroread 387# Imp: possibly accept /PageSize from %%DocumentMedia 388# Imp: /DocumentMedia seems to screw up sub-pt placement in gv(1) 389# 390# Dat: example: a2ping.pl --extra=-c:ijg:50 -r86 nn1.eps nn1.jpg 391# Dat: calling ``showpage'' is not required for -sDEVICE=pdfwrite with gs 6.50, 392# but -sDEVICE=pgmraw depends on it 393# Dat: the functionality of pdfboxes.pl cannot be provided here with a shorter 394# implementation, because gs always outputs the content stream of the PDF 395# objects first 396# Dat: pdftops -eps writes negative bbox correctly 397# Dat: markedEPS: include pdfmarks 398# Dat: gs 7.04 gdevdjet.[ch], gdevdljm.[ch] 399# Dat: to be undeffed in setpagedevice: /.MarginsHWResolution /PageSize 400# /ImagingBBox /HWResolution /HWSize /.MediaSize (we undef all) 401 402### program identification 403my $program = "a2ping.pl"; 404my $filedate="2006-11-15"; # my $filedate="2001/03/05"; 405my $copyright = "Written by <pts\@fazekas.hu> from April 2003. 406This is free software, GNU GPL >=2.0. There is NO WARRANTY. 407(epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.)\n"; 408# "Contains modifications by pts\@fazekas.hu"; 409my $title = "$program $Htex::a2ping::VERSION, $filedate -- $copyright\n"; 410 411### ghostscript command name 412my($quote,$GS)=("'","gs"); 413($quote,$GS) = ("\"","gswin32c") if $^O eq 'MSWin32' or $^O =~ /cygwin/i; 414 415# --- help functions 416 417sub fnq($) { 418 my $fn=$_[0]; 419 return $fn if $fn!~y@-a-zA-Z0-9/.+_@@c; 420 $fn=~s@'@\\'@g if $quote eq "'"; 421 $quote.$fn.$quote 422} 423 424sub debug { 425 print STDERR "* @_\n" if $::opt_verbose; 426} 427sub warning { 428 print STDERR "$0: warning: @_\n"; 429} 430sub error { 431 my $s=$title; $title=""; 432 die "$s$0: @_\n"; 433} 434 435# unlink temporary files? 436my $tmpunlink_p=1; 437my $tmpsig=1; 438my %tmpfiles; 439my $tmpdir=exists $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp'; 440$tmpdir="." if (!-d $tmpdir or !-w $tmpdir) and -w '.'; 441sub cleanup() { 442 unlink keys %tmpfiles; 443 exit 125; 444} 445END { unlink keys %tmpfiles; } 446sub temp_unlink($) { 447 if (defined $_[0] and exists $tmpfiles{$_[0]}) { 448 unlink $_[0] if $tmpunlink_p; 449 delete $tmpfiles{$_[0]}; 450 } 451} 452sub temp_prefix() { 453 my $prog0=$program; 454 $prog0=~y@a-zA-Z0-9@_@c; 455 if ($tmpsig) { 456 $tmpsig=0; 457 $SIG{INT}=$SIG{TERM}=$SIG{HUP}=$SIG{QUIT}=\&cleanup; 458 } 459 return "$tmpdir/$prog0-$$-".int(rand(1<<30))."-"; # 30: nonnegative 460} 461 462#** @return arg rounded down to int 463sub myfloor($) { 464 # Dat: Perl int() rounds towards zero 465 no integer; 466 $_[0]==int($_[0]) ? $_[0] : $_[0] < 0 ? -int(1-$_[0]) : int($_[0]) 467} 468 469#** @return arg rounded up to int 470sub myceil($) { 471 no integer; #### BUGFIX at Wed Nov 15 17:23:29 CET 2006 472 $_[0]==int($_[0]) ? $_[0] : 1+ ($_[0] < 0 ? -int(-$_[0]) : int($_[0])); 473} 474 475just::main; 476 477# --- 478 479sub FL_PAGE1_STOP(){1} # is file format single-page? 480sub FL_SET_PAGESIZE_OK(){2} 481sub FL_PDFMARK(){4} 482sub FL_NEED_SHOWPAGE(){8} # does gs -sDEVICE=... need showpage? 483sub FL_SAMPLED(){16} # is it a sampled (raster, pixel-based) 484sub FL_ANY_ORIGIN_OK(){32} # (llx,lly) may be anything, not just (0,0) 485sub FL_HAS_ANTIALIAS(){64} 486sub FL_VIA_SAM2P(){128} # sam2p(1) should convert PNM to such a format 487sub FL_OK_SAM2P(){256} # sam2p(1) can convert PNM to such a format 488 489my %fmts=( # Name=>[flags] 490 'EPS'=>[FL_PAGE1_STOP], 491 'markedEPS'=>[FL_PAGE1_STOP|FL_PDFMARK], # Imp: should we have FL_SET_PAGESIZE_OK? 492 'PDF1'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_PDFMARK], 493 'PDF'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK], 494 'PS'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK], 495 'markedPS'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK], 496 'PCL5'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK], 497 # ^^^ Dat: no FL_HAS_ANTIALIAS -- would need lj5gray, which is loonger 498 # ^^^ Dat: no FL_SAMPLED, because cannot set resolution 499 'PBM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_OK_SAM2P], # Dat FL_HAS_ANTIALIAS produces obscure image 500 'PGM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P], 501 'PPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P], 502 # Now come the FileFormats supported via sam2p 503 'PNG'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], 504 'XWD'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], 505 'BMP'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], 506 'TIFF'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], 507 'JPEG'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], 508 '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? 509 '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? 510); 511my %fmt_aliases=qw(MARKEDPS markedPS MARKEDEPS markedEPS PCL PCL5 512 UNMARKEDPS PS UNMARKEDEPS EPS EPDF PDF1 MEPS markedEPS); 513# Dat: .ps will be unmarked PS 514# Imp: sometimes markedEPS for .eps? 515my %fmt_exts=qw(eps EPS epsi EPS epsf EPS eps2 EPS ps PS ps2 PS 516 pcl PCL5 pcl5 PCL5 pbm PBM pgm PGM pnm PPM ppm PPM pdf PDF png PNG 517 xwd XWD bmp BMP rle BMP tif TIFF tiff TIFF jpg JPEG jpe JPEG 518 jpg JPEG gif GIF xpm XPM); 519 520### usage 521# vvv deprecated options: 522# --outfile=<file>: write result to <file> 523# --debug: verbose debug informations (default: $bool[$::opt_verbose]) 524# --(no)filter: d. read standard input (default: false) 525# --(no)gs d. run Ghostscript to create PDF 526my $usage= 527"${title}Usage: $program [options] <inputfile> [[<outformat>:] <outputfile>] 528Run with --doc to read documentation as a UNIX man(1) page. 529Options: --help print this help message 530--(no)compress use compression (def: best) 531--(no)hires scan HiResBoundingBox (def: yes) 532--(no)exact scan ExactBoundingBox (def: no) 533--(no)verbose verbose debug informations (def: no) 534--(no)below allow below+left_from baseline (def: no) 535--(no)tmpunlink unlink temporary files (def: yes) 536--(no)antialias render shades at outlines (def: scale3no) (=scale3yes =no =yes) 537--(no)lossy allow lossy image filters (EPS->PDF) (def: yes) 538--(no)keepoldmediabox keep only old, [0 0]-based MediaBox in PDF (def: no) 539--gs-cmd= path to Ghostscript (def: gs or gswin32c) 540--gs-ccmd= path to Ghostscript, 4 bbox calc (def: gs or gswin32c) 541--gsextra= extra arg to gs 542--extra= extra arg to external prg (i.e pdftops) 543--bboxfrom= adsc|compute-gs|pagesize (def: guess) 544--papersize= unchanged|force-unknown|600bpx5cm (def: default) (bp) 545--threshold= min color for 1 in 8->1 bit conv (def: 128) 546Possible input formats: PS EPS PDF JPEG GIF TIFF PNG PNM PCX BMP LBM XPM TGA 547Possible output formats: @{[sort keys %fmts]} 548Examples for producing 'test.pdf': 549 * $program test.eps 550 * produce postscript | $program -v - test.pdf 551Example: look for HiResBoundingBox and produce corrected PostScript: 552 * $program -d --nogs -hires test.ps>testcorr.ps 553"; 554sub errorUsage { 555 die "$usage\U!\E!\U!\E Error: @_\n"; 556} 557 558# --- @ARGV parsing 559 560### default option values 561my @extra=(); 562my @gsextra=(); 563#** Output file format (string) 564my $FileFormat=undef; 565$::opt_help=0; 566$::opt_verbose=0; 567my %vals_compression=map{$_=>1} qw(best none flate zip); 568$::opt_compression='best'; 569#** Prefer %%HiResBoundingBox over %%BoundingBox, but emit both 570$::opt_hires=1; 571$::opt_exact=0; 572# $::opt_filter=0; # deprecated 573# $::opt_outputfile=undef; # deprecated 574$::opt_below=undef; 575$::opt_keepoldmediabox=0; 576$::opt_lossy=1; 577$::opt_antialias=undef; # render shades at path outlines for better readability 578$::opt_gs_cmd=undef; 579$::opt_extra=""; 580$::opt_duplex="default"; 581$::opt_threshold=128; 582my %vals_antialias=map{$_=>1} qw(no yes scale3yes scale3no); 583my %vals_duplex=map{$_=>1} qw(force-unknown force-simplex force-long 584 force-short unchanged default-simplex default-long default-short); 585# ^^^ short: duplex printing, will bind short edge of paper (ideal for 586# duplexing psnup -2) 587#** Dat: force-unknown is forced by /setpagedevice/load def 588$::opt_resolution="default"; # unchanged force-unknown 600x600 (DPI) 589$::opt_papersize="default"; # unchanged force-unknown 600bpx600cm (bp) 590#** --bboxfrom=adsc sets %%BoundingBox from the 1st page if no ADSC comment in non-EPS ps 591my %vals_bboxfrom=map{$_=>1} qw(adsc compute-gs guess pagesize); 592$::opt_bboxfrom="guess"; 593my $InputFilename; 594my $OutputFilename; 595 596sub is_page1_stop() { 0!=($fmts{$FileFormat}[0]&FL_PAGE1_STOP) } 597sub is_set_pagesize_ok() { 0!=($fmts{$FileFormat}[0]&FL_SET_PAGESIZE_OK) } 598sub is_pdfmark() { 0!=($fmts{$FileFormat}[0]&FL_PDFMARK) } 599sub is_need_showpage() { 0!=($fmts{$FileFormat}[0]&FL_NEED_SHOWPAGE) } 600sub is_sampled() { 0!=($fmts{$FileFormat}[0]&FL_SAMPLED) } 601sub is_any_origin_ok() { 0!=($fmts{$FileFormat}[0]&FL_ANY_ORIGIN_OK) } 602sub is_has_antialias() { 0!=($fmts{$FileFormat}[0]&FL_HAS_ANTIALIAS) } 603sub is_via_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_VIA_SAM2P) } 604sub is_ok_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_OK_SAM2P) } 605 606# --- 607 608sub show_doc() { 609 # run `pod2man __FILE__ | man -l -', same as `perldoc __FILE', but perldoc(1) 610 # is missing from some Debian sites that have pod2man. 611 my @path=split/:+/,$ENV{PATH}; 612 my $pod2man_='pod2man --center="a2ping: advanced PS, PDF, EPS converter" '; 613 $pod2man_=q~perl -ne 'if($a>1){print}elsif($a&&/^=head1/){$a=2}else{$a=!/\S/}' ~ 614 if !grep { -x "$_/pod2man" } @path; 615 my $pager=''; 616 for my $pageri ((defined $ENV{PAGER} ? $ENV{PAGER}: ''),'less','most','more','view - ','vim -R - ','vi - ','joe -rdonly -asis -','pager') { 617 next if $pageri!~/^(\S+)/; 618 my $pagert="/$1"; 619 if (grep { -x $_.$pagert } @path) { $pager=$pageri; last } 620 } 621 $pager=q~perl -pe 's@\010_@@g;s@.\010@@gs' | ~.$pager 622 if substr($pager,-2)eq' ' or $pager=~/\A(?:view|vim?|joe|emacs|mcedit|nano|nano-tiny|ae)\b/; 623 # ^^^ Dat: these cannot handle underline/bold backspace directly 624 $ENV{PAGER}=$pager; 625 my $man=''; 626 if (substr($pod2man_,0,5)ne 'perl ') { 627 $man=' | man -l -'; # calls $PAGER 628 if ((!grep { -x "$_/man" } @path) or qx(man -l 2>&1)=~/\binvalid option\b/) { 629 $man=' | nroff -Tlatin1 -mandoc'; # Linux, no need for eqn(1), tbl(1) etc. 630 if (!grep { -x "$_/nroff" } @path) { $man='' } # just write it 631 } 632 } 633 my $cmd=$pod2man_.fnq(__FILE__).$man; 634 if ($cmd!~/[|] man -l -\Z(?!\n)/) { 635 if (!length $pager) { 636 die unless open PIPE, "$cmd|"; 637 print while sysread PIPE, $_, 4096; 638 die "$0: error showing doc\n" unless close PIPE; 639 exit 0; 640 } 641 $cmd.=' | $PAGER'; 642 } 643 ##die $cmd; 644 $ENV{LESS}="" if !defined $ENV{LESS}; 645 $ENV{LESS}="$ENV{LESS}R"; # show ANSI escapes 646 die "$0: exec ($cmd) failed: $!\n" if !exec $cmd; 647} 648 649die $usage if !@ARGV or (1==@ARGV and $ARGV[0] eq '-h' or $ARGV[0] eq '--help' 650 or $ARGV[0] eq 'help'); 651show_doc() if 1==@ARGV and $ARGV[0] eq '--doc' or $ARGV[0] eq 'doc'; 652 653{ my($I,$optname,$optval); 654 my %optmap=qw(o outputfile outfile outputfile r resolution h help 655 f filter d verbose v verbose debug verbose p papersize 656 c compression compress compression h hires b below e exact x extra); 657 #** Options that have a mandatory argument 658 my %argopt1=qw(outputfile 1 duplex 1 resolution 1 extra 1 compression 1 gs-cmd 1 659 gs-ccmd 1 660 papersize 1 paper 1 bboxfrom 1 antialias 1 gsextra 1 threshold 1); # 1 arg 661 my %argnone=qw(help 1 verbose 1 noverbose 1 nocompress 1 noantialias 1); # 0 arg 662 my %argmaybe=qw(); # 0 or 1 arg 663 my %argbool=qw(hires 1 exact 1 below 1 gs 1 filter 1 tmpunlink 1 664 approx 1 lossy 1 keepoldmediabox 1); # boolean arg 665 # Dat: --noverbose --nocompress 666 my $opts_ok=1; 667 for ($I=0; $I<@ARGV; $I++) { 668 if ($ARGV[$I]eq '--') { 669 $OutputFilename=$InputFilename if defined $InputFilename and 670 !defined $OutputFilename and $opts_ok; 671 $opts_ok=0; 672 } elsif ($opts_ok and $ARGV[$I]=~/\A--+(\w[\w-]*)(?:[:=](.*))?\Z(?!\n)/s) { 673 $optname=lc$1; $optval=$2; 674 } elsif ($opts_ok and $ARGV[$I]=~/\A-(\w)(.*)\Z(?!\n)/s) { 675 $optname=lc$1; 676 if (length($2)==0) { $optval=undef } 677 elsif (index(":=",substr($2,0,1))>=0) { $optval=substr($2,1) } 678 else { $optval=$2 } 679 } elsif ($opts_ok and !defined $FileFormat and defined $InputFilename and $ARGV[$I]=~s@\A(\w+):@@) { 680 my $fmtag=uc$1; 681 # errorUsage "invalid FileFormat tag: $fmtag" if $fmtag!~s@:\Z(?!\n)@@; 682 if (exists $fmts{$fmtag}) { $FileFormat=$fmtag } 683 elsif (exists $fmt_aliases{$fmtag}) { $FileFormat=$fmt_aliases{$fmtag} } 684 else { errorUsage "Unknown FileFormat tag: $fmtag" } 685 if (0!=length($ARGV[$I])) { 686 errorUsage "Multiple output filenames" if defined $OutputFilename; 687 $OutputFilename=$ARGV[$I]; 688 } 689 next 690 } elsif (!defined $InputFilename) { $InputFilename=$ARGV[$I]; next } 691 elsif (!defined $OutputFilename) { $OutputFilename=$ARGV[$I]; next } 692 else { errorUsage "Too many arguments (multiple input/output files?)" } 693 $optname=$optmap{$optname} if exists $optmap{$optname}; 694 if (exists $argopt1{$optname} and !defined $optval) { 695 errorUsage "Argument expected for --$optname" if $I==@ARGV; 696 $optval=$ARGV[++$I]; 697 } 698 # Dat: $optname and $optval are now correct 699 errorUsage "No argument expected for --$optname=$optval" if exists $argnone{$optname} and defined $optval; 700 if (substr($optname,0,2)eq"no" and exists $argbool{substr($optname,2)}) { 701 $optname=substr($optname,2); 702 errorUsage "No argument expected for no --no$optname=$optval" if defined $optval; 703 $optval="no"; 704 } 705 if (exists $argbool{$optname}) { 706 # same as sam2p GenBuffer::parseBool, understands: 707 # on true yes ja igen oui enable 1 true vrai? right sure allowed 708 # off false no nein nem non disable 0 false faux? wrong nope disallowed 709 $optval=(!defined($optval) or 0==length($optval) 710 or $optval=~/\Ao[nu]/i or $optval!~/\A[fndw0]/i) ? 1 : 0; 711 } elsif (!exists $argopt1{$optname} and !exists $argnone{$optname} and !exists $argmaybe{$optname}) { 712 errorUsage "Unknown option --$optname, see --help" 713 } 714 # vvv application-specific 715 if ($optname eq "help") { die $usage } 716 elsif ($optname eq "help") { show_doc() } 717 elsif ($optname eq "noverbose") { $::opt_verbose=0 } 718 elsif ($optname eq "nocompress") { $::opt_compression='none' } 719 elsif ($optname eq "verbose") { $::opt_verbose++ } 720 elsif ($optname eq "hires") { $::opt_hires =$optval } 721 elsif ($optname eq "exact") { $::opt_exact =$optval } 722 elsif ($optname eq "below") { $::opt_below =$optval } 723 elsif ($optname eq "keepoldmediabox") { $::opt_keepoldmediabox=$optval } 724 elsif ($optname eq "lossy") { $::opt_lossy =$optval } 725 elsif ($optname eq "approx") { $::opt_approx=$optval } 726 elsif ($optname eq "threshold") { $::opt_threshold=$optval+0 } # Imp: accept only int 0..256 727 elsif ($optname eq "filter") { 728 # errorUsage "Multiple input filenames" if defined $InputFilename; 729 # $InputFilename='-'; 730 errorUsage "Multiple output filenames" if defined $OutputFilename; 731 $OutputFilename='-'; 732 } elsif ($optname eq "tmpunlink") { $tmpunlink_p=$optval } 733 elsif ($optname eq "gs") { $FileFormat=$optval ? 'PDF1' : 'markedEPS' } 734 elsif ($optname eq "compression") { 735 errorUsage "--$optname expects one of: @{[keys%vals_compression]}" if !exists $vals_compression{$optval}; 736 $::opt_compression=$optval; 737 $::opt_compression='zip' if $::opt_compression eq 'flate'; 738 } elsif ($optname eq "outputfile") { 739 errorUsage "Multiple output filenames" if defined $OutputFilename; 740 $OutputFilename=$optval; 741 } elsif ($optname eq "gs-cmd") { 742 errorUsage "Multiple --gs-cmd" if defined $::opt_gs_cmd; 743 $::opt_gs_cmd=$optval; 744 } elsif ($optname eq "gs-ccmd") { 745 errorUsage "Multiple --gs-ccmd" if defined $::opt_gs_ccmd; 746 $::opt_gs_ccmd=$optval; 747 } elsif ($optname eq "extra") { push @extra, $optval } 748 elsif ($optname eq "gsextra") { push @gsextra, $optval } 749 elsif ($optname eq "duplex") { 750 errorUsage "--$optname expects one of: @{[keys%vals_duplex]}" if !exists $vals_duplex{$optval}; 751 $::opt_duplex=$optval 752 } elsif ($optname eq "bboxfrom") { 753 errorUsage "--$optname expects one of: @{[keys%vals_bboxfrom]}" if !exists $vals_bboxfrom{$optval}; 754 $::opt_bboxfrom=$optval 755 } elsif ($optname eq "noantialias") { 756 $::opt_antialias='no' 757 } elsif ($optname eq "antialias") { 758 errorUsage "--$optname expects one of: @{[keys%vals_antialias]}" if !exists $vals_antialias{$optval}; 759 $::opt_antialias=$optval 760 } elsif ($optname eq "resolution") { 761 if ($optval eq "unchanged" or $optval eq "force-unknown") { } 762 elsif ($optval=~/^(\d+(?:[.]\d+)?)\Z(?!\n)/) { $optval="$1x$1" } 763 elsif ($optval=~/^(\d+(?:[.]\d+)?[x,]\d+(?:[.]\d+)?)\Z(?!\n)/) { } 764 else { errorUsage "--Resultion expects unchanged | force-unknown | DPI | XDPIxYDPI" } 765 $::opt_resolution=$optval 766 } elsif ($optname eq "papersize" or $optname eq"paper") { 767 if ($optval eq "unchanged" or $optval eq "force-unknown") { $::opt_papersize=$optval } 768 else { 769 my @L=Htex::papers::any($optval); 770 errorUsage "invalid or unknown for --papersize" if !@L; 771 $::opt_papersize="$L[1],$L[2]" # width, height 772 } 773 } else { die } # unreachable 774 } # NEXT opt 775 errorUsage "Too many arguments (multiple input/output files?)" if $I!=@ARGV; 776 # splice @ARGV, 0, $I; 777} 778 779$GS=$::opt_gs_cmd if defined $::opt_gs_cmd; 780my $CGS=$GS; 781$CGS=$::opt_gs_ccmd if defined $::opt_gs_ccmd; 782# vvv SUXX: (r) file doesn't work with gs 8.5x -DSAFER 783#$GS.= " -dSAFER"; # -dWRITESYSTEMDICT 784#$CGS.=" -dSAFER"; # -dWRITESYSTEMDICT 785 786### get input and output filename 787if (!defined $InputFilename and defined $OutputFilename) { # --filter 788 $InputFilename='-'; 789} elsif (!defined $InputFilename) { 790 errorUsage "Input filename missing" 791} elsif (!defined $OutputFilename) { 792 $FileFormat='PDF1' if !defined $FileFormat; 793 if ($FileFormat eq 'PDF1' or $FileFormat eq 'PDF') { 794 if (($OutputFilename=$InputFilename) ne '-') { 795 $OutputFilename =~ s/\.[^\.]*$//; 796 $OutputFilename .= ".pdf"; 797 } 798 } else { 799 $OutputFilename = '-'; # standard output 800 } 801} 802print STDERR $title if $::opt_verbose; 803$title=""; 804 805# Dat: no more @ARGV 806errorUsage "please specify <outformat>" if 807 !defined $FileFormat and ($OutputFilename!~m@[.]([^/.]+)\Z(?!\n)@ or 808 !defined($FileFormat=$fmt_exts{lc$1})); 809$::opt_below=is_any_origin_ok() if !defined $::opt_below; 810error "--below=1 invalid for FileFormat $FileFormat" if $::opt_below and 811 !is_any_origin_ok() and $FileFormat ne 'PDF1' and $FileFormat ne 'EPS' and 812 $FileFormat ne 'markedEPS'; 813error "--below=0 invalid for FileFormat $FileFormat" if !$::opt_below and 814 is_any_origin_ok(); 815$::opt_antialias=is_has_antialias() ? 816 (is_sampled() ? 'scale3no' : 'yes') : 'no' if 817 !defined $::opt_antialias; 818 819if ($FileFormat eq 'PBM' and ($::opt_antialias eq 'scale3yes' or 820 $::opt_antialias eq 'scale3no')) { 821} elsif ($::opt_antialias ne 'no' and !is_has_antialias()) { 822 $::opt_antialias='no'; 823 warning "--AntiAlias ignored for FileFormat $FileFormat" 824} 825if ($::opt_antialias eq 'scale3no' or $::opt_antialias eq 'scale3yes') { 826 $::opt_resolution="72,72" if $::opt_resolution eq 'unchanged' or $::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'default'; 827 # ^^^ GS raster default 828 my @L=split/[,x]/,$::opt_resolution; 829 @L=(@L,@L); # Imp: .. 830 $L[0]*=3; $L[1]*=3; 831 $::opt_resolution="$L[0],$L[0]"; 832} 833 834### option compress 835my $GSOPTS=join(" ",map{fnq$_}@gsextra); 836# $GSOPTS.=" -r72 -sPAPERSIZE=a4 "; # default -- will be overridden by `setpagedevice' 837# ^^^ Dat: default does only harm; user should specify on command line 838 839### option BoundingBox types 840#**** pts **** 841# scan all of them and find the best 842{ my $BBprint = "%%BoundingBox:"; 843 $BBprint = "%%HiResBoundingBox:" if $::opt_hires; 844 $BBprint = "%%ExactBoundingBox:" if $::opt_exact; 845 debug "Strongest BoundingBox comment:", $BBprint; 846} 847my $BBregex='%%(Hi[Rr]es|Exact|)BoundingBox:'; 848 849if (!is_set_pagesize_ok()) { 850 if ($::opt_papersize ne'default' and $::opt_papersize ne'force-unknown') { 851 error "Cannot set --PaperSize for FileFormat $FileFormat" 852 } else { $::opt_papersize='force-unknown' } 853} elsif ($::opt_papersize eq'default') { $::opt_papersize='unchanged' } 854 855if ($::opt_resolution eq'default') { $::opt_resolution='force-unknown' } 856error "Cannot set --Resolution for FileFormat $FileFormat (must be markedPS or sampled)" 857 if $FileFormat ne 'markedPS' and !is_sampled() 858 and $::opt_resolution ne'force-unknown'; 859error "Bad --Resolution=$::opt_resolution" if $::opt_resolution ne 'unchanged' 860 and $::opt_resolution ne 'force-unknown' and $::opt_resolution!~/\A(\d+)+[,x](\d+)\Z(?!\n)/; 861 862if ($FileFormat ne 'markedPS' and $FileFormat ne 'PCL5') { 863 if ($::opt_duplex ne'default' and $::opt_duplex ne'force-unknown') { 864 error "Cannot set --Duplex for FileFormat $FileFormat (must be markedPS or PCL5)" 865 } else { $::opt_duplex='force-unknown' } 866} elsif ($::opt_duplex eq'default') { $::opt_duplex='force-unknown' } 867 868debug "Doing --PaperSize $::opt_papersize" if $::opt_papersize ne 'force-unknown'; 869debug "Doing --Duplex $::opt_duplex" if $::opt_duplex ne 'force-unknown'; 870debug "Doing --Resolution $::opt_resolution" if $::opt_resolution ne 'force-unknown'; 871debug "Doing --AntiAlias=$::opt_antialias" if $::opt_antialias ne 'no'; 872 873### option outfile 874if ($OutputFilename eq '-') { 875 debug "Output file: standard output"; 876} else { 877 debug "Output filename: $OutputFilename"; 878 #error "$OutputFilename: won't overwrite input file with itself" 879 # if $OutputFilename eq $InputFilename; 880} 881 882### option gs 883debug "Output FileFormat: $FileFormat"; 884$::opt_compression='zip' if $::opt_compression ne 'none'; 885if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') { 886 debug "Ghostscript ps2pdf command: $GS $GSOPTS"; 887 debug "Compression: $::opt_compression"; 888} elsif ($FileFormat eq 'PCL5') { 889 debug "Ghostscript ps2ljet command: $GS $GSOPTS"; 890} elsif (is_sampled()) { 891 debug "Ghostscript ps2sampled command: $GS $GSOPTS"; 892} 893 894#**** pts **** 895sub read_error() { error "read $InputFilename: $!" } 896my $in_mac_p=0; # 0: "\n" or "\r\n" is line terminator; 1: "\r" is line terminator 897my $bytes_left=-1; # -1==unlimited 898my $already_read=0; 899sub dem1($){defined$_[0]?$_[0]:-1} 900#** @param $_[0] number of bytes to read, or undef to read a line 901#** @return the string read 902sub readIN(;$) { 903 my $S; 904 ## return "" if $bytes_left==0; 905 ## print STDERR "READ($_[0])\n"; 906 if (defined $_[0]) { read_error if 0>dem1 read IN, $S, $_[0] } 907 else { 908 $!=0; # clean up error code 909 if ($in_mac_p) { 910 local $/="\r"; 911 $S=~s@\r\Z(?!\n)@\n@ if defined($S=<IN>); 912 } else { $S=<IN> } 913 read_error if !defined($S) and $!; 914 $S="" if !defined $S; # EOF 915 } 916 if ($bytes_left<0) { # unlimited 917 } elsif (length($S)>=$bytes_left) { 918 $S=substr($S, 0, $bytes_left); 919 $bytes_left=0; 920 } else { $bytes_left-=length($S) } 921 $already_read+=length($S); 922 $S 923} 924 925sub open_OUT() { 926 error "Cannot write outfile '$OutputFilename'" unless 927 open(OUT, $OutputFilename eq '-' ? ">-" : "> $OutputFilename") 928} 929 930#** @param $_[0] temp file extension (e.g ".img") 931#** @param $_[1] preprint 932#** @param $_[2] bool: force pipe even if seekable? 933sub fix_pipe_in($$$) { 934 my $c=""; 935 if ($_[2] or (length($c=readIN(1))!=0 and !seek IN,-1,1)) { # we cannot seek back 936 # Dat: ^^^ test seekability instead of $InputFilename eq '-' 937 my($ext,$preprint)=@_; 938 my $tifn; 939 # $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true 940 $tifn=temp_prefix()."M$ext"; 941 error "Cannot open temp input: $tifn" unless open TI, "> $tifn"; 942 $tmpfiles{$tifn}=1; 943 die unless print TI $preprint, $c; 944 print TI or die while length($_=readIN 4096); 945 die unless close TI; 946 $InputFilename=$tifn; 947 debug "Temp input file: $InputFilename"; 948 die unless open IN, "< $tifn"; 949 die unless seek IN, length($preprint), 0; 950 $already_read=length($preprint); 951 $bytes_left=-1; # unlimited, since readIN() has copied only part 952 # $bytes_left++ if $bytes_left>=0; # ungetc($c) 953 # temp_unlink $tifn; # do it later (at END{}) 954 } else { 955 $already_read--; $bytes_left++ if $bytes_left>=0; # BUGFIX at Fri May 14 00:21:18 CEST 2004 956 } 957} 958 959my $temp_out_fn; 960 961#** Does overwrite $temp_out_fn. Fine. 962sub fix_force_out($) { 963 my($ext)=$_[0]; 964 # $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true 965 $temp_out_fn=temp_prefix()."O$ext"; 966 # error "Cannot save output: $!" unless open SAVEOUT, ">&OUT"; # always STDOUT; maybe not open yet 967 error "Cannot open temp output: $temp_out_fn" unless open OUT, "> $temp_out_fn"; 968 $tmpfiles{$temp_out_fn}=1; 969 # $OutputFilename=$temp_out_fn; 970 debug "Temp output file: $temp_out_fn"; 971 # temp_unlink $temp_out_fn; # do it later (at END{}) 972 return $temp_out_fn; 973} 974 975#** @param $_[0] temp file extension (e.g ".img") 976#** @return new output filename 977sub fix_pipe_out($) { 978 if (!defined $temp_out_fn) { 979 return $OutputFilename if $OutputFilename ne '-'; 980 return fix_force_out($_[0]); 981 } 982 $temp_out_fn 983} 984sub fix_close_out() { 985 # error "closing filter out: $? $!" unless close OUT; 986 if (defined $temp_out_fn) { 987 my $buf; 988 die unless open FCO, "< $temp_out_fn"; 989 print STDOUT $buf while sysread FCO, $buf, 4096; 990 die unless close FCO; 991 temp_unlink $temp_out_fn; 992 undef $temp_out_fn; 993 } 994} 995 996sub do_system { 997 my($progname)=splice@_,0,1; 998 debug "Running: $progname @extra @_"; 999 error "prog $progname failed: $? $!" 1000 if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found 1001} 1002 1003sub do_exec { 1004 my($progname)=splice@_,0,1; 1005 if (scalar keys %tmpfiles) { 1006 # Cannot exec() right now, because we have to unlink some temporary files 1007 # later. 1008 do_system $progname, @_; 1009 } else { 1010 debug "Execing: $progname @extra @_"; 1011 1 if exec $progname, @extra, @_; 1012 # ^^^ Dat: $OutputFilename eq '-' should be OK 1013 error "exec failed: $!"; 1014 } 1015 exit(0); 1016} 1017 1018#sub shq($) { 1019# my $S=$_[0]; 1020# return $S if $S!~y@A-Za-z0-9_,:./-@@c and length($S)>0; 1021# $S=~s@'@'\\''@g; 1022# return "'$S'" 1023#} 1024 1025### open input file 1026if ($InputFilename eq '-') { 1027 debug "Input file: standard input"; 1028 open(IN, "<&STDIN") or error "cannot open standard input"; 1029} else { 1030 # -f $InputFilename or error "input file missing: $InputFilename"; # Imp: named pipe? 1031 open(IN,"< $InputFilename") or error "cannot open input file: $InputFilename"; 1032 debug "Input filename:", $InputFilename; 1033 if ($InputFilename eq $OutputFilename) { 1034 # error "same input and output file: $InputFilename"; 1035 my $ext=$InputFilename=~m@([.][^./]+)\Z(?!\n)@ ? $1 : ""; 1036 binmode IN; $bytes_left=-1; 1037 fix_pipe_in($ext, "", 1); # Dat: defined later 1038 } 1039} 1040binmode IN; 1041 1042#** Dat: uses $FileFormat, $InputFileName, $OutputFileName 1043#** @param $S prepend to pipe 1044sub run_sam2p($$) { 1045 my($approx_p,$S)=@_; 1046 # Imp: why isn't sam2p(1) PNG -> PNG idempotent? 1047 my $tfmt=$FileFormat eq'markedEPS' || $FileFormat eq 'EPS' ? 'EPS' 1048 : $FileFormat eq'markedPS' || $FileFormat eq 'PS' ? 'PS' # Dat: emits no /PageSize 1049 : $FileFormat eq'PDF1' || $FileFormat eq 'PDF' ? 'PDF' 1050 : undef; 1051 if (defined $tfmt) {} 1052 elsif (is_via_sam2p() or is_ok_sam2p()) {$tfmt=$FileFormat; $::opt_approx=1} 1053 else { error "sam2p doesn't support our FileFormat $FileFormat" } 1054 fix_pipe_in ".img", $S, 0; 1055 if ($approx_p) { 1056 if ($tfmt eq 'GIF') { 1057 # Dat: reduce palette to 8-bit if necessary 1058 my @args=('sam2p',@extra,"$tfmt:",'--',$InputFilename,$OutputFilename); 1059 debug "Running: @args"; 1060 my $cmd=join(' ',map{fnq$_}@args)." 2>&1"; 1061 my $res=readpipe($cmd); 1062 if ($res=~/\binvalid combination, no applicable OutputRule\b/) { 1063 # Dat: reduce palette to 8-bit 1064 #die "NOR"; 1065 my $have_convert_p; 1066 my $have_pnmquant_p=0; 1067 for my $dir (split/:/,$ENV{PATH}) { 1068 if ((-f"$dir/pnmquant")) { $have_pnmquant_p=1 } 1069 } 1070 if (!$have_pnmquant_p) { 1071 $have_convert_p=0; 1072 for my $dir (split/:/,$ENV{PATH}) { 1073 if ((-f"$dir/convert")) { $have_convert_p=1 } 1074 } 1075 } 1076 my $cmd; 1077 if ($have_pnmquant_p) { 1078 my @args1=('sam2p','PPM:','--',$InputFilename,'-'); 1079 my @args2=('sam2p',@extra,"$tfmt:",'--','-',$OutputFilename); 1080 $cmd=join(' ',map{fnq$_}@args1)." | pnmquant 256 | ". 1081 join(' ',map{fnq$_}@args2); 1082 } elsif ($have_convert_p) { 1083 my @args1=('sam2p','PPM:','--',$InputFilename,'-'); 1084 my @args2=('sam2p',@extra,"$tfmt:",'--','-',$OutputFilename); 1085 # vvv Dat: `convert - GIF:-' does quantize (and emits GIF) 1086 $cmd=join(' ',map{fnq$_}@args1)." | convert - GIF:- | ". 1087 join(' ',map{fnq$_}@args2); 1088 } 1089 debug "Running pipe: $cmd"; 1090 exec($cmd); 1091 } elsif ($? !=0) { die $res } 1092 # die $cmd; 1093 #debug "Running: $progname @extra @_"; 1094 #error "prog $progname failed: $? $!" 1095 #if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found 1096 } 1097 do_exec('sam2p', ("$tfmt:", '--', $InputFilename, $OutputFilename)); 1098 } else { 1099 warning "post-processing of sam2p PDF output increases file size" if $tfmt eq 'PDF'; 1100 $tfmt='EPS' if $tfmt eq 'PDF'; # Imp: PDF1<->PDF 1101 close IN; 1102 my $tpfn=temp_prefix()."Psimg"; 1103 error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn"; 1104 $tmpfiles{$tpfn}=1; 1105 die unless close TP; 1106 do_system('sam2p', ("$tfmt:", '--', $InputFilename, $tpfn)); 1107 error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn"; 1108 $already_read=0; $bytes_left=-1; 1109 $InputFilename=$tpfn; # '-' 1110 goto SCAN_AGAIN 1111 } 1112} 1113 1114#** Force this value for %%HiResBoundingBox if a %BoundingBox is read 1115my $force_hiresbbox_value; 1116 1117### scan first line, check for DOS EPSF (and remove DOS headers) 1118my $header; 1119{ SCAN_AGAIN: 1120 my $S; 1121 $_=$header=""; 1122 read_error if 0>read IN, $S, 4; 1123 error "$InputFilename: empty file" if 0==length($S); 1124 $already_read+=length($S); 1125 ##print tell(IN)." bar=$already_read\n"; 1126 my $iff="?"; # Input File Format 1127 # vvv be permissive, since we have only 4 chars 1128 if ($S eq "\211PNG") { $iff="PNG" } 1129 elsif ($S=~/\A(\377+\330)\377/) { $iff="JPEG" } 1130 elsif ($S eq "MM\000\052" or $S eq "II\052\000") { $iff="TIFF" } 1131 elsif ($S=~m@\AP([1-6])[\s#]@) { $iff="PNM" } 1132 elsif ($S=~/\ABM/) { $iff="BMP" } 1133 elsif ($S eq "GIF8") { $iff="GIF" } 1134 elsif ($S eq "FORM") { $iff="LBM" } 1135 elsif ($S eq "/* X" or $S eq "/*XP") { $iff="XPM" } 1136 elsif ($S=~/\A\12[\0-\005]\001[\001-\10]/) { $iff="PCX" } 1137 elsif ($S=~/\A[\36-\77](?:\001[\001\11]|\0[\002\12\003\13])\0/) { $iff="TGA" } 1138 elsif ($S eq "\305\320\323\306") { $iff="DOS-EPSF" } 1139 elsif ($S eq "\033%-1") { $iff="UEL" } 1140 elsif (substr($S,0,1)eq'%') { $iff="P" } # PS, EPS or PDF 1141 1142 # PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA 1143 if ($iff eq "DOS-EPSF") { # DOS EPSF header 1144 read_error if 30-4>read IN, $S, 30-4, 4; 1145 my ($eheader,$ps_ofs,$ps_len,$wmf_ofs,$wmf_len,$tif_ofs,$tif_len,$checksum)= 1146 unpack"A4VVVVVVv", $S; 1147 $already_read+=30-4; 1148 error "$InputFilename: bad DOS EPS" if $eheader ne "\305\320\323\306" or $ps_ofs<30; 1149 my($ps_end, $wmf_end, $tif_end)=($ps_ofs+$ps_len, $wmf_ofs+$wmf_len, $tif_ofs+$tif_len); 1150 $ps_ofs-=30; 1151 if (!seek IN, $ps_ofs, 1) { 1152 while ($ps_ofs>4096) { $ps_ofs-=4096; readIN 4096 } 1153 read_in $ps_ofs if $ps_ofs>0; 1154 } 1155 $bytes_left=($ps_end>$wmf_end and $ps_end>$tif_end) ? -1 : $ps_len; 1156 $S=readIN(1); 1157 } elsif ($iff eq "UEL") { # HP PJL UEL, untested 1158 $S.=readIN; 1159 $S=substr($S,1); 1160 error "$InputFilename: bad HP PJL UEL header: ".(~chomp($S)&&$S) 1161 if $S!~/\A\\e?%-12345X\@PJL ENTER LANGUAGE\s*=\s*POSTSCRIPT\s*\r?$/i; 1162 1 while length($S=readIN())!=0 and substr($S,0,4)ne'%!PS'; 1163 die "$InputFilename: premature HP PJL UEL header" if length($S)==0; 1164 } elsif ($iff eq "P") { 1165 # no-op yet, see later 1166 } elsif ($iff eq "?") { 1167 error "unknown input image format: $InputFilename"; 1168 } else { # source file is in some raster graphics format 1169 run_sam2p($::opt_approx,$S); 1170 goto SCAN_AGAIN 1171 } 1172 1173 # now deal with PS, EPS and PDF 1174 if (substr($S,0,1) eq '%') { 1175 { my $max=128; 1176 my $C; 1177 while (length($S)<$max and defined($C=readIN(1)) and 1178 $C ne "\n" and $C ne "\r") { $S.=$C } 1179 error "couldn't find end of PS/PDF header line in $max bytes\n" if 1180 length($S)>=$max or !defined($C); 1181 $C=($C eq "\r") ? readIN(1) : "NONE"; 1182 if (!defined$C or ($C ne "\n" and $C ne "NONE")) { 1183 use IO::Handle; # Dat: needed for ungetc 1184 IN->ungetc(ord($C)) if defined $C; 1185 debug "MAC \\r detected"; 1186 $in_mac_p=1; 1187 } elsif ($C eq "\n") { # Dat: \r\n, DOS CRLF 1188 $in_mac_p=0; $S.="\r"; 1189 } else { $in_mac_p=0 } 1190 $S.="\n"; 1191 } # $S.=readIN; 1192 if (substr($S,0,4)eq'%PDF') { 1193 # error "$InputFilename: won't read a PDF file"; 1194 if ($FileFormat eq 'PDF') { # convert PDF to PDF 1195 # !! PDF->PS->PDF 1196 open_OUT(); 1197 $_=$S; 1198 debug "Doing a bit-by-bit copy"; 1199 do { 1200 error "input error: $!" unless print OUT; 1201 } while (length($_=readIN 4096)); 1202 close OUT; close IN; 1203 exit 0; 1204 } elsif ($FileFormat eq 'PDF1') { # Dat: remove extra pages by running pdftops and gs -sDEVICE=pdfwrite 1205 # !! Imp: possibly Run MetaPost output through full dvips (texc.pro) when prologues:=0 1206 # !! Imp: add full dvips %* font comment when prologues:=1 (design sizes missing :-() 1207 # Dat: no way to use $::opt_approx, because it doesn't remove extra pages 1208 fix_pipe_in ".pdf", $S, 0; # in case of stdin 1209 # Imp: option to open pdftops pipe instead of temp file 1210 # Dat: we rather use a temp file here for safety and early error detection 1211 do_input_pdftops: # come from EPS: and markedEPS: 1212 close IN; # after fix_pipe_in() 1213 my $tpfn=temp_prefix()."Peps"; 1214 error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn"; 1215 $tmpfiles{$tpfn}=1; 1216 die unless close TP; 1217 do_system qw(pdftops -f 1 -l 1 -eps -- ), $InputFilename, $tpfn; 1218 error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn"; 1219 $already_read=0; $bytes_left=-1; 1220 $InputFilename=$tpfn; # '-' 1221 goto SCAN_AGAIN 1222 } elsif ($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS') { # convert PDF to EPS 1223 # Dat: limitation: markedEPS and EPS are treated the same 1224 # vvv Dat: pdftops(1) is part of the xpdf package 1225 # vvv Dat: pdftops(1) can emit to stdout 1226 fix_pipe_in ".pdf", $S, 0; 1227 if ($::opt_approx) { 1228 do_exec qw(pdftops -f 1 -l 1 -eps --), $InputFilename, $OutputFilename; 1229 } else { goto do_input_pdftops } 1230 } elsif ($FileFormat eq 'PS' or $FileFormat eq 'markedPS') { 1231 # Dat: limitation: markedEPS and EPS are treated the same 1232 fix_pipe_in ".pdf", $S, 0; 1233 close IN; 1234 # vvv we must query the BoundingBox first 1235 my $cmd="pdftops -f 1 -l 1 -eps ".fnq($InputFilename)." -"; 1236 debug "pdftops bbox pipe: $cmd"; 1237 error "pipe: $!" unless open PIPE, "$cmd |"; 1238 my $line; 1239 error "expected PS document" if !defined($line=<PIPE>) or $line!~/^%!PS-Adobe-\d.*EPSF-\d/; 1240 my @L; # $papersize_x, $papersize_y 1241 while (<PIPE>) { 1242 last if /^%%EndComments/ or !/^%/; 1243 @L=($1,$2) if /^%%(?:Hires|Exact)BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i; 1244 @L=($1,$2) if /^%%BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i and !@L; 1245 # ^^^ Dat: HiRes has priority 1246 # ^^^ Dat: ignore llx and lly coordinates 1247 } 1248 1 while read PIPE, $line, 4096; 1249 error "closing PIPE: $?" unless close PIPE; 1250 error "BoundingBox not found in pdftops output" if !@L; 1251 debug "Got PaperSize: @L"; 1252 1253 # vvv Dat: pdftops without -eps doesn't report HiResBoundingBox, 1254 # so we force it here 1255 # at Wed Nov 15 17:19:23 CET 2006 1256 $::opt_bboxfrom='adsc' if $::opt_bboxfrom eq 'guess'; 1257 $force_hiresbbox_value="0 0 @L"; 1258 1259 #die defined $L[1]; 1260 $L[0]=myceil $L[0]; $L[1]=myceil $L[1]; # Dat: pdftops expects integer papersize :-( ) 1261 if ($::opt_approx) { 1262 # vvv Dat: even pdftops 3.01 accepts only integer for -paperw and paperh 1263 do_exec 'pdftops', '-paperw', myfloor($L[0]+0.5), '-paperh', myfloor($L[1]+0.5), $InputFilename, $OutputFilename; 1264 } else { 1265 my $tpfn=temp_prefix()."Pps"; 1266 error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn"; 1267 $tmpfiles{$tpfn}=1; 1268 die unless close TP; 1269 do_system 'pdftops', '-paperw', myfloor($L[0]+0.5), '-paperh', myfloor($L[1]+0.5), $InputFilename, $tpfn; 1270 error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn"; 1271 $already_read=0; $bytes_left=-1; 1272 $InputFilename=$tpfn; # '-' 1273 goto SCAN_AGAIN 1274 } 1275 } elsif (is_ok_sam2p() or is_via_sam2p()) { 1276 # Dat: PDF to GIF conversion 1277 run_sam2p(1,$S); 1278 } 1279 1280 error "cannot create from PDF: FileFormat $FileFormat"; 1281 OK: 1282 } 1283 error "$InputFilename: EPS DSC must be %!PS-Adobe" if substr($S,0,4)ne'%!PS'; 1284 # ^^^ Dat: mpost outputs "%!PS\n" 1285 } else { 1286 warning "$InputFilename: no PS ADSC header, BoundingBox not found\n" 1287 } 1288 $header=$S; 1289} 1290 1291# Dat: Now we are converting from PS|EPS to EPS|markedEPS|PDF|PCL5|PGM 1292# So we're converting from PS|EPS with Ghostscript 1293 1294### variables and pattern for BoundingBox search 1295my $bbxpatt = '[0-9eE\.\-]'; 1296my $BBValues = "\\s*($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)"; # protect backslashes: "\\" gets '\' 1297 1298my $ll_zero=0; # ($llx,$lly)==(0,0) in the output file 1299my $need_grestore=0; # 0 v 1 1300#** Applies %%*BoundingBox, %%EndComments, special setpagedevice, gsave..translate 1301#** @param $_[0] llx, may be undef to signify that bbox is undetected 1302#** @param $_[1] lly 1303#** @param $_[2] urx 1304#** @param $_[3] ury 1305#** @param $_[4] after_correct PostScript code (resolution, page size) 1306#** @return PostScript code to be printed after the header 1307sub CorrectBoundingBox($$$$$$$) { 1308 no integer; 1309 my $bbx=""; 1310 my $pagedev_mark=""; 1311 my $translate=""; 1312 my ($llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored) = @_; 1313 if (defined $llx) { 1314 my ($xoffset, $yoffset) = (0, 0); 1315 my $old_bbox="$llx $lly $urx $ury"; # debug "Old BoundingBox: $old_bbox"; 1316 # my ($width, $height) = ($urx - $llx, $ury - $lly); 1317 ($xoffset, $yoffset) = (-$llx, -$lly); 1318 # $::opt_below=0 if $lly>=0; # always move to (0,0) 1319 # my ($urxh,$uryh)=($urx,$ury); 1320 # my $no_translate=$::opt_below; 1321 #die $no_translate; 1322 ($llx,$lly,$urx,$ury)=(0,0,$urx-$llx,$ury-$lly) if !$::opt_below; 1323 $urx=1 if $urx<=0; # Dat: GS dislikes empty image; fix also negative image 1324 $ury=1 if $ury<=0; 1325 my($px,$py)=($urx,$ury); 1326 ($px,$py)=($1+0,$2+0) if $after_correct=~m@/PageSize\s*\[(\S+)\s+(\S+)+\]@; 1327 my @paper=Htex::papers::any("$px,$py"); 1328 $paper[0]=defined $paper[0] ? "%%DocumentPaperSizes: $paper[0]\n" : ""; 1329 $bbx.="%%BoundingBox: ".myfloor($llx)." ".myfloor($lly)." ". 1330 myceil($urx)." ". myceil($ury)."\n"; 1331 $bbx.="%%HiResBoundingBox: $llx $lly $urx $ury\n". 1332 "%%ExactBoundingBox: $llx $lly $urx $ury\n" if myfloor($llx)!=$llx 1333 or myfloor($lly)!=$lly or myceil($urx)!=$urx or myceil($ury)!=$ury; 1334 $bbx.="%%DocumentMedia: plain $px $py 0 () ()\n". # like pdftops(1) 1335 "$paper[0]"; 1336 # ^^^ Imp: can DocumentMedia be non-integer? As of us, it can. 1337 # vvv we output a second /MediaBox here, and we'll remove the first one 1338 # (written by GS) later 1339 # vvv Dat: old version of Ghostscript insisted on an integer /CropBox (??). 1340 # we do not force it now 1341 $pagedev_mark.="mark /CropBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark(); 1342 # die "$xoffset $yoffset $::opt_below"; 1343 if ($xoffset==0 and $yoffset==0) { #**** pts **** 1344 $need_grestore=0; 1345 $ll_zero=1; # Dat: we do not insert extra /MediaBox here, gs -sDEVICE=pdfwrite will do 1346 } elsif ($::opt_below) { 1347 # Do not translate (set (0,0) to the origin) with --below or multi-page 1348 # file formats. 1349 $need_grestore=0; 1350 $ll_zero=0; # fix /MediaBox because it become non-(0,0)-based 1351 $pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if 1352 is_pdfmark(); # $FileFormat eq 'markedEPS' or $FileFormat eq 'markedPS'; 1353 # Dat: markedPS and contains pdfmark! 1354 } else { 1355 # debug "Offset:", $xoffset, $yoffset; # no new information, see -$llx, -$lly 1356 $xoffset=0 if $xoffset==0; # get rid of `-0' 1357 $yoffset=0 if $yoffset==0; # get rid of `-0' 1358 if ($is_restored) { $translate="" } # save..restore does gsave..grestore 1359 else { $translate="gsave "; $need_grestore=1 } 1360 $ll_zero=0; 1361 # vvv the /MediaBox is different from what gs dumps 1362 # $pagedev_mark=~s@/PageSize\s*\[[^\]]*]@/PageSize [$urx $ury]@; # BUGFIX at Tue Apr 22 10:08:17 CEST 2003 1363 $pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark(); 1364 $translate.="$xoffset $yoffset translate\n" 1365 } 1366 my $new_bbox="$llx $lly $urx $ury"; 1367 if ($old_bbox eq $new_bbox) { 1368 debug "Final (HiRes)BoundingBox: $new_bbox"; 1369 } else { 1370 debug "Old (HiRes)BoundingBox: $old_bbox"; 1371 debug "Final corrected (HiRes)BoundingBox: $new_bbox"; 1372 } 1373 $pagedev_mark="/pdfmark where{pop}{/pdfmark/cleartomark load def}ifelse\n$pagedev_mark" 1374 if length($pagedev_mark)!=0; 1375 } 1376 # vvv Imp: `<<' -> `dict' 1377 # Dat: it is inherently impossible to tell GS that it shouldn't 1378 # recompress the images already compressed in the EPS file, but keep 1379 # them in their original, compressed form. So we rather instruct GS to 1380 # recompress 1381 # !! Dat: /CompatibilityLevel 1.3 %PDF-1.2 -- Dat: 1.2 won't embed Courier 1382 my $markpagedevices=""; 1383 my $imagesopts=($::opt_lossy ? " 1384/AutoFilterMonoImages true 1385/AutoFilterGrayImages true 1386/AutoFilterColorImages true 1387/MonoImageFilter /CCITTFaxEncode 1388/GrayImageFilter /DCTEncode 1389/ColorImageFilter /DCTEncode 1390" : " 1391/AutoFilterMonoImages false 1392/AutoFilterGrayImages false 1393/AutoFilterColorImages false 1394/MonoImageFilter /LZWEncode 1395/GrayImageFilter /LZWEncode 1396/ColorImageFilter /LZWEncode 1397"); # Dat: assumes new, patent-free LZW 1398 if (is_pdfmark()) { 1399 # Dat: CompatibilityLevel 1.3 is required for font embedding & all /FlateDecode 1400 $markpagedevices=" 1401/CompatibilityLevel 1.3 %PDF-1.3 1402/EmbedAllFonts true 1403/Optimize true % ignored by gs-6.70 1404/AutoRotatePages /None 1405/UseFlateCompression ".($::opt_compression ne 'none'?"true":"false")." 1406/AutoPositionEPSFiles false 1407/ConvertImagesToIndexed false 1408/DownsampleMonoImages false 1409/DownsampleGrayImages false 1410/DownsampleColorImages false 1411/EncodeMonoImages true 1412/EncodeGrayImages true 1413/EncodeColorImages true 1414/AntiAliasMonoImages false 1415/AntiAliasGrayImages false 1416/AntiAliasColorImages false\n$imagesopts"; 1417 $markpagedevices=(length($markpagedevices)!=0 ? "<< $markpagedevices >> setpagedevice\n" : ""); 1418 $markpagedevices.="1 dict dup /ImagingBBox null put setpagedevice\n"; 1419 $markpagedevices.="1 dict dup /Policies 1 dict dup /PageSize 3 put put setpagedevice\n"; # ripped from pdftops(1) 1420 } 1421 my $setpagesize=""; 1422 # die defined $urx; 1423 # die is_set_pagesize_ok(); 1424 # die $after_correct; 1425 if (defined $urx and is_set_pagesize_ok() 1426 and $::opt_papersize ne'force-unknown' 1427 and $after_correct!~m@/PageSize\s*\[@) { # Imp: m@/Pagesize ugly 1428 # Dat: true for FileFormat PGM 1429 # Dat: emit /PageSize even for PDF1 1430 # Dat: Ghostscript 6.70 rounds /PageSize down, but we need up when creating /MediaBox for PDF 1431 $setpagesize="2 dict dup /PageSize [".myceil($urx)." ".myceil($ury)."] put setpagedevice\n"; 1432 # ^^^ Dat: PLRM.pdf doesn't forbid a non-integer /PageSize 1433 } 1434 my $bsetup=is_page1_stop()?"":"%%BeginSetup\n%%EndSetup\n"; 1435 # ^^^ Dat: CUPS inserts its setpagedevice calls for /Duplex and /PageSize 1436 # etc. just after the %%BeginSetup line (or, if missing, puts it in 1437 # front of the first %%Page). We'd like this execution order: CUPS, 1438 # ours, PStoPS (or psnup). (When we come after CUPS, we'll have a 1439 # chance to override its settings.) So we emit a fake 1440 # %%BeginSetup..%%EndSetup pair just before our code doing 1441 # `setpagedevice'. 1442 # !! ?? run pstops first, and then a2ping.pl 1443 # !! why does a PDF -> PS conversion need $is_restored? 1444 # vvv Dat: `mark' is necessary, because pstops 1.17 from xpdf(1) emits lines 1445 # lines leaving `false' on the stack: 1446 # %%BeginResource: font SKPOPP+LMRoman12-Regular 1447 # %!PS-AdobeFont-1.0: LMRoman12-Regular 0.86 1448 # %%CreationDate: 4th August (Monday) 2003 1449 # % Generated by MetaType1 (a MetaPost-based engine) 1450 # % CM sources: copyright (C) 1997 AMS, all rights reserved; METATYPE1/Type 1 ver 1451 # % ADL: 694 194 112 1452 # %%EndComments 1453 # FontDirectory/LMRoman12-Regular known{/LMRoman12-Regular findfont dup/UniqueID 1454 # /UniqueID get 0 eq exch/FontType get 1 eq and}{pop false}ifelse 1455 # {save true}{false}ifelse}{false}ifelse 1456 my $save=$is_restored?"save mark\n":""; 1457 $bbx.$fontsdefs."%%EndComments\n".$bsetup.$setpagesize.$markpagedevices.$pagedev_mark.$after_correct.$save.$translate 1458} 1459 1460### scan header 1461my $to_OUT=""; 1462my $after_code=""; 1463my $do_fix_tumble=0; 1464my $is_restored=0; 1465if (1<length($header)) { 1466 my($llx,$lly,$urx,$ury); 1467 my($bbtype)='-'; # None 1468 my $allow_adsc_bb=1; 1469 my $after_correct=""; 1470 my $do_bb_line=sub { # sub do_bbline($$) 1471 no integer; 1472 # Decreasing precedence of various BoundingBoxes: 1473 # The last valid *bbox entry has effect. 1474 # Active policy: 1475 # normal mode : BoundingBox ExactBoundingBox HiResBoundingBox 1476 # --hires mode: HiResBoundingBox BoundingBox ExactBoundingBox 1477 # --exact mode: ExactBoundingBox BoundingBox HiResBoundingBox 1478 # -hi -ex mode: ExactBoundingBox HiResBoundingBox BoundingBox 1479 # Another possible policy: 1480 # normal mode : BoundingBox HiResBoundingBox==ExactBoundingBox 1481 # --hires mode: HiResBoundingBox ExactBoundingBox BoundingBox 1482 # --exact mode: ExactBoundingBox HiResBoundingBox BoundingBox 1483 # -hi -ex mode: ExactBoundingBox==HiResBoundingBox BoundingBox 1484 my($S,$from)=@_; 1485 return if $S!~/^(?:$BBregex|set)$BBValues/oi; 1486 # print STDERR "($S)\n"; 1487 my $E1=defined$1 ? $1 : "+"; 1488 my $T=!defined($1) ? 'S' : uc substr $1,0,1; # '' || 'H' || 'E' 1489 # debug "Trying BoundingBox T-$bbtype: $llx $lly $urx $ury"; 1490 if ($T eq 'S' 1491 or !$::opt_hires and !$::opt_exact and ($T eq '' or ($bbtype ne '' and ($T eq 'E' or $bbtype ne 'E'))) 1492 or $::opt_hires and !$::opt_exact and ($T eq 'H' or ($bbtype ne 'H' and ($T eq '' or $bbtype ne ''))) 1493 or $::opt_exact and !$::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq '' or $bbtype ne ''))) 1494 or $::opt_exact and $::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq 'H' or $bbtype ne 'H'))) 1495 ) { 1496 # if ($allow_bb) { 1497 ($bbtype,$llx,$lly,$urx,$ury)=($T,$2+0,$3+0,$4+0,$5+0); 1498 debug "Applying ${E1}BoundingBox$from T-$bbtype: $llx $lly $urx $ury"; 1499 # } 1500 } else { 1501 my @L=($2+0,$3+0,$4+0,$5+0); # convert 0.00 to 0 1502 debug "Ignoring ${E1}BoundingBox$from T-$bbtype: @L"; 1503 } 1504 # Dat: don't do $do_bb_line=sub{};# same as $allow_bb=0; 1505 }; 1506 $header=~s@\r\n?\Z(?!\n)@@; 1507 my $after_comments=""; # after %%EndComments 1508 # my $res; 1509 { my $headEPSF; 1510 my $headPS="PS-Adobe-3.0"; 1511 # vvv Imp: run this correction even w/o input EPS header 1512 if ($header!~s/\s+(EPSF-[.\d]+)$// or $::opt_bboxfrom ne 'guess') { # a PS not an EPS already 1513 # This is the compute-pipe routine. 1514 # To convert an [E]PS to an EPS: 1515 # -- find the end of the 1st page in the code, and remove everything after it 1516 # -- `pop' off the execution stack after the 1st page 1517 # -- `end' the dictionary stack after the 1st page 1518 # -- change the ADSC magic `%!PS-Adobe-...' to `%!PS-Adobe-3.0 EPSF-3.0' 1519 # -- remove the `%%Pages', `%%DocumentPaperSizes', `%%PageOrder:' 1520 # (Ascending) comment from the ADSC header 1521 # -- possibly remove the `%%Page' ADSC comment [no] 1522 # -- ignore calls to = setpage setpagemargin setpageparams .setpagesize 1523 # setpagedevice setpagetype setprintername setresolution a4 letter ... 1524 # -- surround the code by save ... pop* end* restore (implies gsave ... grestore) 1525 # -- possibly ignore calls to showpage [showpage is forced] 1526 $headEPSF=" EPSF-3.0"; 1527 debug "Computing BBox info from non-EPS PS file"; 1528 fix_pipe_in 'i.ps', "%!$headPS\n", 0; 1529 my $tfn=temp_prefix()."c.tgs"; 1530 error "temp open $tfn: $!" unless open F, "> $tfn"; 1531 $tmpfiles{$tfn}=1; 1532 ##print tell(IN)." car=$already_read\n"; 1533 die "$0: $!\n" unless print F "% this is temporary gs command file created by $program".' 1534/DOCUT true def 1535/MAINFILE FN (r) file def 1536/DICTCOUNT countdictstack def 1537count /OPCOUNT exch def 1538<</BeginPage { % <PageCount> BeginPage - 1539 dup 1 eq { 1540 count OPCOUNT sub 1 sub (pop-count==) ..print === 1541 countdictstack DICTCOUNT sub (end-count==) ..print === 1542 DOCUT { (cut-offset==) ..print MAINFILE fileposition === flush } if 1543 (bbox-success\n) ..print 1544 quit 1545 } if 1546 .callbeginpage 1547 } 1548>> setpagedevice 1549 1550% vvv do these after our call to /setpagedevice 1551.currentglobal true .setglobal 1552systemdict begin 1553/..paper.redef<< >>def 1554/..print/print load def 1555/setpageparams{pop pop pop pop (\nset-called-4==/setpageparams\n) ..print flush}def 1556/setpage{pop pop pop (\nset-called-3==/setpage\n) ..print flush}def 1557/setpagesize{pop pop (\nset-called-2==/setpagesize\n) ..print flush}def 1558/.setpagesize{pop pop (\nset-called-2==/.setpagesize\n) ..print flush}def 1559/setpagemargin{pop (\nset-called-1==/setpagemargin\n) ..print flush}def 1560{% anti-Windows-printer-driver `%%[ ProductName:` etc. 1561 dup type/stringtype eq{ 1562 dup length 3 ge{ 1563 dup 0 3 getinterval (%%[) eq{ 1564 (\nset-called-1==/=\n) ..print flush 1565 (\nset-called-1==/print\n) ..print flush 1566 }if}if}if 1567 pop 1568} 1569dup/= exch def /print exch def 1570/setpagedevice{pop (\nset-called-1==/setpagedevice\n) ..print flush}def 1571/..sdict << 1572 /PageSize { % [. .] PageSize - 1573 dup type /arraytype eq { 1574 dup length 2 ge { 1575 dup 0 get type dup /integertype eq exch /realtype eq or { 1576 dup 1 get type dup /integertype eq exch /realtype eq or { 1577 (\npapersize-x==) ..print dup 0 get === 1578 (\npapersize-y==) ..print dup 1 get === (\n) ..print 1579 } if 1580 } if 1581 } if 1582 } if 1583 pop 1584 } 1585 /HWResolution { % [. .] PageSize - 1586 dup type /arraytype eq { 1587 dup length 2 ge { 1588 dup 0 get type dup /integertype eq exch /realtype eq or { 1589 dup 1 get type dup /integertype eq exch /realtype eq or { 1590 (\nresolution-x==) ..print dup 0 get === 1591 (\nresolution-y==) ..print dup 1 get === (\n) ..print 1592 } if 1593 } if 1594 } if 1595 } if 1596 pop 1597 } 1598 /Duplex { % [. .] PageSize - 1599 dup type /booleantype eq { 1600 (\nsides-duplex==) ..print dup === (\n) ..print 1601 } if 1602 pop 1603 } 1604 /Tumble { % [. .] PageSize - 1605 dup type /booleantype eq { 1606 (\nsides-tumble==) ..print dup === (\n) ..print 1607 } if 1608 pop 1609 } 1610>> def 1611%/.setpagesize{pop pop (hehehe\n) print} def 1612% /a4{(hehehe\n) ..print} def % doesn"t work, has to be put into userdict 1613/setpagedevice{ 1614 { % <key> <val> 1615 exch dup ..sdict exch known { % run all keys known in ..sdict 1616 ..sdict exch get exec 1617 } {pop pop} ifelse 1618 } forall 1619 (\nset-called-1==/setpagedevice\n) ..print flush 1620}def 1621/setpagetype{pop (\nset-called-1==/setpagetype\n) ..print flush}def 1622/setprintername{pop (\nset-called-1==/setprintername\n) ..print flush}def 1623/setresolution{pop (\nset-called-1==/setresolution\n) ..print flush}def 1624[ % Dat: fixed at Mon May 19 14:32:31 CEST 2003 1625 statusdict /.pagetypenames 2 copy known {get}{pop pop{}}ifelse 1626 % ^^^ Dat: may be {/a4 STRICT {(%END SIZES) .skipeof} if /a5} 1627 { /11x17/a3/a4/a4small/b5/ledger/legal/letter % GS 7.04 1628 /lettersmall/note/a0/a1/a2/a5/a6/a7/a8/a9/c0/c1/c2/c3/c4/c5/c6 1629 /a10/b0/b1/b2/b3/b4/b5/b6 1630 /isob0/isob1/isob2/isob3/isob4/isob5/isob6 1631 /jisb0/jisb1/jisb2/jisb3/jisb4/jisb5/jisb6 1632 /archE/archD/archC/archB/archA/flsa/flse/halfletter 1633 /tabloid/csheet/dsheet/esheet/executivepage/com10envelope 1634 /monarchenvelope/c5envelope/dlenvelope/folio/quarto 1635 } 1636]{{ 1637 dup type /nametype eq { dup xcheck not { % Dat: fixed 1638 % dup === 1639 dup ..paper.redef exch known {pop} { 1640 dup ..paper.redef exch null put 1641 dup userdict exch 2 copy known { 2 copy get 1642 1 index userdict exch undef 1643 % Stack: /a4 userdict /a4 {...} 1644 % 3 copy pop undef 1645 4 2 roll exch undef 1646 } { exch pop pop {} } ifelse 1647 % Stack: /a4 {595 842 //.setpagesize --exec--} 1648 % Stack: /a4 {595 842 {/statusdict --.systemvar-- --begin-- .setpagesize --end--} --exec--} 1649 { /get exec /pop (\nset-called-0==) ..print === flush } % dump 1650 dup length array copy cvx % make a copy for subsequent invocations 1651 2 copy exch 0 exch put exch pop % change /get to {...} 1652 2 copy exch 2 exch put % change /pop to /a4 1653 def % overwrite it in systemdict 1654 } ifelse 1655 true 1656 } if } if 1657 pop 1658}forall} forall 1659end % systemdict 1660.setglobal 1661systemdict readonly pop 1662 1663(bbox-begin\n) ..print 1664MAINFILE cvx exec 1665(add-showpage==1\n) ..print 1666/DOCUT false def 1667showpage quit 1668'; 1669 die unless close F; 1670 # vvv Imp: make it work on Win32 (no >&1 redirection) 1671 my $gs3=$CGS. # "-dPAGE1QUIT=".($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS' ? 'quit' : '{}'). 1672 " -dWRITESYSTEMDICT -dNOPAUSE -sDEVICE=bbox -sFN=".fnq($InputFilename)." ".fnq($tfn)." 2>&1"; 1673 debug "Ghostscript compute pipe: $gs3"; 1674 my $res=`$gs3`; 1675 ## die $res; 1676 temp_unlink $tfn; 1677 ## print STDERR $res; 1678 error $?==11 ? "segmentation fault in $GS" : "not a GS output from $GS ($?)" 1679 if !defined $res # BUGFIX at Sun Mar 7 18:51:34 CET 2004 1680 or $res!~s/\A(?:\w+ Ghostscript \d|Copyright .* artofcode ).*\n// # AFPL Ghostscript 6.50 (2000-12-02) 1681 or $res!~s/.*?^bbox-begin\n//m; 1682 if ($res!~s/\nbbox-success\n\Z(?!\n)/\n/) { 1683 warning # not `error', mpost(1) `prologues:=0; ... btex fonts' output won't compile 1684 "BBox discovery was not successful"; 1685 # !! continue only if MetaPost output? 1686 goto SKIP_BBOX_DISC; 1687 } 1688 #: Copyright (C) 2000 Aladdin Enterprises, Menlo Park, CA. All rights reserved. 1689 #: This software comes with NO WARRANTY: see the file PUBLIC for details. 1690 #: set-called-0==/a4 1691 #: %%BoundingBox: 56 41 539 783 1692 #: %%HiResBoundingBox: 56.645998 41.849999 538.811984 782.351976 1693 #: pop-count==0 1694 #: end-count==1 1695 #: cut-offset==81898 1696 my $pop_count=0; 1697 my $end_count=0; 1698 my $cut_offset=-1; 1699 my $papersize_x=undef; # page_width 1700 my $papersize_y=undef; # page_height 1701 my $resolution_x=undef; 1702 my $resolution_y=undef; 1703 my $duplexi=0; 1704 my $tumblei=0; 1705 my %H; 1706 my $undefs=""; 1707 my $bbc=0; # required 1708 for my $line (split/\n/, $res) { 1709 if ($line=~/^$BBregex$BBValues/oi) { $do_bb_line->($line," from Compute-GS"); $bbc++ } 1710 elsif ($line=~m@^set-called-(\d+)==/(\S+)$@) { 1711 if (not exists $H{$2}) { 1712 $H{$2}=1; 1713 $undefs.="/$2".( 1714 $1==0 ? "{}def\n" : 1715 $1==1 ? "/pop load def\n" : 1716 "{".("pop "x$1)."}bind def\n" 1717 ); 1718 } 1719 # Dat: Safe, restorable, EPS-wise: /setpagedevice {pop} def 1720 # Dat: Smart, documentwise /a4 dup where{dup wcheck{exch{}put}{pop{}def}ifelse}{pop}ifelse 1721 } 1722 elsif ($line=~/^pop-count==(\d+)$/) { $pop_count=$1+0 } 1723 elsif ($line=~/^end-count==(\d+)$/) { $end_count=$1+0 } 1724 elsif ($line=~/^cut-offset==(\d+)$/) { $cut_offset=$1+0 } 1725 elsif ($line=~/^papersize-x==([-+0-9eE.]+)$/) { no integer; $papersize_x=$1+0 } 1726 elsif ($line=~/^papersize-y==([-+0-9eE.]+)$/) { no integer; $papersize_y=$1+0 } 1727 elsif ($line=~/^resolution-x==([-+0-9eE.]+)$/) { no integer; $resolution_x=$1+0 } 1728 elsif ($line=~/^resolution-y==([-+0-9eE.]+)$/) { no integer; $resolution_y=$1+0 } 1729 elsif ($line=~/^sides-duplex==true$/) { $duplexi=1 } 1730 elsif ($line=~/^sides-dumplex==false$/) { $duplexi=2 } 1731 elsif ($line=~/^sides-tumble==true$/) { $tumblei=1 } 1732 elsif ($line=~/^sides-tumble==false$/) { $tumblei=2 } 1733 elsif ($line=~/^add-showpage==\d+$/) { } # !! 1734 elsif (length($line)==0 or $line=~/^(?:Copyright |This software )/) {} 1735 elsif ($line=~/^Loading (\S+) font from.*[.][.][.]/) { debug "GS builtin font used: $1" } 1736 else { debug "unknown line ($line)" } 1737 } 1738 undef $papersize_y if !defined $papersize_x; 1739 die unless $allow_adsc_bb==1; 1740 # Dat: This only applies when converting fron non-EPS PS: 1741 # Setting $allow_adsc_bb=0|1 now would disallow/allow the %%BoundingBox 1742 # etc. ADSC comment override the bbox computed by -sDEVICE=bbox. 1743 # When converting PS -> EPS, the PS file usually contains 1744 # `%%BoundingBox: 0 0 paperwidth paperheight', but the figure 1745 # itself is smaller. 1746 $bbtype='-'; 1747 ## die "$papersize_x;;"; # PDF -sPAPERSIZE=a4 1748 #if ($::opt_papersize ne 'force-unknown' and $::opt_papersize ne 'unchanged') { 1749 # # override bbox 1750 # ($llx,$lly)=(0,0); 1751 # ($urx,$ury)=split/,/,$::opt_papersize; 1752 #} elsif (!is_page1_stop() and defined $papersize_x and defined $papersize_y) { 1753 #} 1754 debug "PaperSize wd=${papersize_x}bp ht=${papersize_y}bp" if defined $papersize_x; 1755 if ($::opt_papersize eq 'force-unknown' or ($::opt_papersize eq 'unchanged' and !defined $papersize_x)) {} 1756 elsif ($::opt_papersize ne 'unchanged') { 1757 die if is_page1_stop(); 1758 ($papersize_x,$papersize_y)=split/,/,$::opt_papersize; 1759 goto do_force_papersize 1760 } else { 1761 # Dat: no $do_bb_line here, because we've done it with $bbc++, and we'll also do it later 1762 do_force_papersize: 1763 die if is_page1_stop(); 1764 # vvv ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y); 1765 # $do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize"); 1766 $after_correct.="1 dict dup /PageSize [".myceil($papersize_x)." ".myceil($papersize_y)."] put setpagedevice\n"; 1767 # ^^^ Dat: both PS and markedPS would benefit from /PaperSize 1768 # ^^^ Dat: will be put after CorrectBoundingBox 1769 # Dat: unneeded: $allow_adsc_bb=0 if $FileFormat eq 'PDF'; # force this into /CropBox (otherwise only /MediaBox) 1770 } 1771 if (defined $papersize_x and ($::opt_bboxfrom eq 'papersize' or ($::opt_bboxfrom eq 'guess' and is_set_pagesize_ok()))) { 1772 $allow_adsc_bb=0; 1773 $do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize"); # does ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y); 1774 } 1775 $allow_adsc_bb=0 if ($::opt_bboxfrom eq 'compute-gs') ? ($bbc!=0) 1776 : ($::opt_bboxfrom eq 'guess') ? ($bbc!=0 and is_page1_stop()) # Imp: is is_page1_stop() OK here? 1777 : 0; 1778 if (!is_page1_stop()) { 1779 $pop_count=$end_count=0; # assume PS is correct 1780 $cut_offset=-1; 1781 } 1782 # if ($FileFormat ne 'EPS' and $FileFormat ne 'PS') { # device-specific (marked) 1783 # ^^^ Dat: $::opt_resolution and $::opt_duplex are already 'force-unknown' if $FileFormat is appropriate 1784 { 1785 $::opt_resolution=$resolution_x.','.$resolution_y if 1786 $::opt_resolution eq 'unchanged' and defined $resolution_x and defined $resolution_y; 1787 1788 # vvv Imp: move down like $::opt_resolution 1789 if ($::opt_duplex eq 'force-unknown' or ($::opt_duplex eq 'unchanged' and $duplexi==0)) { $do_fix_tumble=($duplexi==1 && $tumblei==1) } 1790 elsif ($::opt_duplex eq 'force-simplex') { do_simplex: $after_correct.="1 dict dup /Duplex false put setpagedevice\n" } 1791 elsif ($::opt_duplex eq 'force-long' ) { do_long: $after_correct.="2 dict dup /Duplex true put dup /Tumble false put setpagedevice\n" } 1792 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" } 1793 else { 1794 $duplexi ||= $::opt_duplex eq 'default-simplex' ? 2 : 1; 1795 $tumblei ||= $::opt_duplex eq 'default-short' ? 1 : 2; 1796 goto do_simplex if $duplexi!=1; 1797 goto do_long if $tumblei!=1; 1798 goto do_short; 1799 } 1800 } 1801 # vvv Dat: save...restore is _always_ necessary to undo the changes made 1802 # by the file itself (??) 1803 # vvv BUGFIX (only EPS) at Tue Feb 8 21:40:11 CET 2005 1804 # vvv Dat: now with PS output it is possible that garbage is left on 1805 # the stack (see the `LMRoman' example above) 1806 $is_restored=1 if $FileFormat eq'EPS' or $FileFormat eq'markedEPS'; 1807 $after_comments.=$undefs; # after our precious setpagedevice calls 1808 # debug "pop_count=$pop_count;"; 1809 # debug "end_count=$end_count;"; 1810 # debug "cut_offset=$cut_offset;"; 1811 $after_code.=("pop\n"x$pop_count).("end\n"x$end_count); 1812 if ($cut_offset>=0 and ($bytes_left==-1 or $cut_offset<$bytes_left)) { 1813 $bytes_left=$cut_offset-$already_read; 1814 ##print tell(IN)." ar=$already_read\n"; 1815 debug "Cutting after showpage at $cut_offset -> $bytes_left"; 1816 # ^^^ Dat: cutting after `showpage' makes PS -> EPS conversion easy 1817 # sleep 1000; 1818 } 1819 # Dat: don't unlink $tifn yet, we'll continue scanning it 1820 # Imp: verify EPS created 1821 } else { $headEPSF=" $1" } 1822 SKIP_BBOX_DISC: 1823 if ($::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'unchanged') {} 1824 else { $after_correct.="1 dict dup /HWResolution [@{[split/[x,]/,$::opt_resolution]}] put setpagedevice\n" } 1825 # ^^^ Dat: syntax already ok for $::opt_resolution 1826 $after_correct.="2 dict dup /TextAlphaBits 4 put dup /GraphicsAlphaBits 4 put setpagedevice\n" if 1827 $::opt_antialias eq 'yes' or $::opt_antialias eq 'scale3yes'; 1828 1829 $headEPSF="" if $FileFormat ne 'EPS' and $FileFormat ne 'markedEPS'; 1830 $headPS=$1 if $header=~s/(PS-Adobe-[.\d]+)$//; 1831 $to_OUT.="%!$headPS$headEPSF\n"; 1832 } 1833 1834 debug "Scanning header for BoundingBox"; 1835 my $do_atend=0; 1836 my $doing_atend=0; 1837 my $saved_pos; 1838 my $saved_bytes_left; 1839 my $creator_metapost_p=0; # HiResBoundingBox: after EndProlog 1840 my $creator_adobeps_p=0; 1841 my $had_pages=is_page1_stop(); # Dat: don't put `Pages:' to target EPS 1842 my $fontsdefs=""; 1843 my %fontsnames; 1844 my @creator; 1845 read_again: while (length($_=readIN)) { 1846 #print STDERR "(($_))\n"; 1847 ### end of header 1848 next unless /\S/; 1849 y@\r@@d; chomp; 1850 if (!$doing_atend) { 1851 if (/^%%EndComments\b/i) { 1852 # Dat: EPSI created by ImageMagick has BeginDefaults+EndDefaults+BeginPreview 1853 # Dat: PS output by ADOBEPS4.DRV has BeginDefaults+PageBoundingBox+ViewingOrientation+PageFeatures+EndDefaults 1854 1 while length($_=readIN) and !/\S/; 1855 if (!/^%%BeginDefaults\b/i) { y@\r@@d; chomp; $after_comments.="$_\n"; last } 1856 1 while length($_=readIN) and !/\S/; 1857 if (!/^%%EndDefaults\b/i) { y@\r@@d; chomp; $after_comments.="%%BeginDefaults\n$_\n"; last } 1858 next 1859 } elsif (/^%%EndDefaults\b/i) { # EPSI created by ImageMagick 1860 } elsif (/^%%Creator:\s*ADOBEPS/i) { # ADOBEPS4.DRV 1861 # Emits ``%%BoundingBox 1 1 ...' instead of `0 0' 1862 $creator_adobeps_p=1; 1863 } elsif (/^%%Creator:\s*MetaPost\b/i) { 1864 $creator_metapost_p=1; 1865 } elsif ((substr($_,0,2)ne'%%' and substr($_,0,7)ne'%*Font:' and 1866 substr($_,0,5)ne'%ADO_' and !/^%AI\d_/ # Dat: %ADO_DSC_..., %AI7_Thumbnail 1867 and substr($_,0,5)ne'%EPS ') # epsincl.mp 1868 or !$creator_metapost_p and substr($_,0,5)eq'%%End' 1869 or /^%%Begin(?:Prolog|Setup)\b/i 1870 ) { $after_comments.="$_\n"; last } 1871 } 1872 if (/^%%BeginPreview\b/i) { # remove EPSI preview ballast ****pts**** 1873 while (1) { 1874 error "Missing EPSI %%EndPreview" if !length($_=readIN); 1875 last if /^%%EndPreview\b/; 1876 y@\r@@d; chomp 1877 } 1878 } elsif (/^%%Creator:\s*(.*)/i) { 1879 push @creator, $1; 1880 $creator[-1]=~s@\s+\Z(?!\n)@@; 1881 $creator[-1]=~s@, a2ping .*@@; # remove old 1882 } elsif (/^%%(?:DocumentPaperSizes|PageOrder|DocumentMedia):/i) { 1883 # silently ignore these -- will be recalculated 1884 } elsif (/^%%Pages:\s+(\d+)\s*/i and !$had_pages) { # Not `%%Pages: (atend)' 1885 # Dat: don't `$do_atend=1' only for %%Pages 1886 $to_OUT.="$_\n"; $had_pages=1 1887 } elsif (/^%%Pages:/i) { 1888 # silently ignore these -- not significant for EPS 1889 } elsif (/^$BBregex$BBValues/oi) { ### BoundingBox with values 1890 s@($BBregex)\s*1\s+1\s+@$1 0 0 @ if $creator_adobeps_p; 1891 # vvv $bbtype may be possibly already set by compute-gs 1892 if ($allow_adsc_bb) { 1893 $do_bb_line->($_," from ADSC"); 1894 if ($force_hiresbbox_value) { 1895 $do_bb_line->("%%HiResBoundingBox: $force_hiresbbox_value"," from ADSC"); 1896 } 1897 } 1898 } elsif (/^$BBregex\s*\(atend\)/oi) { 1899 ### BoundingBox with (atend) 1900 debug "At end $1BoundingBox"; 1901 # warning "Cannot look for BoundingBox in the trailer with option --filter" if $::opt_filter; 1902 # ^^^ Dat: may be seekable anyway, omit warning 1903 $do_atend=1 1904 } elsif (/^%%Page:/i and !$creator_metapost_p) { # at Thu Sep 25 15:59:52 CEST 2003 1905 $after_comments.="$_\n"; last 1906 } elsif (/^%(?:ADO_DSC_|AI\d_)/) { # Dat: example: %ADO_DSC_Encoding: MacOS Roman 1907 $to_OUT.="%$_\n"; 1908 } elsif (/^%\*Font:\s+(\S+)\s+/) { # mpost(1) output 1909 ## debug $_; 1910 $fontsdefs.="$_\n"; # put in front (before `gsave ... translate') 1911 $fontsnames{$1}=1; 1912 } elsif (substr($_,0,5) eq '%EPS ') { # epsincl.mp 1913 $after_correct.="$_\n" if !$doing_atend; # before `gsave' 1914 } elsif ($doing_atend or /^%%End/) { 1915 # we might be in mid-line 1916 } else { 1917 $to_OUT.="$_\n" 1918 } 1919 } 1920 if ($doing_atend) { # already read (atend); restore file position 1921 seek(IN, $saved_pos, 0) or error "Input unseekable, cannot go back to line `: (atend)'"; 1922 $bytes_left=$saved_bytes_left; 1923 } elsif ($do_atend) { # seek to near EOF and try again 1924 # error "Cannot leave line `: (atend)'" if ($saved_pos=tell IN)<0 or !seek(IN,0,1); 1925 fix_pipe_in "j.ps", $to_OUT, 0; 1926 die if ($saved_pos=tell IN)<0; 1927 $saved_bytes_left=$bytes_left; 1928 # vvv get the very last *BoundingBox entry from the last 4096 bytes 1929 if ($bytes_left>4096) { 1930 die unless seek(IN, $bytes_left-4096, 1); 1931 $bytes_left=4096; 1932 } elsif ($bytes_left<0) { 1933 die unless seek(IN, -4096, 2) or seek(IN, 0,0); # Dat: 0,0 for short files 1934 } 1935 $doing_atend=1; goto read_again; 1936 } 1937 # if (!$had_pages) { debug "Lying %%Pages: 1"; $to_OUT.="%%Pages: 1\n" } 1938 # ^^^ Dat: rather not lie !! go to (atend) if command line 1939 # vvv Dat: $bbtype ne'-' would be a bad idea 1940 warning "BoundingBox not found, try --bboxfrom=compute-gs" if !defined $llx; # !! compute-gs 1941 push @creator, "$program $Htex::a2ping::VERSION"; # if "@creator"!~/\ba2ping\b/; 1942 $to_OUT.="%%Creator: ".join(", ",@creator)."\n"; # before CorrectBoundingBox to be before `gsave' etc. 1943 $to_OUT.=CorrectBoundingBox $llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored; 1944 $to_OUT.=$after_comments; 1945 if (%fontsnames) { # !! save .. restore 1946 $to_OUT.="{@{[sort keys%fontsnames]}}{\ndup where{pop pop}{cvlit dup def}ifelse}forall\n"; 1947 $to_OUT.="/fshow where{pop}{/fshow{exch findfont exch scalefont setfont show}bind def}ifelse\n"; 1948 } 1949} 1950 1951### open output file or pipe (do this as late as possible) 1952my $do_scale3_pnm=0; 1953my $scale3_pnm_fn; 1954my @pnm2sampled_cmd; 1955if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') { 1956 my $ofn=$ll_zero ? $OutputFilename : fix_pipe_out('.pdf'); 1957 my $pipe = "$GS -q -dBATCH -sDEVICE=pdfwrite $GSOPTS -sOutputFile=".fnq($ofn)." -"; 1958 debug "Ghostscript ps2pdf pipe:", $pipe; 1959 open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe"; 1960} elsif ($FileFormat eq 'PCL5') { 1961 my $ofn=$do_fix_tumble ? fix_pipe_out('.pcl5') : $OutputFilename; 1962 # vvv ljet4 cannot do duplex, ljet4d can 1963 my $pipe = "$GS -q -dBATCH -sDEVICE=ljet4d $GSOPTS -sOutputFile=".fnq($ofn)." -"; 1964 debug "Ghostscript ps2ljet pipe:", $pipe; 1965 open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe"; 1966} elsif ($FileFormat eq 'PBM' or $FileFormat eq 'PGM' or $FileFormat eq 'PPM' 1967 or is_via_sam2p()) { 1968 $do_scale3_pnm=($::opt_antialias eq'scale3no' or $::opt_antialias eq 'scale3yes'); 1969 my $device=$FileFormat eq 'PPM' || is_via_sam2p() ? 'ppmraw' : 1970 $FileFormat eq 'PBM' && $::opt_antialias eq 'no' ? 'pbmraw' : 'pgmraw'; 1971 # Dat: -sDEVICE=pgm is ASCII, pgmraw is binary 1972 my $pipe ="$GS -q -dBATCH -sDEVICE=$device "; 1973 # $pipe.="-dTextAlphaBits=4 -dGraphicsAlphaBits=4 " if $::opt_antialias; # Dat: already done 1974 my $ofn=$OutputFilename; 1975 if (is_via_sam2p()) { 1976 # Dat: fortunately the following file format names are commin in sam2p(1) 1977 # and a2ping.pl: PNG XWD BMP TIFF JPEG GIF XPM 1978 @pnm2sampled_cmd=('sam2p',"$FileFormat:",'--'); # Imp: use convert(1) if no sam2p(1) 1979 $ofn=fix_force_out('SS.pnm'); 1980 push @pnm2sampled_cmd, $ofn, $OutputFilename; 1981 } 1982 if ($do_scale3_pnm) { 1983 $scale3_pnm_fn=$ofn; 1984 $ofn=fix_force_out('S3.pnm') if $do_scale3_pnm; 1985 # ^^^ Dat: this must be the last call to fix_force_out() 1986 } 1987 $pipe.="$GSOPTS -sOutputFile=".fnq($ofn)." -"; 1988 debug "Ghostscript ps2raster pipe:", $pipe; 1989 open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe"; 1990} else { open_OUT() } 1991 1992my $unlink_OutputFilename; 1993END { unlink $unlink_OutputFilename if defined $unlink_OutputFilename } 1994$unlink_OutputFilename=$OutputFilename; 1995 1996die unless binmode OUT; 1997#die $to_OUT; 1998# !! remove setpagedevice from EPS->EPS, but keep EPS->PGM 1999# vvv needed by EPS->PGM conversion !! 2000if (is_need_showpage() and is_page1_stop()) { 2001 $to_OUT.="/showpage{showpage quit}bind def\n"; # don't call showpage twice 2002 $after_code.="showpage\n"; 2003} 2004error "write OUT" if !print OUT $to_OUT; 2005$to_OUT=""; 2006 2007### print rest of file 2008sub OVERLAP_LENGTH(){4096} # `%%TrailerLength: 1162' by ADOBEPS4.DRV 2009my $extra_trailer="%%Trailer\n"; 2010##undef $unlink_OutputFilename; die; 2011{ my $overlap=""; # keeps OVERLAP_LENGTH chars 2012 my $S; 2013 # print OUT while length($_=readIN 4096); 2014 while (length($S=readIN 4096)) { # Dat: 4096>=OVERLAP_LENGTH 2015 #if (length($S)<OVERLAP_LENGTH) { $S="$overlap$S"; $overlap=""; } 2016 #die if length($S)<OVERLAP_LENGTH; # happens sometimes 2017 #print OUT $overlap, substr($S,0,length($S)-OVERLAP_LENGTH()); 2018 #$overlap=substr($S,-OVERLAP_LENGTH(),OVERLAP_LENGTH); 2019 next if length($overlap.=$S)<OVERLAP_LENGTH; 2020 print OUT substr($overlap,0,length($overlap)-OVERLAP_LENGTH()); 2021 $overlap=substr($overlap,-OVERLAP_LENGTH()); 2022 } 2023 if ($overlap=~s@\r?\n%%Trailer\r?\n(.*?)\Z(?!\n)@\n%%Trailer\n@s) { 2024 my $S=$1; 2025 $S=~y@\r@@d; 2026 $S=~s@\n%%TrailerLength:.*$@@m; # ADOBEPS4.DRV 2027 $overlap.=$S; 2028 $extra_trailer=""; 2029 } 2030 $overlap=~s@(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]*\Z(?!\n)@@; 2031 # vvv Dat: would move %%Trailer after dvips output `end userdict /end-hook known{end-hook}if' 2032 # $overlap=~s@(?:[\n\r\0\f]+%%Trailer)?(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]+\Z(?!\n)@@; 2033 print OUT $overlap; 2034} 2035 2036### close files 2037error "closing IN: $?" unless close IN; 2038# ^^^ SUXX: gs always exit(0), if exists 2039# vvv Dat: $after_code is pop+end 2040print OUT "\n$extra_trailer$after_code", 2041 ("grestore\n"x$need_grestore), 2042 ("cleartomark restore\n"x$is_restored), 2043 "%%EOF\n"; 2044error "closing gs filter: $? $!" unless close OUT; 2045 2046# --- PNM scaling routines for --antialias=scale3* 2047 2048sub pnm_gettok($) { 2049 my ($fh,$S,$C)=($_[0],""); 2050 while (1) { 2051 die "unexpected EOF" if !defined($C=getc($fh)); 2052 if ($C eq'#') { <$fh> } # ignore rest of line 2053 elsif ($C=~y@ \n\r\t@@) { last if length($S)!=0 } 2054 else { $S.=$C } 2055 } 2056 $S 2057} 2058 2059my @div9=(0,0,0,0,0,map { $_, $_, $_, $_, $_, $_, $_, $_, $_ } 1..255, 255); 2060 2061#** @param $_[0] length always divisible by 3 2062sub p5_avg_lines($$$$) { 2063 use integer; 2064 my $len=length($_[0]); 2065 my $olen=$len/3; 2066 while ($len>0) { 2067 vec($_[3],--$olen,8)=$div9[ 2068 vec($_[0],$len-1,8)+vec($_[0],$len-2,8)+vec($_[0],$len-3,8)+ 2069 vec($_[1],$len-1,8)+vec($_[1],$len-2,8)+vec($_[1],$len-3,8)+ 2070 vec($_[2],$len-1,8)+vec($_[2],$len-2,8)+vec($_[2],$len-3,8)]; 2071 $len-=3; 2072 } 2073} 2074 2075#** @param $_[0] length always divisible by 9 2076sub p6_avg_lines($$$$) { 2077 # Imp: why is it lighter than: convert -scale '33.3333%' a3.pbm a3r.pgm 2078 use integer; 2079 my $len=length($_[0]); 2080 my $olen=$len/3; 2081 while ($len>0) { 2082 vec($_[3],--$olen,8)=$div9[ 2083 vec($_[0],$len-1,8)+vec($_[0],$len-4,8)+vec($_[0],$len-7,8)+ 2084 vec($_[1],$len-1,8)+vec($_[1],$len-4,8)+vec($_[1],$len-7,8)+ 2085 vec($_[2],$len-1,8)+vec($_[2],$len-4,8)+vec($_[2],$len-7,8)]; 2086 $len-=6 if 0==--$len%3; 2087 } 2088} 2089 2090# --- 2091 2092if (!$ll_zero and ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1')) { # correct /MediaBox if not (0,0)-based 2093 ### ****pts**** remove incorrect /MediaBox produced by gs 2094 my $tfn=temp_prefix()."p.tgs"; 2095 error "temp open $tfn: $!" unless open F, "> $tfn"; 2096 $tmpfiles{$tfn}=1; 2097 # vvv Dat: doesn't work with gs 8.53: Error: /undefined in readxrefentry 2098 die unless print F "% this is temporary gs command file created by $program".' 2099 GS_PDF_ProcSet begin 2100 pdfdict begin 2101 FN (r) file pdfopen begin 2102 % vvv keep file offsets, because `pdffindpageref` overrides it with contents 2103 /OFT Objects 0 get dup length array copy def 2104 % vvv Dat: the generation number is assumed to be 0 2105 % vvv Dat: modifies Objects[0] 2106 1 pdffindpageref 0 get 2107 Objects 0 OFT put 2108 %=== 2109 %print_xref 2110 { readxrefentry } stopped { Objects exch lget } if 2111 === 2112 currentdict pdfclose end end end 2113 '; 2114 die unless close F; 2115 2116 my $gs2="$GS -dNODISPLAY -dBATCH -sFN=".fnq(fix_pipe_out(undef))." -q ".fnq($tfn); 2117 debug "Ghostscript dup pipe: $gs2"; 2118 my $offset=`$gs2`; 2119 #die $offset; 2120 chomp $offset; 2121 temp_unlink $tfn; 2122 if ($offset=~/\A\d+\Z(?!\n)/) { 2123 # Dat: now $offsets is a file position containing our /Page object 2124 die unless open F, "+< ".fix_pipe_out(undef); 2125 die unless binmode F; 2126 die unless seek F, $offset+=0, 0; 2127 my $pageobj; 2128 die unless 32<read F, $pageobj, 4096; 2129 if ($::opt_keepoldmediabox) { 2130 if ($pageobj=~m@\A(.*?/Type\s*/Page\b.*?/MediaBox\s*\[0 0 [^\]]*\].*?)((?:/CropBox\s*\[[^\]]+\]\s*)?/MediaBox\s*\[[^\]]+\])@s) { 2131 substr($pageobj, length($1), length($2))=" "x length($2); 2132 # ^^^ overwrite first buggy /MediaBox definition with spaces 2133 die unless seek F, $offset, 0; 2134 die unless print F $pageobj; 2135 debug "new /MediaBox destroyed."; 2136 } else { 2137 debug "warning: double /MediaBox not found at $offset"; 2138 } 2139 } else { 2140 if ($pageobj=~m@\A(.*?/Type\s*/Page\b.*?)(/MediaBox\s*\[0 0 [^\]]*\]).*?/MediaBox\b@s) { 2141 substr($pageobj, length($1), length($2))=" "x length($2); 2142 # ^^^ overwrite first buggy /MediaBox definition with spaces 2143 die unless seek F, $offset, 0; 2144 die unless print F $pageobj; 2145 debug "old /MediaBox destroyed."; 2146 } else { 2147 debug "warning: double /MediaBox not found at $offset"; 2148 } 2149 } 2150 die unless close F; 2151 } else { 2152 debug "warning: gs failed to locate double /MediaBox"; 2153 } 2154} 2155if ($FileFormat eq 'PCL5' and $do_fix_tumble) { 2156 # stupid Ghostscript ignores /Tumble true with -sDEVICE=ljet4 2157 # 2 dict dup /Duplex true /Tumble false put setpagedevice % long HP PCL5e "\033&l1S" 2158 # 2 dict dup /Duplex true /Tumble true put setpagedevice % short HP PCL5e "\033&l2S" 2159 # 2 dict dup /Duplex false /Tumble false put setpagedevice % simplex HP PCL5e "\033&l0S" 2160 # HP PCL5e gs header "\033E\033&l2A\033&l1S\033&l0o0l0E\033&l-180u36Z" 2161 die unless open F, "+< ".fix_pipe_out(undef); 2162 die unless binmode F; 2163 my $pageobj; 2164 die unless 32<read F, $pageobj, 4096; 2165 if ($pageobj=~s@\033&l1S.*@\033&l2S@s) { 2166 die unless seek F, 0, 0; 2167 die unless print F $pageobj; 2168 debug "fixed /Tumble true (short)."; 2169 } elsif ($pageobj=~m@\033&l0S@) { 2170 debug "no need to fix to /Tumble."; 2171 } else { 2172 debug "warning: /Duplex /Tumble settings not found" 2173 } 2174 die unless close F; 2175} 2176if ($do_scale3_pnm) { 2177 # Imp: scale down the file in place, ovoid early overwrite 2178 # Imp: possibly call an external C program that is faster 2179 debug "Scaling down PNM by 3x3"; 2180 die unless open F, "> $scale3_pnm_fn"; 2181 die unless binmode F; 2182 die unless open FIN, "< ".fix_pipe_out(undef); 2183 my $hd; 2184 die "PNMraw expected\n" if read(FIN,$hd,2)!=2 or $hd!~/\AP[456]/; 2185 my $wd=pnm_gettok(*FIN); die "width expected\n" if $wd!~/\A(\d+)\Z(?!\n)/; 2186 my $wd3=$hd eq 'P4' ? ($wd+7)>>3 : $hd eq 'P5' ? $wd : $wd*3; # bw/grayscale/RGB 2187 my $ht=pnm_gettok(*FIN); die "height expected\n" if $ht!~/\A(\d+)\Z(?!\n)/; 2188 if ($hd ne 'P4') { 2189 my $mx=pnm_gettok(*FIN); die "max==255 expected, got: $mx\n" if $mx ne '255'; 2190 } 2191 $wd+=0; $ht+=0; 2192 { use integer; 2193 my $phd=($hd eq 'P5' and $FileFormat eq 'PBM') ? "P4 ".(($wd+2)/3)." ".(($ht+2)/3)."\n" 2194 : ($hd eq 'P6' ? 'P6' : 'P5')."\n# reduced-3x3\n". 2195 (($wd+2)/3)." ".(($ht+2)/3)." 255\n"; 2196 die if !print F $phd; 2197 } 2198 2199 my($l1,$l2,$l3); 2200 my $ret=""; 2201 if ($hd eq 'P4') { 2202 while ($ht>0) { 2203 die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3; 2204 if (--$ht==0) { $l2=$l1 } 2205 else { 2206 die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3; 2207 if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight 2208 else { $ht--; 2209 die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3; 2210 } 2211 } 2212 $l1=unpack("B$wd",$l1); $l1=~y@10@\000\377@; $l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0; 2213 $l2=unpack("B$wd",$l2); $l2=~y@10@\000\377@; $l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0; 2214 $l3=unpack("B$wd",$l3); $l3=~y@10@\000\377@; $l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0; 2215 p5_avg_lines($l1, $l2, $l3, $ret); 2216 die if !print F $ret; 2217 } 2218 } elsif ($hd eq 'P5') { 2219 while ($ht>0) { 2220 die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3; 2221 $l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0; 2222 if (--$ht==0) { $l2=$l1 } 2223 else { 2224 die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3; 2225 $l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0; 2226 if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight 2227 else { $ht--; 2228 die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3; 2229 $l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0; 2230 } 2231 } 2232 p5_avg_lines($l1, $l2, $l3, $ret); 2233 if ($FileFormat eq 'PBM') { 2234 my $I=length($ret); 2235 while ($I--) { vec($ret,$I,8)=vec($ret,$I,8)<$::opt_threshold } # [\0\1] 2236 # ^^^ grayscale>=$::opt_threshold will be white 2237 $ret=pack"B".length($ret),$ret; 2238 } 2239 die if !print F $ret; 2240 } 2241 } elsif ($hd eq 'P6') { 2242 while ($ht>0) { 2243 die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3; 2244 $l1.=substr($l1,-9+length($l1)%9) if length($l1)%9!=0; 2245 if (--$ht==0) { $l2=$l1 } 2246 else { 2247 die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3; 2248 $l2.=substr($l2,-9+length($l2)%9) if length($l2)%9!=0; 2249 if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight 2250 else { $ht--; 2251 die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3; 2252 $l3.=substr($l3,-9+length($l3)%9) if length($l3)%9!=0; 2253 } 2254 } 2255 p6_avg_lines($l1, $l2, $l3, $ret); 2256 die if !print F $ret; 2257 } 2258 } 2259 die unless close F; 2260 temp_unlink $temp_out_fn; 2261 undef $temp_out_fn; 2262} 2263if (@pnm2sampled_cmd) { # $scale3_pnm_fn -> $OutputFilename 2264 do_system @pnm2sampled_cmd; # Dat: uses @extra -- really share that? 2265 temp_unlink $scale3_pnm_fn; 2266} else { # BUGFIX for `a2ping.pl -v --antialias=no negyzet.eps negyzet.png' at Wed Jul 20 21:34:29 CEST 2005 2267 fix_close_out(); 2268} 2269undef $unlink_OutputFilename; 2270if ($OutputFilename eq '-') { 2271 debug "Done OK, stdout is $FileFormat" 2272} elsif (-f $OutputFilename) { 2273 debug "Done OK, created $FileFormat file $OutputFilename (".(-s _)." bytes)"; 2274} else { 2275 error "missing $OutputFilename" 2276} 2277just::end __END__ 2278 2279Dat: `=item * foo' is wrong, puts big space between `*' and `foo' 2280 2281=begin man 2282 2283.ds pts-dev \*[.T] 2284.do if '\*[.T]'ascii' .ds pts-dev tty 2285.do if '\*[.T]'ascii8' .ds pts-dev tty 2286.do if '\*[.T]'latin1' .ds pts-dev tty 2287.do if '\*[.T]'nippon' .ds pts-dev tty 2288.do if '\*[.T]'utf8' .ds pts-dev tty 2289.do if '\*[.T]'cp1047' .ds pts-dev tty 2290.do if '\*[pts-dev]'tty' \{\ 2291.ll 79 2292.pl 33333v 2293.nr IN 2n 2294.\} 2295.ad n 2296 2297=end 2298 2299=head1 NAME 2300 2301a2ping.pl -- convert between PS, EPS and PDF and other page description 2302formats 2303 2304=head1 SYNOPSIS 2305 2306Z<> B<a2ping.pl> [B<-->]B<help> 2307 B<a2ping.pl> [B<-->]B<doc> 2308 B<a2ping.pl> [I<options>] <I<inputfile>> [[I<outformat>:] I<outputfile>] 2309 2310=head1 DESCRIPTION 2311 2312B<a2ping> is a UNIX command line utility written in Perl that 2313converts many raster image and vector graphics formats to EPS or PDF and 2314other page description formats. Accepted input file formats are: PS 2315(PostScript), EPS, PDF, PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX, 2316TGA. Accepted output formats are: EPS, PCL5, PDF, PDF1, PBM, PGM, PPM, 2317PS, markedEPS, markedPS, PNG, XWD, BMP, TIFF, JPEG, GIF, XPM. 2318B<a2ping> delegates the low-level work to 2319Ghostscript (GS), B<pdftops> and B<sam2p>. B<a2ping> fixes many glitches 2320during the EPS to EPS conversion, so its output is often more compatible 2321and better embeddable than its input. 2322 2323Without the C<--below> option, it is guarenteed to start at the 0,0 2324coordinate. C<--below>, C<--hires> and C<-v> are recommended options. 2325 2326The page size is set exactly corresponding to the BoundingBox. 2327This means that when Ghostscript renders it, the result needs no 2328cropping, and the PDF MediaBox is correct. 2329 2330If the bounding box is not right, of course, you have problems. If you 2331feed crap in, you get crap. But you can supply the 2332B<--bboxfrom=compute-gs> option to make GS recompute the bounding box. 2333 2334The name of the input file doesn't matter -- B<a2ping> detects the file 2335format based on the first few bytes of the file. The name of the output 2336file matters if I<outformat> is missing from the command line: then the 2337extension of the output file determines the FileFormat (I<outformat>). 2338 2339=head1 EXTERNAL PROGRAMS 2340 2341The internal file format of B<a2ping.pl> is PS/EPS. Everything read is 2342first converted to PS or EPS, then processed by B<a2ping.pl>, then 2343converted to the output format. 2344 2345To analyse the bounding box and other properties of non-EPS PS files 2346(and EPS files with option B<--bboxfrom> other than B<=guess>), GS is 2347used. Converting PS to EPS involves this analysis. 2348 2349To write PDF files, GS is used. 2350 2351To read PDF files, B<pdftops> from the B<xpdf> package is used. 2352 2353Sampled input formats are PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX 2354and TGA. To read sampled input formats, B<sam2p> is used. B<sam2p> is 2355a raster image converter written in C++ by the author of B<a2ping.pl>. 2356 2357Extra output formats are PNG, XWD, BMP, TIFF, JPEG, GIF and XPM. To 2358write extra output formats, B<sam2p> and GS are used. 2359 2360PNM output formats are PGM, PGM and PPM. To write PNM output formats, GS 2361is used. 2362 2363 2364=head1 TIPS AND TRICKS 2365 2366=over 2 2367 2368=item * 2369 2370Call with the B<-v> option to see progress and debug messages. 2371 2372=item * 2373 2374If your EPS contains a wrong bounding box, you can fix it by running 2375C<a2ping.pl -v --bboxfrom=compute-gs thefile.eps --> 2376 2377=item * 2378 2379You can specify B<-> as I<inputfile> to get stdin and as I<outputfile> 2380to get stdout. This works even for PDF files (which must be seekable), 2381because B<a2ping> copies them to a temporary file automatically. 2382 2383=item * 2384 2385If I<inputfile> and I<outputfile> are the same, B<a2ping> copies the 2386I<inputfile> to a temporary location first. However, this usage is 2387recommended only if there is a backup of the file to be restored in case 2388B<a2ping> doesn't produce the desired result. 2389 2390=item * 2391 2392If you specify B<--> as I<outputfile>, it will be the same as I<inputfile>. 2393 2394=item * 2395 2396B<a2ping> respects B<--Duplex> for FileFormat PCL5, even though GS doesn't. 2397 2398=item * 2399 2400If you have an incompatible PS that GS can read but your printer cannot print, 2401just run C<a2ping.pl foo.ps PDF: - | a2ping.pl - PS: foo.ps> 2402 2403=item * 2404 2405If you have a PS coming from Win32 (often with extension C<.prn>), run 2406it through B<a2ping>. It will remove the resolution changes and the 2407progress text printed to the terminal (which confuses gv(1) and makes 2408some filters in the print queue emit incorrect output). 2409 2410=item * 2411 2412B<a2ping> does antialiasing (B<--antialias=scale3no>) of glyphs and 2413curves when emitting a sampled image (FileFormats such as PGM and PPM). 2414This improves readability of the glyphs. B<=yes> instructs GS to do 2415internal antialiasing, but it usually doesn't improve much. B<=scale3no> 2416turns off GS internal antialiasing, but makes it render everything 3x3 2417as big, and then scales it back down. B<=scale3no> turns on both 3x3 2418scaling and GS internal antialiasing, which results in thicker lines and 2419worse quality in general. 2420 2421=item * 2422 2423When creating a PBM file, antialiasing usually doesn't improve the 2424quality, so it is switched off by default. But if you set 2425B<--antialias=scale3no> or B<--antialias=scale3yes>, GS will render a PGM file, 2426and the value of B<--threshold> determines the minimum intensity for white in 2427the final PBM. 2428 2429=item * 2430 2431If you need a bigger sampled output file, specify a larger 2432B<--Resolution>. The default is B<--Resolution=72>. If your sampled output file 2433is going to be really big, you should specify B<--AntiAlias=yes> instead of 2434the default B<--AntiAlias=scale3no> to speed up conversion. 2435 2436=back 2437 2438 2439=head1 MISC 2440 2441=over 2 2442 2443=item * 2444 2445Doesn't depend on the filename or extension of the input file. 2446 2447=item * 2448 2449Conversion from EPS to PDF: fixes glitches etc., calls gs 2450-sDEVICE=pdfwrite 2451 2452=item * 2453 2454Conversion from EPS to EPS: fixes various glitches, moves (llx,lly) to 2455(0,0), removes binary junk from the beginning of the EPS etc. 2456 2457=item * 2458 2459Conversion from PDF to PDF: keeps the file intact 2460 2461=item * 2462 2463Conversion from PDF to EPS: calls pdftops -eps (of the xpdf package) 2464 2465=item * 2466 2467Conversion from PS to EPS: keeps 1st page only, removes setpagedevice etc. 2468 2469=back 2470 2471=head1 AUTHORS 2472 2473The author of B<a2ping> is Szab� P�ter <F<pts@fazekas.hu>>. 2474 2475B<a2ping> is inspired by and historically based on the B<epstopdf> Perl 2476script modified by Thomas Esser, Sept. 1998, but his modifications have 2477been removed from B<a2ping>, and also B<a2ping> and B<epstopdf> do not 2478share common code anymore. B<epstopdf> is written by Sebastian Rahtz, 2479for Elsevier Science. B<epstopdf> contained extra tricks from Hans Hagen's 2480texutil. 2481 2482=head1 HISTORY 2483 2484=head2 1999/05/06 v2.5 (Heiko Oberdiek) 2485 2486 * New options: --hires, --exact, --filter, --help. 2487 * Many cosmetics: title, usage, ... 2488 * New code for debug, warning, error 2489 * Detecting of cygwin perl 2490 * Scanning for %%{Hires,Exact,}BoundingBox. 2491 * Scanning only the header in order not to get a wrong 2492 BoundingBox of an included file. 2493 * (atend) supported. 2494 * uses strict; (earlier error detecting). 2495 * changed first comment from '%!PS' to '%!'; 2496 * corrected (atend) pattern: '\s*\(atend\)' 2497 * using of $bbxpat in all BoundingBox cases, 2498 correct the first white space to '...Box:\s*$bb...' 2499 * corrected first line (one line instead of two before 'if 0;'; 2500 2501=head2 2000/11/05 v2.6 (Heiko Oberdiek) 2502 2503 * %%HiresBoundingBox corrected to %%HiResBoundingBox 2504 2505=head2 2001/03/05 v2.7 (Heiko Oberdiek) 2506 2507 * Newline before grestore for the case that there is no 2508 whitespace at the end of the eps file. 2509 2510=head2 2003/02/02 (Szab� P�ter) 2511 2512 * option --below 2513 * removes DOS EPSF binary junk correctly 2514 * adds all 3 BoundingBox DSC comments 2515 * reads all 3 BoundingBox DSC comments, and picks the best 2516 * forces BoundingBox to be an integer 2517 * adds %%EndComments and proper %!PS-Adobe-?-? EPSF-?.? header 2518 * adds %%Pages: 2519 * adds invocation syntax: a2ping <infile.eps> <outfile.eps|pdf> 2520 * can convert PDF to EPS (by calling pdftops(1)) and PDF to PDF 2521 * emulates work for PDF input 2522 2523=head2 2003/04/16 (Szab� P�ter) 2524 2525 * added PS and sam2p support, renamed to a2ping 2526 * sam2p and pdftops if $InputFilename eq '-'; 2527 * remove PJL UEL header from the beginning 2528 * works for PS non-EPS files for input 2529 * input support for PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA via sam2p 2530 * removes ^L (form feed) from end of EPS file 2531 * -x=-c:rle to add sam2p options 2532 2533=head2 2003/04/26 (Szab� P�ter) 2534 2535 * omit the unnecessary setpagedevice calls when creating normal eps 2536 * --noverbose --nocompress supported differently 2537 * no more option defaults :-( 2538 * justlib2 2539 * multi-page output with PS:, PDF:, PCL5: 2540 * after `a2ping -pa4', file out.pcl says: `HP PCL printer data - A4 page 2541 size', instead of `US letter' 2542 * justlib2-ified doesn't depend on Getopt::Long anymore 2543 * fully supports filtering (stdin and/or stdout), PDF and PCL5 output to 2544 pipe (!$$ll_zero) 2545 * adds DSC ``%%DocumentMedia: plain 612 792 0 () ()'' 2546 * BoundingBox precedence for EPS input: --PageSize, %%*BoundingBox, 2547 setpagedevice. Precedence for other inputs: --PageSize, setpagedevice, 2548 %%*BoundingBox 2549 2550=head2 2003/09/25 (Szab� P�ter) 2551 2552 * --bboxfrom=adsc: %%BoundingBox overrides -sDEVICE=bbox 2553 * improved bbox discovery 2554 * many bugfixes 2555 * MetaPost EPS input fixes for prologues:=0; 2556 * a2ping.pl -v --papersize=50,60 --bboxfrom=compute-gs t.ps t2.ps 2557 * consistent bbox, --PageSize, /PageSize handling 2558 * consistent --Resolution and --Duplex handling 2559 2560=head2 2003/12/02 (Szab� P�ter) 2561 2562 * --bboxfrom=compute-gs option to fix PS -> EPS bbox (gs -sDEVICE=bbox), tuzv.eps 2563 2564=head2 2004/02/10 v2.77 (Szab� P�ter) 2565 2566 * the compute-pipe routine is now run unless --bboxfrom=guess with EPS 2567 * added --gsextra= 2568 * added --antialias= 2569 * added FileFormat PBM, PGM, PPM 2570 * separated FileFormat features to FL_* constants 2571 * added --doc 2572 * there is no default FileFormat (PDF) anymore 2573