Packages February 2022

packages@lists.squeakfoundation.org

1 participants
200 discussions

The Trunk: Morphic-mt.1867.mcz
by commits＠source.squeak.org 05 Feb '22

05 Feb '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1867.mcz ==================== Summary ==================== Name: Morphic-mt.1867 Author: mt Time: 5 February 2022, 8:38:14.914233 am UUID: 65f30102-4d0b-5b41-b10d-66aa2dc38960 Ancestors: Morphic-mt.1866 Fixes that annoying issue in multi-window windows where that (invisible) button for choosing your model was made inaccessible when, for example, switching UI themes. Thanks to Eliot (eem) for reporting this! =============== Diff against Morphic-mt.1866 =============== Item was added: + ----- Method: PluggableSystemWindowWithLabelButton>>replaceBoxes (in category 'initialization') ----- + replaceBoxes + + super replaceBoxes. + labelButton comeToFront.!

1 0

The Trunk: ToolBuilder-Morphic-mt.292.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.292.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.292 Author: mt Time: 3 February 2022, 5:14:01.689252 pm UUID: 9e44876c-0f30-4844-a9fe-55f0c4faae18 Ancestors: ToolBuilder-Morphic-mt.291 Fixes regression in list-chooser dialogs, which are not only for lists of strings but actual objects. Thanks to David O'Toole for reporting this! =============== Diff against ToolBuilder-Morphic-mt.291 =============== Item was changed: ----- Method: ListChooser>>initialExtent (in category 'building') ----- initialExtent | listFont itemCount maxItemSize cellSize | listFont := Preferences standardListFont. itemCount := items size. + maxItemSize := items inject: 0 into: [:max :item | max max: item asString size]. - maxItemSize := items inject: 0 into: [:max :item | max max: item size]. cellSize := (listFont widthOf: $m) @ listFont height. ^ ((maxItemSize min: 20 max: 10) @ (itemCount min: 15 max: 5) * cellSize) + (0@ self searchBarHeight)! Item was changed: ----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') ----- initialExtent | listFont itemCount maxItemSize cellSize | listFont := Preferences standardListFont. itemCount := labels size. + maxItemSize := labels inject: 0 into: [:max :item | max max: item asString size]. - maxItemSize := labels inject: 0 into: [:max :item | max max: item size]. cellSize := (listFont widthOf: $m) @ listFont height. ^ ((maxItemSize min: 20 max: 10) @ (itemCount min: 15 max: 5) * cellSize)!

1 0

The Trunk: Morphic-mt.1866.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1866.mcz ==================== Summary ==================== Name: Morphic-mt.1866 Author: mt Time: 3 February 2022, 4:58:18.363576 pm UUID: 5d2d9711-dbfa-5d44-a2e5-f29b0a081d60 Ancestors: Morphic-mt.1865 Fixes a regression in TextMorph, which must support #font: without having any contents/text configured. Thanks to Christoph (ct) for the pointer. =============== Diff against Morphic-mt.1865 =============== Item was changed: ----- Method: TextMorph>>font: (in category 'accessing') ----- font: aFont "Change the receiver's default font, which is used to draw its contents. Remove all custom font-face-related attributes from the current contents. For a less harsh approach, just use #textStyle: instead and rely on text attributes. !! It is best practice to work with #textStyle: and rely on the text attributes TextFontChange and (sometimes) TextFontReference." + self text ifNotNil: [ + self text removeAttributesThat: [:attr | attr isTextFontChange and: [attr canFontBeSubstituted]]. - self text removeAttributesThat: [:attr | attr isTextFontChange and: [attr canFontBeSubstituted]]. + aFont emphasis ~= 0 ifTrue: [ + self text addAttribute: (TextEmphasis new emphasisCode: aFont emphasis; yourself)]]. - aFont emphasis ~= 0 ifTrue: [ - self text addAttribute: (TextEmphasis new emphasisCode: aFont emphasis; yourself)]. self textStyle: aFont asNewTextStyle.!

1 0

