Packages February 2022

packages@lists.squeakfoundation.org

1 participants
200 discussions

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

25 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.74.mcz ==================== Summary ==================== Name: TrueType-mt.74 Author: mt Time: 25 February 2022, 10:40:11.78063 am UUID: ab1c5dc9-3363-e448-9bfa-c3c33f4a73fe Ancestors: TrueType-mt.73 Step 3 of 2 :-D ... remove unused code. =============== Diff against TrueType-mt.73 =============== 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' - instanceVariableNames: 'fileName fileOffset familyName subfamilyName copyright ascender descender lineGap unitsPerEm numGlyphs indexToLocOffset indexToLocFormat glyphTableOffset cmapType cmapOffset numHMetrics hmtxTableOffset sTypoAscender sTypoDescender sTypoLineGap extraScale extraGap' 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 removed: - ----- Method: TTFileDescription>>extraGap (in category 'accessing') ----- - extraGap - "See commenetary in TTFontDescription" - - ^ extraGap ifNil: [extraGap := TTFontDescription extraGapFor: self]! Item was removed: - ----- Method: TTFileDescription>>extraGap: (in category 'accessing') ----- - extraGap: anIntegerOrNil - "Increase or decrease the receivers line gap" - - extraGap = anIntegerOrNil ifTrue: [^ self]. - extraGap := anIntegerOrNil. - TTCFont allSubInstancesDo: [:font | - font ttcDescription == self ifTrue: [font reset "keep glyph cache"]]. - TextStyle allInstancesDo: [:style | style reset].! Item was removed: - ----- Method: TTFileDescription>>extraScale (in category 'accessing') ----- - extraScale - - ^ extraScale ifNil: [extraScale := TTFontDescription extraScaleFor: self]! Item was removed: - ----- Method: TTFileDescription>>extraScale: (in category 'accessing') ----- - extraScale: aFloatOrNil - "EXPERIMENTAL. See commentary in TTFontDescription" - - self extraScale = aFloatOrNil ifTrue: [^ self]. - extraScale := aFloatOrNil. - TTCFont allSubInstancesDo: [:font | - font ttcDescription == self ifTrue: [font flushCache]].! 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' - instanceVariableNames: 'glyphTable glyphs kernPairs copyright familyName fullName subfamilyName uniqueName versionName postscriptName trademark bounds unitsPerEm ascender descender lineGap sTypoAscender sTypoDescender sTypoLineGap extraScale extraGap' 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 removed: - ----- Method: TTFontDescription class>>extraGapFor: (in category 'defaults') ----- - extraGapFor: ttcDescription - - ^ ttcDescription typographicLineGap = 0 - ifFalse: [0 "The font already provides. Users may override manually."] - ifTrue: [(ttcDescription internalLeading * 0.5) truncated]! Item was removed: - ----- 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. For now, use up about 50% of the room reserved for glyph features, i.e. #internalLeading. Our goal is to render comparable glyphs from different fonts in a similar size so that the system's readability of text is not impaired when mixing largely different fonts. In the end, glyphs sizes may still differ, but not as much." - - (ttcDescription familyName beginsWith: 'Bitstream Vera') - ifTrue: [^ 1.059 "Squeak's optimized default TrueType font for scale factors 75% to 150%. The benchmark is whether the underscore glyph $_ is legible."]. - - ^ 1.0 + ((ttcDescription internalLeading / ttcDescription unitsPerEm) * 0.5)! Item was removed: - ----- Method: TTFontDescription>>extraGap (in category 'accessing - metrics') ----- - extraGap - "Answer the extra lineGap for the receiver. In combination with #extraScale, this property can be used to balance the legibility of different fonts used side-by-side with the same #pointSize." - - ^ extraGap ifNil: [extraGap := self class extraGapFor: self]! Item was removed: - ----- Method: TTFontDescription>>extraGap: (in category 'accessing - metrics') ----- - extraGap: anIntegerOrNil - "Increase or decrease the receivers line gap" - - extraGap = anIntegerOrNil ifTrue: [^ self]. - extraGap := anIntegerOrNil. - TTCFont allSubInstancesDo: [:font | - font ttcDescription == self ifTrue: [font reset "keep glyph cache"]]. - TextStyle allInstancesDo: [:style | style reset].! Item was removed: - ----- Method: TTFontDescription>>extraScale (in category 'accessing - metrics') ----- - extraScale - " - TTCFont allSubInstancesDo: [:f | f ttcDescription extraScale: nil] - " - ^ extraScale ifNil: [extraScale := self class extraScaleFor: self]! Item was removed: - ----- Method: TTFontDescription>>extraScale: (in category 'accessing - metrics') ----- - 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 may notice overlapping and clipping artifacts." - - extraScale = aFloatOrNil ifTrue: [^ self]. - extraScale := aFloatOrNil. - TTCFont allSubInstancesDo: [:font | - font ttcDescription == self ifTrue: [font flushCache]].!

1 0

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

