[squeak-dev] The Trunk: Tools-mt.1124.mczcommits at source.squeak.org commits at source.squeak.orgThu Feb 3 15:31:47 UTC 2022
Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1124.mcz ==================== Summary ==================== Name: Tools-mt.1124 Author: mt Time: 3 February 2022, 4:31:44.734027 pm UUID: 49d75784-dd99-7f46-bce5-1583ed4f45f4 Ancestors: Tools-ct.1123 Revises rather new tool on AbstractFont to browse all glyphs in a code-point range. Can now show an arbitrary list of characters/code points. Add a similar thing to TextStyle to browse all available fonts with a sample text. Builds upon Graphics-mt.471, TrueType-mt.60, and System-mt.1300 =============== Diff against Tools-ct.1123 =============== Item was changed: ----- Method: AbstractFont>>browseAllGlyphs (in category '*Tools-Browsing') ----- browseAllGlyphs + "Browse glyphs for all printable characters/code-points in the receiver." ^ self browseGlyphsFrom: self minCodePoint to: self maxCodePoint! Item was changed: ----- Method: AbstractFont>>browseGlyphsFrom:to: (in category '*Tools-Browsing') ----- browseGlyphsFrom: firstCodePoint to: lastCodePoint + "Split range in sub-ranges whenever the receiver has no glyph for a certain code point or when that glyph is not visible. Start with at least a printable character after #space to avoid line breaks in the editor. Note that non-breaking space an similar are skipped as well." + + ^ self + browseGlyphsOf: + ((firstCodePoint max: (self minCodePoint max: 32 "space" +1)) + to: (lastCodePoint min: self maxCodePoint)) + select: [:char | (self hasGlyphOf: char) and: [(self widthOf: char) > 0] + and: [(self characterFormAt: char) bits anySatisfy: [:ea | + ea ~= 0 "transparent" and: [ea ~= 4294967295 "white"]]] + ]! - "Browse all glyphs in the given range of code points. Use a fall-back character if an inner code point does not have a glyph. DO NOT TRANSLATE!!" - - | contents first last fallbackChar | - first := firstCodePoint max: (self minCodePoint max: 32+1 "first printable after space"). - last := lastCodePoint min: self maxCodePoint. - fallbackChar := Character space. - - contents := String streamContents: [:s | - first to: last do: [:codePoint | | char | - (self hasGlyphOf: (char := Character value: codePoint)) - ifTrue: [s nextPut: char] - ifFalse: [s nextPut: fallbackChar]]]. - contents := contents asText addAttribute: (TextFontReference toFont: self); yourself. - contents := (('Family name: {1}\ Emphasis: {2}\ Point size: {3} ({4}ppi {5}px)\Code points: 16r{6} to: 16r{7}\ Fallback: 16r{8} ({9})\\' withCRs asText format: { self familyName asText addAttribute: (PluggableTextAttribute evalBlock: [self explore]); yourself. self emphasisString. self pointSize. self pixelsPerInch. self pixelSize. first printStringBase: 16 length: 6 padded: true. last printStringBase: 16 length: 6 padded: true. fallbackChar codePoint printStringBase: 16 length: 6 padded: true. fallbackChar storeString}) addAttribute: (TextFontReference toFont: TextStyle defaultFixedFont); yourself), - contents. - contents editWithLabel: self printString.! Item was added: + ----- Method: AbstractFont>>browseGlyphsFrom:to:select: (in category '*Tools-Browsing') ----- + browseGlyphsFrom: firstCodePoint to: lastCodePoint select: aBlock + + self + browseGlyphsOf: (firstCodePoint to: lastCodePoint) + select: aBlock.! Item was added: + ----- Method: AbstractFont>>browseGlyphsOf: (in category '*Tools-Browsing') ----- + browseGlyphsOf: someCodePointsOrCharacters + + self browseGlyphsOf: someCodePointsOrCharacters label: nil.! Item was added: + ----- Method: AbstractFont>>browseGlyphsOf:label: (in category '*Tools-Browsing') ----- + browseGlyphsOf: someCodePointsOrCharacters label: label + "Browse a collection of non-sequential code points or characters. For ranges use #browseGlyphsFrom:to: to then split into sub-ranges via prediate. + + self browseGlyphsOf: 'Hello' + " + + self + browseGlyphsOf: someCodePointsOrCharacters + select: [:char | true] + label: label! Item was added: + ----- Method: AbstractFont>>browseGlyphsOf:select: (in category '*Tools-Browsing') ----- + browseGlyphsOf: someCodePointsOrCharacters select: aBlock + + self browseGlyphsOf: someCodePointsOrCharacters select: aBlock label: nil.! Item was added: + ----- 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 | + isRange := someCodePointsOrCharacters isInterval and: [someCodePointsOrCharacters increment = 1]. + + "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. 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, (('\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)]. + contents := contents, ((s cr; contents) asText addAttribute: (TextFontReference toFont: self); yourself). + s reset]] ]]. + + contents editWithLabel: (aLabelOrNil ifNil: [self printString]).! Item was added: + ----- Method: TextStyle class>>browseAllStyles (in category '*Tools-Browsing') ----- + browseAllStyles + + ^ self browseAllStylesAtPointSize: self defaultFont pointSize! Item was added: + ----- Method: TextStyle class>>browseAllStylesAtPointSize: (in category '*Tools-Browsing') ----- + browseAllStylesAtPointSize: pointSize + " + self browseAllStylesAtPointSize: 24.0 + " + ^ self browseAllStylesAtPointSize: pointSize sample: 'HelloSqueak' ! Item was added: + ----- Method: TextStyle class>>browseAllStylesAtPointSize:sample: (in category '*Tools-Browsing') ----- + browseAllStylesAtPointSize: pointSize sample: aString + " + self browseAllStylesAtPointSize: 24.0 sample: 'HelloSqueak' + " + + (Text streamContents: [:stream | | allStyles | + allStyles := self actualTextStyles sorted: [:a :b | + (a isTTCStyle and: [b isTTCStyle not]) + or: [a isTTCStyle = b isTTCStyle and: [a defaultFamilyName <= b defaultFamilyName]]]. + + "1) Combine all side-by-side to be able to compare ascent/descent/baseline." + allStyles do: [:style | + stream nextPutAll: (aString asText addAttribute: (TextFontReference toFont: (style defaultFont asPointSize: pointSize)); yourself)]. + stream cr; cr. + + "2) Show one per line. Be sure to also set the font for the line break to get the correct line height." + allStyles do: [:style | stream nextPutAll: ( + ('{1} {2}\' withCRs asText format: {aString. style defaultFamilyName asText addAttribute: (PluggableTextAttribute evalBlock: [style explore]); yourself}) addAttribute: (TextFontReference toFont: (style defaultFont asPointSize: pointSize)); yourself)] + + ]) editWithLabel: 'All known fonts/styles'!
More information about the Squeak-dev mailing list |