The Trunk: TrueType-mt.61.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.61.mcz ==================== Summary ==================== Name: TrueType-mt.61 Author: mt Time: 3 February 2022, 4:41:36.830061 pm UUID: 1d2cd5ad-a073-8142-9e1b-1926a91d7343 Ancestors: TrueType-mt.60 Adds missing selector. Sorry for the noise. =============== Diff against TrueType-mt.60 =============== Item was added: + ----- Method: TTFileDescription>>unitsPerEm (in category 'accessing') ----- + unitsPerEm + + ^unitsPerEm!

1 0

The Trunk: MultilingualTests-mt.38.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

Marcel Taeumel uploaded a new version of MultilingualTests to project The Trunk: http://source.squeak.org/trunk/MultilingualTests-mt.38.mcz ==================== Summary ==================== Name: MultilingualTests-mt.38 Author: mt Time: 3 February 2022, 4:32:56.405027 pm UUID: 0cd9e92d-e797-3547-b7c4-bd46de0fd9ab Ancestors: MultilingualTests-pre.37 Fixes paragraph test. The box needs to be bigger to account for a bigger default system font. Maybe we can further rewrite this test to not use "TextStyle default" in the first place. =============== Diff against MultilingualTests-pre.37 =============== Item was changed: ----- Method: FontTest>>testParagraphFallback (in category 'tests') ----- testParagraphFallback "self debug: #testParagraphFallback" | text p style height width e expect | e := (Character value: 257) asString. text := ('test' , e , e , e , e , 'test') asText. expect := 'test????test'. p := NewParagraph new. style := TextStyle default. p compose: text style: style from: 1 + in: (0 @ 0 corner: 1000000 @ 1000000). - in: (0 @ 0 corner: 100 @ 100). "See CompositionScanner>>setActualFont: & CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide:" height := style defaultFont height + style leading. width := (expect inject: 0 into: [:tally :next | tally + (style defaultFont widthOf: next)]) + p caretWidth. p adjustRightX. self assert: p extent = (width @ height). "Display getCanvas paragraph: p bounds: (10 @ 10 extent: 100 @ 100) color: Color black"!

1 0

The Trunk: Tools-mt.1124.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

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'!

1 0

