[squeak-dev] The Trunk: TrueType-mt.66.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Feb 6 12:17:54 UTC 2022


Marcel Taeumel uploaded a new version of TrueType to project The Trunk:
http://source.squeak.org/trunk/TrueType-mt.66.mcz

==================== Summary ====================

Name: TrueType-mt.66
Author: mt
Time: 6 February 2022, 1:17:53.180367 pm
UUID: 549ac535-cdc2-ef4b-9d1f-fa74a7a901cb
Ancestors: TrueType-mt.65

Refactors character mapping during TTF/TTC parsing. Windows' symbol fonts work now correctly. Does not treat that duplication in TTFileDescription.

=============== Diff against TrueType-mt.65 ===============

Item was changed:
  ----- Method: TTCFont>>isSymbolFont (in category 'testing') -----
  isSymbolFont
+ 	"https://docs.microsoft.com/en-us/typography/opentype/spec/cmap#encoding-records-and-encodings"
+ 	
+ 	^ (self hasGlyphOf: $a) not or: [self hasGlyphForCode: 16rF020]!
- 
- 	^ (self hasGlyphOf: $a) not!

Item was added:
+ Object subclass: #TTCharacterMappingTable
+ 	instanceVariableNames: 'version platformID encodingID characterMap macLanguageID'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'TrueType-Support'!

Item was added:
+ ----- Method: TTCharacterMappingTable>>characterMap (in category 'accessing') -----
+ characterMap
+ 
+ 	^ characterMap!

Item was added:
+ ----- Method: TTCharacterMappingTable>>characterMap: (in category 'accessing') -----
+ characterMap: anObject
+ 
+ 	characterMap := anObject.!

Item was added:
+ ----- Method: TTCharacterMappingTable>>encodingID (in category 'accessing') -----
+ encodingID
+ 
+ 	^ encodingID!

Item was added:
+ ----- Method: TTCharacterMappingTable>>encodingID: (in category 'accessing') -----
+ encodingID: anObject
+ 
+ 	encodingID := anObject.!

Item was added:
+ ----- Method: TTCharacterMappingTable>>encodingName (in category 'accessing') -----
+ encodingName
+ 	"https://docs.microsoft.com/en-us/typography/opentype/spec/cmap"
+ 	
+ 	^ platformID caseOf: {
+ 		[0] -> [self encodingNameForUnicode].
+ 		[1] -> [self encodingNameForMacintosh].
+ 		[2] -> [self encodingNameForISO].
+ 		[3] -> [self encodingNameForWindows].
+ 		[4] -> ['OTF Windows NT compatibility mapping']
+ 	} !

Item was added:
+ ----- Method: TTCharacterMappingTable>>encodingNameForISO (in category 'accessing') -----
+ encodingNameForISO
+ 	"https://docs.microsoft.com/en-us/typography/opentype/spec/cmap"
+ 	
+ 	^ #(
+ 		'7-bit ASCII'
+ 		'ISO 10646'
+ 		'ISO 8859-1'
+ 	) at: encodingID + 1!

Item was added:
+ ----- Method: TTCharacterMappingTable>>encodingNameForMacintosh (in category 'accessing') -----
+ encodingNameForMacintosh
+ 	"https://docs.microsoft.com/en-us/typography/opentype/spec/cmap"
+ 	
+ 	^ #('Roman' 'Japanese' 'Chinese (Traditional)' 'Korean' 'Arabic' 'Hebrew' 'Greek' 'Russian' 'RSymbol' 'Devanagari' 'Gurmukhi' 'Gujarati' 'Oriya' 'Bengali' 'Tamil' 'Telugu' 'Kannada' 'Malayalam' 'Sinhalese' 'Burmese' 'Khmer' 'Thai' 'Laotian' 'Georgian' 'Armenian' 'Chinese (Simplified)' 'Tibetan' 'Mongolian' 'Geez' 'Slavic' 'Vietnamese' 'Sindhi' 'Uninterpreted') at: encodingID + 1!

Item was added:
+ ----- Method: TTCharacterMappingTable>>encodingNameForUnicode (in category 'accessing') -----
+ encodingNameForUnicode
+ 	"https://docs.microsoft.com/en-us/typography/opentype/spec/cmap"
+ 	
+ 	^ #(
+ 		'Unicode 1.0 (deprecated)'
+ 		'Unicode 1.1 (deprecated)'
+ 		'ISO/IEC 10646 (deprecated)'
+ 		'Unicode 2.0+ (BMP only)' "basic multilingual pane"
+ 		'Unicode 2.0+ (full)'
+ 		'Unicode Variation Sequences (subtable format 14)'
+ 		'Unicode Full (subtable format 13)'	
+ 	) at: encodingID + 1 ifAbsent: [ 'unknown ', encodingID asString]!

