lists.squeakfoundation.org
Sign In
Sign Up
Sign In
Sign Up
Manage this list
×
Keyboard Shortcuts
Thread View
j
: Next unread message
k
: Previous unread message
j a
: Jump to all threads
j l
: Jump to MailingList overview
2024
May
April
March
February
January
2023
December
November
October
September
August
July
June
May
April
March
February
January
2022
December
November
October
September
August
July
June
May
April
March
February
January
2021
December
November
October
September
August
July
June
May
April
March
February
January
2020
December
November
October
September
August
July
June
May
April
March
February
January
2019
December
November
October
September
August
July
June
May
April
March
February
January
2018
December
November
October
September
August
July
June
May
April
March
February
January
2017
December
November
October
September
August
July
June
May
April
March
February
January
2016
December
November
October
September
August
July
June
May
April
March
February
January
2015
December
November
October
September
August
July
June
May
April
March
February
January
2014
December
November
October
September
August
July
June
May
April
March
February
January
2013
December
November
October
September
August
July
June
May
April
March
February
January
2012
December
November
October
September
August
July
June
May
April
March
February
January
2011
December
November
October
September
August
July
June
May
April
March
February
January
2010
December
November
October
September
August
July
June
May
April
March
February
January
2009
December
November
October
September
August
July
June
May
April
March
February
January
2008
December
November
October
September
August
July
June
May
April
March
February
January
2007
December
November
October
September
August
July
June
May
April
March
February
January
2006
December
November
October
September
August
July
June
May
April
March
February
January
2005
December
November
October
September
August
July
June
May
April
March
February
List overview
Download
Packages
July 2013
----- 2024 -----
May 2024
April 2024
March 2024
February 2024
January 2024
----- 2023 -----
December 2023
November 2023
October 2023
September 2023
August 2023
July 2023
June 2023
May 2023
April 2023
March 2023
February 2023
January 2023
----- 2022 -----
December 2022
November 2022
October 2022
September 2022
August 2022
July 2022
June 2022
May 2022
April 2022
March 2022
February 2022
January 2022
----- 2021 -----
December 2021
November 2021
October 2021
September 2021
August 2021
July 2021
June 2021
May 2021
April 2021
March 2021
February 2021
January 2021
----- 2020 -----
December 2020
November 2020
October 2020
September 2020
August 2020
July 2020
June 2020
May 2020
April 2020
March 2020
February 2020
January 2020
----- 2019 -----
December 2019
November 2019
October 2019
September 2019
August 2019
July 2019
June 2019
May 2019
April 2019
March 2019
February 2019
January 2019
----- 2018 -----
December 2018
November 2018
October 2018
September 2018
August 2018
July 2018
June 2018
May 2018
April 2018
March 2018
February 2018
January 2018
----- 2017 -----
December 2017
November 2017
October 2017
September 2017
August 2017
July 2017
June 2017
May 2017
April 2017
March 2017
February 2017
January 2017
----- 2016 -----
December 2016
November 2016
October 2016
September 2016
August 2016
July 2016
June 2016
May 2016
April 2016
March 2016
February 2016
January 2016
----- 2015 -----
December 2015
November 2015
October 2015
September 2015
August 2015
July 2015
June 2015
May 2015
April 2015
March 2015
February 2015
January 2015
----- 2014 -----
December 2014
November 2014
October 2014
September 2014
August 2014
July 2014
June 2014
May 2014
April 2014
March 2014
February 2014
January 2014
----- 2013 -----
December 2013
November 2013
October 2013
September 2013
August 2013
July 2013
June 2013
May 2013
April 2013
March 2013
February 2013
January 2013
----- 2012 -----
December 2012
November 2012
October 2012
September 2012
August 2012
July 2012
June 2012
May 2012
April 2012
March 2012
February 2012
January 2012
----- 2011 -----
December 2011
November 2011
October 2011
September 2011
August 2011
July 2011
June 2011
May 2011
April 2011
March 2011
February 2011
January 2011
----- 2010 -----
December 2010
November 2010
October 2010
September 2010
August 2010
July 2010
June 2010
May 2010
April 2010
March 2010
February 2010
January 2010
----- 2009 -----
December 2009
November 2009
October 2009
September 2009
August 2009
July 2009
June 2009
May 2009
April 2009
March 2009
February 2009
January 2009
----- 2008 -----
December 2008
November 2008
October 2008
September 2008
August 2008
July 2008
June 2008
May 2008
April 2008
March 2008
February 2008
January 2008
----- 2007 -----
December 2007
November 2007
October 2007
September 2007
August 2007
July 2007
June 2007
May 2007
April 2007
March 2007
February 2007
January 2007
----- 2006 -----
December 2006
November 2006
October 2006
September 2006
August 2006
July 2006
June 2006
May 2006
April 2006
March 2006
February 2006
January 2006
----- 2005 -----
December 2005
November 2005
October 2005
September 2005
August 2005
July 2005
June 2005
May 2005
April 2005
March 2005
February 2005
packages@lists.squeakfoundation.org
1 participants
522 discussions
Start a n
N
ew thread
The Trunk: Multilingual-fbs.163.mcz
by commitsï¼ source.squeak.org
02 Jul '13
02 Jul '13
Frank Shearar uploaded a new version of Multilingual to project The Trunk:
http://source.squeak.org/trunk/Multilingual-fbs.163.mcz
==================== Summary ==================== Name: Multilingual-fbs.163 Author: fbs Time: 2 July 2013, 8:21:22.262 pm UUID: 9f8b3b97-0255-d848-8146-56a618db9aa2 Ancestors: Multilingual-fbs.162 Break the Multilingual <-> TrueType cyclic dependency by moving TTC (TrueType Collection) classes to TrueType and FixedFaceFont to Graphics-Fonts (because this concerns displaying fonts). =============== Diff against Multilingual-fbs.162 =============== Item was removed: - AbstractFont subclass: #FixedFaceFont - instanceVariableNames: 'baseFont substitutionCharacter displaySelector' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Display'! - - !FixedFaceFont commentStamp: 'tak 12/22/2004 01:45' prior: 0! - I am a font for special purpose like password or fallback. - I can show same form whenever someone requests any character. - - Variable displaySelector is future use to show a form dynamically. - (Although it would be unnecessary...)! Item was removed: - ----- Method: FixedFaceFont>>ascent (in category 'accessing') ----- - ascent - ^baseFont ascent! Item was removed: - ----- Method: FixedFaceFont>>ascentOf: (in category 'accessing') ----- - ascentOf: aCharacter - ^ self ascent! Item was removed: - ----- Method: FixedFaceFont>>baseFont (in category 'accessing') ----- - baseFont - ^baseFont! Item was removed: - ----- Method: FixedFaceFont>>baseFont: (in category 'accessing') ----- - baseFont: aFont - baseFont := aFont! Item was removed: - ----- Method: FixedFaceFont>>baseKern (in category 'accessing') ----- - baseKern - ^baseFont baseKern! Item was removed: - ----- Method: FixedFaceFont>>characterFormAt: (in category 'accessing') ----- - characterFormAt: character - ^ baseFont characterFormAt: substitutionCharacter! Item was removed: - ----- Method: FixedFaceFont>>descent (in category 'accessing') ----- - descent - ^baseFont descent! Item was removed: - ----- Method: FixedFaceFont>>descentKern (in category 'accessing') ----- - descentKern - ^baseFont descentKern! Item was removed: - ----- Method: FixedFaceFont>>descentOf: (in category 'accessing') ----- - descentOf: aCharacter - ^ self descent! Item was removed: - ----- Method: FixedFaceFont>>displayErrorOn:length:at:kern: (in category 'displaying') ----- - displayErrorOn: aCanvas length: length at: aPoint kern: kernDelta - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta! Item was removed: - ----- Method: FixedFaceFont>>displayErrorOn:length:at:kern:baselineY: (in category 'displaying') ----- - displayErrorOn: aCanvas length: length at: aPoint kern: kernDelta baselineY: baselineY - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta - baselineY: baselineY! Item was removed: - ----- Method: FixedFaceFont>>displayPasswordOn:length:at:kern: (in category 'displaying') ----- - displayPasswordOn: aCanvas length: length at: aPoint kern: kernDelta - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta! Item was removed: - ----- Method: FixedFaceFont>>displayPasswordOn:length:at:kern:baselineY: (in category 'displaying') ----- - displayPasswordOn: aCanvas length: length at: aPoint kern: kernDelta baselineY: baselineY - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta - baselineY: baselineY! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern: (in category 'displaying') ----- - displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta - | size | - size := stopIndex - startIndex + 1. - ^ self perform: displaySelector withArguments: (Array with: aDisplayContext with: size with: aPoint with: kernDelta with: aPoint y + self ascent).! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern:baselineY: (in category 'displaying') ----- - displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY - | size | - size := stopIndex - startIndex + 1. - ^ self perform: displaySelector withArguments: (Array with: aDisplayContext with: size with: aPoint with: kernDelta with: baselineY).! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern:from: (in category 'displaying') ----- - displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont - | destPoint | - destPoint := self - displayString: aString - on: aBitBlt - from: startIndex - to: stopIndex - at: aPoint - kern: kernDelta. - ^ Array with: stopIndex + 1 with: destPoint! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern:from:baselineY: (in category 'displaying') ----- - displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont baselineY: baselineY - | destPoint | - destPoint := self - displayString: aString - on: aBitBlt - from: startIndex - to: stopIndex - at: aPoint - kern: kernDelta - baselineY: baselineY. - ^destPoint! Item was removed: - ----- Method: FixedFaceFont>>emphasized: (in category 'accessing') ----- - emphasized: emph - ^self class new baseFont: (baseFont emphasized: emph)! Item was removed: - ----- Method: FixedFaceFont>>errorFont (in category 'initialize-release') ----- - errorFont - displaySelector := #displayErrorOn:length:at:kern:baselineY:. - substitutionCharacter := $?.! Item was removed: - ----- Method: FixedFaceFont>>familyName (in category 'accessing') ----- - familyName - ^baseFont familyName, '-pw'! Item was removed: - ----- Method: FixedFaceFont>>fontSize: (in category 'accessing') ----- - fontSize: aNumber - self baseFont: (StrikeFont familyName: baseFont familyName size: aNumber) copy! Item was removed: - ----- Method: FixedFaceFont>>glyphInfoOf:into: (in category 'private') ----- - glyphInfoOf: aCharacter into: glyphInfoArray - - ^ baseFont glyphInfoOf: substitutionCharacter into: glyphInfoArray. - ! Item was removed: - ----- Method: FixedFaceFont>>height (in category 'accessing') ----- - height - ^baseFont height! Item was removed: - ----- Method: FixedFaceFont>>initialize (in category 'initialize-release') ----- - initialize - "This used to be the default textstyle, but it needs to be a StrikeFont and not a TTCFont and sometimes the default textstyle is a TTCFont. So, we use a typical StrikeFont as the default fallback font." - baseFont := StrikeFont defaultSized: 12. - self passwordFont! Item was removed: - ----- Method: FixedFaceFont>>installOn:foregroundColor:backgroundColor: (in category 'displaying') ----- - installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor - ^baseFont installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor! Item was removed: - ----- Method: FixedFaceFont>>lineGrid (in category 'accessing') ----- - lineGrid - ^baseFont lineGrid! Item was removed: - ----- Method: FixedFaceFont>>maxAscii (in category 'accessing') ----- - maxAscii - ^ SmallInteger maxVal! Item was removed: - ----- Method: FixedFaceFont>>passwordCharacter (in category 'accessing') ----- - passwordCharacter - ^$*! Item was removed: - ----- Method: FixedFaceFont>>passwordFont (in category 'initialize-release') ----- - passwordFont - displaySelector := #displayPasswordOn:length:at:kern:baselineY:. - substitutionCharacter := $*! Item was removed: - ----- Method: FixedFaceFont>>pointSize (in category 'accessing') ----- - pointSize - ^baseFont pointSize! Item was removed: - ----- Method: FixedFaceFont>>releaseCachedState (in category 'caching') ----- - releaseCachedState - baseFont releaseCachedState.! Item was removed: - ----- Method: FixedFaceFont>>widthOf: (in category 'measuring') ----- - widthOf: aCharacter - ^ baseFont widthOf: substitutionCharacter! Item was removed: - TTCFont subclass: #LinedTTCFont - instanceVariableNames: 'emphasis lineGlyph contourWidth' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: LinedTTCFont class>>fromTTCFont:emphasis: (in category 'as yet unclassified') ----- - fromTTCFont: aTTCFont emphasis: code - - | inst | - inst := self new. - inst ttcDescription: aTTCFont ttcDescription. - inst pointSize: aTTCFont pointSize. - inst emphasis: (aTTCFont emphasis bitOr: code). - inst lineGlyph: (aTTCFont ttcDescription at: $_). - - ^ inst. - ! Item was removed: - ----- Method: LinedTTCFont>>computeForm: (in category 'as yet unclassified') ----- - computeForm: char - - | ttGlyph scale | - - char = Character tab ifTrue: [^ super computeForm: char]. - - "char = $U ifTrue: [self doOnlyOnce: [self halt]]." - scale := self pixelSize asFloat / (ttcDescription ascender - ttcDescription descender). - ttGlyph := ttcDescription at: char. - ^ ttGlyph asFormWithScale: scale ascender: ttcDescription ascender descender: ttcDescription descender fgColor: foregroundColor bgColor: Color transparent depth: self depth replaceColor: false lineGlyph: lineGlyph lingGlyphWidth: contourWidth emphasis: emphasis! Item was removed: - ----- Method: LinedTTCFont>>emphasis (in category 'as yet unclassified') ----- - emphasis - - ^ emphasis. - ! Item was removed: - ----- Method: LinedTTCFont>>emphasis: (in category 'as yet unclassified') ----- - emphasis: code - - emphasis := code. - ! Item was removed: - ----- Method: LinedTTCFont>>lineGlyph: (in category 'as yet unclassified') ----- - lineGlyph: aGlyph - - lineGlyph := aGlyph. - contourWidth := aGlyph calculateWidth. - ! Item was removed: - TTCFont subclass: #MultiTTCFont - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: MultiTTCFont class>>cacheAllNil (in category 'as yet unclassified') ----- - cacheAllNil - " - self cacheAllNil - " - self allInstances do: [:inst | - inst cache do: [:e | - e third ifNotNil: [^ false]. - ]. - ]. - - ^ true. - ! Item was removed: - ----- Method: MultiTTCFont>>access:at: (in category 'as yet unclassified') ----- - access: char at: index - - | wcache entry | - wcache := self cache. - entry := wcache at: index. - wcache replaceFrom: index to: wcache size - 1 with: wcache startingAt: index + 1. - wcache at: wcache size put: entry. - ! Item was removed: - ----- Method: MultiTTCFont>>at:put: (in category 'as yet unclassified') ----- - at: char put: form - - | wcache | - wcache := self cache. - wcache replaceFrom: 1 to: wcache size - 1 with: wcache startingAt: 2. - wcache at: wcache size - put: (Array with: char asciiValue with: foregroundColor with: form). - ^form - ! Item was removed: - ----- Method: MultiTTCFont>>formOf: (in category 'as yet unclassified') ----- - formOf: char - - | newForm | - self hasCached: char ifTrue: [:form :index | - self access: char at: index. - ^ form. - ]. - - newForm := self computeForm: char. - self at: char put: newForm. - ^ newForm. - ! Item was removed: - ----- Method: MultiTTCFont>>glyphInfoOf:into: (in category 'as yet unclassified') ----- - glyphInfoOf: char into: glyphInfoArray - - | newForm | - self hasCached: char ifTrue: [:form :index | - self access: char at: index. - glyphInfoArray at: 1 put: form; - at: 2 put: 0; - at: 3 put: form width; - at: 4 put: (self ascentOf: char); - at: 5 put: self. - ^ glyphInfoArray. - ]. - - newForm := self computeForm: char. - self at: char put: newForm. - - glyphInfoArray at: 1 put: newForm; - at: 2 put: 0; - at: 3 put: newForm width; - at: 4 put: (self ascentOf: char); - at: 5 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- Method: MultiTTCFont>>hasCached:ifTrue: (in category 'as yet unclassified') ----- - hasCached: char ifTrue: twoArgBlock - - | value elem | - value := char asciiValue. - - self cache size to: 1 by: -1 do: [:i | - elem := self cache at: i. - (elem first = value and: [elem second = foregroundColor]) ifTrue: [ - ^ twoArgBlock value: elem third value: i. - ]. - ]. - ^ false. - ! Item was removed: - ----- Method: MultiTTCFont>>isTTCFont (in category 'as yet unclassified') ----- - isTTCFont - ^true! Item was removed: - ----- Method: MultiTTCFont>>widthOf: (in category 'as yet unclassified') ----- - widthOf: char - - "This method cannot use #formOf: because formOf: discriminates the color and causes unnecessary bitmap creation." - - | newForm | - self hasCached: char ifTrue: [:form :index | - self access: char at: index. - ^ form width. - ]. - - newForm := self computeForm: char. - self at: char put: newForm. - ^ newForm width. - - ! Item was removed: - AbstractFont subclass: #TTCFont - instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont height ascent descent maxAscii colorToCacheMap' - classVariableNames: 'GlyphCacheData GlyphCacheIndex GlyphCacheReady GlyphCacheSize NamesToIndexes Registry Scale ShutdownList' - 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 removed: - ----- Method: TTCFont class>>classVersion (in category 'objects from disk') ----- - classVersion - "Version 0 had pixelSize; version 1 changed it to pointSize" - ^1! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: TTCFont class>>fileReaderServicesForFile:suffix: (in category 'file list services') ----- - fileReaderServicesForFile: fullName suffix: suffix - ^(suffix = 'ttf') | (suffix = '*') - ifTrue: [ self services ] - ifFalse: [ #() ]! Item was removed: - ----- Method: TTCFont class>>getExistings: (in category 'instance creation') ----- - getExistings: fontArray - - | result em | - result := OrderedCollection new. - result add: fontArray. - 1 to: 3 do: [:i | - em := (fontArray collect: [:f | f emphasized: i]). - (em at: 1) ~= (fontArray at: 1) ifTrue: [ - result add: em. - ]. - ]. - ^ result asArray. - ! Item was removed: - ----- 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 ifNotNil: [self newTextStyleFromTT: tt]. - FileServices registerFileReader: self. - - Smalltalk addToShutDownList: self.! Item was removed: - ----- Method: TTCFont class>>isCacheAllNil (in category 'other') ----- - isCacheAllNil - " - self cacheAllNil - " - self allInstances do: [:inst | - inst cache do: [:e | - e ifNotNil: [^ false]. - ]. - ]. - - ^ true. - ! Item was removed: - ----- Method: TTCFont class>>newTextStyleFromTT: (in category 'instance creation') ----- - newTextStyleFromTT: description - "Create a new TextStyle from specified TTFontDescription instance." - - | array | - array := self pointSizes collect: - [:pt | | f | - f := self new. - f ttcDescription: description. - f pointSize: pt]. - ^self reorganizeForNewFontArray: array name: array first name asSymbol! Item was removed: - ----- 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. - ^ self newTextStyleFromTT: description. - ! Item was removed: - ----- Method: TTCFont class>>newTextStyleFromTTStream: (in category 'instance creation') ----- - newTextStyleFromTTStream: readStream - " - " - - | description | - description := TTFontDescription addFromTTStream: readStream. - ^ self newTextStyleFromTT: description. - ! Item was removed: - ----- Method: TTCFont class>>pointSizes (in category 'other') ----- - pointSizes - - "The default sizes that are created when a TextStyle is created. You can add new sizes by the new-size feature." - ^ #(9 12 15 24 36). - ! Item was removed: - ----- Method: TTCFont class>>recreateCache (in category 'other') ----- - recreateCache - " - self recreateCache. - " - self allSubInstances do: [:inst | inst flushCache]. - Smalltalk garbageCollect. - ! Item was removed: - ----- Method: TTCFont class>>register:at: (in category 'other') ----- - register: anObject at: symbolName - - self registry at: symbolName put: anObject. - ! Item was removed: - ----- Method: TTCFont class>>registerAll (in category 'other') ----- - registerAll - " - TTCFont registerAll - " - - TextStyle allInstancesDo: [:e | - (e fontArray first isMemberOf: TTCFont) ifTrue: [ - self register: e fontArray at: e fontArray first familyName asSymbol. - ]. - ]. - ! Item was removed: - ----- Method: TTCFont class>>registry (in category 'other') ----- - registry - ^ Registry - ifNil: [Registry := IdentityDictionary new] - ! Item was removed: - ----- Method: TTCFont class>>removeAllDerivatives (in category 'other') ----- - removeAllDerivatives - " - self removeAllDerivatives - " - - self allInstances do: [:s | - s textStyle ifNotNil: [ - s textStyle fontArray do: [:f | - f derivativeFont: nil at: 0. - ]. - ]. - ]. - ! Item was removed: - ----- Method: TTCFont class>>removeStyleName: (in category 'other') ----- - removeStyleName: aString - - TextConstants removeKey: aString asSymbol ifAbsent: []. - TTFontDescription removeDescriptionNamed: aString asString. - ! Item was removed: - ----- 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 isTTCStyle ifFalse: [ - 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]. - - 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 ifNotNil: [ r derivativeFont: f ]. - ]. - ]. - ]. - - style newFontArray: regular. - self register: regular at: styleName. - self recreateCache. - ^ style. - ! Item was removed: - ----- Method: TTCFont class>>repairDerivativeFonts (in category 'other') ----- - repairDerivativeFonts - "Fix the cases where the derivatives are a different size than the originals." - - " - TTCFont repairDerivativeFonts. - " - self allInstancesDo: [ :font | font pointSize: font pointSize ]. - Preferences refreshFontSettings.! Item was removed: - ----- 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' - selector: #newTextStyleFromTTFile: - description: 'install a true type font as a text style' - buttonLabel: 'install ttf'! Item was removed: - ----- Method: TTCFont class>>services (in category 'file list services') ----- - services - "Return a set of services for use in FileList" - - ^ Array with: self serviceInstallTrueTypeFontStyle! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: TTCFont class>>unload (in category 'class initialization') ----- - unload - - FileServices unregisterFileReader: self! Item was removed: - ----- Method: TTCFont class>>unregister: (in category 'other') ----- - unregister: symbolName - - self registry removeKey: symbolName ifAbsent: []. - ! Item was removed: - ----- Method: TTCFont class>>version (in category 'other') ----- - version - - ^ '6.0'. - ! Item was removed: - ----- Method: TTCFont>>addLined (in category 'private') ----- - addLined - - self addLined: self. - self derivativeFonts do: [:e | - e ifNotNil: [self addLined: e]. - ]. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>ascent (in category 'accessing') ----- - ascent - ^ascent ifNil:[ascent := (ttcDescription typographicAscender * self pixelScale) truncated].! Item was removed: - ----- Method: TTCFont>>ascentOf: (in category 'accessing') ----- - ascentOf: aCharacter - - " (self hasGlyphFor: aCharacter) ifFalse: [ - fallbackFont ifNotNil: [ - ^ fallbackFont ascentOf: aCharacter. - ]. - ]. - " - ^ self ascent. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>cache (in category 'friend') ----- - cache - ^cache! Item was removed: - ----- Method: TTCFont>>characterFormAt: (in category 'character shapes') ----- - characterFormAt: character - "Answer a Form copied out of the glyphs for the argument, - character. Use a cached copy if possible." - - ^self formOf: character! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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. - ]. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm.! Item was removed: - ----- Method: TTCFont>>copy (in category 'copying') ----- - copy - - ^ self. - ! Item was removed: - ----- Method: TTCFont>>deepCopy (in category 'copying') ----- - deepCopy - - ^ self. - ! Item was removed: - ----- Method: TTCFont>>depth (in category 'public') ----- - depth - - ^ 32. - ! Item was removed: - ----- 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 removed: - ----- 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>>derivativeFont:mainFont: (in category 'initialize') ----- - derivativeFont: aNewlyCreatedDerivativeFont mainFont: aMainFont - - self derivativeFont: aNewlyCreatedDerivativeFont at: aMainFont emphasis. - aNewlyCreatedDerivativeFont emphasis: aMainFont emphasis. - aNewlyCreatedDerivativeFont lineGlyph: (aMainFont ttcDescription at: $_).! Item was removed: - ----- Method: TTCFont>>derivativeFontArray (in category 'friend') ----- - derivativeFontArray - - ^ derivatives. - ! Item was removed: - ----- Method: TTCFont>>derivativeFonts (in category 'friend') ----- - derivativeFonts - - derivatives ifNil: [^ #()]. - ^derivatives copyWithout: nil! Item was removed: - ----- 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 := self height - self ascent]. - ! Item was removed: - ----- Method: TTCFont>>descentKern (in category 'accessing') ----- - descentKern - - ^ 0. - ! Item was removed: - ----- Method: TTCFont>>descentOf: (in category 'accessing') ----- - descentOf: aCharacter - - " (self hasGlyphFor: aCharacter) ifFalse: [ - fallbackFont ifNotNil: [ - ^ fallbackFont descentOf: aCharacter. - ]. - ]." - ^ self descent. - ! Item was removed: - ----- 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 removed: - ----- 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. - aBitBlt sourceX: hereX; sourceY: 0. - aBitBlt width: nextX - hereX. - aBitBlt height: form height. - aBitBlt copyBits. - destX := destX + (nextX - hereX) + kernDelta. - ]. - ^ destX @ destY - ! Item was removed: - ----- Method: TTCFont>>emphasis (in category 'accessing') ----- - emphasis - "Answer the emphasis code (0 to 3) corresponding to my subfamily name" - ^self indexOfSubfamilyName: self subfamilyName - - ! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: TTCFont>>fallbackFont (in category 'accessing') ----- - fallbackFont - "Answers the fallbackFont for the receiver. The fallback font must be some derivative of the receiver since it will not be asked to install itself properly on the target BitBlt so rendering a completely different font here is simply not possible. The default implementation uses a synthetic font that maps all characters to question marks." - ^ fallbackFont - ifNil: [fallbackFont := FixedFaceFont new errorFont baseFont: self]! Item was removed: - ----- Method: TTCFont>>fallbackFont: (in category 'accessing') ----- - fallbackFont: aFontSetOrNil - - aFontSetOrNil == self - ifTrue:[^ self error: 'Invalid fallback font']. - - fallbackFont := aFontSetOrNil. - ! Item was removed: - ----- Method: TTCFont>>familyName (in category 'accessing') ----- - familyName - - ^ ttcDescription name. - ! Item was removed: - ----- Method: TTCFont>>familySizeFace (in category 'accessing') ----- - familySizeFace - - ^ Array - with: self familyName - with: self height - with: 0. - ! Item was removed: - ----- Method: TTCFont>>flushCache (in category 'initialize') ----- - flushCache - "Flush the cache of this font" - cache := foregroundColor := colorToCacheMap := nil.! Item was removed: - ----- Method: TTCFont>>flushCachedValues (in category 'private') ----- - flushCachedValues - "Flush all values computed from ttcDescription and cached for speed" - "TTCFont allInstancesDo:[:font| font flushCachedValues]" - height := ascent := descent := nil.! Item was removed: - ----- Method: TTCFont>>fontNameWithPointSize (in category 'accessing') ----- - fontNameWithPointSize - ^ self name withoutTrailingDigits , ' ' , self pointSize printString! Item was removed: - ----- Method: TTCFont>>foregroundColor (in category 'public') ----- - foregroundColor - - ^ foregroundColor. - ! Item was removed: - ----- 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 removed: - ----- 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 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 removed: - ----- 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. - glyphInfoArray at: 1 put: form; - at: 2 put: 0; - at: 3 put: form width; - at: 4 put: ascent "(self ascentOf: aCharacter)"; - at: 5 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- 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]! Item was removed: - ----- Method: TTCFont>>height (in category 'accessing') ----- - height - "Answer my height in pixels. This will answer a Float." - ^height ifNil:[height := self pixelSize + self lineGap]! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>indexOfSubfamilyName: (in category 'private') ----- - indexOfSubfamilyName: aName - | decoded | - - "decodeStyleName will consume all the modifiers and leave nothing if everything was recognized." - decoded := TextStyle decodeStyleName: aName. - decoded second isEmpty ifTrue: [ ^decoded first ]. - - "If you get a halt here - please add the missing synonym to the lookup table in TextStyle>>decodeStyleName: ." - - self error: 'please add the missing synonym ', aName, ' to the lookup table in TextStyle>>decodeStyleName:'. - - ^0.! Item was removed: - ----- Method: TTCFont>>initialize (in category 'friend') ----- - initialize - - foregroundColor := Color black. - ! Item was removed: - ----- Method: TTCFont>>initialize: (in category 'initialize') ----- - initialize: aFont - - self initialize. - self ttcDescription: aFont ttcDescription. - ! Item was removed: - ----- Method: TTCFont>>installOn: (in category 'friend') ----- - installOn: aDisplayContext - - ^aDisplayContext installTTCFont: self. - ! Item was removed: - ----- Method: TTCFont>>installOn:foregroundColor:backgroundColor: (in category 'friend') ----- - installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor - self foregroundColor: fgColor. "install color" - aDisplayContext installTTCFont: self foregroundColor: foregroundColor backgroundColor: bgColor - ! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: TTCFont>>isTTCFont (in category 'testing') ----- - isTTCFont - ^true! Item was removed: - ----- Method: TTCFont>>lineGap (in category 'accessing') ----- - lineGap - "Answer the line gap from the ttf description" - ^self pixelSize * ttcDescription typographicLineGap // - (ttcDescription typographicAscender - ttcDescription typographicDescender)! Item was removed: - ----- Method: TTCFont>>lineGlyph: (in category 'initialize') ----- - lineGlyph: ignore - ^self! Item was removed: - ----- Method: TTCFont>>lineGrid (in category 'accessing') ----- - lineGrid - "Answer the relative space between lines" - ^ self ascent + self descent! Item was removed: - ----- 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].! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>name (in category 'accessing') ----- - name - - ^ ttcDescription name. - ! Item was removed: - ----- 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: - args: {self familyName. self pointSize. self emphasis}. - refStrm replace: self with: dp. - ^ dp. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>pixelScale (in category 'accessing') ----- - pixelScale - "Answer the scale factor to convert from the truetype's units into the receiver's pixel size. The scale for a font is computed by *excluding* the linegap (leading) in the font. Consequently, the height of the font (including linegap/leading) will be larger than the pixel size." - ^self pixelSize asFloat / - (ttcDescription typographicAscender - - ttcDescription typographicLineGap - - ttcDescription typographicDescender)! Item was removed: - ----- Method: TTCFont>>pixelSize (in category 'accessing') ----- - pixelSize - "Make sure that we don't return a Fraction" - ^(TextStyle pointsToPixels: pointSize) truncated! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>pointSize (in category 'accessing') ----- - pointSize - - ^ pointSize. - ! Item was removed: - ----- Method: TTCFont>>pointSize: (in category 'accessing') ----- - pointSize: aNumber - - self privatePointSize: aNumber. - derivatives ifNotNil: [ derivatives do: [ :f | f ifNotNil: [ f privatePointSize: aNumber ]]]. - ! Item was removed: - ----- Method: TTCFont>>printOn: (in category 'printing') ----- - printOn: aStream - aStream nextPutAll: 'TTCFont('; - nextPutAll: self familyName; space; - print: self pointSize; space; - nextPutAll: self subfamilyName; - nextPut: $)! Item was removed: - ----- Method: TTCFont>>privatePointSize: (in category 'accessing') ----- - privatePointSize: aNumber - pointSize = aNumber - ifFalse: [pointSize := aNumber. - self flushCache]! Item was removed: - ----- Method: TTCFont>>releaseCachedState (in category 'caching') ----- - releaseCachedState - self flushCache.! Item was removed: - ----- Method: TTCFont>>reset (in category 'caching') ----- - reset - ! Item was removed: - ----- Method: TTCFont>>scale (in category 'private') ----- - scale - - ^ self pixelSize / ttcDescription unitsPerEm - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>size (in category 'public') ----- - size - - ^ ttcDescription size. - ! Item was removed: - ----- Method: TTCFont>>subfamilyName (in category 'private') ----- - subfamilyName - - ^ ttcDescription subfamilyName. - ! Item was removed: - ----- Method: TTCFont>>textStyle (in category 'accessing') ----- - textStyle - ^ TextStyle actualTextStyles detect: - [:aStyle | aStyle fontArray includes: self] ifNone: [nil]! Item was removed: - ----- Method: TTCFont>>ttcDescription (in category 'friend') ----- - ttcDescription - - ^ ttcDescription. - ! Item was removed: - ----- Method: TTCFont>>ttcDescription: (in category 'friend') ----- - ttcDescription: aTTCDescription - - ttcDescription := aTTCDescription. - self flushCache. - ! Item was removed: - ----- Method: TTCFont>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - - self flushCache. - ^ self. - ! Item was removed: - ----- 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: [ - fallbackFont ifNotNil: [^ fallbackFont widthOf: aCharacter]. - ^ 1 - ]. - ^(self formOf: aCharacter) width! Item was removed: - TTFontDescription subclass: #TTCFontDescription - instanceVariableNames: '' - classVariableNames: 'TTCDefault TTCDescriptions' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: TTCFontDescription class>>addFromTTFile: (in category 'as yet unclassified') ----- - addFromTTFile: fileName - " - Execute the following only if you know what you are doing. - self addFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC' - " - - | tt old | - (fileName asLowercase endsWith: 'ttf') ifTrue: [ - tt := TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName). - ] ifFalse: [ - tt := TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName). - ]. - - old := TTCDescriptions detect: [:f | f first name = tt first name] ifNone: [nil]. - old ifNotNil: [TTCDescriptions remove: old]. - TTCDescriptions add: tt. - ^ tt. - ! Item was removed: - ----- Method: TTCFontDescription class>>clearDefault (in category 'as yet unclassified') ----- - clearDefault - " - self clearDefault - " - - TTCDefault := nil. - ! Item was removed: - ----- Method: TTCFontDescription class>>clearDescriptions (in category 'as yet unclassified') ----- - clearDescriptions - " - self clearDescriptions - " - - TTCDescriptions := Set new. - TTCDefault ifNotNil: [TTCDescriptions add: TTCDefault]. - ! Item was removed: - ----- Method: TTCFontDescription class>>default (in category 'as yet unclassified') ----- - default - - ^ TTCDefault. - ! Item was removed: - ----- Method: TTCFontDescription class>>descriptionNamed: (in category 'as yet unclassified') ----- - descriptionNamed: descriptionName - - ^ TTCDescriptions detect: [:f | f first name = descriptionName] ifNone: [TTCDefault]. - ! Item was removed: - ----- Method: TTCFontDescription class>>descriptionNamed:at: (in category 'as yet unclassified') ----- - descriptionNamed: descriptionName at: index - - | array | - (array := self descriptionNamed: descriptionName) ifNil: [^ nil]. - ^ array at: index. - ! Item was removed: - ----- Method: TTCFontDescription class>>initialize (in category 'as yet unclassified') ----- - initialize - " - self initialize - " - - self clearDescriptions. - ! Item was removed: - ----- Method: TTCFontDescription class>>removeDescriptionNamed: (in category 'as yet unclassified') ----- - removeDescriptionNamed: descriptionName - - | tt | - TTCDescriptions ifNil: [^ self]. - [(tt := TTCDescriptions detect: [:f | ('Multi', f first name) = descriptionName] ifNone: [nil]) notNil] whileTrue:[ - TTCDescriptions remove: tt - ]. - ! Item was removed: - ----- Method: TTCFontDescription class>>setDefault (in category 'as yet unclassified') ----- - setDefault - " - self setDefault - " - - TTCDefault := TTCFontReader readFrom: (FileStream readOnlyFileNamed: 'C:\WINDOWS\Fonts\msgothic.ttc'). - self clearDescriptions. - - ! Item was removed: - ----- Method: TTCFontDescription>>at: (in category 'accessing') ----- - at: aCharOrInteger - - | char | - char := aCharOrInteger asCharacter. - ^ glyphs at: (char charCode) + 1. - ! Item was removed: - ----- Method: TTCFontDescription>>deepCopy (in category 'copying') ----- - deepCopy - - ^ self. - ! Item was removed: - ----- Method: TTCFontDescription>>name (in category 'accessing') ----- - name - - ^ self familyName copyWithout: Character space. - ! Item was removed: - ----- Method: TTCFontDescription>>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 Font in the other system instead. " - - "A path to me" - (TextConstants at: #forceFontWriting ifAbsent: [false]) ifTrue: [^ self]. - "special case for saving the default fonts on the disk. See collectionFromFileNamed:" - - dp := DiskProxy global: #TTCFontDescription selector: #descriptionNamed:at: - args: {self name. ((TTCFontDescription descriptionNamed: self name) indexOf: self)}. - refStrm replace: self with: dp. - ^ dp. - ! Item was removed: - ----- Method: TTCFontDescription>>size (in category 'accessing') ----- - size - - ^ glyphs size. - ! Item was removed: - ----- Method: TTCFontDescription>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - "Return self. I am shared. Do not record me." - ! Item was removed: - TTFontReader subclass: #TTCFontReader - instanceVariableNames: 'fonts' - classVariableNames: 'EncodingTag' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: TTCFontReader class>>encodingTag: (in category 'as yet unclassified') ----- - encodingTag: aNumber - " - TTCFontReader encodingTag: 6 - " - - EncodingTag := aNumber. - ! Item was removed: - ----- Method: TTCFontReader>>decodeCmapFmtTable: (in category 'as yet unclassified') ----- - decodeCmapFmtTable: entry - | cmapFmt length entryCount segCount segments offset cmap firstCode | - cmapFmt := entry nextUShort. - length := entry nextUShort. - entry skip: 2. "skip version" - - cmapFmt = 0 ifTrue: "byte encoded table" - [length := length - 6. "should be always 256" - length <= 0 ifTrue: [^ nil]. "but sometimes, this table is empty" - cmap := Array new: length. - entry nextBytes: length into: cmap startingAt: entry offset. - ^ cmap]. - - cmapFmt = 4 ifTrue: "segment mapping to deltavalues" - [segCount := entry nextUShort // 2. - entry skip: 6. "skip searchRange, entrySelector, rangeShift" - segments := Array new: segCount. - segments := (1 to: segCount) collect: [:e | Array new: 4]. - 1 to: segCount do: [:i | (segments at: i) at: 2 put: entry nextUShort]. "endCount" - entry skip: 2. "skip reservedPad" - 1 to: segCount do: [:i | (segments at: i) at: 1 put: entry nextUShort]. "startCount" - 1 to: segCount do: [:i | (segments at: i) at: 3 put: entry nextShort]. "idDelta" - offset := entry offset. - 1 to: segCount do: [:i | (segments at: i) at: 4 put: entry nextUShort]. "idRangeOffset" - cmap := Array new: 65536 withAll: 0. - segments withIndexDo: - [:seg :si | | code | - seg first to: seg second do: - [:i | - seg last > 0 ifTrue: - ["offset to glypthIdArray - this is really C-magic!!" - entry offset: i - seg first - 1 * 2 + seg last + si + si + offset. - code := entry nextUShort. - code > 0 ifTrue: [code := code + seg third]] - ifFalse: - ["simple offset" - code := i + seg third]. - cmap at: i + 1 put: (code \\ 16r10000)]]. - ^ cmap]. - - cmapFmt = 6 ifTrue: "trimmed table" - [firstCode := entry nextUShort. - entryCount := entry nextUShort. - cmap := Array new: entryCount + firstCode withAll: 0. - entryCount timesRepeat: - [cmap at: (firstCode := firstCode + 1) put: entry nextUShort]. - ^ cmap]. - ^ nil! Item was removed: - ----- Method: TTCFontReader>>getTableDirEntry:from:offset: (in category 'as yet unclassified') ----- - getTableDirEntry: tagString from: fontData offset: offset - "Find the table named tagString in fontData and return a table directory entry for it." - - | nTables pos currentTag tag | - nTables := fontData shortAt: 5 + offset bigEndian: true. - tag := ByteArray new: 4. - 1 to: 4 do:[:i| tag byteAt: i put: (tagString at: i) asInteger]. - tag := tag longAt: 1 bigEndian: true. - pos := 13 + offset. - 1 to: nTables do:[:i| - currentTag := fontData longAt: pos bigEndian: true. - currentTag = tag ifTrue:[^TTFontTableDirEntry on: fontData at: pos]. - pos := pos+16]. - ^nil! Item was removed: - ----- Method: TTCFontReader>>parseTTCHeaderFrom: (in category 'as yet unclassified') ----- - parseTTCHeaderFrom: fontData - - | pos nTables | - nTables := fontData longAt: 9 bigEndian: true. - fonts := Array new: nTables. - pos := 13. - 1 to: nTables do: [:i | - fonts at: i put: (fontData longAt: pos bigEndian: true). - pos := pos + 4. - ]. - - ^ fonts - ! Item was removed: - ----- Method: TTCFontReader>>processCharMap: (in category 'as yet unclassified') ----- - processCharMap: assoc - "Process the given character map" - - | glyph cmap encode0 encode1 char value null | - cmap := assoc value. - null := (glyphs at: (cmap at: Character space asUnicode + 1) + 1) copy. - null contours: #(). - - encode0 := Array new: 256 withAll: glyphs first. - encode1 := Array new: 65536 withAll: glyphs first. - - 0 to: 255 do: [:i | - char := Character value: i. - glyph := glyphs at: (cmap at: char asUnicode + 1) + 1. - encode0 at: i+1 put: glyph. - ]. - Character separators do: [:c | - encode0 at: (c asciiValue + 1) put: null. - ]. - 0 to: 65536 - 1 do: [:i | - value := cmap at: i+1. - value = 65535 ifFalse: [ "???" - encode1 at: i+1 put: (glyphs at: value+1). - ] - ]. - - ^ {encode0. encode1}. - ! Item was removed: - ----- Method: TTCFontReader>>processCharacterMappingTable: (in category 'as yet unclassified') ----- - processCharacterMappingTable: entry - "Read the font's character to glyph index mapping table. - If an appropriate mapping can be found then return an association - with the format identifier and the contents of the table" - | copy initialOffset nSubTables pID sID offset cmap assoc | - initialOffset := entry offset. - entry skip: 2. "Skip table version" - nSubTables := entry nextUShort. - 1 to: nSubTables do:[:i| - pID := entry nextUShort. - sID := entry nextUShort. - offset := entry nextULong. - "Check if this is either a Macintosh encoded table - or a Windows encoded table" - (pID = 1 or:[pID = 3]) ifTrue:[ - "Go to the beginning of the table" - copy := entry copy. - copy offset: initialOffset + offset. - cmap := self decodeCmapFmtTable: copy. - "(pID = 1 and: [cmap notNil])" "Prefer Macintosh encoding over everything else" - "ifTrue: [pID -> cmap]." - assoc := pID -> cmap. "Keep it in case we don't find a Mac encoded table" - ]. - ]. - ^assoc! Item was removed: - ----- Method: TTCFontReader>>readFrom: (in category 'as yet unclassified') ----- - readFrom: aStream - - "Read the raw font byte data" - | fontData | - (aStream respondsTo: #binary) ifTrue:[aStream binary]. - fontData := aStream contents asByteArray. - - fonts := self parseTTCHeaderFrom: fontData. - ^ ((Array with: fonts first) collect: [:offset | - fontDescription := TTCFontDescription new. - self readFrom: fontData fromOffset: offset at: EncodingTag. - ]) at: 1. - ! Item was removed: - ----- Method: TTCFontReader>>readFrom:fromOffset:at: (in category 'as yet unclassified') ----- - readFrom: fontData fromOffset: offset at: encodingTag - - | headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry glyphOffset cmap numHMetrics indexToLocFormat fontDescription0 fontDescription1 array result | - - "Search the tables required to build the font" - (headerEntry := self getTableDirEntry: 'head' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a header table']. - (maxProfileEntry := self getTableDirEntry: 'maxp' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a maximum profile table']. - (nameEntry := self getTableDirEntry: 'name' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a name table']. - (indexLocEntry := self getTableDirEntry: 'loca' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a relocation table']. - (charMapEntry := self getTableDirEntry: 'cmap' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a character map table']. - (glyphEntry := self getTableDirEntry: 'glyf' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a glyph table']. - (horzHeaderEntry := self getTableDirEntry: 'hhea' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a horizontal header table']. - (horzMetricsEntry := self getTableDirEntry: 'hmtx' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a horizontal metrics table']. - (kerningEntry := self getTableDirEntry: 'kern' from: fontData offset: offset) == nil ifTrue:[ - Transcript cr; show:'This font does not have a kerning table';endEntry]. - - - "Process the data" - indexToLocFormat := self processFontHeaderTable: headerEntry. - self processMaximumProfileTable: maxProfileEntry. - self processNamingTable: nameEntry. - glyphOffset := self processIndexToLocationTable: indexLocEntry format: indexToLocFormat. - cmap := self processCharacterMappingTable: charMapEntry. - (cmap == nil or:[cmap value == nil]) - ifTrue:[^self error:'This font has no suitable character mappings']. - self processGlyphDataTable: glyphEntry offsets: glyphOffset. - numHMetrics := self processHorizontalHeaderTable: horzHeaderEntry. - self processHorizontalMetricsTable: horzMetricsEntry length: numHMetrics. - kerningEntry isNil - ifTrue:[kernPairs := #()] - ifFalse:[self processKerningTable: kerningEntry]. - array := self processCharMap: cmap. - fontDescription0 := fontDescription clone. - fontDescription1 := fontDescription clone. - fontDescription0 setGlyphs: (array at: 1) mapping: nil. - fontDescription1 setGlyphs: (array at: 2) mapping: nil. - "fontDescription setKernPairs: kernPairs." - result := OrderedCollection new. - (encodingTag = nil or: [encodingTag = 0]) ifTrue: [^ Array with: fontDescription1]. - result add: fontDescription0. - encodingTag -1 timesRepeat: [result add: nil]. - result add: fontDescription1. - ^ result asArray. - - ! Item was removed: - ----- Method: TTCFontReader>>readTTFFrom: (in category 'as yet unclassified') ----- - readTTFFrom: aStream - - "Read the raw font byte data" - | fontData | - (aStream respondsTo: #binary) ifTrue:[aStream binary]. - fontData := aStream contents asByteArray. - fontDescription := TTCFontDescription new. - - ^ self readFrom: fontData fromOffset: 0 at: EncodingTag. - ! Item was removed: - AbstractFont subclass: #TTCFontSet - instanceVariableNames: 'name fontArray foregroundColor' - classVariableNames: 'Registry' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: TTCFontSet class>>discardDefault (in category 'as yet unclassified') ----- - discardDefault - " - self discardDefault - " - | ttc | - ttc := TTCFontDescription default. - ttc ifNotNil: [ - TextConstants removeKey: ttc name asSymbol ifAbsent: []. - ].! Item was removed: - ----- Method: TTCFontSet class>>familyName:pointSize: (in category 'as yet unclassified') ----- - familyName: n pointSize: s - - "(self familyName: 'MultiMSGothic' pointSize: 14) pointSize" - | 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]. - index := 2. - [index <= t size and: [(t at: index) pointSize <= s]] whileTrue: [ - ret := t at: index. - index := index + 1. - ]. - ^ ret. - ]. - ^ (TextStyle named: n) addNewFontSize: s.! Item was removed: - ----- Method: TTCFontSet class>>initialize (in category 'as yet unclassified') ----- - initialize - " - self initialize - " - - | tt | - tt := TTCFontDescription default. - tt ifNotNil: [self newTextStyleFromTT: tt]. - ! Item was removed: - ----- Method: TTCFontSet class>>newFontArray: (in category 'as yet unclassified') ----- - newFontArray: anArray - - ^super new initializeWithFontArray: anArray - ! Item was removed: - ----- Method: TTCFontSet class>>newTextStyleFromTT: (in category 'as yet unclassified') ----- - newTextStyleFromTT: descriptionArray - - | array textStyle styleName arrayOfArray | - - arrayOfArray := self pointSizes collect: [:pt | - descriptionArray collect: [:ttc | | f | - ttc ifNil: [nil] ifNotNil: [ - f := (ttc size > 256) - ifTrue: [MultiTTCFont new initialize] - ifFalse: [TTCFont new initialize]. - f ttcDescription: ttc. - f pointSize: pt. - ]. - ]. - ]. - - array := arrayOfArray collect: [:fonts | - self newFontArray: fonts. - ]. - - styleName := (array at: 1) familyName asSymbol. - textStyle := TextStyle fontArray: array. - TextConstants at: styleName put: textStyle. - - self register: array at: styleName. - - ^ TextConstants at: styleName. - ! Item was removed: - ----- Method: TTCFontSet class>>newTextStyleFromTTFile: (in category 'as yet unclassified') ----- - newTextStyleFromTTFile: fileName - " - TTCFontReader encodingTag: JapaneseEnvironment leadingChar. - self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\msmincho.TTC' - - TTCFontReader encodingTag: 0. - self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\symbol.ttf' - " - - | description | - description := TTCFontDescription addFromTTFile: fileName. - ^ self newTextStyleFromTT: description. - ! Item was removed: - ----- Method: TTCFontSet class>>pointSizes (in category 'as yet unclassified') ----- - pointSizes - - ^ TTCFont pointSizes. - ! Item was removed: - ----- Method: TTCFontSet class>>register:at: (in category 'as yet unclassified') ----- - register: anObject at: symbolName - - self registry at: symbolName put: anObject. - ! Item was removed: - ----- Method: TTCFontSet class>>registry (in category 'as yet unclassified') ----- - registry - ^ Registry - ifNil: [Registry := IdentityDictionary new]! Item was removed: - ----- Method: TTCFontSet class>>removeStyleName: (in category 'as yet unclassified') ----- - removeStyleName: aString - - | style symName | - symName := aString asSymbol. - style := TextConstants removeKey: symName ifAbsent: []. - style ifNotNil: [self unregister: symName]. - TTCFontDescription removeDescriptionNamed: aString asString. - ! Item was removed: - ----- Method: TTCFontSet class>>setDefault (in category 'as yet unclassified') ----- - setDefault - " - self setDefault - " - | tt | - tt := TTCFontDescription default. - tt ifNil: [TTCFontDescription setDefault]. - tt := TTCFontDescription default. - tt ifNotNil: [self newTextStyleFromTT: tt]. - ! Item was removed: - ----- Method: TTCFontSet class>>unregister: (in category 'as yet unclassified') ----- - unregister: symbolName - - self registry removeKey: symbolName ifAbsent: []. - ! Item was removed: - ----- Method: TTCFontSet>>ascent (in category 'accessing') ----- - ascent - - ^ (fontArray at: 1) ascent. - ! Item was removed: - ----- Method: TTCFontSet>>ascentOf: (in category 'accessing') ----- - ascentOf: aCharacter - - ^ fontArray first ascentOf: aCharacter. - ! Item was removed: - ----- Method: TTCFontSet>>baseKern (in category 'accessing') ----- - baseKern - - ^ 0. - ! Item was removed: - ----- Method: TTCFontSet>>depth (in category 'accessing') ----- - depth - - ^ (fontArray at: 1) depth. - ! Item was removed: - ----- Method: TTCFontSet>>descent (in category 'accessing') ----- - descent - - ^ (fontArray at: 1) descent. - ! Item was removed: - ----- Method: TTCFontSet>>descentKern (in category 'accessing') ----- - descentKern - - ^ 0. - ! Item was removed: - ----- Method: TTCFontSet>>descentOf: (in category 'accessing') ----- - descentOf: aChar - - ^ fontArray first descentOf: aChar - ! Item was removed: - ----- Method: TTCFontSet>>displayString:on:from:to:at:kern: (in category 'displaying') ----- - 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 removed: - ----- Method: TTCFontSet>>displayString:on:from:to:at:kern:baselineY: (in category 'displaying') ----- - displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY - - | destPoint font form encoding glyphInfo char charCode destY | - destPoint := aPoint. - glyphInfo := Array new: 5. - startIndex to: stopIndex do: [:charIndex | - char := aString at: charIndex. - encoding := char leadingChar + 1. - charCode := char charCode. - font := fontArray at: encoding. - ((charCode between: font minAscii and: font maxAscii) not) ifTrue: [ - charCode := font maxAscii]. - self glyphInfoOf: char into: glyphInfo. - form := glyphInfo first. - (glyphInfo fifth ~= aBitBlt lastFont) ifTrue: [ - glyphInfo fifth installOn: aBitBlt. - ]. - destY := baselineY - glyphInfo fourth. - aBitBlt - sourceForm: form; - destX: destPoint x; - destY: destY; - sourceOrigin: 0 @ 0; - width: form width; - height: form height; - copyBits. - destPoint := destPoint x + (form width + kernDelta) @ destPoint y. - ]. - ^ destPoint. - ! Item was removed: - ----- Method: TTCFontSet>>displayStringR2L:on:from:to:at:kern: (in category 'displaying') ----- - displayStringR2L: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta - - | destPoint font form encoding char charCode glyphInfo | - destPoint := aPoint. - glyphInfo := Array new: 5. - startIndex to: stopIndex do: [:charIndex | - char := aString at: charIndex. - encoding := char leadingChar + 1. - charCode := char charCode. - font := fontArray at: encoding. - ((charCode between: font minAscii and: font maxAscii) not) ifTrue: [ - charCode := font maxAscii]. - self glyphInfoOf: char into: glyphInfo. - form := glyphInfo first. - (glyphInfo size > 4 and: [glyphInfo fifth notNil and: [glyphInfo fifth ~= aBitBlt lastFont]]) ifTrue: [ - glyphInfo fifth installOn: aBitBlt. - ]. - aBitBlt - sourceForm: form; - destX: destPoint x - form width; - destY: destPoint y; - sourceOrigin: 0 @ 0; - width: form width; - height: form height; - copyBits. - destPoint := destPoint x - (form width + kernDelta) @ destPoint y. - ]. - ! Item was removed: - ----- Method: TTCFontSet>>emphasis (in category 'accessing') ----- - emphasis - ^ fontArray first emphasis! Item was removed: - ----- Method: TTCFontSet>>emphasized: (in category 'accessing') ----- - emphasized: code - - ! Item was removed: - ----- Method: TTCFontSet>>familyName (in category 'accessing') ----- - familyName - - ^ 'Multi', (fontArray at: 1) familyName. - ! Item was removed: - ----- Method: TTCFontSet>>familySizeFace (in category 'accessing') ----- - familySizeFace - - ^ Array - with: fontArray first name - with: self height - with: 0. - ! Item was removed: - ----- Method: TTCFontSet>>fontArray (in category 'accessing') ----- - fontArray - - ^ fontArray - ! Item was removed: - ----- Method: TTCFontSet>>glyphInfoOf:into: (in category 'private') ----- - glyphInfoOf: aCharacter into: glyphInfoArray - - | index f code | - index := aCharacter leadingChar + 1. - fontArray size < index ifTrue: [^ self questionGlyphInfoInto: glyphInfoArray]. - (f := fontArray at: index) ifNil: [^ self questionGlyphInfoInto: glyphInfoArray]. - - code := aCharacter charCode. - ((code between: f minAscii and: f maxAscii) not) ifTrue: [ - ^ self questionGlyphInfoInto: glyphInfoArray. - ]. - f glyphInfoOf: aCharacter into: glyphInfoArray. - glyphInfoArray at: 5 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- Method: TTCFontSet>>height (in category 'accessing') ----- - height - - ^fontArray first pixelSize. - ! Item was removed: - ----- Method: TTCFontSet>>initializeWithFontArray: (in category 'as yet unclassified') ----- - initializeWithFontArray: anArray - - fontArray := anArray. - "name := anArray first name." - ! Item was removed: - ----- Method: TTCFontSet>>installOn: (in category 'as yet unclassified') ----- - installOn: aDisplayContext - - ^aDisplayContext installTTCFont: self. - ! Item was removed: - ----- Method: TTCFontSet>>installOn:foregroundColor:backgroundColor: (in category 'as yet unclassified') ----- - installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor - - foregroundColor := fgColor. - fontArray do: [:s | s ifNotNil: [s installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor]]. - ! Item was removed: - ----- Method: TTCFontSet>>isFontSet (in category 'testing') ----- - isFontSet - - ^ true. - ! Item was removed: - ----- Method: TTCFontSet>>isTTCFont (in category 'testing') ----- - isTTCFont - ^true! Item was removed: - ----- Method: TTCFontSet>>lineGrid (in category 'accessing') ----- - lineGrid - - ^ fontArray first lineGrid. - ! Item was removed: - ----- Method: TTCFontSet>>maxAsciiFor: (in category 'accessing') ----- - maxAsciiFor: encoding - - | f | - f := (fontArray at: encoding+1). - f ifNotNil: [^ f maxAscii]. - ^ 0. - ! Item was removed: - ----- Method: TTCFontSet>>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: #TTCFontSet selector: #familyName:pointSize: - args: {self familyName. self pointSize}. - refStrm replace: self with: dp. - ^ dp. - ! Item was removed: - ----- Method: TTCFontSet>>pointSize (in category 'accessing') ----- - pointSize - - ^ fontArray first pixelSize * 72 // 96. - ! Item was removed: - ----- Method: TTCFontSet>>pointSizes (in category 'accessing') ----- - pointSizes - - ^ self class pointSizes. - ! Item was removed: - ----- Method: TTCFontSet>>questionGlyphInfoInto: (in category 'private') ----- - questionGlyphInfoInto: glyphInfoArray - - | f form | - f := fontArray at: 1. - form := f formOf: $?. - glyphInfoArray at: 1 put: form; - at: 2 put: 0; - at: 3 put: form width; - at: 4 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- Method: TTCFontSet>>textStyle (in category 'accessing') ----- - textStyle - - ^ TextStyle actualTextStyles - detect: [:aStyle | (aStyle fontArray collect: [:s | s name]) includes: self name] - ifNone: []. - ! Item was removed: - ----- Method: TTCFontSet>>ttcDescription (in category 'as yet unclassified') ----- - ttcDescription - ^ fontArray first ttcDescription! Item was removed: - ----- Method: TTCFontSet>>widthOf: (in category 'measuring') ----- - widthOf: aCharacter - - | encoding | - encoding := aCharacter leadingChar. - ^ (fontArray at: encoding + 1) widthOf: aCharacter. - !
1
0
0
0
The Trunk: Multilingual-fbs.163.mcz
by commitsï¼ source.squeak.org
02 Jul '13
02 Jul '13
Frank Shearar uploaded a new version of Multilingual to project The Trunk:
http://source.squeak.org/trunk/Multilingual-fbs.163.mcz
==================== Summary ==================== Name: Multilingual-fbs.163 Author: fbs Time: 2 July 2013, 8:21:22.262 pm UUID: 9f8b3b97-0255-d848-8146-56a618db9aa2 Ancestors: Multilingual-fbs.162 Break the Multilingual <-> TrueType cyclic dependency by moving TTC (TrueType Collection) classes to TrueType and FixedFaceFont to Graphics-Fonts (because this concerns displaying fonts). =============== Diff against Multilingual-fbs.162 =============== Item was removed: - AbstractFont subclass: #FixedFaceFont - instanceVariableNames: 'baseFont substitutionCharacter displaySelector' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Display'! - - !FixedFaceFont commentStamp: 'tak 12/22/2004 01:45' prior: 0! - I am a font for special purpose like password or fallback. - I can show same form whenever someone requests any character. - - Variable displaySelector is future use to show a form dynamically. - (Although it would be unnecessary...)! Item was removed: - ----- Method: FixedFaceFont>>ascent (in category 'accessing') ----- - ascent - ^baseFont ascent! Item was removed: - ----- Method: FixedFaceFont>>ascentOf: (in category 'accessing') ----- - ascentOf: aCharacter - ^ self ascent! Item was removed: - ----- Method: FixedFaceFont>>baseFont (in category 'accessing') ----- - baseFont - ^baseFont! Item was removed: - ----- Method: FixedFaceFont>>baseFont: (in category 'accessing') ----- - baseFont: aFont - baseFont := aFont! Item was removed: - ----- Method: FixedFaceFont>>baseKern (in category 'accessing') ----- - baseKern - ^baseFont baseKern! Item was removed: - ----- Method: FixedFaceFont>>characterFormAt: (in category 'accessing') ----- - characterFormAt: character - ^ baseFont characterFormAt: substitutionCharacter! Item was removed: - ----- Method: FixedFaceFont>>descent (in category 'accessing') ----- - descent - ^baseFont descent! Item was removed: - ----- Method: FixedFaceFont>>descentKern (in category 'accessing') ----- - descentKern - ^baseFont descentKern! Item was removed: - ----- Method: FixedFaceFont>>descentOf: (in category 'accessing') ----- - descentOf: aCharacter - ^ self descent! Item was removed: - ----- Method: FixedFaceFont>>displayErrorOn:length:at:kern: (in category 'displaying') ----- - displayErrorOn: aCanvas length: length at: aPoint kern: kernDelta - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta! Item was removed: - ----- Method: FixedFaceFont>>displayErrorOn:length:at:kern:baselineY: (in category 'displaying') ----- - displayErrorOn: aCanvas length: length at: aPoint kern: kernDelta baselineY: baselineY - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta - baselineY: baselineY! Item was removed: - ----- Method: FixedFaceFont>>displayPasswordOn:length:at:kern: (in category 'displaying') ----- - displayPasswordOn: aCanvas length: length at: aPoint kern: kernDelta - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta! Item was removed: - ----- Method: FixedFaceFont>>displayPasswordOn:length:at:kern:baselineY: (in category 'displaying') ----- - displayPasswordOn: aCanvas length: length at: aPoint kern: kernDelta baselineY: baselineY - | maskedString | - maskedString := String new: length. - maskedString atAllPut: substitutionCharacter. - ^ baseFont - displayString: maskedString - on: aCanvas - from: 1 - to: length - at: aPoint - kern: kernDelta - baselineY: baselineY! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern: (in category 'displaying') ----- - displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta - | size | - size := stopIndex - startIndex + 1. - ^ self perform: displaySelector withArguments: (Array with: aDisplayContext with: size with: aPoint with: kernDelta with: aPoint y + self ascent).! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern:baselineY: (in category 'displaying') ----- - displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY - | size | - size := stopIndex - startIndex + 1. - ^ self perform: displaySelector withArguments: (Array with: aDisplayContext with: size with: aPoint with: kernDelta with: baselineY).! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern:from: (in category 'displaying') ----- - displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont - | destPoint | - destPoint := self - displayString: aString - on: aBitBlt - from: startIndex - to: stopIndex - at: aPoint - kern: kernDelta. - ^ Array with: stopIndex + 1 with: destPoint! Item was removed: - ----- Method: FixedFaceFont>>displayString:on:from:to:at:kern:from:baselineY: (in category 'displaying') ----- - displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta from: fromFont baselineY: baselineY - | destPoint | - destPoint := self - displayString: aString - on: aBitBlt - from: startIndex - to: stopIndex - at: aPoint - kern: kernDelta - baselineY: baselineY. - ^destPoint! Item was removed: - ----- Method: FixedFaceFont>>emphasized: (in category 'accessing') ----- - emphasized: emph - ^self class new baseFont: (baseFont emphasized: emph)! Item was removed: - ----- Method: FixedFaceFont>>errorFont (in category 'initialize-release') ----- - errorFont - displaySelector := #displayErrorOn:length:at:kern:baselineY:. - substitutionCharacter := $?.! Item was removed: - ----- Method: FixedFaceFont>>familyName (in category 'accessing') ----- - familyName - ^baseFont familyName, '-pw'! Item was removed: - ----- Method: FixedFaceFont>>fontSize: (in category 'accessing') ----- - fontSize: aNumber - self baseFont: (StrikeFont familyName: baseFont familyName size: aNumber) copy! Item was removed: - ----- Method: FixedFaceFont>>glyphInfoOf:into: (in category 'private') ----- - glyphInfoOf: aCharacter into: glyphInfoArray - - ^ baseFont glyphInfoOf: substitutionCharacter into: glyphInfoArray. - ! Item was removed: - ----- Method: FixedFaceFont>>height (in category 'accessing') ----- - height - ^baseFont height! Item was removed: - ----- Method: FixedFaceFont>>initialize (in category 'initialize-release') ----- - initialize - "This used to be the default textstyle, but it needs to be a StrikeFont and not a TTCFont and sometimes the default textstyle is a TTCFont. So, we use a typical StrikeFont as the default fallback font." - baseFont := StrikeFont defaultSized: 12. - self passwordFont! Item was removed: - ----- Method: FixedFaceFont>>installOn:foregroundColor:backgroundColor: (in category 'displaying') ----- - installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor - ^baseFont installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor! Item was removed: - ----- Method: FixedFaceFont>>lineGrid (in category 'accessing') ----- - lineGrid - ^baseFont lineGrid! Item was removed: - ----- Method: FixedFaceFont>>maxAscii (in category 'accessing') ----- - maxAscii - ^ SmallInteger maxVal! Item was removed: - ----- Method: FixedFaceFont>>passwordCharacter (in category 'accessing') ----- - passwordCharacter - ^$*! Item was removed: - ----- Method: FixedFaceFont>>passwordFont (in category 'initialize-release') ----- - passwordFont - displaySelector := #displayPasswordOn:length:at:kern:baselineY:. - substitutionCharacter := $*! Item was removed: - ----- Method: FixedFaceFont>>pointSize (in category 'accessing') ----- - pointSize - ^baseFont pointSize! Item was removed: - ----- Method: FixedFaceFont>>releaseCachedState (in category 'caching') ----- - releaseCachedState - baseFont releaseCachedState.! Item was removed: - ----- Method: FixedFaceFont>>widthOf: (in category 'measuring') ----- - widthOf: aCharacter - ^ baseFont widthOf: substitutionCharacter! Item was removed: - TTCFont subclass: #LinedTTCFont - instanceVariableNames: 'emphasis lineGlyph contourWidth' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: LinedTTCFont class>>fromTTCFont:emphasis: (in category 'as yet unclassified') ----- - fromTTCFont: aTTCFont emphasis: code - - | inst | - inst := self new. - inst ttcDescription: aTTCFont ttcDescription. - inst pointSize: aTTCFont pointSize. - inst emphasis: (aTTCFont emphasis bitOr: code). - inst lineGlyph: (aTTCFont ttcDescription at: $_). - - ^ inst. - ! Item was removed: - ----- Method: LinedTTCFont>>computeForm: (in category 'as yet unclassified') ----- - computeForm: char - - | ttGlyph scale | - - char = Character tab ifTrue: [^ super computeForm: char]. - - "char = $U ifTrue: [self doOnlyOnce: [self halt]]." - scale := self pixelSize asFloat / (ttcDescription ascender - ttcDescription descender). - ttGlyph := ttcDescription at: char. - ^ ttGlyph asFormWithScale: scale ascender: ttcDescription ascender descender: ttcDescription descender fgColor: foregroundColor bgColor: Color transparent depth: self depth replaceColor: false lineGlyph: lineGlyph lingGlyphWidth: contourWidth emphasis: emphasis! Item was removed: - ----- Method: LinedTTCFont>>emphasis (in category 'as yet unclassified') ----- - emphasis - - ^ emphasis. - ! Item was removed: - ----- Method: LinedTTCFont>>emphasis: (in category 'as yet unclassified') ----- - emphasis: code - - emphasis := code. - ! Item was removed: - ----- Method: LinedTTCFont>>lineGlyph: (in category 'as yet unclassified') ----- - lineGlyph: aGlyph - - lineGlyph := aGlyph. - contourWidth := aGlyph calculateWidth. - ! Item was removed: - TTCFont subclass: #MultiTTCFont - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: MultiTTCFont class>>cacheAllNil (in category 'as yet unclassified') ----- - cacheAllNil - " - self cacheAllNil - " - self allInstances do: [:inst | - inst cache do: [:e | - e third ifNotNil: [^ false]. - ]. - ]. - - ^ true. - ! Item was removed: - ----- Method: MultiTTCFont>>access:at: (in category 'as yet unclassified') ----- - access: char at: index - - | wcache entry | - wcache := self cache. - entry := wcache at: index. - wcache replaceFrom: index to: wcache size - 1 with: wcache startingAt: index + 1. - wcache at: wcache size put: entry. - ! Item was removed: - ----- Method: MultiTTCFont>>at:put: (in category 'as yet unclassified') ----- - at: char put: form - - | wcache | - wcache := self cache. - wcache replaceFrom: 1 to: wcache size - 1 with: wcache startingAt: 2. - wcache at: wcache size - put: (Array with: char asciiValue with: foregroundColor with: form). - ^form - ! Item was removed: - ----- Method: MultiTTCFont>>formOf: (in category 'as yet unclassified') ----- - formOf: char - - | newForm | - self hasCached: char ifTrue: [:form :index | - self access: char at: index. - ^ form. - ]. - - newForm := self computeForm: char. - self at: char put: newForm. - ^ newForm. - ! Item was removed: - ----- Method: MultiTTCFont>>glyphInfoOf:into: (in category 'as yet unclassified') ----- - glyphInfoOf: char into: glyphInfoArray - - | newForm | - self hasCached: char ifTrue: [:form :index | - self access: char at: index. - glyphInfoArray at: 1 put: form; - at: 2 put: 0; - at: 3 put: form width; - at: 4 put: (self ascentOf: char); - at: 5 put: self. - ^ glyphInfoArray. - ]. - - newForm := self computeForm: char. - self at: char put: newForm. - - glyphInfoArray at: 1 put: newForm; - at: 2 put: 0; - at: 3 put: newForm width; - at: 4 put: (self ascentOf: char); - at: 5 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- Method: MultiTTCFont>>hasCached:ifTrue: (in category 'as yet unclassified') ----- - hasCached: char ifTrue: twoArgBlock - - | value elem | - value := char asciiValue. - - self cache size to: 1 by: -1 do: [:i | - elem := self cache at: i. - (elem first = value and: [elem second = foregroundColor]) ifTrue: [ - ^ twoArgBlock value: elem third value: i. - ]. - ]. - ^ false. - ! Item was removed: - ----- Method: MultiTTCFont>>isTTCFont (in category 'as yet unclassified') ----- - isTTCFont - ^true! Item was removed: - ----- Method: MultiTTCFont>>widthOf: (in category 'as yet unclassified') ----- - widthOf: char - - "This method cannot use #formOf: because formOf: discriminates the color and causes unnecessary bitmap creation." - - | newForm | - self hasCached: char ifTrue: [:form :index | - self access: char at: index. - ^ form width. - ]. - - newForm := self computeForm: char. - self at: char put: newForm. - ^ newForm width. - - ! Item was removed: - AbstractFont subclass: #TTCFont - instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont height ascent descent maxAscii colorToCacheMap' - classVariableNames: 'GlyphCacheData GlyphCacheIndex GlyphCacheReady GlyphCacheSize NamesToIndexes Registry Scale ShutdownList' - 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 removed: - ----- Method: TTCFont class>>classVersion (in category 'objects from disk') ----- - classVersion - "Version 0 had pixelSize; version 1 changed it to pointSize" - ^1! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: TTCFont class>>fileReaderServicesForFile:suffix: (in category 'file list services') ----- - fileReaderServicesForFile: fullName suffix: suffix - ^(suffix = 'ttf') | (suffix = '*') - ifTrue: [ self services ] - ifFalse: [ #() ]! Item was removed: - ----- Method: TTCFont class>>getExistings: (in category 'instance creation') ----- - getExistings: fontArray - - | result em | - result := OrderedCollection new. - result add: fontArray. - 1 to: 3 do: [:i | - em := (fontArray collect: [:f | f emphasized: i]). - (em at: 1) ~= (fontArray at: 1) ifTrue: [ - result add: em. - ]. - ]. - ^ result asArray. - ! Item was removed: - ----- 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 ifNotNil: [self newTextStyleFromTT: tt]. - FileServices registerFileReader: self. - - Smalltalk addToShutDownList: self.! Item was removed: - ----- Method: TTCFont class>>isCacheAllNil (in category 'other') ----- - isCacheAllNil - " - self cacheAllNil - " - self allInstances do: [:inst | - inst cache do: [:e | - e ifNotNil: [^ false]. - ]. - ]. - - ^ true. - ! Item was removed: - ----- Method: TTCFont class>>newTextStyleFromTT: (in category 'instance creation') ----- - newTextStyleFromTT: description - "Create a new TextStyle from specified TTFontDescription instance." - - | array | - array := self pointSizes collect: - [:pt | | f | - f := self new. - f ttcDescription: description. - f pointSize: pt]. - ^self reorganizeForNewFontArray: array name: array first name asSymbol! Item was removed: - ----- 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. - ^ self newTextStyleFromTT: description. - ! Item was removed: - ----- Method: TTCFont class>>newTextStyleFromTTStream: (in category 'instance creation') ----- - newTextStyleFromTTStream: readStream - " - " - - | description | - description := TTFontDescription addFromTTStream: readStream. - ^ self newTextStyleFromTT: description. - ! Item was removed: - ----- Method: TTCFont class>>pointSizes (in category 'other') ----- - pointSizes - - "The default sizes that are created when a TextStyle is created. You can add new sizes by the new-size feature." - ^ #(9 12 15 24 36). - ! Item was removed: - ----- Method: TTCFont class>>recreateCache (in category 'other') ----- - recreateCache - " - self recreateCache. - " - self allSubInstances do: [:inst | inst flushCache]. - Smalltalk garbageCollect. - ! Item was removed: - ----- Method: TTCFont class>>register:at: (in category 'other') ----- - register: anObject at: symbolName - - self registry at: symbolName put: anObject. - ! Item was removed: - ----- Method: TTCFont class>>registerAll (in category 'other') ----- - registerAll - " - TTCFont registerAll - " - - TextStyle allInstancesDo: [:e | - (e fontArray first isMemberOf: TTCFont) ifTrue: [ - self register: e fontArray at: e fontArray first familyName asSymbol. - ]. - ]. - ! Item was removed: - ----- Method: TTCFont class>>registry (in category 'other') ----- - registry - ^ Registry - ifNil: [Registry := IdentityDictionary new] - ! Item was removed: - ----- Method: TTCFont class>>removeAllDerivatives (in category 'other') ----- - removeAllDerivatives - " - self removeAllDerivatives - " - - self allInstances do: [:s | - s textStyle ifNotNil: [ - s textStyle fontArray do: [:f | - f derivativeFont: nil at: 0. - ]. - ]. - ]. - ! Item was removed: - ----- Method: TTCFont class>>removeStyleName: (in category 'other') ----- - removeStyleName: aString - - TextConstants removeKey: aString asSymbol ifAbsent: []. - TTFontDescription removeDescriptionNamed: aString asString. - ! Item was removed: - ----- 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 isTTCStyle ifFalse: [ - 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]. - - 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 ifNotNil: [ r derivativeFont: f ]. - ]. - ]. - ]. - - style newFontArray: regular. - self register: regular at: styleName. - self recreateCache. - ^ style. - ! Item was removed: - ----- Method: TTCFont class>>repairDerivativeFonts (in category 'other') ----- - repairDerivativeFonts - "Fix the cases where the derivatives are a different size than the originals." - - " - TTCFont repairDerivativeFonts. - " - self allInstancesDo: [ :font | font pointSize: font pointSize ]. - Preferences refreshFontSettings.! Item was removed: - ----- 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' - selector: #newTextStyleFromTTFile: - description: 'install a true type font as a text style' - buttonLabel: 'install ttf'! Item was removed: - ----- Method: TTCFont class>>services (in category 'file list services') ----- - services - "Return a set of services for use in FileList" - - ^ Array with: self serviceInstallTrueTypeFontStyle! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: TTCFont class>>unload (in category 'class initialization') ----- - unload - - FileServices unregisterFileReader: self! Item was removed: - ----- Method: TTCFont class>>unregister: (in category 'other') ----- - unregister: symbolName - - self registry removeKey: symbolName ifAbsent: []. - ! Item was removed: - ----- Method: TTCFont class>>version (in category 'other') ----- - version - - ^ '6.0'. - ! Item was removed: - ----- Method: TTCFont>>addLined (in category 'private') ----- - addLined - - self addLined: self. - self derivativeFonts do: [:e | - e ifNotNil: [self addLined: e]. - ]. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>ascent (in category 'accessing') ----- - ascent - ^ascent ifNil:[ascent := (ttcDescription typographicAscender * self pixelScale) truncated].! Item was removed: - ----- Method: TTCFont>>ascentOf: (in category 'accessing') ----- - ascentOf: aCharacter - - " (self hasGlyphFor: aCharacter) ifFalse: [ - fallbackFont ifNotNil: [ - ^ fallbackFont ascentOf: aCharacter. - ]. - ]. - " - ^ self ascent. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>cache (in category 'friend') ----- - cache - ^cache! Item was removed: - ----- Method: TTCFont>>characterFormAt: (in category 'character shapes') ----- - characterFormAt: character - "Answer a Form copied out of the glyphs for the argument, - character. Use a cached copy if possible." - - ^self formOf: character! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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. - ]. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm.! Item was removed: - ----- Method: TTCFont>>copy (in category 'copying') ----- - copy - - ^ self. - ! Item was removed: - ----- Method: TTCFont>>deepCopy (in category 'copying') ----- - deepCopy - - ^ self. - ! Item was removed: - ----- Method: TTCFont>>depth (in category 'public') ----- - depth - - ^ 32. - ! Item was removed: - ----- 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 removed: - ----- 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>>derivativeFont:mainFont: (in category 'initialize') ----- - derivativeFont: aNewlyCreatedDerivativeFont mainFont: aMainFont - - self derivativeFont: aNewlyCreatedDerivativeFont at: aMainFont emphasis. - aNewlyCreatedDerivativeFont emphasis: aMainFont emphasis. - aNewlyCreatedDerivativeFont lineGlyph: (aMainFont ttcDescription at: $_).! Item was removed: - ----- Method: TTCFont>>derivativeFontArray (in category 'friend') ----- - derivativeFontArray - - ^ derivatives. - ! Item was removed: - ----- Method: TTCFont>>derivativeFonts (in category 'friend') ----- - derivativeFonts - - derivatives ifNil: [^ #()]. - ^derivatives copyWithout: nil! Item was removed: - ----- 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 := self height - self ascent]. - ! Item was removed: - ----- Method: TTCFont>>descentKern (in category 'accessing') ----- - descentKern - - ^ 0. - ! Item was removed: - ----- Method: TTCFont>>descentOf: (in category 'accessing') ----- - descentOf: aCharacter - - " (self hasGlyphFor: aCharacter) ifFalse: [ - fallbackFont ifNotNil: [ - ^ fallbackFont descentOf: aCharacter. - ]. - ]." - ^ self descent. - ! Item was removed: - ----- 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 removed: - ----- 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. - aBitBlt sourceX: hereX; sourceY: 0. - aBitBlt width: nextX - hereX. - aBitBlt height: form height. - aBitBlt copyBits. - destX := destX + (nextX - hereX) + kernDelta. - ]. - ^ destX @ destY - ! Item was removed: - ----- Method: TTCFont>>emphasis (in category 'accessing') ----- - emphasis - "Answer the emphasis code (0 to 3) corresponding to my subfamily name" - ^self indexOfSubfamilyName: self subfamilyName - - ! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: TTCFont>>fallbackFont (in category 'accessing') ----- - fallbackFont - "Answers the fallbackFont for the receiver. The fallback font must be some derivative of the receiver since it will not be asked to install itself properly on the target BitBlt so rendering a completely different font here is simply not possible. The default implementation uses a synthetic font that maps all characters to question marks." - ^ fallbackFont - ifNil: [fallbackFont := FixedFaceFont new errorFont baseFont: self]! Item was removed: - ----- Method: TTCFont>>fallbackFont: (in category 'accessing') ----- - fallbackFont: aFontSetOrNil - - aFontSetOrNil == self - ifTrue:[^ self error: 'Invalid fallback font']. - - fallbackFont := aFontSetOrNil. - ! Item was removed: - ----- Method: TTCFont>>familyName (in category 'accessing') ----- - familyName - - ^ ttcDescription name. - ! Item was removed: - ----- Method: TTCFont>>familySizeFace (in category 'accessing') ----- - familySizeFace - - ^ Array - with: self familyName - with: self height - with: 0. - ! Item was removed: - ----- Method: TTCFont>>flushCache (in category 'initialize') ----- - flushCache - "Flush the cache of this font" - cache := foregroundColor := colorToCacheMap := nil.! Item was removed: - ----- Method: TTCFont>>flushCachedValues (in category 'private') ----- - flushCachedValues - "Flush all values computed from ttcDescription and cached for speed" - "TTCFont allInstancesDo:[:font| font flushCachedValues]" - height := ascent := descent := nil.! Item was removed: - ----- Method: TTCFont>>fontNameWithPointSize (in category 'accessing') ----- - fontNameWithPointSize - ^ self name withoutTrailingDigits , ' ' , self pointSize printString! Item was removed: - ----- Method: TTCFont>>foregroundColor (in category 'public') ----- - foregroundColor - - ^ foregroundColor. - ! Item was removed: - ----- 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 removed: - ----- 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 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 removed: - ----- 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. - glyphInfoArray at: 1 put: form; - at: 2 put: 0; - at: 3 put: form width; - at: 4 put: ascent "(self ascentOf: aCharacter)"; - at: 5 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- 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]! Item was removed: - ----- Method: TTCFont>>height (in category 'accessing') ----- - height - "Answer my height in pixels. This will answer a Float." - ^height ifNil:[height := self pixelSize + self lineGap]! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>indexOfSubfamilyName: (in category 'private') ----- - indexOfSubfamilyName: aName - | decoded | - - "decodeStyleName will consume all the modifiers and leave nothing if everything was recognized." - decoded := TextStyle decodeStyleName: aName. - decoded second isEmpty ifTrue: [ ^decoded first ]. - - "If you get a halt here - please add the missing synonym to the lookup table in TextStyle>>decodeStyleName: ." - - self error: 'please add the missing synonym ', aName, ' to the lookup table in TextStyle>>decodeStyleName:'. - - ^0.! Item was removed: - ----- Method: TTCFont>>initialize (in category 'friend') ----- - initialize - - foregroundColor := Color black. - ! Item was removed: - ----- Method: TTCFont>>initialize: (in category 'initialize') ----- - initialize: aFont - - self initialize. - self ttcDescription: aFont ttcDescription. - ! Item was removed: - ----- Method: TTCFont>>installOn: (in category 'friend') ----- - installOn: aDisplayContext - - ^aDisplayContext installTTCFont: self. - ! Item was removed: - ----- Method: TTCFont>>installOn:foregroundColor:backgroundColor: (in category 'friend') ----- - installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor - self foregroundColor: fgColor. "install color" - aDisplayContext installTTCFont: self foregroundColor: foregroundColor backgroundColor: bgColor - ! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: TTCFont>>isTTCFont (in category 'testing') ----- - isTTCFont - ^true! Item was removed: - ----- Method: TTCFont>>lineGap (in category 'accessing') ----- - lineGap - "Answer the line gap from the ttf description" - ^self pixelSize * ttcDescription typographicLineGap // - (ttcDescription typographicAscender - ttcDescription typographicDescender)! Item was removed: - ----- Method: TTCFont>>lineGlyph: (in category 'initialize') ----- - lineGlyph: ignore - ^self! Item was removed: - ----- Method: TTCFont>>lineGrid (in category 'accessing') ----- - lineGrid - "Answer the relative space between lines" - ^ self ascent + self descent! Item was removed: - ----- 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].! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>name (in category 'accessing') ----- - name - - ^ ttcDescription name. - ! Item was removed: - ----- 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: - args: {self familyName. self pointSize. self emphasis}. - refStrm replace: self with: dp. - ^ dp. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>pixelScale (in category 'accessing') ----- - pixelScale - "Answer the scale factor to convert from the truetype's units into the receiver's pixel size. The scale for a font is computed by *excluding* the linegap (leading) in the font. Consequently, the height of the font (including linegap/leading) will be larger than the pixel size." - ^self pixelSize asFloat / - (ttcDescription typographicAscender - - ttcDescription typographicLineGap - - ttcDescription typographicDescender)! Item was removed: - ----- Method: TTCFont>>pixelSize (in category 'accessing') ----- - pixelSize - "Make sure that we don't return a Fraction" - ^(TextStyle pointsToPixels: pointSize) truncated! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>pointSize (in category 'accessing') ----- - pointSize - - ^ pointSize. - ! Item was removed: - ----- Method: TTCFont>>pointSize: (in category 'accessing') ----- - pointSize: aNumber - - self privatePointSize: aNumber. - derivatives ifNotNil: [ derivatives do: [ :f | f ifNotNil: [ f privatePointSize: aNumber ]]]. - ! Item was removed: - ----- Method: TTCFont>>printOn: (in category 'printing') ----- - printOn: aStream - aStream nextPutAll: 'TTCFont('; - nextPutAll: self familyName; space; - print: self pointSize; space; - nextPutAll: self subfamilyName; - nextPut: $)! Item was removed: - ----- Method: TTCFont>>privatePointSize: (in category 'accessing') ----- - privatePointSize: aNumber - pointSize = aNumber - ifFalse: [pointSize := aNumber. - self flushCache]! Item was removed: - ----- Method: TTCFont>>releaseCachedState (in category 'caching') ----- - releaseCachedState - self flushCache.! Item was removed: - ----- Method: TTCFont>>reset (in category 'caching') ----- - reset - ! Item was removed: - ----- Method: TTCFont>>scale (in category 'private') ----- - scale - - ^ self pixelSize / ttcDescription unitsPerEm - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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 removed: - ----- Method: TTCFont>>size (in category 'public') ----- - size - - ^ ttcDescription size. - ! Item was removed: - ----- Method: TTCFont>>subfamilyName (in category 'private') ----- - subfamilyName - - ^ ttcDescription subfamilyName. - ! Item was removed: - ----- Method: TTCFont>>textStyle (in category 'accessing') ----- - textStyle - ^ TextStyle actualTextStyles detect: - [:aStyle | aStyle fontArray includes: self] ifNone: [nil]! Item was removed: - ----- Method: TTCFont>>ttcDescription (in category 'friend') ----- - ttcDescription - - ^ ttcDescription. - ! Item was removed: - ----- Method: TTCFont>>ttcDescription: (in category 'friend') ----- - ttcDescription: aTTCDescription - - ttcDescription := aTTCDescription. - self flushCache. - ! Item was removed: - ----- Method: TTCFont>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - - self flushCache. - ^ self. - ! Item was removed: - ----- 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: [ - fallbackFont ifNotNil: [^ fallbackFont widthOf: aCharacter]. - ^ 1 - ]. - ^(self formOf: aCharacter) width! Item was removed: - TTFontDescription subclass: #TTCFontDescription - instanceVariableNames: '' - classVariableNames: 'TTCDefault TTCDescriptions' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: TTCFontDescription class>>addFromTTFile: (in category 'as yet unclassified') ----- - addFromTTFile: fileName - " - Execute the following only if you know what you are doing. - self addFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC' - " - - | tt old | - (fileName asLowercase endsWith: 'ttf') ifTrue: [ - tt := TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName). - ] ifFalse: [ - tt := TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName). - ]. - - old := TTCDescriptions detect: [:f | f first name = tt first name] ifNone: [nil]. - old ifNotNil: [TTCDescriptions remove: old]. - TTCDescriptions add: tt. - ^ tt. - ! Item was removed: - ----- Method: TTCFontDescription class>>clearDefault (in category 'as yet unclassified') ----- - clearDefault - " - self clearDefault - " - - TTCDefault := nil. - ! Item was removed: - ----- Method: TTCFontDescription class>>clearDescriptions (in category 'as yet unclassified') ----- - clearDescriptions - " - self clearDescriptions - " - - TTCDescriptions := Set new. - TTCDefault ifNotNil: [TTCDescriptions add: TTCDefault]. - ! Item was removed: - ----- Method: TTCFontDescription class>>default (in category 'as yet unclassified') ----- - default - - ^ TTCDefault. - ! Item was removed: - ----- Method: TTCFontDescription class>>descriptionNamed: (in category 'as yet unclassified') ----- - descriptionNamed: descriptionName - - ^ TTCDescriptions detect: [:f | f first name = descriptionName] ifNone: [TTCDefault]. - ! Item was removed: - ----- Method: TTCFontDescription class>>descriptionNamed:at: (in category 'as yet unclassified') ----- - descriptionNamed: descriptionName at: index - - | array | - (array := self descriptionNamed: descriptionName) ifNil: [^ nil]. - ^ array at: index. - ! Item was removed: - ----- Method: TTCFontDescription class>>initialize (in category 'as yet unclassified') ----- - initialize - " - self initialize - " - - self clearDescriptions. - ! Item was removed: - ----- Method: TTCFontDescription class>>removeDescriptionNamed: (in category 'as yet unclassified') ----- - removeDescriptionNamed: descriptionName - - | tt | - TTCDescriptions ifNil: [^ self]. - [(tt := TTCDescriptions detect: [:f | ('Multi', f first name) = descriptionName] ifNone: [nil]) notNil] whileTrue:[ - TTCDescriptions remove: tt - ]. - ! Item was removed: - ----- Method: TTCFontDescription class>>setDefault (in category 'as yet unclassified') ----- - setDefault - " - self setDefault - " - - TTCDefault := TTCFontReader readFrom: (FileStream readOnlyFileNamed: 'C:\WINDOWS\Fonts\msgothic.ttc'). - self clearDescriptions. - - ! Item was removed: - ----- Method: TTCFontDescription>>at: (in category 'accessing') ----- - at: aCharOrInteger - - | char | - char := aCharOrInteger asCharacter. - ^ glyphs at: (char charCode) + 1. - ! Item was removed: - ----- Method: TTCFontDescription>>deepCopy (in category 'copying') ----- - deepCopy - - ^ self. - ! Item was removed: - ----- Method: TTCFontDescription>>name (in category 'accessing') ----- - name - - ^ self familyName copyWithout: Character space. - ! Item was removed: - ----- Method: TTCFontDescription>>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 Font in the other system instead. " - - "A path to me" - (TextConstants at: #forceFontWriting ifAbsent: [false]) ifTrue: [^ self]. - "special case for saving the default fonts on the disk. See collectionFromFileNamed:" - - dp := DiskProxy global: #TTCFontDescription selector: #descriptionNamed:at: - args: {self name. ((TTCFontDescription descriptionNamed: self name) indexOf: self)}. - refStrm replace: self with: dp. - ^ dp. - ! Item was removed: - ----- Method: TTCFontDescription>>size (in category 'accessing') ----- - size - - ^ glyphs size. - ! Item was removed: - ----- Method: TTCFontDescription>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - "Return self. I am shared. Do not record me." - ! Item was removed: - TTFontReader subclass: #TTCFontReader - instanceVariableNames: 'fonts' - classVariableNames: 'EncodingTag' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: TTCFontReader class>>encodingTag: (in category 'as yet unclassified') ----- - encodingTag: aNumber - " - TTCFontReader encodingTag: 6 - " - - EncodingTag := aNumber. - ! Item was removed: - ----- Method: TTCFontReader>>decodeCmapFmtTable: (in category 'as yet unclassified') ----- - decodeCmapFmtTable: entry - | cmapFmt length entryCount segCount segments offset cmap firstCode | - cmapFmt := entry nextUShort. - length := entry nextUShort. - entry skip: 2. "skip version" - - cmapFmt = 0 ifTrue: "byte encoded table" - [length := length - 6. "should be always 256" - length <= 0 ifTrue: [^ nil]. "but sometimes, this table is empty" - cmap := Array new: length. - entry nextBytes: length into: cmap startingAt: entry offset. - ^ cmap]. - - cmapFmt = 4 ifTrue: "segment mapping to deltavalues" - [segCount := entry nextUShort // 2. - entry skip: 6. "skip searchRange, entrySelector, rangeShift" - segments := Array new: segCount. - segments := (1 to: segCount) collect: [:e | Array new: 4]. - 1 to: segCount do: [:i | (segments at: i) at: 2 put: entry nextUShort]. "endCount" - entry skip: 2. "skip reservedPad" - 1 to: segCount do: [:i | (segments at: i) at: 1 put: entry nextUShort]. "startCount" - 1 to: segCount do: [:i | (segments at: i) at: 3 put: entry nextShort]. "idDelta" - offset := entry offset. - 1 to: segCount do: [:i | (segments at: i) at: 4 put: entry nextUShort]. "idRangeOffset" - cmap := Array new: 65536 withAll: 0. - segments withIndexDo: - [:seg :si | | code | - seg first to: seg second do: - [:i | - seg last > 0 ifTrue: - ["offset to glypthIdArray - this is really C-magic!!" - entry offset: i - seg first - 1 * 2 + seg last + si + si + offset. - code := entry nextUShort. - code > 0 ifTrue: [code := code + seg third]] - ifFalse: - ["simple offset" - code := i + seg third]. - cmap at: i + 1 put: (code \\ 16r10000)]]. - ^ cmap]. - - cmapFmt = 6 ifTrue: "trimmed table" - [firstCode := entry nextUShort. - entryCount := entry nextUShort. - cmap := Array new: entryCount + firstCode withAll: 0. - entryCount timesRepeat: - [cmap at: (firstCode := firstCode + 1) put: entry nextUShort]. - ^ cmap]. - ^ nil! Item was removed: - ----- Method: TTCFontReader>>getTableDirEntry:from:offset: (in category 'as yet unclassified') ----- - getTableDirEntry: tagString from: fontData offset: offset - "Find the table named tagString in fontData and return a table directory entry for it." - - | nTables pos currentTag tag | - nTables := fontData shortAt: 5 + offset bigEndian: true. - tag := ByteArray new: 4. - 1 to: 4 do:[:i| tag byteAt: i put: (tagString at: i) asInteger]. - tag := tag longAt: 1 bigEndian: true. - pos := 13 + offset. - 1 to: nTables do:[:i| - currentTag := fontData longAt: pos bigEndian: true. - currentTag = tag ifTrue:[^TTFontTableDirEntry on: fontData at: pos]. - pos := pos+16]. - ^nil! Item was removed: - ----- Method: TTCFontReader>>parseTTCHeaderFrom: (in category 'as yet unclassified') ----- - parseTTCHeaderFrom: fontData - - | pos nTables | - nTables := fontData longAt: 9 bigEndian: true. - fonts := Array new: nTables. - pos := 13. - 1 to: nTables do: [:i | - fonts at: i put: (fontData longAt: pos bigEndian: true). - pos := pos + 4. - ]. - - ^ fonts - ! Item was removed: - ----- Method: TTCFontReader>>processCharMap: (in category 'as yet unclassified') ----- - processCharMap: assoc - "Process the given character map" - - | glyph cmap encode0 encode1 char value null | - cmap := assoc value. - null := (glyphs at: (cmap at: Character space asUnicode + 1) + 1) copy. - null contours: #(). - - encode0 := Array new: 256 withAll: glyphs first. - encode1 := Array new: 65536 withAll: glyphs first. - - 0 to: 255 do: [:i | - char := Character value: i. - glyph := glyphs at: (cmap at: char asUnicode + 1) + 1. - encode0 at: i+1 put: glyph. - ]. - Character separators do: [:c | - encode0 at: (c asciiValue + 1) put: null. - ]. - 0 to: 65536 - 1 do: [:i | - value := cmap at: i+1. - value = 65535 ifFalse: [ "???" - encode1 at: i+1 put: (glyphs at: value+1). - ] - ]. - - ^ {encode0. encode1}. - ! Item was removed: - ----- Method: TTCFontReader>>processCharacterMappingTable: (in category 'as yet unclassified') ----- - processCharacterMappingTable: entry - "Read the font's character to glyph index mapping table. - If an appropriate mapping can be found then return an association - with the format identifier and the contents of the table" - | copy initialOffset nSubTables pID sID offset cmap assoc | - initialOffset := entry offset. - entry skip: 2. "Skip table version" - nSubTables := entry nextUShort. - 1 to: nSubTables do:[:i| - pID := entry nextUShort. - sID := entry nextUShort. - offset := entry nextULong. - "Check if this is either a Macintosh encoded table - or a Windows encoded table" - (pID = 1 or:[pID = 3]) ifTrue:[ - "Go to the beginning of the table" - copy := entry copy. - copy offset: initialOffset + offset. - cmap := self decodeCmapFmtTable: copy. - "(pID = 1 and: [cmap notNil])" "Prefer Macintosh encoding over everything else" - "ifTrue: [pID -> cmap]." - assoc := pID -> cmap. "Keep it in case we don't find a Mac encoded table" - ]. - ]. - ^assoc! Item was removed: - ----- Method: TTCFontReader>>readFrom: (in category 'as yet unclassified') ----- - readFrom: aStream - - "Read the raw font byte data" - | fontData | - (aStream respondsTo: #binary) ifTrue:[aStream binary]. - fontData := aStream contents asByteArray. - - fonts := self parseTTCHeaderFrom: fontData. - ^ ((Array with: fonts first) collect: [:offset | - fontDescription := TTCFontDescription new. - self readFrom: fontData fromOffset: offset at: EncodingTag. - ]) at: 1. - ! Item was removed: - ----- Method: TTCFontReader>>readFrom:fromOffset:at: (in category 'as yet unclassified') ----- - readFrom: fontData fromOffset: offset at: encodingTag - - | headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry glyphOffset cmap numHMetrics indexToLocFormat fontDescription0 fontDescription1 array result | - - "Search the tables required to build the font" - (headerEntry := self getTableDirEntry: 'head' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a header table']. - (maxProfileEntry := self getTableDirEntry: 'maxp' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a maximum profile table']. - (nameEntry := self getTableDirEntry: 'name' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a name table']. - (indexLocEntry := self getTableDirEntry: 'loca' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a relocation table']. - (charMapEntry := self getTableDirEntry: 'cmap' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a character map table']. - (glyphEntry := self getTableDirEntry: 'glyf' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a glyph table']. - (horzHeaderEntry := self getTableDirEntry: 'hhea' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a horizontal header table']. - (horzMetricsEntry := self getTableDirEntry: 'hmtx' from: fontData offset: offset) == nil ifTrue:[ - ^self error:'This font does not have a horizontal metrics table']. - (kerningEntry := self getTableDirEntry: 'kern' from: fontData offset: offset) == nil ifTrue:[ - Transcript cr; show:'This font does not have a kerning table';endEntry]. - - - "Process the data" - indexToLocFormat := self processFontHeaderTable: headerEntry. - self processMaximumProfileTable: maxProfileEntry. - self processNamingTable: nameEntry. - glyphOffset := self processIndexToLocationTable: indexLocEntry format: indexToLocFormat. - cmap := self processCharacterMappingTable: charMapEntry. - (cmap == nil or:[cmap value == nil]) - ifTrue:[^self error:'This font has no suitable character mappings']. - self processGlyphDataTable: glyphEntry offsets: glyphOffset. - numHMetrics := self processHorizontalHeaderTable: horzHeaderEntry. - self processHorizontalMetricsTable: horzMetricsEntry length: numHMetrics. - kerningEntry isNil - ifTrue:[kernPairs := #()] - ifFalse:[self processKerningTable: kerningEntry]. - array := self processCharMap: cmap. - fontDescription0 := fontDescription clone. - fontDescription1 := fontDescription clone. - fontDescription0 setGlyphs: (array at: 1) mapping: nil. - fontDescription1 setGlyphs: (array at: 2) mapping: nil. - "fontDescription setKernPairs: kernPairs." - result := OrderedCollection new. - (encodingTag = nil or: [encodingTag = 0]) ifTrue: [^ Array with: fontDescription1]. - result add: fontDescription0. - encodingTag -1 timesRepeat: [result add: nil]. - result add: fontDescription1. - ^ result asArray. - - ! Item was removed: - ----- Method: TTCFontReader>>readTTFFrom: (in category 'as yet unclassified') ----- - readTTFFrom: aStream - - "Read the raw font byte data" - | fontData | - (aStream respondsTo: #binary) ifTrue:[aStream binary]. - fontData := aStream contents asByteArray. - fontDescription := TTCFontDescription new. - - ^ self readFrom: fontData fromOffset: 0 at: EncodingTag. - ! Item was removed: - AbstractFont subclass: #TTCFontSet - instanceVariableNames: 'name fontArray foregroundColor' - classVariableNames: 'Registry' - poolDictionaries: '' - category: 'Multilingual-Display'! Item was removed: - ----- Method: TTCFontSet class>>discardDefault (in category 'as yet unclassified') ----- - discardDefault - " - self discardDefault - " - | ttc | - ttc := TTCFontDescription default. - ttc ifNotNil: [ - TextConstants removeKey: ttc name asSymbol ifAbsent: []. - ].! Item was removed: - ----- Method: TTCFontSet class>>familyName:pointSize: (in category 'as yet unclassified') ----- - familyName: n pointSize: s - - "(self familyName: 'MultiMSGothic' pointSize: 14) pointSize" - | 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]. - index := 2. - [index <= t size and: [(t at: index) pointSize <= s]] whileTrue: [ - ret := t at: index. - index := index + 1. - ]. - ^ ret. - ]. - ^ (TextStyle named: n) addNewFontSize: s.! Item was removed: - ----- Method: TTCFontSet class>>initialize (in category 'as yet unclassified') ----- - initialize - " - self initialize - " - - | tt | - tt := TTCFontDescription default. - tt ifNotNil: [self newTextStyleFromTT: tt]. - ! Item was removed: - ----- Method: TTCFontSet class>>newFontArray: (in category 'as yet unclassified') ----- - newFontArray: anArray - - ^super new initializeWithFontArray: anArray - ! Item was removed: - ----- Method: TTCFontSet class>>newTextStyleFromTT: (in category 'as yet unclassified') ----- - newTextStyleFromTT: descriptionArray - - | array textStyle styleName arrayOfArray | - - arrayOfArray := self pointSizes collect: [:pt | - descriptionArray collect: [:ttc | | f | - ttc ifNil: [nil] ifNotNil: [ - f := (ttc size > 256) - ifTrue: [MultiTTCFont new initialize] - ifFalse: [TTCFont new initialize]. - f ttcDescription: ttc. - f pointSize: pt. - ]. - ]. - ]. - - array := arrayOfArray collect: [:fonts | - self newFontArray: fonts. - ]. - - styleName := (array at: 1) familyName asSymbol. - textStyle := TextStyle fontArray: array. - TextConstants at: styleName put: textStyle. - - self register: array at: styleName. - - ^ TextConstants at: styleName. - ! Item was removed: - ----- Method: TTCFontSet class>>newTextStyleFromTTFile: (in category 'as yet unclassified') ----- - newTextStyleFromTTFile: fileName - " - TTCFontReader encodingTag: JapaneseEnvironment leadingChar. - self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\msmincho.TTC' - - TTCFontReader encodingTag: 0. - self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\symbol.ttf' - " - - | description | - description := TTCFontDescription addFromTTFile: fileName. - ^ self newTextStyleFromTT: description. - ! Item was removed: - ----- Method: TTCFontSet class>>pointSizes (in category 'as yet unclassified') ----- - pointSizes - - ^ TTCFont pointSizes. - ! Item was removed: - ----- Method: TTCFontSet class>>register:at: (in category 'as yet unclassified') ----- - register: anObject at: symbolName - - self registry at: symbolName put: anObject. - ! Item was removed: - ----- Method: TTCFontSet class>>registry (in category 'as yet unclassified') ----- - registry - ^ Registry - ifNil: [Registry := IdentityDictionary new]! Item was removed: - ----- Method: TTCFontSet class>>removeStyleName: (in category 'as yet unclassified') ----- - removeStyleName: aString - - | style symName | - symName := aString asSymbol. - style := TextConstants removeKey: symName ifAbsent: []. - style ifNotNil: [self unregister: symName]. - TTCFontDescription removeDescriptionNamed: aString asString. - ! Item was removed: - ----- Method: TTCFontSet class>>setDefault (in category 'as yet unclassified') ----- - setDefault - " - self setDefault - " - | tt | - tt := TTCFontDescription default. - tt ifNil: [TTCFontDescription setDefault]. - tt := TTCFontDescription default. - tt ifNotNil: [self newTextStyleFromTT: tt]. - ! Item was removed: - ----- Method: TTCFontSet class>>unregister: (in category 'as yet unclassified') ----- - unregister: symbolName - - self registry removeKey: symbolName ifAbsent: []. - ! Item was removed: - ----- Method: TTCFontSet>>ascent (in category 'accessing') ----- - ascent - - ^ (fontArray at: 1) ascent. - ! Item was removed: - ----- Method: TTCFontSet>>ascentOf: (in category 'accessing') ----- - ascentOf: aCharacter - - ^ fontArray first ascentOf: aCharacter. - ! Item was removed: - ----- Method: TTCFontSet>>baseKern (in category 'accessing') ----- - baseKern - - ^ 0. - ! Item was removed: - ----- Method: TTCFontSet>>depth (in category 'accessing') ----- - depth - - ^ (fontArray at: 1) depth. - ! Item was removed: - ----- Method: TTCFontSet>>descent (in category 'accessing') ----- - descent - - ^ (fontArray at: 1) descent. - ! Item was removed: - ----- Method: TTCFontSet>>descentKern (in category 'accessing') ----- - descentKern - - ^ 0. - ! Item was removed: - ----- Method: TTCFontSet>>descentOf: (in category 'accessing') ----- - descentOf: aChar - - ^ fontArray first descentOf: aChar - ! Item was removed: - ----- Method: TTCFontSet>>displayString:on:from:to:at:kern: (in category 'displaying') ----- - 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 removed: - ----- Method: TTCFontSet>>displayString:on:from:to:at:kern:baselineY: (in category 'displaying') ----- - displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY - - | destPoint font form encoding glyphInfo char charCode destY | - destPoint := aPoint. - glyphInfo := Array new: 5. - startIndex to: stopIndex do: [:charIndex | - char := aString at: charIndex. - encoding := char leadingChar + 1. - charCode := char charCode. - font := fontArray at: encoding. - ((charCode between: font minAscii and: font maxAscii) not) ifTrue: [ - charCode := font maxAscii]. - self glyphInfoOf: char into: glyphInfo. - form := glyphInfo first. - (glyphInfo fifth ~= aBitBlt lastFont) ifTrue: [ - glyphInfo fifth installOn: aBitBlt. - ]. - destY := baselineY - glyphInfo fourth. - aBitBlt - sourceForm: form; - destX: destPoint x; - destY: destY; - sourceOrigin: 0 @ 0; - width: form width; - height: form height; - copyBits. - destPoint := destPoint x + (form width + kernDelta) @ destPoint y. - ]. - ^ destPoint. - ! Item was removed: - ----- Method: TTCFontSet>>displayStringR2L:on:from:to:at:kern: (in category 'displaying') ----- - displayStringR2L: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta - - | destPoint font form encoding char charCode glyphInfo | - destPoint := aPoint. - glyphInfo := Array new: 5. - startIndex to: stopIndex do: [:charIndex | - char := aString at: charIndex. - encoding := char leadingChar + 1. - charCode := char charCode. - font := fontArray at: encoding. - ((charCode between: font minAscii and: font maxAscii) not) ifTrue: [ - charCode := font maxAscii]. - self glyphInfoOf: char into: glyphInfo. - form := glyphInfo first. - (glyphInfo size > 4 and: [glyphInfo fifth notNil and: [glyphInfo fifth ~= aBitBlt lastFont]]) ifTrue: [ - glyphInfo fifth installOn: aBitBlt. - ]. - aBitBlt - sourceForm: form; - destX: destPoint x - form width; - destY: destPoint y; - sourceOrigin: 0 @ 0; - width: form width; - height: form height; - copyBits. - destPoint := destPoint x - (form width + kernDelta) @ destPoint y. - ]. - ! Item was removed: - ----- Method: TTCFontSet>>emphasis (in category 'accessing') ----- - emphasis - ^ fontArray first emphasis! Item was removed: - ----- Method: TTCFontSet>>emphasized: (in category 'accessing') ----- - emphasized: code - - ! Item was removed: - ----- Method: TTCFontSet>>familyName (in category 'accessing') ----- - familyName - - ^ 'Multi', (fontArray at: 1) familyName. - ! Item was removed: - ----- Method: TTCFontSet>>familySizeFace (in category 'accessing') ----- - familySizeFace - - ^ Array - with: fontArray first name - with: self height - with: 0. - ! Item was removed: - ----- Method: TTCFontSet>>fontArray (in category 'accessing') ----- - fontArray - - ^ fontArray - ! Item was removed: - ----- Method: TTCFontSet>>glyphInfoOf:into: (in category 'private') ----- - glyphInfoOf: aCharacter into: glyphInfoArray - - | index f code | - index := aCharacter leadingChar + 1. - fontArray size < index ifTrue: [^ self questionGlyphInfoInto: glyphInfoArray]. - (f := fontArray at: index) ifNil: [^ self questionGlyphInfoInto: glyphInfoArray]. - - code := aCharacter charCode. - ((code between: f minAscii and: f maxAscii) not) ifTrue: [ - ^ self questionGlyphInfoInto: glyphInfoArray. - ]. - f glyphInfoOf: aCharacter into: glyphInfoArray. - glyphInfoArray at: 5 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- Method: TTCFontSet>>height (in category 'accessing') ----- - height - - ^fontArray first pixelSize. - ! Item was removed: - ----- Method: TTCFontSet>>initializeWithFontArray: (in category 'as yet unclassified') ----- - initializeWithFontArray: anArray - - fontArray := anArray. - "name := anArray first name." - ! Item was removed: - ----- Method: TTCFontSet>>installOn: (in category 'as yet unclassified') ----- - installOn: aDisplayContext - - ^aDisplayContext installTTCFont: self. - ! Item was removed: - ----- Method: TTCFontSet>>installOn:foregroundColor:backgroundColor: (in category 'as yet unclassified') ----- - installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor - - foregroundColor := fgColor. - fontArray do: [:s | s ifNotNil: [s installOn: aDisplayContext foregroundColor: fgColor backgroundColor: bgColor]]. - ! Item was removed: - ----- Method: TTCFontSet>>isFontSet (in category 'testing') ----- - isFontSet - - ^ true. - ! Item was removed: - ----- Method: TTCFontSet>>isTTCFont (in category 'testing') ----- - isTTCFont - ^true! Item was removed: - ----- Method: TTCFontSet>>lineGrid (in category 'accessing') ----- - lineGrid - - ^ fontArray first lineGrid. - ! Item was removed: - ----- Method: TTCFontSet>>maxAsciiFor: (in category 'accessing') ----- - maxAsciiFor: encoding - - | f | - f := (fontArray at: encoding+1). - f ifNotNil: [^ f maxAscii]. - ^ 0. - ! Item was removed: - ----- Method: TTCFontSet>>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: #TTCFontSet selector: #familyName:pointSize: - args: {self familyName. self pointSize}. - refStrm replace: self with: dp. - ^ dp. - ! Item was removed: - ----- Method: TTCFontSet>>pointSize (in category 'accessing') ----- - pointSize - - ^ fontArray first pixelSize * 72 // 96. - ! Item was removed: - ----- Method: TTCFontSet>>pointSizes (in category 'accessing') ----- - pointSizes - - ^ self class pointSizes. - ! Item was removed: - ----- Method: TTCFontSet>>questionGlyphInfoInto: (in category 'private') ----- - questionGlyphInfoInto: glyphInfoArray - - | f form | - f := fontArray at: 1. - form := f formOf: $?. - glyphInfoArray at: 1 put: form; - at: 2 put: 0; - at: 3 put: form width; - at: 4 put: self. - ^ glyphInfoArray. - ! Item was removed: - ----- Method: TTCFontSet>>textStyle (in category 'accessing') ----- - textStyle - - ^ TextStyle actualTextStyles - detect: [:aStyle | (aStyle fontArray collect: [:s | s name]) includes: self name] - ifNone: []. - ! Item was removed: - ----- Method: TTCFontSet>>ttcDescription (in category 'as yet unclassified') ----- - ttcDescription - ^ fontArray first ttcDescription! Item was removed: - ----- Method: TTCFontSet>>widthOf: (in category 'measuring') ----- - widthOf: aCharacter - - | encoding | - encoding := aCharacter leadingChar. - ^ (fontArray at: encoding + 1) widthOf: aCharacter. - !
1
0
0
0
← Newer
1
...
50
51
52
53
Older →
Jump to page:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Results per page:
10
25
50
100
200