The Trunk: ST80-mt.310.mcz
[email protected] Tue, 16 Jun 2026 09:31:12 0000
| Newsgroups | gmane.comp.lang.smalltalk.squeak.general |
|---|---|
| Message-ID | <[email protected]> |
Marcel Taeumel uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-mt.310.mcz ==================== Summary ==================== Name: ST80-mt.310 Author: mt Time: 16 June 2026, 11:31:12.478747 am UUID: 1b2581cd-9e53-8545-85e1-bc59ec51a90e Ancestors: ST80-ct.309 Fixes high-DPI issues in ST80 window rendering code. There are many magic numbers in the code, which we keep around for historical reasons. And MVC is still nice as a fall back when you lock yourself out of Morphic (rendering/layouting) code. Anyway, most visual stuff in MVC/ST80 is based on font geometry. =============== Diff against ST80-ct.309 =============== Item was changed: ----- Method: StandardSystemController>>adjustWindowCorners (in category 'borders') ----- adjustWindowCorners | box clicked | box := view windowBox. clicked := false. #(topLeft topRight bottomRight bottomLeft) do: [:readCorner | | cornerBox | + cornerBox := ((box insetBy: 2 px) perform: readCorner) - (10 px @ 10 px) extent: 20 px @ 20 px. - cornerBox := ((box insetBy: 2) perform: readCorner) - (10@10) extent: 20@20. (cornerBox containsPoint: sensor cursorPoint) ifTrue: ["Display reverse: cornerBox." (Cursor perform: readCorner) showWhile: [[(cornerBox containsPoint: (sensor cursorPoint)) and: [(clicked := sensor anyButtonPressed) not]] whileTrue: [ self interActivityPause ]. "Display reverse: cornerBox." clicked ifTrue: [view newFrame: [:f | | p f2 | p := sensor cursorPoint. readCorner = #topLeft ifTrue: [f2 := p corner: f bottomRight]. readCorner = #bottomLeft ifTrue: [f2 := (f withBottom: p y) withLeft: p x]. readCorner = #bottomRight ifTrue: [f2 := f topLeft corner: p]. readCorner = #topRight ifTrue: [f2 := (f withTop: p y) withRight: p x]. f2]]]]]. ^ clicked! Item was changed: ----- Method: StandardSystemController>>checkForReframe (in category 'borders') ----- checkForReframe | cp | view isCollapsed ifTrue: [^ self]. cp := sensor cursorPoint. + ((view closeBoxFrame expandBy: 2 px) containsPoint: cp) + | ((view growBoxFrame expandBy: 2 px) containsPoint: cp) - ((view closeBoxFrame expandBy: 2) containsPoint: cp) - | ((view growBoxFrame expandBy: 2) containsPoint: cp) ifTrue: [^ self]. "Dont let reframe interfere with close/grow" self adjustWindowCorners. self cursorOnBorder ifFalse: [^ self]. + ((view insetDisplayBox insetBy: 2 px @ 2 px) containsPoint: cp) - ((view insetDisplayBox insetBy: 2@2) containsPoint: cp) ifFalse: [^ self adjustWindowBorders]. view subViews size <= 1 ifTrue: [^ self]. (view subviewWithLongestSide: [:s | ] near: cp) == nil ifFalse: [^ self adjustPaneBorders].! Item was changed: ----- Method: StandardSystemController>>redButtonActivity (in category 'control defaults') ----- redButtonActivity "If cursor is in label of a window when red button is pushed, check for closeBox or growBox, else drag the window frame or edit the label." | box p | p := sensor cursorPoint. self labelHasCursor ifFalse: [super redButtonActivity. ^ self]. ((box := view closeBoxFrame) containsPoint: p) ifTrue: [Utilities awaitMouseUpIn: box repeating: [] ifSucceed: [self close. ^ self]. ^ self]. ((box := view growBoxFrame) containsPoint: p) ifTrue: [Utilities awaitMouseUpIn: box repeating: [] ifSucceed: [Sensor controlKeyPressed ifTrue: [^ self expand; fullScreen]. ^ view isCollapsed ifTrue: [self expand] ifFalse: [self collapse]]. ^ self]. + (((box := view labelTextRegion expandBy: 1 px) containsPoint: p) - (((box := view labelTextRegion expandBy: 1) containsPoint: p) and: [Preferences clickOnLabelToEdit or: [sensor leftShiftDown]]) ifTrue: [Utilities awaitMouseUpIn: box repeating: [] ifSucceed: [^ self label]. ^ self]. self move! Item was changed: ----- Method: StandardSystemView>>closeBoxFrame (in category 'label access') ----- closeBoxFrame + ^ Rectangle origin: (self labelDisplayBox leftCenter + (10 px @ -5 px)) extent: (11 px @ 11 px)! - ^ Rectangle origin: (self labelDisplayBox leftCenter + (10 @ -5)) extent: (11 @ 11)! Item was changed: ----- Method: StandardSystemView>>collapse (in category 'framing') ----- collapse "If the receiver is not already collapsed, change its view to be that of its label only." self isCollapsed ifFalse: [model modelSleep. expandedViewport := self viewport. savedSubViews := subViews. self resetSubViews. labelText isNil ifTrue: [self label: nil. bitsValid := false.]. self window: (self inverseDisplayTransform: + ((self labelDisplayBox topLeft extent: (labelText extent x + 70 px) @ self labelHeight) - ((self labelDisplayBox topLeft extent: (labelText extent x + 70) @ self labelHeight) intersect: self labelDisplayBox))]! Item was changed: ----- Method: StandardSystemView>>displayLabelBoxes (in category 'displaying') ----- displayLabelBoxes "closeBox, growBox." | aRect smallRect backColor | aRect := self closeBoxFrame. backColor := self labelColor. + Display fill: (aRect insetBy: -2 px) fillColor: backColor. - Display fill: (aRect insetBy: -2) fillColor: backColor. Display fillBlack: aRect. + Display fill: (aRect insetBy: 1 px) fillColor: backColor. - Display fill: (aRect insetBy: 1) fillColor: backColor. aRect := self growBoxFrame. + smallRect := aRect origin extent: 7 px @7 px. + Display fill: (aRect insetBy: -2 px) fillColor: backColor. + aRect := aRect insetOriginBy: 2 px @ 2 px cornerBy: 0@0. - smallRect := aRect origin extent: 7@7. - Display fill: (aRect insetBy: -2) fillColor: backColor. - aRect := aRect insetOriginBy: 2@2 cornerBy: 0@0. Display fillBlack: aRect. + Display fill: (aRect insetBy: 1 px) fillColor: backColor. - Display fill: (aRect insetBy: 1) fillColor: backColor. Display fillBlack: smallRect. + Display fill: (smallRect insetBy: 1 px) fillColor: backColor! - Display fill: (smallRect insetBy: 1) fillColor: backColor! Item was changed: ----- Method: StandardSystemView>>displayLabelText (in category 'displaying') ----- displayLabelText "The label goes in the center of the window" | labelRect | labelText foregroundColor: self foregroundColor backgroundColor: self labelColor. labelRect := self labelTextRegion. + Display fill: (labelRect expandBy: 3 px @ 0) fillColor: self labelColor. - Display fill: (labelRect expandBy: 3@0) fillColor: self labelColor. labelText displayOn: Display at: labelRect topLeft clippingBox: labelRect rule: labelText rule fillColor: labelText fillColor. labelText destinationForm: nil! Item was changed: ----- Method: StandardSystemView>>displayRacingStripes (in category 'displaying') ----- displayRacingStripes "Display Racing Stripes in the label" | labelDisplayBox stripes top bottom left box right | labelDisplayBox := self labelDisplayBox. + top := labelDisplayBox top + 3 px. + bottom := labelDisplayBox bottom - 3 px. - top := labelDisplayBox top + 3. - bottom := labelDisplayBox bottom - 3. stripes := Bitmap with: (Display pixelWordFor: self labelColor) with: (Display pixelWordFor: Color black). + top even ifFalse: [stripes swap: 1 px with: 2 px]. - top even ifFalse: [stripes swap: 1 with: 2]. + left := labelDisplayBox left + 3 px. - left := labelDisplayBox left + 3. box := self closeBoxFrame. + right := box left - 2 px. - right := box left - 2. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. + left := box right + 2 px. - left := box right + 2. box := self labelTextRegion. + right := box left - 3 px. - right := box left - 3. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. + left := box right + 2 px. - left := box right + 2. box := self growBoxFrame. + right := box left - 2 px. - right := box left - 2. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. + left := box right + 2 px. - left := box right + 2. + right := labelDisplayBox right - 3 px. - right := labelDisplayBox right - 3. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. ! Item was changed: ----- Method: StandardSystemView>>expand (in category 'framing') ----- expand "If the receiver is collapsed, change its view to be that of all of its subviews, not its label alone." | newFrame | self isCollapsed ifTrue: [newFrame := self chooseFrame expandBy: borderWidth. collapsedViewport := self viewport. subViews := savedSubViews. + labelFrame borderWidthLeft: 2 px right: 2 px top: 2 px bottom: 2 px. - labelFrame borderWidthLeft: 2 right: 2 top: 2 bottom: 2. savedSubViews := nil. self setWindow: nil. self resizeTo: newFrame. self displayDeEmphasized. model modelWakeUpIn: self]! Item was changed: ----- Method: StandardSystemView>>growBoxFrame (in category 'label access') ----- growBoxFrame + ^ Rectangle origin: (self labelDisplayBox rightCenter + (-22 px @ -5 px)) extent: (11 px @ 11 px)! - ^ Rectangle origin: (self labelDisplayBox rightCenter + (-22 @ -5)) extent: (11 @ 11)! Item was changed: ----- Method: StandardSystemView>>initialize (in category 'initialize-release') ----- initialize "Refer to the comment in View|initialize." super initialize. labelFrame := Quadrangle new. + labelFrame region: (Rectangle origin: 0 @ 0 extent: 50 px @ self labelHeight). + labelFrame borderWidthLeft: 2 px right: 2 px top: 2 px bottom: 2 px. - labelFrame region: (Rectangle origin: 0 @ 0 extent: 50 @ self labelHeight). - labelFrame borderWidthLeft: 2 right: 2 top: 2 bottom: 2. self label: nil. isLabelComplemented := false. minimumSize := 50 @ 50. maximumSize := Display extent. collapsedViewport := nil. expandedViewport := nil. bitsValid := false. updatablePanes := #()! Item was changed: ----- Method: StandardSystemView>>labelHeight (in category 'label access') ----- labelHeight + ^ (self class standardLabelStyle fontAt: 1) lineGrid! - ^ ((self class standardLabelStyle fontAt: 1) height + 4) max: 20! Item was changed: ----- Method: StandardSystemView>>labelOffset (in category 'label access') ----- labelOffset + ^ 0 @ (self labelHeight - 2 px)! - ^ 0 @ (self labelHeight-2)! Item was changed: ----- Method: StandardSystemView>>labelTextRegion (in category 'label access') ----- labelTextRegion labelText == nil ifTrue: [^ self labelDisplayBox center extent: 0@0]. ^ (labelText boundingBox align: labelText boundingBox center with: self labelDisplayBox center) + intersect: (self labelDisplayBox insetBy: 35 px @ 0)! - intersect: (self labelDisplayBox insetBy: 35@0)! Item was changed: ----- Method: StandardSystemView>>noLabel (in category 'label access') ----- noLabel "A label of zero height indicates no label" labelFrame height > 0 + ifTrue: [labelFrame region: (labelFrame bottomLeft + (0 @ 1 px) extent: labelFrame width@0). - ifTrue: [labelFrame region: (labelFrame bottomLeft + (0@1) extent: labelFrame width@0). labelFrame borderWidth: 0. self uncacheBits]! Item was changed: ----- Method: StandardSystemView>>relabel: (in category 'label access') ----- relabel: aString "A new string for the label. Window is assumed to be active. Window will redisplay only if label bar has to grow." | oldRegion oldWidth | (model windowReqNewLabel: aString) ifFalse: [^ self]. oldRegion := self labelTextRegion. oldWidth := self insetDisplayBox width. self label: aString. + Display fill: ((oldRegion merge: self labelTextRegion) expandBy: 3 px @ 0) - Display fill: ((oldRegion merge: self labelTextRegion) expandBy: 3@0) fillColor: self labelColor. self insetDisplayBox width = oldWidth ifTrue: [self displayLabelText; emphasizeLabel] ifFalse: [self uncacheBits; displayEmphasized]. ! Item was changed: ----- Method: StandardSystemView>>setLabelRegion (in category 'label access') ----- setLabelRegion "Always follows view width" labelFrame region: (0 @ 0 extent: self displayBox width @ self labelHeight). + labelFrame borderWidth: 2 px! - labelFrame borderWidth: 2! Item was changed: ----- Method: StandardSystemView>>setLabelTo: (in category 'label access') ----- setLabelTo: aString "Force aString to be the new label of the receiver, bypassing any logic about whether it is acceptable and about propagating information about the change." | oldRegion oldWidth | self label: aString. self controller isControlActive ifFalse: [^ self]. oldRegion := self labelTextRegion. oldWidth := self insetDisplayBox width. + Display fill: ((oldRegion merge: self labelTextRegion) expandBy: 3 px @ 0) - Display fill: ((oldRegion merge: self labelTextRegion) expandBy: 3@0) fillColor: self labelColor. self insetDisplayBox width = oldWidth ifTrue: [self displayLabelText; emphasizeLabel] ifFalse: [self uncacheBits; displayEmphasized]! Squeak-dev mailing list -- [email protected] To unsubscribe send an email to [email protected]