Item was added:
+ ----- Method: TTCharacterMappingTable>>encodingNameForWindows (in category 'accessing') -----
+ encodingNameForWindows
+ 	"https://docs.microsoft.com/en-us/typography/opentype/spec/cmap"
+ 	
+ 	^ #(
+ 		'Symbol'
+ 		'Unicode BMP' "basic multilingual pane"
+ 		'ShiftJIS'
+ 		'PRC'
+ 		'Big5'
+ 		'Wansung'
+ 		'Johab'
+ 		'Reserved'
+ 		'Reserved'
+ 		'Reserved'
+ 		'Unicode Full'
+ 	) at: encodingID + 1!

Item was added:
+ ----- Method: TTCharacterMappingTable>>isMacintosh (in category 'testing') -----
+ isMacintosh
+ 
+ 	^ platformID = 1!

Item was added:
+ ----- Method: TTCharacterMappingTable>>isUnicode (in category 'testing') -----
+ isUnicode
+ 
+ 	^ platformID = 0!

Item was added:
+ ----- Method: TTCharacterMappingTable>>isWindows (in category 'testing') -----
+ isWindows
+ 
+ 	^ platformID = 3!

Item was added:
+ ----- Method: TTCharacterMappingTable>>macEncodingName (in category 'accessing') -----
+ macEncodingName
+ 
+ 	^#('Roman' 'Japanese' 'Chinese (Traditional)' 'Korean' 'Arabic' 'Hebrew' 'Greek' 'Russian' 'RSymbol' 'Devanagari' 'Gurmukhi' 'Gujarati' 'Oriya' 'Bengali' 'Tamil' 'Telugu' 'Kannada' 'Malayalam' 'Sinhalese' 'Burmese' 'Khmer' 'Thai' 'Laotian' 'Georgian' 'Armenian' 'Chinese (Simplified)' 'Tibetan' 'Mongolian' 'Geez' 'Slavic' 'Vietnamese' 'Sindhi' 'Uninterpreted') at: encodingID + 1!

Item was added:
+ ----- Method: TTCharacterMappingTable>>macLanguageID (in category 'accessing') -----
+ macLanguageID
+ 
+ 	^ macLanguageID!

Item was added:
+ ----- Method: TTCharacterMappingTable>>macLanguageID: (in category 'accessing') -----
+ macLanguageID: anObject
+ 
+ 	macLanguageID := anObject.!

Item was added:
+ ----- Method: TTCharacterMappingTable>>macLanguageName (in category 'accessing') -----
+ macLanguageName
+ 	
+ 	self
+ 		assert: [platformID = 1]
+ 		description: 'LanguageID is only defined for the macOS platform'.
+ 		
+ 	^ #('English' 'French' 'German' 'Italian' 'Dutch' 'Swedish' 'Spanish' 'Danish' 'Portuguese' 'Norwegian' 'Hebrew' 'Japanese' 'Arabic' 'Finnish' 'Greek' 'Icelandic' 'Maltese' 'Turkish' 'Croatian' 'Chinese (Traditional)' 'Urdu' 'Hindi' 'Thai' 'Korean' 'Lithuanian' 'Polish' 'Hungarian' 'Estonian' 'Latvian' 'Sami' 'Faroese' 'Farsi/Persian' 'Russian' 'Chinese (Simplified)' 'Flemish' 'Irish Gaelic' 'Albanian' 'Romanian' 'Czech' 'Slovak' 'Slovenian' 'Yiddish' 'Serbian' 'Macedonian' 'Bulgarian' 'Ukrainian' 'Byelorussian' 'Uzbek' 'Kazakh' 'Azerbaijani (Cyrillic script)' 'Azerbaijani (Arabic script)' 'Armenian' 'Georgian' 'Moldavian' 'Kirghiz' 'Tajiki' 'Turkmen' 'Mongolian (Mongolian script)' 'Mongolian (Cyrillic script)' 'Pashto' 'Kurdish' 'Kashmiri' 'Sindhi' 'Tibetan' 'Nepali' 'Sanskrit' 'Marathi' 'Bengali' 'Assamese' 'Gujarati' 'Punjabi' 'Oriya' 'Malayalam' 'Kannada' 'Tamil' 'Telugu' 'Sinhalese' 'Burmese' 'Khmer' 'Lao' 'Vietnamese' 'Indonesian' 'Tagalog' 'Malay (Roman script)' 'Malay (Ara
 bic script)' 'Amharic' 'Tigrinya' 'Galla' 'Somali' 'Swahili' 'Kinyarwanda/Ruanda' 'Rundi' 'Nyanja/Chewa' 'Malagasy' 'Esperanto')
