[squeak-dev] The Trunk: Graphics-mt.471.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 3 15:26:19 UTC 2022


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

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

Name: Graphics-mt.471
Author: mt
Time: 3 February 2022, 4:26:11.420027 pm
UUID: 944bb575-2b2c-e14f-99ea-88876b34a5cc
Ancestors: Graphics-mt.470

Various fixes and improvements around font rendering:

- Imported fonts now have the current system's point size by default
- Fixes very old #lineGap/#leading issue concering TrueType fonts
- Fixes very old #ascent/#height issue concerning TrueType fonts
- Adds extra TrueType scaling so improve the quality of imported fonts that have too small glyphs by default; see commentary in #extraScale:; may be tweaked per font
- Makes #lineGap in StrikeFonts adapt with their point size, min. 1 pixel
- Adds missing sTypo* properties for our BitstreamVera font families to actually now have a #lineGap
- Improve "Font Size Summary" page in help browser
- Removes fallback-glyph-drawing code from TTCGlyph because fallback glyphs are organized at a higher level in AbstractFont via FixedFaceFont; see #fallbackFont
- Speed up TTCFont >> #hasGlyphOf:

=============== Diff against Graphics-mt.470 ===============

Item was added:
+ ----- Method: AbstractFont>>asPointSize: (in category 'converting') -----
+ asPointSize: differentPointSize
+ 	"Convert the receiver into a different point size. Compared to #pointSize:, this operation does not modify the receiver but tries to lookup another font object or create one on-the-fly."
+ 
+ 	self pointSize = differentPointSize ifTrue: [^ self].
+ 
+ 	^ self class
+ 		familyName: self familyName
+ 		pointSize: differentPointSize
+ 		emphasized: self emphasis!

Item was added:
+ ----- Method: AbstractFont>>lineGap (in category 'accessing') -----
+ lineGap
+ 
+ 	^ 2 "pre-rendered legacy fonts"!

Item was changed:
  ----- Method: AbstractFont>>lineGrid (in category 'accessing') -----
  lineGrid
  	"Answer the relative space between lines"
  
+ 	^ self height + self lineGap!
- 	^self subclassResponsibility!

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

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

Item was changed:
+ ----- Method: FixedFaceFont>>characterFormAt: (in category 'character shapes') -----
- ----- Method: FixedFaceFont>>characterFormAt: (in category 'accessing') -----
  characterFormAt: character 
  	^ baseFont characterFormAt: substitutionCharacter!

Item was added:
+ ----- Method: FixedFaceFont>>formOf: (in category 'private') -----
+ formOf: aCharacter
+ 	"No need to check #hasGlyphOf:."
+ 
+ 	^ self characterFormAt: aCharacter!

Item was changed:
  ----- 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 := TextStyle defaultFont.
+ 	self passwordFont.!
- 	self passwordFont!

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

Item was changed:
  AbstractFont subclass: #StrikeFont
