[comp.lang.smalltalk] format of X font files

zliu@argosy.UUCP (Zaide (Edward) Liu) (08/15/90)

I would like to use X font to display text in Smalltalk, since
the available smalltalk fonts are not that beautiful. 

However, I do not know the format of the x font files.  I would
appreciate if somebody tell me about the format of the x font
files.  By the way, has anybody done the work which reads from a
X font file and generates the smalltalk font format.  

Any response is welcome.
--- liu

eliot@cs.qmw.ac.uk (Eliot Miranda) (08/16/90)

"Here's some code to experiment with for creating Smalltalk StrikeFonts from X BDF files"
'From BrouHaHa Smalltalk-80, Version 2.3.1 of 30 January 1989 on 8 January 1990 at 2:30:38 pm'!



!PositionableStream methodsFor: 'accessing'!

upToAny: aCollection 
	"Answer a subcollection from position to the occurrence (if any, not  
	inclusive) of any element in aCollection. If not there, answer everything."

	| newStream element |
	newStream _ WriteStream on: (collection species new: 64).
	[self atEnd or: [aCollection includes: (element _ self next)]]
		whileFalse: [newStream nextPut: element].
	^newStream contents! !

!TextStyle methodsFor: 'accessing'!

outputMedium: aSymbol
	"Set the outputMedium for this style -- currently only Display"
	outputMedium _ aSymbol.
	lineGrid == nil ifTrue: [lineGrid _ DefaultLineGrid].
	baseline == nil ifTrue: [baseline _ DefaultBaseline]"! !

!TextStyle methodsFor: 'private'!

newFontArray: anArray
	fontArray _ anArray.
	lineGrid _ (fontArray inject: 0 into: [:h :f| h max: f height]).
	baseline _ (fontArray inject: 0 into: [:h :f| h max: f ascent]) - 1.
	alignment _ 0.
	firstIndent _ 0.
	restIndent _ 0.
	rightIndent _ 0.
	outputMedium _ #Display.
	tabsArray _ DefaultTabsArray.
	marginTabsArray _ DefaultMarginTabsArray

	"Currently there is no supporting protocol for changing these arrays.  If an editor wishes to implement margin setting, then a copy of the default should be stored as these instance variables."! !


!TextStyle class methodsFor: 'instance creation'!

