'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 19 March 2009 at 3:56:18 pm'!

!StrikeFont commentStamp: 'jmv 3/19/2009 14:39' prior: 0!
I represent a compact encoding of a set of Forms corresponding to characters in the ASCII character set. All the forms are placed side by side in a large form whose height is the font height, and whose width is the sum of all the character widths. The xTable variable gives the left-x coordinates of the subforms corresponding to the glyphs. Characters are mapped to glyphs by using the characterToGyphMap.

Subclasses can have non-trivial mapping rules as well as different representations for glyphs sizes (e.g., not using an xTable). If so, these classes should return nil when queried for xTable and/or the characterToGlyphMap. This will cause the CharacterScanner primitive to fail and query the font for the width of a character (so that a more programatical approach can be implemented).

For display, fonts need to implement two messages:
	#installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor
This method installs the receiver (a font) on the given DisplayContext (which may be an instance of BitBlt or Canvas (or any of it's subclasses). The font should take the appropriate action to initialize the display context so that further display operations can be optimized.
	#displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta
This method is called for each subsequent run of characters in aString which is to be displayed with the (previously installed) settings.!


!FormCanvas methodsFor: 'drawing-text' stamp: 'jmv 3/19/2009 14:55'!
drawString: aString from: firstIndex to: lastIndex at: aPoint font: fontOrNil color: c
	| font |
	port colorMap: nil.
	font _ fontOrNil ifNil: [TextStyle defaultFont].
	port combinationRule: Form paint.
	font installOn: port
		foregroundColor: (self shadowColor ifNil:[c]) 
		backgroundColor: Color transparent.
	font displayString: aString on: port 
		from: firstIndex to: lastIndex at: (origin + aPoint) kern: font baseKern negated.! !

!FormCanvas methodsFor: 'drawing-text' stamp: 'jmv 3/19/2009 14:49'!
drawString: aString from: firstIndex to: lastIndex in: bounds font: fontOrNil color: c
	| font portRect |
	port colorMap: nil.
	portRect _ port clipRect.
	port clipByX1: bounds left + origin x 
		y1: bounds top + origin y 
		x2: bounds right + origin x 
		y2: bounds bottom + origin y.
	font _ fontOrNil ifNil: [TextStyle defaultFont].
	port combinationRule: Form paint.
	font installOn: port
		foregroundColor: (self shadowColor ifNil:[c]) 
		backgroundColor: Color transparent.
	font displayString: aString asString on: port 
		from: firstIndex to: lastIndex at: (bounds topLeft + origin) kern: font baseKern negated.
	port clipRect: portRect.! !


!StrikeFont methodsFor: 'accessing' stamp: 'jmv 3/19/2009 14:52'!
baseKern
	"Return the base kern value to be used for all characters."
	
	| italic |
	italic _ emphasis allMask: 2.
	
	self isSynthetic ifFalse: [
		^(italic or: [ pointSize < 9 ])
			ifTrue: [ 1 ]
			ifFalse: [ 0] ].
		
	italic ifFalse: [^ 0].
	^ ((self height-1-self ascent+4)//4 max: 0)  "See makeItalicGlyphs"
		+ (((self ascent-5+4)//4 max: 0))! !

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 3/19/2009 15:50'!
descent
	"Answer the receiver's maximum extent of characters below the baseline."

	^pointSize < 9
		ifTrue: [descent-1]
		ifFalse: [descent]! !

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 3/19/2009 15:48'!
lineGrid
	^ ascent + self descent! !

!StrikeFont methodsFor: 'building' stamp: 'jmv 3/18/2009 11:34'!
buildFromForm: allGlyphs data: data name: aString
	"
	TextConstants at: #DejaVu put: (TextStyle fontArray: (Array
              with: (StrikeFont new 
			buildFromForm: (Form fromFileNamed: 'AAFonts/DejaVu Sans Book 8.bmp') 
			data: (FileStream oldFileNamed: 'AAFonts/DejaVu Sans Book 8.txt') contentsOfEntireFile substrings
			name: 'DejaVu 8')
              with: (StrikeFont new 
			buildFromForm: (Form fromFileNamed: 'AAFonts/DejaVu Sans Book 9.bmp') 
			data: (FileStream oldFileNamed: 'AAFonts/DejaVu Sans Book 9.txt') contentsOfEntireFile substrings
			name: 'DejaVu 9')
              with: (StrikeFont new 
			buildFromForm: (Form fromFileNamed: 'AAFonts/DejaVu Sans Book 10.bmp') 
			data: (FileStream oldFileNamed: 'AAFonts/DejaVu Sans Book 10.txt') contentsOfEntireFile substrings
			name: 'DejaVu 10')
	)).
	"
	| x |
	pointSize _ data first asNumber.
	ascent _ data second asNumber.
	descent _ data third asNumber.
	
	minAscii _ 32.
	maxAscii _ 255.
	name _ aString.
	type _ 0.  "ignored for now"
	superscript _ ascent - descent // 3.	
	subscript _ descent - ascent // 3.	
	emphasis _ 0.

	xTable _ (Array new: 258) atAllPut: 0.
	maxWidth _ 0.
	glyphs _ allGlyphs.
	x _ 0.
	minAscii to: maxAscii+1 do: [ :i |
		x _ (data at: i-minAscii+4) asNumber.
		xTable at: i+1 put: x].
	xTable at: 258 put: x.
	self reset.
	derivativeFonts _ Array new: 32! !

!StrikeFont methodsFor: 'building' stamp: 'jmv 3/18/2009 12:31'!
buildFromTableForm: allGlyphs name: aString
	"
	TextConstants at: #DejaVu put: (TextStyle fontArray: (Array
              with: (StrikeFont new buildFromForm: (Form fromFileNamed: 'AAFonts/DejaVu10.bmp') name: 'DejaVu 10')
	)).
	"
	| markers top bottom height baseline stripeCount columnStarts columnEnds glyph c x |
	markers _ self lineMarkersInTable: allGlyphs.
	ascent _ markers first.
	descent _ markers second.
	height _ ascent + descent.
	pointSize _ ascent. 
	baseline _ markers third.
	stripeCount _ baseline size.
	
	markers _ self columnMarkersIn: allGlyphs top: baseline first - ascent.
	columnStarts _ markers first.
	columnEnds _ markers second.
	
	minAscii _ 0.
	maxAscii _ 255.
	name _ aString.
	type _ 0.  "ignored for now"
	superscript _ ascent - descent // 3.	
	subscript _ descent - ascent // 3.	
	emphasis _ 0.

	xTable _ (Array new: 258) atAllPut: 0.
	maxWidth _ 0.
	glyphs _ Form extent: allGlyphs width * stripeCount @ height depth: allGlyphs depth.
	glyphs fillWhite.
	c _ 0.
	x _ 0.
	1 to: stripeCount do: [ :stripe |
		top _ (baseline at: stripe) - ascent+1.
		bottom _ (baseline at: stripe) + descent+1.
		1 to: columnStarts size do: [ :column |
			xTable at: c+1 put: x.
			glyph _ self glyph: c in: allGlyphs rect: ((columnStarts at: column) @ top corner: (columnEnds at: column) @ bottom).
			glyph notNil ifTrue: [
				maxWidth _ maxWidth max: glyph width.
				glyphs copy: glyph boundingBox from: glyph to: x@0 rule: Form over.
				x _ x + glyph width + 1.
				].
			c _ c + 1.
			] ].
	xTable at: 257 put: c.
	xTable at: 258 put: c.
	glyphs _ glyphs copy: (0@0 extent: x@glyphs height).
	self reset! !

!StrikeFont methodsFor: 'building' stamp: 'jmv 3/16/2009 14:05'!
columnMarkersIn: aForm top: height
"
	StrikeFont new columnMarkersIn: (Form fromFileNamed: 'AAFonts/DejaVu10.bmp') top: 20
"
	| tally columnsStart columnsEnd f |
	f _ aForm copy: (0@0 extent: aForm width @ height).
	tally _ f xTallyPixelValue: 32767 orNot: true.
	columnsStart _ (1 to: tally size-1) select: [ :x | 
		(tally at: x) = 0 and: [(tally at: x+1) > 0 ]].
	columnsEnd _ (0 to: tally size-2) select: [ :x | 
		(tally at: x+2) = 0 and: [(tally at: x+1) > 0 ]].
	^Array with: columnsStart with: columnsEnd! !

!StrikeFont methodsFor: 'building' stamp: 'jmv 3/16/2009 15:16'!
glyph: code in: aForm rect: aRect
	| glyph tally glyphStart glyphEnd |
	
	(#(9 13) includes: code) ifTrue: [ ^nil ].
	code = 32 ifTrue: [
		^(Form extent: aRect height // 4 @ aRect height depth: aForm depth) fillWhite ].
	glyph _ aForm copy: aRect.	
	tally _ glyph xTallyPixelValue: 32767 orNot: true.
	glyphStart _ (1 to: tally size-1) detect: [ :xx | (tally at: xx) > 0 ].
	glyphEnd _ (tally size to: 1 by: -1) detect: [ :xx | (tally at: xx) > 0 ].
	^glyph copy: (glyphStart @ 0 corner: glyphEnd@ aRect height).! !

!StrikeFont methodsFor: 'building' stamp: 'jmv 3/18/2009 12:31'!
lineMarkersInTable: aForm
"
	StrikeFont new lineMarkersIn: (Form fromFileNamed: 'AAFonts/DejaVu10.bmp')
	
self third do: [ :y | Display getCanvas line: 0@y to: 1200@y width: 1 color: Color red]
self third do: [ :y | Display getCanvas line: 0@(y-self first+1) to: 1200@(y-self first+1) width: 1 color: Color red]
self third do: [ :y | Display getCanvas line: 0@(y+self second) to: 1200@(y+self second) width: 1 color: Color red]
"
	| tally glyphsTop glyphsBottom max glyphsBaseline |
	tally _ aForm yTallyPixelValue: 32767 orNot: true.
	glyphsTop _ (1 to: tally size-1) select: [ :y | 
		(tally at: y) = 0 and: [(tally at: y+1) > 0 ]].
	glyphsTop _ glyphsTop copyFrom: 3 to: glyphsTop size.
	glyphsBottom _ (0 to: tally size-2) select: [ :y | 
		(tally at: y+2) = 0 and: [(tally at: y+1) > 0 ]].
	glyphsBottom _ glyphsBottom copyFrom: 3 to: glyphsBottom size.
	max _ tally max.
	glyphsBaseline _ 
		(glyphsBottom first to: glyphsTop first by: -1) detect: [ :y |
			(tally at: y+1) > (max //9) ].
	
	ascent _ glyphsBaseline - glyphsTop first + 1.
	descent _ glyphsBottom first - glyphsBaseline.
	glyphsBaseline _ glyphsBottom collect: [ :b | b - descent ].
	
	^Array with: ascent with: descent with: glyphsBaseline! !


!StrikeFont class methodsFor: 'instance creation' stamp: 'jmv 3/18/2009 12:38'!
installDejaVu
"
StrikeFont installDejaVu
"
	| baseF base boldF italicF bold italic sizes boldItalicF boldItalic data |
	sizes _ 5 to: 24.
	baseF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Book ', s printString -> ('DejaVu ', s printString) ].
	boldF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Bold ', s printString -> ('DejaVu ', s printString, 'B') ].
	italicF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Oblique ', s printString -> ('DejaVu ', s printString, 'I') ].
	boldItalicF _ sizes collect: [ :s |
		'AAFonts/DejaVu Sans Bold Oblique ', s printString -> ('DejaVu ', s printString, 'BI') ].
		
	base := OrderedCollection new.
	bold := OrderedCollection new.
	italic := OrderedCollection new.
	boldItalic := OrderedCollection new.
	
			baseF withIndexDo: [:keyValue :index | |form |	
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					base add: ((StrikeFont new buildFromForm: form data: data name: keyValue value)
						pointSize: keyValue value substrings last asNumber)].
			boldF withIndexDo: [:keyValue :index | |form |
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					bold add: ((StrikeFont new buildFromForm: form data: data name: keyValue value) 
						emphasis: 1;
						pointSize: keyValue value substrings last asNumber)].
			italicF withIndexDo: [:keyValue :index | |form |
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					italic add: ((StrikeFont new buildFromForm: form data: data name: keyValue value)
						emphasis:2;
						pointSize: keyValue value substrings last asNumber)].
			boldItalicF withIndexDo: [:keyValue :index | |form |
					form _ Form fromFileNamed:keyValue key, '.bmp'.
					data _ (FileStream oldFileNamed: keyValue key, '.txt') contentsOfEntireFile substrings.
					boldItalic add: ((StrikeFont new buildFromForm: form data: data name: keyValue value)
						emphasis:3;
						pointSize: keyValue value substrings last asNumber)].
			
			1 to: base size do: [ :i |
				(base at: i) derivativeFont: (bold at: i) at: 1.
				(base at: i) derivativeFont: (italic at: i) at: 2.
				(base at: i) derivativeFont: (boldItalic at: i) at: 3 ].

			TextConstants at: #DejaVu put: (TextStyle fontArray: base).
"
			Preferences setDefaultFonts: #(
				(setSystemFontTo: 'DejaVu' 9)
				(setListFontTo: 'DejaVu' 9)
				(setMenuFontTo: 'DejaVu' 10)
				(setWindowTitleFontTo: 'DejaVu' 12)
				(setBalloonHelpFontTo: 'DejaVu' 10)
				(setCodeFontTo: 'DejaVu' 10)
				(setButtonFontTo: 'DejaVu' 9))
"! !

!StrikeFont class methodsFor: 'removing' stamp: 'jmv 3/18/2009 12:43'!
removeMostFonts
"
StrikeFont removeMostFonts
"
	| style keep dejaVu |
	style _ TextConstants at: #DejaVu.
	keep _ #(7 8 9 10 12 14 16 18 20) collect: [ :s |
		style fontNamed: 'DejaVu ', s printString ].
	keep do: [ :f |
		f derivativeFont: nil at: 0 ].
	dejaVu _ TextStyle fontArray: keep.
	TextConstants at: #DefaultFixedTextStyle put: dejaVu.
	self actualFamilyNames do: [ :n |
		TextConstants removeKey: n ].
	TextConstants at: #DejaVu put: dejaVu.
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 9)
		(setListFontTo: 'DejaVu' 9)
		(setMenuFontTo: 'DejaVu' 10)
		(setWindowTitleFontTo: 'DejaVu' 12)
		(setBalloonHelpFontTo: 'DejaVu' 10)
		(setCodeFontTo: 'DejaVu' 10)
		(setButtonFontTo: 'DejaVu' 9))! !


!TextStyle class methodsFor: 'instance creation' stamp: 'jmv 3/18/2009 09:50'!
new
	^ super new leading: 2-2! !

