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

commits at source.squeak.org commits at source.squeak.org
Sat Feb 5 15:00:20 UTC 2022


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

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

Name: Graphics-mt.472
Author: mt
Time: 5 February 2022, 4:00:13.751491 pm
UUID: 18a56b77-995e-1e4a-95c3-9148a92c9246
Ancestors: Graphics-mt.471

Prepare the use of #leadingSlice and #lineGapSlice, which will be used in CharacterScanner to improve layout of one-line texts.

Some tweaks in font-size summary. Let users change a TrueType font's extraScale and extra Gap.

(That fix in DisplayScreen complements System-mt.1301.)

=============== Diff against Graphics-mt.471 ===============

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

Item was changed:
  ----- Method: DisplayScreen>>uiScaleFactor: (in category 'scale factor') -----
  uiScaleFactor: aFloat
  	"Sets the effective scale factor for the user interface, i.e., all widgets, tools, and windows. The user can override the CurrentScaleFactor recommended by the platform."
  
  	| oldFactor newFactor |
+ 	(UserInterfaceTheme current canFakeScaleFactor: 0.75) ifTrue: [
- 	(UserInterfaceTheme current canFakeScaleFactor: aFloat) ifTrue: [
  		self flag: #isTTCBased.
  		^ UserInterfaceTheme current applyScaled: aFloat].
+ 
+ 	aFloat = 0.75 ifTrue: [(Project uiManager confirm: ((('You are currently using <b>TrueType fonts</b>. Your requested scale factor of <b>{1}%</b> looks better using pre-rendered <b>pixel fonts</b>.\\Do you want to switch to pixel fonts now?' translated withCRs format: {(aFloat * 100) rounded}) withNoLineLongerThan: 60) copyReplaceAll: String cr with: '<br>') asTextFromHtml title: 'Blurry Fonts Detected' translated) == true
+ 		ifTrue: [UserInterfaceTheme cleanUpAndReset. ^ self uiScaleFactor: aFloat]].
  	
  	oldFactor := RealEstateAgent scaleFactor. "Use effective, pixel-based factor to account for rounding errors. See #isTTCBased and #uiScaleFactor."
  	newFactor := aFloat max: 0.75.
  	newFactor = oldFactor ifTrue: [^ self].
  	
  	TextStyle pixelsPerInch: 96.0 * aFloat.
  	newFactor := RealEstateAgent resetScaleFactor; scaleFactor. "Again, account for rounding errors."
  	Project current ifNotNil: [:p | p displayScaleChangedFrom: oldFactor to: newFactor].!

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 lineGapSlice'
- 	instanceVariableNames: 'characterToGlyphMap xTable glyphs name type minAscii maxAscii maxWidth strikeLength ascent descent xOffset raster subscript superscript emphasis derivativeFonts pointSize fallbackFont charIndexCompatibilitySlot lineGap'
  	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 added:
+ ----- Method: StrikeFont>>lineGapSlice (in category 'accessing') -----
+ lineGapSlice
+ 	"Cached portion of the receiver's #lineGap, which can be used to center one-liners in text fields. Also see TTCFont >> #lineGapSlice."
+ 	
+ 	^ lineGapSlice ifNil: [lineGapSlice := (self lineGap asFloat / 2) rounded]!

Item was changed:
  ----- Method: StrikeFont>>reset (in category 'emphasis') -----
  reset
  	"Reset the cache of derivative emphasized fonts"
  
+ 	lineGap := lineGapSlice := nil.
+ 
  	fallbackFont class = FixedFaceFont
  		ifTrue: [fallbackFont := nil].
  		
  	derivativeFonts notNil ifTrue: [
  		derivativeFonts withIndexDo: [ :f :i |
  			(f notNil and: [f isSynthetic]) ifTrue: [derivativeFonts at: i put: nil]]].
  	"
  	derivativeFonts := Array new: 32.
  	#('B' 'I' 'BI') doWithIndex:
  		[:tag :index | 
  		(style := TextStyle named: self familyName) ifNotNil:
  			[(font := style fontArray
  				detect: [:each | each name = (self name , tag)]
  				ifNone: [nil]) ifNotNil: [derivativeFonts at: index put: font]]]
  	"!

Item was changed:
  Object subclass: #TextStyle
+ 	instanceVariableNames: 'fontArray fontFamilySize lineGrid baseline alignment firstIndent restIndent rightIndent tabsArray marginTabsArray leading leadingSlice defaultFontIndex'
- 	instanceVariableNames: 'fontArray fontFamilySize lineGrid baseline alignment firstIndent restIndent rightIndent tabsArray marginTabsArray leading defaultFontIndex'
  	classVariableNames: ''
  	poolDictionaries: 'TextConstants'
  	category: 'Graphics-Text'!
  
  !TextStyle commentStamp: '<historical>' prior: 0!
  A textStyle comprises the formatting information for composing and displaying a unit (usually a paragraph) of text.  Typically one makes a copy of a master textStyle (such as TextStyle default), and then that copy may get altered in the process of editing.  Bad things can happen if you do not copy first.
  
  Each of my instances consists of...
  	fontArray		An array of StrikeFonts
  	fontFamilySize	unused
  	lineGrid			An integer; default line spacing for paragraphs
  	baseline			An integer; default baseline (dist from line top to bottom of an 'a')
  	alignment		An integer; text alignment, see TextStyle alignment:
  	firstIndent		An integer; indent of first line in pixels
  	restIndent		An integer; indent of remaining lines in pixels
  	rightIndent		An integer; indent of right margin rel to section
  	tabsArray		An array of integers giving tab offsets in pixels
  	marginTabsArray	An array of margin tabs
  	leading			An integer giving default vertical line separation
  
  For a concrete example, look at TextStyle default copy inspect!

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 tt defaultFont preferredPointSize exampleFont |
- 					| 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, ')'].
+ 					tt := style isTTCStyle ifTrue: [style defaultFont ttcDescription].
- 					
  					aStream
  						nextPutAll: ((Text new,
+ 							((style isTTCStyle ifFalse: [''] ifTrue: [' TrueType', (tt isExternal ifFalse: [''] ifTrue: [' (extern)'])])
+ 								asText addAttribute: (TextColor color: ((self userInterfaceTheme get: #balloonTextColor for: #PluggableTextMorphPlus) ifNil: [Color gray])); yourself),
+ 							(style isTTCStyle ifFalse: [''] ifTrue: [ | eg |
+ 								'  ... ' asText,
+ 								((' ', (tt extraScale * 100) rounded asString, '%') asText addAttribute: (PluggableTextAttribute evalBlock: [style chooseExtraScale]); yourself),
+ 								(('  ', ((eg := tt extraGap) >= 0 ifTrue: ['+', eg asString] ifFalse: [eg asString])) asText addAttribute: (PluggableTextAttribute evalBlock: [style chooseExtraGap]); yourself) ]),
+ 							'  ...  ',
- 							((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.
  				].!

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

Item was changed:
  ----- Method: TextStyle>>initialize (in category 'initialize-release') -----
  initialize
  
  	super initialize.
+ 	self leading: 2.
+ 	self leadingSlice: 1.!
- 	self leading: 2.!

Item was added:
+ ----- Method: TextStyle>>leadingSlice (in category 'accessing') -----
+ leadingSlice
+ 	"Cached portion of the receiver's #leading, which can be used to vertically center one-liners in text fields."
+ 
+ 	^ leadingSlice!

Item was added:
+ ----- Method: TextStyle>>leadingSlice: (in category 'accessing') -----
+ leadingSlice: yDeltaSlice
+ 
+ 	leadingSlice := yDeltaSlice.!

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

Item was added:
+ ----- Method: TextStyle>>reset (in category 'initialize-release') -----
+ reset
+ 	"Reset values cached from the receiver's default font."
+ 	
+ 	self defaultFontIndex: self defaultFontIndex.!



More information about the Squeak-dev mailing list