[Pkg] The Trunk: Tools-mt.1135.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Feb 25 09:31:30 UTC 2022
Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.1135.mcz
==================== Summary ====================
Name: Tools-mt.1135
Author: mt
Time: 25 February 2022, 10:31:28.08163 am
UUID: 174dbc8f-f373-3f41-afd8-3ba9d33e16ce
Ancestors: Tools-mt.1134
Complements TrueType-mt.72
=============== Diff against Tools-mt.1134 ===============
Item was changed:
----- Method: AbstractFont>>browseGlyphsByCategoryOf:select:label: (in category '*Tools-Browsing') -----
browseGlyphsByCategoryOf: someCodePointsOrCharacters select: aBlock label: aLabelOrNil
"Like #browseGlyphsOf:... but group the code points by Unicode category."
| sortedCodePoints contents isRange tmp separatorBlock |
isRange := isRange := someCodePointsOrCharacters isInterval and: [someCodePointsOrCharacters increment = 1].
separatorBlock := [:codePoints :category |
(('\{1}\\' withCRs asText
format: { Unicode generalCategoryLabels at: category+1 ifAbsent: ['n/a'] })
addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont);
addAttribute: (PluggableTextAttribute evalBlock: [self browseGlyphsByCategoryOf: codePoints select: aBlock label: aLabelOrNil]);
yourself) ].
sortedCodePoints := (someCodePointsOrCharacters
collect: [:ea | ea isCharacter ifTrue: [ea asUnicode] ifFalse: [ea] ]
thenSelect: [:ea | aBlock value: (Character value: ea)])
sorted: [:a :b | | ca cb | (ca := (Unicode generalCategoryOf: a) ifNil: [0]) < (cb := (Unicode generalCategoryOf: b) ifNil: [0])
or: [ca = cb and: [a < b]]].
"Header"
+ contents := (('Family name: {1}{6}\ Emphasis: {2}\ Point size: {3} ({4}ppi {5}px{7})\' withCRs asText format: { self familyName asText addAttribute: (PluggableTextAttribute evalBlock: [self explore]); yourself. [self emphasisString] on: Error do: [self subfamilyName]. self pointSize. self pixelsPerInch. self height. isRange ifTrue: [''] ifFalse: [' (selected code points)']. (self isTTCFont and: [(tmp := self extraGlyphScale) ~= 1]) ifFalse: [''] ifTrue: [' ', (tmp * 100) rounded asString, '%'] }) addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont); yourself).
- contents := (('Family name: {1}{6}\ Emphasis: {2}\ Point size: {3} ({4}ppi {5}px{7})\' withCRs asText format: { self familyName asText addAttribute: (PluggableTextAttribute evalBlock: [self explore]); yourself. [self emphasisString] on: Error do: [self subfamilyName]. self pointSize. self pixelsPerInch. self height. isRange ifTrue: [''] ifFalse: [' (selected code points)']. (self isTTCFont and: [(tmp := self ttcDescription extraScale) ~= 1]) ifFalse: [''] ifTrue: [' ', (tmp * 100) rounded asString, '%'] }) addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont); yourself).
String streamContents: [:s | | priorCategory currentCodePoints |
currentCodePoints := OrderedCollection new.
sortedCodePoints withIndexDo: [:codePoint :index |
| char category |
char := Character value: codePoint.
category := Unicode generalCategoryOf: codePoint.
priorCategory ifNil: [priorCategory := category].
category = priorCategory ifTrue: [
currentCodePoints add: codePoint.
s nextPut: char].
(category ~= priorCategory or: [index = sortedCodePoints size])
ifTrue: [
contents := contents, (separatorBlock value: currentCodePoints value: priorCategory).
contents := contents, ((s cr; contents) asText addAttribute: (TextFontReference toFont: self); yourself).
currentCodePoints := OrderedCollection new.
s reset.
currentCodePoints add: codePoint.
s nextPut: char].
priorCategory := category]].
contents editWithLabel: (aLabelOrNil ifNil: [self printString]).!
Item was changed:
----- Method: AbstractFont>>browseGlyphsOf:select:label: (in category '*Tools-Browsing') -----
browseGlyphsOf: someCodePointsOrCharacters select: aBlock label: aLabelOrNil
"Browse all glyphs in the given collection of code points or characters. Split range in sub-ranges whenever the receiver has no glyph for a certain code point. DO NOT translate user-facing text because this is a debugging tool so that text should only use ASCII."
| contents isRange tmp separatorBlock |
isRange := someCodePointsOrCharacters isInterval and: [someCodePointsOrCharacters increment = 1].
separatorBlock := [:currentRange |
(('\16r{1} to: 16r{2}\\' withCRs asText
format: { currentRange first printStringBase: 16 length: 6 padded: true. currentRange last printStringBase: 16 length: 6 padded: true })
addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont);
addAttribute: (PluggableTextAttribute evalBlock: [self browseGlyphsFrom: currentRange first to: currentRange last select: aBlock]);
yourself)].
"Header"
+ contents := (('Family name: {1}{6}\ Emphasis: {2}\ Point size: {3} ({4}ppi {5}px{7})\' withCRs asText format: { self familyName asText addAttribute: (PluggableTextAttribute evalBlock: [self explore]); yourself. [self emphasisString] on: Error do: [self subfamilyName]. self pointSize. self pixelsPerInch. self height. isRange ifTrue: [''] ifFalse: [' (selected code points)']. (self isTTCFont and: [(tmp := self extraGlyphScale) ~= 1]) ifFalse: [''] ifTrue: [' ', (tmp * 100) rounded asString, '%'] }) addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont); yourself).
- contents := (('Family name: {1}{6}\ Emphasis: {2}\ Point size: {3} ({4}ppi {5}px{7})\' withCRs asText format: { self familyName asText addAttribute: (PluggableTextAttribute evalBlock: [self explore]); yourself. [self emphasisString] on: Error do: [self subfamilyName]. self pointSize. self pixelsPerInch. self height. isRange ifTrue: [''] ifFalse: [' (selected code points)']. (self isTTCFont and: [(tmp := self ttcDescription extraScale) ~= 1]) ifFalse: [''] ifTrue: [' ', (tmp * 100) rounded asString, '%'] }) addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont); yourself).
String streamContents: [:s | | first last |
last := someCodePointsOrCharacters last.
someCodePointsOrCharacters withIndexDo: [:codePointOrChar :index |
| current char valid |
current := codePointOrChar isCharacter ifTrue: [codePointOrChar asUnicode] ifFalse: [codePointOrChar].
char := Character value: current.
(valid := (aBlock value: char))
ifTrue: [s position = 0 ifTrue: [first := current]. s nextPut: char].
(valid not or: [index = someCodePointsOrCharacters size])
ifTrue: [s position = 0 ifFalse: [
isRange ifFalse: [contents := contents, String cr] ifTrue: [ | currentRange |
currentRange := first to: (index = someCodePointsOrCharacters size ifTrue: [last] ifFalse: [current-1]).
contents := contents, (separatorBlock value: currentRange)].
contents := contents, ((s cr; contents) asText addAttribute: (TextFontReference toFont: self); yourself).
s reset]] ]].
+
-
contents editWithLabel: (aLabelOrNil ifNil: [self printString]).!
Item was changed:
----- Method: TextStyle>>chooseExtraGap (in category '*Tools-Browsing') -----
chooseExtraGap
"
TextStyle defaultFixed chooseExtraGap.
"
| sampleFont answer |
self isTTCStyle ifFalse: [^ self].
sampleFont := self defaultFont.
answer := Project uiManager
request: ('Change extra leading for font\{1}.\Reset to default via non-number.' translated withCRs asText format: {self defaultFamilyName asText allBold})
+ initialAnswer: sampleFont extraLineGap asString.
- initialAnswer: sampleFont ttcDescription extraGap asString.
(answer isNil or: [answer isEmpty]) ifTrue: [^ self].
answer := [answer asNumber] on: NumberParserError do: [nil].
+ sampleFont extraLineGap: answer.
- sampleFont ttcDescription extraGap: answer.
- sampleFont derivativeFonts do: [:font |
- font ttcDescription extraGap: answer].
UserInterfaceTheme current basicApply.!
Item was changed:
----- Method: TextStyle>>chooseExtraScale (in category '*Tools-Browsing') -----
chooseExtraScale
"
TextStyle defaultFixed chooseExtraScale.
"
| sampleFont answer |
self isTTCStyle ifFalse: [^ self].
sampleFont := self defaultFont.
answer := Project uiManager
request: ('Change extra scale for glyphs of font\{1}.\Reset to default via non-number.' translated withCRs asText format: {self defaultFamilyName asText allBold})
+ initialAnswer: sampleFont extraGlyphScale asString.
- initialAnswer: sampleFont ttcDescription extraScale asString.
(answer isNil or: [answer isEmpty]) ifTrue: [^ self].
answer := [answer asNumber] on: NumberParserError do: [nil].
+ sampleFont extraGlyphScale: answer.
- sampleFont ttcDescription extraScale: answer.
- sampleFont derivativeFonts do: [:font |
- font ttcDescription extraScale: answer].
UserInterfaceTheme current basicApply.!
More information about the Packages
mailing list