+ 	instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize fallbackFont charIndexCompatibilitySlot lineGap'
- 	instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize fallbackFont charIndexCompatibilitySlot'
  	classVariableNames: 'DefaultStringScanner'
  	poolDictionaries: 'TextConstants'
  	category: 'Graphics-Fonts'!
  
  !StrikeFont commentStamp: 'fbs 11/28/2013 08:50' prior: 0!
  I represent a compact encoding of a set of Forms corresponding to characters in the ASCII character set. All the forms are placed side by side in a large form whose height is the font height, and whose width is the sum of all the character widths. The xTable variable gives the left-x coordinates of the subforms corresponding to the glyphs. Characters are mapped to glyphs by using the characterToGyphMap.
  
  Subclasses can have non-trivial mapping rules as well as different representations for glyphs sizes (e.g., not using an xTable). If so, these classes should return nil when queried for xTable and/or the characterToGlyphMap. This will cause the CharacterScanner primitive to fail and query the font for the width of a character (so that a more programatical approach can be implemented).
  
  For display, fonts need to implement two messages:
  	#installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor
  This method installs the receiver (a font) on the given DisplayContext (which may be an instance of BitBlt or Canvas (or any of its subclasses). The font should take the appropriate action to initialize the display context so that further display operations can be optimized.
  	#displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta
  This method is called for each subsequent run of characters in aString which is to be displayed with the (previously installed) settings.
  !

Item was changed:
+ ----- Method: StrikeFont>>basicHasGlyphOf: (in category 'private') -----
- ----- Method: StrikeFont>>basicHasGlyphOf: (in category 'multibyte character methods') -----
  basicHasGlyphOf: aCharacter
  
  	^ self hasGlyphForCode: (self codeForCharacter: aCharacter)
  !

Item was added:
+ ----- Method: StrikeFont>>formOf: (in category 'private') -----
+ formOf: aCharacter
+ 	"Like #characterFormAt: but checks for #hasGlyphOf: and supports #fallbackFont."
+ 
+ 	(self hasGlyphOf: aCharacter)
+ 		ifFalse: [^ self fallbackFont formOf: aCharacter].
+ 		
+ 	^ self characterFormAt: aCharacter!

Item was changed:
+ ----- Method: StrikeFont>>glyphOf: (in category 'private') -----
- ----- Method: StrikeFont>>glyphOf: (in category 'accessing') -----
  glyphOf: aCharacter 
- 	"Answer the width of the argument as a character in the receiver."
  
+ 	self flag: #deprecated.
+ 	^ self formOf: aCharacter!
- 	| code |
- 	(self hasGlyphOf: aCharacter)
- 		ifFalse: [^ self fallbackFont glyphOf: aCharacter].
- 	code := self codeForCharacter: aCharacter.
- 	^ glyphs copy: (((xTable at: code + 1)@0) corner: (xTable at: code +2)@self height).
- !

Item was changed:
+ ----- Method: StrikeFont>>hasGlyphForCode: (in category 'private') -----
- ----- Method: StrikeFont>>hasGlyphForCode: (in category 'multibyte character methods') -----
  hasGlyphForCode: aCharacterCode
  	"Note that missing glyphs are encoded as -1 in the xTable but to speed up the #widthOf: check, the next offset must be adjacent and thus be duplicated. For example: #(-1 -1 0 24 -1 -1 -1 24 48 -1 ...). Since aCharacterCode is 0-based, that codes offset is at +1 while its width needs to consult +2, too. See #widthOf:." 
  
  	(aCharacterCode between: self minAscii and: self maxAscii)
  		ifFalse: [^ false].
  	(xTable at: aCharacterCode + 1) >= 0
  		ifFalse: [^ false].
  	(xTable at: aCharacterCode + 2) >= 0
  		ifFalse: [^ false].
  	^ true!

Item was added:
+ ----- Method: StrikeFont>>lineGap (in category 'accessing') -----
+ lineGap
+ 	"Historical. The #lineGap has been 2 pixels for all fonts in the system for a very long time. Since the #referenceHeight is 14 pixels, use that to compute a #lineGap relative to the receivers #pointSize/#pixelSize. Also see TTCFont >> #lineGap."
+ 	
+ 	^ lineGap ifNil: [lineGap := ((self height asFloat / self class referenceHeight) * 2 "pixels") rounded]!

Item was removed:
- ----- Method: StrikeFont>>lineGrid (in category 'accessing') -----
- lineGrid
- 	^ ascent + descent!

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

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

Item was changed:
  ----- Method: TextStyle class>>actualTextStyles (in category 'TextConstants access') -----
  actualTextStyles
  	| aDict |
  	"TextStyle actualTextStyles"
  
  	"Answer dictionary whose keys are the names of styles in the system and whose values are the actual styles"
  
  	aDict := TextConstants select: [:thang | thang isKindOf: self ].
+ 	self defaultFamilyNames do: [ :sym | aDict removeKey: sym ifAbsent: [] ].
- 	self defaultFamilyNames do: [ :sym | aDict removeKey: sym ].
  	^ aDict!

Item was changed:
  ----- Method: TextStyle class>>fontSizeSummaryContents (in category 'utilities') -----
  fontSizeSummaryContents
  
+ 	^ Text streamContents: [:aStream |
+ 			| knownStyles knownTTCStyles knownLegacyStyles defaultStyles printBlock |
+ 			knownStyles := self knownTextStylesWithoutDefault sorted.
+ 			defaultStyles := self defaultFamilyNames sorted.
+ 			
+ 			aStream nextPutAll: ('This page lists all known text styles and for each style''s font the available point sizes. Most text fields offer the {1} where you can choose a different font or point size. Note that you can use any new point size for TrueType fonts. This is, however, not possible for our pre-rendred legacy fonts. If you need more fonts, use the {2} to import TrueType fonts from your current platform. Click {3} to browse all styles by example.\\'
+ 				translated withCRs asText format: {
+ 					'FontChooserTool' asText
+ 						addAttribute: (PluggableTextAttribute evalBlock: [FontChooserTool open]); yourself.
+ 					'FontImporterTool' asText
+ 						addAttribute: (PluggableTextAttribute evalBlock: [FontImporterTool open]); yourself.
+ 					'here' asText
+ 						addAttribute: (PluggableTextAttribute evalBlock: [TextStyle browseAllStyles])}).
+ 			
+ 			defaultStyles do: [:styleName |
+ 				| style prefix |
+ 				style := self named: styleName.
+ 				prefix := (style isNil or: [(self named: style defaultFamilyName) == style]) ifTrue: [''] ifFalse: [' !! '].
+ 				aStream
+ 					nextPutAll: (((styleName padded: #left to: 24 with: Character space), ': ', prefix) asText addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont); yourself);
+ 					nextPutAll: (style ifNil: ['-'] ifNotNil: [(style defaultFamilyName asText addAttribute: (TextFontReference toFont: style defaultFont); addAttribute: (PluggableTextAttribute evalBlock: [style explore]); yourself)]);
+ 					cr].
+ 			
+ 			printBlock :=  [:styleName |
+ 					| style defaultFont preferredPointSize exampleFont |
+ 					style := self named: styleName.
+ 					preferredPointSize := TextStyle defaultFont pointSize. "system's current default"
+ 					defaultFont := style defaultFont. "style's current default"
+ 					exampleFont := defaultFont asPointSize: preferredPointSize.
+ 					aStream
+ 						nextPutAll: (styleName asText addAttribute: (TextFontReference toFont: exampleFont)).
+ 					styleName ~= style defaultFamilyName ifTrue: ["style alias"
+ 						aStream nextPutAll: ' (', style defaultFamilyName, ')'].
+ 					
+ 					aStream
+ 						nextPutAll: ((Text new,
+ 							((style isTTCStyle ifFalse: [''] ifTrue: [ | es tt |
+ 								' TrueType', 
+ 								((tt := style defaultFont ttcDescription) isExternal ifFalse: [''] ifTrue: [' (extern)']), 
+ 								((es := tt extraScale) >  1.0 ifFalse: [''] ifTrue: [' ', (es * 100) rounded asString, '%'])] ) asText addAttribute: (TextColor color: ((self userInterfaceTheme get: #balloonTextColor for: #PluggableTextMorphPlus) ifNil: [Color gray])); yourself),
+ 							'  ... ',
+ 							('explore' translated asText addAttribute: (PluggableTextAttribute evalBlock: [style explore]); yourself),
+ 							'  ',
+ 							('browse' translated asText addAttribute: (PluggableTextAttribute evalBlock: [defaultFont browseAllGlyphs]); yourself),
+ 							
+ 							'  ') addAttribute: (TextFontReference toFont: Preferences standardButtonFont); yourself);
+ 						cr.
+ 					aStream nextPutAll:	 (((self fontPointSizesFor: styleName) inject: '    ' asText into: [:text :pointSize |
+ 							pointSize = defaultFont pointSize
+ 								ifFalse: [text, ((pointSize asFloat printShowingDecimalPlaces: 1) padded: #left to: 5 with: Character space)]
+ 								ifTrue: [text, (((pointSize asFloat printShowingDecimalPlaces: 1) padded: #left to: 5 with: Character space) asText addAttribute: TextEmphasis bold; yourself)]]) addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont); yourself).
+ 					aStream cr; cr].
+ 			
+ 			knownTTCStyles := knownStyles select: [:ea | (self named: ea) isTTCStyle].
+ 			knownLegacyStyles := knownStyles reject: [:ea | (self named: ea) isTTCStyle].
+ 			
+ 			aStream cr.
+ 			knownTTCStyles do: printBlock.
+ 			aStream nextPutAll: ('The following pre-rendered legacy fonts are still available. Note that you can only choose from the point sizes that are listed here. Each point size has a pixel size for 96 PPI. The system scales currently for {1} PPI.' translated format: {TextStyle pixelsPerInch}) ; cr; cr.
+ 			knownLegacyStyles do: printBlock.
+ 				].!
- 	^ Text streamContents:
- 		[:aStream |
- 			self knownTextStyles do: [:aStyleName |
- 				aStream nextPutAll:
- 					(aStyleName  asText addAttribute: (TextFontReference toFont: (TextStyle named: aStyleName) defaultFont)), '  ',
- 					(self fontPointSizesFor: aStyleName) asArray storeString.
- 				aStream cr]].!

Item was changed:
  ----- Method: TextStyle class>>pixelsPerInch: (in category 'utilities') -----
  pixelsPerInch: aNumber
  	"Set the nominal number of pixels per inch to aNumber."
  
  	self pixelsPerInch = aNumber ifTrue: [^ self].
  	TextConstants at: #pixelsPerInch put: aNumber.
+ 	AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ].
+ 	TextStyle allInstancesDo: [ :style | style pixelsPerInchChanged ].!
- 	AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ].!

Item was changed:
  ----- Method: TextStyle>>consistOnlyOf: (in category 'fonts and font indexes') -----
  consistOnlyOf: aFont
+ 
+ 	self deprecated.
+ 	^ self newFontArray: {aFont}!
- 	fontArray := Array with: aFont.
- 	defaultFontIndex := 1!

Item was added:
+ ----- Method: TextStyle>>defaultFamilyName (in category 'accessing') -----
+ defaultFamilyName
+ 	^ self defaultFont familyName!

Item was changed:
  ----- Method: TextStyle>>defaultFontIndex: (in category 'default font') -----
  defaultFontIndex: anIndex
  
  	defaultFontIndex := anIndex.
+ 	
+ 	leading := self defaultFont lineGap.
+ 	lineGrid := self defaultFont height + leading.
+ 	baseline := self defaultFont ascent + leading.!
- 	lineGrid := (fontArray at: defaultFontIndex) height + leading.
- 	baseline := (fontArray at: defaultFontIndex) ascent + leading.!

Item was added:
+ ----- Method: TextStyle>>pixelsPerInchChanged (in category 'notifications') -----
+ pixelsPerInchChanged
+ 	"The receiver's #lineGap is cached here."
+ 	
+ 	self defaultFontIndex: self defaultFontIndex.!



More information about the Squeak-dev mailing list