[etoys-dev] Etoys: Multilingual-Richo.7.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun May 30 18:41:25 EDT 2010
Ricardo Moran uploaded a new version of Multilingual to project Etoys:
http://source.squeak.org/etoys/Multilingual-Richo.7.mcz
==================== Summary ====================
Name: Multilingual-Richo.7
Author: Richo
Time: 30 May 2010, 5:00:18 pm
UUID: bdb9aaa5-53a4-c049-983a-b22e0e349d06
Ancestors: Multilingual-KR.6
* Integrating true type font support by Andreas Raab
=============== Diff against Multilingual-KR.6 ===============
Item was changed:
----- Method: TTCFont class>>registerAll (in category 'other') -----
registerAll
"
TTCFont registerAll
"
TextStyle allInstancesDo: [:e |
+ (e fontArray first isMemberOf: TTCFont) ifTrue: [
- (e isTTCStyle) ifTrue: [
self register: e fontArray at: e fontArray first familyName asSymbol.
].
].
!
Item was changed:
----- Method: TTCFont>>computeForm: (in category 'private') -----
computeForm: char
| ttGlyph scale |
+ scale := self pixelSize asFloat / (ttcDescription ascender - ttcDescription descender).
+ Scale ifNotNil: [scale := Scale * scale].
+ ttGlyph := ttcDescription at: (char isCharacter ifTrue: [char charCode] ifFalse: [char]).
+ ^ ttGlyph ifNotNil:[ttGlyph asFormWithScale: scale ascender: ttcDescription ascender descender: ttcDescription descender fgColor: foregroundColor bgColor: Color transparent depth: self depth].
- scale _ self pixelSize asFloat / (ttcDescription ascender - ttcDescription descender).
- Scale ifNotNil: [scale _ Scale * scale].
- ttGlyph _ ttcDescription at: (char isCharacter ifTrue: [char charCode] ifFalse: [char]).
- ^ ttGlyph asFormWithScale: scale ascender: ttcDescription ascender descender: ttcDescription descender fgColor: foregroundColor bgColor: Color transparent depth: self depth.
!
Item was changed:
----- Method: TTCFont>>installOn:foregroundColor:backgroundColor: (in category 'friend') -----
installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor
+ self foregroundColor: fgColor. "install color"
-
- foregroundColor _ fgColor.
-
aDisplayContext installTTCFont: self foregroundColor: foregroundColor backgroundColor: bgColor
!
Item was changed:
----- Method: TTCFont>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
convertToCurrentVersion: varDict refStream: smartRefStrm
"If we're reading in an old version with a pixelSize instance variable, convert it to a point size."
"Deal with the change from pixelSize to pointSize, assuming the current monitor dpi."
varDict at: 'pixelSize' ifPresent: [ :x |
+ pointSize := (TextStyle pixelsToPoints: x) rounded.
- pointSize _ (TextStyle pixelsToPoints: x) rounded.
].
^super convertToCurrentVersion: varDict refStream: smartRefStrm.!
Item was added:
+ ----- Method: TTCFont>>derivativeFontArray (in category 'friend') -----
+ derivativeFontArray
+
+ ^ derivatives.
+ !
Item was changed:
----- Method: TTCFont class>>newTextStyleFromTTFile: (in category 'instance creation') -----
newTextStyleFromTTFile: fileName
"Create a new TextStyle from specified file name. On certain versions of Windows, you can evaluate following to get Arial font into the image. On other platforms, wait and see someone implements the support code for FontPlugin then we can start relying on the generic font lookup mechanism.
TTCFontReader encodingTag: 0.
self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\symbol.TTF'.
"
| description |
+ description := TTFontDescription addFromTTFile: fileName.
- description _ TTFontDescription addFromTTFile: fileName.
^ self newTextStyleFromTT: description.
!
Item was changed:
----- Method: TTCFont>>maxAscii (in category 'accessing') -----
maxAscii
+ "Answer the max. code point in this font. The name of this method is historical."
+ ^maxAscii ifNil:[ttcDescription size].!
-
- ^ ttcDescription size.
- !
Item was changed:
----- Method: TTCFont>>ttcDescription: (in category 'friend') -----
ttcDescription: aTTCDescription
+ ttcDescription := aTTCDescription.
+ self flushCache.
- ttcDescription _ aTTCDescription.
- self recreateCache.
!
Item was changed:
----- Method: TTCFont>>fallbackFont (in category 'accessing') -----
fallbackFont
^ fallbackFont
+ ifNil: [fallbackFont := FixedFaceFont new errorFont fontSize: self height]!
- ifNil: [fallbackFont _ FixedFaceFont new errorFont fontSize: self height]!
Item was added:
+ ----- Method: TTCFont>>setupDefaultFallbackFontTo: (in category 'friend') -----
+ setupDefaultFallbackFontTo: aTextStyleOrNil
+ "
+ TTCFont allInstances do: [:i | i setupDefaultFallbackFontTo: (TextStyle named: 'MultiMSMincho')].
+ "
+
+ | fonts f |
+ aTextStyleOrNil ifNil: [
+ self fallbackFont: nil.
+ ^ self.
+ ].
+ fonts := aTextStyleOrNil fontArray.
+ (aTextStyleOrNil defaultFont familyName endsWith: self familyName) ifTrue: [fallbackFont := nil. ^ self].
+
+ f := fonts first.
+ 1 to: fonts size do: [:i |
+ self height >= (fonts at: i) height ifTrue: [f := fonts at: i].
+ ].
+ self fallbackFont: f.
+ self reset.
+
+ !
Item was changed:
----- Method: TTCFont class>>shutDown (in category 'class initialization') -----
shutDown
"Flush the glyph cache"
GlyphCacheData atAllPut: nil.
+ GlyphCacheIndex := 0.
+ ShutdownList ifNotNil:[ShutdownList do:[:fnt| fnt flushCache]].
+ ShutdownList := WeakSet new.
+ !
- GlyphCacheIndex := 0.!
Item was changed:
----- Method: TTCFont>>minAscii (in category 'accessing') -----
minAscii
+ "Answer the min. code point in this font. The name of this method is historical."
-
^ 0.
!
Item was changed:
----- Method: TTCFont>>emphasis (in category 'accessing') -----
emphasis
"Answer the emphasis code (0 to 3) corresponding to my subfamily name"
+ ^self indexOfSubfamilyName: self subfamilyName
- ^TTCFont indexOfSubfamilyName: self subfamilyName
!
Item was changed:
----- Method: TTCFont class>>getExistings: (in category 'instance creation') -----
getExistings: fontArray
| result em |
+ result := OrderedCollection new.
- result _ OrderedCollection new.
result add: fontArray.
1 to: 3 do: [:i |
+ em := (fontArray collect: [:f | f emphasized: i]).
- em _ (fontArray collect: [:f | f emphasized: i]).
(em at: 1) ~= (fontArray at: 1) ifTrue: [
result add: em.
].
].
^ result asArray.
!
Item was changed:
----- Method: TTCFont>>textStyle (in category 'accessing') -----
textStyle
+ ^ TextStyle actualTextStyles detect:
+ [:aStyle | aStyle fontArray includes: self] ifNone: [nil]!
- ^ TextStyle actualTextStyles
- at: self familyName asSymbol
- ifAbsent: []!
Item was changed:
----- Method: TTCFont class>>familyName:pointSize:emphasis: (in category 'instance creation') -----
familyName: n pointSize: s emphasis: code
+ "(TTCFont familyName: 'BitstreamVeraSans' pointSize: 12 emphasis: 0)"
+ | t ret index |
+ t := self registry at: n asSymbol ifAbsent: [#()].
+ t isEmpty ifTrue: [
+ t := (TextConstants at: #DefaultTextStyle) fontArray.
+ ret := t first.
+ ret pointSize >= s ifTrue: [^ ret emphasis: code].
+ index := 2.
+ [index <= t size and: [(t at: index) pointSize <= s]] whileTrue: [
+ ret := t at: index.
+ index := index + 1.
+ ].
+ ^ ret emphasis: code.
+ ].
+ ^ ((TextStyle named: n) addNewFontSize: s) emphasis: code.
+ !
- ^ self familyName: n pointSize: s emphasized: code!
Item was changed:
----- Method: TTCFont>>widthOf: (in category 'public') -----
widthOf: aCharacter
-
"This method cannot use #formOf: because formOf: discriminates the color and causes unnecessary bitmap creation."
+ (self hasGlyphOf: aCharacter) ifFalse: [
-
- | f assoc |
- aCharacter charCode > 255 ifTrue: [
fallbackFont ifNotNil: [^ fallbackFont widthOf: aCharacter].
^ 1
].
+ ^(self formOf: aCharacter) width!
- assoc _ self cache at: (aCharacter charCode + 1).
- assoc ifNotNil: [
- ^ assoc value width
- ].
-
- f _ self computeForm: aCharacter.
- self at: aCharacter charCode put: f.
- ^ f width.
- !
Item was changed:
----- Method: TTCFont class>>newTextStyleFromTTStream: (in category 'instance creation') -----
newTextStyleFromTTStream: readStream
"
"
| description |
+ description := TTFontDescription addFromTTStream: readStream.
- description _ TTFontDescription addFromTTStream: readStream.
^ self newTextStyleFromTT: description.
!
Item was changed:
----- Method: TTCFont>>glyphInfoOf:into: (in category 'private') -----
glyphInfoOf: aCharacter into: glyphInfoArray
"Answer the width of the argument as a character in the receiver."
| form |
(self hasGlyphOf: aCharacter) ifFalse: [
^ self fallbackFont glyphInfoOf: aCharacter into: glyphInfoArray.
].
+ form := self formOf: aCharacter.
- form _ self formOf: aCharacter.
glyphInfoArray at: 1 put: form;
at: 2 put: 0;
at: 3 put: form width;
+ at: 4 put: ascent "(self ascentOf: aCharacter)";
- at: 4 put: (self ascentOf: aCharacter);
at: 5 put: self.
^ glyphInfoArray.
!
Item was changed:
----- Method: TTCFont>>addLined: (in category 'private') -----
addLined: aTTCFont
| l |
+ l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 4.
- l _ LinedTTCFont fromTTCFont: aTTCFont emphasis: 4.
self derivativeFont: l at: l emphasis.
+ l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 16.
- l _ LinedTTCFont fromTTCFont: aTTCFont emphasis: 16.
self derivativeFont: l at: l emphasis.
+ l := LinedTTCFont fromTTCFont: aTTCFont emphasis: 20.
- l _ LinedTTCFont fromTTCFont: aTTCFont emphasis: 20.
self derivativeFont: l at: l emphasis.
!
Item was added:
+ ----- Method: TTCFont>>closeHtmlOn: (in category 'html') -----
+ closeHtmlOn: aStream
+ "put on the given stream the tag to close the html
+ representation of the receiver"
+ self htmlSize isZero
+ ifFalse: [aStream nextPutAll: '</font>']!
Item was changed:
----- Method: TTCFont class>>initialize (in category 'class initialization') -----
initialize
"
self initialize
"
| tt |
+ self allSubInstancesDo:[:fnt| fnt flushCache].
GlyphCacheSize := 512.
GlyphCacheData := Array new: GlyphCacheSize.
GlyphCacheIndex := 0.
+ GlyphCacheReady := true.
+ tt := TTFontDescription default.
- tt _ TTFontDescription default.
tt ifNotNil: [self newTextStyleFromTT: tt].
+ (FileList respondsTo: #registerFileReader:) ifTrue: [
+ FileList registerFileReader: self
+ ].
+
Smalltalk addToShutDownList: self.!
Item was changed:
----- Method: TTCFont>>height (in category 'accessing') -----
height
"Answer my height in pixels. This will answer a Float."
+ ^height ifNil:[height := self pixelSize * Scale y]!
- ^ self pixelSize * Scale y!
Item was changed:
----- Method: TTCFont>>objectForDataStream: (in category 'objects from disk') -----
objectForDataStream: refStrm
| dp |
"I am about to be written on an object file. Write a
reference to a known FontSet in the other system instead."
"a path to me"
+ dp := DiskProxy global: #TTCFont selector: #familyName:pointSize:emphasis:
- dp _ DiskProxy global: #TTCFont selector: #familyName:pointSize:emphasis:
args: {self familyName. self pointSize. self emphasis}.
refStrm replace: self with: dp.
^ dp.
!
Item was changed:
----- Method: TTCFont>>derivativeFont: (in category 'friend') -----
derivativeFont: aTTCFont
| index |
+ index := self indexOfSubfamilyName: (aTTCFont subfamilyName).
- index _ TTCFont 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:
AbstractFont subclass: #TTCFont
+ instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont height ascent descent maxAscii colorToCacheMap'
+ classVariableNames: 'GlyphCacheData GlyphCacheIndex GlyphCacheReady GlyphCacheSize NamesToIndexes Registry Scale ShutdownList'
- instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont ascent descent'
- classVariableNames: 'GlyphCacheData GlyphCacheIndex GlyphCacheSize NamesToIndexes Registry Scale'
poolDictionaries: ''
category: 'Multilingual-Display'!
!TTCFont commentStamp: 'nk 4/2/2004 11:32' prior: 0!
I represent a font that uses TrueType derived glyph. Upon a request for glyph for a character through a call to #formOf: (or #widthOf:), I first search corresponding glyph in the cache. If there is not, it creates a 32bit depth form with the glyph.
The cache is weakly held. The entries are zapped at full GC.
Structure:
ttcDescription TTFontDescription -- The Squeak data structure for a TrueType font data file.
pointSize Number -- Nominal Em size in points. Conversion to pixel sizes depends on the definition of TextStyle class>>pixelsPerInch.
foregroundColor Color -- So far, this font need to know the glyph color in cache.
cache WeakArray of <Color -> <Array(256) of glyph>>
derivatives Array -- stores the fonts in the same family but different emphasis.
!
Item was changed:
----- 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.
- | destPoint form glyphInfo destY destX w |
- destPoint _ aPoint.
- 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).
- form _ glyphInfo at: 1.
- ((glyphInfo at: 5) ~= aBitBlt lastFont) ifTrue: [
- (glyphInfo at: 5) installOn: aBitBlt.
- ].
- destY _ baselineY - (glyphInfo at: 4).
aBitBlt sourceForm: form.
aBitBlt destX: destX.
aBitBlt destY: destY.
+ aBitBlt sourceX: hereX; sourceY: 0.
+ aBitBlt width: nextX - hereX.
- aBitBlt sourceOrigin: (glyphInfo at: 2) @ 0.
- aBitBlt width: (w _ (glyphInfo at: 3) - (glyphInfo at: 2)).
aBitBlt height: form height.
aBitBlt copyBits.
+ destX := destX + (nextX - hereX) + kernDelta.
- destX _ destX + w + kernDelta.
].
+ ^ destX @ destY
- ^ destX @ destPoint y.
!
Item was added:
+ ----- 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 maxAscii+1].
+ ShutdownList ifNotNil:[ShutdownList add: self].
+ ].
+ !
Item was changed:
----- Method: TTCFont class>>recreateCache (in category 'other') -----
recreateCache
"
self recreateCache.
"
+ self allSubInstances do: [:inst | inst flushCache].
- self allSubInstances do: [:inst | inst recreateCache].
Smalltalk garbageCollect.
!
Item was changed:
----- Method: TTCFont>>ascent (in category 'accessing') -----
ascent
+ ascent ifNil:[ascent := ttcDescription ascender * self pixelSize // (ttcDescription ascender - ttcDescription descender) * Scale y].
+ ^ (fallbackFont notNil
+ and: [fallbackFont ascent > ascent])
- | a |
- ^ ascent ifNil: [
- a := ttcDescription ascender * self pixelSize // (ttcDescription ascender - ttcDescription descender) * Scale y.
- ascent := (fallbackFont notNil
- and: [fallbackFont ascent > a])
ifTrue: [fallbackFont ascent]
+ ifFalse: [ascent]!
- ifFalse: [a]
- ].
- !
Item was changed:
----- Method: TTCFont>>descent (in category 'accessing') -----
descent
"One is added to make sure the gap between lines is filled. If we don't add, multi line selection in a text pane look ugly."
+ ^descent ifNil:[descent := (ttcDescription descender * self pixelSize // (ttcDescription descender - ttcDescription ascender)) * Scale y + 1].
- ^ descent ifNil: [descent _ (ttcDescription descender * self pixelSize // (ttcDescription descender - ttcDescription ascender)) * Scale y + 1].
!
Item was added:
+ ----- Method: TTCFont>>openHtmlOn: (in category 'html') -----
+ openHtmlOn: aStream
+ "put on the given stream the tag to open the html
+ representation of the receiver"
+ | size |
+ size := self htmlSize.
+ size isZero
+ ifFalse: [aStream nextPutAll: '<font size="' , size asString , '">']!
Item was changed:
----- Method: TTCFont class>>reorganizeForNewFontArray:name: (in category 'instance creation') -----
reorganizeForNewFontArray: array name: styleName
| style existings regular altName |
(TextConstants includesKey: styleName) ifFalse: [
TextConstants at: styleName put: (TextStyle fontArray: array).
^ TextConstants at: styleName.
].
"There is a text style with the name I want to use. See if it is a TTC font..."
+ style := TextConstants at: styleName.
- style _ TextConstants at: styleName.
style isTTCStyle ifFalse: [
+ altName := ((array at: 1) name, 'TT') asSymbol.
- altName _ ((array at: 1) name, 'TT') asSymbol.
^ self reorganizeForNewFontArray: array name: altName.
].
+ existings := (self getExistings: style fontArray), (Array with: array).
+ regular := existings detect: [:e | (e at: 1) isRegular] ifNone: [existings at: 1].
+
- existings _ (self getExistings: style fontArray) copyWith: array.
- regular _ existings reversed detect: [:e | (e at: 1) isRegular] ifNone: [existings at: 1].
regular do: [:r |
r addLined: r.
].
"The existing array may be different in size than the new one."
existings do: [:e |
(e at: 1) isRegular ifFalse: [
regular do: [ :r | | f |
+ f := e detect: [ :ea | ea pointSize = r pointSize ] ifNone: [ ].
- f _ e detect: [ :ea | ea pointSize = r pointSize ] ifNone: [ ].
f ifNotNil: [ r derivativeFont: f ].
].
].
].
style newFontArray: regular.
self register: regular at: styleName.
self recreateCache.
^ style.
!
Item was changed:
----- Method: TTCFont class>>serviceInstallTrueTypeFontStyle (in category 'file list services') -----
serviceInstallTrueTypeFontStyle
"Return a service to install a true type font as a text style"
^ SimpleServiceEntry
provider: self
+ label: 'install ttf style'
- label: 'install ttf style' translatedNoop
selector: #newTextStyleFromTTFile:
+ description: 'install a true type font as a text style'
+ buttonLabel: 'install ttf'!
- description: 'install a true type font as a text style' translatedNoop
- buttonLabel: 'install ttf' translatedNoop!
Item was added:
+ ----- Method: TTCFont>>htmlSize (in category 'html') -----
+ htmlSize
+ "private - answer the size in html form, assumes 12 as default size"
+ ^ (self pointSize - 12 / 3) rounded!
Item was changed:
----- Method: TTCFont class>>family:size: (in category 'instance creation') -----
family: f size: s
+ ^ self allInstances detect: [:a | a familyName = f and: [a pointSize = s]] ifNone: [nil].
+ !
- ^ self familyName: f size: s emphasized: 0!
Item was changed:
----- Method: TTCFont>>fallbackFont: (in category 'accessing') -----
fallbackFont: aFontSetOrNil
+ aFontSetOrNil == self
+ ifTrue:[^ self error: 'Invalid fallback font'].
+
+ fallbackFont := aFontSetOrNil.
- fallbackFont _ aFontSetOrNil.
!
Item was changed:
----- Method: TTCFont>>isRegular (in category 'testing') -----
isRegular
"Answer true if I am a Regular/Roman font (i.e. not bold, etc.)"
+ ^ (self indexOfSubfamilyName: (self subfamilyName)) = 0.
- ^ (TTCFont indexOfSubfamilyName: (self subfamilyName)) = 0.
!
Item was changed:
----- Method: TTCFont class>>scale: (in category 'other') -----
scale: anObject
+ Scale := anObject.
- Scale _ anObject.
!
Item was changed:
----- Method: TTCFont>>hasGlyphOf: (in category 'private') -----
hasGlyphOf: aCharacter
+ "Answer whether this font includes a glyph for the given character"
+ ^ aCharacter charCode <= self maxAscii
+ and:[(self formOf: aCharacter) notNil]!
-
- ^ aCharacter charCode <= 255
- !
Item was changed:
----- Method: TTCFont class>>removeStyleName: (in category 'other') -----
removeStyleName: aString
+ TextConstants removeKey: aString asSymbol ifAbsent: [].
- | style symName |
- symName _ aString asSymbol.
- style _ TextConstants removeKey: symName ifAbsent: [].
- style ifNotNil: [self unregister: symName].
TTFontDescription removeDescriptionNamed: aString asString.
!
Item was changed:
----- Method: TTCFont>>derivativeFont:at: (in category 'friend') -----
derivativeFont: aTTCFont at: index
| newDeriv |
+ aTTCFont ifNil: [derivatives := nil. ^ self].
+ derivatives ifNil: [derivatives := Array new: 32].
- aTTCFont ifNil: [derivatives _ nil. ^ self].
- derivatives ifNil: [derivatives _ Array new: 32].
derivatives size < 32 ifTrue: [
+ newDeriv := Array new: 32.
- newDeriv _ Array new: 32.
newDeriv replaceFrom: 1 to: derivatives size with: derivatives.
+ derivatives := newDeriv.
- derivatives _ newDeriv.
].
derivatives at: index put: aTTCFont.
!
Item was changed:
----- Method: TTCFont>>initialize (in category 'friend') -----
initialize
+ foregroundColor := Color black.
- foregroundColor _ Color black.
!
Item was changed:
----- Method: TTCFont>>flushCache (in category 'initialize') -----
flushCache
+ "Flush the cache of this font"
+ cache := foregroundColor := colorToCacheMap := nil.!
- cache atAllPut: nil.!
Item was changed:
----- Method: TTCFont>>cache (in category 'friend') -----
cache
- cache size = 256 ifFalse:[self recreateCache]. "old weak-array caching"
^cache!
Item was changed:
----- Method: TTCFont class>>repairBadSizes (in category 'other') -----
repairBadSizes
"There was a bug that would cause the TTCFonts to generate incorrectly sized glyphs.
By looking at the dimensions of cached forms,
we can tell whether the incorrect height logic was used.
If it was, change the point size of the font and its derivatives.
Note that this is probably pointless to call after the new code has been loaded; it's here for documentation (it should be called from the CS preamble instead)."
"TTCFont repairBadSizes"
| description computedScale cached desiredScale newPointSize repaired |
+ repaired := OrderedCollection new.
- repaired _ OrderedCollection new.
TTCFont allInstancesDo: [ :font |
cached := (font cache copyFrom: $A asciiValue + 1 to: $z asciiValue + 1)
detect: [ :f | f notNil ] ifNone: [].
cached := cached ifNil: [ font formOf: $A ] ifNotNil: [ cached value ].
+ description := font ttcDescription.
+ desiredScale := cached height asFloat / (description ascender - description descender).
+ computedScale := font pixelSize asFloat / font ttcDescription unitsPerEm.
- description _ font ttcDescription.
- desiredScale _ cached height asFloat / (description ascender - description descender).
- computedScale _ font pixelSize asFloat / font ttcDescription unitsPerEm.
(((computedScale / desiredScale) - 1.0 * cached height) abs < 1.0) ifFalse: [
+ newPointSize := (font pointSize * desiredScale / computedScale) rounded.
- newPointSize _ (font pointSize * desiredScale / computedScale) rounded.
font pointSize: newPointSize; flushCache.
repaired add: font.
font derivativeFonts do: [ :df | df ifNotNil: [
df pointSize: newPointSize; flushCache.
repaired add: df. ]].
].
].
repaired isEmpty ifFalse: [ repaired asArray inspect ].
!
Item was changed:
----- 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.!
- self cache at: (char asInteger + 1) put: assoc.!
Item was changed:
----- Method: TTCFont>>setupDefaultFallbackFont (in category 'emphasis') -----
setupDefaultFallbackFont
+ | fonts f |
+ fonts := TextStyle default fontArray.
+ f := fonts first.
+ 1 to: fonts size do: [:i |
+ self height > (fonts at: i) height ifTrue: [f := fonts at: i].
+ ].
+ (f == self)
+ ifFalse:[ self fallbackFont: f ].
+ self reset.
- self setupDefaultFallbackTextStyleTo: (StrikeFont defaultFallbackTextStyle).
!
Item was changed:
----- Method: TTCFont>>formOf: (in category 'private') -----
formOf: char
+ | code form |
+ char charCode > self maxAscii
- | f assoc code |
- char charCode > 255
ifTrue: [^ self fallbackFont formOf: char].
+ cache ifNil:[self foregroundColor: Color black]. "make sure we have a cache"
- code _ char charCode.
- assoc _ self cache at: (code + 1).
- assoc ifNotNil: [
- (assoc key = foregroundColor) ifTrue: [
- ^ assoc value.
- ].
- ].
+ code := char charCode.
+ form := cache at: (code + 1).
+ 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
- f _ self computeForm: code.
- self at: code put: f.
- ^ f.
!
More information about the etoys-dev
mailing list