'From Squeak6.0alpha of 20 December 2021 [latest update: #20885] on 21 December 2021 at 6:34:01 pm'!

!DisplayScreen methodsFor: 'scale factor' stamp: 'mt 12/21/2021 11:28'!
scaleFactor
	
	UserInterfaceTheme current isTTCBased
		ifFalse: [^ RealEstateAgent scaleFactor].

	^ TextStyle pixelsPerInch / 96.0! !

!DisplayScreen methodsFor: 'scale factor' stamp: 'mt 12/21/2021 15:54'!
scaleFactor: aFloat
	"Can be from the system or overridden by the user."

	| oldFactor newFactor |
	(UserInterfaceTheme current canFakeScaleFactor: aFloat) ifTrue: [
		self flag: #isTTCBased.
		^ UserInterfaceTheme current applyScaled: aFloat].
	
	oldFactor := self scaleFactor.
	newFactor := aFloat max: 1.0.
	newFactor = oldFactor ifTrue: [^ self].
	
	TextStyle pixelsPerInch: 96.0 * aFloat.
	Project current ifNotNil: [:p | p displayScaleChangedFrom: oldFactor to: newFactor].! !


!DisplayScreen class methodsFor: 'snapshots' stamp: 'mt 12/21/2021 09:45'!
actualScreenScaleFactor
	"<primitive: 'primitiveScreenScaleFactor'>"
	
	^ 1.0! !


!FontImporterTool methodsFor: 'helper' stamp: 'mt 12/21/2021 16:22'!
fontFromFamily: aFamily

	| readFonts | 
	aFamily ifNil: [^ TextStyle default fonts first].
	readFonts := TTFileDescription readFontsFrom: aFamily allFilenames anyOne.
	^ (readFonts size > 1
		ifTrue: [ 
			| ftArray |
			" see TTCFontSet>>newTextStyleFromTT: "
			ftArray := readFonts collect: [:ttc | |f|
				ttc ifNil: [nil] ifNotNil: [
					f := TTCFont new.
					f ttcDescription: ttc.
					f pointSize: TextStyle defaultFont pointSize.
					f]].
			TTCFontSet newFontArray: ftArray]
		ifFalse: [ |f|
			f := TTCFont new.
			f ttcDescription: readFonts anyOne.
			f pointSize: TextStyle defaultFont pointSize.	
			f])! !


!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 12/21/2021 12:43'!
decreaseFontSize

	Display scaleFactor: (Display scaleFactor roundTo: 0.25) - 0.25.! !

!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 12/21/2021 12:43'!
increaseFontSize

	Display scaleFactor: (Display scaleFactor roundTo: 0.25) + 0.25.! !

!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 12/21/2021 12:48'!
setDemoFonts
	"Preferences setDemoFonts"

	Display scaleFactor: 1.5.! !

!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 12/21/2021 08:05'!
setFixedFontTo: aFont

	UserInterfaceTheme current setFixedFontTo: aFont.! !

!Preferences class methodsFor: 'prefs - fonts' stamp: 'mt 12/21/2021 08:04'!
setSystemFontTo: aFont

	UserInterfaceTheme current setSystemFontTo: aFont.! !


!Project methodsFor: 'displaying' stamp: 'mt 12/21/2021 11:11'!
displayScaleChangedFrom: oldFactor to: newFactor

	RealEstateAgent resetScaleFactor. "Reset cached scale factor used by tool builders etc."! !


!MorphicProject methodsFor: 'display' stamp: 'mt 12/21/2021 17:41'!
displayScaleChangedFrom: oldFactor to: newFactor
	"Update Morphic-specific geometry. Try to be more efficient than UI theme's #applyUserInterfaceTheme."
	
	| scale |
	super displayScaleChangedFrom: oldFactor to: newFactor.
	
	"Based on UserInterfaceTheme >> #apply"
	(#(SimpleHierarchicalListMorph SystemWindow PluggableTextMorph SystemProgressMorph)
		collect: [:className | self environment classNamed: className])
		in: [:widgetClasses | 
			widgetClasses do: [:ea | ea applyUserInterfaceTheme].
			Cursor wait showWhile: [
				SystemNavigation default allObjectsDo: [:o |
					((widgetClasses includes: o class)
						and: [o canApplyUserInterfaceTheme])
							ifTrue: [o applyUserInterfaceTheme]]]].
	
	
	"Resize windows."
	scale := newFactor / oldFactor.
	self world submorphs
		select: [:ea | ea isSystemWindow]
		thenDo: [:ea |
			ea extent: (ea extent * scale).
			ea layoutChanged.
			ea setFramesForLabelArea].! !


