Change #shrinkTo: on FreeTypeCache to selectively remove entries rather than all of them

src/FreeType-Tests/FreeTypeCacheTest.class.st

@@ -230,17 +230,18 @@ FreeTypeCacheTest >> testMaximumSizeRespectedOnIfAbsentPut [
 		ifAbsentPut: [font1XGlyph].
 	self validateSizes: cache.
 	self validateCollections: cache.
+	self assert: (cache instVarNamed: #used) equals: (cache sizeOf: font1XGlyph).
 	cache
 		atFont: font1
 		charCode: $Y asInteger
 		type: FreeTypeCacheGlyph
 		scale: 1
 		ifAbsentPut: [font1XGlyph].
-	self assert: (cache instVarNamed: #used) equals: 0.	"cache has been cleared on reaching max size"
+	self assert: (cache instVarNamed: #used) equals: (cache sizeOf: font1XGlyph). "cache has been shrunk on reaching max size"
 	self validateSizes: cache.
 	self validateCollections: cache.
 	self should: [ cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph scale: 1 ] raise: Error.
-	self should: [ cache atFont: font1 charCode: $Y asInteger type: FreeTypeCacheGlyph scale: 1 ] raise: Error
+	self assert: (cache atFont: font1 charCode: $Y asInteger type: FreeTypeCacheGlyph scale: 1) identicalTo: font1XGlyph.
 ]
 
 { #category : 'tests' }
@@ -255,17 +256,18 @@ FreeTypeCacheTest >> testMaximumSizeRespectedOnPut [
 		put: font1XGlyph.
 	self validateSizes: cache.
 	self validateCollections: cache.
+	self assert: (cache instVarNamed: #used) equals: (cache sizeOf: font1XGlyph).
 	cache
 		atFont: font1
 		charCode: $Y asInteger
 		type: FreeTypeCacheGlyph
 		scale: 1
 		put: font1XGlyph.
-	self assert: (cache instVarNamed: #used) equals: 0.	"cache has been cleared on reaching max size"
+	self assert: (cache instVarNamed: #used) equals: (cache sizeOf: font1XGlyph). "cache has been shrunk on reaching max size"
 	self validateSizes: cache.
 	self validateCollections: cache.
 	self should: [ cache atFont: font1 charCode: $X asInteger type: FreeTypeCacheGlyph scale: 1 ] raise: Error.
-	self should: [ cache atFont: font1 charCode: $Y asInteger type: FreeTypeCacheGlyph scale: 1 ] raise: Error
+	self assert: (cache atFont: font1 charCode: $Y asInteger type: FreeTypeCacheGlyph scale: 1) identicalTo: font1XGlyph.
 ]
 
 { #category : 'tests' }
@@ -544,7 +546,7 @@ FreeTypeCacheTest >> testSetMaximumSizeShrink [
 	| m |
 	m := fullCache instVarNamed: #maximumSize.
 	fullCache maximumSize: m // 2.	"shrink"
-	self assert: (fullCache instVarNamed: #used) equals: 0.	"cache is cleared when used > maximumSize"
+	self assert: (fullCache instVarNamed: #used) equals: 5 * (fullCache sizeOf: font1YGlyph). "cache is shrunk when used > maximumSize"
 	self validateSizes: fullCache.
 	self validateCollections: fullCache
 ]
@@ -576,8 +578,14 @@ FreeTypeCacheTest >> validateCollections: aFreeTypeCache [
 	fifo := aFreeTypeCache instVarNamed: #fifo.
 	lastLink := fifo instVarNamed: #lastLink.
 	fontTableEntries := Set new.
-	fontTable keysAndValuesDo: [ :k1 :v1 | v1 keysAndValuesDo: [ :k2 :v2 | v2 keysAndValuesDo: [ :k3 :v3 | v3 keysAndValuesDo: [ :k4 :v4 |
-		fontTableEntries add: v4 ] ] ] ].
+	fontTable keysAndValuesDo: [ :k1 :v1 |
+		self denyEmpty: v1.
+		v1 keysAndValuesDo: [ :k2 :v2 |
+			self denyEmpty: v2.
+			v2 keysAndValuesDo: [ :k3 :v3 |
+				self denyEmpty: v3.
+				v3 keysAndValuesDo: [ :k4 :v4 |
+					fontTableEntries add: v4 ] ] ] ].
 	self assert: fifo size equals: fontTableEntries size.
 	self assert: fifo asSet equals: fontTableEntries.
 	self assert: (lastLink isNil or: [ lastLink nextLink isNil ])

src/FreeType/FreeTypeCache.class.st

@@ -5,6 +5,7 @@ Class {
 	#name : 'FreeTypeCache',
 	#superclass : 'Object',
 	#instVars : [
+		'mutex',
 		'maximumSize',
 		'used',
 		'fontTable',
@@ -96,7 +97,7 @@ FreeTypeCache >> atFont: aFreeTypeFont charCode: charCodeInteger type: typeFlag
 
 	| charCodeTable typeTable scaleTable entry v vSize |
 
-	aFreeTypeFont mutex criticalReleasingOnError: [
+	mutex criticalReleasingOnError: [
 		charCodeTable := fontTable at: aFreeTypeFont ifAbsentPut:[self dictionaryClass new: 60].
 		typeTable := charCodeTable at: charCodeInteger ifAbsentPut:[self dictionaryClass new: 10].
 		scaleTable := typeTable at: typeFlag ifAbsentPut:[self dictionaryClass new: 1].
@@ -105,10 +106,16 @@ FreeTypeCache >> atFont: aFreeTypeFont charCode: charCodeInteger type: typeFlag
 			ifNotNil:[
 				fifo moveDown: entry.
 				^entry object].
-		v := aBlock value.
+		v := aBlock on: Error do: [ :error |
+			self removeIfEmptyScaleTable: scaleTable type: typeFlag typeTable: typeTable
+				charCode: charCodeInteger charCodeTable: charCodeTable font: aFreeTypeFont.
+			error pass].
 		vSize := self sizeOf: v.
 		(maximumSize isNotNil and:[vSize > maximumSize])
-			ifTrue:[^v].
+			ifTrue:[
+				self removeIfEmptyScaleTable: scaleTable type: typeFlag typeTable: typeTable
+					charCode: charCodeInteger charCodeTable: charCodeTable font: aFreeTypeFont.
+				^v].
 		used := used + vSize.
 		entry := (self fifoEntryClass new
 			 font: aFreeTypeFont;
@@ -128,7 +135,7 @@ FreeTypeCache >> atFont: aFreeTypeFont charCode: charCodeInteger type: typeFlag
 
 	| charCodeTable typeTable scaleTable anObjectSize oldEntry oldEntrySize entry |
 
-	aFreeTypeFont mutex criticalReleasingOnError: [
+	mutex criticalReleasingOnError: [
 		anObjectSize := self sizeOf: anObject.
 		(maximumSize isNotNil and:[anObjectSize > maximumSize])
 			ifTrue:[^anObject].
@@ -156,6 +163,14 @@ FreeTypeCache >> atFont: aFreeTypeFont charCode: charCodeInteger type: typeFlag
 		^ anObject ]
 ]
 
+{ #category : 'private - sizing' }
+FreeTypeCache >> basicRemoveAll [
+
+	fontTable := self dictionaryClass new: self fontTableInitialMinimumCapacity.
+	fifo := self fifoClass new.
+	used := 0
+]
+
 { #category : 'public' }
 FreeTypeCache >> cacheSize [
 
@@ -186,12 +201,19 @@ FreeTypeCache >> fifoEntryClass [
 	^ FreeTypeCacheEntry
 ]
 
+{ #category : 'private - sizing' }
+FreeTypeCache >> fontTableInitialMinimumCapacity [
+
+	^ 100
+]
+
 { #category : 'initialization' }
 FreeTypeCache >> initialize [
 
 	super initialize.
+	mutex := Semaphore forMutualExclusion.
 	maximumSize := self class defaultMaximumSize.
-	fontTable := self dictionaryClass new: 100.
+	fontTable := self dictionaryClass new: self fontTableInitialMinimumCapacity.
 	used := 0.
 	fifo := self fifoClass new
 ]
@@ -205,68 +227,97 @@ FreeTypeCache >> maximumSize [
 { #category : 'public' }
 FreeTypeCache >> maximumSize: anIntegerOrNil [
 
-	maximumSize := anIntegerOrNil.
-	maximumSize ifNotNil:[
-		used > maximumSize
-			ifTrue:["shrink"
-				self shrinkTo: maximumSize]]
+	mutex criticalReleasingOnError:[
+		maximumSize := anIntegerOrNil.
+		maximumSize ifNotNil:[
+			used > maximumSize
+				ifTrue:["shrink"
+					self shrinkTo: maximumSize]]]
 ]
 
 { #category : 'add-remove' }
 FreeTypeCache >> removeAll [
 
-	fontTable := self dictionaryClass new: 100.
-	fifo := self fifoClass new.
-	used := 0
+	mutex criticalReleasingOnError: [
+		self basicRemoveAll ]
 ]
 
 { #category : 'add-remove' }
 FreeTypeCache >> removeAllForFont: aFreeTypeFont [
 
-	| toRemove |
-	(fontTable includesKey: aFreeTypeFont) ifFalse: [ ^ self ].
-	toRemove := IdentitySet new.
-	fifo do: [ :entry |
-		entry font = aFreeTypeFont ifTrue: [ toRemove add: entry ] ].
-	toRemove do: [ :entry |
-		| d |
-		fifo remove: entry.
-		d := ((fontTable at: entry font) at: entry charCode) at: entry type.
-		d removeKey: entry scale.
-		used := used - (self sizeOf: entry object) ]
+	mutex criticalReleasingOnError: [
+		| toRemove |
+		(fontTable includesKey: aFreeTypeFont) ifFalse: [ ^ self ].
+		toRemove := IdentitySet new.
+		fifo do: [ :entry |
+			entry font = aFreeTypeFont ifTrue: [ toRemove add: entry ] ].
+		toRemove do: [ :entry | self removeEntry: entry ] ]
 ]
 
 { #category : 'add-remove' }
 FreeTypeCache >> removeAllForType: typeFlag [
 
-	| toRemove |
-	toRemove := IdentitySet new.
-	fifo do: [ :entry |
-		entry type = typeFlag ifTrue: [ toRemove add: entry ] ].
-	toRemove do: [ :entry |
-		| d |
-		fifo remove: entry.
-		d := ((fontTable at: entry font) at: entry charCode) at: entry type.
-		d removeKey: entry scale.
-		used := used - (self sizeOf: entry object) ]
+	mutex criticalReleasingOnError: [
+		| toRemove |
+		toRemove := IdentitySet new.
+		fifo do: [ :entry |
+			entry type = typeFlag ifTrue: [ toRemove add: entry ] ].
+		toRemove do: [ :entry | self removeEntry: entry ] ]
+]
+
+{ #category : 'private - sizing' }
+FreeTypeCache >> removeEntry: entry [
+
+	fifo remove: entry.
+	self removeFont: entry font charCode: entry charCode type: entry type scale: entry scale.
+	used := used - (self sizeOf: entry object)
+]
+
+{ #category : 'private - sizing' }
+FreeTypeCache >> removeFont: font charCode: charCode type: type scale: scale [
+
+	| charCodeTable typeTable scaleTable |
+
+	charCodeTable := fontTable at: font.
+	typeTable := charCodeTable at: charCode.
+	scaleTable := typeTable at: type.
+
+	scaleTable removeKey: scale.
+	self removeIfEmptyScaleTable: scaleTable type: type typeTable: typeTable
+		charCode: charCode charCodeTable: charCodeTable font: font
+]
+
+{ #category : 'private - sizing' }
+FreeTypeCache >> removeIfEmptyScaleTable: scaleTable type: type typeTable: typeTable charCode: charCode charCodeTable: charCodeTable font: font [
+
+	scaleTable ifNotEmpty: [ ^ self ].
+	typeTable removeKey: type.
+	typeTable ifNotEmpty: [ ^ self ].
+	charCodeTable removeKey: charCode.
+	charCodeTable ifNotEmpty: [ ^ self ].
+	fontTable removeKey: font.
+	(fontTable capacity // 2 > self fontTableInitialMinimumCapacity
+		and: [ fontTable capacity // 4 > fontTable size ]) ifFalse: [ ^ self ].
+	fontTable compact
 ]
 
 { #category : 'reporting' }
 FreeTypeCache >> reportCacheState [
 	"Answer a description of the current state of the cache"
 
-	| usedPercent |
-	usedPercent := maximumSize
-		ifNil: [0]
-		ifNotNil: [(used * 100 / maximumSize) asFloat rounded].
-	^ usedPercent asString,'% Full (maximumSize: ', maximumSize asString, ' , used: ', used asString,')'
+	^ mutex criticalReleasingOnError: [
+		| usedPercent |
+		usedPercent := maximumSize
+			ifNil: [0]
+			ifNotNil: [(used * 100 / maximumSize) asFloat rounded].
+		usedPercent asString,'% Full (maximumSize: ', maximumSize asString, ' , used: ', used asString,')' ]
 ]
 
 { #category : 'private - sizing' }
 FreeTypeCache >> shrinkTo: newSize [
-	"if the used size is greater than newSize, then remove all the receiver's entries"
+	"while the used size is greater than newSize, remove the receiver's first entry"
 
-	used > newSize ifTrue:[self removeAll]
+	[ used > newSize ] whileTrue: [ self removeEntry: fifo firstLink ]
 ]
 
 { #category : 'private - accessing' }

src/FreeType/FreeTypeCacheLinkedList.class.st

@@ -72,12 +72,12 @@ FreeTypeCacheLinkedList >> moveDown: aLink [
 	e4 := e3 nextLink.
 	e1 := e2 previousLink.
 	"swap e2 & e3"
-	e1 ifNotNil: [e1 nextLink: e2].
-	e2 nextLink: e3.
-	e3 nextLink: e4.
-	e4 ifNotNil: [e4 previousLink: e3].
-	e3 previousLink: e2.
-	e2 previousLink: e1
+	e1 ifNotNil: [e1 nextLink: e3] ifNil: [firstLink := e3].
+	e2 nextLink: e4.
+	e3 nextLink: e2.
+	e4 ifNotNil: [e4 previousLink: e2] ifNil: [lastLink := e2].
+	e3 previousLink: e1.
+	e2 previousLink: e3
 ]
 
 { #category : 'removing' }

src/FreeType/FreeTypeFont.class.st

@@ -15,7 +15,6 @@ Class {
 		'cachedDescent',
 		'subPixelPositioned',
 		'symbolFont',
-		'mutex',
 		'characterWidthCache'
 	],
 	#pools : [
@@ -663,12 +662,6 @@ FreeTypeFont >> mode41GlyphOf: aCharacter colorValue: aColorValue mono: monoBool
 				scale: scale ]
 ]
 
-{ #category : 'accessing' }
-FreeTypeFont >> mutex [
-
-	^ mutex ifNil: [ mutex := Semaphore forMutualExclusion ]
-]
-
 { #category : 'measuring' }
 FreeTypeFont >> pixelSize [
 	^pixelSize ifNil:[pixelSize := super pixelSize rounded]