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

commits at source.squeak.org commits at source.squeak.org
Thu Feb 3 15:27:03 UTC 2022


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

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

Name: TrueType-mt.60
Author: mt
Time: 3 February 2022, 4:27:02.246027 pm
UUID: 34f587e4-3c6f-2e40-b722-10f3742eda7c
Ancestors: TrueType-mt.59

Complements Graphics-mt.471

=============== Diff against TrueType-mt.59 ===============

Item was changed:
  ----- Method: LinedTTCFont>>computeForm: (in category 'private') -----
  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 lineGlyphWidth: contourWidth emphasis: emphasis!
- 	^ 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 changed:
  ----- 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."
+ 	^ ({TextStyle defaultFont pointSize. self referencePointSize}, #(9 12 15 24 36)) asSet asArray sorted!
- 	^ #(9 12 15 24 36).
- !

Item was changed:
  ----- Method: TTCFont class>>registerAll (in category 'other') -----
  registerAll
  "
  	TTCFont registerAll
  "
  
+ 	self registry removeAll.
+ 	TextStyle actualTextStyles valuesDo: [:e |
- 	TextStyle allInstancesDo: [:e |
  		(e fontArray first isMemberOf: TTCFont) ifTrue: [
  			self register: e fontArray at: e fontArray first familyName asSymbol.
  		].
  	].
  !

Item was changed:
  ----- Method: TTCFont class>>reorganizeForNewFontArray:name: (in category 'other') -----
  reorganizeForNewFontArray: array name: styleName
  
  	| style existings regular altName |
  	(TextConstants includesKey: styleName) ifFalse: [
+ 		style := TextConstants at: styleName put: (TextStyle fontArray: array).
+ 		style defaultFontIndex: (style fontIndexOfPointSize: TextStyle defaultFont pointSize).
+ 		^ style
- 		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.
+ 	style defaultFont asPointSize: TextStyle defaultFont pointSize. "May create new point size"
+ 	style defaultFontIndex: (style fontIndexOfPointSize: TextStyle defaultFont pointSize).
+ 	
  	self register: regular at: styleName.
  	self recreateCache.	
  	^ style.
  !

Item was changed:
  ----- Method: TTCFont>>ascent (in category 'accessing') -----
  ascent
+ 	"Compute the #ascent from the font description. Avoid the use of #typographicAscender to make receiver compatible with pixel-based rendering. Note that only #height and #ascent are used for paragraph layouting and rendering. See TextStyle's #lineGrid and #baseline used in CharacterScanner."
+ 
+ 	^ ascent ifNil: [ascent := (ttcDescription ascender * self pixelScale) rounded]
+ 	"^ ascent ifNil: [ascent := (ttcDescription typographicAscender * self pixelScale) rounded]"
+ 	"^ ascent ifNil: [ascent := self height - self descent]"!
- 	^ascent ifNil:[ascent := (ttcDescription typographicAscender * self pixelScale) truncated].!

Item was changed:
  ----- Method: TTCFont>>basicHasGlyphOf: (in category 'private') -----
  basicHasGlyphOf: aCharacter
  	"Answer whether this font includes a glyph for the given character"
+ 
+ 	^ self hasGlyphForCode: (self codeForCharacter: aCharacter)!
- 	^ aCharacter charCode <= self maxAscii
- 		and:[
- 			aCharacter = Character null
- 				ifTrue: [(self formOf: aCharacter) notNil]
- 				ifFalse: [
- 					"this should also be
- 						 (self formOf: aCharacter) notNil
- 					but it does not work, the fallback glyph -- if present -- is always found instead.
- 					So we fake. if aCharacter is the same form as Character null aka 0, we assume absence."
- 					(self characterFormAt: aCharacter) bits ~= self fallbackForm bits]]!

Item was added:
+ ----- Method: TTCFont>>codeForCharacter: (in category 'private') -----
+ codeForCharacter: aCharacter
+ 
+ 	^ aCharacter charCode!

Item was changed:
  ----- Method: TTCFont>>descent (in category 'accessing') -----
  descent
+ 	"See commentary in #ascent."
+ 
+ 	^ descent ifNil: [descent := self height - self ascent]
+ 	"^ descent ifNil: [descent := (ttcDescription descender * self pixelScale) abs rounded]]"
+ 	"^ descent ifNil:[descent := (ttcDescription typographicDescender * self pixelScale) abs rounded]"!
- 	"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>>fallbackForm (in category 'private') -----
- fallbackForm
- 	"Compute the glyph form for the fallback glyph"
- 	^ttcDescription renderFallbackGlyphOfHeight: self height fgColor: foregroundColor bgColor: Color transparent depth: self depth!

Item was changed:
  ----- Method: TTCFont>>familyName (in category 'accessing') -----
  familyName
+ 	"Use #name instead of #familyName to ignore separators."
+ 	
+ 	^ ttcDescription name!
- 
- 	^ ttcDescription name.
- !

Item was added:
+ ----- Method: TTCFont>>hasGlyphForCode: (in category 'private') -----
+ hasGlyphForCode: aCharacterCode
+ 	"Answer whether this font includes a glyph for the given character"
+ 
+ 	(aCharacterCode between: self minCodePoint and: self maxCodePoint)
+ 		ifFalse: [^ false].
+ 	(cache notNil and: [(cache at: aCharacterCode + 1 ifAbsent: [nil]) notNil])
+ 		ifTrue: [^ true "fallback glyphs via #fallbackFont"].
+ 	(ttcDescription at: "expensive for TTFileDescription" aCharacterCode) isFallback
+ 		ifTrue: [^ false].
+ 	^ true!

Item was removed:
- ----- Method: TTCFont>>hasGlyphOf: (in category 'private') -----
- hasGlyphOf: aCharacter
- 	"Answer whether this font includes a glyph for the given character (or a fallback)"
- 	self flag: #topa. "formOf: never actually returns nil for ttcfonts..."
- 	^ aCharacter charCode <= self maxAscii
- 		and:[(self formOf: aCharacter) notNil]!

Item was changed:
  ----- Method: TTCFont>>height (in category 'accessing') -----
  height
+ 	"Answer my height in pixels. NOTE THAT on 2/1/2022 we removed the addition of #lineGap here because this would increase the glyph height, which is wrong. See #computeForm:. TextStyle has a #leading(:) to configure that for now."
+ 
+ 	^ height ifNil: [height := self pixelSize]!
- 	"Answer my height in pixels. This will answer a Float."
- 	^height ifNil:[height := self pixelSize + self lineGap]!

Item was changed:
  ----- Method: TTCFont>>lineGap (in category 'accessing') -----
  lineGap
+ 	"Answer the line gap from the ttf description. Use #typographicLineGap to make larger tests more ledigble."
+ 
+ 	"^ (ttcDescription lineGap * self pixelScale) rounded"
+ 	^ ((self pixelSize asFloat / ttcDescription typographicFontHeight) * ttcDescription typographicLineGap) rounded!
- 	"Answer the line gap from the ttf description"
- 	^self pixelSize * ttcDescription typographicLineGap // ttcDescription typographicFontHeight!

Item was removed:
- ----- Method: TTCFont>>maxAscii (in category 'accessing') -----
- maxAscii
- 
- 	self flag: #deprecated.
- 	^ self maxCodePoint!

Item was removed:
- ----- Method: TTCFont>>minAscii (in category 'accessing') -----
- minAscii
- 
- 	self flag: #deprecated.
- 	^ self minCodePoint
- !

Item was changed:
  ----- Method: TTCFont>>pixelScale (in category 'accessing') -----
  pixelScale
+ 	"Answer the scale factor to convert from the truetype's units into the receiver's pixel size. Avoid the use of #typographicFontHeight to make receiver compatible with pixel-based rendering."
+ 
+ 	^self pixelSize asFloat / ttcDescription fontHeight
+ 	"^ self pixelSize asFloat / ttcDescription typographicFontHeight"!
- 	"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 changed:
  ----- Method: TTCFontReader>>readFrom:fromOffset:at: (in category 'private') -----
  readFrom: fontData fromOffset: offset at: encodingTag
  
+ 	| headerEntry maxProfileEntry nameEntry indexLocEntry charMapEntry glyphEntry horzHeaderEntry horzMetricsEntry kerningEntry os2Entry glyphOffset cmap numHMetrics indexToLocFormat fontDescription0 fontDescription1 array result |
- 	| 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].
+ 	(os2Entry := self getTableDirEntry: 'OS/2' from: fontData offset: offset) == nil ifTrue:[
+ 		Transcript cr; show: 'This font does not have a OS/2 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].
+ 	os2Entry ifNotNil: [self processOS2Table: os2Entry].
  	array := self processCharMap: cmap.
  	fontDescription0 := fontDescription shallowCopy.
  	fontDescription1 := fontDescription shallowCopy.
  	fontDescription0 setGlyphs: (array at: 1) mapping: (array at: 1)..
  	fontDescription1 setGlyphs: (array at: 2) mapping: (array at: 2)..
  	fontDescription0 setKernPairs: kernPairs.
  	fontDescription1 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: TTCFontSet>>hasGlyphOf: (in category 'private') -----
- hasGlyphOf: aCharacter
- 	"see TTCFont>>hasGlyphOf:"
- 	^ fontArray first hasGlyphOf: aCharacter!

Item was changed:
  ----- Method: TTCFontSet>>height (in category 'accessing') -----
  height
  
+ 	^fontArray first height
- 	^fontArray first pixelSize.
  !

Item was changed:
  Object subclass: #TTFileDescription
+ 	instanceVariableNames: 'fileName fileOffset familyName subfamilyName copyright ascender descender lineGap unitsPerEm numGlyphs indexToLocOffset indexToLocFormat glyphTableOffset cmapType cmapOffset numHMetrics hmtxTableOffset sTypoAscender sTypoDescender sTypoLineGap extraScale'
- 	instanceVariableNames: 'fileName fileOffset familyName subfamilyName copyright ascender descender lineGap unitsPerEm numGlyphs indexToLocOffset indexToLocFormat glyphTableOffset cmapType cmapOffset numHMetrics hmtxTableOffset sTypoAscender sTypoDescender sTypoLineGap'
  	classVariableNames: 'AllFontsAndFiles FontPaths OfferNonPortableFonts'
  	poolDictionaries: ''
  	category: 'TrueType-Fonts'!
  
  !TTFileDescription commentStamp: 'ar 7/29/2009 22:18' prior: 0!
  Contrary to TTFontDescritption, this class leaves true type files on disk and only reads the required portions when constructing glyphs. This avoids the need of reading the entire font into memory at the cost of having to hit disk whenever a glyph is requested.!

Item was added:
+ ----- Method: TTFileDescription>>extraScale (in category 'accessing') -----
+ extraScale
+ 
+ 	^ extraScale ifNil: [extraScale := TTFontDescription extraScaleFor: self]!

Item was added:
+ ----- Method: TTFileDescription>>extraScale: (in category 'accessing') -----
+ extraScale: aFloatOrNil
+ 	"EXPERIMENTAL. Increase the glyph size without increasing the pixel size for a certain point size. Consequently, if the scale factor is too large, you will notice clipping artifacts."
+ 
+ 	self extraScale = aFloatOrNil ifTrue: [^ self].
+ 	extraScale := aFloatOrNil.
+ 	TTCFont allSubInstancesDo: [:font | font ttcDescription == self ifTrue: [font flushCache]].!

Item was added:
+ ----- Method: TTFileDescription>>isExternal (in category 'testing') -----
+ isExternal
+ 	"Answer whether the receiver get's its data from an external file."
+ 
+ 	^ true!

Item was changed:
  ----- Method: TTFileDescription>>name (in category 'accessing') -----
  name
  	"For compatibility with TTFontDescription"
+ 	^familyName copyWithout: Character space!
- 	^familyName!

Item was removed:
- ----- Method: TTFileDescription>>renderFallbackGlyphOfHeight:fgColor:bgColor:depth: (in category 'rendering') -----
- renderFallbackGlyphOfHeight: height fgColor: fgColor bgColor: bgColor depth: depth
- 	"Render the glyph with the given code point at the specified pixel height."
- 	^ self fallbackGlyph
- 		asFormWithScale: height asFloat / (ascender - descender) 
- 			ascender: ascender 
- 			descender: descender 
- 			fgColor: fgColor bgColor: bgColor depth: depth!

Item was changed:
  ----- Method: TTFileDescription>>renderGlyph:height:fgColor:bgColor:depth: (in category 'rendering') -----
  renderGlyph: code height: height fgColor: fgColor bgColor: bgColor depth: depth
  	"Render the glyph with the given code point at the specified pixel height."
  	^(self at: code) 
+ 		asFormWithScale: height asFloat / (self fontHeight / self extraScale)
+ 			ascender: self ascender / self extraScale
+ 			descender: self descender / self extraScale
- 		asFormWithScale: height asFloat / (ascender - descender) 
- 			ascender: ascender 
- 			descender: descender 
  			fgColor: fgColor bgColor: bgColor depth: depth!

Item was changed:
  ----- Method: TTFileDescription>>typographicFontHeight (in category 'accessing') -----
  typographicFontHeight
  	"cope for the fact that typographicAscender and 
  	typographicDescender may not be available and 
  	0-height fonts are a bit useless"
  	| tfh |
  	tfh := self typographicAscender - self typographicDescender.
  	^ tfh = 0 ifTrue: [self fontHeight] ifFalse: [tfh]!

Item was changed:
  Object subclass: #TTFontDescription
+ 	instanceVariableNames: 'glyphTable glyphs kernPairs copyright familyName fullName subfamilyName uniqueName versionName postscriptName trademark bounds unitsPerEm ascender descender lineGap sTypoAscender sTypoDescender sTypoLineGap extraScale'
- 	instanceVariableNames: 'glyphTable glyphs kernPairs copyright familyName fullName subfamilyName uniqueName versionName postscriptName trademark bounds unitsPerEm ascender descender lineGap sTypoAscender sTypoDescender sTypoLineGap'
  	classVariableNames: 'Default Descriptions'
  	poolDictionaries: ''
  	category: 'TrueType-Fonts'!
  
  !TTFontDescription commentStamp: '<historical>' prior: 0!
  Holds a TrueType font in memory.  Is used by TTSampleStringMorph as its font.  
  
  Class owns a default example.  !

Item was added:
+ ----- Method: TTFontDescription class>>extraScaleFor: (in category 'defaults') -----
+ extraScaleFor: ttcDescription
+ 	"Answers a factor for #extraScale for selected font families. They represent a trade-off between legibility and correctness."
+ 
+ 	^ ttcDescription familyName caseOf: {
+ 		['Bitstream Vera Sans'] -> [1.04].
+ 		['Bitstream Vera Sans Mono'] -> [1.04].
+ 		['Bitstream Vera Serif'] -> [1.04].
+ 	} otherwise: [(((ttcDescription ascender - ttcDescription descender) / ttcDescription unitsPerEm) - 0.1 roundTo: 0.01) max: 1.0]!

Item was changed:
  ----- Method: TTFontDescription>>at: (in category 'accessing') -----
  at: aCharOrInteger
+ 
+ 	^ glyphTable
+ 		at: (aCharOrInteger isCharacter
+ 			ifTrue: [aCharOrInteger charCode]
+ 			ifFalse: [aCharOrInteger]) + 1
+ 		ifAbsent: [self fallbackGlyph]!
- 	^glyphTable at: (aCharOrInteger isCharacter ifTrue: [aCharOrInteger charCode] ifFalse: [aCharOrInteger])+1!

Item was added:
+ ----- Method: TTFontDescription>>extraScale (in category 'accessing') -----
+ extraScale
+ 	"
+ 	TTCFont allSubInstancesDo: [:f | f ttcDescription extraScale: nil]
+ 	"
+ 	^ extraScale ifNil: [extraScale := self class extraScaleFor: self]!

Item was added:
+ ----- Method: TTFontDescription>>extraScale: (in category 'accessing') -----
+ extraScale: aFloatOrNil
+ 	"EXPERIMENTAL. Increase the glyph size without increasing the pixel size for a certain point size. Consequently, if the scale factor is too large, you will notice clipping artifacts."
+ 
+ 	self extraScale = aFloatOrNil ifTrue: [^ self].
+ 	extraScale := aFloatOrNil.
+ 	TTCFont allSubInstancesDo: [:font | font ttcDescription == self ifTrue: [font flushCache]].!

Item was added:
+ ----- Method: TTFontDescription>>isExternal (in category 'testing') -----
+ isExternal
+ 	"Answer whether the receiver get's its data from an external file."
+ 
+ 	^ false!

Item was removed:
- ----- Method: TTFontDescription>>renderFallbackGlyphOfHeight:fgColor:bgColor:depth: (in category 'rendering') -----
- renderFallbackGlyphOfHeight: height fgColor: fgColor bgColor: bgColor depth: depth
- 	"Render the glyph with the given code point at the specified pixel height."
- 	^ self fallbackGlyph
- 		asFormWithScale: height asFloat / (ascender - descender) 
- 			ascender: ascender 
- 			descender: descender 
- 			fgColor: fgColor bgColor: bgColor depth: depth!

Item was changed:
  ----- Method: TTFontDescription>>renderGlyph:height:fgColor:bgColor:depth: (in category 'rendering') -----
  renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth
  	"Render the glyph with the given code point at the specified pixel height."
  	^(self at: code) 
+ 		asFormWithScale: fontHeight asFloat / (self fontHeight / self extraScale)
+ 			ascender: self ascender / self extraScale
+ 			descender: self descender / self extraScale
- 		asFormWithScale: fontHeight asFloat / (ascender - descender) 
- 			ascender: ascender 
- 			descender: descender 
  			fgColor: fgColor bgColor: bgColor depth: depth!

Item was changed:
  ----- Method: TTFontDescription>>typographicFontHeight (in category 'accessing') -----
  typographicFontHeight
  	"cope for the fact that typographicAscender and 
  	typographicDescender may not be available and 
  	0-height fonts are a bit useless"
  	| tfh |
  	tfh := self typographicAscender - self typographicDescender.
  	^ tfh = 0 ifTrue: [self fontHeight] ifFalse: [tfh]!

Item was changed:
  ----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth:replaceColor: (in category 'converting') -----
  asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth replaceColor: replaceColorFlag
  
  	^ self
  		asFormWithScale: scale
  		ascender: ascender
  		descender: descender
  		fgColor: fgColor
  		bgColor: bgColor
  		depth: depth
  		replaceColor: replaceColorFlag
  		lineGlyph: nil
+ 		lineGlyphWidth: 0
- 		lingGlyphWidth: 0
  		emphasis: 0.!

Item was added:
+ ----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth:replaceColor:lineGlyph:lineGlyphWidth:emphasis: (in category 'converting') -----
+ asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth replaceColor: replaceColorFlag lineGlyph: lineGlyph lineGlyphWidth: lWidth emphasis: code
+ 
+ 	| form canvas newScale |
+ 	form := Form extent: ((advanceWidth @ (ascender - descender)) * scale) rounded depth: depth.
+ 	form fillColor: bgColor.
+ 	canvas := form getCanvas asBalloonCanvas.
+ 	canvas aaLevel: 4.
+ 	canvas transformBy: (MatrixTransform2x3 withScale: scale asPoint * (1 @ -1)).
+ 	canvas transformBy: (MatrixTransform2x3 withOffset: 0 @ ascender negated).
+ 	canvas
+ 		drawGeneralBezierShape: self contours
+ 		color: fgColor 
+ 		borderWidth: 0 
+ 		borderColor: fgColor.
+ 	((code bitAnd: 4) ~= 0 or: [(code bitAnd: 16) ~= 0]) ifTrue: [
+ 		newScale := (form width + 1) asFloat / lineGlyph calculateWidth asFloat.
+ 		canvas transformBy: (MatrixTransform2x3 withScale: (newScale / scale)@1.0).
+ 
+ 		(code bitAnd: 4) ~= 0 ifTrue: [
+ 			canvas
+ 				drawGeneralBezierShape: lineGlyph contours
+ 				color: fgColor 
+ 				borderWidth: 0 
+ 				borderColor: fgColor.
+ 		].
+ 
+ 		(code bitAnd: 16) ~= 0 ifTrue: [
+ 			canvas transformBy: (MatrixTransform2x3 withOffset: 0@(ascender // 2)).
+ 			canvas
+ 				drawGeneralBezierShape: lineGlyph contours
+ 				color: fgColor 
+ 				borderWidth: 0 
+ 				borderColor: fgColor.
+ 		].
+ 	].
+ 
+ 	replaceColorFlag ifTrue: [
+ 		form replaceColor: bgColor withColor: Color transparent.
+ 	].
+ 	^ form!

Item was added:
+ ----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth:replaceColor:lineGlyph:lineGlyphWidth:emphasis:advanceWidth: (in category 'converting') -----
+ asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth replaceColor: replaceColorFlag lineGlyph: lineGlyph lineGlyphWidth: lWidth emphasis: code advanceWidth: w
+ 
+ 	| form canvas newScale |
+ 	form := Form extent: ((w @ (ascender - descender)) * scale) rounded depth: depth.
+ 	form fillColor: bgColor.
+ 	canvas := form getCanvas asBalloonCanvas.
+ 	canvas aaLevel: 4.
+ 	canvas transformBy: (MatrixTransform2x3 withScale: scale asPoint * (1 @ -1)).
+ 	canvas transformBy: (MatrixTransform2x3 withOffset: 0 @ ascender negated).
+ 	canvas
+ 		drawGeneralBezierShape: self contours
+ 		color: fgColor 
+ 		borderWidth: 0 
+ 		borderColor: fgColor.
+ 	((code bitAnd: 4) ~= 0 or: [(code bitAnd: 16) ~= 0]) ifTrue: [
+ 		newScale := (form width + 1) asFloat / lineGlyph calculateWidth asFloat.
+ 		canvas transformBy: (MatrixTransform2x3 withScale: (newScale / scale)@1.0).
+ 
+ 		(code bitAnd: 4) ~= 0 ifTrue: [
+ 			canvas
+ 				drawGeneralBezierShape: lineGlyph contours
+ 				color: fgColor 
+ 				borderWidth: 0 
+ 				borderColor: fgColor.
+ 		].
+ 
+ 		(code bitAnd: 16) ~= 0 ifTrue: [
+ 			canvas transformBy: (MatrixTransform2x3 withOffset: 0@(ascender // 2)).
+ 			canvas
+ 				drawGeneralBezierShape: lineGlyph contours
+ 				color: fgColor 
+ 				borderWidth: 0 
+ 				borderColor: fgColor.
+ 		].
+ 	].
+ 
+ 	replaceColorFlag ifTrue: [
+ 		form replaceColor: bgColor withColor: Color transparent.
+ 	].
+ 	^ form!

Item was removed:
- ----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth:replaceColor:lineGlyph:lingGlyphWidth:emphasis: (in category 'converting') -----
- asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth replaceColor: replaceColorFlag lineGlyph: lineGlyph lingGlyphWidth: lWidth emphasis: code
- 
- 	| form canvas newScale |
- 	form := Form extent: (advanceWidth @ (ascender - descender) * scale) rounded depth: depth.
- 	form fillColor: bgColor.
- 	canvas := form getCanvas asBalloonCanvas.
- 	canvas aaLevel: 4.
- 	canvas transformBy: (MatrixTransform2x3 withScale: scale asPoint * (1 @ -1)).
- 	canvas transformBy: (MatrixTransform2x3 withOffset: 0 @ ascender negated).
- 	canvas
- 		drawGeneralBezierShape: self contours
- 		color: fgColor 
- 		borderWidth: 0 
- 		borderColor: fgColor.
- 	((code bitAnd: 4) ~= 0 or: [(code bitAnd: 16) ~= 0]) ifTrue: [
- 		newScale := (form width + 1) asFloat / lineGlyph calculateWidth asFloat.
- 		canvas transformBy: (MatrixTransform2x3 withScale: (newScale / scale)@1.0).
- 
- 		(code bitAnd: 4) ~= 0 ifTrue: [
- 			canvas
- 				drawGeneralBezierShape: lineGlyph contours
- 				color: fgColor 
- 				borderWidth: 0 
- 				borderColor: fgColor.
- 		].
- 
- 		(code bitAnd: 16) ~= 0 ifTrue: [
- 			canvas transformBy: (MatrixTransform2x3 withOffset: 0@(ascender // 2)).
- 			canvas
- 				drawGeneralBezierShape: lineGlyph contours
- 				color: fgColor 
- 				borderWidth: 0 
- 				borderColor: fgColor.
- 		].
- 	].
- 
- 	replaceColorFlag ifTrue: [
- 		form replaceColor: bgColor withColor: Color transparent.
- 	].
- 	^ form!

Item was added:
+ ----- Method: TTGlyph>>isFallback (in category 'testing') -----
+ isFallback
+ 	"Answer whether the receiver is a dummy to represent unsupported code points in the corresponding font description."
+ 
+ 	^ self glyphIndex = 0!



More information about the Squeak-dev mailing list