'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 24 April 2003 at 12:34:08 am'!

!StrikeFont class methodsFor: 'instance creation' stamp: 'sumim 4/23/2003 22:31'!
fromUser: priorFont
	"Present a menu of available fonts, and if one is chosen, return it."
	| fontList fontMenu style active ptMenu label spec font |
	"self halt."
	fontList _ StrikeFont familyNames remove: 'DefaultTextStyle' ifAbsent: []; asOrderedCollection.
	fontMenu _ MenuMorph new defaultTarget: self.
	fontList do: [:fontName |
		style _ TextStyle named: fontName.
		active _ priorFont familyName sameAs: fontName.
		ptMenu _ MenuMorph new defaultTarget: self.
		style pointSizes do: [:pt |
			(active and:[pt = priorFont pointSize]) 
				ifTrue:[label _ '<on>'] 
				ifFalse:[label _ '<off>'].
			label _ label, pt printString, ' pt'.
			ptMenu add: label 
				target: fontMenu
				selector: #modalSelection:
				argument: {fontName. pt}].
		((style fontArray first isKindOf: TTCFont) or: [
			(style fontArray first isKindOf: TTCFontSet)]) ifTrue: [
			ptMenu 
				add: 'new size'
				target: style 
				selector: #addNewFontSizeDialog: 
				argument: {fontName. fontMenu}].
		active ifTrue:[label _ '<on>'] ifFalse:[label _ '<off>'].
		label _ label, fontName.
		fontMenu add: label subMenu: ptMenu].
	spec _ fontMenu invokeModal: false. "don't allow keyboard control"
	spec ifNil: [^ nil].
	style _ TextStyle named: spec first.
	style ifNil: [^ self].
	font _ style fonts detect: [:any | any pointSize = spec last] ifNone: [nil].
	^ font! !

!StrikeFont class methodsFor: 'instance creation' stamp: 'sumim 4/23/2003 22:33'!
fromUserForMulti: priorFont
	"Present a menu of available fonts, and if one is chosen, return it."
	| fontList fontMenu style active ptMenu label spec font |
	"self halt."
	fontList _ StrikeFont familyNames remove: 'DefaultTextStyle' ifAbsent: []; asOrderedCollection.
	fontMenu _ MenuMorph new defaultTarget: self.
	fontList do: [:fontName |
		((style _ TextStyle named: fontName) defaultFont class name copyLast: 3) = 'Set' ifTrue: [
			active _ priorFont familyName sameAs: fontName.
			ptMenu _ MenuMorph new defaultTarget: self.
			style pointSizes do: [:pt |
				(active and:[pt = priorFont pointSize]) 
					ifTrue:[label _ '<on>'] 
					ifFalse:[label _ '<off>'].
				label _ label, pt printString, ' pt'.
				ptMenu add: label 
					target: fontMenu
					selector: #modalSelection:
					argument: {fontName. pt}].
			((style fontArray first isKindOf: TTCFont) or: [
				(style fontArray first isKindOf: TTCFontSet)]) ifTrue: [
				ptMenu 
					add: 'new size'
					target: style 
					selector: #addNewFontSizeDialog: 
					argument: {fontName. fontMenu}].
			active ifTrue:[label _ '<on>'] ifFalse:[label _ '<off>'].
			label _ label, fontName.
			fontMenu add: label subMenu: ptMenu]].
	spec _ fontMenu invokeModal: false. "don't allow keyboard control"
	spec ifNil: [^ nil].
	style _ TextStyle named: spec first.
	style ifNil: [^ self].
	font _ style fonts detect: [:any | any pointSize = spec last] ifNone: [nil].
	^ font! !


!TTCFont methodsFor: 'accessing' stamp: 'sumim 4/23/2003 23:40'!
pointSize

	^ (pixelSize * 72 / 96) rounded
! !


!TTCFontSet methodsFor: 'as yet unclassified' stamp: 'sumim 4/23/2003 23:28'!
emphasis
	^ fontArray first emphasis! !

!TTCFontSet methodsFor: 'as yet unclassified' stamp: 'sumim 4/23/2003 23:56'!
pointSize

	^ (fontArray first pixelSize * 72 / 96) rounded! !


!TextStyle methodsFor: 'fonts and font indexes' stamp: 'sumim 4/24/2003 00:33'!
addNewFontSize: pointSize

	| f d newArray t |
	fontArray first emphasis ~= 0 ifTrue: [
		t _ TextConstants at: self fontArray first familyName asSymbol.
		t fonts first emphasis = 0 ifTrue: [
			^ t addNewFontSize: pointSize.
		].
	].

	pointSize <= 0 ifTrue: [^ nil].
	fontArray do: [:s |
		s pointSize = pointSize ifTrue: [^ s].
	].

	(fontArray first isKindOf: TTCFontSet) 
	ifTrue:[
		| fonts |
		fonts _ fontArray first fontArray collect: [ :font |
			| newFont |
			newFont _ (font ttcDescription size > 256)
				ifTrue: [MultiTTCFont new initialize]
				ifFalse: [TTCFont new initialize].
			newFont ttcDescription: font ttcDescription.
			newFont pixelSize: pointSize * 96 // 72.
			font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto |
				proto ifNotNil: [
					d _ proto class new initialize.
					d ttcDescription: proto ttcDescription.
					d pixelSize: newFont pixelSize.
					newFont derivativeFont: d]]].
			newFont].
		f _ TTCFontSet newFontArray: fonts]
	ifFalse: [
		f _ TTCFont new initialize.
		f ttcDescription: fontArray first ttcDescription.
		f pixelSize: pointSize * 96 // 72.
		fontArray first derivativeFonts do: [ :proto |
			proto ifNotNil: [
				d _ TTCFont new initialize.
				d ttcDescription: proto ttcDescription.
				d pixelSize: f pixelSize.
				f derivativeFont: d]]].

	newArray _ ((fontArray copyWith: f) asSortedCollection: [:a :b | a pointSize <= b pointSize]) asArray.
	self newFontArray: newArray.
	^ self fontOfPointSize: pointSize
! !

!TextStyle methodsFor: 'fonts and font indexes' stamp: 'sumim 4/23/2003 22:39'!
discardOtherSizes

	| newArray |
	((fontArray first isKindOf: TTCFont) or: [fontArray first isKindOf: TTCFontSet]) 
		ifFalse: [^ self].
	newArray _ fontArray select: [:s | TTCFont pointSizes includes: s pointSize * 96 // 72].
	self newFontArray: newArray.

"(TextConstants at: #ComicSansMS) discardOtherSizes"! !


!Utilities class methodsFor: 'text styles and fonts' stamp: 'sumim 4/23/2003 22:30'!
fontMenuForStyle: styleName target: target selector: selector
 	| aMenu |
	aMenu _ MenuMorph entitled: styleName.
	TextConstants at: styleName ifPresent: [:s |
		((s fonts first isKindOf: TTCFont) or: [s fonts first isKindOf: TTCFontSet]) ifTrue: [
			aMenu 
				add: 'New Size' 
				target: self 
				selector: #chooseTTCFontSize: 
				argument: {styleName. target. selector}]].
 	(Utilities pointSizesFor: styleName) do:
		[:aWidth |
			aMenu 
				add: (aWidth asString, ' Point') 
				target: target 
				selector: selector
				argument: ((TextStyle named: styleName) fontOfPointSize: aWidth).
                aMenu lastItem font: ((TextStyle named: styleName) fontOfPointSize: aWidth)].
        ^ aMenu! !