+ 		at: macLanguageID + 1 ifAbsent: [
+ 			#('Welsh' 'Basque' 'Catalan' 'Latin' 'Quechua' 'Guarani' 'Aymara' 'Tatar' 'Uighur' 'Dzongkha' 'Javanese (Roman script)' 'Sundanese (Roman script)' 'Galician' 'Afrikaans' 'Breton' 'Inuktitut' 'Scottish Gaelic' 'Manx Gaelic' 'Irish Gaelic (with dot above)' 'Tongan' 'Greek (polytonic)' 'Greenlandic' 'Azerbaijani (Roman script)')
+ 				at: macLanguageID - 128 + 1]!

Item was added:
+ ----- Method: TTCharacterMappingTable>>macToWin: (in category 'mapping') -----
+ macToWin: index
+ 	^ (index - 1) asCharacter macToSqueak asciiValue + 1!

Item was added:
+ ----- Method: TTCharacterMappingTable>>map: (in category 'mapping') -----
+ map: glyphs
+ 
+ 	self isUnicode ifTrue: [^ self mapFromUnicode: glyphs].
+ 	self isMacintosh ifTrue: [^ self mapFromMacintosh: glyphs].
+ 	self isWindows ifTrue: [^ self mapFromWindows: glyphs].
+ 	
+ 	"Fallback"
+ 	self notify: 'Platform is not supported: ', self platformName.
+ 	^ Array new: 256 withAll: glyphs first!

