ryland@mfci.UUCP (Chris Ryland) (05/11/89)
The enclosed code converts BDF 2.1 (Adobe bitmap distribution format) fonts
into ST-80 Strikefonts. I wrote it so that I could take advantage of all
the Adobe/DEC/Bitstream screen fonts distributed with X11 Release 3 and
later (Times, Helvetica, Charter, in a bunch of sizes and styles).
For example,
"(BDFFont newFrom: 'helvr12.bdf') asStrikeFont"
produces a 12-point Helvetica Roman strikefont from the given file.
I didn't provide any packaged way to collect a bunch of related fonts
into a TextStyle. This is left as an exercise.
This code has only been tested minimally under PPS ST-80 V2.3.
--Chris Ryland, Multiflow Computer
ryland@multiflow.com, ...!uunet!mfci!ryland
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Object subclass: #BDFChar
instanceVariableNames: 'encoding bbw bbh bbox bboy xWidth yWidth glyph '
classVariableNames: ''
poolDictionaries: ''
category: 'Graphics-BDF Support'!
BDFChar comment:
'This is a support class for BDFFont, used to hold
BDF character objects.
'!
!BDFChar methodsFor: 'accessing'!
bbh
^bbh!
bbox
^bbox!
bboy
^bboy!
bbw
^bbw!
bbw: width bbh: height bbox: xOffset bboy: yOffset
bbw _ width.
bbh _ height.
bbox _ xOffset.
bboy _ yOffset!
encoding
^encoding!
encoding: code
^encoding _ code!
glyph
^glyph!
glyph: aForm
^glyph _ aForm!
xWidth
^xWidth!
xWidth: xw yWidth: yw
xWidth _ xw.
yWidth _ yw!
yWidth
^yWidth! !
!BDFChar methodsFor: 'printing'!
printOn: aStream
aStream nextPutAll: 'BDFchar('.
"This knows too much about the ascii representation
of Characters."
(encoding >= 32 and: [encoding <= 127])
ifTrue: [aStream nextPut: encoding asCharacter]
ifFalse: [encoding printOn: aStream].
aStream nextPut: $)! !
!BDFChar methodsFor: 'converting'!
strikeWidth
"The width of this character in a strike format.
This is a slightly damaged concept, since strike format
oversimplifies the notions of bounding box and character
advance vector."
| minX maxX |
minX _ 0 min: bbox.
maxX _ xWidth max: bbw + bbox.
^maxX - minX!
strikeXOffset
"BBox, normalized for a strike font approach."
bbox >= 0 ifTrue: [^bbox] ifFalse: [^0]!
strikeYOffset
"Top of glyph, normalized for a strike format."
^bbh + bboy! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
BDFChar class
instanceVariableNames: ''!
!BDFChar class methodsFor: 'instance creation'!
new
^super new! !
Object subclass: #BDFFont
instanceVariableNames: 'name pointSize xRes yRes bbw bbh bbox bboy chars currentChar source sourceLine '
classVariableNames: ''
poolDictionaries: ''
category: 'Graphics-BDF Support'!
BDFFont comment:
'This class implements only the two aspects of Adobe
Bitmap Distribution Format (BDF) font handling we need:
BDF source file parsing, and conversion to StrikeFont.
BDF file parsing insists on strictly following the font file
format described in "Bitmap Distribution Format 2.1", the
X Consortium document provided by Adobe Systems.
Chris Ryland, ryland@multiflow.com, ...!!uunet!!mfci!!ryland
'!
!BDFFont methodsFor: 'parsing'!
lex
"Assign to sourceLine next non-empty line of BDF file as an
array of token strings. If hit EOF, sourceLine will be nil."
| buffer bufferSize isString i j |
source atEnd ifTrue: [^sourceLine _ nil].
buffer _ source upTo: Character cr.
(bufferSize _ buffer size) <= 0 ifTrue: [^self lexLine].
"Recursively ignore blank lines."
sourceLine _ OrderedCollection new: 4.
i _ 1.
"Track start of token."
[bufferSize >= i]
whileTrue:
[[bufferSize >= i and: [(buffer at: i) isSeparator]]
whileTrue: [i _ i + 1].
j _ i + 1.
"Track end of token."
(isString _ (buffer at: i)
= '"') ifTrue: [i _ i + 1].
[bufferSize < j or: [isString
ifTrue: [(buffer at: j)
= '"']
ifFalse: [(buffer at: j) isSeparator]]]
whileFalse: [j _ j + 1].
sourceLine add: (buffer copyFrom: i to: j - 1).
i _ j + 1].
sourceLine size <= 0 ifTrue: [^self lex].
^sourceLine!
newFrom: aString
source _ FileStream oldFileNamed: aString.
[self parse] whileTrue.
source close!
parse
"Parse the next item or set of items in the BDF source.
Returns true iff parsing should continue."
| keyword |
self lex.
sourceLine = nil ifTrue: [^false].
"EOF check."
keyword _ sourceLine at: 1.
(keyword sameAs: 'startfont')
ifTrue: [^self parseStartFont].
(keyword sameAs: 'comment')
ifTrue: [^self parseComment].
(keyword sameAs: 'font')
ifTrue: [^self parseFont].
(keyword sameAs: 'size')
ifTrue: [^self parseSize].
(keyword sameAs: 'fontboundingbox')
ifTrue: [^self parseFontBoundingBox].
(keyword sameAs: 'startproperties')
ifTrue: [^self parseStartProperties].
(keyword sameAs: 'chars')
ifTrue: [^self parseChars].
(keyword sameAs: 'startchar')
ifTrue: [^self parseStartChar].
(keyword sameAs: 'encoding')
ifTrue: [^self parseEncoding].
(keyword sameAs: 'swidth')
ifTrue: [^self parseSWidth].
(keyword sameAs: 'dwidth')
ifTrue: [^self parseDWidth].
(keyword sameAs: 'bbx')
ifTrue: [^self parseBBX].
(keyword sameAs: 'attributes')
ifTrue: [^self parseAttributes].
(keyword sameAs: 'bitmap')
ifTrue: [^self parseBitmap].
(keyword sameAs: 'endchar')
ifTrue: [^self parseEndChar].
(keyword sameAs: 'endfont')
ifTrue: [^self parseEndFont].
^true "Just ignore any unrecognized keywords."!
parseAttributes
"ATTRIBUTES <encoding>"
^true!
parseBBX
"BBX <x width> <y height> <x offset> <y offset>"
currentChar
bbw: (sourceLine at: 2) asNumber
bbh: (sourceLine at: 3) asNumber
bbox: (sourceLine at: 4) asNumber
bboy: (sourceLine at: 5) asNumber.
^true!
parseBitmap
"BITMAP
(... BBh lines of bitmap ...)"
| bits i hex bbww fill |
bbww _ currentChar bbw + 15 // 16.
"Bounding box word width"
bits _ Array new: bbww * currentChar bbh.
i _ 1.
1 to: currentChar bbh do:
[:x |
self lex.
sourceLine = nil ifTrue: [^false"Hit EOF."].
hex _ sourceLine at: 1.
"Fill out each hex line to a multiple of 16-bit hex values."
(fill _ hex size \\ 4) = 0 ifFalse: [hex _ hex , ('0000' copyFrom: 1 to: 4 - fill)].
1
to: bbww * 4
by: 4
do:
[:j |
bits at: i put: (((hex at: j) digitValue bitShift: 12)
bitOr: (((hex at: j + 1) digitValue bitShift: 8)
bitOr: (((hex at: j + 2) digitValue bitShift: 4)
bitOr: (hex at: j + 3) digitValue))).
i _ i + 1.
j _ j + 4]].
currentChar glyph: (Form
extent: currentChar bbw @ currentChar bbh
fromArray: bits
offset: 0 @ 0).
^true!
parseChars
"CHARS <# chars>"
"Glyph definitions follow, so set up for receiving them."
chars _ Array new: 128.
^true!
parseComment
"COMMENT ..."
^true!
parseDWidth
"DWIDTH <x width> <y width>"
currentChar
xWidth: (sourceLine at: 2) asNumber
yWidth: (sourceLine at: 3) asNumber.
^true!
parseEncoding
"ENCODING <value>"
currentChar encoding: (sourceLine at: 2) asNumber.
^true!
parseEndChar
"ENDCHAR"
| encoding |
encoding _ currentChar encoding.
encoding >= 0 & (encoding < chars size) ifTrue: [chars at: encoding + 1 put: currentChar].
^true!
parseEndFont
"ENDFONT"
^false!
parseFont
"FONT <fontname>"
name _ sourceLine at: 2.
^true!
parseFontBoundingBox
"FONTBOUNDINGBOX <x width> <y height> <x offset>
<y offset>"
bbw _ (sourceLine at: 2) asNumber.
bbh _ (sourceLine at: 3) asNumber.
bbox _ (sourceLine at: 4) asNumber.
bboy _ (sourceLine at: 5) asNumber.
^true!
parseSize
"SIZE <point size> <x resolution> <y resolution>"
pointSize _ (sourceLine at: 2) asNumber.
xRes _ (sourceLine at: 3) asNumber.
yRes _ (sourceLine at: 4) asNumber.
^true!
parseStartChar
"STARTCHAR <glyph name>"
currentChar _ BDFChar new.
^true!
parseStartFont
"STARTFONT <version>"
(sourceLine at: 2)
= '2.1' ifFalse: [self error: 'Font is version ' , (sourceLine at: 2) , ', not version 2.1'].
^true!
parseStartProperties
"STARTPROPERTIES <# properties>"
[self lex.
sourceLine = nil ifTrue: [^false].
(sourceLine at: 1)
sameAs: 'endproperties'] whileFalse.
^true!
parseSWidth
"SWIDTH <x width> <y height>"
^true! !
!BDFFont methodsFor: 'converting'!
asStrikeFont
"Convert BDFFont to StrikeFont.
This knows too much about StrikeFonts, but I don't see any
other way to use the StrikeFont>setFrom:glyphs:xTable method
(albeit private) that enables this conversion."
| info xTable glyphs x char baseline strikeFont |
glyphs _ Form extent: self strikeWidth @ self strikeHeight.
xTable _ Array new: chars size + 1.
baseline _ bbh + bboy.
x _ 0.
1 to: chars size do:
[:i |
xTable at: i put: x.
char _ chars at: i.
char isNil ifFalse:
[glyphs copyBits: char glyph boundingBox
from: char glyph
at: (x + char strikeXOffset)
@ (baseline - char strikeYOffset)
clippingBox: glyphs boundingBox
rule: Form over
mask: Form black.
x _ x + char strikeWidth]].
xTable at: chars size + 1 put: x.
info _ Array new: 9.
info at: 1 put: name. "name"
info at: 2 put: 0. "min ascii"
info at: 3 put: chars size - 1. "max ascii"
info at: 4 put: bbw. "max character width"
info at: 5 put: self strikeWidth.
info at: 6 put: self strikeAscent.
info at: 7 put: self strikeDescent.
info at: 8 put: 0. "xOffset (unused)"
info at: 9 put: 0. "raster (unused)"
strikeFont _ StrikeFont new.
strikeFont setFrom: info glyphs: glyphs xTable: xTable.
^strikeFont!
strikeAscent
"The ascent of the entire font in strike format."
^bbh + bboy!
strikeDescent
"The descent of the entire font in strike format."
^bboy < 0 ifTrue: [0 - bboy] ifFalse: [0]!
strikeHeight
"The height of the entire font in strike format."
^bbh + (bboy < 0 ifTrue: [0] ifFalse: [bboy])!
strikeWidth
"The width of the entire font in strike format."
^chars inject: 0 into:
[:width :char |
width + (char isNil ifTrue: [0] ifFalse: [char strikeWidth])]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
BDFFont class
instanceVariableNames: ''!
!BDFFont class methodsFor: 'instance creation'!
newFrom: aString
"Instantiate a BDFFont and initialize it from the given BDF source file."
^self basicNew newFrom: aString! !