25 Feb '22

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1313.mcz ==================== Summary ==================== Name: System-mt.1313 Author: mt Time: 25 February 2022, 10:37:45.39663 am UUID: fc3c8d83-1afd-7d41-8347-a215a8982ad0 Ancestors: System-mt.1312 Complements TrueType-mt.73 =============== Diff against System-mt.1312 =============== 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 | 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) + ifFalse: [f := fontArray first copyWithPointSize: pointSize] ifTrue:[ | fonts | + self flag: #legacy. "mt: There should be no new instances of TTCFontSet (or StrikeFontSet) anymore." 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. 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]. + - 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 !

1 0

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

25 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.73.mcz ==================== Summary ==================== Name: TrueType-mt.73 Author: mt Time: 25 February 2022, 10:37:20.57863 am UUID: 9a7bc579-7e0f-8c48-8a25-10f8a5466379 Ancestors: TrueType-mt.72 Move extral scale/gap from TTFontDescription up to TTCFont -- Step 2 of 2 Activate the use of TTCFont's #extraGlyphScale and #extraLineGap. (Note that this also fixes clipping artifacts of over-height and over-wide glyphs. That is, left/top/right/bottom bearings in a glyph are not respected.) =============== Diff against TrueType-mt.72 =============== Item was changed: TTCFont subclass: #LinedTTCFont instanceVariableNames: 'emphasis lineGlyph contourWidth' classVariableNames: '' poolDictionaries: '' category: 'TrueType-Fonts'! + + !LinedTTCFont commentStamp: 'mt 2/24/2022 16:24' prior: 0! + I am a TrueType font that uses the glyph for $_ to appear with underlined emphasis. If that glyph's decent is too close the baseline, the underlined font might look awkward.! Item was changed: ----- Method: LinedTTCFont>>computeForm: (in category 'private') ----- computeForm: char "Overwritten to add line glyph." + ^ ttcDescription renderGlyph: char height: self height extraScale: self extraGlyphScale fgColor: foregroundColor bgColor: Color transparent depth: self depth lineGlyph: lineGlyph lineGlyphWidth: contourWidth emphasis: emphasis! - ^ ttcDescription renderGlyph: char height: self height fgColor: foregroundColor bgColor: Color transparent depth: self depth lineGlyph: lineGlyph lineGlyphWidth: contourWidth emphasis: emphasis! Item was changed: ----- Method: TTCFont>>computeForm: (in category 'character shapes') ----- + computeForm: aCharacter - computeForm: char "Compute the glyph form for the given character" + + ^ ttcDescription + renderGlyph: aCharacter + height: self height "in pixels" + extraScale: self extraGlyphScale + fgColor: foregroundColor + bgColor: Color transparent + depth: self depth! - ^ttcDescription renderGlyph: char height: self height fgColor: foregroundColor bgColor: Color transparent depth: self depth! Item was changed: ----- Method: TTCFont>>displayString:on:from:to:at:kern:baselineY: (in category 'displaying') ----- displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY | form glyphInfo destX destY hereX nextX actualFont | destX := aPoint x. glyphInfo := Array new: 5. startIndex to: stopIndex do: [:charIndex | self glyphInfoOf: (aString at: charIndex) into: glyphInfo. form := glyphInfo at: 1. hereX := glyphInfo at: 2. nextX := glyphInfo at: 3. (actualFont := glyphInfo at: 5) == aBitBlt lastFont ifFalse: [actualFont installOn: aBitBlt]. destY := baselineY - (glyphInfo at: 4). aBitBlt sourceForm: form. + aBitBlt destX: destX + form offset x. - aBitBlt destX: destX. aBitBlt destY: destY + form offset y. "Compensate overdraw. See #extraScale:." aBitBlt sourceX: hereX; sourceY: 0. + aBitBlt width: form width. - aBitBlt width: nextX - hereX. aBitBlt height: form height. aBitBlt copyBits. destX := destX + (nextX - hereX) + kernDelta. ]. ^ destX @ destY ! Item was changed: ----- Method: TTCFont>>glyphInfoOf:into: (in category 'displaying') ----- glyphInfoOf: aCharacter into: glyphInfoArray "return the glyph info for aCharacter; if I don't have such a character, try my fallback font" | form | (self hasGlyphOf: aCharacter) ifFalse: [ ^ self fallbackFont glyphInfoOf: aCharacter into: glyphInfoArray. ]. form := self formOf: aCharacter. glyphInfoArray at: 1 put: form; + at: 2 put: 0; "hereX -- relative, unlike StrikeFont" + at: 3 put: form advanceWidth; "nextX -- relative, unlike StrikeFont" - at: 2 put: 0; - at: 3 put: form width; at: 4 put: self ascent "(self ascentOf: aCharacter)"; at: 5 put: self. ^ glyphInfoArray. ! Item was changed: ----- Method: TTCFont>>lineGap (in category 'accessing') ----- lineGap + "Answer the line gap in pixels. Scale from #typographicLineGap to make larger texts more ledigble." - "Answer the line gap from the ttf description. Use #typographicLineGap to make larger tests more ledigble." + ^ lineGap ifNil: [lineGap := (self pixelTypoScale * (ttcDescription typographicLineGap + self extraLineGap)) rounded] + + "Do not use the non-typo values: + ^ (self pixelScale * (ttcDescription lineGap + ttcDescription extraGap) rounded + "! - "^ (self pixelScale * (ttcDescription lineGap + ttcDescription extraGap) rounded" - ^ lineGap ifNil: [lineGap := (self pixelTypoScale * (ttcDescription typographicLineGap + ttcDescription extraGap)) rounded]! Item was changed: + ----- Method: TTCFont>>widthOf: (in category 'measuring') ----- - ----- Method: TTCFont>>widthOf: (in category 'public') ----- widthOf: aCharacter + "Overwritten to use the #advanceWidth and not the #width of the form. See TTGlyphForm" + - "This method cannot use #formOf: because formOf: discriminates the color and causes unnecessary bitmap creation." (self hasGlyphOf: aCharacter) ifFalse: [^ self fallbackFont widthOf: aCharacter]. + ^(self formOf: aCharacter) advanceWidth! - ^(self formOf: aCharacter) width! Item was changed: ----- Method: TTFileDescription>>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 flag: #deprecated. ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: nil lineGlyphWidth: 0 emphasis: 0! Item was changed: ----- Method: TTFileDescription>>renderGlyph:height:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') ----- + renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis - renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyph lineGlyphWidth: lWidth emphasis: emphasis "Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph." + self flag: #deprecated. + ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - | form pixelScale offset | - pixelScale := fontHeight asFloat / self fontHeight. - offset := 0 @ ( (((self ascender) - ((self ascender) * self extraScale)) * pixelScale) truncated). - form := (self at: code) - asFormWithScale: pixelScale * self extraScale - ascender: self ascender - descender: self descender fgColor: fgColor bgColor: bgColor depth: depth + lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis! - replaceColor: false - lineGlyph: lineGlyph lineGlyphWidth: lWidth - emphasis: emphasis. - form offset: offset. - ^ form! 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 flag: #deprecated. ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: nil lineGlyphWidth: 0 emphasis: 0! Item was changed: ----- Method: TTFontDescription>>renderGlyph:height:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') ----- renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis "Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph." + self flag: #deprecated. + ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - | form pixelScale offset | - pixelScale := fontHeight asFloat / self fontHeight. - offset := 0 @ ( (((self ascender) - ((self ascender) * self extraScale)) * pixelScale) truncated). - form := (self at: code) - asFormWithScale: pixelScale * self extraScale - ascender: self ascender - descender: self descender fgColor: fgColor bgColor: bgColor depth: depth + lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis! - replaceColor: false - lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth - emphasis: emphasis. - form offset: offset. - ^ form! Item was changed: ----- 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 + | topBearing bottomBearing pixelBox pixelOutset form canvas newScale renderOffset | + topBearing := bounds bottom - ascender max: 0. + bottomBearing := bounds top - descender min: 0. + renderOffset := leftSideBearing abs @ (ascender+topBearing) negated. + + "Prepare the pixel box" + pixelBox := ((advanceWidth @ (ascender - descender)) * scale) rounded. + pixelOutset := ((leftSideBearing abs @ topBearing "abs" ) * scale) rounded + corner: ((rightSideBearing abs @ bottomBearing abs ) * scale) rounded. + form := TTGlyphForm extent: pixelBox + + pixelOutset left + pixelOutset top + + pixelOutset right + pixelOutset bottom + depth: depth. + form advanceWidth: pixelBox x. + form offset: pixelOutset topLeft negated. + - | 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: renderOffset). - 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 := (pixelBox x + 1) asFloat / lineGlyph calculateWidth asFloat. - 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: [ | renderLineOffset | + renderLineOffset := renderOffset x @ (renderOffset y negated // 2). + canvas transformBy: (MatrixTransform2x3 withOffset: renderLineOffset). - (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: + (PackageInfo named: 'TrueType') postscript: '"Moves extra glyph scale and extra line gap from font description (i.e., TTFontDescription) up to font instance (i.e., TTCFont). Restore glyph scale for default fonts. Note that we might want to rename their #familyName(:) in the future to make that clear. Scale factors were chosen to look good on various scale factors at 10.5 pt." + + #( + BitstreamVeraSans 1.059 24 + BitstreamVeraSansMono 1.059 24 + BitstreamVeraSerif 1.11 47 + ) groupsDo: [:name :scale :gap | + (TextStyle named: name) defaultFont + extraGlyphScale: scale; + extraLineGap: gap]. + TTCFont shutDown: true. "Reset glyph caches"'!

1 0

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

25 Feb '22

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.487.mcz ==================== Summary ==================== Name: Graphics-mt.487 Author: mt Time: 25 February 2022, 10:32:11.90563 am UUID: be4417fd-f7bd-7047-800d-6ab6ec40c0a7 Ancestors: Graphics-mt.486 Complements TrueType-mt.72 =============== Diff against Graphics-mt.486 =============== 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 tt defaultFont preferredPointSize exampleFont | style := self named: styleName. preferredPointSize := TextStyle defaultFont pointSize. "system's current default" defaultFont := style defaultFont. "style's current default" exampleFont := defaultFont isSymbolFont + ifTrue: [TextStyle defaultFont "famiyl name should be legible"] - ifTrue: [TextStyle defaultFont] ifFalse: [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', (defaultFont isRemoteFont ifFalse: [''] ifTrue: [' (remote)']), (defaultFont isSymbolFont ifFalse: [''] ifTrue: [' (symbols)'])]) - ((style isTTCStyle ifFalse: [''] ifTrue: [' TrueType', (tt isExternal ifFalse: [''] ifTrue: [' (extern)']), (defaultFont isSymbolFont ifFalse: [''] ifTrue: [' (symbols)'])]) asText addAttribute: (TextColor color: ((self userInterfaceTheme get: #balloonTextColor for: #PluggableTextMorphPlus) ifNil: [Color gray])); yourself), (style isTTCStyle ifFalse: [''] ifTrue: [ | eg | ' ... ' asText, + ((' ', (defaultFont extraGlyphScale * 100) rounded asString, '%') asText addAttribute: (PluggableTextAttribute evalBlock: [style chooseExtraScale]); yourself), + ((' ', ((eg := defaultFont extraLineGap) >= 0 ifTrue: ['+', eg asString] ifFalse: [eg asString])) asText addAttribute: (PluggableTextAttribute evalBlock: [style chooseExtraGap]); yourself) ]), - ((' ', (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) ]), ' ... ', ('explore' translated asText addAttribute: (PluggableTextAttribute evalBlock: [style explore]); yourself), ' ', ('browse' translated asText addAttribute: (PluggableTextAttribute evalBlock: [defaultFont browseAllGlyphs; browseAllGlyphsByCategory]); 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. ].!

1 0

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

25 Feb '22

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

1 0

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

25 Feb '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.72.mcz ==================== Summary ==================== Name: TrueType-mt.72 Author: mt Time: 25 February 2022, 10:30:51.46363 am UUID: 94aba991-6d64-304c-9759-2f6b86743889 Ancestors: TrueType-mt.71 Move extral scale/gap from TTFontDescription up to TTCFont -- Step 1 of 2 Make it a property of the particular font instance to not modify the original font data. Make it possible no rename a TTCFont's #familyName to install that font under a different #textStyleName to make it possible to have both the modified and the original font. Thanks to Tobias (topa) for the idea! This fits better to our concept of TTCFont and how point sizes are managed. =============== Diff against TrueType-mt.71 =============== Item was added: + ----- Method: Form>>advanceWidth (in category '*TrueType-displaying') ----- + advanceWidth + "Backwards compatibility wit TTGlyphForm. See TTCFont >> #widthOf:." + + ^ width! Item was added: + ----- Method: LinedTTCFont>>addLined: (in category 'initialize') ----- + addLined: aTTCFont + "Ignore. I am already lined." + + ^ self! Item was changed: AbstractFont subclass: #TTCFont + instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont height ascent descent colorToCacheMap lineGap lineGapSlice minCodePoint maxCodePoint extraGlyphScale extraLineGap' - instanceVariableNames: 'ttcDescription pointSize foregroundColor cache derivatives fallbackFont height ascent descent colorToCacheMap lineGap lineGapSlice minCodePoint maxCodePoint' classVariableNames: 'GlyphCacheData GlyphCacheIndex GlyphCacheReady GlyphCacheSize NamesToIndexes Registry Scale ShutdownList' poolDictionaries: '' category: 'TrueType-Fonts'! !TTCFont commentStamp: 'nk 4/2/2004 11:32' prior: 0! I represent a font that uses TrueType derived glyph. Upon a request for glyph for a character through a call to #formOf: (or #widthOf:), I first search corresponding glyph in the cache. If there is not, it creates a 32bit depth form with the glyph. The cache is weakly held. The entries are zapped at full GC. Structure: ttcDescription TTFontDescription -- The Squeak data structure for a TrueType font data file. pointSize Number -- Nominal Em size in points. Conversion to pixel sizes depends on the definition of TextStyle class>>pixelsPerInch. foregroundColor Color -- So far, this font need to know the glyph color in cache. cache WeakArray of <Color -> <Array(256) of glyph>> derivatives Array -- stores the fonts in the same family but different emphasis. ! Item was added: + ----- Method: TTCFont>>copyWithPointSize: (in category 'copying') ----- + copyWithPointSize: newPointSize + "Copy the receiver to create a new point size. Note that the call to #asPointSize: might end up here." + + | result | + result := self class new initialize: self. + result setPointSize: newPointSize. + result flushCache. "Hmpf. Initialize cache at some point ..." + + self derivativeFonts do: [:proto | + proto ifNotNil: [ | d | + d := TTCFont new initialize: proto. + d setPointSize: newPointSize. + d flushCache. "Hmpf. Initialize cache at some point ..." + result derivativeFont: d]]. + + ^ result! Item was added: + ----- Method: TTCFont>>extraGlyphScale (in category 'accessing') ----- + extraGlyphScale + "Answers the additional scale factor that is applied when rendering the receiver's glyphs into forms. You can increase or decrease this scale to change the font's original point-size-to-visual-size mapping. For example, the visual #xHeight of multiple fonts can be adjusted to look more consistent side-by-side. In the case of #fallbackFont it makes sense to show the fallback glyph in a compatible size. There are fonts that greatly vary in their #xHeight when being rendered at the same point size. Another example is a low value of #pixelsPerInch where a slightly increase in glyph scale can improve legibility of some glyphs at smaller point sizes. + + NOTE THAT this extra scale does not change the receiver's #pixelHeight. Consequently, if the scale factor is too large, you may notice overlapping and clipping artifacts. You may want to also adjust #extraLineGap to keep the font's overall aesthetics." + + ^ extraGlyphScale ifNil: [extraGlyphScale := 1.0]! Item was added: + ----- Method: TTCFont>>extraGlyphScale: (in category 'editing') ----- + extraGlyphScale: aFloatOrNil + "See commentary in #extraGlyphScale. Enumerate all known point sizes and emphases." + + | fontsToUpdate | + fontsToUpdate := self textStyleOrNil + ifNil: [{self} "not-yet-installed"] + ifNotNil: [:style | style fontArray "all point sizes"]. + + fontsToUpdate do: [:font | "All subfamilies / emphases" + font privateExtraGlyphScale: aFloatOrNil. + font derivativeFonts do: [:f | f privateExtraGlyphScale: aFloatOrNil ]]. + + TextStyle allInstancesDo: [:style | + (style fontArray anySatisfy: [:font | fontsToUpdate identityIncludes: font]) + ifTrue: [ "Width of space and tabs might have changed." + style reset]].! Item was added: + ----- Method: TTCFont>>extraLineGap (in category 'accessing') ----- + extraLineGap + "Answers the extra line gap of the receiver in units-per-em (UPM). Which means that the description's #typographicLineGap can be adjusted or completely nullified. NOTE THAT you can adjust a text-style's #lineSpacing as an additional factor to modify such gaps per application instead of per font." + + ^ extraLineGap ifNil: [extraLineGap := 0]! Item was added: + ----- Method: TTCFont>>extraLineGap: (in category 'editing') ----- + extraLineGap: aFloatOrNil + "See commentary in #extraLineGap. Enumerate all known point sizes and emphases." + + | fontsToUpdate | + fontsToUpdate := self textStyleOrNil + ifNil: [{self} "not-yet-installed"] + ifNotNil: [:style | style fontArray "all point sizes"]. + + fontsToUpdate do: [:font | "All subfamilies / emphases" + font privateExtraLineGap: aFloatOrNil. + font derivativeFonts do: [:f | f privateExtraLineGap: aFloatOrNil ]].! Item was changed: ----- Method: TTCFont>>familyName (in category 'accessing') ----- familyName + "Use the description's #name instead of #familyName to ignore separators. Can be overwritten by the particular receiver such as when changing a font's #extraGlyphScale." - "Use #name instead of #familyName to ignore separators." + ^ familyName + ifNotNil: [familyName copyWithout: Character space] + ifNil: [ttcDescription name]! - ^ ttcDescription name! Item was added: + ----- Method: TTCFont>>familyName: (in category 'editing') ----- + familyName: newNameOrNil + "See commentary in #familyName. Enumerate all known point sizes and emphases." + + | fontsToUpdate | + fontsToUpdate := self textStyleOrNil + ifNil: [{self} "not-yet-installed"] + ifNotNil: [:style | style fontArray "all point sizes"]. + + fontsToUpdate do: [:font | "All subfamilies / emphases" + font privateFamilyName: newNameOrNil. + font derivativeFonts do: [:f | f privateFamilyName: newNameOrNil ]].! Item was added: + ----- Method: TTCFont>>familyNameAsIs (in category 'accessing') ----- + familyNameAsIs + "Answers the receiver's family name as-is, which means including all the spaces." + + ^ familyName ifNil: [ttcDescription familyName]! Item was changed: ----- Method: TTCFont>>initialize: (in category 'initialize') ----- + initialize: aPrototypeTTCFont + "Initialize the receiver from aPrototypeTTCFont." - initialize: aFont self initialize. + + ttcDescription := aPrototypeTTCFont ttcDescription. + pointSize := aPrototypeTTCFont pointSize. + + familyName := aPrototypeTTCFont familyNameAsIs. + extraGlyphScale := aPrototypeTTCFont extraGlyphScale. + extraLineGap := aPrototypeTTCFont extraLineGap.! - self ttcDescription: aFont ttcDescription. - ! Item was added: + ----- Method: TTCFont>>isRemoteFont (in category 'testing') ----- + isRemoteFont + "Answer whether this font fetches its glyph data from a remote location such as the file system." + + ^ ttcDescription isRemoteFont! Item was changed: ----- Method: TTCFont>>name (in category 'accessing') ----- name + "Overwritten just like StrikeFont does. Keep it simple and use my #familyName." + ^ self familyName! - ^ ttcDescription name. - ! 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 fontHeight - "^ self pixelSize asFloat / ttcDescription typographicFontHeight"! Item was changed: + ----- Method: TTCFont>>pixelSize: (in category 'editing') ----- - ----- Method: TTCFont>>pixelSize: (in category 'initialize') ----- pixelSize: aNumber + "Make sure that we don't yield too many point sizes." + + self flag: #deprecated. + self pointSize: ((TextStyle pixelsToPoints: aNumber) roundTo: 0.5). - "Make sure that we don't return a Fraction" - self pointSize: (TextStyle pixelsToPoints: aNumber) rounded. ! Item was changed: + ----- Method: TTCFont>>pointSize: (in category 'editing') ----- - ----- Method: TTCFont>>pointSize: (in category 'initialize') ----- pointSize: aNumber + "Modify the receiver's point size. NOTE THAT #asPointSize: will also give you the receiver's font (description) in a different size without modifying the receiver." + - self privatePointSize: aNumber. derivatives ifNotNil: [ derivatives do: [ :f | f ifNotNil: [ f privatePointSize: aNumber ]]]. ! Item was added: + ----- Method: TTCFont>>privateExtraGlyphScale: (in category 'editing') ----- + privateExtraGlyphScale: aFloatOrNil + "See commentary in #extraGlyphScale." + + extraGlyphScale = aFloatOrNil ifTrue: [^ self]. + (aFloatOrNil isNil or: [aFloatOrNil > 0.0]) ifFalse: [^ self]. + + extraGlyphScale := aFloatOrNil. + + "Discard cached glyph forms and pixel-sclaed font metrics." + self flushCache.! Item was added: + ----- Method: TTCFont>>privateExtraLineGap: (in category 'editing') ----- + privateExtraLineGap: anIntegerOrNil + "See commentary in #extraLineGap." + + extraLineGap = anIntegerOrNil ifTrue: [^ self]. + extraLineGap := anIntegerOrNil. + + "Discard pixel-scaled font metrics but (!!) keep glyph cache." + self reset.! Item was added: + ----- Method: TTCFont>>privateFamilyName: (in category 'editing') ----- + privateFamilyName: newNameOrNil + "Rename the receiver to reflect custom edits such as #extraGlyphScale and #extraLineGap. Changing the name will override the receiver's #textStyleName and #familyName." + + familyName := newNameOrNil.! Item was changed: ----- Method: TTCFont>>scale (in category 'private') ----- scale self flag: #deprecated. + ^ self pixelScale - ^ self pixelSize / ttcDescription unitsPerEm ! Item was added: + ----- Method: TTCFont>>setPointSize: (in category 'initialize') ----- + setPointSize: aPointSize + "For fast initialization only. See #pointSize: and #asPointSize:." + + pointSize := aPointSize.! Item was added: + ----- Method: TTCFont>>setPointSize:familyName:extraGlyphScale:extraLineGap: (in category 'initialize') ----- + setPointSize: aPointSize familyName: aString extraGlyphScale: aFloat extraLineGap: anInteger + "For fast initialization only. Tweak the receiver's font description with a custom scale and gap. Rename it to make that adjustments clear in tools. See #pointSize:, #familyName:, #extraGlyphScale:, and #extraLineGap: for later adjustments." + + pointSize := aPointSize. + + familyName := aString. "Override what's in #ttcDescription." + extraGlyphScale := aFloat. + extraLineGap := anInteger.! Item was removed: - ----- Method: TTFileDescription>>isExternal (in category 'testing') ----- - isExternal - "Answer whether the receiver get's its data from an external file." - - ^ true! Item was added: + ----- Method: TTFileDescription>>isRemoteFont (in category 'testing') ----- + isRemoteFont + "Answer whether the receiver get's its data from an external file." + + ^ true! Item was added: + ----- Method: TTFileDescription>>renderGlyph:height:extraScale:fgColor:bgColor:depth: (in category 'rendering') ----- + renderGlyph: code height: fontHeight extraScale: extraScale fgColor: fgColor bgColor: bgColor depth: depth + "Render the glyph with the given code point at the specified pixel height." + + ^ self + renderGlyph: code height: fontHeight extraScale: extraScale + fgColor: fgColor bgColor: bgColor depth: depth + lineGlyph: nil lineGlyphWidth: 0 emphasis: 0! Item was added: + ----- Method: TTFileDescription>>renderGlyph:height:extraScale:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') ----- + renderGlyph: code height: fontHeight extraScale: extraScale fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis + "Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph." + + | form pixelScale offset | + pixelScale := fontHeight asFloat / self fontHeight. + offset := 0 @ ( ((self ascender - (self ascender * extraScale)) * pixelScale) truncated ). + form := (self at: code) + asFormWithScale: pixelScale * extraScale + ascender: self ascender + descender: self descender + fgColor: fgColor bgColor: bgColor depth: depth + replaceColor: false + lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth + emphasis: emphasis. + form offset: form offset + offset. + ^ form! Item was removed: - ----- Method: TTFontDescription>>isExternal (in category 'testing') ----- - isExternal - "Answer whether the receiver get's its data from an external file." - - ^ false! Item was added: + ----- Method: TTFontDescription>>isRemoteFont (in category 'testing') ----- + isRemoteFont + "Answer whether the receiver get's its data from an external file." + + ^ false! Item was changed: ----- Method: TTFontDescription>>name (in category 'accessing') ----- name + "Compact the receiver's #familyName to be used in index structures such as a font's #textStyle." + + ^ self familyName copyWithout: Character space! - - ^ self familyName copyWithout: Character space. - ! Item was added: + ----- Method: TTFontDescription>>renderGlyph:height:extraScale:fgColor:bgColor:depth: (in category 'rendering') ----- + renderGlyph: code height: fontHeight extraScale: extraScale fgColor: fgColor bgColor: bgColor depth: depth + "Render the glyph with the given code point at the specified pixel height." + + ^ self + renderGlyph: code height: fontHeight extraScale: extraScale + fgColor: fgColor bgColor: bgColor depth: depth + lineGlyph: nil lineGlyphWidth: 0 emphasis: 0! Item was added: + ----- Method: TTFontDescription>>renderGlyph:height:extraScale:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') ----- + renderGlyph: code height: fontHeight extraScale: extraScale fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis + "Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph." + + | form pixelScale offset | + pixelScale := fontHeight asFloat / self fontHeight. + offset := 0 @ ( ((self ascender - (self ascender * extraScale)) * pixelScale) truncated ). + form := (self at: code) + asFormWithScale: pixelScale * extraScale + ascender: self ascender + descender: self descender + fgColor: fgColor bgColor: bgColor depth: depth + replaceColor: false + lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth + emphasis: emphasis. + form offset: form offset + offset. + ^ form! Item was added: + Form subclass: #TTGlyphForm + instanceVariableNames: 'advanceWidth' + classVariableNames: '' + poolDictionaries: '' + category: 'TrueType-Fonts'! + + !TTGlyphForm commentStamp: 'mt 2/19/2022 07:36' prior: 0! + I am a form that holds extra information about #advanceWidth in pixels.! Item was added: + ----- Method: TTGlyphForm>>advanceWidth (in category 'accessing') ----- + advanceWidth + + ^ advanceWidth! Item was added: + ----- Method: TTGlyphForm>>advanceWidth: (in category 'accessing') ----- + advanceWidth: anObject + + advanceWidth := anObject.! Item was added: + ----- Method: TTGlyphForm>>initialize (in category 'initialize-release') ----- + initialize + + super initialize. + advanceWidth := 0.!

1 0

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

25 Feb '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1908.mcz ==================== Summary ==================== Name: Morphic-mt.1908 Author: mt Time: 25 February 2022, 10:20:44.98063 am UUID: 456e2759-82fb-bc45-9568-55811f72a5bf Ancestors: Morphic-ct.1907 Fixes a bug related to StringMorph updating in, for example, tree widgets. We could not remove emphasis in such an update (e.g., underlined -> normal). Also improves the support of not-yet-installed fonts in the FontChooserTool. =============== Diff against Morphic-ct.1907 =============== Item was changed: ----- Method: FontChooserTool>>fontList (in category 'font list') ----- fontList "List of available font family names. Avoid StrikeFonts if PPI is not 96.0." fontList ifNotNil: [^ fontList]. fontList := TextStyle knownTextStylesWithoutDefault. self getFontFromRequestor ifNotNil: [:font | (fontList includes: font familyName) ifFalse: [ fontList := (fontList, {font familyName}) sorted]]. TextStyle pixelsPerInch = 96.0 ifFalse: [ + fontList := fontList select: [:styleName | + (TextStyle named: styleName) ifNil: [true "not yet installed"] ifNotNil: [:style | style isTTCStyle] ]]. - fontList := fontList select: [:styleName | (TextStyle named: styleName) isTTCStyle]]. ^ fontList! Item was changed: ----- Method: StringMorphAttributeScanner>>initializeFromStringMorph: (in category 'string morph') ----- initializeFromStringMorph: aStringMorph actualFont := aStringMorph font ifNil: [ TextStyle defaultFont ]. + emphasis := 0. "We must start with no emphasis." + fontNumber := (actualFont textStyleOrNil + ifNil: [1] + ifNotNil: [:style | style fontIndexOfPointSize: actualFont pointSize]). - emphasis := actualFont emphasis. - fontNumber := (actualFont textStyle ifNotNil: [:style | style fontIndexOf: actualFont]) ifNil: [ 1 ]. textColor := aStringMorph color. !

1 0

The Trunk: Monticello-ct.775.mcz
by commits＠source.squeak.org 24 Feb '22

24 Feb '22

Christoph Thiede uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.775.mcz ==================== Summary ==================== Name: Monticello-ct.775 Author: ct Time: 24 February 2022, 10:26:08.824123 pm UUID: ac420a9e-d609-344d-92cc-80dadf2eb06e Ancestors: Monticello-mt.774 Hardens time-stamp parsing against invalid/legacy/missing change stamps. MCMethodDefinition>>#fullTimeStamp will answer nil in this case, and when comparing conflicts, such definitions will be skipped. =============== Diff against Monticello-mt.774 =============== Item was changed: ----- Method: MCConflict>>isLocalNewer (in category 'testing') ----- isLocalNewer + ^ (self localDefinition fullTimeStamp ifNil: [^ false]) > self remoteDefinition fullTimeStamp! - ^ self localDefinition fullTimeStamp > self remoteDefinition fullTimeStamp! Item was changed: ----- Method: MCConflict>>isRemoteNewer (in category 'testing') ----- isRemoteNewer + ^ (self localDefinition fullTimeStamp ifNil: [^ false]) < self remoteDefinition fullTimeStamp! - ^ self localDefinition fullTimeStamp < self remoteDefinition fullTimeStamp! Item was changed: ----- Method: MCMethodDefinition>>fullTimeStamp (in category 'accessing') ----- fullTimeStamp + ^ [TimeStamp fromMethodTimeStamp: timeStamp] ifError: []! - ^TimeStamp fromMethodTimeStamp: timeStamp!

1 0

The Trunk: SystemReporter-eem.57.mcz
by commits＠source.squeak.org 24 Feb '22

24 Feb '22

Eliot Miranda uploaded a new version of SystemReporter to project The Trunk: http://source.squeak.org/trunk/SystemReporter-eem.57.mcz ==================== Summary ==================== Name: SystemReporter-eem.57 Author: eem Time: 24 February 2022, 11:13:41.758845 am UUID: 33cb7103-3c28-4a75-9660-5d1709c79c21 Ancestors: SystemReporter-mt.56 Accurately describe the meaning of bit 5 in vmParameter 65's Cog VM feature flags. =============== Diff against SystemReporter-mt.56 =============== Item was changed: ----- Method: SystemReporter>>reportVMParameters: (in category 'reporting') ----- reportVMParameters: aStream | vmParameters isStack isCog isSpur | self header: 'Virtual Machine Parameters' on: aStream. vmParameters := Smalltalk vm getVMParameters. isStack := (vmParameters at: 42 ifAbsent: [0]) ~= 0. "42 = number of stack pages available" isCog := isStack and: [(vmParameters at: 46) ~= 0]. "46 is machine code zone size" isSpur := isStack and: [(vmParameters at: 41) anyMask: 2r10000]. "41 is imageFormatVersion for the VM; bit 16 is the Spur bit" (isSpur ifFalse: [#( 1 'size of old space' 2 'size of young+old space' 3 'size of memory' 4 'allocationCount' 5 'allocations between GCs')] ifTrue: [#( 1 'size of old space' 2 'used bytes in new space (used eden + used past space)' 3 'size of heap')]), #( 6 'survivor count tenuring threshold' 7 'full GCs since startup' 8 'total milliseconds in full GCs since startup'), (isSpur ifFalse: [#( 9 'incremental GCs since startup' 10 'total milliseconds in incremental GCs since startup' 11 'tenures of surving objects since startup'), {12 to: 19. 'specific to the translating VM'}] ifTrue: [#( 9 'scavenging GCs since startup' 10 'total milliseconds in scavenging GCs since startup' 11 'tenures of surving objects since startup' 12 'event trace mask (for debugging input events)' 13 'VM ticker start microseconds (Croquet/QwaqVM)' 14 'VM ticker count (Croquet/QwaqVM)' 15 'VM ticker call count (Croquet/QwaqVM)' 16 'total microseconds in idle since startup' 17 'proportion of code zone available for use (Sista VMs only; read-write)' 18 'total milliseconds in full GC compaction since startup (a portion of parameter 8)' 19 'scavenge threshold; the effective size of eden')]), #( 20 'utc microseconds at startup (if non-zero)' 21 'root/remembered table size (occupancy)' 22 'root/remembered table overflows since startup' 23 'bytes of extra memory to reserve for VM buffers, plugins, etc.' 24 'free memory threshold above which object memory will be shrunk' 25 'memory headroom when growing object memory'), (isStack ifFalse: [#( 26 'interruptChecksEveryNms - force an ioProcessEvents every N milliseconds, in case the image is not calling getNextEvent often')] ifTrue: [#( 26 'heartbeat period (ms; see #58)')]), (isSpur ifFalse: [#( 27 'number of times mark loop iterated for current IGC/FGC includes ALL marking' 28 'number of times sweep loop iterated for current IGC/FGC' 29 'number of times make forward loop iterated for current IGC/FGC' 30 'number of times compact move loop iterated for current IGC/FGC')] ifTrue: [#()]), #( 31 'number of grow memory requests' 32 'number of shrink memory requests'), (isSpur ifFalse: [#( 33 'number of root table entries used for current IGC/FGC' 34 'number of allocations done before current IGC/FGC' 35 'number of survivor objects after current IGC/FGC' 36 'millisecond clock when current IGC/FGC completed' 37 'number of marked objects for Roots of the world, not including Root Table entries for current IGC/FGC' 38 'milliseconds taken by current IGC' 39 'Number of finalization signals for Weak Objects pending when current IGC/FGC completed')] ifTrue: [#( 33 'number of root table entries at last scavenge' 35 'number of survivor objects at last scavenge (if non-zero)' 36 'millisecond clock when current scavenge completed' 38 'milliseconds taken by current scavenge' 39 'Number of finalization signals for Weak Objects pending when current SGC/FGC completed')]), #( 40 'VM word size - 4 or 8'), (isStack ifTrue: [#( 41 'imageFormatVersion for the VM' 42 'number of stack pages available' 43 'desired number of stack pages (stored in image file header, max 65535)' 44 'size of eden, in bytes' 45 'desired size of eden, in bytes (stored in image file header)' 46 'machine code zone size, in bytes (0 in Stack VM)' 47 'desired machine code zone size (0 => default 1Mb to 2Mb depending on processor)'), { 48. 'Persistent image header flags\ bit 0: implies Process has threadId as its 4th inst var\ bit 1: if set, methods that are interpreted will have the flag bit set in their header\ bit 2: if set, implies preempting a process does not put it to the back of its run queue\ bit 3: if set, implies the GUI should run on the first thread and event queues should not be accessed from other threads\ bit 4: if set, implies the new finalization scheme where WeakArrays are queued\ bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events\ bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)\ bit 7: if set, causes times delivered from file primitives to be in UTC rather than local time.' withCRs }, #( 49 'max size the image promises to grow the external semaphore table to'), (isSpur ifFalse: [{ 50 to: 51. 'reserved for VM parameters that persist in the image (such as size of eden above)'. 52 to: 56. 'specific to Spur' }] ifTrue: [{ 50 to: 51. 'reserved for VM parameters that persist in the image (such as size of eden above)' }, #( 52 'root/remembered table capacity' 53 'number of old space segments' 54 'total free old space' 55 'ratio of growth and image size at or above which a GC will be performed post scavenge')]), #( 56 'number of process switches since startup' 57 'number of ioProcessEvents calls since startup' 58 'number of forceInterruptCheck calls since startup' 59 'number of check event calls since startup' 60 'number of stack page overflows since startup' 61 'number of stack page divorces since startup' 62 'compiled code compactions since startup'), (isCog ifFalse: [#()] ifTrue: [#( 63 'total milliseconds in compiled code compactions since startup' 64 'the number of methods that currently have jitted machine-code')]), + { 65. 'Cog feature flags\ bit 0: set if the VM supports MULTIPLE_BYTECODE_SETS.\ bit 1: set if the VM supports read-only objects (IMMUTABILITY).\ bit 2: set if the VM has an ITIMER_HEARTBEAT\ bit 3: set if the VM supports cross-platform BIT_IDENTICAL_FLOATING_POINT arithmetic\ bit 4: set if the VM can catch exceptions in FFI calls and answer them as primitive failures\ bit 5: set if the VM has primitives 568 and 578, versions of the suspend primitive which back up the process to before the wait if it was waiting on a condition variable' withCRs. - { 65. 'Cog feature flags\ bit 0: set if the VM supports MULTIPLE_BYTECODE_SETS.\ bit 1: set if the VM supports read-only objects (IMMUTABILITY).\ bit 2: set if the VM has an ITIMER_HEARTBEAT\ bit 3: set if the VM supports cross-platform BIT_IDENTICAL_FLOATING_POINT arithmetic\ bit 4: set if the VM can catch exceptions in FFI calls and answer them as primitive failures\ bit 5: set if the VM''s suspend primitive backs up the process to before the wait if it was waiting on a condition variable' withCRs. 66. 'the byte size of a stack page'.}, (isSpur ifFalse: [{ 67 to: 69. 'reserved for more Cog-related info' }] ifTrue: [#( 67 'the maximum allowed size of old space (if zero there is no limit)' 68 'the average number of live stack pages when scanned by scavenge/gc/become' 69 'the maximum number of live stack pages when scanned by scavenge/gc/become')]), #( 70 'the vmProxyMajorVersion (the interpreterProxy VM_MAJOR_VERSION)' 71 'the vmProxyMinorVersion (the interpreterProxy VM_MINOR_VERSION)'), (isSpur ifFalse: [#()] ifTrue: [#( 72 'milliseconds spent marking since startup' 73 'reserved for more Spur-related info' 74 'reserved for more Spur-related info' 75 'do mixed arithmetic; if false binary arithmetic primitives will fail unless receiver and argument are of the same type')]), (isCog ifFalse: [#()] ifTrue: [#(76 'minimum unused bytes of headroom on all stack pages')])] ifFalse: [#()]) pairsDo: [:idx :desc | | value values | (idx isInteger ifTrue: [idx] ifFalse: [idx last]) <= vmParameters size ifTrue: [aStream nextPut: $#. idx isInteger ifTrue: [value := vmParameters at: idx. aStream print: idx; tab: (idx < 10 ifTrue: [2] ifFalse: [1]); nextPutAll: ((value isInteger and: [idx ~= 41]) ifTrue: [(desc includesSubstring: 'bit 0:') ifTrue: [value printStringBase: 2 nDigits: value highBit] ifFalse: [value asStringWithCommas]] ifFalse: [value printString])] ifFalse: [value := vmParameters at: idx first. aStream print: idx first; next: 2 put: $.; print: idx last; tab. values := idx collect: [:i| vmParameters at: i]. values asSet size = 1 ifTrue: [aStream print: value] ifFalse: [values do: [:v| aStream print: v] separatedBy: [aStream nextPutAll: ', ']]]. aStream tab; nextPutAll: desc; cr]]!

1 0

The Trunk: Morphic-ct.1899.mcz
by commits＠source.squeak.org 24 Feb '22

24 Feb '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1899.mcz ==================== Summary ==================== Name: Morphic-ct.1899 Author: ct Time: 15 February 2022, 7:14:37.136793 pm UUID: 8821ca11-fa94-0a4a-a2eb-c07b9fc772e9 Ancestors: Morphic-mt.1898 Makes caret width in Morphic dpi-aware. Tested with different scale factors from 75% - 300%. =============== Diff against Morphic-mt.1898 =============== Item was changed: ----- Method: NewParagraph>>caretWidth (in category 'access') ----- caretWidth + ^ (Editor dumbbellCursor - ^ Editor dumbbellCursor ifTrue: [ 3 ] + ifFalse: [ 2 ]) "pixels" * RealEstateAgent scaleFactor // 1! - ifFalse: [ 2 ]! Item was changed: ----- Method: NewParagraph>>displayDumbbellCursorOn:at:in: (in category 'display') ----- displayDumbbellCursorOn: aCanvas at: leftX in: line | w | + w := 3 "pixels" * (RealEstateAgent scaleFactor max: 1) // 1. - w := 2. self focused ifFalse: [^ w]. 1 to: w do: [:i | "Draw caret triangles at top and bottom" aCanvas fillRectangle: ((leftX - w + i - 1) @ (line top + i - 1) extent: ((w - i) * 2 + 3) @ 1) color: self caretColor. aCanvas fillRectangle: ((leftX - w + i - 1) @ (line bottom - i) extent: ((w - i) * 2 + 3) @ 1) color: self caretColor]. aCanvas + fillRectangle: (leftX - (w // 4) @ line top rect: leftX + (w + 1 // 2) @ line bottom - 1) - line: leftX @ line top - to: leftX @ (line bottom-1) color: self caretColor. ^ w! Item was changed: ----- Method: NewParagraph>>displaySelectionInLine:on: (in category 'display') ----- displaySelectionInLine: line on: aCanvas | leftX rightX w | selectionStart ifNil: [^self]. "No selection" aCanvas isShadowDrawing ifTrue: [ ^self ]. "don't draw selection with shadow" selectionStart = selectionStop ifTrue: ["Only show caret on line where clicked" selectionStart textLine ~= line ifTrue: [^self]] ifFalse: ["Test entire selection before or after here" (selectionStop stringIndex < line first or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self]. "No selection on this line" (selectionStop stringIndex = line first and: [selectionStop textLine ~= line]) ifTrue: [^self]. "Selection ends on line above" (selectionStart stringIndex = (line last + 1) and: [selectionStop textLine ~= line]) ifTrue: [^self]]. "Selection begins on line below" leftX := (selectionStart stringIndex <= line first ifTrue: [line ] ifFalse: [selectionStart ])left. rightX := (selectionStop stringIndex > (line last + 1) or: [selectionStop stringIndex = (line last + 1) and: [selectionStop textLine ~= line]]) ifTrue: [line right] ifFalse: [selectionStop left]. selectionStart = selectionStop ifTrue: [ rightX := rightX + 1. + w := caretRect ifNotNil: [caretRect width] ifNil: [2] "sigh...". + caretRect := (leftX - (w // 2)) @ line top corner: (rightX + (w // 2)) @ line bottom. - caretRect := (leftX-2) @ line top corner: (rightX+2)@ line bottom. "sigh..." self showCaret ifFalse: [^self]. w := (Editor dumbbellCursor ifTrue: [self displayDumbbellCursorOn: aCanvas at: leftX in: line] ifFalse: [self displaySimpleCursorOn: aCanvas at: leftX in: line]). caretRect := (leftX-w) @ line top corner: (rightX+w)@ line bottom] ifFalse: [ caretRect := nil. aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom) color: (self focused ifTrue: [self selectionColor] ifFalse: [self unfocusedSelectionColor])]! Item was changed: ----- Method: NewParagraph>>displaySimpleCursorOn:at:in: (in category 'display') ----- displaySimpleCursorOn: aCanvas at: leftX in: line + | width | self focused ifFalse: [^ 1]. + width := 2 "pixel" * (RealEstateAgent scaleFactor max: 1) // 1. + aCanvas + fillRectangle: (leftX @ (line top + 1) rect: leftX + width @ line bottom - 1) - line: leftX @ (line top+1) - to: leftX @ (line bottom-1) color: self caretColor. + + ^ width! - - aCanvas - line: leftX+1 @ (line top+1) - to: leftX+1 @ (line bottom-1) - color: (self caretColor alpha: 0.3). - - ^ 1!

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