Category : DeskTop Publishing in the 1990's
Archive   : GS261EXE.ZIP
Filename : BDFTOPS.PS

% Copyright (C) 1990, 1991, 1993 Aladdin Enterprises. All rights reserved.
%
% 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
/encrypt_CharStrings true def

% Invert the StandardEncoding vector.
256 dict dup begin
0 1 255 { dup StandardEncoding exch get exch def } for
end /decoding exch 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
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