[squeak-dev] The Trunk: TrueType-mt.70.mczcommits at source.squeak.org commits at source.squeak.orgMon Feb 14 16:31:58 UTC 2022
Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.70.mcz ==================== Summary ==================== Name: TrueType-mt.70 Author: mt Time: 14 February 2022, 5:31:58.130304 pm UUID: c281811e-ddb6-a940-9dd4-d8450bd6dc31 Ancestors: TrueType-mt.69 Make the cache size for TrueType glyphs a preference. Note that the original 512 is way too small. See the preference description for an explanation of reasonable cache sizes. Minor protocol clean-up in TTCFont. =============== Diff against TrueType-mt.69 =============== Item was added: + ----- Method: TTCFont class>>glyphCacheSize (in category 'preferences') ----- + glyphCacheSize + <preference: 'Glyph cache size (for TrueType fonts)' + categoryList: #(performance) + description: 'The number of glyphs for TrueType fonts that should be kept in memory, which is a trade-off between memory load and drawing speed. Adjust the number to the variation of fonts/sizes/colors you are using at the same time. For example, 1 font with 2 styles (regular+bold) at 2 different point sizes in 3 different colors would result in a preferred cache size of 2268, provided that you only use the typical 189 latin-1 code points (16r0021 to: 16r007E) and (16r00A1 to 16r00FF).' + type: #Number> + + ^ GlyphCacheSize ifNil: [self glyphCacheSize: 2048. GlyphCacheSize]! Item was added: + ----- Method: TTCFont class>>glyphCacheSize: (in category 'preferences') ----- + glyphCacheSize: anInteger + + | newSize newCacheData oldCacheData | + newSize := anInteger ifNil: [2048]. + GlyphCacheSize = newSize ifTrue: [^ self]. + + oldCacheData := GlyphCacheData. + newCacheData := Array new: newSize. + + 1 to: (oldCacheData size min: newCacheData size) do: [:index | + newCacheData at: index put: (oldCacheData at: index)]. + + GlyphCacheSize := newSize. + GlyphCacheData := newCacheData. + GlyphCacheIndex := GlyphCacheIndex min: GlyphCacheSize. + + GlyphCacheReady := true. "Do we need this?"! Item was changed: + ----- Method: TTCFont>>addLined (in category 'initialize') ----- - ----- Method: TTCFont>>addLined (in category 'private') ----- addLined self addLined: self. self derivativeFonts do: [:e | e ifNotNil: [self addLined: e]. ]. ! Item was changed: + ----- Method: TTCFont>>addLined: (in category 'initialize') ----- - ----- Method: TTCFont>>addLined: (in category 'private') ----- addLined: aTTCFont | l | l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 4. self derivativeFont: l at: l emphasis. l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 16. self derivativeFont: l at: l emphasis. l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 20. self derivativeFont: l at: l emphasis. ! Item was changed: + ----- Method: TTCFont>>ascentOf: (in category 'accessing - queries') ----- - ----- Method: TTCFont>>ascentOf: (in category 'accessing') ----- ascentOf: aCharacter " (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont ascentOf: aCharacter. ]. ]. " ^ self ascent. ! Item was changed: + ----- Method: TTCFont>>at:put: (in category 'caching') ----- - ----- Method: TTCFont>>at:put: (in category 'private') ----- at: char put: form | assoc | assoc := foregroundColor -> form. GlyphCacheData at: (GlyphCacheIndex := GlyphCacheIndex \\ GlyphCacheSize + 1) put: assoc. cache at: (char asInteger + 1) put: assoc. ^form! Item was changed: + ----- Method: TTCFont>>cache (in category 'caching') ----- - ----- Method: TTCFont>>cache (in category 'friend') ----- cache ^cache! Item was changed: + ----- Method: TTCFont>>computeForm: (in category 'character shapes') ----- - ----- Method: TTCFont>>computeForm: (in category 'private') ----- computeForm: char "Compute the glyph form for the given character" ^ttcDescription renderGlyph: char height: self height fgColor: foregroundColor bgColor: Color transparent depth: self depth! Item was changed: + ----- Method: TTCFont>>depth (in category 'accessing') ----- - ----- Method: TTCFont>>depth (in category 'public') ----- depth ^ 32. ! Item was changed: + ----- Method: TTCFont>>derivativeFont: (in category 'initialize') ----- - ----- Method: TTCFont>>derivativeFont: (in category 'friend') ----- derivativeFont: aTTCFont | index | index := self indexOfSubfamilyName: (aTTCFont subfamilyName). index < 1 ifTrue: [ ^ self "inform: 'unknown sub family name. This font will be skipped'". ]. self derivativeFont: aTTCFont at: index. self addLined: aTTCFont. ! Item was changed: + ----- Method: TTCFont>>derivativeFont:at: (in category 'initialize') ----- - ----- Method: TTCFont>>derivativeFont:at: (in category 'friend') ----- derivativeFont: aTTCFont at: index | newDeriv | aTTCFont ifNil: [derivatives := nil. ^ self]. derivatives ifNil: [derivatives := Array new: 32]. derivatives size < 32 ifTrue: [ newDeriv := Array new: 32. newDeriv replaceFrom: 1 to: derivatives size with: derivatives. derivatives := newDeriv. ]. derivatives at: index put: aTTCFont. ! Item was removed: - ----- Method: TTCFont>>derivativeFontArray (in category 'friend') ----- - derivativeFontArray - - ^ derivatives. - ! Item was changed: + ----- Method: TTCFont>>derivativeFonts (in category 'accessing') ----- - ----- Method: TTCFont>>derivativeFonts (in category 'friend') ----- derivativeFonts derivatives ifNil: [^ #()]. ^derivatives copyWithout: nil! Item was changed: + ----- Method: TTCFont>>descentOf: (in category 'accessing - queries') ----- - ----- Method: TTCFont>>descentOf: (in category 'accessing') ----- descentOf: aCharacter " (self hasGlyphFor: aCharacter) ifFalse: [ fallbackFont ifNotNil: [ ^ fallbackFont descentOf: aCharacter. ]. ]." ^ self descent. ! Item was changed: + ----- Method: TTCFont>>displayString:on:from:to:at:kern: (in category 'displaying') ----- - ----- Method: TTCFont>>displayString:on:from:to:at:kern: (in category 'friend') ----- displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta ^ self displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: aPoint y + self ascent. ! Item was changed: + ----- Method: TTCFont>>displayString:on:from:to:at:kern:baselineY: (in category 'displaying') ----- - ----- Method: TTCFont>>displayString:on:from:to:at:kern:baselineY: (in category 'friend') ----- displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY | form glyphInfo destX destY hereX nextX actualFont | destX := aPoint x. glyphInfo := Array new: 5. startIndex to: stopIndex do: [:charIndex | self glyphInfoOf: (aString at: charIndex) into: glyphInfo. form := glyphInfo at: 1. hereX := glyphInfo at: 2. nextX := glyphInfo at: 3. (actualFont := glyphInfo at: 5) == aBitBlt lastFont ifFalse: [actualFont installOn: aBitBlt]. destY := baselineY - (glyphInfo at: 4). aBitBlt sourceForm: form. aBitBlt destX: destX. aBitBlt destY: destY + form offset y. "Compensate overdraw. See #extraScale:." aBitBlt sourceX: hereX; sourceY: 0. aBitBlt width: nextX - hereX. aBitBlt height: form height. aBitBlt copyBits. destX := destX + (nextX - hereX) + kernDelta. ]. ^ destX @ destY ! Item was changed: + ----- Method: TTCFont>>emphasis: (in category 'converting') ----- - ----- Method: TTCFont>>emphasis: (in category 'accessing') ----- emphasis: code code > 3 ifTrue: [^ self]. code = 0 ifTrue: [^ self]. derivatives ifNil: [^ self]. ^ (derivatives at: code) ifNil: [self]. ! Item was changed: + ----- Method: TTCFont>>emphasized: (in category 'converting') ----- - ----- Method: TTCFont>>emphasized: (in category 'accessing') ----- emphasized: code code = 0 ifTrue: [^ self]. derivatives ifNil: [^ self]. (((code bitAnd: 20) ~= 0) and: [ derivatives size < code or: [(derivatives at: code) isNil]]) ifTrue: [ self addLined. ]. ^ (derivatives at: code) ifNil: [self]. ! Item was changed: + ----- Method: TTCFont>>fallbackFont: (in category 'initialize') ----- - ----- Method: TTCFont>>fallbackFont: (in category 'accessing') ----- fallbackFont: aFontSetOrNil aFontSetOrNil == self ifTrue:[^ self error: 'Invalid fallback font']. fallbackFont := aFontSetOrNil. ! Item was changed: + ----- Method: TTCFont>>foregroundColor (in category 'accessing') ----- - ----- Method: TTCFont>>foregroundColor (in category 'public') ----- foregroundColor ^ foregroundColor. ! Item was changed: ----- Method: TTCFont>>foregroundColor: (in category 'initialize') ----- foregroundColor: fgColor "Install the given foreground color" foregroundColor = fgColor ifFalse:[ foregroundColor := fgColor. colorToCacheMap ifNil:[colorToCacheMap := Dictionary new]. + cache := colorToCacheMap at: fgColor ifAbsentPut:[WeakArray new: self maxCodePoint+1]. - cache := colorToCacheMap at: fgColor ifAbsentPut:[WeakArray new: self maxAscii+1]. ShutdownList ifNotNil:[ShutdownList add: self]. ]. ! Item was changed: + ----- Method: TTCFont>>formOf: (in category 'character shapes') ----- - ----- Method: TTCFont>>formOf: (in category 'private') ----- formOf: char | code form | char charCode > self maxAscii ifTrue: [^ self fallbackFont formOf: char]. cache ifNil:[self foregroundColor: Color black]. "make sure we have a cache" code := char charCode. form := cache at: (code + 1). + "form class == Association ifTrue:[^self computeForm: code]. ""in midst of loading" - form class == Association ifTrue:[^self computeForm: code]. "in midst of loading" form ifNil:[ form := self computeForm: code. form ifNil:[^nil]. cache at: code+1 put: form. GlyphCacheData at: (GlyphCacheIndex := GlyphCacheIndex \\ GlyphCacheSize + 1) put: form. ]. ^form ! Item was changed: + ----- Method: TTCFont>>glyphInfoOf:into: (in category 'displaying') ----- - ----- Method: TTCFont>>glyphInfoOf:into: (in category 'private') ----- glyphInfoOf: aCharacter into: glyphInfoArray "return the glyph info for aCharacter; if I don't have such a character, try my fallback font" | form | (self hasGlyphOf: aCharacter) ifFalse: [ ^ self fallbackFont glyphInfoOf: aCharacter into: glyphInfoArray. ]. form := self formOf: aCharacter. glyphInfoArray at: 1 put: form; at: 2 put: 0; at: 3 put: form width; at: 4 put: self ascent "(self ascentOf: aCharacter)"; at: 5 put: self. ^ glyphInfoArray. ! Item was changed: + ----- Method: TTCFont>>hasGlyphForCode: (in category 'testing') ----- - ----- Method: TTCFont>>hasGlyphForCode: (in category 'private') ----- hasGlyphForCode: aCharacterCode "Answer whether this font includes a glyph for the given character" (aCharacterCode between: self minCodePoint and: self maxCodePoint) ifFalse: [^ false]. (cache notNil and: [(cache at: aCharacterCode + 1 ifAbsent: [nil]) notNil]) ifTrue: [^ true "fallback glyphs via #fallbackFont"]. (ttcDescription at: "expensive for TTFileDescription" aCharacterCode) isFallback ifTrue: [^ false]. ^ true! Item was changed: + ----- Method: TTCFont>>initialize (in category 'initialize') ----- - ----- Method: TTCFont>>initialize (in category 'friend') ----- initialize foregroundColor := Color black. ! Item was changed: + ----- Method: TTCFont>>installOn: (in category 'displaying') ----- - ----- Method: TTCFont>>installOn: (in category 'friend') ----- installOn: aDisplayContext ^aDisplayContext installTTCFont: self. ! Item was changed: + ----- Method: TTCFont>>installOn:foregroundColor:backgroundColor: (in category 'displaying') ----- - ----- Method: TTCFont>>installOn:foregroundColor:backgroundColor: (in category 'friend') ----- installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor self foregroundColor: fgColor. "install color" (self fallbackFont notNil and: [ self fallbackFont class = TTCFontSet ]) ifTrue: [ self fallbackFont fontArray do: [:font | font ifNotNil: [ font foregroundColor: fgColor ] ] ]. "install color for fallbackFont" aDisplayContext installTTCFont: self foregroundColor: foregroundColor backgroundColor: bgColor ! Item was changed: + ----- Method: TTCFont>>pixelSize: (in category 'initialize') ----- - ----- Method: TTCFont>>pixelSize: (in category 'accessing') ----- pixelSize: aNumber "Make sure that we don't return a Fraction" self pointSize: (TextStyle pixelsToPoints: aNumber) rounded. ! Item was changed: + ----- Method: TTCFont>>pointSize: (in category 'initialize') ----- - ----- Method: TTCFont>>pointSize: (in category 'accessing') ----- pointSize: aNumber self privatePointSize: aNumber. derivatives ifNotNil: [ derivatives do: [ :f | f ifNotNil: [ f privatePointSize: aNumber ]]]. ! Item was changed: + ----- Method: TTCFont>>privatePointSize: (in category 'initialize') ----- - ----- Method: TTCFont>>privatePointSize: (in category 'accessing') ----- privatePointSize: aNumber pointSize = aNumber ifFalse: [pointSize := aNumber. self flushCache]! Item was changed: + ----- Method: TTCFont>>recreateCache (in category 'initialize') ----- - ----- Method: TTCFont>>recreateCache (in category 'friend') ----- recreateCache cache := WeakArray new: 256.! Item was changed: ----- Method: TTCFont>>scale (in category 'private') ----- scale + self flag: #deprecated. ^ self pixelSize / ttcDescription unitsPerEm ! Item was changed: + ----- Method: TTCFont>>size (in category 'accessing') ----- - ----- Method: TTCFont>>size (in category 'public') ----- size ^ ttcDescription size. ! Item was changed: + ----- Method: TTCFont>>subfamilyName (in category 'accessing') ----- - ----- Method: TTCFont>>subfamilyName (in category 'private') ----- subfamilyName ^ ttcDescription subfamilyName. ! Item was changed: + ----- Method: TTCFont>>textStyle (in category 'accessing - queries') ----- - ----- Method: TTCFont>>textStyle (in category 'accessing') ----- textStyle "Overwritten to consider the case where a font is primarily registered under a different name... also do not create a new style for orphaned fonts." self flag: #discuss. "mt: Do we really need this?" ^ self textStyleOrNil ifNil: [ "Fallback: Maybe this font is in a text style with another name?" TextStyle actualTextStyles detect: [:aStyle | aStyle fontArray anySatisfy: [:font | font familyName = self familyName]] ifNone: [nil]]! Item was changed: + ----- Method: TTCFont>>ttcDescription (in category 'initialize') ----- - ----- Method: TTCFont>>ttcDescription (in category 'friend') ----- ttcDescription ^ ttcDescription. ! Item was changed: + ----- Method: TTCFont>>ttcDescription: (in category 'initialize') ----- - ----- Method: TTCFont>>ttcDescription: (in category 'friend') ----- ttcDescription: aTTCDescription ttcDescription := aTTCDescription. self flushCache. !
More information about the Squeak-dev mailing list |