'From etoys2.3 of 28 November 2007 [latest update: #1824] on 8 December 2007 at 2:18:28 am'! "Change Set: TTCFontSetRework-yo Date: 8 December 2007 Author: Yoshiki Ohshima Clean up TTCFontSet and friends. Also supports emphasis for them."! AbstractFont subclass: #TTCFontSet instanceVariableNames: 'name fontArray foregroundColor derivatives fallbackFont ' classVariableNames: 'Registry ' poolDictionaries: '' category: 'Multilingual-Display'! !CanvasDecoder class methodsFor: 'decoding' stamp: 'yo 12/7/2007 15:38'! decodeTTCFont: fontString "Decode a string that consists of (e.g. 'ComicSansMS 12 0') into a proper instance." | first second | first _ fontString indexOf: $ startingAt: 1. second _ fontString indexOf: $ startingAt: first + 1. (first ~= 0 and: [second ~= 0]) ifTrue: [ ^ TTCFont familyName: (fontString copyFrom: 1 to: (first - 1)) size: (fontString copyFrom: first + 1 to: second - 1) asNumber emphasized: (fontString copyFrom: second + 1 to: fontString size) asNumber. ]. ^ TextStyle defaultFont. ! ! !TTCFont methodsFor: 'accessing' stamp: 'yo 12/8/2007 00:01'! emphasis "Answer the emphasis code (0 to 3) corresponding to my subfamily name" ^TTCFont indexOfSubfamilyName: self subfamilyName ! ! !TTCFont methodsFor: 'friend' stamp: 'yo 12/8/2007 00:01'! derivativeFont: aTTCFont | index | index _ TTCFont indexOfSubfamilyName: (aTTCFont subfamilyName). index < 1 ifTrue: [ ^ self "inform: 'unknown sub family name. This font will be skipped'". ]. self derivativeFont: aTTCFont at: index. self addLined: aTTCFont. ! ! !TTCFont methodsFor: 'objects from disk' stamp: 'yo 12/7/2007 16:40'! 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:emphasized: args: {self familyName. self pointSize. self emphasis}. refStrm replace: self with: dp. ^ dp. ! ! !TTCFont methodsFor: 'testing' stamp: 'yo 12/8/2007 00:01'! isRegular "Answer true if I am a Regular/Roman font (i.e. not bold, etc.)" ^ (TTCFont indexOfSubfamilyName: (self subfamilyName)) = 0. ! ! !TTCFont class methodsFor: 'instance creation' stamp: 'yo 12/7/2007 15:37'! familyName: n pointSize: s emphasis: code ^ self familyName: n pointSize: s emphasized: code! ! !TTCFont class methodsFor: 'instance creation' stamp: 'yo 12/7/2007 15:37'! familyName: n pointSize: s emphasized: 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. ! ! !TTCFont class methodsFor: 'instance creation' stamp: 'yo 12/7/2007 16:17'! family: f size: s ^ self familyName: f size: s emphasized: 0! ! !TTCFont class methodsFor: 'instance creation' stamp: 'yo 12/8/2007 00:38'! 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) copyWith: 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. ! ! !TTCFont class methodsFor: 'other' stamp: 'yo 12/8/2007 00:01'! 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.! ! !TTCFont class methodsFor: 'other' stamp: 'yo 12/8/2007 00:32'! registerAll " TTCFont registerAll " TextStyle allInstancesDo: [:e | (e isTTCFont) ifTrue: [ self register: e fontArray at: e fontArray first familyName asSymbol. ]. ]. ! ! !TTCFont class methodsFor: 'other' stamp: 'yo 12/8/2007 00:10'! removeStyleName: aString | style symName | symName _ aString asSymbol. style _ TextConstants removeKey: symName ifAbsent: []. style ifNotNil: [self unregister: symName]. TTFontDescription removeDescriptionNamed: aString asString. ! ! !TTCFont class methodsFor: '*siss-instance creation' stamp: 'yo 12/7/2007 15:41'! familyName: aName size: aSize emphasized: emphasisCode ^ self familyName: aName pointSize: aSize emphasized: emphasisCode! ! !TTCFontReader methodsFor: 'all' stamp: 'yo 12/8/2007 01:42'! decodeCmapFmtTable: entry | cmapFmt length cmap firstCode entryCount segCount segments offset code | 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 | 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]. cmapFmt = 12 ifTrue: "segmented coverage" [|groupCount groups | groupCount _ entry nextULong. groups _ Array new: groupCount. groups _ (1 to: groupCount) collect: [:e | Array new: 3]. 1 to: groupCount do: [:i | (groups at: i) at: 1 put: entry nextULong. "StartCharCode" (groups at: i) at: 2 put: entry nextULong. "endCharCode" (groups at: i) at: 3 put: entry nextULong. "startGlyphID" ]. cmap _ Array new: 65536 withAll: 0. groups do: [:group | offset _ 0. (group first) to: (group second) do: [:i | code _ group last + offset. i < 65536 ifTrue: [ cmap at: i + 1 put: (code \\ 16r10000). ]. offset _ offset + 1. ] ]. ^ cmap. ]. ^ nil! ! !TTCFontReader methodsFor: 'all' stamp: 'yo 12/8/2007 01:50'! 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" (#(0 1 3) includes: pID) ifTrue: [ (assoc notNil and: [assoc key = pID]) ifFalse: [ "Go to the beginning of the table" copy _ entry copy. copy offset: initialOffset + offset. cmap _ self decodeCmapFmtTable: copy. (pID = 0 and: [cmap notNil]) "Prefer Unicode encoding over everything else" ifTrue: [^ pID -> cmap]. assoc _ pID -> cmap. "Keep it in case we don't find a better table" ]. ]. ]. ^assoc! ! !TTCFontReader methodsFor: 'all' stamp: 'yo 12/6/2007 16:54'! 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 _ TTFontDescription new. self readFrom: fontData fromOffset: offset at: EncodingTag. ]) at: 1. ! ! !TTCFontReader methodsFor: 'all' stamp: 'yo 12/6/2007 14:52'! 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: (array at: 1). fontDescription1 setGlyphs: (array at: 2) mapping: (array at: 2). "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. ! ! !TTCFontReader methodsFor: 'all' stamp: 'yo 12/6/2007 16:53'! readTTFFrom: aStream "Read the raw font byte data" | fontData | (aStream respondsTo: #binary) ifTrue:[aStream binary]. fontData _ aStream contents asByteArray. fontDescription _ TTFontDescription new. ^ self readFrom: fontData fromOffset: 0 at: EncodingTag. ! ! !TTCFontSet methodsFor: 'accessing' stamp: 'yo 12/6/2007 13:43'! familyName ^ (fontArray at: 1) familyName. ! ! !TTCFontSet methodsFor: 'accessing' stamp: 'yo 12/7/2007 18:09'! subfamilyName ^ fontArray first ttcDescription subfamilyName. ! ! !TTCFontSet methodsFor: 'accessing' stamp: 'yo 12/8/2007 02:05'! widthOf: aCharacter | encoding font | encoding _ aCharacter leadingChar. font _ (fontArray at: encoding + 1). font ifNotNil: [^ font widthOf: aCharacter]. fallbackFont ifNotNil: [^ fallbackFont widthOf: aCharacter]. ^ (fontArray at: 1) widthOf: aCharacter. ! ! !TTCFontSet methodsFor: 'displaying' stamp: 'yo 12/8/2007 02:08'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY | destPoint form glyphInfo char destY destX | destPoint _ aPoint. destX _ aPoint x. glyphInfo _ Array new: 5. startIndex to: stopIndex do: [:charIndex | char _ aString at: charIndex. self glyphInfoOf: char into: glyphInfo. form _ glyphInfo at: 1. ((glyphInfo at: 5) ~= aBitBlt lastFont) ifTrue: [ (glyphInfo at: 5) installOn: aBitBlt. ]. destY _ baselineY - (glyphInfo at: 4). aBitBlt sourceForm: form. aBitBlt destX: destX. aBitBlt destY: destY. aBitBlt sourceOrigin: 0 @ 0. aBitBlt width: form width. aBitBlt height: form height. aBitBlt copyBits. destX _ destX + (form width + kernDelta). ]. ^ destX@destPoint y. ! ! !TTCFontSet methodsFor: 'displaying private' stamp: 'yo 12/8/2007 02:10'! 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 ascentOf: $?); at: 5 put: self. ^ glyphInfoArray. ! ! !TTCFontSet methodsFor: 'testing' stamp: 'yo 12/8/2007 00:01'! isRegular "Answer true if I am a Regular/Roman font (i.e. not bold, etc.)" ^ (TTCFont indexOfSubfamilyName: (self subfamilyName)) = 0. ! ! !TTCFontSet methodsFor: 'derivatives' stamp: 'yo 12/7/2007 17:06'! derivativeFonts derivatives ifNil: [^ #()]. ^derivatives copyWithout: nil! ! !TTCFontSet methodsFor: 'derivatives' stamp: 'yo 12/8/2007 00:02'! derivativeFont: aTTCFont | index | index _ TTCFont indexOfSubfamilyName: (aTTCFont subfamilyName). index < 1 ifTrue: [ ^ self "inform: 'unknown sub family name. This font will be skipped'". ]. self derivativeFont: aTTCFont at: index. "self addLined: aTTCFont." ! ! !TTCFontSet methodsFor: 'derivatives' stamp: 'yo 12/7/2007 17:27'! derivativeFont: aTTCFontSet at: index | newDeriv | aTTCFontSet 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: aTTCFontSet ! ! !TTCFontSet methodsFor: 'derivatives' stamp: 'yo 12/7/2007 17:13'! emphasis: code code > 3 ifTrue: [^ self]. code = 0 ifTrue: [^ self]. derivatives isNil ifTrue: [^ self]. ^ (derivatives at: code) ifNil: [self]. ! ! !TTCFontSet methodsFor: 'derivatives' stamp: 'yo 12/7/2007 17:13'! 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]. ! ! !TTCFontSet methodsFor: 'derivatives' stamp: 'yo 12/7/2007 17:12'! pointSize: aNumber self privatePointSize: aNumber. derivatives ifNotNil: [ derivatives do: [ :f | f ifNotNil: [ f privatePointSize: aNumber ]]]. ! ! !TTCFontSet methodsFor: 'derivatives' stamp: 'yo 12/7/2007 17:20'! privatePointSize: aNumber fontArray do: [:f | f privatePointSize: aNumber ]. ! ! !TTCFontSet methodsFor: 'private' stamp: 'yo 12/8/2007 00:39'! addLined: aTTCFont " I ran out steam to add this for TTCFontSet for now. | 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. "! ! !TTCFontSet class methodsFor: 'instance creation' stamp: 'yo 12/7/2007 15:31'! familyName: n pointSize: s "(self familyName: 'MSGothic' 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.! ! !TTCFontSet class methodsFor: 'instance creation' stamp: 'yo 12/7/2007 17:41'! familyName: n pointSize: s emphasized: code | t ret index | t _ TTCFont 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 emphasis: code ]. ^ ((TextStyle named: n) addNewFontSize: s) emphasis: code.! ! !TTCFontSet class methodsFor: 'file out/in' stamp: 'yo 12/8/2007 01:56'! installExternalFontFileName: aFileName " TTCFontSet installExternalFontFileName: 'GreekTT.out'. TTCFontSet installExternalFontFileName: 'JapaneseTT.out'. " | f | f _ FileStream readOnlyFileNamed: aFileName. TTCFontSet newTextStyleFromSmartRefStream: (SmartRefStream on: f).. f close. ! ! !TTCFontSet class methodsFor: 'file out/in' stamp: 'yo 12/8/2007 01:57'! makeSmartRefFilesFrom: fileNames encodingTag: anInteger ranges: ranges outputFileName: outputFile " | dir | dir _ FileDirectory on: 'C:\tmp'. dir _ FileDirectory on: '/usr/share/fonts/dejavu-lgc'. ((dir fileNames select: [:e | e endsWith: '.ttf']) collect: [:e | dir fullNameFor: e]). TTCFontSet makeSmartRefFilesFrom: ((dir fileNames select: [:e | e endsWith: '.ttf']) collect: [:e | dir fullNameFor: e]) encodingTag: GreekEnvironment leadingChar ranges: EFontBDFFontReaderForRanges rangesForGreek. " | f ref descriptions | TTCFontReader encodingTag: anInteger. descriptions _ fileNames collect: [:ttfFile | TTCFontSet newTextStyleFromTTFile: ttfFile encodingTag: anInteger ranges: ranges]. f _ FileStream newFileNamed: outputFile. TextConstants at: #forceFontWriting put: true. ref _ SmartRefStream on: f. ref nextPutObjOnly: descriptions. ref close. TextConstants at: #forceFontWriting put: false. f close. " When you load a copyrighted font, be careful not to distribute the result. TTCFontSet makeSmartRefFilesFrom: #('C:\Windows\Fonts\MSGothic.ttc') encodingTag: JapaneseEnvironment leadingChar ranges: EFontBDFFontReaderForRanges basicNew rangesForJapanese outputFileName: 'JapaneseTT.out' "! ! !TTCFontSet class methodsFor: 'file out/in' stamp: 'yo 12/8/2007 01:08'! newTextStyleFromSmartRefStream: ref | descriptions | descriptions _ TTFontDescription addFromSmartRefStream: ref. descriptions do: [:desc | self newTextStyleFromTT: desc].. ! ! !TTCFontSet class methodsFor: 'file out/in' stamp: 'yo 12/8/2007 01:19'! newTextStyleFromTTFile: fileName " Deprecated. TTCFontReader encodingTag: JapaneseEnvironment leadingChar. self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\msmincho.TTC' TTCFontReader encodingTag: 0. self newTextStyleFromTTFile: 'C:\WINDOWS\Fonts\symbol.ttf' " | description | description _ TTFontDescription addSetFromTTFile: fileName. ^ self newTextStyleFromTT: description. ! ! !TTCFontSet class methodsFor: 'file out/in' stamp: 'yo 12/8/2007 01:58'! newTextStyleFromTTFile: fileName encodingTag: encodingTag ranges: ranges | description | description _ TTFontDescription addSetFromTTFile: fileName encodingTag: encodingTag ranges: ranges. self newTextStyleFromTT: description. ^ description. ! ! !TTCFontSet class methodsFor: 'file out/in' stamp: 'yo 12/8/2007 00:40'! newTextStyleFromTT: descriptionArray | array f arrayOfArray | arrayOfArray _ self pointSizes collect: [:pt | descriptionArray collect: [:ttc | ttc ifNil: [nil] ifNotNil: [ f _ (ttc size > 256) ifTrue: [MultiTTCFont new] ifFalse: [TTCFont new]. f ttcDescription: ttc. f pointSize: pt. ]. ]. ]. array _ arrayOfArray collect: [:fonts | self newFontArray: fonts. ]. ^TTCFont reorganizeForNewFontArray: array name: array first familyName asSymbol. " styleName _ (array at: 1) familyName asSymbol. textStyle _ TextStyle fontArray: array. TextConstants at: styleName put: textStyle. self register: array at: styleName. ^ TextConstants at: styleName. "! ! !TTCFontSet class methodsFor: 'registry' stamp: 'yo 12/7/2007 17:47'! registry ^ TTCFont registry. ! ! !TTCFontSet class methodsFor: '*sixx-instance creation' stamp: 'yo 12/8/2007 00:24'! familyName: aName size: aSize emphasized: emphasisCode ^TTCFont familyName: aName pointSize: aSize emphasized: emphasisCode! ! !TTCFontSet class methodsFor: 'private' stamp: 'yo 12/7/2007 17:44'! 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. ! ! !TTFontDescription methodsFor: 'accessing' stamp: 'yo 12/6/2007 14:52'! at: aCharOrInteger ^glyphTable at: (aCharOrInteger isCharacter ifTrue: [aCharOrInteger charCode] ifFalse: [aCharOrInteger])+1! ! !TTFontDescription methodsFor: 'accessing' stamp: 'yo 12/7/2007 10:33'! first ^ self. ! ! !TTFontDescription methodsFor: 'copying' stamp: 'yo 12/6/2007 16:56'! objectForDataStream: refStrm | dp isCollection | "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:" isCollection _ (Descriptions detect: [:e | e == self]) not. dp _ DiskProxy global: #TTFontDescription selector: #descriptionFullNamed:at: args: {self fullName. (isCollection ifTrue: [(TTFontDescription descriptionFullNamed: self fullName) indexOf: self] ifFalse: [0])}. refStrm replace: self with: dp. ^ dp. ! ! !TTFontDescription methodsFor: 'migration' stamp: 'yo 12/6/2007 14:58'! compactForRanges: rangesArray | newGlyphTable noMapping | noMapping _ glyphs == glyphTable. newGlyphTable := SparseLargeTable new: rangesArray last last chunkSize: 32 arrayClass: Array base: 0 + 1 defaultValue: (glyphs at: 1). rangesArray do: [:pair | pair first to: pair second do: [:i | newGlyphTable at: i put: (glyphs at: i) ] ]. glyphTable _ newGlyphTable. noMapping ifTrue: [glyphs _ glyphTable]. ! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/6/2007 16:49'! addFromSmartRefStream: ref | tt old | tt := ref nextAndClose. old _ Descriptions detect: [:f | f first name = tt first name] ifNone: [nil]. old ifNotNil: [Descriptions remove: old]. Descriptions add: tt. ^ tt. ! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/8/2007 00:08'! addSetFromTTFile: 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 _ Descriptions detect: [:f | f first name = tt first name] ifNone: [nil]. old ifNotNil: [Descriptions remove: old]. Descriptions add: tt. ^ tt. ! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/8/2007 01:17'! addSetFromTTFile: fileName encodingTag: encodingTag ranges: ranges | tt old | (fileName asLowercase endsWith: 'ttf') ifTrue: [ tt _ TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName). ] ifFalse: [ tt _ TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName). ]. (tt at: encodingTag + 1) compactForRanges: ranges. old _ Descriptions detect: [:f | f first name = tt first name] ifNone: [nil]. old ifNotNil: [Descriptions remove: old]. Descriptions add: tt. ^ tt. ! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/7/2007 23:51'! descriptionFullNamed: descriptionFullName ^ Descriptions detect: [:f | f first fullName = descriptionFullName] ifNone: [Default]! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/7/2007 23:51'! descriptionFullNamed: descriptionFullName at: index | ans | ans _ Descriptions detect: [:f | f first fullName = descriptionFullName] ifNone: [Default]. index > 0 ifTrue: [^ ans at: index]. ^ ans. ! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/7/2007 13:26'! descriptionNamed: descriptionName ^ Descriptions detect: [:f | f first name = descriptionName] ifNone: [Default]. ! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/7/2007 23:50'! removeDescriptionNamed: descriptionName | tt | Descriptions ifNil: [^ self]. [(tt _ Descriptions detect: [:f | f first name = descriptionName] ifNone: [nil]) notNil] whileTrue:[ Descriptions remove: tt ]. ! ! !TTFontDescription class methodsFor: 'instance creations' stamp: 'yo 12/7/2007 23:51'! removeDescriptionNamed: descriptionName subfamilyName: subfamilyName | tts | Descriptions ifNil: [^ self]. tts _ Descriptions select: [:f | f first name = descriptionName and: [f first subfamilyName = subfamilyName]]. tts do: [:f | Descriptions remove: f]. ! ! !TTCFontDescription class methodsFor: 'deprecated instance creation' stamp: 'yo 12/7/2007 16:48'! descriptionNamed: descriptionName ^ TTFontDescription descriptionNamed: descriptionName. ! ! TTCFontDescription class removeSelector: #addFromSmartRefStream:! TTCFontDescription class removeSelector: #addFromTTFile:! TTCFontDescription class removeSelector: #clearDefault! TTCFontDescription class removeSelector: #clearDescriptions! TTCFontDescription class removeSelector: #default! TTCFontDescription class removeSelector: #initialize! TTCFontDescription class removeSelector: #removeDescriptionNamed:! TTCFontDescription class removeSelector: #setDefault! !TTCFontDescription class reorganize! ('deprecated instance creation' descriptionNamed: descriptionNamed:at:) ! TTCFontDescription removeSelector: #at:! TTCFontDescription removeSelector: #compactForRanges:! TTCFontDescription removeSelector: #deepCopy! TTCFontDescription removeSelector: #name! TTCFontDescription removeSelector: #objectForDataStream:! TTCFontDescription removeSelector: #size! TTCFontDescription removeSelector: #veryDeepCopyWith:! TTCFontSet class removeSelector: #discardDefault! TTCFontSet class removeSelector: #initialize! TTCFontSet class removeSelector: #makeSmartRefFileFrom:encodingTag:ranges:! TTCFontSet class removeSelector: #removeStyleName:! TTCFontSet class removeSelector: #reorganizeForNewFontArray:name:! TTCFontSet class removeSelector: #setDefault! !TTCFontSet class reorganize! ('instance creation' familyName:pointSize: familyName:pointSize:emphasized:) ('file out/in' installExternalFontFileName: makeSmartRefFilesFrom:encodingTag:ranges:outputFileName: newTextStyleFromSmartRefStream: newTextStyleFromTTFile: newTextStyleFromTTFile:encodingTag:ranges: newTextStyleFromTT:) ('accessing' pointSizes) ('registry' register:at: registry unregister:) ('*sixx-instance creation' familyName:size:emphasized:) ('private' getExistings: newFontArray:) ! TTCFontSet removeSelector: #derivativeFontArray! AbstractFont subclass: #TTCFontSet instanceVariableNames: 'fontArray foregroundColor derivatives fallbackFont' classVariableNames: '' poolDictionaries: '' category: 'Multilingual-Display'! !TTCFontSet reorganize! ('accessing' ascent ascentOf: baseKern depth descent descentKern descentOf: emphasis familyName familySizeFace fontArray height lineGrid maxAsciiFor: pointSize pointSizes subfamilyName textStyle ttcDescription widthOf:) ('displaying' displayStringR2L:on:from:to:at:kern: displayString:on:from:to:at:kern: displayString:on:from:to:at:kern:baselineY:) ('displaying private' glyphInfoOf:into: installOn: installOn:foregroundColor:backgroundColor: questionGlyphInfoInto:) ('initialization' initializeWithFontArray:) ('testing' isFontSet isRegular isTTCFont) ('objects from disk' objectForDataStream:) ('derivatives' derivativeFonts derivativeFont: derivativeFont:at: emphasis: emphasized: pointSize: privatePointSize:) ('private' addLined:) ! !TTCFontReader reorganize! ('all' decodeCmapFmtTable: getTableDirEntry:from:offset: parseTTCHeaderFrom: processCharMap: processCharacterMappingTable: readFrom: readFrom:fromOffset:at: readTTFFrom:) ! TTCFont removeSelector: #derivativeFontArray!