The Trunk: Morphic-mt.1865.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1865.mcz ==================== Summary ==================== Name: Morphic-mt.1865 Author: mt Time: 3 February 2022, 4:29:43.140027 pm UUID: 36bb0484-8771-7347-8df0-76a80dcf9a71 Ancestors: Morphic-mt.1864 Extends FontImporterTool to be able to browse a font before installing it and be able to delete a font that is already installed. Fixes some issues in FontImporterTool and TextEditor. Builds upon Graphics-mt.471, TrueType-mt.60, and System-mt.1300 =============== Diff against Morphic-mt.1864 =============== Item was added: + ----- Method: FontImporterTool>>browseImported (in category 'actions') ----- + browseImported + + | filenames fonts ttcFonts | + fonts := self currentSelection. + filenames := fonts allFilenames. + + ttcFonts := filenames gather: [:ea | + (TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: ea)) + collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]]. + + ttcFonts do: [:ea | ea browseAllGlyphs].! Item was added: + ----- Method: FontImporterTool>>browseLinked (in category 'actions') ----- + browseLinked + + | filenames fonts ttcFonts | + fonts := self currentSelection. + filenames := fonts allFilenames. + + ttcFonts := filenames gather: [:ea | + (TTFileDescription readFontsFrom: ea) + collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]]. + + ttcFonts do: [:ea | ea browseAllGlyphs].! Item was added: + ----- Method: FontImporterTool>>delete (in category 'actions') ----- + delete + + | font | + (font := self selectedFont) textStyleOrNil ifNotNil: [:style | + TextConstants removeKey: font familyName]. + self allFonts: nil. "force redraw" + TTCFont registerAll.! Item was changed: ----- Method: FontImporterTool>>font:hasGlyphOf: (in category 'helper') ----- font: f hasGlyphOf: aCharacter | font | font := f isFontSet ifTrue: [f fontArray first] ifFalse: [f]. + ^ font hasGlyphOf: aCharacter! - ^ font isTTCFont - ifFalse: [font hasGlyphOf: aCharacter] - ifTrue: [ - " [(f hasGlyphOf: aCharacter) not] does not work, the fallback glyph is always found instead. - So we fake. if aCharacter is the same form as Character null aka 0, we assume absence." - (font characterFormAt: aCharacter) bits ~= font fallbackForm bits] - ! Item was changed: ----- Method: FontImporterTool>>fontFromFamily: (in category 'helper') ----- fontFromFamily: aFamily | readFonts | + aFamily ifNil: [^ TextStyle defaultFont]. - aFamily ifNil: [^ TextStyle default fonts first]. readFonts := TTFileDescription readFontsFrom: aFamily allFilenames anyOne. ^ (readFonts size > 1 ifTrue: [ | ftArray | " see TTCFontSet>>newTextStyleFromTT: " ftArray := readFonts collect: [:ttc | |f| ttc ifNil: [nil] ifNotNil: [ f := TTCFont new. f ttcDescription: ttc. f pointSize: TextStyle defaultFont pointSize. f]]. TTCFontSet newFontArray: ftArray] ifFalse: [ |f| f := TTCFont new. f ttcDescription: readFonts anyOne. f pointSize: TextStyle defaultFont pointSize. f])! Item was changed: ----- Method: FontImporterTool>>fontListMenu: (in category 'font list') ----- fontListMenu: aMenu ^ aMenu addTranslatedList: #( + ('Browse Font (imported)' browseImported 'Import and browse all available glyphs') + ('Browse Font (linked)' browseLinked 'Browse all available glyphs') + - + ('Install Font (imported)' import 'Include the font data in the image and provide a TextStyle for the font') + ('Install Font (linked)' link 'Install the font as a link to its file and provide a TextStyle for the referenced font') + ), (self selectedFont textStyleOrNil ifNil: [#()] ifNotNil: [#( + - + ('Delete Font' delete 'Remove imported font data or link to font from the system') + )]) - ('Import Font' import 'Include the font data in the image and provide a TextStyle for the font') - ('Link Font' link 'Install the font as a link to its file and provide a TextStyle for the referenced font')) yourself! Item was changed: ----- Method: FontImporterTool>>textForFamily:subfamily: (in category 'helper') ----- textForFamily: familyName subfamily: subfamilyName subfamilyName ifNil: [ + ^ (TextStyle named: (familyName copyWithout: Character space)) - ^ (TextStyle named: familyName) ifNil: [familyName] ifNotNil: [:style | style isTTCStyle ifTrue: ["we are already present " Text string: familyName attribute: TextEmphasis underlined] ifFalse: [familyName]]]. " frome here on it is only about subfamilies" (self isStyleNameSupported: subfamilyName) ifFalse: [^ Text string: subfamilyName attribute: TextColor gray]. ^ (TextStyle named: familyName) ifNil: ["importable" subfamilyName] ifNotNil: [:style | (style isTTCStyle and: [ | regular emph | regular := style fonts anyOne. emph := TTCFont indexOfSubfamilyName: subfamilyName. " detect if this style is already imported " regular emphasis = emph or: [(regular emphasis: emph) ~= regular]]) ifFalse: ["again importable" subfamilyName] ifTrue: [Text string: subfamilyName attribute: TextEmphasis underlined]]! Item was changed: ----- Method: TextEditor>>changeSelectionFontTo: (in category 'attributes') ----- changeSelectionFontTo: aFont | attr | aFont ifNil: [ ^ self ]. attr := TextFontReference toFont: aFont. self openTypeIn. paragraph text addAttribute: attr + from: (self hasSelection + ifTrue: [ self startIndex ] + ifFalse: [ 1 ]) - from: self startIndex to: (self hasSelection ifTrue: [ self stopIndex - 1 min: paragraph text size ] ifFalse: [ paragraph text size ]). self closeTypeIn. paragraph composeAll. self recomputeSelection. morph changed!

1 0