createBDFStyle: fileNames named: styleName
	| array |
	array _ fileNames asArray collect: [:fn| | fs sf |
					(fs _ FileStream oldFileNamed: fn) readOnly.
					sf _ StrikeFont fromBDFFile: fs.
					fs close.
					sf].
	"Add a copy of the fonts on the end with underlined emphasis"
	array _ array, (array collect: [:f| f copy emphasis: 4. "underlined"]).

	self styleNamed: styleName asSymbol put: (self fontArray: array)



	"TextStyle
		createBDFStyle: (
			#(	'timR18' 'timB18' 'timI18'
				'helvR18' 'helvB18' 'helvO18'
				'timR24' 'timB24' 'timI24'
				'helvR24' 'helvB24' 'helvO24' ) collect: [:n|
					'/nfs/whistle/pub/X.V11R3/core.src/fonts/bdf/75dpi/', n, '.bdf'])
		named: #BDFLarge"


	"TextStyle
		createBDFStyle: (
			#(	'courR10' 'courB10' 'courO10'
				'courR12' 'courB12' 'courO12'
				'courR14' 'courB14' 'courO14'
				'courR18' 'courB18' 'courO18' ) collect: [:n|
					'/nfs/whistle/pub/X.V11R3/core.src/fonts/bdf/75dpi/', n, '.bdf'])
		named: #BDFFixed.
	1 to: 12 do: [:n|
		| font |
		font _ (TextStyle styleNamed: #BDFFixed) fontAt: n.
		font fixPitch scrunch.
		n > 3 ifTrue: [font scrunch]]"! !


!Document methodsFor: 'Smalltalk compatibility'!

getFontLike: familySizeFace 
	"Map a strike font to an abstract type family."

	| family |
	family _ familySizeFace at: 1.
	(#('TIMES' 'TIMESROMAN' 'SERIF') includes: family)
		ifTrue: [^#Serif].
	(#('HELVETICA' 'SANSERIF' 'SANS-SERIF') includes: family)
		ifTrue: [^#SanSerif].
	(#('FIXED' 'ICON' 'COURIER') includes: family)
		ifTrue: [^#FixedPitch].
	self error: 'don''t know how to handle this font yet!!'! !


!Character methodsFor: 'accessing'!

digitValue
	"Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 otherwise.
	This is used to parse literal numbers of radix 2-36."

	value <= $9 asciiValue 
		ifTrue: [^value - $0 asciiValue].
	value >= $A asciiValue 
		ifTrue: [
			value <= $Z asciiValue ifTrue: [^value - $A asciiValue + 10].
			value >= $a asciiValue ifTrue: [
				value <= $z asciiValue ifTrue: [^value - $a asciiValue + 10]]].
	^-1! !


!StrikeFont methodsFor: 'private'!

setFromBDFFile: stream
	"Create a StrikeFont from an X11 style Bitmap Distribution Format file.
	 See /usr/X11/core.src/doc/bdf/bdf.mss"

	| token space cr separators blitter byteStripe glyph min max bold italic |

	bold _ italic _ false.
	stopConditions _ Array new: 258 withAll: #characterNotInFont.
	xTable _ Array new: 258 withAll: 0.
	minAscii _ 0. maxAscii _ 255.
	min _ 256. max _ -1. maxWidth _ 0.
	byteStripe _ Form extent: 1024@1.
	byteStripe bits: (ByteArray new: 1024 / 8).
	glyph _ Form extent: 0@0.
	blitter _ BitBlt
				destForm: glyph sourceForm: byteStripe halftoneForm: nil combinationRule: Form over
				destOrigin: 0@0 sourceOrigin: 0@0 extent: 0@1 clipRect: (0@0 extent: 0@0). 

	space _ Character space.
	cr _ Character cr.
	separators _ Array with: space with: cr.
	[stream atEnd] whileFalse: [
		token _ stream upToAny: separators.
		token = 'STARTPROPERTIES' ifTrue: [
			[	stream skip: -1; skipTo: cr.
				token _ stream upToAny: separators.
				token = 'FONT_ASCENT'	ifTrue: [ascent _ Integer readFrom: stream].
				token = 'FONT_DESCENT'	ifTrue: [descent _ Integer readFrom: stream].
				token = 'FAMILY_NAME' ifTrue: [stream skipTo: $". name _ stream upTo: $"].
				token = 'WEIGHT_NAME' ifTrue: [stream skipTo: $". bold _ stream peek = $B].
				token = 'SLANT' ifTrue: [stream skipTo: $". italic _ stream peek == $I or: [stream peek == $O]].
				token = 'PIXEL_SIZE' ifTrue: [name _ name, (stream upToAny: separators)].
				token ~= 'ENDPROPERTIES'] whileTrue.
			glyphs _ Form extent: 0@ascent + descent.
			blitter clipHeight: ascent + descent].

		token = 'STARTCHAR' ifTrue: [
			| ascii charWidth w h ox oy bytes |
			stream skip: -1; skipTo: cr.
			((token _ stream upToAny: separators) = 'ENCODING'
			and: [(ascii _ Integer readFrom: stream) > 0]) ifTrue: [
				ascii < min ifTrue: [min _ ascii].
				ascii > max ifTrue: [max _ ascii].
				stopConditions at: ascii + 1 put: nil.
				[	stream skip: -1; skipTo: cr.
					token _ stream upToAny: separators.
					token = 'DWIDTH' ifTrue: [charWidth _ Integer readFrom: stream].
					token = 'BBX' ifTrue: [
						w _ Integer readFrom: stream. stream skip: 1.
						h _ Integer readFrom: stream. stream skip: 1.
						ox _ Integer readFrom: stream. stream skip: 1.
						oy _ Integer readFrom: stream.
						glyph extent: (w + 1 max: charWidth) @ glyphs height; white.
						maxWidth < glyph width ifTrue: [maxWidth _ glyph width].
						blitter width: w; clipWidth: w].
					token = 'BITMAP' ifTrue: [
						stream skip: -1; skipTo: cr.
						0 to: h - 1 do: [:y| | line |
							line _ stream upTo: cr.
							1 to: line size by: 2 do: [:i|
								byteStripe bits
									at: i + 1 / 2
									put: (line at: i) digitValue * 16 + (line at: i + 1) digitValue].
							blitter destY: ascent - h - oy + y; copyBits].
						glyph display.
						self characterFormAt: (Character value: ascii) put: glyph.
						ascii = 171 ifTrue: [
							self characterFormAt: $_ put: glyph]].
					token ~= 'ENDCHAR'] whileTrue]].
		stream skip: -1; skipTo: cr].

	emphasis _ strikeLength _ xOffset _ 0.
	raster _ glyphs raster.
	superscript _ ascent - descent // 3.	
	subscript _ descent - ascent // 3.
	minAscii _ min.
	maxAscii _ max.
	bold ifTrue: [name _ name, 'b'].
	italic ifTrue: [name _ name, 'i']! !


!StrikeFont class methodsFor: 'instance creation'!

fromBDFFile: stream
	^self new setFromBDFFile: stream! !


!CharacterScanner methodsFor: 'scanning'!

characterNotInFont
	"All fonts have an illegal character to be used when a character is  
	not within the font's legal range.  When characters out of ranged 
	are encountered in scanning text, then this special character 
	indicates the appropriate behavior.  The character is usually treated 
	as a unary message understood by a subclass of CharacterScanner."

	| illegalAsciiString saveIndex stopCondition | 
	saveIndex _ lastIndex.
	illegalAsciiString _ String with: (font maxAscii + 1 min: 255) asCharacter.
	(self isMemberOf: CompositionScanner) not
	ifTrue: [
	stopCondition _ self scanCharactersFrom: 1
						to: 1
						in: illegalAsciiString
						rightX: rightMargin
						stopConditions: stopConditions
						displaying: self doesDisplaying]
	ifFalse:	[
	stopCondition _ 
		self scanCharactersFrom: 1 to: 1
			in: illegalAsciiString
			rightX: rightMargin stopConditions: stopConditions
			displaying: self doesDisplaying].
	lastIndex _ saveIndex + 1.
	stopCondition ~= (stopConditions at: EndOfRun)
		ifTrue:	[^self perform: stopCondition]
		ifFalse: [lastIndex = runStopIndex
					ifTrue:	[^self perform: (stopConditions at: EndOfRun)].
				^false]! !


!ExternalStream methodsFor: 'nonhomogeneous accessing'!

nextSigned
	"Answer the next byte from the receiver as a signed byte."

	| value |
	self atEnd ifTrue: [^false].
	^(value _ self next asInteger) > 127
		ifTrue: [256 + value negated]
		ifFalse: [value]! !


!CharacterBlockScanner methodsFor: 'scanning'!

characterNotInFont
	"This does not handle character selection nicely, i.e., illegal characters are a little tricky to select.  Since the end of a run or line is subverted here by actually having the scanner scan a different string in order to manage the illegal character, things are not in an absolutely correct state for the character location code.  If this becomes too odious in use, logic will be added to accurately manage the situation."

	lastCharacterExtent _ 
		(font widthOf: (font maxAscii + 1 min: 255) asCharacter) @ textStyle lineGrid.
	^super characterNotInFont! !
-- 
Eliot Miranda			email:	eliot@cs.qmw.ac.uk
Dept of Computer Science	Tel:	071 975 5220 (+44 71 975 5220)
Queen Mary Westfield College	ARPA:	eliot%cs.qmw.ac.uk@nsfnet-relay.ac.uk	
Mile End Road			UUCP:	eliot@qmw-cs.uucp
LONDON E1 4NS

ghazi@athos.rutgers.edu (Kaveh R. Ghazi) (08/18/90)

 >I would like to use X font to display text in Smalltalk, since
 >the available smalltalk fonts are not that beautiful. 
 >However, I do not know the format of the x font files.  I would
 >appreciate if somebody tell me about the format of the x font
 >files.  By the way, has anybody done the work which reads from a
 >X font file and generates the smalltalk font format.  
 >Any response is welcome.
 >--- liu

	X font format source is in BDF format.  The font source code is public
and available with the X11 distribution.  I found something which converts
bdf to ST80 strikefonts.  The code contains the following header:

 >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

	Chris Ryland's code contains a bug which causes his converter to fail
on fonts above a certain size (~ 12 or 14 pt.)  It involves the accidental
double incrementation of a loop which assembles how wide in bits a character
in a font's form is. If the font is small and only one byte wide, then the
double incrementation of the loop index doesn't matter since it exits the
loop after one iteration.  However, if the character is expected to be two
bytes or more wide and the loop is incremented twice per iteration then it will
exit prematurely which is why bigger fonts fail.  
	The fix is trivial once the cause is known.  I have included the
repaired method below, and the original (unfixed) file containing the converter
after it.
		--Kaveh
--
Kaveh R. Ghazi			CAIP Center, Rutgers University.
ghazi@caip.rutgers.edu		rutgers!caip.rutgers.edu!ghazi


---------cut here-----------
'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 17 August 1990 at 3:08:30 pm'!



!BDFFont methodsFor: 'parsing'!

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 This line was taken out by Kaveh (ghazi@caip.rutgers.edu). It shouldn't be there and prevents big fonts from working!!"]].
	currentChar glyph: (Form
			extent: currentChar bbw @ currentChar bbh
			fromArray: bits
			offset: 0 @ 0).
	^true! !

---------cut here-----------
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! !
-- 
Kaveh R. Ghazi			CAIP Center, Rutgers University.
ghazi@caip.rutgers.edu		rutgers!caip.rutgers.edu!ghazi