Item was added:
+ ----- Method: TTCharacterMappingTable>>mapFromMacintosh: (in category 'mapping') -----
+ mapFromMacintosh: glyphs
+ 
+ 	| charTable glyph |
+ 	self
+ 		assert: [#(0 "MacRoman") includes: encodingID]
+ 		description: 'Encoding not supported: ' self encodingName.
+ 
+ 	self flag: #todo. "Support encodingID and macLanguageID."
+ 	
+ 	charTable := Array new: 256 withAll: glyphs first. "Initialize with default glyph"
+ 	1 to: (characterMap size min: charTable size) do:
+ 		[:i |
+ 		glyph := glyphs at: (characterMap at: i) + 1.
+ 		charTable at: (self macToWin: i) put: glyph].
+ 	^ charTable!

Item was added:
+ ----- Method: TTCharacterMappingTable>>mapFromUnicode: (in category 'mapping') -----
+ mapFromUnicode: glyphs
+ 
+ 	| charTable glyph |
+ 	self
+ 		assert: [encodingID >= 3]
+ 		description: 'Encoding not supported: ', self encodingName.
+ 
+ 	charTable := SparseLargeTable new: characterMap size
+ 		chunkSize: 256 arrayClass: Array base: 1
+ 		defaultValue: glyphs first.
+ 	1 to: charTable size do:
+ 		[:i |
+ 		glyph := glyphs at: (characterMap at: i) + 1 ifAbsent: [glyphs first].
+ 		charTable at: i put: glyph].
+ 	
+ 	charTable zapDefaultOnlyEntries.
+ 	^charTable!

Item was added:
+ ----- Method: TTCharacterMappingTable>>mapFromWindows: (in category 'mapping') -----
+ mapFromWindows: glyphs
+ 
+ 	| charTable glyph |	
+ 	self
+ 		assert: [#(0 1) includes: encodingID]
+ 		description: 'Encoding not supported: ', self encodingName.
+ 
+ 	charTable := characterMap size > 256
+ 		ifFalse: [Array new: 256 withAll: glyphs first]
+ 		ifTrue: [SparseLargeTable new: characterMap size
+ 			chunkSize: 256 arrayClass: Array base: 1
+ 			defaultValue: glyphs first].
+ 
+ 	1 to: (characterMap size min: charTable size) do: [:i |
+ 		| glyphIndex |
+ 		glyphIndex := characterMap at: i.
+ 		encodingID = 0 ifTrue: [ "symbol font"
+ 			glyphIndex := glyphIndex bitAnd: 16r00FF].
+ 		glyph := glyphs at: glyphIndex + 1 ifAbsent: [glyphs first].
+ 		charTable at: i put: glyph.
+ 		encodingID = 0 ifTrue: [ "symbol font" 
+ 			(i-1 between: 16rF020 and: 16rF0FF) ifTrue: [ "copy into ascii range"
+ 				charTable at: (i-1 bitAnd: 16r00FF)+1 put: glyph]]].
+ 		
+ 	^ charTable!

Item was added:
+ ----- Method: TTCharacterMappingTable>>platformID (in category 'accessing') -----
+ platformID
+ 
+ 	^ platformID!

Item was added:
+ ----- Method: TTCharacterMappingTable>>platformID: (in category 'accessing') -----
+ platformID: anObject
+ 
+ 	platformID := anObject.!

Item was added:
+ ----- Method: TTCharacterMappingTable>>platformName (in category 'accessing') -----
+ platformName
+ 
+ 	^ platformID caseOf: {
+ 		[0] -> [#Unicode].
+ 		[1] -> [#Macintosh].
+ 		[2] -> [#ISO "deprecated"].
+ 		[3] -> [#Windows].
+ 		[4] -> [#Custom]
+ 	}!

Item was added:
+ ----- Method: TTCharacterMappingTable>>printOn: (in category 'printing') -----
+ printOn: stream
+ 
+ 	stream
+ 		nextPutAll: 'cmap( ';
+ 		nextPutAll: self platformName;
+ 		nextPutAll: ' ; ';
+ 		nextPutAll: self encodingName.
+ 		
+ 	self isMacintosh ifTrue: [
+ 		stream
+ 			nextPut: $<;
+ 			nextPutAll: self macLanguageName;
+ 			nextPut: $>].
+ 		
+ 	stream
+ 		nextPutAll: ' ; ';
+ 		nextPutAll: self characterMap size asString;
+ 		nextPutAll: ' )'.!

Item was added:
+ ----- Method: TTCharacterMappingTable>>version (in category 'accessing') -----
+ version
+ 
+ 	^ version!

Item was added:
+ ----- Method: TTCharacterMappingTable>>version: (in category 'accessing') -----
+ version: anObject
+ 
+ 	version := anObject.!

Item was added:
+ ----- Method: TTCharacterMappingTable>>winToMac: (in category 'mapping') -----
+ winToMac: index
+ 	^ (index - 1) asCharacter squeakToMac asciiValue + 1!

Item was added:
+ ----- Method: TTFontReader>>decodeCmapFmtTable0: (in category 'private') -----
+ decodeCmapFmtTable0: entry
+ 	"byte encoded table"
+ 		
+ 	| length language cmap |
+ 	length := entry nextUShort.
+ 	language := entry nextUShort.
+ 	
+ 	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.
+ 	^ {language. cmap}!

Item was added:
+ ----- Method: TTFontReader>>decodeCmapFmtTable4: (in category 'private') -----
+ decodeCmapFmtTable4: entry
+ 	"segment mapping to deltavalues"
+ 		
+ 	| length language entryCount segCount segments offset cmap |
+ 	length := entry nextUShort.
+ 	language := entry nextUShort.
+ 
+ 	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"
+ 	entryCount := segments inject: 0 into: [:max :seg | max max: seg second].
+ 	cmap := Array new: entryCount+1 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]].
+ 	
+ 	^ {language. cmap}!

Item was added:
+ ----- Method: TTFontReader>>decodeCmapFmtTable6: (in category 'private') -----
+ decodeCmapFmtTable6: entry
+ 	"trimmed table"
+ 	
+ 	| length language entryCount cmap firstCode |
+ 	length := entry nextUShort.
+ 	language := entry nextUShort.
+ 
+ 	firstCode := entry nextUShort.
+ 	entryCount := entry nextUShort.
+ 	cmap := Array new: entryCount + firstCode withAll: 0.
+ 	entryCount timesRepeat:
+ 		[cmap at: (firstCode := firstCode + 1) put: entry nextUShort].
+ 
+ 	^ {language. cmap}!

Item was changed:
  ----- Method: TTFontReader>>decodeCmapFmtTable: (in category 'private') -----
  decodeCmapFmtTable: entry
+ 	"Decode cmap table. Currently supports formats 0, 4, and 6
+ 	https://docs.microsoft.com/en-us/typography/opentype/spec/cmap#format-0-byte-encoding-table"
+ 	
+ 	| cmapFmt |
+ 	^ (cmapFmt := entry nextUShort)
+ 		caseOf: {
+ 			[0] -> [self decodeCmapFmtTable0: entry].
+ 			[4] -> [self decodeCmapFmtTable4: entry].
+ 			[6] -> [self decodeCmapFmtTable6: entry].
+ 		} otherwise: [self error: 'Unsupported encoding of cmap: ', cmapFmt]!
- 	| 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"
- 		entryCount := segments inject: 0 into: [:max :seg | max max: seg second].
- 		cmap := Array new: entryCount+1 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]].
- 		^ 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: TTFontReader>>macToWin: (in category 'private') -----
- macToWin: index
- 	^ (index - 1) asCharacter macToSqueak asciiValue + 1!

Item was changed:
  ----- Method: TTFontReader>>processCharMap: (in category 'processing - support') -----
+ processCharMap: mappingTables
+ 	"Process the given character map. Prefer Unicode mappings"
- processCharMap: assoc
- 	"Process the given character map"
  
+ 	mappingTables explore.
- 	| charTable glyph cmap |
- 	cmap := assoc value.
  
+ 	^ mappingTables
+ 		detect: [:ea | ea isUnicode]
+ 		ifFound: [:table | table map: glyphs]
+ 		ifNone: [mappingTables last map: glyphs]!
- 	assoc key = 0 ifTrue: "Unicode table"
- 		[charTable := SparseLargeTable new: cmap size
- 			chunkSize: 256 arrayClass: Array base: 1
- 			defaultValue: glyphs first.
- 		1 to: charTable size do:
- 			[:i |
- 			glyph := glyphs at: (cmap at: i) + 1 ifAbsent: [glyphs first].
- 			charTable at: i put: glyph].
- 		charTable zapDefaultOnlyEntries.
- 		^charTable].
- 
- 	charTable := Array new: 256 withAll: glyphs first. "Initialize with default glyph"
- 
- 	assoc key = 1 ifTrue: "Mac encoded table"
- 		[1 to: (cmap size min: charTable size) do:
- 			[:i |
- 			glyph := glyphs at: (cmap at: i) + 1.
- 			charTable at: (self macToWin: i) put: glyph]].
- 
- 	assoc key = 3 ifTrue: "Win encoded table"
- 		[1 to: (cmap size min: charTable size) do:
- 			[:i |
- 			glyph := glyphs at: (cmap at: i) + 1.
- 			charTable at: i put: glyph]].
- 
- 	^ charTable!

Item was changed:
  ----- Method: TTFontReader>>processCharMapENC: (in category 'processing - support') -----
+ processCharMapENC: mappingTables
- processCharMapENC: assoc
  	"Process the given character map"
  
  	| glyph cmap encode0 encode1 char value null |
+ 	self flag: #deprecated.
+ 	cmap := mappingTables
+ 		detect: [:ea | ea isUnicode]
+ 		ifFound: [:table | table characterMap]
+ 		ifNone: [mappingTables last characterMap].
- 	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: [ "???"
  			| g |
  			g := glyphs at: value+1 ifAbsent: [ null. ].
  			(g isKindOf: TTCompositeGlyph) ifFalse: [
  				encode1 at: i+1 put: g.
  			] ifTrue: [
  				g basicGlyphs: (((glyphs at: value+1) basicGlyphs) collect: [:t | t key->(glyphs at: (t value glyphIndex+1))]).
  				encode1 at: i+1 put: g
  			].
  		]
  	].
  
  	^ {encode0. encode1}.
  !

Item was changed:
  ----- Method: TTFontReader>>processCharacterMappingTable: (in category 'processing - tables') -----
  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"
+ 	| initialOffset nSubTables tables tableVersion |
- 	| copy initialOffset nSubTables pID sID offset cmap assoc |
  	initialOffset := entry offset.
+ 	tableVersion := entry nextUShort.
- 	entry skip: 2. "Skip table version"
  	nSubTables := entry nextUShort.
+ 	tables := OrderedCollection new.
  	1 to: nSubTables do:[:i|
+ 		| platformID encodingID offset copy cmap |
+ 		platformID := entry nextUShort.
+ 		encodingID := entry nextUShort.
- 		pID := entry nextUShort.
- 		sID := entry nextUShort.
  		offset := entry nextULong.
+ 		"Go to the beginning of the table"
+ 		copy := entry copy.
+ 		copy offset: initialOffset + offset.
+ 		cmap := self decodeCmapFmtTable: copy.
+ 		tables add: (TTCharacterMappingTable new
+ 			version: tableVersion;
+ 			platformID: platformID;
+ 			encodingID: encodingID;
+ 			characterMap: cmap second;
+ 			macLanguageID: cmap first;
+ 			yourself)].
+ 	^ tables!
- 		"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].
- 				"(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 better table"
- 			].
- 		].
- 	].
- 	^assoc!

Item was removed:
- ----- Method: TTFontReader>>winToMac: (in category 'private') -----
- winToMac: index
- 	^ (index - 1) asCharacter squeakToMac asciiValue + 1!



More information about the Squeak-dev mailing list