'From Cuis 1.0 of 21 August 2009 [latest update: #268] on 25 August 2009 at 7:11:02 pm'!
!classDefinition: #StrikeFont category: #'Graphics-Text'!
AbstractFont subclass: #StrikeFont
	instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth ascent descent subscript superscript emphasis derivativeFonts pointSize baseFont '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
!classDefinition: #StrikeFontTest category: #'StyledTextEditor-Tests'!
TestCase subclass: #StrikeFontTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'StyledTextEditor-Tests'!

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 8/25/2009 11:57'!
baseFont
	^self isBaseFont
		ifTrue: [ self ]
		ifFalse: [ baseFont ]! !

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 8/25/2009 11:55'!
baseFont: aStrikeFont
	baseFont _ aStrikeFont! !

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 8/25/2009 18:58'!
baseKern
	"Return the base kern value to be used for all characters.
	What follows is some 'random' text used to visually adjust this method.
	HaHbHcHdHeHfHgHhHiHjHkHlHmHnHoHpHqHrHsHtHuHvHwHxHyHzH
	HAHBHCHDHEHFHGHHHIHJHKHLHMHNHOHPHQHRHSHTHUHVHWHXHYHXZH
	wok yuyo	wuwu	vuvu	rucu	tucu	WUWU	VUVU	huevo	HUEVO	to
											k y mate	runico ridiculo	ARABICO	AAAAA	TOMATE
	TUTU
	tatadalajafua
	abacadafagahaqawaearatayauaiaoapasadafagahajakalazaxacavabanama
	kUxUxa
	q?d?h?l?t?f?j?"
	
	| italic baseKern |
	italic _ emphasis allMask: 2.
	
	"Assume synthetic will not affect kerning (i.e. synthetic italics are not used)"

	baseKern _ (italic or: [ pointSize < 9 ])
		ifTrue: [ 1 ]
		ifFalse: [ 0 ].
	(italic not and: [pointSize = 12]) ifTrue: [
		baseKern _ baseKern -1 ].
	pointSize >= 13 ifTrue: [
		baseKern _ baseKern -1 ].
	pointSize >= 20 ifTrue: [
		baseKern _ baseKern -1 ].
	
	"If synthetic italic"
	"See makeItalicGlyphs"
	(self isSynthetic and: [ emphasis = 3 ]) ifTrue: [
		baseKern _ baseKern + ((self height-1-self ascent+4)//4 max: 0)  
		+ (((self ascent-5+4)//4 max: 0)) ].
	^baseKern! !

!StrikeFont methodsFor: 'accessing' stamp: 'jmv 8/25/2009 13:48'!
derivativeFonts
	^derivativeFonts ifNotNil: [
		derivativeFonts copyWithout: nil ]! !

!StrikeFont methodsFor: 'testing' stamp: 'jmv 8/25/2009 11:55'!
isBaseFont
	^emphasis = 0! !

!StrikeFont methodsFor: 'emphasis' stamp: 'jmv 8/25/2009 13:52'!
derivativeFont: aStrikeFont at: index

	| newDeriv |
	(aStrikeFont isNil and: [ index = 0 ]) 
		ifTrue: [
			derivativeFonts _ nil.
			^ self].

	self isBaseFont ifFalse: [ 
		derivativeFonts _ nil.
		self error: 'Derivative fonts can not have derivatives' ].
	
	derivativeFonts ifNil: [derivativeFonts := Array new: 32].
	derivativeFonts size < 32 ifTrue: [
		newDeriv := Array new: 32.
		newDeriv replaceFrom: 1 to: derivativeFonts size with: derivativeFonts.
		derivativeFonts := newDeriv.
	].
	derivativeFonts at: index put: aStrikeFont.! !

!StrikeFont methodsFor: 'emphasis' stamp: 'jmv 8/25/2009 14:03'!
emphasized: code
	"Answer a copy of the receiver with emphasis set to include code."
	| derivative addedEmphasis base safeCode |
	self isBaseFont ifFalse: [ ^self baseFont emphasized: (code bitOr: emphasis) ].
	code = 0 ifTrue: [ ^ self ].
	
	derivative _ derivativeFonts at: (safeCode _ code min: derivativeFonts size).
	derivative ifNotNil: [^ derivative].  "Already have this style"

	"Dont have it -- derive from another with one with less emphasis"
	addedEmphasis _ 1 bitShift: safeCode highBit - 1.
	base _ self emphasized: safeCode - addedEmphasis.  "Order is Bold, Ital, Under, Narrow"
	addedEmphasis = 1 ifTrue:   "Compute synthetic bold version of the font"
		[derivative _ (base copy ensureCleanBold name: base name , 'B') makeBoldGlyphs].
	addedEmphasis = 2 ifTrue:   "Compute synthetic italic version of the font"
		[ derivative _ (base copy name: base name , 'I') makeItalicGlyphs].
	addedEmphasis = 4 ifTrue:   "Compute underlined version of the font"
		[derivative _ (base copy name: base name , 'U') makeUnderlinedGlyphs].
	addedEmphasis = 8 ifTrue:   "Compute narrow version of the font"
		[derivative _ (base copy name: base name , 'N') makeCondensedGlyphs].
	addedEmphasis = 16 ifTrue:   "Compute struck-out version of the font"
		[derivative _ (base copy name: base name , 'X') makeStruckOutGlyphs].
	derivative emphasis: safeCode.
	derivative baseFont: self.
	derivativeFonts at: safeCode put: derivative.
	^ derivative! !

!StrikeFont methodsFor: 'emphasis' stamp: 'jmv 8/25/2009 13:53'!
reset
	"Reset the cache of derivative emphasized fonts"
	
	derivativeFonts notNil ifTrue: [
		derivativeFonts withIndexDo: [ :f :i |
			(f notNil and: [ f isSynthetic ]) 
				ifTrue: [ derivativeFonts at: i put: nil ]]].
	"
	derivativeFonts _ Array new: 32.
	#('B' 'I' 'BI') doWithIndex:
		[:tag :index | 
		(style _ TextStyle named: self familyName) ifNotNil:
			[(font _ style fontArray
				detect: [:each | each name = (self name , tag)]
				ifNone: [nil]) ifNotNil: [derivativeFonts at: index put: font]]]
	"! !

!StrikeFont methodsFor: 'private' stamp: 'jmv 8/25/2009 13:35'!
fixDerivatives
	self isBaseFont
		ifTrue: [
			baseFont _ nil.
			derivativeFonts do: [ :der |
				der ifNotNil: [
					der baseFont: self.
					der fixDerivatives ]]]
		ifFalse: [
			derivativeFonts _ nil ].! !

!StrikeFont methodsFor: 'building' stamp: 'jmv 8/25/2009 13:52'!
buildFromForm: allGlyphs data: data name: aString

	| 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 _ nil! !

!StrikeFont methodsFor: 'derivatives - emphasis' stamp: 'jmv 8/25/2009 13:40'!
narrow
	^self emphasized: 8! !

!StrikeFont methodsFor: 'derivatives - emphasis' stamp: 'jmv 8/25/2009 13:41'!
struckOut
	^self emphasized: 16! !

!StrikeFont methodsFor: 'derivatives - emphasis' stamp: 'jmv 8/25/2009 13:40'!
underlined
	^self emphasized: 4! !


!StrikeFontTest methodsFor: 'testing' stamp: 'jmv 8/25/2009 13:45'!
testBaseAndDerivedFont
	"
	StrikeFontTest new testBaseAndDerivedFont
	"

	| base italic italicItalic boldItalic italicBold boldItalic2 underlined underlinedItalic italicUnderlined struckOut1 struckOut2 |
	base _ AbstractFont familyName: 'DejaVu' pointSize: 14.
	self assert: base isBaseFont.
	italic _ base italic.
	self deny: italic isBaseFont.
	italicItalic _ italic italic.
	self assert: italicItalic == italic.
	boldItalic _ base bold italic.
	self deny: boldItalic isBaseFont.
	boldItalic2 _ base boldItalic.
	italicBold _ italic bold.
	self assert: boldItalic == italicBold.
	self assert: boldItalic == boldItalic2.
	underlined _ base underlined.
	self deny: underlined isBaseFont.
	underlinedItalic _ underlined italic.
	italicUnderlined _ italic underlined.
	self assert: underlinedItalic == italicUnderlined.
	struckOut1 _ base italic underlined bold struckOut.
	struckOut2 _ base bold underlined italic struckOut.
	self assert: struckOut1 == struckOut2! !

!StrikeFontTest methodsFor: 'testing' stamp: 'jmv 8/25/2009 13:48'!
testBaseAndDerivedFontSanity
	"
	StrikeFontTest new testBaseAndDerivedFontSanity
	"

	StrikeFont allInstances do: [ :f |
		f isBaseFont 
			ifTrue: [
				self assert: (f instVarNamed: 'baseFont') isNil.
				self assert: f baseFont == f.
				self assert: f derivativeFonts notNil ]
			ifFalse: [
				self assert: f baseFont notNil.
				self assert: f derivativeFonts isNil.
				self assert: (f baseFont emphasized: f emphasis) == f ] ]! !

!classDefinition: #StrikeFont category: #'Graphics-Text'!
AbstractFont subclass: #StrikeFont
	instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth ascent descent subscript superscript emphasis baseFont derivativeFonts pointSize'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Text'!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
StrikeFont allInstances do: [ :f | f fixDerivatives ]!