!RealEstateAgent class methodsFor: 'display scale' stamp: 'mt 12/21/2021 11:10'!
resetScaleFactor
	
	ScaleFactor := nil.! !

!RealEstateAgent class methodsFor: 'display scale' stamp: 'mt 12/21/2021 12:39'!
scaleFactor
	"Use the default font height to calculate some factor. Note that, in the future, we will be able to use a method that is not based on pixels once we only use TrueType fonts all over the image. Then, TextStyle class >> #pixelsPerInch will suffice, considering that 96 PPI represents a scale factor of 1.0."
	
	^ ScaleFactor ifNil: [ScaleFactor := (TextStyle defaultFont height / StrikeFont referenceHeight)]! !


!StrikeFont class methodsFor: '*System-constants' stamp: 'mt 12/21/2021 08:58'!
referenceHeight
	"Since Squeak 4.1, the standard system/text font has been pre-rendered to a height of 14 pixels, which are about 10.5 point in 96 PPI. We can use this value to compute the effective in-image scale factor using the current system font's height (in pixels). If that font happens to be a TTCFont, the same #pointSize can result in a different #pixelSize once PPI changes.
	
	StrikeFont ... 10.5 pt = 14 px in 96 ppi = 1.0 or 100%
	TTCFont ... 96 ppi = 1.0 or 100%
	"

	^ 14 "pixels"! !


!TTCFont class methodsFor: '*System-constants' stamp: 'mt 12/21/2021 13:15'!
referencePointSize
	"See commentary in StrikeFont class >> #referenceHeight."

	^ 10.5! !


!TextStyle class methodsFor: 'utilities' stamp: 'mt 12/21/2021 11:05'!
pixelsPerInch: aNumber
	"Set the nominal number of pixels per inch to aNumber."

	self pixelsPerInch = aNumber ifTrue: [^ self].
	TextConstants at: #pixelsPerInch put: aNumber.
	AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ].! !


!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 12/21/2021 12:48'!
chooseCustomScaleFactor

	| result |
	result := Project uiManager request: 'Please enter a scale factor in %' translated initialAnswer: '350'.
	result ifEmpty: [^ self].
	[result := result asInteger abs] ifError: [^ self].
	result < 100 ifTrue: [^ self].
	Display scaleFactor: result / 100.! !