The Trunk: System-mt.1300.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1300.mcz ==================== Summary ==================== Name: System-mt.1300 Author: mt Time: 3 February 2022, 4:27:27.276027 pm UUID: 6bb978c2-9714-c846-b94b-4166a25fae48 Ancestors: System-dtl.1299 Complements Graphics-mt.471 =============== Diff against System-dtl.1299 =============== Item was changed: ----- Method: TextStyle>>addNewFontSize: (in category '*System-Fonts') ----- addNewFontSize: pointSize "Add a font in specified size to the array of fonts." + | f d newArray t isSet priorDefault | - | f d newArray t isSet | fontArray first emphasis ~= 0 ifTrue: [ t := TextConstants at: self fontArray first familyName asSymbol. t fonts first emphasis = 0 ifTrue: [ ^ t addNewFontSize: pointSize. ]. ]. pointSize <= 0 ifTrue: [^ nil]. fontArray do: [:s | s pointSize = pointSize ifTrue: [^ s]. ]. (isSet := fontArray first isKindOf: TTCFontSet) ifTrue:[ | fonts | fonts := fontArray first fontArray collect: [ :font | | newFont | (font isNil) ifTrue: [newFont := nil] ifFalse: [ newFont := (font ttcDescription size > 256) ifTrue: [MultiTTCFont new initialize] ifFalse: [TTCFont new initialize]. newFont ttcDescription: font ttcDescription. + newFont pointSize: pointSize. - newFont pixelSize: pointSize * 96 // 72. font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto | proto ifNotNil: [ d := proto class new initialize. d ttcDescription: proto ttcDescription. d pixelSize: newFont pixelSize. newFont derivativeFont: d]]]. ]. newFont]. f := TTCFontSet newFontArray: fonts] ifFalse: [ f := fontArray first class new initialize: fontArray first. f pointSize: pointSize. fontArray first derivativeFonts do: [:proto | proto ifNotNil: [ d := TTCFont new initialize: proto. d pointSize: f pointSize. f derivativeFont: d. ]. ]. ]. newArray := (fontArray copyWith: f) asArray sort: [:a :b | a pointSize <= b pointSize]. + priorDefault := self defaultFont pointSize. self newFontArray: newArray. + self defaultFontIndex: (self fontIndexOfPointSize: priorDefault). isSet ifTrue: [ TTCFontSet register: newArray at: newArray first familyName asSymbol. ]. ^ self fontOfPointSize: pointSize ! Item was changed: ----- Method: UserInterfaceTheme>>installSystemFont: (in category 'private - fonts') ----- installSystemFont: aFont + "Establish the default text font and style. Update the #defaultFontIndex in all known text styles to reflect the system's new default point size." - "Establish the default text font and style" | aStyle | self flag: #todo. "mt: Support derivatives such as bold and italic." aStyle := aFont textStyle. aStyle defaultFontIndex: (aStyle fontIndexOfPointSize: aFont pointSize "drop emphasis"). TextStyle setDefault: aStyle. + TextStyle actualTextStyles "no defaults" do: [:ea | + ea isTTCStyle ifTrue: [ea defaultFont asPointSize: aFont pointSize "May generate new pointSize"]. + ea defaultFontIndex: (ea fontIndexOfPointSize: aFont pointSize)]. + RealEstateAgent resetScaleFactor. Flaps replaceToolsFlap. ScriptingSystem resetStandardPartsBin.! Item was changed: + (PackageInfo named: 'System') postscript: '"Add missing sTypo values for our Bitstream Vera fonts." + TTFontDescription allInstancesDo: [:ea | (ea familyName beginsWith: ''Bitstream Vera'') + ifTrue: [ea setTypographicAscender: 1556 descender: -492 lineGap: 410 ]]. + + "Update #leading in all text styles using the default font''s #lineGap. Also remove all cached glyphs." + AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ]. + TextStyle allInstancesDo: [ :style | style pixelsPerInchChanged ]. + + "Fix default font sizes in existing text styles according to the current UserInterfaceTheme." + UserInterfaceTheme current installSystemFont: TextStyle defaultFont.'! - (PackageInfo named: 'System') postscript: 'SystemNavigation initializeAuthors. - AbstractFont setupDefaultFallbackTextStyle.'!

1 0

The Trunk: TrueType-mt.60.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

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)(a)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)(a)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)(a)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!

1 0

The Trunk: Graphics-mt.471.mcz
by commits＠source.squeak.org 03 Feb '22

03 Feb '22

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.!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2022