% Copyright (C) 1994, 1995 Aladdin Enterprises. All rights reserved. % % This file is part of GNU Ghostscript. % % GNU Ghostscript is distributed in the hope that it will be useful, but % WITHOUT ANY WARRANTY. No author or distributor accepts responsibility to % anyone for the consequences of using it or for whether it serves any % particular purpose or works at all, unless he says so in writing. Refer % to the GNU Ghostscript General Public License for full details. % % Type 1 font support code. % The standard representation for PostScript compatible fonts is described % in the book "Adobe Type 1 Font Format", published by Adobe Systems Inc. % Define an augmented version of .buildfont1 that inserts UnderlinePosition % and UnderlineThickness entries in FontInfo if they aren't there already. % (This works around the incorrect assumption, made by many word processors, % that these entries are present in the built-in fonts.) /.buildfont1 { dup /FontInfo known not { .growfontdict dup /FontInfo 2 dict put } if dup dup /FontInfo get dup dup /UnderlinePosition known exch /UnderlineThickness known and { pop pop % entries already present } { dup length 2 add dict copy dup /UnderlinePosition known not { dup /UnderlinePosition 3 index /FontBBox get 1 get 2 div put % 1/2 the font descent } if dup /UnderlineThickness known not { dup /UnderlineThickness 3 index /FontBBox get dup 3 get exch 1 get sub 20 div put % 1/20 the font height } if 1 index /FontInfo get wcheck not { readonly } if /FontInfo exch put } ifelse //.buildfont1 } bind def % If DISKFONTS is true, we load individual CharStrings as they are needed. % (This is intended primarily for machines with very small memories.) % Initially, the character definition is the file position of the definition; % this gets replaced with the actual CharString. % Note that if we are loading characters lazily, CharStrings is writable. % _Cstring must be long enough to hold the longest CharString for % a character defined using seac. This is lenIV + 4 * 5 (for the operands % of sbw, assuming div is not used) + 2 (for sbw) + 3 * 5 (for the operands % of seac other than the character codes) + 2 * 2 (for the character codes) % + 2 (for seac), i.e., lenIV + 43. /_Cstring 60 string def % When we initially load the font, we call % cskip_C % to skip over each character definition and return the file position instead. % This substitutes for the procedure % string currentfile exch read[hex]string pop % [encrypt] % What we actually store is fileposition * 1000 + length, % negated if the string is stored in binary form. % Older fonts use skip_C rather than cskip_C. % skip_C takes /readstring or /readhexstring as its third argument, % instead of the entire reading procedure. /skipproc_C {string currentfile exch readstring pop} cvlit def /skip_C { //skipproc_C dup 3 4 -1 roll put cvx readonly cskip_C } bind def /cskip_C { exch dup 1000 ge 3 index type /nametype ne or { % This is a Subrs string, or the string is so long we can't represent % its length. Load it now. exch exec } { % Record the position and length, and skip the string. dup currentfile fileposition 1000 mul add 2 index 3 get /readstring cvx eq { neg } if 3 1 roll dup _Cstring length idiv { currentfile _Cstring 3 index 3 get exec pop pop } repeat _Cstring length mod _Cstring exch 0 exch getinterval currentfile exch 3 -1 roll 3 get exec pop pop } ifelse } bind def % Type1BuildGlyph calls load_C to actually load the character definition. /load_C % load_C - { dup abs 1000 idiv FontFile exch setfileposition CharStrings 3 1 roll dup 0 lt { neg 1000 mod string FontFile exch readstring } { 1000 mod string FontFile exch readhexstring } ifelse pop % If the CharStrings aren't encrypted on the file, encrypt now. Private /-| get 0 get dup type /nametype ne { dup length 5 sub 5 exch getinterval exec } { pop } ifelse dup 4 1 roll put % If the character is defined with seac, load its components now. mark exch seac_C counttomark { StandardEncoding exch get dup CharStrings exch get dup type /integertype eq { load_C } { pop pop } ifelse } repeat pop % the mark } bind def /seac_C % seac_C ..or nothing.. { dup length _Cstring length le { 4330 exch _Cstring .type1decrypt exch pop dup dup length 2 sub 2 getinterval <0c06> eq % seac { dup length Private /lenIV known { Private /lenIV get } { 4 } ifelse exch 1 index sub getinterval % Parse the string just enough to extract the seac information. % We assume that the only possible operators are hsbw, sbw, and seac, % and that there are no 5-byte numbers. mark 0 3 -1 roll { exch { { dup 32 lt { pop 0 } { dup 247 lt { 139 sub 0 } { dup 251 lt { 247 sub 256 mul 108 add 1 1 } { 251 sub -256 mul -108 add -1 1 } ifelse } ifelse } ifelse } % 0 { mul add 0 } % 1 } exch get exec } forall pop counttomark 1 add 2 roll cleartomark % pop all but achar bchar } { pop % not seac } ifelse } { pop % punt } ifelse } bind def % Define an auxiliary procedure for loading a font. % If DISKFONTS is true and the body of the font is not encrypted with eexec: % - Prevent the CharStrings from being made read-only. % - Substitute a different CharString-reading procedure. % (eexec disables this because the implicit 'systemdict begin' hides % the redefinitions that make the scheme work.) % We assume that: % - The magic procedures (-|, -!, |-, and |) are defined with % executeonly or readonly; % - The contents of the reading procedures are as defined in bdftops.ps; % - The font includes the code % /CharStrings readonly put /.loadfontdict 6 dict def mark /begin % push this dict after systemdict { dup begin //systemdict eq { //.loadfontdict begin } if } bind /end % match begin { currentdict end //.loadfontdict eq currentdict //systemdict eq and { end } if } bind /dict % leave room for FontFile { 1 add dict } bind /executeonly % for reading procedures { readonly } /noaccess % for Subrs strings and Private dictionary { readonly } /readonly % for procedures and CharStrings dictionary { % We want to take the following non-standard actions here: % - If the operand is the CharStrings dictionary, do nothing; % - If the operand is a number (a file position replacing the % actual CharString), do nothing; % - If the operand is either of the reading procedures (-| or -!), % substitute a different one. dup type /dicttype eq % CharStrings or Private count 2 gt and { 1 index /CharStrings ne { readonly } if } { dup type /arraytype eq % procedure or data array { dup length 5 ge 1 index xcheck and { dup 0 get /string eq 1 index 1 get /currentfile eq and 1 index 2 get /exch eq and 1 index 3 get dup /readstring eq exch /readhexstring eq or and 1 index 4 get /pop eq and { /cskip_C cvx 2 packedarray cvx } { readonly } ifelse } { readonly } ifelse } { dup type /stringtype eq % must be a Subr string { readonly } if } ifelse } ifelse } bind counttomark 2 idiv { .loadfontdict 3 1 roll put } repeat pop .loadfontdict readonly pop /.loadfont % .loadfont - { mark exch systemdict begin DISKFONTS { .loadfontdict begin } if % We really would just like systemdict on the stack, % but fonts produced by Fontographer require a writable dictionary.... userdict begin % We can't just use `run', because we want to check for .PFB files. currentpacking { false setpacking .loadfont1 true setpacking } { .loadfont1 } ifelse { stop } if end DISKFONTS { end } if end cleartomark } bind def /.loadfont1 % .loadfont1 { % We would like to use `false /PFBDecode filter', % but this occasionally produces a whitespace character as % the first of an eexec section, so we can't do it. % Also, since the real input file never reaches EOF if we are using % a PFBDecode filter (the filter stops just after reading the last % character), we must explicitly close the real file in this case. % Since the file might leave garbage on the operand stack, % we have to create a procedure to close the file reliably. { dup read not { -1 } if 2 copy unread 16#80 eq { [ exch dup true /PFBDecode filter cvx exch cvlit systemdict /closefile get ] } if cvx exec } stopped $error /newerror get and } bind def % The CharStrings are a dictionary in which the key is the character name, % and the value is a compressed and encrypted representation of a path. % For detailed information, see the book "Adobe Type 1 Font Format", % published by Adobe Systems Inc. % Here are the BuildChar and BuildGlyph implementation for Type 1 fonts. % The names Type1BuildChar and Type1BuildGlyph are known to the interpreter. /Type1BuildChar % Type1BuildChar - { 1 index /Encoding get 1 index get .type1build } bind def /Type1BuildGlyph % Type1BuildGlyph - { dup .type1build } bind def /.type1build % .type1build - { 3 -1 roll begin dup CharStrings exch .knownget not { 2 copy eq { exch pop /.notdef exch } if QUIET not { (Substituting .notdef for ) print = flush } { pop } ifelse /.notdef CharStrings /.notdef get } if % stack: codename charname charstring PaintType 0 ne { % Any reasonable implementation would execute something like % 1 setmiterlimit 0 setlinejoin 0 setlinecap % here, but apparently the Adobe implementations aren't reasonable. currentdict /StrokeWidth .knownget not { 0 } if setlinewidth } if dup type /stringtype eq % encoded outline { 3 -1 roll pop 0 0 moveto outline_C } { dup type /integertype eq % file position for lazy loading { 3 -1 roll pop 1 index exch load_C dup CharStrings exch get 0 0 moveto outline_C } { % PostScript procedure exch pop currentdict end systemdict begin begin exec end } ifelse } ifelse end } bind def % Expand the bounding box before calling setcachedevice. % Because of square caps and miter joins, the maximum expansion on each side % is max(sqrt(2), miter_limit) * line_width/2. % (setcachedevice adds the necessary 1- or 2-pixel fuzz.) /expandbox_C % expandbox_C <...ditto...> { PaintType 0 ne { 1.415 currentmiterlimit max currentlinewidth mul 2 div % llx lly urx ury exp 5 1 roll 4 index add % exp llx lly urx ury+ 5 1 roll 3 index add % ury+ exp llx lly urx+ 5 1 roll 2 index sub % urx+ ury+ exp llx lly- 5 1 roll exch sub % lly- urx+ ury+ llx- 4 1 roll } if } bind def % Make the call on setcachedevice a separate procedure, so we can redefine it % if the composite font extensions are present. /setcache_C where % gs_type0.ps might be loaded first! { pop } { /setcache_C { setcachedevice pop } bind def } ifelse /outline_C % outline_C - { % In order to make character oversampling work, we must % set up the cache before calling .type1addpath. % To do this, we must get the bounding box from the FontBBox, % and the width and left side bearing from the CharString. % (If the FontBBox isn't valid, we punt.) currentdict /FontBBox .knownget { dup length 4 eq { aload pop dup 3 index gt 2 index 5 index gt and { bbox_C } { pop pop pop pop nobbox_C } ifelse } { pop nobbox_C } ifelse } { nobbox_C } ifelse PaintType 0 eq { fill } { stroke } ifelse } bind def % Handle the case where FontBBox is not valid. % In this case, we do the .type1addpath first, then the setcachedevice. % Oversampling is not possible. /nobbox_C % nobbox_C - { currentdict /Metrics .knownget { 2 index .knownget { dup type dup /integertype eq exch /realtype eq or { % exch .type1addpath 0 } { dup length 2 eq { % [ ] exch 1 index 0 get 0 .type1addpath 1 get 0 } { % [ ] aload pop 5 2 roll .type1addpath } ifelse } ifelse } { .type1addpath currentpoint } ifelse } { .type1addpath currentpoint } ifelse % stack: wx wy pathbbox expandbox_C setcache_C } bind def % Handle the case where FontBBox is valid. /bbox_C % ... bbox_C - { % Get the width and l.s.b. by parsing the CharString. % This isn't needed if we have a 4-element Metrics array, % but those are rare. 4 index .type1getsbw % stack: cname cstring llx lly urx ury sbx sby wx wy currentdict /Metrics .knownget { 10 index .knownget { dup type dup /integertype eq exch /realtype eq or { % exch pop exch pop 0 } { 5 1 roll pop pop pop pop dup length 2 eq { % [ ] aload pop 0 exch 0 } { % [ ] aload pop } ifelse } ifelse } if } if 8 4 roll expandbox_C 9 index 7 1 roll setcache_C .type1addpath pop } bind def