756 lines
22 KiB
PostScript
756 lines
22 KiB
PostScript
% Copyright (C) 1990, 1991 Aladdin Enterprises. All rights reserved.
|
|
% Distributed by Free Software Foundation, Inc.
|
|
%
|
|
% This file is part of Ghostscript.
|
|
%
|
|
% 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 Ghostscript General Public License for full details.
|
|
%
|
|
% Everyone is granted permission to copy, modify and redistribute
|
|
% Ghostscript, but only under the conditions described in the Ghostscript
|
|
% General Public License. A copy of this license is supposed to have been
|
|
% given to you along with Ghostscript so you can know your rights and
|
|
% responsibilities. It should be in a file named COPYING. Among other
|
|
% things, the copyright notice and this notice must be preserved on all
|
|
% copies.
|
|
|
|
% bdftops.ps
|
|
% Convert a BDF file (possibly with (an) associated AFM file(s))
|
|
% to a Ghostscript font.
|
|
|
|
% Ghostscript fonts are in the same format as Adobe Type 1 fonts,
|
|
% except that they do not use eexec encryption.
|
|
% See gs_fonts.ps for more information.
|
|
|
|
/envBDF 120 dict def
|
|
envBDF begin
|
|
|
|
% "Import" the image-to-path package.
|
|
% This also brings in the Type 1 opcodes (type1ops.ps).
|
|
(impath.ps) run
|
|
|
|
% "Import" the font-writing package.
|
|
(wrfont.ps) run
|
|
|
|
% Invert the StandardEncoding vector.
|
|
256 dict dup begin
|
|
0 1 255 { dup StandardEncoding exch get exch def } for
|
|
end /decoding exch def
|
|
|
|
% Define the dictionary equivalent of ].
|
|
/dicttomark
|
|
{ counttomark 2 idiv dup dict begin
|
|
{ def } repeat
|
|
pop currentdict end
|
|
} bind def
|
|
|
|
% Define the properties copied to FontInfo.
|
|
mark
|
|
(COPYRIGHT) /Notice
|
|
(FAMILY_NAME) /FamilyName
|
|
(FULL_NAME) /FullName
|
|
(WEIGHT_NAME) /Weight
|
|
dicttomark /properties exch def
|
|
|
|
% Define the character sequences used to fill in some undefined entries
|
|
% in the standard encoding.
|
|
mark
|
|
(AE) [/A /E]
|
|
(OE) [/O /E]
|
|
(acute) [/quoteright]
|
|
(ae) [/a /e]
|
|
(bullet) [/asterisk]
|
|
(cedilla) [/comma]
|
|
(circumflex) [/asciicircum]
|
|
(dieresis) [/quotedbl]
|
|
(dotlessi) [/i]
|
|
(ellipsis) [/period /period /period]
|
|
(emdash) [/hyphen /hyphen /hyphen]
|
|
(endash) [/hyphen /hyphen]
|
|
(exclamdown) [/exclam]
|
|
(fi) [/f /i]
|
|
(fl) [/f /l]
|
|
(florin) [/f]
|
|
(fraction) [/slash]
|
|
(germandbls) [/s /s]
|
|
(grave) [/quoteleft]
|
|
(guillemotleft) [/less /less]
|
|
(guillemotright) [/greater /greater]
|
|
(guilsinglleft) [/less]
|
|
(guilsinglright) [/greater]
|
|
(hungarumlaut) [/quotedbl]
|
|
(oe) [/o /e]
|
|
(periodcentered) [/asterisk]
|
|
(questiondown) [/question]
|
|
(quotedblbase) [/comma /comma]
|
|
(quotedblleft) [/quotedbl]
|
|
(quotedblright) [/quotedbl]
|
|
(quotesinglbase) [/comma]
|
|
(quotesingle) [/quoteright]
|
|
(tilde) [/asciitilde]
|
|
dicttomark /composites exch def
|
|
|
|
% Note the characters that must be defined as subroutines.
|
|
96 dict begin
|
|
0 composites
|
|
{ exch pop
|
|
{ dup currentdict exch known
|
|
{ pop }
|
|
{ 1 index def 1 add }
|
|
ifelse
|
|
}
|
|
forall
|
|
}
|
|
forall pop
|
|
currentdict
|
|
end /subrchars exch def
|
|
|
|
% Define the overstruck characters that can be synthesized with seac.
|
|
mark
|
|
[ /Aacute /Acircumflex /Adieresis /Agrave /Aring /Atilde
|
|
/Ccedilla
|
|
/Eacute /Ecircumflex /Edieresis /Egrave
|
|
/Iacute /Icircumflex /Idieresis /Igrave
|
|
/Lslash
|
|
/Ntilde
|
|
/Oacute /Ocircumflex /Odieresis /Ograve /Otilde
|
|
/Scaron
|
|
/Uacute /Ucircumflex /Udieresis /Ugrave
|
|
/Yacute /Ydieresis
|
|
/Zcaron
|
|
/aacute /acircumflex /adieresis /agrave /aring /atilde
|
|
/ccedilla
|
|
/eacute /ecircumflex /edieresis /egrave
|
|
/iacute /icircumflex /idieresis /igrave
|
|
/lslash
|
|
/ntilde
|
|
/oacute /ocircumflex /odieresis /ograve /otilde
|
|
/scaron
|
|
/uacute /ucircumflex /udieresis /ugrave
|
|
/yacute /ydieresis
|
|
/zcaron
|
|
]
|
|
{ dup dup length string cvs
|
|
[ exch dup 0 1 getinterval
|
|
exch dup length 1 sub 1 exch getinterval
|
|
]
|
|
} forall
|
|
/cent [/c /slash]
|
|
/daggerdbl [/bar /equal]
|
|
/divide [/colon /hyphen]
|
|
/sterling [/L /hyphen]
|
|
/yen [/Y /equal]
|
|
dicttomark /accentedchars exch def
|
|
|
|
% ------ BDF file parsing utilities ------ %
|
|
|
|
% Define a buffer for reading the BDF file.
|
|
/buffer 400 string def
|
|
|
|
% Read a line from the BDF file into the buffer.
|
|
% Define /keyword as the first word on the line.
|
|
% Define /args as the remainder of the line.
|
|
% If the keyword is equal to commentword, skip the line.
|
|
% (If commentword is equal to a space, never skip.)
|
|
/nextline
|
|
{ bdfile buffer readline not
|
|
{ (Premature EOF\n) print stop } if
|
|
( ) search
|
|
{ /keyword exch def pop }
|
|
{ /keyword exch def () }
|
|
ifelse
|
|
/args exch def
|
|
keyword commentword eq { nextline } if
|
|
} bind def
|
|
|
|
% Get a word argument from args. We do *not* copy the string.
|
|
/warg % warg -> string
|
|
{ args ( ) search
|
|
{ exch pop exch }
|
|
{ () }
|
|
ifelse /args exch def
|
|
} bind def
|
|
|
|
% Get an integer argument from args.
|
|
/iarg % iarg -> int
|
|
{ warg cvi
|
|
} bind def
|
|
|
|
% Get a numeric argument from args.
|
|
/narg % narg -> int|real
|
|
{ warg cvr
|
|
dup dup cvi eq { cvi } if
|
|
} bind def
|
|
|
|
% Convert the remainder of args into a string.
|
|
/remarg % remarg -> string
|
|
{ args copystring
|
|
} bind def
|
|
|
|
% Get a string argument that occupies the remainder of args.
|
|
/sarg % sarg -> string
|
|
{ args (") anchorsearch
|
|
{ pop /args exch def } { pop } ifelse
|
|
args args length 1 sub get (") 0 get eq
|
|
{ args 0 args length 1 sub getinterval /args exch def } if
|
|
args copystring
|
|
} bind def
|
|
|
|
% Check that the keyword is the expected one.
|
|
/checkline % (EXPECTED-KEYWORD) checkline ->
|
|
{ dup keyword ne
|
|
{ (Expected ) print =
|
|
(Line=) print keyword print ( ) print args print (\n) print stop
|
|
} if
|
|
pop
|
|
} bind def
|
|
|
|
% Read a line and check its keyword.
|
|
/getline % (EXPECTED-KEYWORD) getline ->
|
|
{ nextline checkline
|
|
} bind def
|
|
|
|
% Find the first/last non-zero bit of a non-zero byte.
|
|
/fnzb
|
|
{ 0 { exch dup 128 ge { pop exit } { dup add exch 1 add } ifelse }
|
|
loop
|
|
} bind def
|
|
/lnzb
|
|
{ 7 { exch dup 1 and 0 ne { pop exit } { -1 bitshift exch 1 sub } ifelse }
|
|
loop
|
|
} bind def
|
|
|
|
% ------ Type 1 encoding utilities ------ %
|
|
|
|
% Parse the side bearing and width information that begins a CharString.
|
|
% Arguments: charstring. Result: mark sbx wx substring *or*
|
|
% mark sbx sby wx wy substring.
|
|
/parsesbw
|
|
{ mark exch lenIV
|
|
{ % stack: mark ... string dropcount
|
|
dup 2 index length exch sub getinterval
|
|
dup 0 get dup 32 lt { pop exit } if
|
|
dup 246 le
|
|
{ 139 sub exch 1 }
|
|
{ dup 250 le
|
|
{ 247 sub 8 bitshift 108 add 1 index 1 get add exch 2 }
|
|
{ dup 254 le
|
|
{ 251 sub 8 bitshift 108 add 1 index 1 get add neg exch 2 }
|
|
{ pop dup 1 get 128 xor 128 sub
|
|
8 bitshift 1 index 2 get add
|
|
8 bitshift 1 index 3 get add
|
|
8 bitshift 1 index 4 get add exch 5
|
|
} ifelse
|
|
} ifelse
|
|
} ifelse
|
|
} loop
|
|
} bind def
|
|
|
|
% Find the side bearing and width information that begins a CharString.
|
|
% Arguments: charstring. Result: charstring sizethroughsbw.
|
|
/findsbw
|
|
{ dup parsesbw counttomark 1 add 1 roll cleartomark skipsbw
|
|
} bind def
|
|
/skipsbw % charstring sbwprefix -> sizethroughsbw
|
|
{ length 1 index length exch sub
|
|
2 copy get 12 eq { 2 } { 1 } ifelse add
|
|
} bind def
|
|
|
|
% Encode a number, and append it to a string.
|
|
% Arguments: str num. Result: newstr.
|
|
/concatnum
|
|
{ dup dup -107 ge exch 107 le and
|
|
{ 139 add 1 string dup 0 3 index put }
|
|
{ dup dup -1131 ge exch 1131 le and
|
|
{ dup 0 ge { 16#f694 } { neg 16#fa94 } ifelse add
|
|
2 string dup 0 3 index -8 bitshift put
|
|
dup 1 3 index 255 and put
|
|
}
|
|
{ 5 string dup 0 255 put exch
|
|
2 copy 1 exch -24 bitshift 255 and put
|
|
2 copy 2 exch -16 bitshift 255 and put
|
|
2 copy 3 exch -8 bitshift 255 and put
|
|
2 copy 4 exch 255 and put
|
|
exch
|
|
}
|
|
ifelse
|
|
}
|
|
ifelse exch pop concatstrings
|
|
} bind def
|
|
|
|
% Encode a subroutine call for a given character, appending it to a string.
|
|
% Arguments: str subrindex. Result: newstr.
|
|
/concatcall
|
|
{ () exch concatnum
|
|
s_callsubr concatstrings concatstrings
|
|
} bind def
|
|
|
|
% ------ Point arithmetic utilities ------ %
|
|
|
|
/ptadd { exch 4 -1 roll add 3 1 roll add } bind def
|
|
|
|
/ptexch { 4 2 roll } bind def
|
|
|
|
/ptneg { neg exch neg exch } bind def
|
|
|
|
/ptsub { ptneg ptadd } bind def
|
|
|
|
% ------ The main program ------ %
|
|
|
|
/readBDF % infilename outfilename fontname encodingname
|
|
% uniqueID readBDF -> font
|
|
{ /uniqueID exch def
|
|
/encoding exch def
|
|
/fontname exch def
|
|
/psname exch def
|
|
/bdfname exch def
|
|
gsave % so we can set the CTM to the font matrix
|
|
|
|
% Open the input files. We don't open the output file until
|
|
% we've done a minimal validity check on the input.
|
|
bdfname (r) file /bdfile exch def
|
|
/commentword ( ) def
|
|
|
|
% Check for the STARTFONT.
|
|
(STARTFONT) getline
|
|
args (2.1) ne { (Not version 2.1\n) print stop } if
|
|
|
|
% Initialize the font.
|
|
/Font 20 dict def
|
|
Font begin
|
|
/FontName fontname def
|
|
/PaintType 0 def
|
|
/FontType 1 def
|
|
/UniqueID uniqueID def
|
|
/Encoding encoding cvx exec def
|
|
/FontInfo 20 dict def
|
|
/Private 20 dict def
|
|
currentdict end currentdict end
|
|
exch begin begin % insert font above environment
|
|
|
|
% Initialize the Private dictionary in the font.
|
|
Private begin
|
|
/-! {string currentfile exch readhexstring pop} readonly def
|
|
/-| {string currentfile exch readstring pop} readonly def
|
|
/|- {readonly def} readonly def
|
|
/| {readonly put} readonly def
|
|
/BlueValues [] def
|
|
/lenIV lenIV def
|
|
/MinFeature {16 16} def
|
|
/password 5839 def
|
|
/UniqueID uniqueID def
|
|
end % Private
|
|
|
|
% Now open the output file.
|
|
psname (w) file /psfile exch def
|
|
|
|
% Put out a header compatible with the Adobe "standard".
|
|
(%!FontType1-1.0: ) ws fontname wt (000.000) wl
|
|
(% This is a font description converted from ) ws
|
|
bdfname wl
|
|
(% by bdftops running on revision ) ws
|
|
revision wt (of (a) ) ws
|
|
statusdict /product get ws (.) wl
|
|
|
|
% Copy the initial comments, up to FONT.
|
|
true
|
|
{ nextline
|
|
keyword (COMMENT) ne {exit} if
|
|
{ (% Here are the initial comments from the BDF file:\n%) wl
|
|
} if false
|
|
(%) ws remarg wl
|
|
} loop pop
|
|
/commentword (COMMENT) def % do skip comments from now on
|
|
|
|
% Read and process the FONT, SIZE, and FONTBOUNDINGBOX.
|
|
% If we cared about FONT, we'd use it here. If the BDF files
|
|
% from MIT had PostScript names rather than X names, we would
|
|
% care; but what's there is unusable, so we discard FONT.
|
|
(FONT) checkline
|
|
(SIZE) getline
|
|
/pointsize iarg def /xres iarg def /yres iarg def
|
|
(FONTBOUNDINGBOX) getline
|
|
/fbbw iarg def /fbbh iarg def /fbbxo iarg def /fbbyo iarg def
|
|
/fraster fbbw 7 add 8 idiv def
|
|
nextline
|
|
|
|
% Allocate the buffers for the bitmap and the outline,
|
|
% according to the font bounding box.
|
|
/bits fraster fbbh mul 200 max 65535 min string def
|
|
/outline bits length 6 mul 65535 min string def
|
|
|
|
% The Type 1 font machinery really only works with a 1000 unit
|
|
% character coordinate system. Set this up here.
|
|
|
|
% Compute the factor to make the X entry in the FontMatrix
|
|
% come out at exactly 0.001.
|
|
/fontscale 72 pointsize div xres div 1000 mul def
|
|
Font /FontBBox
|
|
[ fbbxo fontscale mul
|
|
fbbyo fontscale mul
|
|
fbbxo fbbw add fontscale mul
|
|
fbbyo fbbh add fontscale mul
|
|
] cvx readonly
|
|
put
|
|
|
|
% Read and process the properties. We only care about a few of them.
|
|
keyword (STARTPROPERTIES) eq
|
|
{ iarg
|
|
{ nextline
|
|
properties keyword known
|
|
{ FontInfo properties keyword get sarg readonly put
|
|
} if
|
|
} repeat
|
|
(ENDPROPERTIES) getline
|
|
nextline
|
|
} if
|
|
|
|
% Compute and set the FontMatrix.
|
|
Font /FontMatrix
|
|
[ 0.001 0 0 0.001 xres mul yres div 0 0 ] readonly
|
|
dup setmatrix put
|
|
|
|
% Read and process the header for the bitmaps.
|
|
(CHARS) checkline
|
|
/ccount iarg def
|
|
|
|
% Initialize the character subroutine table and the CharStrings dictionary.
|
|
/subrs subrchars length array def
|
|
/subrsbw subrchars length array def
|
|
/subrcount 0 def
|
|
/charstrings ccount composites length add
|
|
accentedchars length add 1 add dict def % 1 add for .notdef
|
|
/isfixedwidth true def
|
|
/fixedwidth null def
|
|
|
|
% Read and process the bitmap data. This reads the remainder of the file.
|
|
ccount -1 1
|
|
{ (STARTCHAR) getline
|
|
/charname remarg def
|
|
(/) print charname print
|
|
10 mod 1 eq { (\n) print flush } if
|
|
(ENCODING) getline % Ignore, assume StandardEncoding
|
|
(SWIDTH) getline
|
|
/swx iarg pointsize mul 1000 div xres mul 72 div def
|
|
/swy iarg pointsize mul 1000 div xres mul 72 div def
|
|
(DWIDTH) getline % Ignore, use SWIDTH instead
|
|
(BBX) getline
|
|
/bbw iarg def /bbh iarg def /bbox iarg def /bboy iarg def
|
|
nextline
|
|
keyword (ATTRIBUTES) eq
|
|
{ nextline
|
|
} if
|
|
(BITMAP) checkline
|
|
|
|
% Read the bits for this character.
|
|
bbw 7 add 8 idiv /raster exch def
|
|
% The bitmap handed to type1imagepath must have the correct height,
|
|
% because type1imagepath uses this to compute the scale factor,
|
|
% so we have to clear the unused parts of it.
|
|
bits dup 0 1 raster fbbh mul 1 sub
|
|
{ 0 put dup } for
|
|
pop pop
|
|
raster fbbh bbh sub mul raster raster fbbh 1 sub mul
|
|
{ bits exch raster getinterval
|
|
bdfile buffer readline not
|
|
{ (EOF in bitmap\n) print stop } if
|
|
% stack has <bits.interval> <buffer.interval>
|
|
0 () /SubFileDecode filter
|
|
exch 2 copy readhexstring pop pop pop closefile
|
|
} for
|
|
(ENDCHAR) getline
|
|
|
|
% Compute the font entry, converting the bitmap to an outline.
|
|
bits 0 raster fbbh mul getinterval % the bitmap image
|
|
bbw fbbh % bitmap width & height
|
|
swx swy % width x & y
|
|
bbox neg bboy neg % origin x & y
|
|
% Account for lenIV when converting the outline.
|
|
outline lenIV outline length lenIV sub getinterval
|
|
type1imagepath
|
|
length lenIV add
|
|
outline exch 0 exch getinterval
|
|
|
|
% Check for a fixed width font.
|
|
isfixedwidth
|
|
{ fixedwidth null eq
|
|
{ /fixedwidth swx def }
|
|
{ fixedwidth swx ne { /isfixedwidth false def } if }
|
|
ifelse
|
|
} if
|
|
|
|
% Check whether this character must be a subroutine.
|
|
% If so, strip off the initial [h]sbw, replace the endchar by a return,
|
|
% and put the charstring in the Subrs array.
|
|
subrchars charname known
|
|
{ /charstr exch def
|
|
/csindex subrchars charname get def
|
|
charstr parsesbw counttomark 1 add 1 roll
|
|
counttomark 2 eq { 0 exch 0 } if ]
|
|
subrsbw exch csindex exch put
|
|
charstr exch skipsbw /charend exch def pop
|
|
charstr charstr length 1 sub c_return put
|
|
subrs csindex
|
|
charstr charend lenIV sub dup charstr length exch sub
|
|
getinterval copystring
|
|
put
|
|
charstr 0 charend getinterval
|
|
() subrchars charname get concatcall s_endchar concatstrings
|
|
concatstrings
|
|
/subrcount subrcount 1 add def
|
|
}
|
|
{ copystring }
|
|
ifelse
|
|
charname exch charstrings 3 1 roll put
|
|
} for
|
|
(ENDFONT) getline
|
|
|
|
% Synthesize missing characters out of available ones.
|
|
% For fixed-width fonts, only do this in the 1-for-1 case.
|
|
composites
|
|
{ 1 index charstrings exch known
|
|
{ pop pop }
|
|
{ dup isfixedwidth
|
|
{ dup length 1 eq }
|
|
{ true }
|
|
ifelse
|
|
exch { charstrings exch known and } forall
|
|
{ ( /) print 1 index bits cvs print
|
|
dup length 1 eq
|
|
{ 0 get charstrings exch get copystring }
|
|
{ % Top of stack is array of characters to combine.
|
|
% Convert to an array of subr indices.
|
|
[ exch { subrchars exch get } forall ]
|
|
% The final width is the sum of the widths of all
|
|
% the characters, minus the side bearings of all the
|
|
% characters except the first. After each character
|
|
% except the last, do a setcurrentpoint of its width
|
|
% minus its side bearing (except for the first character);
|
|
% before each character except the first, do a 0 hmoveto.
|
|
% Fortunately, all this information is available in subrsbw.
|
|
/combine exch def
|
|
lenIV string
|
|
% Compute the total width.
|
|
subrsbw combine 0 get get aload pop pop pop 2 copy
|
|
combine
|
|
{ subrsbw exch get
|
|
aload pop ptexch ptsub ptadd
|
|
} forall
|
|
% Encode the combined side bearing and width.
|
|
dup 3 index or 0 eq
|
|
{ pop exch pop 2 array astore s_hsbw }
|
|
{ 4 array astore s_sbw }
|
|
ifelse
|
|
3 1 roll { concatnum } forall exch concatstrings
|
|
% Encode the subroutine calls, except the last.
|
|
subrsbw combine 0 get get aload pop ptexch pop pop
|
|
0 1 combine length 2 sub
|
|
{ combine exch get /ccsi exch def
|
|
2 copy 5 -1 roll ccsi concatcall
|
|
3 -1 roll concatnum exch concatnum
|
|
s_setcurrentpoint_hmoveto concatstrings
|
|
subrsbw ccsi get aload pop ptexch ptsub
|
|
5 -2 roll ptadd
|
|
} for
|
|
% Encode the last call.
|
|
pop pop
|
|
combine dup length 1 sub get concatcall
|
|
s_endchar concatstrings
|
|
} ifelse
|
|
charstrings 3 1 roll put
|
|
}
|
|
{ pop pop }
|
|
ifelse
|
|
}
|
|
ifelse
|
|
}
|
|
forall flush
|
|
|
|
% Synthesize accented characters with seac if needed and possible.
|
|
accentedchars
|
|
{ aload pop /accent exch def /base exch def
|
|
buffer cvs /accented exch def
|
|
charstrings accented known not
|
|
charstrings base known and
|
|
charstrings accent known and
|
|
{ ( /) print accented print
|
|
charstrings base get findsbw 0 exch getinterval
|
|
/acstring exch def % start with sbw of base
|
|
charstrings accent get parsesbw
|
|
counttomark 1 sub { pop } repeat % just leave mark & sbx
|
|
acstring exch concatnum exch pop % pop the mark
|
|
0 concatnum 0 concatnum % adx ady
|
|
decoding base get concatnum % bchar
|
|
decoding accent get concatnum % achar
|
|
s_seac concatstrings
|
|
charstrings exch accented copystring exch put
|
|
} if
|
|
} forall
|
|
|
|
% Make a CharStrings entry for .notdef.
|
|
outline lenIV <8b8b0d0e> putinterval % 0 0 hsbw endchar
|
|
charstrings /.notdef outline 0 lenIV 4 add getinterval copystring put
|
|
|
|
% Encrypt the CharStrings and Subrs (in place).
|
|
charstrings dup begin
|
|
{ 4330 exch dup type1encrypt exch pop
|
|
readonly def
|
|
}
|
|
forall end
|
|
0 1 subrs length 1 sub
|
|
{ dup subrs exch get dup null ne
|
|
{ 4330 exch dup type1encrypt exch pop
|
|
subrs 3 1 roll put
|
|
}
|
|
{ pop pop }
|
|
ifelse
|
|
}
|
|
for
|
|
|
|
% Make most of the remaining entries in the font dictionaries.
|
|
Font /CharStrings charstrings readonly put
|
|
FontInfo /FullName known not
|
|
{ % Some programs insist on FullName being present.
|
|
FontInfo /FullName FontName dup length string cvs put
|
|
}
|
|
if
|
|
FontInfo /isFixedPitch isfixedwidth put
|
|
subrcount 0 gt
|
|
{ Private /Subrs subrs readonly put
|
|
} if
|
|
|
|
% Determine the italic angle and underline position
|
|
% by actually installing the font.
|
|
save
|
|
/_temp_ Font definefont setfont
|
|
[1000 0 0 1000 0 0] setmatrix % mitigate rounding problems
|
|
% The italic angle is the multiple of -5 degrees
|
|
% that minimizes the width of the 'I'.
|
|
0 9999 0 5 85
|
|
{ dup rotate
|
|
newpath 0 0 moveto (I) false charpath
|
|
dup neg rotate
|
|
pathbbox pop exch pop exch sub
|
|
dup 3 index lt { 4 -2 roll } if
|
|
pop pop
|
|
}
|
|
for pop
|
|
% The underline position is halfway between the bottom of the 'A'
|
|
% and the bottom of the FontBBox.
|
|
newpath 0 0 moveto (A) false charpath
|
|
FontMatrix concat
|
|
pathbbox pop pop exch pop
|
|
% Put the values in FontInfo.
|
|
3 -1 roll restore
|
|
Font /FontBBox get 1 get add 2 div cvi
|
|
dup FontInfo /UnderlinePosition 3 -1 roll put
|
|
2 div abs FontInfo /UnderlineThickness 3 -1 roll put
|
|
FontInfo /ItalicAngle 3 -1 roll put
|
|
|
|
% Clean up and finish.
|
|
grestore
|
|
bdfile closefile
|
|
Font currentdict end end begin % remove font from dict stack
|
|
(\n) print flush
|
|
|
|
} bind def
|
|
|
|
% ------ Reader for AFM files ------ %
|
|
|
|
% Dictionary for looking up character keywords
|
|
/cmdict 6 dict dup begin
|
|
/C { /c iarg def } def
|
|
/N { /n warg copystring def } def
|
|
/WX { /w narg def } def
|
|
/W0X /WX load def
|
|
/W /WX load def
|
|
/W0 /WX load def
|
|
end def
|
|
|
|
/readAFM % fontdict afmfilename readAFM -> fontdict
|
|
{ (r) file /bdfile exch def
|
|
/Font exch def
|
|
/commentword (Comment) def
|
|
|
|
% Check for the StartFontMetrics.
|
|
(StartFontMetrics) getline
|
|
args cvr 2.0 lt { (Not version 2.0 or greater\n) print stop } if
|
|
|
|
% Look for StartCharMetrics, then parse the character metrics.
|
|
% The only information we care about is the X width.
|
|
/metrics 0 dict def
|
|
{ nextline
|
|
keyword (EndFontMetrics) eq { exit } if
|
|
keyword (StartCharMetrics) eq
|
|
{ iarg dup dict /metrics exch def
|
|
{ /c -1 def /n null def /w null def
|
|
nextline buffer
|
|
{ token not { exit } if
|
|
dup cmdict exch known
|
|
{ exch /args exch def cmdict exch get exec args }
|
|
{ pop }
|
|
ifelse
|
|
} loop
|
|
c 0 ge n null ne or w null ne and
|
|
{ n null eq { /n Font /Encoding get c get def } if
|
|
metrics n w put
|
|
}
|
|
if
|
|
}
|
|
repeat
|
|
(EndCharMetrics) getline
|
|
} if
|
|
} loop
|
|
|
|
% Insert the metrics in the font.
|
|
metrics length 0 ne
|
|
{ Font /Metrics metrics readonly put
|
|
} if
|
|
Font
|
|
} bind def
|
|
|
|
end % envBDF
|
|
|
|
% Enter the main program in the current dictionary.
|
|
/bdftops
|
|
{ [] exch bdfafmtops
|
|
} bind def
|
|
/bdfafmtops % infilename afmfilename* outfilename fontname
|
|
% encoding uniqueID
|
|
{ envBDF begin
|
|
6 -2 roll exch 6 2 roll % afm* in out fontname encoding uniqueID
|
|
readBDF % afm* font
|
|
exch { readAFM } forall
|
|
save exch
|
|
dup /FontName get exch definefont
|
|
setfont
|
|
psfile writefont
|
|
restore
|
|
psfile closefile
|
|
end
|
|
} bind def
|
|
|
|
% If the program was invoked from the command line, run it now.
|
|
[ shellarguments
|
|
{ counttomark 4 ge
|
|
{ dup 0 get
|
|
dup 48 ge exch 57 le and % last arg starts with a digit?
|
|
{ cvi /StandardEncoding } % no encodingname
|
|
{ cvn exch cvi exch } % have encodingname
|
|
ifelse
|
|
counttomark 4 roll
|
|
counttomark 5 sub array astore
|
|
6 -4 roll exch
|
|
bdfafmtops
|
|
}
|
|
{ cleartomark
|
|
(Usage: bdftops xx.bdf [yy1.afm ...] zz.gsf fontname uniqueID [encodingname]\n) print flush
|
|
mark
|
|
}
|
|
ifelse
|
|
}
|
|
if pop
|