!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 12/19/2021 09:11'!
extrasMenuOn: aDockingBar 

	aDockingBar addItem: [ :it|
		it 	contents: 'Extras' translated;
			addSubMenu: [:menu|
				menu addItem:[:item|
					item
						contents: 'Recover Changes' translated;
						help: 'Recover changes after a crash' translated;
						icon: MenuIcons smallDocumentClockIcon;
						target: ChangeList;
						selector: #browseRecentLog].
				menu addItem:[:item|
					item
						contents: 'Recover Method Versions' translated;
						help: 'Recover versions of deleted methods' translated;
						target: ChangeList;
						selector: #browseMethodVersions].				
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Themes & Colors' translated;
						subMenuUpdater: self
						selector: #themesAndWindowColorsOn: ].
				menu addItem:[:item|
					item
						contents: 'Scale Factor' translated;
						subMenuUpdater: self
						selector: #scaleFactorsOn:].
				menu addItem:[:item|
					item
						contents: 'Language' translated;
						subMenuUpdater: self
						selector: #languageTranslatorsOn: ].
				menu addItem:[:item|
					item
						contents: 'Set Author Initials' translated;
						help: 'Sets the author initials' translated;
						icon: MenuIcons smallUserQuestionIcon;
						target: Utilities;
						selector: #setAuthorInitials].
				menu addItem:[:item|
					item
						contents: 'Restore Display (r)' translated;
						help: 'Redraws the entire display' translated;
						target: Project current;
						selector: #restoreDisplay].
				menu addItem:[:item|
					item
						contents: 'Rebuild Menus' translated;
						help: 'Rebuilds the menu bar' translated;
						target: TheWorldMainDockingBar;
						selector: #updateInstances].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Start Profiler' translated;
						help: 'Starts the profiler' translated;
						icon: MenuIcons smallTimerIcon;
						target: self;
						selector: #startMessageTally].
				menu addItem:[:item|
					item
						contents: 'Collect Garbage' translated;
						help: 'Run the garbage collector and report space usage' translated;
						target: Utilities;
						selector: #garbageCollectAndReport].
				menu addItem:[:item|
					item
						contents: 'Purge Undo Records' translated;
						help: 'Save space by removing all the undo information remembered in all projects' translated;
						target: CommandHistory;
						selector: #resetAllHistory].
				menu addItem:[:item|
					item
						contents: 'VM statistics' translated;
						help: 'Virtual Machine information' translated;
						target: self;
						selector: #vmStatistics].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Graphical Imports' translated;
						help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated;
						target: (Imports default);
						selector: #viewImages].
				menu addItem:[:item|
					item
						contents: 'Standard Graphics Library' translated;
						help: 'Lets you view and change the system''s standard library of graphics' translated;
						target: ScriptingSystem;
						selector: #inspectFormDictionary].
				menu addItem:[:item|
					item
						contents: 'Annotation Setup' translated;
						help: 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools' translated;
						target: Preferences;
						selector: #editAnnotations].
				menu addItem:[:item|
					item
						contents: 'Browse My Changes' translated;
						help: 'Browse all of my changes since the last time #condenseSources was run.' translated;
						target: SystemNavigation new;
						selector: #browseMyChanges].
			] ]! !

!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 12/21/2021 12:54'!
scaleFactorsOn: menu

	| presets currentScaleFactor |
	currentScaleFactor := UserInterfaceTheme current isTTCBased
		ifTrue: [(Display scaleFactor * 100) rounded]
		ifFalse: [(Display scaleFactor * 100) roundTo: 25].
	presets := 100 to: 300 by: 25.
	
	presets do: [:scale |
		scale = 175 ifTrue: [menu addLine]. "TTCFont used after this line..."
		menu addItem: [:item|
			item
				contents: (currentScaleFactor = scale ifTrue: ['<yes>'] ifFalse: ['<no>']), scale, '%';
				target: Display;
				selector: #scaleFactor:;
				arguments: {scale / 100}]].
		
	menu addLine.
	menu addItem: [:item |
		item
			contents: ((presets includes: currentScaleFactor) not ifTrue: ['<yes> Custom: ', currentScaleFactor, '% ...'] ifFalse: ['<no>Other scale factor...']);
			target: self;
			selector: #chooseCustomScaleFactor].! !

!TheWorldMainDockingBar methodsFor: 'submenu - extras' stamp: 'mt 12/21/2021 13:33'!
themesAndWindowColorsOn: menu
	| themes |
	menu addItem:[:item|
		item
			contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated;
			target: self;
			selector: #toggleColorfulWindows].
	menu addItem:[:item|
		item
			contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated;
			target: self;
			selector: #toggleGradients].
	menu addLine.
	menu addItem:[:item |
		item
			contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated;
			target: self;
			selector: #toggleSoftShadows].
	menu addItem:[:item |
		item
			contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated;
			target: self;
			selector: #toggleHardShadows].
	menu addLine.
	menu addItem:[:item |
		item
			contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog/Menu Look' translated;
			target: self;
			selector: #toggleRoundedWindowLook].
	menu addItem:[:item |
		item
			contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar Look' translated;
			target: self;
			selector: #toggleRoundedButtonLook].
	menu addLine.
	themes := UserInterfaceTheme allThemes asArray sort: #name ascending.
	themes := themes select: [ :each | each isGenuine].
	themes ifEmpty: [ 
		menu addItem: [ :item | 
			item
				contents: '(No UI themes found.)' translated;
				isEnabled: false ] ].
	themes do: [ :each |
		menu addItem: [ :item |
			item 
				contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name;
				target: each;
				selector: #applyScaled ] ].
	menu	
		addLine;
		add: 'Set Etoys Mode' translated target: ReleaseBuilderSqueakland selector: #setEtoysMode.
	menu
		addLine;
		add: 'Restore UI Theme Background' translated target: self selector: #restoreThemeBackground;
		add: 'Edit Current UI Theme...' translated target: self selector: #editCurrentTheme.! !


!UserInterfaceTheme methodsFor: 'actions' stamp: 'mt 12/21/2021 15:31'!
applyAfter: aBlock

	lastScaleFactor := Display scaleFactor.
	self ignoreApplyDuring: aBlock.
	self apply.! !

!UserInterfaceTheme methodsFor: 'actions' stamp: 'mt 12/21/2021 15:29'!
ignoreApplyDuring: aBlock

	ignoreApply := true.
	^ aBlock ensure: [ignoreApply := false]! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 11:32'!
applyScaled
	"Apply the receiver but keep the current theme's #scaleFactor."
	
	self applyScaled: Display scaleFactor.! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 11:31'!
applyScaled: aFloat
	"Apply the receiver with the given scale factor aFloat."
	
	self setScaleFactor: aFloat.! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 13:49'!
canFakeScaleFactor: aFloat
	"Answer whether we can fake the given scale factor with pre-rendered fonts."

	self isTTCBased ifFalse: [^ true "Need to #makeTTCBased anyway."].
	(self lookupScaleFactor: 1.0) ifNil: [^ false "Without a fake 100%, we go all-in with TrueType fonts."].

	aFloat = 1.0 ifTrue: [^ true].
	aFloat = 1.25 ifTrue: [^ true].
	aFloat = 1.5 ifTrue: [^ true].
	
	^ false! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 14:11'!
checkScaleFactor100
	"The receiver must not be the reference theme for 100% using pre-rendered fonts."
	
	self
		assert: [self isTTCBased or: [self localScaleFactor ~= 1.0]]
		description: 'You must not modify the reference theme!!'.! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 14:11'!
checkTheme100

	| theme100 |
	self flag: #isTTCBased.
	theme100 := self lookupScaleFactor: 1.0.
	self
		assert: [theme100 notNil]
		description: 'Reference theme not found!! Please reset all themes.'.
	^ theme100! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 16:31'!
copyWithScaleFactor: aFloat
	"Duplicate the receiver and reconfigure the copy to have its #scaleFactor match factorInPercent. This method is used for preserving the reference theme, which has a 100% scale factor."

	| copy |
	self
		assert: [self isTTCBased not]
		description: 'There is no need to duplicate themes that are already based on TrueType fonts!!'.
	
	copy := UserInterfaceTheme named: 'Demo'.
	copy merge: self overwrite: true.
	
	copy name: self name.
	copy set: #standardSystemFont to: nil. "We are not theme100 for the moment."
	self assert: [copy localScaleFactor isNil].

	copy setScaleFactorPreApply: aFloat.
	
	^ copy! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 16:51'!
doScale100
	"Private. Use #applyScaled:. The reference theme, which has a 100% scale factor, must already be there. Look it up and apply it."
	
	self checkTheme100 apply.
	TextStyle pixelsPerInch: 96.0. "Restore Squeak's default PPI for 100%."! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 16:51'!
doScale125
	"Private. Use #applyScaled:. This is actually about 135% because of which font sizes we have available."
	
	| specs theme100 |
	self checkScaleFactor100.
	theme100 := self checkTheme100.
	
	self flag: #hack. "mt: A different scale factor should not result in different point sizes being selected BUT the same point size resulting in a different pixel height."
	
	specs := OrderedCollection new.
	#(
	standardSystemFont 14.5
	standardFixedFont 14.5
	
	standardCodeFont 14.5
	standardListFont 14.5
	standardButtonFont 10.5
	standardMenuFont 14.5
	standardFlapFont 10.5
		
	windowTitleFont 14.5
	balloonHelpFont 10.5
	haloLabelFont 14.5)
		groupsDo: [:symbolicFontName :newPointSize | | font100 fontScaled |
			font100 := theme100 get: symbolicFontName.
			fontScaled := font100 isTTCFont
				ifTrue: [TTCFont familyName: font100 familyName pointSize: newPointSize emphasis: font100 emphasis]
				ifFalse: [StrikeFont familyName: font100 familyName pointSize: newPointSize emphasized: font100 emphasis].
			"Check whether newPointSize for StrikeFont is installed."
			self
				assert: [fontScaled pointSize = newPointSize]
				description: 'No pre-rendered font with the correct point size available'.
			specs add: (Symbol lookup: ('set', ((symbolicFontName beginsWith: 'standard') ifTrue: [symbolicFontName allButFirst: 8] ifFalse: [symbolicFontName capitalized]), 'To:')).
			specs add: fontScaled.
			].
		
	self setFonts: specs.
	TextStyle pixelsPerInch: 96.0. "Restore Squeak's default PPI for 100%."! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 16:51'!
doScale150
	"Private. Use #applyScaled:. Traditional 'Demo Mode'. Optimized for existing pre-rendered fonts. Does not fall back on TTC font. See #doScale:. This is actually about 157% because of which font sizes we have available."
	
	| specs theme100 |
	self checkScaleFactor100.
	theme100 := self checkTheme100.
	
	self flag: #hack. "mt: A different scale factor should not result in different point sizes being selected BUT the same point size resulting in a different pixel height."
	
	specs := OrderedCollection new.
	#(
	standardSystemFont 16.5
	standardFixedFont 16.5
	
	standardCodeFont 16.5
	standardListFont 16.5
	standardButtonFont 14.5
	standardMenuFont 16.5
	standardFlapFont 14.5
		
	windowTitleFont 16.5
	balloonHelpFont 14.5
	haloLabelFont 16.5)
		groupsDo: [:symbolicFontName :newPointSize | | font100 fontScaled |
			font100 := theme100 get: symbolicFontName.
			fontScaled := font100 isTTCFont
				ifTrue: [TTCFont familyName: font100 familyName pointSize: newPointSize emphasis: font100 emphasis]
				ifFalse: [StrikeFont familyName: font100 familyName pointSize: newPointSize emphasized: font100 emphasis].
			"Check whether newPointSize for StrikeFont is installed."
			self
				assert: [fontScaled pointSize = newPointSize]
				description: 'No pre-rendered font with the correct point size available'.
			specs add: (Symbol lookup: ('set', ((symbolicFontName beginsWith: 'standard') ifTrue: [symbolicFontName allButFirst: 8] ifFalse: [symbolicFontName capitalized]), 'To:')).
			specs add: fontScaled.
			].
		
	self setFonts: specs.
	TextStyle pixelsPerInch: 96.0. "Restore Squeak's default PPI for 100%."! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 13:33'!
isGenuine

	^ self isTTCBased or: [self localScaleFactor = 1.0]! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 14:04'!
isTTCBased
	"Answer whether the receiver uses only TrueType fonts, which can flexibly adapt to changing scale factors."

	^ (self get: #standardSystemFont) ifNil: [false] ifNotNil: [:font | font isTTCFont]
	
	"properties keysDo: [:key |
		(key isSymbol and: [key endsWith: #Font])
			ifTrue: [(self get: key) isTTCFont ifFalse: [^ false]]].
	^ true"! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 14:42'!
localScaleFactor
	"Answers the scale factor that the receiver supports, which is arbitrary for themes that only use TTCFonts."

	self
		assert: [self isTTCBased not]
		description: 'The local scale factor is undefined for TrueType-based themes!!'.

	^ (self get: #standardSystemFont)
		ifNil: ["Not yet initialized."]
		ifNotNil: [:font | (font height / StrikeFont referenceHeight) roundTo: 0.25]! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 17:05'!
lookupScaleFactor: aFloat
	"Answer a theme that fakes the given scale factor with pre-rendered fonts."

	^ self class allThemes
		detect: [:ea | ea name = self name and: [ea isTTCBased not and: [ea localScaleFactor = aFloat]]]
		ifNone: ["Not found."]! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 16:26'!
lookupSimilar
	"Answer a theme that is similar to the receiver but not the reference theme for pre-rendered fonts."

	^ self class allThemes
		detect: [:ea | ea name = self name and: [ea isTTCBased or: [ea localScaleFactor ~= 1.0]]]
		ifNone: ["Not found."]! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 15:45'!
makeTTCBased

	| ttcFallbackName theme100 specs |
	self isTTCBased ifTrue: [^ self].

	self checkScaleFactor100.
	theme100 := self checkTheme100.
	ttcFallbackName := self ttcFallbackName.
	
	specs := #(
	standardSystemFont
	standardFixedFont
	
	standardCodeFont
	standardListFont
	standardButtonFont
	standardMenuFont
	standardFlapFont
		
	windowTitleFont
	balloonHelpFont
	haloLabelFont)
		collect: [:symbolicFontName | | current alternative |
			current := theme100 get: symbolicFontName.
			current isTTCFont
				ifTrue: [alternative := current]
				ifFalse: [alternative := TTCFont familyName: ttcFallbackName
						pointSize: current pointSize emphasis: current emphasis].
			{
				Symbol lookup: ('set', ((symbolicFontName beginsWith: 'standard') ifTrue: [symbolicFontName allButFirst: 8] ifFalse: [symbolicFontName capitalized]), 'To:').
				alternative
			}].
		
	self ignoreApplyDuring: [ specs do: [:pair |
		Preferences
			perform: pair first
			with: pair second] ].
	
	self assert: [self isTTCBased].! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/20/2021 14:30'!
setFonts: spec

	self applyAfter: [ spec pairsDo: [:mutator :font |
		Preferences
			perform: mutator
			with: font] ].! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 17:04'!
setScaleFactor: aFloat
	"Private. Use #applyScaled:. In the receiver, change the fonts to have a scale of aFloat. Change all fonts to be TrueType fonts if no pre-rendered fonts exist. Never change the 100% reference theme but make a copy. Apply the receiver to the system."

	(self isTTCBased not and: [aFloat = self localScaleFactor])
		ifTrue: [^ self "No change"].

	(self lookupScaleFactor: aFloat)
		ifNotNil: [:theme | ^ theme apply "Already there with pre-rendered fonts. Use class-side #cleanUp: to reset broken themes."].
	
	(self isTTCBased not and: [self localScaleFactor = 1.0]) "!!!! Never change the reference theme !!!!"
		ifTrue: [^ self lookupSimilar ifNil: [self copyWithScaleFactor: aFloat] ifNotNil: [:other | other setScaleFactorPreApply: aFloat]].
	
	aFloat = 1.0 ifTrue: [^ self doScale100].
	aFloat = 1.25 ifTrue: [^ self doScale125].
	aFloat = 1.5 ifTrue: [^ self doScale150].

	"And now transition from the pre-rendered world into the TrueType world. Or re-use an existing TrueType-based theme with new values. See #lookupSimilar above."
	TextStyle pixelsPerInch: 96.0 * RealEstateAgent scaleFactor "current, based on pixels".
	self makeTTCBased.
	self applyAfter: [TextStyle pixelsPerInch: 96.0 * aFloat "new, not rounded"].! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/21/2021 16:33'!
setScaleFactorPreApply: aFloat

	| last |
	last := Current.
	[Current := self.  "Manage side-effects in #setDefaultFonts: ..."
	self setScaleFactor: aFloat]
		on: Error do: [:ex | Current := last. ex pass].! !

!UserInterfaceTheme methodsFor: 'private - display scale' stamp: 'mt 12/20/2021 10:23'!
ttcFallbackName
	"Answer the name of the TTCFont that should be used as a fallback for pre-rendered StrikeFonts that do not have the requested #pointSize available. See #ttcCorrection."
	
	^ 'BitstreamVeraSans'! !

!UserInterfaceTheme methodsFor: 'testing' stamp: 'mt 12/19/2021 10:03'!
isCurrent
	"Note that changes to the receiver's properties without calling #apply can result in visual differences even though the answer might be 'true'."
	
	^ self class current == self! !

!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 12/21/2021 17:13'!
fixFontsAndScaleAround: block
	"Due to the current situation with fonts and the real-estate manager, this is a small workaround to support theme switching with largely different font sizes."

	lastScaleFactor ifNil: [lastScaleFactor := Display scaleFactor].

	"Due to the current font situation, update TextConstants."
	(self get: #standardSystemFont) ifNotNil: [:font | self setSystemFontSilentlyTo: font].
	(self get: #standardFixedFont) ifNotNil: [:font | self setFixedFontSilentlyTo: font].
	RealEstateAgent resetScaleFactor.

	"Apply theme etc."
	block value.

	"Due to the current real-estate manager situation, resize all windows. Works only for Morphic projects."
	Display scaleFactor ~= lastScaleFactor ifTrue: [
		Project current isMorphic ifTrue: [
			| scale |
			scale := Display scaleFactor / lastScaleFactor.
			Project current world submorphs
				select: [:ea | ea isSystemWindow]
				thenDo: [:ea |
					ea extent: (ea extent * scale).
					ea layoutChanged.
					ea setFramesForLabelArea]]].

	lastScaleFactor := nil.! !

!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 12/21/2021 14:35'!
setFixedFontSilentlyTo: aFont
	"Establish the default fixed text font and style"

	| aStyle |
	self flag: #todo. "mt: Support derivatives such as bold and italic."
	aStyle := aFont textStyle.
	aStyle defaultFontIndex: (aStyle fontIndexOf: aFont).

	self set: #standardFixedFont to: aFont.

	TextStyle setDefaultFixed: aStyle.! !

!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 12/21/2021 14:35'!
setFixedFontTo: aFont
	"Establish the default fixed text font and style"

	self setFixedFontSilentlyTo: aFont.
	self apply.! !

!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 12/21/2021 14:35'!
setSystemFontSilentlyTo: aFont
	"Establish the default text font and style"

	| aStyle |
	self flag: #todo. "mt: Support derivatives such as bold and italic."
	aStyle := aFont textStyle.
	aStyle defaultFontIndex: (aStyle fontIndexOf: aFont).

	self set: #standardSystemFont to: aFont.

	TextStyle setDefault: aStyle.
	Flaps replaceToolsFlap.
	ScriptingSystem resetStandardPartsBin.! !

!UserInterfaceTheme methodsFor: 'private - fonts' stamp: 'mt 12/21/2021 14:57'!
setSystemFontTo: aFont
	"Establish the default text font and style"

	"(Display scaleFactor = 1.0 and: [aFont isTTCFont not and: [aFont height ~= StrikeFont referenceHeight]])
		ifTrue: [^ self error: 'Incompatible pre-rendered font for 100% scale factor'].

	(Display scaleFactor = 1.0 and: [aFont isTTCFont and: [aFont pointSize ~= TTCFont referencePointSize]])
		ifTrue: [self notify: ('The standard system/text font should be {1} pt. If you want to increase the overall font size, please change the screen scale factor instead. You may proceed without harm.' format: {TTCFont referencePointSize})]."

	self setSystemFontSilentlyTo: aFont.	
	self apply.! !

!UserInterfaceTheme methodsFor: 'printing' stamp: 'mt 12/21/2021 13:48'!
printOn: aStream

	super printOn: aStream.

	aStream space; print: name.
	self isTTCBased ifFalse: [
		aStream space; nextPutAll: ('({1}%)' format: {self localScaleFactor * 100})].! !


!UserInterfaceTheme class methodsFor: 'initialize-release' stamp: 'mt 12/21/2021 18:33'!
cleanUpAndReset
	"Rebuild all themes and re-apply the current one by name."
	
	| nameToReset scaleFactorToReset |
	nameToReset := self current name.
	scaleFactorToReset := self current isTTCBased
		ifTrue: [Display scaleFactor]
		ifFalse: [Display scaleFactor roundTo: 0.25].
	self cleanUp: true.
	(self named: nameToReset) applyScaled: scaleFactorToReset.! !


!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 12/20/2021 17:13'!
addDarkFonts: aUserInterfaceTheme
	"Set-up fonts."
	aUserInterfaceTheme
		set: #balloonHelpFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5 emphasized: TextEmphasis italic emphasisCode];
		set: #standardButtonFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5];
		set: #standardCodeFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardFlapFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 7.5 emphasized: TextEmphasis bold emphasisCode];
		set: #haloLabelFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardListFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardMenuFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardSystemFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #windowTitleFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5 emphasized: TextEmphasis bold emphasisCode]! !


!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 12/20/2021 17:12'!
addDarkFonts: theme

	"Set-up fonts."
	theme
		set: #balloonHelpFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5];
		set: #standardButtonFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5];
		set: #standardCodeFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardFlapFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5 emphasized: TextEmphasis bold emphasisCode];
		set: #haloLabelFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardListFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardMenuFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardSystemFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #windowTitleFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5].! !


!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 12/20/2021 17:12'!
addDarkFonts: theme

	"Set-up fonts."
	theme
		set: #balloonHelpFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5];
		set: #standardButtonFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5];
		set: #standardCodeFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardFlapFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5 emphasized: TextEmphasis bold emphasisCode];
		set: #haloLabelFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardListFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardMenuFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardSystemFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #windowTitleFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5].! !

!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 12/20/2021 17:12'!
addLightFonts: theme

	"Set-up fonts."
	theme
		set: #balloonHelpFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 7.5];
		set: #standardButtonFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 7.5];
		set: #standardCodeFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardFlapFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 7.5 emphasized: TextEmphasis bold emphasisCode];
		set: #haloLabelFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardListFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardMenuFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardSystemFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #windowTitleFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5 emphasized: TextEmphasis bold emphasisCode].! !


!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 12/21/2021 13:33'!
addFonts: theme

	theme
		set: #standardSystemFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardFixedFont to: [TTCFont familyName: 'BitstreamVeraSansMono' pointSize: 10.5];

		set: #standardCodeFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardListFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardButtonFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 7.5];
		set: #standardMenuFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5];
		set: #standardFlapFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 7.5 emphasized: TextEmphasis bold emphasisCode];

		set: #windowTitleFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5 emphasized: TextEmphasis bold emphasisCode];
		set: #balloonHelpFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 7.5];
		set: #haloLabelFont to: [StrikeFont familyName: 'Bitmap DejaVu Sans' pointSize: 10.5].! !


!TrimTheme class methodsFor: 'instance creation' stamp: 'mt 12/20/2021 17:12'!
addFonts: theme

	"Set-up fonts."
	theme
		set: #balloonHelpFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5];
		set: #standardButtonFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5];
		set: #standardCodeFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardFlapFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 7.5 emphasized: TextEmphasis bold emphasisCode];
		set: #haloLabelFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardListFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardMenuFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #standardSystemFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5];
		set: #windowTitleFont to: [StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 10.5].! !


!UserInterfaceTheme class reorganize!
('tools' allThemeProperties allThemePropertiesDo: categories propertiesForCategory: propertiesForClass:)
('accessing' allThemes current current: default default:)
('private' clientClasses clientClassesToReapply)
('initialize-release' cleanUp: cleanUpAndReset initialize named: reset)
!


!UserInterfaceTheme reorganize!
('actions' apply applyAfter: applyTo: ignoreApplyDuring:)
('private - display scale' applyScaled applyScaled: canFakeScaleFactor: checkScaleFactor100 checkTheme100 copyWithScaleFactor: doScale100 doScale125 doScale150 isGenuine isTTCBased localScaleFactor lookupScaleFactor: lookupSimilar makeTTCBased setFonts: setScaleFactor: setScaleFactorPreApply: ttcFallbackName)
('testing' isCurrent)
('private - fonts' fixFontsAndScaleAround: setFixedFontSilentlyTo: setFixedFontTo: setSystemFontSilentlyTo: setSystemFontTo:)
('private' atomicUpdate: get: get:for: get:for:do: getViaLink: getViaSuperclasses: preMerge: properties validateCanMerge:)
('building' clear: clear:for: derive:for:from: derive:for:from:at: derive:for:from:at:do: derive:for:from:do: link: merge: merge:overwrite: set:for:to: set:to:)
('initialization' initialize register unregister)
('accessing' name name: next unsetProperties)
('copying' postCopy)
('printing' printOn:)
!


!TextStyle class reorganize!
('class initialization' initialize initializeStyleDecoder styleDecoder)
('constants' default defaultFixed defaultFixedFont defaultFont named: setDefault: setDefaultFixed:)
('instance creation' changeDefaultFontSizeBy: fontArray: initDefaultFontsAndStyle new)
('mime file in/out' collectionFromCompressedMIMEString: looseFontsFromFamily: replaceFontsIn:with: replaceStyle:with:)
('TextConstants access' actualTextStyles defaultFamilyNames fontArrayForStyle: fontPointSizesFor: fontSizesFor: fontWidthsFor: knownTextStyles knownTextStylesWithoutDefault pointSizesFor:)
('user interface' importFontsFromStyleFiles)
('utilities' decodeStyleName: fontSizeSummary fontSizeSummaryContents pixelsPerInch pixelsPerInch: pixelsToPoints: pointsToPixels:)
('*System-Fonts' chooseTTCFontSize:)
('*Morphic-user interface' emphasisMenuForFont:target:selector:highlight: fontMenuForStyle:target:selector: fontMenuForStyle:target:selector:highlight: promptForFont:andSendTo:withSelector: promptForFont:andSendTo:withSelector:highlight:)
('*System-Changes-mime file in/out' writeSF2FamilyNamed:inDirectory:toChangeSet: writeStyle:named:toChangeSet:)
('*Etoys-Squeakland-instance creation' addNewStyle:)
!


!TTCFont class reorganize!
('class initialization' initialize shutDown unload)
('file list services' fileReaderServicesForFile:suffix: serviceInstallTrueTypeFontStyle services)
('instance creation' familyName:pointSize: familyName:pointSize:emphasis: family:size: familyName:pointSize:emphasized: getExistings: newTextStyleFromTT: newTextStyleFromTTFile: newTextStyleFromTTStream:)
('objects from disk' classVersion)
('*System-constants' referencePointSize)
('other' indexOfSubfamilyName: isCacheAllNil pointSizes recreateCache registerAll register:at: registry removeAllDerivatives removeStyleName: reorganizeForNewFontArray:name: repairDerivativeFonts unregister: version)
!

RealEstateAgent class removeSelector: #applyUserInterfaceTheme!
RealEstateAgent class removeSelector: #themeProperties!
RealEstateAgent removeSelector: #applyUserInterfaceTheme!
RealEstateAgent removeSelector: #canApplyUserInterfaceTheme!

!RealEstateAgent reorganize!
('as yet unclassified')
!

Preferences class removeSelector: #changeFontSize:!
Preferences class removeSelector: #displaySizeChanged!
Preferences class removeSelector: #setDefaultFonts:!
UserInterfaceTheme allThemes do: [:each | 
	"Convert 'Demo + Squeak' to 'Squeak'. Not needed anymore because of #scaleFactor in each theme."
	each name: (each name findTokens: '+') last withBlanksTrimmed].

TheWorldMainDockingBar updateInstances.

"Unpack unnecessary StrikeFontSet in Accuny."
(TextStyle named: 'Accuny') ifNotNil: [:style |
	style fontArray withIndexDo: [:fontSet :index |
		((fontSet isKindOf: StrikeFontSet) and: [fontSet fontArray size = 1])
			ifTrue: [style fontArray at: index put: fontSet fontArray first]]].
	
"Fix font names for Atlanta."
(TextStyle named: 'Atlanta') fontArray do: [:font |
	font name last isDigit ifFalse: [font name: font name, font pointSize]].

"Fix PPI to be around 96 in all pre-rendered fonts."
(TextStyle knownTextStylesWithoutDefault
	collect: [:ea | TextStyle named: ea]
	thenSelect: [:style | style defaultFont isTTCFont not])
		do: [:style | style fontArray do: [:font |
			font pointSize: ((72 * font height / 96) roundTo: 0.5).
			font derivativeFonts do: [:derivate |
				derivate pointSize: font pointSize]]].

"Fixes a bug where some emphasis got lost in high-DPI mode."	
UserInterfaceTheme cleanUpAndReset.!

