This is pdf2ps.pl in view mode; [Download] [Up]
#!/usr/local/bin/perl
#
# read Adobe PDF Files (PDF-1.0 + PDF-1.1) and convert to PostScript Level 2
# Detlev Droege, <droege@informatik.uni-koblenz.de>, Sept. 1993
# Copyright (C) 1993-1995 Detlev Droege
#
# RCS: "$Id: pdf2ps.pl,v 3.6 95/10/06 22:02:12 droege Exp Locker: droege $";
# RCS: "$Source: /Users/droege/pdf/pdf2ps/RCS/pdf2ps.pl,v $";
$Version = "2.18a";
$RCS_Revision = '$Revision: 3.6 $';
($dummy, $Rev, $dummy) = split (/ /, $RCS_Revision);
require "ctime.pl";
require "getopts.pl";
$logging = 0;
$noType3 = 0;
$opt_h = $opt_v = $opt_3 = $opt_b = 0;
$streamOutMode = 0; # will be set to 1 or 2 during binary output unless -b
$UsageMsg = "usage: $0 [-abxhtv3] file.pdf
-a produce ASCII85 encoded data (default, SLOW, smallest pure 7-Bit files)
-x produce HEX encoded data (fast, rather large pure 7-Bit files)
-b produce possibly binary data (fastest, might mess up data transfer)
-h print this message and exit
-t don't generate seperate PS file with thumbnails
-v be a bit more verbose
-3 fake all Type3 fonts as Times-Roman";
&Getopts('abxhtv3');
die "This is $0, Version $Version (Rev $Rev)\n$UsageMsg\n" if $opt_h;
($pdffile = $ARGV[0]) || die "$UsageMsg\n";
$noType3 = $opt_3;
$verbose = $opt_v;
$NoThumbs = $opt_t;
$avoidBinary = (! $opt_b);
$opt_a = 1 unless (($opt_b) || ($opt_x));
if ($opt_x && (! $opt_a)) { # use HEX as default
$avoidBinary = 1;
$defaultAsciiMode = 1;
$defaultAsciiFilter = "/ASCIIHexDecode"; # must match !!
$defaultAsciiProcSuffix = "_Hex"; # must match !!
warn "Option -x overrides -b\n" if ($opt_b);
}
if ($opt_a) { # use ASCII85 output
$avoidBinary = 1;
$defaultAsciiMode = 2;
$defaultAsciiFilter = "/ASCII85Decode"; # must match !!
$defaultAsciiProcSuffix = "_A85"; # must match !!
warn "Option -a overrides -b\n" if ($opt_b);
warn "Option -a overrides -x\n" if ($opt_x);
};
$pdffile =~ m:(.*)\.[Pp][Dd][Ff]$:;
$basename = $1;
$basename = "x" if ($basename eq "");
# print "Basename: $basename\n";
open (PDF, "$pdffile") || die "Can't open file '$pdffile'\n";
# let's try to figure out the line ending char, \012 or \015, to set $/
while (1) {
$c = getc PDF;
last if ($c eq "\012");
last if ($c eq "\015");
};
$/ = $c;
$c = getc PDF;
$/ = $c if (($/ eq "\015") && ($c eq "\012")); # handle DOS's CR LF
if ($logging) {
print "In this file, lines seems to be terminated by ";
print "Carriage Return (CR)\n" if ($/ eq "\015");
print "Line Feed (LF)\n" if ($/ eq "\012");
}
seek (PDF, 0, 0);
# done. now let's start.
$_ = <PDF>;
/^%PDF-/ || die "File '$pdffile' is not a PDF file\n";
if (/^%PDF-(\d+).(\d+)/) {
chop;
$pdf_version = $1 * 1000 + $2;
if ($pdf_version == 1000) {
$pdf10 = 1;
}
elsif ($pdf_version == 1001) {
$pdf11 = 1;
}
else {
warn "'$pdffile': never tried $_ files - let's see ...\n";
}
}
sub put_proc_set
{
if (open (HDR, "header_for_pdf")) {
while (<HDR>) {
print PS;
};
return;
};
# if header_for_pdf not present, use this stuff:
print PS <<'EndOfProcSet';
% PostScript definitions for PDF interpretation
% Copyright 1994-1995 Detlev Droege.
currentfile /ASCII85Decode filter /LZWDecode filter cvx exec
J07)\i!]IG!!!$b"FpQf%g`4F^^#[A$ip<WSRDL(Zsklu!It/8#.YcdM3.cZ":.D<
rXOq2L2ja0)uta<_>l<s,fVJ:)UG/l3<0$n!&m:,!DiiJIk?o,BV<-@n;Sdq$@i-X
m6X<@!(]Cp]!qf<+,Q$DdRc<L!E:d@_&rk;/gVL0d4Z5$Zp$ef!"ks4C9@73@i4!O
#XABaM)(]*`7SIB!&&u"K5f9Er%cIr!rsDF.p[`n&HFo!dYWS6A#6WTC59@FHoqC.
$oSf(S!R3LM=.P^rJ1MkhVZE!*%89/Mdp@'B5iZ,68:dl5OVHeKsk4qRK*?g!rgbJ
#j(bu;AqPsbo?<3.!-j3kJ@l41ACI:5dtpG2$MHX![2LRL:/M6!2d&u"2Fn1"E.5U
Z&B6(MuXUo$ma[0"cIj!(BFXs]I(b<ZLB9H+^3cs&I\T"]O`UB$Tq9"jHmTA>(0=0
Bg`5K/J(!;T90`N;J\lVC_4'$AK-)[QkE#cihHXXN1H:JPFT*,"OsU`92\q[N"^7-
;)$()_#l?T'1AdKOHTDo2^kW@;(n(GUpto<&i,Ii:K&/15>TC"D]qj9jG^X7'KhX;
TB$_&!"9Q`VP9kt$\#X='XY<1Uh'E^!#bk(?D!G0q2nTQ'<1t+bN8t28'U+j^0F]\
]_5:FaAF*ce*6[.,:"MQJMAGrl[G]L!9Ht7'/`d\<mP=T@qjMZE>9]DAVIBp:dl\?
VVCeO0MC23L!+!O"73`i?#giQ9t;[Cj#<#S1I<?nol2@!LDT<E!"JG(63L[r!!#^L
Vnb6(TB(+.G[^<C'MGq"g!P]33#O4'[0$UnE$Zd$1&q\"*J0E=:pND1AQD,e8@Ri7
TFFlb),6Ft"ibP?,p[hdnV8"]4,"9PGQ8:gfcimdB7NI@Q%0!AIYAaAc>in!OL)_b
CK^d/7-R&C_kX%R4+7K8JB##ak[4E7[qndW/?/mnVU1lqPo7pVeEPWjhknAJ!P4@O
W):J"$^kt>\mPUim(3kBFHMXW)8R4pLpnA0]C-(]66Q`*7VHk%Jr5YAXRbN#PT<Be
nA'Tf>k(^_PNQ!Y%\HDp$6@U&n>P9_4I:/[Zbj8(SiY]Y`,B#`&UE39S_^EiYRBch
rU6JFJ:5!u+F%/$!.?H4HFNIX.2h7>pBH5;jX@+5q!WSOjE/b?T>F(o*r.]7Dtj;r
oL;K7Z-NCNWWE8)4@i$LI"C2UQj2b$84-Vq499a9J,m%]aafX9UkC9b1?K8.kY-ZF
!$T067M&sqPm1#DOcGdtp'IYt"gBlk]jcjrhP./u01k1bYQ4;'F3K5H@IH@B'+9^,
'7Rt:s.!0d'd+sEJ5?jt4n;'&b@r@QiW8k`Jjqb1#QP7./?uZ]`u7MT0TE?)!"Kk(
!!'rYBts^ea)_aA`p@CbA&+kK;7@H77"f>cAjd92$HG]BZSo$1qAM`,;pNIG1*?S\
U3#NDO.qD!kb/s2R7_l/C%Pl-!Q^E[Z4r,J-mrH_16_8[G"DHgPYaUF%&Z?d_Z[5(
!?t^0J>jr(BE0!Wr/=;^Y\6;?`?4[km)u\`*mU0+RDsX$NdrO$Au*#+,JIb#q6im)
#e6AfhJeYBXLi)g^mITE6r($n4%]A=+6!3Dbh;.$-a>n."Cc-Z0G+cW2#d^n#%L>^
Gs>t9cSS/OG#78n`/`()3!1@^:O4Q_9aL!RZtPS[MC;(-(f3'qga^_Hr]Fm4oEPVS
OG3NB&!>)QHuuNP+i/nTLte&77C`I*EnZ'Mh)U$Qie.;'i^/0t5cH$oWKdQP!2r/#
W&7Pe<I,2WBS&8ni\#m0([3o:.A7iJ`2jUPi(PPu=?qDR\.\$[?43.:6H"g:<ru2h
_M*+[oX8M,5cmJ3E*"F;WcHQEZ7F6/7%jd+X;3Ne?n74)!!(HH<B>k,)8P176ste4
!gkD"7(FMkehjhN+_E1g2mL?[Z,"8`:+4?',U;9igCde.aUB>uEsRI/$[Y.1,?94.
NVltsTQn?h#S%*fU`&_m0H?X56Pg`$=@@$MlrX6"dS8EF6Ap,Gq&"-2<QL6\0L*Yg
7B#lr&WimB*GnK>[`I=\,B/trl%)YrQ>l3JoM]AZ`WNQT#bU%qYY21e^HR4eqH6I&
A3^=G[e2&pPHdDi/k!4`P-Fd!1UCoQNCgg.Nq\V*?$Hk%%Or8Sc^lfk:GE/n/9hC4
?@lI>YeB8"-ZB&q_Hi,$4n\jV2Z/gIo$7Gm*QKtIjGj#gB?Q[(`tUA/'R[#mnA%#n
ARN'#$;Og@!8,J)rpLG8]e@\35`3>YO_*2?j=9+@^rY<&^&/V,Yi]iKj^>(jL=hLQ
/eZA3(<ISe/4p5QT[<8O#O$26GH[#4^fkLpl-`jiSfT)ojS533]Jj_#_;cLR:D++r
/RZo$W^?QNrZ=i.TX+R)ds)O3,CGVE1She1k@[!0E\48.?@t`>BS?YLV3_R5_aKUP
AF#cYLGf?Z!"Sp+D#H`!EE4;-8)OhedbRkN72X\+jj>e$+>".m7\LDPU#elfG'ANX
Y=5UH^jXk4%i#B--+^9#RJFUr-LKaThgt,$eok,=#Tr[(M"&[LOblcmi`$TlENUls
FpZik*,g#k5!QDt;G*@)PCR\f:1(d:c'RLG?ZO$>bpP.HhPC&s'B_S-Y=.\GmT%X&
U<@\"*Tb%k:DDeI,L^R$:TL$Z5]n&:\9bP_lC3F(FagsQFQibjh.Nm6:8+S3hcT7d
:Tr;4\(UY.CraKo@Zp0FcT1S[S?e67*](tcc_REad\NrX?uY-4reW#rba2H<IK0On
jjEjb<&f:K!!A"4]=<fA&eo3m]?#MmTs4AnY/!\gWG<4diq)j_hi#VJ:Rnp_Pd91G
=]eLAQfO4`AFD6u#f*Fd,c!EsYQ=2i\81digYW6]asBXRI_:@S-(A6!7a\Jc.,bEs
G9_Zb0lO9X,u]>AKU)AAhnM66JF381NVWq$au^c>qF9$?*e"+hp6[t,LKVb5O-]eJ
Z>eq1podHW:NH,d4R#YEWhNbt9S,OlFtI=;/T9Phk9C!Z:>KAL!5rdX0AQ_JG6>&*
S?O,V0('qp5XU'@s"F*#kG7sY70*qI%.INV#lY"3DVr=O#>bmT!8<f-`X`9Bg&_ss
i=`Dug;oA'e"_U!j64So5!!.>/n!WCD:TpC?NhVP#\3*&l[\pe70[]*,68XY8!X,c
SICLl--r7Sn$rmgg*7+67dbT\&,cE:kQLBo,]ElUn*#\UNr`"=LCcf=Wm:^M(B,QB
#=I_=6<nSb%Uc'<%c[!S6aA:2ZOX)?4i=Q>j671C>[K38qBO)]+G?!]Hp+\)'FUNI
nM3:^d1u*K7e'A<0gmDN[a*8_7e'_Qi854tOpu>B&"in3Z&7O;+A#Fm#N>XnY/W`s
Lc[>a/TI4KmnFAq>oKuT,r);:"6gb]>!@\X7c7<2J5F0o6G3\1]Ar,qj0Kd0D@C%>
!X/]?UZg@3<]_j_--tp(aXlNcHGU54,8'FtN(1C[If?;r_\$Z,LV=u6-QaqY`3L4A
1'2c""t/nH7oCWWMpOM\D]b^'+6%bp-ZL=#3;?r:'i!Bpc"t=<gEC(5,f28^&QoT2
kp=;S-4C8/;Cs6$)UX[Tf<09jKBN\8+;6!`'1:sjl6$^lkn#+Y-Gf]^M('*Jkn;#]
&d!OGJprrEc6^:c)BrH7_GVNW'H5n!#EdamEn^WS2]\S_%KQ>1o'%dBIO3D*+VNZa
P2%:&lRqbi0@L(X;ZA?nIkS'T/n-al'*Bgb!?Ihp*$Fo-!]Mm@/g\@;4"44r@U/[q
Z3pd!$dsh6J:f62>SufWQpPs2">hpp:]qG@dc9PcKPr[<*'5rE7e92-d$?'NH6q$i
2_7Gi`,@VEIlO0.2aS*";hR>uR#g;X.KgIe9gLb<GT/=,nmi":"<oY]C`O1(edY)1
+N5nKIe$r7$kpK($,-NB6oup4":$>=M+EtaXS]'_-Ap*8J,qM^]*tn8-c/58A$[/L
>aI)r(_c&Z'FXsU&<uZr/7=SH9btc:5sRbB4b=J5is6_@+#_>U6;Xno@M(tj<lQV'
75RY&0$)N2E:_RZ$W:(O0YW`m0+EnP7`(fJJulWn0^*TI_Z?;mK%t_4NYmC`I6]JO
b(`@c!#Lkq#(gY1Pc>rA9gA!k"qd%lJntTI^If`$*n7M#&(1Lna%F,I"#SU@_o;]k
h[Qb)5*OG5cR(#I+@*e?DuifW'M/?^[l^U361k5u1o(3&CI"f34EF@I6D7$?o'q<\
%3t(WW,kTH+Z;b[.o[Zi+9>D-gcT]o(%k2Nd7mL*3t$U35(d3)nIT^b=[dtK"jKV<
,ATnO<?-'M$8la$6<jXiW'^0.7;^U<FK%D:e0>JN+[Jt(b@=I$a\l#m*RF;O6KSOg
4OSb"=qf-6FN$2'm%P,kd7l\_#9s'iI`;gY-?Y9gom]ZncNam$6Gf)t&G]Gd!EDk]
6A08Z9gmdr78@ga+7AnJ!!JY\igc[c-c-U,2*jsSZ3g]t%T,r"i[nU'b0OaA&p4u,
_HgWs$6^.m!#9,e.Tl0rO&GV-hua&TeC5r`2&5cF>Z4VNY<"a!=%e-7++n;O6?WA$
0cRQ6<=Sn1KPq=^"s;%0Q-YG&_m1!$@Qp*%"C_rSKBX4*_(9&F).HNZ!!']bkbVg-
%Wla)';-Q`VYDg2BnN_`QI.`\kgU/MP=)XT_UiYT@f+I"=^h<2&-j+3\IjGFC][iU
(0%<L!DM(Qqp*`3j6:I/]4htU>1RUs_ScETa'/-C',F1c@1c_i2de8aF#Q$ioVG\B
Vc6_qs"/-Q;BZ*#0R"9,-h)`tOMW7c4]-E@f<l99MlCqN,Rk@D]0NVtpI7XEHUeW[
BbTk#A$]I+iF!j7!,e/d1[aH:Da_g&U(U$/e7ffO$Od_R4,k7WW-"OD,=5jF5sg&e
KJ!Z5=?A/N5k":5<9ln11'#lh[m0p6(ZmO5NY<63:c)$tQ/>.j(Bs2UJQ,uA;aA1+
B1:7.Fr0"!Q`Y@igN!eKEQ\n@p[BCC!I7@.r03%b<2E.Od5_i"+7R-"@8fkj_+jt1
'KBY/'UMMSF]fQ'_\Gqc2n[%j'^KYTY!NmaJpoN$:_lFU*?fE'`,;^monLNP!#@[I
"C$a"VQTt#L,c5kiZS?>IgSRr7*.qI'GG<HPDcnUNE(3mpY;CYZFXML,[bVK%A;GM
=#_BYH<#qs=K'!eh)BT:5)H]of]]oa)ik<'-8f0WeF,Y2rpjMf*roYr:B;[BkcXK_
?dojY6jNeqK^A7tW?OYk!@YU56G.IDA$m)=3F,V:(-EdXN#9$f\T*S3o.33dPX8Z1
Fpob?,iB75-.U0COKD(d$V^]c#1pg'3Lu=8G:9N!'bt(LP&laO0q.TFqO*V('Eaif
^+OA/7PJN]\]#.3ngF"UE+/bu!^\%q7>J$2"Sq7Np@'m$!!NZ[-,@YJGtL8e!3;an
T%,c0-`<LZ>RWDn-!C)e@Nh=ZKZ!pHTn9LY8M&;@_4gUe>hTda==\6?Mk4)>-.Q0\
.a<,aO_T1iAm,g/2.f>S:.G(YJL<saRFEApo0Yer#`I'!H/\f)-)]!K&*(M`+Up9Q
JZ17fWIinP!#l^@J0"K^bl@jGUW+1?W\bkTWDCqG3iXUdfg&Uo*nn[p!'++'!'C7<
WhMruHF>Gp]r;q5Y$.<q_WDDU_>jT-WhQF*3iY:C)6Q#jfE#'V+\Si0'Fai`/mtlc
TIm94?j>??6b<Z-]*eKZ_m)H,)"DKa+\9KNUU/r=C.(#^[#c"20F:qP;OY6L?rJo&
+r-$!*kL>2qU?qOe#o@]XQ)V[HWgY9?2t$%W0pE@]8Rp6V5qI&#+K-J@;\1O?it_T
-GYbFil2t-Ot(uD\`+/:Mio#`Os\#C\Kem,g5'bmJZ.K,(cpXq>He).f=/Nq(OE)6
@2$0q'G-as,[cb8_o<4VOu+>K^4>U],/tTA)?9f5^4BA"JW%5cFhqKrXPuP`Hj90^
1(h.^'YE?<>Ncj7mJm75\Kf*1Hnkt2l42S4&GtGtS/)Lf1)@Lo6Q;1:i9.89V8FF\
_#OH@r%\KrOtL-j`h6tZTE#(A!!!"#_]V1]+A9bj.EH!0__A[_!"6i`l*[5:X271<
]J:J<l5MeL)uG@-g?KLO=r=j9%XR+9]':&Wl5)O:'cU<iqW\dmC(spO%9lE%:#i._
IQSehW,'`k&C\BT7PT9a!#u.&*"M$0iQ@Z_6_%]J*.$ZcG(EnK6_'%p*/2dfO!pNe
j;aoT*1h^dVF,kM_`Y6c*3V_7[R6Rrj;c,!*6dI`aFRUC6_)fi*7X$hki<`EJR%P/
SFGSX]&Xf\]c0=rTc(0U=qA3X`uV/[)g4T!_6plsd<h3.Rot[GcbJ3"`CnPn0[mO;
`SGaH#2>NOHG,WUce_s\Q7/;_(GiKDV>qRIhP*rj:-m/Gp&R=Z+8Y`?h>B)jWScOq
e$E.B+93BbW[7bGWsLemRloaNguKF@j;^SG)W9NSA$.m'j;SciHNE+F#"+jOnbW+C
*8TMhkKh(,ZZ:j04tX-j+g%JsZ?n&*RjnVI8$!bYaZ_)SHMj%urVuu?hE&l3>NUKA
']^4k6_#(U*"(aH,(WuG6_#Xe*$=7s5MgXe^771D**e&"@F>u8,@TrL3lfWp(uuW_
d9sN$@&L*e#RULP])D=-S*1(1c65G_m@k03fM@J)('U+<4#FE?JeS8C<$>Tc4#JU:
/_BQX"=4,J%KLd'Q5mp@cW$MG8M=<n&&i56A0N*A"*JbV^K$sL>@6Y=H$D\RT2m0Q
EW?o!4#_M02h1SRKU[Jl*$7D-6)")K%>+>RJNkCO[EujA;i>95nJQgf[KZ656e4*)
q>+Co6='0^''Fa$d"2gm!aP8&]i8A?@fdhN?\=GC*[gb.5M+XkaG^6d-hL;nrPC5p
@K6CZ+M\N^ps'!B7">9q!s&0&"b2\D0M!nW.KBO#![JVA)Bf._J,oWN,^9>*J&l1U
,K+1Q*KRtR5T-!@1BniE?h&uA^(V^pJ,n#S;"bP1Oh)elYYY?T+dEdP1,04V,qOX=
^_M\/nm<R@=">%W'\^kqZqFfRM\V]6/"TtJ25lc9j*6^-_q!rG[WsEda[4VG"O%0D
U&YZ*p_57_%`_ghPBl6KB6KZb/Tni4Y1G-jfI*#D?@HJm\\`3'\X:rm%A;A?GO)ZG
B5l>bk$U8>Deh-a:BNV)<&B\%RDgLo\Xh_[5d=/LZT:Q?B\;E5J.sgFDPpLmgj"+:
'mInYYjF%_%n<;B1XO(CQadgcH#X(<9d\o9gb=_kkiad\j!`tL%jQVI2[k=0`]=C#
E5jiQ_f3mG#pLW30o3_lgc>bg#g3Rkj.OCGN_oN-1W/6$ehdl@]M^eMUL:r"`8`Bg
2Fc_jqD4(_Gj$i?@iQ=H$q$-!3t.m#M\SV^8D#[+UDVE>$ur5i2@Q@rW\]Z&%%8Zg
o$"QqbOR3)15YT2`\N7cFGD?)_L0T[%C5'--d?TQP;gUX9H=4oUR9IiM)3)t0*sH(
as,1hKaB'Pj-YHhLpUF[1l+!Dp,kW[5gVHMUR8q'N[(W\*K3?n`%[3]/QGhJn@`12
N3s5G$HV`@$8N$B#gWS_6R?"j%)YW]3m)TLc8J2Q37']hQ?7[!N2&4)3f[*C-9R79
'Hpcl_TaMs;$5(j90pJ"djiq1-)G?_6S,idhUXibA_sh"$%:\B+PU<7@mh2de<=R'
-]X@[WZ^9KTZSD*6^ZgVN46=L1l`9XX_a!&*U.=l\I=7E97qV@2[tm[*\`S;S-V4c
EP;];NoP7^6Xe@>Kq/\5S8X#g0dVf,NcN]12e_4obpP`Zm$p+t0OWfs<6u34;[N:@
@Pe?7/_NNhj.sXDalAK7$4[0`8L9>f7HY]DZ@!Tm@e!0J0b+:N`&cWtV.F[[n19nH
fQJ\/Z4:BH5;\D-OR#EXG^N*&NVnIC(/.V>habgkS_u?O['Uo+:Gi<BcO?RC+!(!\
XV!(+1gojkc3#X?,Bbg*_\C/o%OET`4D]r1;j-kM3-Z(c#V,A=Ii9\ZP_C/%aRS>/
+Q\58K>u>@[@](3Pp#-H%m>]l.X^tJ*]ELIG-F)b^GjEU<DcKQ3Q8m'0au.6r?-b'
Mk"h"AT-Oe5]dL>&3tGQ6.Q/D+OG_-3,V;R]JZA$?lYV5.7<&g'I=;q*YR[SKW"l/
KFhCtd\q0mW)YgkGXTbSLgtqna=4BINXMM3`eSA@(C)kE#(n<k%H4N-/>RV*,#^<.
JP"Pskb&S0fOPJC25pgGTFh5^7!N.+/qdaTKHams$=VF="D"AI:tcUUZ*6+i"B65U
QpZW`dEMnMKZSih7h(P_%jD",&;,4POE"jjU\PIV_k9sp6'O$WjquBqP.Hc!,pG(Z
`Xl.[AWn:K!/48)L;P]H$fR$tL1%_9j\&hfTjgZM#h]HWMRj/\_=ImlAePo8FH<Le
4<g2+-CKh!$>^2W`IQ;S6Wd\]_4"Ci'L=O,qAbc@3@DYP*#PCqe..[FVTS/=$\Li2
#XG=L#D<^/_JE1E_9t`t$.os089t]<C`!?&5mrc6+Cn&C&-K^q#Q]Gu<^G(D!Y@[5
"!CPLJP\3-5fON@]L7+f,mD:JSBB>R:I)`R=GF&5'ET+<%5&&;+F&te6\6pY!=UF)
fQ@]LE`Ro\&h_XdWY?%9D%:R-H%^rX[)8P.$)&YPLFQVicm6e^aCl,.6pMSbk]6k,
^,NqP>oeM@-4BIY3PqH47[,cA6B&Jd;ei^9,8EGD#P8QNWLt4]XHRTX.Pm`D^4ZN#
7LUHu&6H*s#V2&V"gY;HKL^b66CO`D0cV?iOJimF!-kPY<#=%5roTBl9+7+'2ch\h
&nq>WUeR@9LPnj1_^pm8G/,kc0ZXZ<l:DD8'J'A0YS7/0[1%T$,(u1;&;!G:#Jgk:
KJ8i16<HUd'-&6M+GLT5:i$F%Lcg>EO&D.A\."11GGK2SFRLVE]LY.?h2oJpDb<O1
QTFnpY]pZ[Otqp9?1V3\aqTG89FF-mra6-;&Ak:A#acOo"CQjUmN=In\*tO!$l``o
9gl<&\0-H_0H7m%8d%DL.KZ9A)fRc9%ma#PKg=]6"#*.NJI!_/E)[[*:hBl&0(Oc?
c5=H8edQ5j3S#n@)qagpJl@5R"[%kd/W_cY!JplMgmB*)Q;>Un2P2+*^k+>t3,QKZ
3X5Gu*DoPbD5$,IAkFb=-P0jSaDtO?krbZdP]0/2cT6fL^GN:DDG^0$1M6REK]s%X
$:2A;kB'=MoKJ+Lq?ogWV,<nm,hGA&+h'3l5RIQ0.0KXh*.s>b$[!"@#,$MVLIA]o
[8JJ>Tp-)i8M7X)3ZeSlJ/JFHAZA$=,Z&gKK=k_*2FEa<C#H=!CV>$"2*`f!+N%jp
I<5l`cnksBkSSq[5T)G2"p=rA:kA\7k+L@If/n49lQ'S&5Q~>
EndOfProcSet
};
sub find_startxref
{
seek (PDF, -50, 2);
local($found_startxref) = 0;
$startxref = 0;
while (<PDF>) {
if (/^startxref/) {
$found_startxref = 1;
next;
}
if (/[\012\015]+startxref[\012\015]+(\d+)[ \012\015]+/) {
$startxref = $1;
$found_startxref = 1;
last;
}
next if (/^[ \015]*$/);
/^(\d+)/;
$startxref = $1 if $found_startxref;
last if ($startxref > 0);
$found_startxref = 0;
}
warn "Could not locate 'startxref' entry - truncated file ?\n"
unless $found_startxref;
};
sub load_xref
{
local ($start) = @_;
local ($first, $num);
seek (PDF, $start, 0);
$_ = <PDF>;
chop;
/^xref/ || die "XREF not found at pos. $start as expected\n";
print "loading Xref at pos. $start\n" if $verbose;
while (<PDF>) {
# print ">> $_ <<\n";
next if (/^[ \015]*$/);
last if (/^trailer/);
($first, $num) = split;
for ($i = $first; $num; $i++, $num--) {
$_ = <PDF>;
$_ = <PDF> if (/^[ \015]*$/);
chop;
/^(\d+) (\d+) ([nf])/;
if ($Xpos[$i]) {
# print " ignore Xref '$_' for obj $i (use $Xpos[$i] $Xver[$i] $Xuse[$i])\n";
next; # don't overwrite existing entries
}
$Xpos[$i] = $1 + 0;
$Xver[$i] = $2;
$Xuse[$i] = $3;
};
};
};
sub token
{
local ($token); # $tbuf sollte 'static' sein ... :-(
local ($tktyp, $multi);
$_ = $tbuf;
$multi = 0;
do {
$_ = <PDF> if (/^$/); # next line if empty
s/^[\s\015]*//; # strip leading blanks
s/^%.*$//; # strip comments
} while (/^$/);
if (m:^(/[\002a-zA-Z0-9\._][^\s\012\015%()<>[\]{}/]*):) { # /Identifier
$token = $1;
$tktyp = "Id";
}
elsif (m:^(\d+\s+\d+\s+R)[\s\012\015%()<>\[\]{}/]:) {
$token = $1; # Reference: num num R
$tktyp = "Ref";
}
elsif (/^([\[\]])/) { # '[' or ']'
$token = $1;
$tktyp = "Array begin/end";
}
elsif (/^(<<)/) { # dict start '<<'
$token = $1;
$tktyp = "Dict start";
}
elsif (/^(>>)/) { # dict end '>>'
$token = $1;
$tktyp = "Dict end";
}
elsif (/^(true)/) { # Constant: true
$token = $1;
$tktyp = "const true";
}
elsif (/^(false)/) { # Constant: false
$token = $1;
$tktyp = "const false";
}
elsif (/^(null)/) { # Constant: null
$token = $1;
$tktyp = "const null";
}
elsif (/^([+-]?[0-9]*\.?[0-9]+)/) { # Number # OK ???
$token = $1;
$tktyp = "Number";
}
elsif (/^([\w]+)/) { # Name (\w == alphanumeric + '_')
$token = $1;
$tktyp = "Name";
}
elsif (/^(\([^\)]*\))/) { # String: (abc)
# (string) - multiline stings see below !!!
$token = $1;
$tktyp = "String";
}
elsif (/^(\([^\)]*$)/) { # String: multiline (abc\^Mdef)
$token = $1;
$tktyp = "String(multiline)";
$multi = 1;
do {
$token =~ s/\\[\012\015]+//;
$_ = <PDF>;
if (/^([^\)]*\))/) {
$token .= $1;
last;
};
$token .= $_;
} while (1);
print STDERR "ML: '$token'\n";
}
elsif (/^(<[0-9a-fA-F]+>)/) { # HEX-String: <0fab12>
# HEX (string) - can't yet handle multiline hex stings !!! ???
$token = "$1";
$tktyp = "Hex-String";
}
else {
$tpos = tell(PDF);
open (ERR, ">/tmp/PDF_ERR");
print ERR "Unrecognized token: '$_' (near PDF pos $tpos)\n";
die "Unrecognized token: '$_' (near PDF pos $tpos)\n ";
$tktyp = "Unknown";
return 0;
};
$tpos = tell(PDF) - length;
if ($multi) {
$_ = substr ($_, length ($1));
}
else {
$_ = substr ($_, length ($token));
}
$tbuf = $_;
# warn "TOKEN[$ld_nest]: '$token'\n" if $Problem;
die "Null token '$_' ($tpos)" if ("$token" eq "");
return $token;
};
# load_dir: aktuelle Zeile ist die, in der '<<' steht
sub load_dir
{
local ($tok, $key, $val, %val, %pairs, $len);
$ld_nest++;
$tok = &token;
($tok eq "<<") || die "dictionary start not recognized near pos ",
tell(PDF), " \n ";
# print LOG "load_dir: at pos ", tell(PDF), "\n" if $logging;
while ($tok = &token) {
last if ($tok eq ">>");
$len = length;
$key = $tok;
$key =~ s:^/::; # strip leading slash
$tok = &token;
if ($tok eq "[") {
$array_nest = 1; # first '[' already scanned
$val = $tok;
do {
$tok = &token;
$val .= " ".$tok;
$array_nest++ if ($tok eq "[");
$array_nest-- if ($tok eq "]");
} until (($array_nest == 0) && ($tok eq "]"));
# print "ARRAY in DICT: /$key $val\n";
}
elsif ($tok eq "<<") {
$val = $tpos; # just store position to find it.
$tbuf = "<< ".$tbuf; # push "<<" back in for load_dir
%val = &load_dir;
$loaded_rnam {"DPos_$val"} = 1;
eval "\%DPos_$val = \%val;";
}
else {
$val = $tok;
};
$pairs{$key} = $val;
# print "LD[$ld_nest]: /$key := $val\n" if $Problem;
};
# print "Dir loaded[$ld_nest]: "; &dump_dir(%pairs);
$ld_nest--;
return %pairs;
};
# pos_to: position to given byte in PDF file and read current line
sub pos_to
{
local($position) = @_;
seek (PDF, $position + 0, 0);
print LOG "pos: positioning to $position\n" if $logging;
$tbuf = $_ = <PDF>;
};
sub load_dir_by_ref
{
local ($ref) = @_;
local (%dir,$rnam,$isref);
if ($ref =~ /(\d+)\s+(\d+)\s+R/) {
$rnam = "DRef_$1_$2_R";
$isref = 1;
}
else {
$rnam = "DPos_$ref";
$isref = 0;
};
print LOG "load_dir_by_ref: ref '$ref' ($rnam)\n" if $logging;
if ($loaded_rnam {$rnam}) {
eval "return \%$rnam;";
}
else {
if ($isref) {
&pos_ref ($ref);
}
else {
&pos_to ($ref);
};
%dir = &load_dir;
$loaded_rnam {$rnam} = 1;
$streamPos{$ref} = tell (PDF); # might be a stream which starts _here_
eval "\%$rnam = \%dir;";
return %dir;
};
};
# pos_ref: position to a reference (given as string "num ver R")
sub pos_ref
{
local($par) = @_;
local ($obj, $ver, $o, $v);
($obj, $ver) = ($par =~ /(\d+) (\d+) R/);
print LOG "pos_ref: ref = $par, " if $logging;
&pos_to ($Xpos[$obj]);
($o, $v) = /(\d+)\s+(\d+)\s+obj/;
if (($obj != $o) || ($ver != $v)) {
print "=='$_'==($o, $v)\n";
die "Illegal Xref ($obj, $ver)\n ";
};
$tbuf = $_ = <PDF>;
};
# pos_dir_or_ref: position to reference or byte, depending on par format
sub pos_dir_or_ref
{
local($par) = @_;
if ($par =~ /\d+\s+\d+\s+R/) {
&pos_ref ($par);
}
else {
&pos_to ($par);
};
};
sub load_pages
{
local($ref) = @_;
local(*dir, $kids, $typ);
# printf "[$ref] ";
# &pos_ref($ref); %dir = &load_dir;
%dir = &load_dir_by_ref ($ref);
# print "Ref '$ref':\n"; &dump_dir (%dir);
if ( ! ($typ = $dir{"Type"})) {
# circumvent bug - some /Pages dicts don't have /Type fields
# (seen in file generated by Mac Net Distiller 1.0 from FrameMaker3.01)
$typ = "/Pages" if ($dir{"Kids"});
warn "/Type entry missing in Dict '$ref', guess '$typ'\n";
}
if ($typ =~ m"/Pages") {
# printf "($ref) Pages:\n";
# &dump_dir (%dir);
$kids = $dir{"Kids"};
$kids =~ s/\s*\[(.*)\]\s*/$1/;
while ($kids =~ /(\d+ \d+ R)/) {
&load_pages ($1);
$kids =~ s/\s*\d+ \d+ R\s*(.*)/$1/;
};
}
else {
die "wrong type: '$typ' instead of '/Page' in object\n "
if ($typ ne "/Page");
$page_cnt++;
$page[$page_cnt] = $ref;
# printf "($ref) Page %d:\n", $page_cnt;
# &dump_dir (%dir);
return;
};
};
sub dump_dir
{
local(%dir) = @_;
foreach $i (keys(%dir)) {
printf "%12s = %12s\n", $i, $dir{$i};
};
};
sub gen_page_resource
{
local($pg) = @_;
local(%page, %resources, %fonts, %xobj, %cs);
local($fdir, $fnt, $key, $xdir, $cs);
# &pos_ref ($page[$pg]); %page = &load_dir;
%page = &load_dir_by_ref($page[$pg]);
# print "Ref '$page[$pg]':\n"; &dump_dir (%page);
$cnt_annots++ if ($page{"Annots"});
print "Rotate ignored on Page $pg ($page{\"Rotate\"})\n"
if ($page{"Rotate"});
&make_thumb ($page{"Thumb"}, $pg) if ($page{"Thumb"});
return unless $page{"Resources"};
&pos_dir_or_ref ($page{"Resources"});
%resources = &load_dir;
# print "Resource (pg $pg):\n";
# &dump_dir (%resources);
if ($fdir = $resources{"Font"}) {
local($fn, $fref, $refnam);
# &pos_dir_or_ref ($fdir); %fonts = &load_dir;
%fonts = &load_dir_by_ref ($fdir);
# print "Resources/Font (pg $pg):\n";
# &dump_dir (%fonts);
while (($fn, $fref) = each %fonts) {
$fref =~ m:(\d+)\s+(\d+)\s+R:;
$refnam = "Fnt_$1_$2";
&font_prolog ($refnam, $fref);
};
};
if ($xdir = $resources{"XObject"}) {
local($xn, $xref, $refnam);
&pos_dir_or_ref ($xdir);
%xobj = &load_dir;
# print "Resources/XObject (pg $pg):\n";
# &dump_dir (%xobj);
while (($xn, $xref) = each %xobj) {
$xref =~ m:(\d+)\s+(\d+)\s+R:;
$refnam = "XObj_$1_$2";
&xobj_prolog ($refnam, $xref);
$XObjects++;
};
};
if ($cs = $resources{"ColorSpace"}) {
local($csn, $csref, $refnam);
&pos_dir_or_ref ($cs);
%cs = &load_dir;
print "Page $pg: unhandled ColorSpace\n"; # unless ($cs_warn_cnt++);
print PS "%%Page $pg: unhandled ColorSpace\n";
if ($verbose) {
print "Resources/ColorSpace (pg $pg):\n";
&dump_dir (%cs);
};
while (($csn, $csref) = each %cs) {
$csref =~ m:(\d+)\s+(\d+)\s+R:;
$refnam = "ColorSpace_$1_$2";
&cs_prolog ($refnam, $csref);
};
# ??? ColorSpace ??? noch nicht behandelt
};
foreach $key (sort keys(%resources)) {
next if ($key eq "Font");
next if ($key eq "XObject");
next if ($key eq "ProcSet"); # !!!!??? noch nicht richtig behandelt.
next if ($key eq "ColorSpace");
print "Page $pg: unhandled Resource '$key = $resources{$key}'\n";
};
};
sub setup_page_output
{
local(%page) = @_;
local(%resources, %fonts, %xobj);
local($fdir, $fnt, $key, $xdir);
return unless $page{"Resources"};
&pos_dir_or_ref ($page{"Resources"});
%resources = &load_dir;
if ($fdir = $resources{"Font"}) {
local($fn, $fref, $refnam);
# &pos_dir_or_ref ($fdir); %fonts = &load_dir;
%fonts = &load_dir_by_ref ($fdir);
while (($fn, $fref) = each %fonts) {
$fref =~ m:(\d+)\s+(\d+)\s+R:;
$refnam = "Fnt_$1_$2";
print PS " /$fn /$refnam\n";
};
};
if ($xdir = $resources{"XObject"}) {
local($xn, $xref, $refnam);
&pos_dir_or_ref ($xdir);
%xobj = &load_dir;
while (($xn, $xref) = each %xobj) {
$xref =~ m:(\d+)\s+(\d+)\s+R:;
$refnam = "XObj_$1_$2";
print PS " /$xn /$refnam\n";
};
};
};
# copy /Indexed color space table from PDF to output file (THUMB or PS)
# &load_print_index_lookup($lookup, $name, THUMB);
sub load_print_index_lookup
{
local($ref, $name, $OUTFILE) = @_;
local($tmppos, %idir, $filter, $inxLlen, $l);
$tmppos = tell(PDF);
print $OUTFILE "% Indexed lookup table object $ref\n";
# &pos_ref($ref); %idir = &load_dir;
%idir = &load_dir_by_ref($ref);
$l = $idir{"Length"};
$inxLlen = &get_val($l);
$filter = &gen_filterChain ($idir{"Filter"}, $idir{"DecodeParms"});
if ($stream_is_binary && $avoidBinary) {
$filter = "$defaultAsciiFilter filter $filter";
$streamOutMode = $defaultAsciiMode;
};
print $OUTFILE " { /$name currentfile $filter\n "; # defer execution
print $OUTFILE "1024 string readstring pop def } exec\n";
# print STDERR "CALL(2): copy_stream_len ($$inxLlen, \$OUTFILE)\n";
# if load_dir_by_ref returned a "stored" dict we need to set the position:
seek (PDF, $streamPos{$ref}, 0);
©_stream_len ($inxLlen, $OUTFILE);
seek (PDF, $tmppos, 0);
};
sub setup_thumb
{
return if $setup_thumb_done;
$setup_thumb_done = 1;
open (THUMB, ">$basename.thumb.ps")
|| die "Can't open/create $basename.thumb.ps\n ";
print "Thumb File: $basename.thumb.ps\n";
print THUMB "%!PS-Adobe-2.0\n%%Pages: (atend)\n";
print THUMB "%%LanguageLevel: 2\n%%EndComments\n\n";
$thumb_x = $thumb_x_off = 20;
$thumb_y = $thumb_y_off= 680;
$thumb_x_inc = 90;
$thumb_y_inc = 130;
$thumb_pg = 1;
print THUMB "%%Page: $thumb_pg $thumb_pg\n\n";
print THUMB " /Helvetica findfont 12 scalefont setfont .15 setlinewidth\n";
print THUMB "180 820 moveto (Thumbnails for PDF-File '$pdffile') show\n";
};
sub make_thumb
{
local ($ref, $pg) = @_;
local (%thumb, $filter, $w, $h, $bps, $cs, $hcs, $len, $mypos);
local ($tmppos, $dec, $base, $lookup, $lnam, $hival);
local ($tlen);
return if $NoThumbs;
&setup_thumb;
# &pos_ref ($ref); %thumb = &load_dir;
%thumb = &load_dir_by_ref ($ref);
$mypos = tell(PDF);
$w = $thumb{"Width"};
$h = $thumb{"Height"};
$bps = $thumb{"BitsPerComponent"};
$cs = $thumb{"ColorSpace"};
$len = $thumb{"Length"};
$tlen = &get_val ($len);
# must handle /CalRGB... (PDF-1.1) ColorSpaces
$hcs = &get_val ($cs);
if ($hcs eq "[") {
$hcs = &get_ref_array ($cs);
$cs = "/Indexed";
}
else {
$cs = $hcs;
};
$dec = $Decode{$cs} unless ($thumb{"Decode"});
if ($hcs =~
m:\[\s*/Indexed\s*(/Device[A-Z]+)\s+(\d+)\s+(\d+\s+\d+\s+R)\s*\]:) {
$base = $1;
$hival = $2;
$lookup = $3;
$lnam = $lookup;
$lnam =~ s: R::;
$lnam =~ s: :_:g;
$lnam = "inx_lookup_obj_$lnam";
# PROBLEM: this load should go into the prolog of
# the thumb-nail file. Would need an extra scan for that.
# So I delete the loaded entries mark after a showpage ... :-(
&load_print_index_lookup($lookup, $lnam, THUMB)
unless $loaded{"THUMB/$lnam"};
$loaded{"THUMB/$lnam"} = 1;
$hcs = "[/Indexed$base $hival $lnam]";
$dec = "[0 $hival]" unless ($thumb{"Decode"});
};
print THUMB "% thumbnail for page $pg (object '$ref')\n";
print THUMB "$thumb_x $thumb_y 15 add moveto\n";
print THUMB " gsave currentpoint translate";
printf THUMB " -1 -1 %d %d rectstroke\n", $w+2, $h+2;
print THUMB " /.im_proc { currentfile ";
if ($filter = $thumb{"Filter"}) {
$filter =~ s/\s*\[(.*)\]\s*/$1/;
while ($filter =~ m:(/[^\s]+):) {
print THUMB "$1 filter ";
$filter =~ s:/[^\s]+\s*(.*):$1:;
};
};
print THUMB "} def\n";
# print "THUMB: /ColorSpace $hcs\n";
if ($hcs =~ m:^\[:) {
#warn "Can't yet deal with /Indexed ColorSpace (Thumbnail page $pg)\n";
# fake it as DeviceGray ... !!! ???
};
print THUMB " $hcs setcolorspace\n";
print THUMB " << /ImageType 1 /Width $w /Height $h /ImageMatrix ";
warn "Can't yet deal with /Decode entries (XObject page $pg)\n"
if $xdir{"Decode"};
print THUMB "[1 0 0 -1 0 $h]\n";
print THUMB " /DataSource .im_proc ";
print THUMB "\n /BitsPerComponent $bps";
if ($thumb{"Decode"}) {
warn "Can't yet deal with /Decode entries (Thumbnail page $pg)\n";
print THUMB " /Decode $Decode{$cs}"; # fake, use standard ???
}
else {
print THUMB " /Decode $dec";
};
print THUMB " >>\n image\n";
seek (PDF, $mypos, 0);
# print STDERR "CALL(3): copy_stream_len ($tlen, THUMB)\n";
©_stream_len ($tlen, THUMB);
print THUMB "\ngrestore %currentpoint $w $h rectstroke\n";
print THUMB "$thumb_x 15 add $thumb_y moveto (Page $pg) show\n\n";
$thumb_x += $thumb_x_inc;
if ($thumb_x > 520) {
$thumb_x = $thumb_x_off;
$thumb_y -= $thumb_y_inc;
if ($thumb_y < 0) {
$thumb_pg++;
$thumb_y = $thumb_y_off;
print THUMB " showpage\n%%Page: $thumb_pg $thumb_pg\n\n";
print THUMB
" /Helvetica findfont 12 scalefont setfont .15 setlinewidth\n";
foreach $key (keys %loaded) {
delete $loaded{$key} if ($key =~ m:THUMB/inx_lookup:); #old
delete $loaded{$key} if ($key =~ m:^Thumb:); #new
};
};
};
};
sub gen_page_output
{
local($pg) = @_;
local(%page, $contents, $c);
# &pos_ref ($page[$pg]); %page = &load_dir;
%page = &load_dir_by_ref ($page[$pg]);
print PS "<<\n";
&setup_page_output(%page);
print PS " >> begin startPage\n";
$contents = $page{"Contents"};
if (! ($contents =~ m/^\[/)) {
$c = &get_val ($contents);
if ($c eq "[") {
$contents = &get_ref_array ($contents);
}
}
print STDERR "pg $pg: Contents Array: '$contents'\n"
if (($contents =~ m/\[/) && $verbose);
print LOG "gen_page_output: /Contents '$contents'\n" if $logging;
$contents =~ s/\s*\[(.*)\]\s*/$1/;
print PS "% Page $pg ";
while ($contents =~ /(\d+ \d+ R)/) {
&gen_stream ($1);
$contents =~ s/\s*\d+ \d+ R\s*(.*)/$1/;
};
print PS " endPage end showpage\n";
};
sub gen_filterChain
{
local ($filter, $DecodeParms) = @_;
local (@dec, $f, $fil, $dp);
local ($dpar, $d2, %dpdir);
$stream_is_compressed = 0;
$stream_is_binary = 1;
return "" unless $filter;
$fil = "";
$dp = $DecodeParms;
$filter =~ s/\s*\[\s*(.*)\s*\]\s*/$1/;
$dp =~ s/\s*\[\s*(.*)\s*\]\s*/$1/ if ($dp);
@dec = split (/\s+/, $filter);
foreach $f (@dec) {
$dpar = "";
if ($dp) {
if (($dp =~ m/^(\d+)/) && $loaded_rnam{"DPos_$1"}) {
$d2 = $1;
$dp =~ s/^\d+\s*(.*)/$1/;
$dpar = "<<";
eval "\%dpdir = \%DPos_$d2;";
foreach $k (keys(%dpdir)) {
$dpar .= "/$k $dpdir{$k} ";
}
$dpar .= ">>";
}
else {
$dp =~ s:\s*([^\s]+)\s*(.*):$2:; # get "word"
$dpar = $1;
$dpar = "" if ($dpar eq "null");
if ($dpar eq "<<") {
do {
$dp =~ s:\s*([^\s]+)\s*(.*):$2:; # get "word"
$d2 = $1;
$dpar = $dpar . " $d2";
} until ($d2 eq ">>");
};
}
};
$fil .= "$dpar $f filter ";
# determine data characteristics
$stream_is_compressed = 1 if ($f eq "/LZWDecode");
$stream_is_compressed = 1 if ($f eq "/DCTDecode");
$stream_is_compressed = 1 if ($f eq "/CCITTFaxDecode");
$stream_is_compressed = 1 if ($f eq "/RunLengthDecode");
$stream_is_binary = 0 if ($f eq "/ASCII85Decode");
$stream_is_binary = 0 if ($f eq "/ASCIIHexDecode");
}
return $fil;
};
sub gen_stream
{
local ($ref) = @_;
local (%stream, $dec, $len);
&pos_ref ($ref);
%stream = &load_dir;
# resolve indirect values if needed:
$stream{"Length"} = &get_val($stream{"Length"}) if $stream{"Length"};
#$stream{"Length1"} = &get_val($stream{"Length1"}) if $stream{"Length1"};
#$stream{"Length2"} = &get_val($stream{"Length2"}) if $stream{"Length2"};
#$stream{"Length3"} = &get_val($stream{"Length3"}) if $stream{"Length3"};
print PS "% stream ref $ref\n";
$dec = &gen_filterChain ($stream{"Filter"}, $stream{"DecodeParms"});
if ($stream_is_binary && $avoidBinary) {
$streamOutMode = $defaultAsciiMode;
$dec = "$defaultAsciiFilter filter $dec";
}
print PS " currentfile $dec cvx exec\n" unless ($dec =~ m/^\s*$/);
$len = $stream{"Length"};
# print STDERR "CALL(4): copy_stream_len ($len, PS)\n";
©_stream_len ($len, PS);
print PS "\n\n%% END stream ref $ref\n";
};
# test if a given font exists on this machine (NEXTSTEP only !!!)
sub font_exists_here
{
local ($fname) = @_;
local ($n);
if (-f ($n = "$ENV{'HOME'}/Library/Fonts/$fname.font/$fname") ||
-f ($n = "/LocalLibrary/Fonts/$fname.font/$fname") ||
-f ($n = "/NextLibrary/Fonts/$fname.font/$fname")) {
print PS "% $fname exists locally\n";
return $n;
};
return 0;
};
sub loadType3font
{
local ($bfont, $fref) = @_;
local (%fdir, $bbox, $fmatrix, $first, $last, $size);
local ($cpref, %cpdir, %cstream, $glyph, $len, $fil);
return if $loaded{$bfont};
$loaded{$bfont} = 1;
&pos_ref ($fref);
%fdir = &load_dir;
$bbox = $fdir{'FontBBox'};
$fmatrix = $fdir{'FontMatrix'};
$cpref = $fdir{'CharProcs'};
$first = $fdir{'FirstChar'};
$last = $fdir{'LastChar'};
&pos_ref ($cpref);
%cpdir = &load_dir;
print PS "% make Type3 font $bfont:\n";
$size = $last - $first + 1 + 1; # second +1 for /.notdef
print PS " $bbox $fmatrix $size beginSetupType3font\n";
print PS " CharProcs begin\n";
local ($op, $target);
foreach $glyph (keys(%cpdir)) {
&pos_ref ($cpdir{$glyph});
%cstream = &load_dir;
$fil = &gen_filterChain ($cstream{"Filter"}, $cstream{"DecodeParms"});
$len = $cstream{"Length"};
if ($len > 65500) {
warn "Type3 character description too large (> 64KB), ignored";
print PS "% /$glyph: description to large (>64KB), make dummy\n";
print PS " FilProcs /$glyph {} put\n";
print PS " /$glyph () def\n"; # should at least move by it's width
# MISSING_CODE: move right by width of character
next;
}
else {
$op = "copy_to_string";
$target = "/$glyph";
}
print PS " FilProcs /$glyph {$fil} put\n";
if ($stream_is_binary && $avoidBinary) {
$streamOutMode = $defaultAsciiMode;
$op .= $defaultAsciiProcSuffix;
}
print PS " $target $len $op\n";
©_stream_len ($len, PS);
};
print PS " end $bfont endSetupType3font\n";
};
sub font_prolog
{
local($fname, $fref) = @_;
local(%font, %encoding, $ftype, $enc, $basefont, $diffname, $nam);
local($style, $fdesc);
return if $loaded{$fname};
$loaded{$fname} = 1; # auch bei fehler nicht noch mal laden
&pos_ref ($fref);
%font = &load_dir;
# &dump_dir (%font);
$ftype = $font{"Subtype"};
$nam = $font{"Name"};
$basefont = $font{'BaseFont'};
# print "FNT: $fname, $basefont, $ftype\n";
if (($ftype eq "/Type1") || ($ftype eq "/MMType1")) {
if ($basefont =~ m/_/) {
local ($mmname) = $basefont;
local ($mmbase, $ff);
$mmname =~ s:^/::;
$mmname =~ s/,.*$//;
$mmname =~ s/^[A-Z]{6}\+//;
$mmbase = $mmname;
$mmbase =~ s/_[0-9A-Za-z_]+$//;
# print "$fname is a $ftype font ($mmname / $mmbase)";
if (($ff = &font_exists_here ($mmbase)) && (! $loaded{$mmbase})) {
print PS "% $mmbase included for $fname\n";
# Font must be in prolog for e.g. MyriadMM_650_300_ names to work
print PS "%%BeginResource: font $mmbase\n";
open (MM, "<$ff");
while (<MM>) {
print PS;
};
close (MM);
print PS "\n%%EndResource\n";
$loaded{$mmbase} = 1;
}
print PS "% $mmname: will just be generated from $mmbase\n";
}
}
elsif ($ftype eq "/TrueType") {
$basefont = "TrueType_$fname" unless $basefont;
warn "$fname: Can't deal with $ftype fonts yet (faked !!! ???)\n";
print PS " /$fname [] /Times-Roman mk_diff_font % faked !!!???\n";
return;
}
elsif ($ftype eq "/Type3") {
$basefont = "/Type3_$fname" unless $basefont;
if ($noType3) {
print PS " $basefont [] /Times-Roman mk_diff_font % faked upon request\n";
}
else {
&loadType3font ($basefont, $fref);
}
}
else {
$basefont = "Unknown_$fname" unless $basefont;
print PS "% $fname: Unknown font type $ftype\n";
print PS "/$fname [] /Times-Roman mk_diff_font %% (faked!)\n";
warn "$fname: Can't deal with $ftype fonts (faked!)\n";
# $prolog_error = 1;
return;
}
$style = '';
($basefont, $style) = split(/,/, $basefont, 2) if ($basefont =~ /.*,.*/);
$DocFonts{$basefont}++; # Liste aller verwendeten (base-) fonts
if ( (! $FontBase{$basefont}) && ($ftype ne "/Type3") ) {
# should include font here !!!! ???
$fdesc = $font{"FontDescriptor"};
if (! $fdesc) {
print "ERROR: FontDescriptor missing for $fname\n";
print PS "% FontDescriptor missing for $fname\n";
$prolog_error = 1;
};
print PS "% load font $basefont for $fname here:\n";
&load_font_desc($fdesc) unless ($ftype eq "/MMType1");
$FontBase{$basefont} = 100; # mark as "loaded", nonstandard
};
print PS "% load font $fname here (ref $fref, BaseFont = $basefont):\n";
if (! ($enc = $font{"Encoding"})) { # if no /Encoding entry
# take original font encoding, no differences
print PS "/$fname [] $basefont mk_diff_font\n";
return;
};
if ($enc =~ m:/\w+Encoding:) {
$enc =~ s/\W*(\w+)\W*/$1/;
if ( ($enc ne "MacRomanEncoding")
&& ($enc ne "MacExpertEncoding")
&& ($enc ne "WinAnsiEncoding")) {
die "Unknown font encoding $enc\n ";
};
if ( ($enc ne "MacRomanEncoding")
&& ($enc ne "WinAnsiEncoding")) {
print "WARNING: $enc not yet supported - ";
$enc = "StandardEncoding";
print "will use $enc\n";
};
# mit vordefinierten Encoding Vektoren
print PS "/$fname $enc $basefont mk_enc_font\n";
return;
};
# ????????? BaseEncoding , MacRomanEncoding etc. noch behandeln !!!
if ($enc =~ /(\d+)\s+(\d+)\s+R/) {
$diffname = "EncObj_$1_$2_Diff";
if ( ! $loaded{$diffname} ) {
print PS "% encoding from object $enc\n";
&pos_ref ($enc);
%encoding = &load_dir;
$enc = $encoding{"Differences"};
print PS "/$diffname $enc def\n";
$loaded{$diffname} = 1;
# &dump_dir (%encoding);
};
}
else {
$diffname = $fname . "_Diffs";
# ??? hier noch mehrfach def's von /Diffs vermeiden
print PS "/$diffname $enc def\n";
}
print PS "/$fname $diffname $basefont mk_diff_font\n";
};
sub load_font_desc
{
local($fd) = @_;
local(%fddir, $ffile, $fname);
&pos_ref ($fd);
%fddir = &load_dir;
die "Error in FontDescriptor\n" if ($fddir{"Type"} ne "/FontDescriptor");
$ffile = $fddir{"FontFile"};
$fname = $fddir{"FontName"};
$fname =~ s:^/::;
if ($ffile) { # embedded Type1 Font
print PS "%%BeginResource: font $fname\n";
&gen_stream ($ffile);
print PS "\n%%EndResource\n";
}
elsif (! &font_exists_here ($fname)) {
print PS "% Can't yet replace font $fname\n";
print PS "/$fname [] /Times-Roman mk_diff_font % (faked!)\n";
print "% Can't yet replace font $fname (use Times-Roman instead)\n";
}
else {
print PS "%% $fname is an existing font - wait and see\n";
};
};
sub get_val
{
local($val) = @_;
if ($val =~ /^\s*(\d+)\s+(\d+)\s+R\s*$/) {
local($tmppos) = tell (PDF);
&pos_ref ($val);
$val = &token;
seek (PDF, $tmppos, 0);
}
return $val;
}
sub get_ref_array
{
local($ref) = @_;
local($val, $tok, $array_nest, $tmppos);
if ($ref =~ /^\s*(\d+)\s+(\d+)\s+R\s*$/) {
$tmppos = tell (PDF);
&pos_ref ($ref);
$tok = &token;
if ($tok ne "[") {
die "get_ref_array: array expected, found '$tok' !!";
};
if ($tok eq "[") {
$array_nest = 1; # first '[' already scanned
$val = $tok;
do {
$tok = &token;
$val .= " ".$tok;
$array_nest++ if ($tok eq "[");
$array_nest-- if ($tok eq "]");
} until (($array_nest == 0) && ($tok eq "]"));
}
seek (PDF, $tmppos, 0);
}
else {
die "get_ref_array: '$ref' must be a reference !!";
};
return $val;
}
sub enc85
{
local ($val) = @_;
local ($tmp, $b1, $b2, $b3, $b4, $b5);
use integer;
# print "TRACE: enc85: val=$val\n";
return "z" if ($val == 0);
if ($val < 0) { # Because some don't support unsigned long
$tmp = 32;
$val = $val - (85 * 85 * 85 * 85 * 32);
}
if ($val < 0) {
$tmp = 64;
$val = $val - (85 * 85 * 85 * 85 * 32);
}
$b1 = (($val / (85 * 85 * 85 * 85)) + $tmp) + 33;
$val %= (85 * 85 * 85 * 85);
$b2 = ($val / (85 * 85 * 85)) + 33;
$val %= (85 * 85 * 85);
$b3 = ($val / (85 * 85)) + 33;
$val %= (85 * 85);
$b4 = ($val / 85) + 33;
$val %= 85;
$b5 = ($val) + 33;
return pack ("C5", $b1, $b2, $b3, $b4, $b5);
}
# $blen MUST be a multiple of 4 exept for the last chunk
sub encodeASCII85
{
local ($blen, $buf, $last, $OUTFILE) = @_;
local ($i, $v, $off);
$off = 0;
while ($blen >= 4) {
$v = unpack ("L", substr ($buf, $off, 4));
$off += 4;
$blen -= 4;
$i = &enc85 ($v);
$pos85 += length ($i);
print $OUTFILE $i;
if ($pos85 > 72) {
print $OUTFILE "\n";
$pos85 = 0;
}
}
if ($blen && (! $last)) {
warn "internal: ascii base-85 encoding called inconsistently";
}
if ($blen) {
$v = 0;
$i = 0;
while ($i < $blen) {
$v = $v * 256 + unpack ("C", substr ($buf, $off, 1));
$off++;
$i++;
}
while ($i < 4) {
$v = $v * 256;
$i++;
}
print $OUTFILE substr (&enc85 ($v), 0, $blen + 1);
$pos85 += $blen + 1;
}
if ($last) {
print $OUTFILE "~>";
$pos85 = 0;
}
}
sub copyAndEnc85
{
local ($encLen, $INFILE, $OUTFILE) = @_;
local ($val, $i, $outstr);
use integer;
# print "TRACE: copyAndEnc85: encLen=$encLen\n";
$outstr = "";
$val = 0;
while ($encLen >= 4) {
$val = ord (getc $INFILE);
$val = ($val * 256) + ord (getc $INFILE);
$val = ($val * 256) + ord (getc $INFILE);
$val = ($val * 256) + ord (getc $INFILE);
$encLen -= 4;
$outstr .= &enc85 ($val);
if (length ($outstr) > 66) {
print $OUTFILE "$outstr\n";
$outstr = "";
}
}
if ($encLen) {
$val = 0;
$i = 0;
while ($i < $encLen) {
$val = $val * 256 + ord (getc $INFILE);
$i++;
}
while ($i < 4) {
$val = $val * 256;
$i++;
}
$outstr .= substr (&enc85 ($val), 0, $encLen + 1);
}
print $OUTFILE "$outstr~>";
}
sub encodeHex
{
local ($blen, $buf, $last, $OUTFILE) = @_;
$blen *= 2;
printf $OUTFILE "%s%s\n", unpack ("H$blen", $buf), ($last) ? ">" : "";
}
sub copy_stream_len
{ # copy stream from PDF current position to $OUTFILE
local ($cpSlen, $OUTFILE) = @_;
local ($l, $n, $buf, $chunksize);
$l = $cpSlen;
$cpSlen = &get_val ($cpSlen); # might be a reference, won't harm otherwise
# print "TRACE: copy_stream_len: len=$cpSlen (oldl=$l)\n";
while (<PDF>) {
last if (/^stream/);
};
$n = tell(PDF);
seek (PDF, $n - 6, 0);
while (1) {
$c = getc(PDF);
last if ($c eq "m"); # "streaM"
}
$c = getc (PDF); # get LF (or CR) char behind word "stream"
$n = tell(PDF);
$c = getc (PDF) if ($c eq "\015"); # get LF if previous was CR
if ($c ne "\012") {
warn "Illegal chars after 'stream': (CR) not followed by LF (PDF pos $n)\n"
unless ($pdf_version == 1000);
seek (PDF, $n, 0);
}
$chunksize = 1024; # for direct copy
$chunksize = 38 if ($streamOutMode == 1); # HexEncoded
# $chunksize = 56 if ($streamOutMode == 2); # ASCII85Encoded ???
if ($streamOutMode == 2) {
if (1) {
©AndEnc85 ($cpSlen, PDF, $OUTFILE);
}
else { local ($tnam) = "/tmp/_e85_$$";
open (E85, "|encode85>$tnam") || die "PIPE setup";
while ($cpSlen > 0) {
$l = $chunksize;
$l = $cpSlen if ($cpSlen < $chunksize);
$n = read (PDF, $buf, $l);
warn "stream read: wanted $l bytes, got only $n" if ($n != $l);
print E85 $buf;
$cpSlen -= $n;
};
close E85;
open (I85, "<$tnam");
while ($n = read (I85, $buf, 1024)) {
print $OUTFILE $buf;
}
close I85;
print $OUTFILE "~>";
unlink $tnam;
}
}
else {
while ($cpSlen > 0) {
$l = $chunksize;
$l = $cpSlen if ($cpSlen < $chunksize);
$n = read (PDF, $buf, $l);
warn "stream read: wanted $l bytes, got only $n" if ($n != $l);
if ($streamOutMode == 0) {
print $OUTFILE "$buf";
} elsif ($streamOutMode == 1) {
&encodeHex ($n, $buf, ($n == $cpSlen), $OUTFILE);
} elsif ($streamOutMode == 2) {
&encodeASCII85 ($n, $buf, ($n == $cpSlen), $OUTFILE);
} else {
warn "internal: illegal streamOutMode ($streamOutMode)\n";
print $OUTFILE "$buf";
}
$cpSlen -= $n;
};
}
$_ = <PDF>;
$_ = <PDF> if (/^[\012\015]*$/);
unless (m:^endstream:){ local ($p); $p = tell (PDF);
warn "stream read: 'endstream' not found (p=$p)" ;
open (ERR, ">>/tmp/PDF_ERR");
print ERR "stream read (p=$p): 'endstream' not found in '$_'\n";
};
$streamOutMode = 0;
# while (<PDF>) {
# last if (/^endstream/);
# print $OUTFILE $_;
# };
};
sub cs_prolog
{
local($csname, $csref) = @_;
local(%csdir);
return if $loaded{$csname};
#$loaded{$csname} = 1; # auch bei fehler nicht noch mal laden
### ??? not yet finished !!!!
#&pos_ref ($csref);
#%csdir = &load_dir;
# &dump_dir (%csdir);
};
sub do_xobj_form
{
local ($xname, %xdir) = @_;
local ($ftype, $BBox, $filter, $dp, $matrix);
$ftype = $xdir{"FormType"};
if ($ftype != 1) {
print PS "% $xname: Can't deal with $ftype FormType (faked)\n";
print PS "/$xname { } def\n";
warn "$xname: Can't deal with $ftype FormType (faked)\n";
return;
}
$len = $xdir{"Length"};
$len = &get_val($len);
$BBox = $xdir{"BBox"};
$matrix = $xdir{"Matrix"};
print PS "% load XObject $xname here:\n";
print PS "/$xname { 5 dict\nbegin\n";
if ($len > 65500) {
print PS " /.pa_cnt 0 def\n";
print PS " /_pdf_xobject_$xname {\n";
print PS " _pdf_xobjectArray_$xname .pa_cnt get\n";
print PS " /.pa_cnt .pa_cnt 1 add def\n";
print PS " } def\n";
}
print PS " << /FormType 1 /BBox $BBox\n ";
print PS "/Matrix $matrix\n";
$dp = $xdir{"DecodeParms"};
print PS "% DecodeParms = $dp\n" if ($dp);
$filter = &gen_filterChain ($xdir{"Filter"}, $dp);
print PS " /PaintProc { pop _pdf_xobject_$xname \n";
print PS " $filter cvx exec }\n";
print PS " >> execform\nend } def\n";
print PS "% store /$xname data:\n";
local ($op, $target);
if ($len > 65500) {
$op = "copy_to_procarray";
$target = "/_pdf_xobjectArray_$xname";
}
else {
$op = "copy_to_string";
$target = "/_pdf_xobject_$xname";
}
if ($stream_is_binary && $avoidBinary) {
$streamOutMode = $defaultAsciiMode;
$op .= $defaultAsciiProcSuffix;
}
print PS " $target $len $op\n";
©_stream_len ($len, PS);
print PS "\n%%_pdf_End_of_Data\n";
}
sub xobj_prolog
{
local($xname, $xref) = @_;
local(%xdir, $xtype, $nam, $w, $h, $bpc, $cs, $hcs, $filter, $tmppos);
local($len, $imask, $dp);
return if $loaded{$xname};
$loaded{$xname} = 1; # auch bei fehler nicht noch mal laden
&pos_ref ($xref);
%xdir = &load_dir;
# &dump_dir (%xdir);
$xtype = $xdir{"Subtype"};
$nam = $xdir{"Name"};
if ($xtype ne "/Image") {
# $prolog_error = 1;
if ($xtype eq "/Form") {
&do_xobj_form ($xname, %xdir);
return;
};
print PS "% $xname: Can't deal with $xtype XObjects yet (faked)\n";
print PS "/$xname { } def\n";
warn "$xname: Can't deal with $xtype XObjects yet (faked)\n";
return;
};
$w = $xdir{"Width"};
$h = $xdir{"Height"};
$bpc = $xdir{"BitsPerComponent"};
$imask = ($xdir{"ImageMask"} eq "true");
$len = $xdir{"Length"};
$len = &get_val($len);
$cs = $xdir{"ColorSpace"};
$dec = $xdir{"Decode"};
$hcs = $cs;
$hcs = &get_val($cs) if ($cs =~ /^\d+\s+\d+\s+R$/);
if ($hcs eq "[") {
$hcs = &get_ref_array($cs) if ($cs =~ /\d+\s+\d+\s+R/);
$cs = "/Indexed";
print "/Indexed Image on page $pg\n";
}
else {
$cs = $hcs;
};
$dec = $Decode{$cs} unless ($xdir{"Decode"});
if ($hcs =~
m:\[\s*/Indexed\s*(/Device[A-Z]+)\s+(\d+)\s+(\d+\s+\d+\s+R)\s*\]:) {
local ($base, $hival, $lookup, $lnam);
$base = $1;
$hival = $2;
$lookup = $3;
$lnam = $lookup;
$lnam =~ s: R::;
$lnam =~ s: :_:g;
$lnam = "inx_lookup_obj_$lnam";
&load_print_index_lookup($lookup, $lnam, PS)
unless $loaded{$lnam};
$loaded{$lnam} = 1;
$hcs = "[/Indexed$base $hival $lnam]";
$dec = "[0 $hival]" unless ($xdir{"Decode"});
};
print PS "% load XObject $xname here:\n";
print PS "/$xname { 5 dict\nbegin\n";
if ($len > 65500) {
print PS " /.pa_cnt 0 def\n";
print PS " /_pdf_xobject_$xname {\n";
print PS " _pdf_xobjectArray_$xname .pa_cnt get\n";
print PS " /.pa_cnt .pa_cnt 1 add def\n";
print PS " } def\n";
}
print PS " $hcs setcolorspace\n" unless $imask;
# print PS " gsave [$w 0 0 -$h 0 $h] concat mk_cross grestore\n";
print PS " gsave mk_cross grestore\n" unless ($imask); # shines through
print PS " << /ImageType 1 /Width $w /Height $h\n ";
print PS "/ImageMatrix [$w 0 0 -$h 0 $h]\n";
$dp = $xdir{"DecodeParms"};
print PS "% DecodeParms = $dp\n" if ($dp);
$filter = &gen_filterChain ($xdir{"Filter"}, $dp);
print PS " /DataSource { _pdf_xobject_$xname }\n";
print PS " $filter\n";
print PS " /BitsPerComponent $bpc";
print PS " /Decode $dec" if $dec;
if ($imask)
{ print PS " /Decode [0 1] " unless $dec;
print PS " >> imagemask\nend } def\n";
}
else
{ print PS " >> image\nend } def\n";}
if (0 && ($xdir{"Filter"} =~ m:/CCITTFaxDecode:)) {
# bug in NeXT DiplayPostScript interpreter up to NEXTSTEP version 3.2
# fixed since NEXTSTEP 3.3 (delete the "0 &&" above if you run <= 3.2)
print PS "% image $xname omitted due to bug in PS CCITTFaxDecode\n";
print "% image $xname omitted due to bug in PS CCITTFaxDecode\n";
print PS "/$xname { gsave mk_cross /Helvetica findfont 0.05 scalefont
setfont 0.2 0.4 moveto ($xname) show grestore } def
% override def to avoid any harm\n";
}
print PS "% store /$xname data:\n";
local ($op, $target);
if ($len > 65500) {
$op = "copy_to_procarray";
$target = "/_pdf_xobjectArray_$xname";
}
else {
$op = "copy_to_string";
$target = "/_pdf_xobject_$xname";
}
if ($stream_is_binary && $avoidBinary) {
$streamOutMode = $defaultAsciiMode;
$op .= $defaultAsciiProcSuffix;
}
print PS " $target $len $op\n";
# print STDERR "CALL(1): copy_stream_len ($len, PS)\n";
©_stream_len ($len, PS);
print PS "\n%%_pdf_End_of_Data\n";
};
sub scan_outlines
{
local ($ort) = @_;
local (%odir, $l, $f);
return unless $ort;
%odir = &load_dir_by_ref ($ort);
$l = $odir{"Last"};
$f = $odir{"First"};
return unless $f;
&scan_one_level ($f, $l, ":= ");
}
sub scan_one_level
{
local ($el, $end, $pref) = @_;
local (%edir, $i);
# print "$pref--- Start (sub-)list\n";
$i = 0;
while (1) {
$i++;
%edir = &load_dir_by_ref ($el);
print "$pref $i. $edir{'Title'} ==> $edir{'Dest'}\n";
if ($edir{"Count"}) {
&scan_one_level ($edir{"First"}, $edir{"Last"}, "$pref ");
};
last if ($el eq $end);
$el = $edir{"Next"};
}
# print "$pref--- End list ($i entries)\n";
return;
}
sub init
{ # Base-14 fonts (always defined in PDF)
$FontBase{"/Courier"} = 14;
$FontBase{"/Courier-Bold"} = 14;
$FontBase{"/Courier-Oblique"} = 14;
$FontBase{"/Courier-BoldOblique"} = 14;
$FontBase{"/Helvetica"} = 14;
$FontBase{"/Helvetica-Bold"} = 14;
$FontBase{"/Helvetica-Oblique"} = 14;
$FontBase{"/Helvetica-BoldOblique"} = 14;
$FontBase{"/Times-Roman"} = 14;
$FontBase{"/Times-Bold"} = 14;
$FontBase{"/Times-Italic"} = 14;
$FontBase{"/Times-BoldItalic"} = 14;
$FontBase{"/Symbol"} = 14;
$FontBase{"/ZapfDibgbats"} = 14;
# Base-35 fonts (found in most PostScript printers)
$FontBase{"/AvantGarde-Book"} = 35;
$FontBase{"/AvantGarde-BookOblique"} = 35;
$FontBase{"/AvantGarde-Demi"} = 35;
$FontBase{"/AvantGarde-DemiOblique"} = 35;
$FontBase{"/Bookman-Demi"} = 35;
$FontBase{"/Bookman-DemiItalic"} = 35;
$FontBase{"/Bookman-Light"} = 35;
$FontBase{"/Bookman-LightItalic"} = 35;
$FontBase{"/Helvetica-Narrow"} = 35;
$FontBase{"/Helvetica-Narrow-Bold"} = 35;
$FontBase{"/Helvetica-Narrow-Oblique"} = 35;
$FontBase{"/Helvetica-Narrow-BoldOblique"} = 35;
$FontBase{"/NewCenturySchlbk-Bold"} = 35;
$FontBase{"/NewCenturySchlbk-BoldItalic"} = 35;
$FontBase{"/NewCenturySchlbk-Italic"} = 35;
$FontBase{"/NewCenturySchlbk-Roman"} = 35;
$FontBase{"/Palatino-Bold"} = 35;
$FontBase{"/Palatino-BoldItalic"} = 35;
$FontBase{"/Palatino-Italic"} = 35;
$FontBase{"/Palatino-Roman"} = 35;
$FontBase{"/ZapfDingbats"} = 35;
$Decode{"/DeviceGray"} = "[0 1]";
$Decode{"/DeviceRGB"} = "[0 1 0 1 0 1]";
$Decode{"/DeviceCMYK"} = "[0 1 0 1 0 1 0 1]";
$Decode{"/CIEBasedABC"} = "[0 1 0 1 0 1]";
$Decode{"/CIEBasedA"} = "[0 1]";
$Decode{"/Seperation"} = "[0 1]";
$Decode{"/Indexed"} = "[0 255]"; # Dummy, 255 not ok !!! ???
};
######### Main Program ############
print "Analyzing PDF file '$pdffile'\n";
# load cross refrence table
&init;
&find_startxref;
die "PDF file structure corrupt - can't continue.\n" unless $startxref;
open (LOG, ">$basename.log") if $logging;
printf "Xref starts at %d\n", $startxref if $verbose;
$pos = $startxref;
while (1) {
&load_xref ($pos);
if (1) {
(/^trailer/) || die "Trailer keyword not recognized\n";
$tbuf = <PDF>;
}
else {
(&token eq "trailer") || die "Trailer keyword not recognized\n";
# $tbuf = <PDF>;
}
%tmp = &load_dir;
%document = %tmp unless $document{"Root"}; # preserve "latest" trailer
$pos = $tmp{"Prev"};
last unless $pos;
};
printf "Root is '%s', Info is '%s'\n",
$document{"Root"}, $document{"Info"} if $verbose;
&dump_dir (%document) if $verbose;
if ($document{"Encrypt"}) {
unlink ("$basename.ps");
die "\nThis document is encrypted. The en/decryption algorithm is
not documented by Adobe, so I can't convert it - sorry\n\n"
}
# get catalog object
print LOG "== get catalog object\n" if $logging;
&pos_ref ($document{"Root"});
%catalog = &load_dir;
if ($verbose) {
print "Catalog:\n";
&dump_dir (%catalog);
};
# print "Outlines ignored\n" if $catalog{"Outlines"};
&scan_outlines ($catalog{"Outlines"}) if $verbose;
# get list of page objects
print LOG "== get list of page objects\n" if $logging;
$page_cnt = 0;
&load_pages ($catalog{"Pages"});
# write header
open (PS, ">$basename.ps");
print "Output File: $basename.ps\n";
print PS "%!PS-Adobe-2.0\n";
print PS "%%Title: $pdffile\n";
$Date = &ctime(time);
$tmp = $0;
$tmp =~ s:.*/::; # strip leading path if present
print PS "%%CreationDate: $Date";
print PS "%%Creator: $tmp (Version $Version [Rev $Rev], (C) 1993-1995 by D. Droege)\n";
print PS "%%BoundingBox: 0 0 612 842\n";
print PS "%%Pages: $page_cnt 1\n";
print PS "%%For: $ENV{'USER'}@$ENV{'HOST'}\n";
print PS "%%DocumentNeededResources: (atend)\n";
print PS "%%DocumentSuppliedResources: (atend)\n";# ??? avoid if not needed
print PS "%%LanguageLevel: 2\n"; # needed for 'filter' etc.
print PS "%%EndComments\n";
print PS "\n%%BeginProlog\n\n";
print PS "systemdict /languagelevel known\n";
print PS " {languagelevel 2 ge}{false}ifelse not\n";
print PS " {(== Must run on PostScript Level 2 device ==)== stop} if\n\n";
print PS "\n%%BeginResource: procset PDF_ProcSet\n 1 setobjectformat\n";
&put_proc_set;
print PS " /copy_to_string_Hex { % /strname length copy_to_string_Hex
string currentfile /ASCIIHexDecode filter exch readstring pop def
} bd\n";
print PS " /copy_to_string_A85 { % /strname length copy_to_string_A85
string currentfile /ASCII85Decode filter exch readstring pop def
} bd\n";
print PS " /copy_to_procarray_fil { % /paname length file copy_to_procarray
/.xfile exch def
/.xlen exch def
/.xnamA exch def
[
{
.xlen 0 le { exit } if
.xlen 4096 le { .xlen } { 4096 } ifelse
dup .xlen exch sub /.xlen exch def
string .xfile exch readstring pop
} loop
() % empty string as EOD to signal end of data
] .xnamA exch def
} bd\n";
print PS " /copy_to_procarray_Hex { % /paname length copy_to_procarray_Hex
currentfile /ASCIIHexDecode filter copy_to_procarray_fil
} bd\n";
print PS " /copy_to_procarray_A85 { % /paname length copy_to_procarray_A85
currentfile /ASCII85Decode filter copy_to_procarray_fil
} bd\n";
print PS "\n%%EndResource\n\n";
print LOG "== collect needed resources/writing prolog\n" if $logging;
print "Writing out $page_cnt page resources ...\n";
for ($pg = 1; $pg <= $page_cnt; $pg++) {
&gen_page_resource ($pg);
# print STDERR "$pg " if (($pg % 10) == 0);
};
print " generated $XObjects XObjects\n" if $XObjects;
print " $cnt_annots Annotations ignored\n" if ($verbose && $cnt_annots);
print PS "\n%%EndProlog\n";
if ((! $NoThumbs) && $setup_thumb_done) {
print THUMB "showpage\n%%Trailer\n%%Pages: $thumb_pg 1\n";
close THUMB;
};
# print STDERR "\n";
die "Error while generating PostScript Prolog\n" if $prolog_error;
print LOG "== generate pages\n" if $logging;
for ($pg = 1; $pg <= $page_cnt; $pg++) {
print STDERR "[$pg";
print PS "\n%%Page: $pg $pg\n";
&gen_page_output ($pg);
print STDERR "] ";
print STDERR "\n" if (($pg % 10) == 0);
};
print STDERR "\n" if (! ((($pg - 1) % 10) == 0));
# print PS "usertime startTime sub 1000 div 20 string cvs ==\n";
print PS "%%Trailer\n";
# ??? veraltet, umstellen auf ...SuppliedResurces ...
$first = 1;
foreach $fnt (sort keys(%DocFonts)) {
next if ($FontBase{$fnt} > 35);
$fnt =~ s:^/::;
if ($first == 1) {
print PS "%%DocumentNeededResources: font $fnt\n";
$first = 0;
}
else {
print PS "%%+ font $fnt\n";
};
};
foreach $fnt (sort keys(%DocFonts)) {
next if ($FontBase{$fnt} > 35);
$fnt =~ s:^/::;
print PS "%%IncludeResource: font $fnt\n";
};
print PS "%%DocumentSuppliedResources: procset PDF_ProcSet\n";
foreach $fnt (sort keys(%DocFonts)) {
next if ($FontBase{$fnt} <= 35);
$fnt =~ s:^/::;
print PS "%%+ font $fnt\n";
};
print PS "%%EOF\n";
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.