diff --git a/src/Glamour-Morphic-Brick-Tests/GLMBrickTests.class.st b/src/Glamour-Morphic-Brick-Tests/GLMBrickTests.class.st index 0738f53c176..6f093c76054 100644 --- a/src/Glamour-Morphic-Brick-Tests/GLMBrickTests.class.st +++ b/src/Glamour-Morphic-Brick-Tests/GLMBrickTests.class.st @@ -138,7 +138,7 @@ GLMBrickTests >> staticExtent [ { #category : #defaults } GLMBrickTests >> staticHeight [ - ^ 100 + ^ 100 * World displayScaleFactor ] { #category : #defaults } @@ -150,19 +150,19 @@ GLMBrickTests >> staticSmallExtent [ { #category : #defaults } GLMBrickTests >> staticSmallHeight [ - ^ 50 + ^ 50 * World displayScaleFactor ] { #category : #defaults } GLMBrickTests >> staticSmallWidth [ - ^ 50 + ^ 50 * World displayScaleFactor ] { #category : #defaults } GLMBrickTests >> staticWidth [ - ^ 100 + ^ 100 * World displayScaleFactor ] { #category : #'tests-layouter' } diff --git a/src/Glamour-Morphic-Brick/GLMBrickButtonStyle.trait.st b/src/Glamour-Morphic-Brick/GLMBrickButtonStyle.trait.st index 8962697360a..4a9aa51aa43 100644 --- a/src/Glamour-Morphic-Brick/GLMBrickButtonStyle.trait.st +++ b/src/Glamour-Morphic-Brick/GLMBrickButtonStyle.trait.st @@ -27,7 +27,7 @@ GLMBrickButtonStyle >> buttonBorderWidth [ { #category : #'brick-button' } GLMBrickButtonStyle >> buttonMinHeight [ - ^ 26 + ^ 26 * World displayScaleFactor ] { #category : #'brick-button' } diff --git a/src/Glamour-Morphic-Brick/GLMBrickStructureTrait.trait.st b/src/Glamour-Morphic-Brick/GLMBrickStructureTrait.trait.st index 66a0c8ed5d7..53efb4e320b 100644 --- a/src/Glamour-Morphic-Brick/GLMBrickStructureTrait.trait.st +++ b/src/Glamour-Morphic-Brick/GLMBrickStructureTrait.trait.st @@ -225,7 +225,7 @@ GLMBrickStructureTrait >> openInBrickWindowLabeled: aLabel [ hSpaceFill; addBrickBack: self; yourself); - extent: 400@400; + extent: (400@400) * World displayScaleFactor; openCenteredInWorld ] ifAbsent: [ self asMorph openInWindow ] diff --git a/src/Graphics-Display Objects/Form.class.st b/src/Graphics-Display Objects/Form.class.st index 215019d98eb..75dad53a90f 100644 --- a/src/Graphics-Display Objects/Form.class.st +++ b/src/Graphics-Display Objects/Form.class.st @@ -2293,6 +2293,13 @@ f display " ] +{ #category : #'scaling, rotation' } +Form >> scaledByDisplayScaleFactor [ + + ^ self scaledToSize: self extent * World displayScaleFactor. + +] + { #category : #'scaling, rotation' } Form >> scaledToSize: newExtent [ diff --git a/src/Morphic-Base/MenuLineMorph.class.st b/src/Morphic-Base/MenuLineMorph.class.st index 4383ae5aa02..8d1ff8f1c12 100644 --- a/src/Morphic-Base/MenuLineMorph.class.st +++ b/src/Morphic-Base/MenuLineMorph.class.st @@ -67,5 +67,5 @@ MenuLineMorph >> minHeight [ { #category : #layout } MenuLineMorph >> minWidth [ "Answer the receiver's minWidth" - ^ 10 + ^ 10 * self displayScaleFactor ] diff --git a/src/Morphic-Base/MenuTitleMorph.class.st b/src/Morphic-Base/MenuTitleMorph.class.st index b95342f6dc4..d12dae5a052 100644 --- a/src/Morphic-Base/MenuTitleMorph.class.st +++ b/src/Morphic-Base/MenuTitleMorph.class.st @@ -46,7 +46,7 @@ MenuTitleMorph >> bigTitle: aTitle [ { #category : #'private-creation' } MenuTitleMorph >> boxExtent [ - ^18 @ 18 + ^ (18 @ 18) * self displayScaleFactor ] { #category : #'event handling' } @@ -207,7 +207,7 @@ MenuTitleMorph >> withPinBox [ pinBox := self iconButtonCalling: #pinBoxClicked - withForm: self pinForm + withForm: self pinForm scaledByDisplayScaleFactor helpText: 'Keep this menu up'. self addMorph: pinBox asElementNumber: 4 diff --git a/src/Morphic-Base/ToggleMenuItemMorph.class.st b/src/Morphic-Base/ToggleMenuItemMorph.class.st index b93a613ea1a..c4dbe0efa63 100644 --- a/src/Morphic-Base/ToggleMenuItemMorph.class.st +++ b/src/Morphic-Base/ToggleMenuItemMorph.class.st @@ -54,9 +54,9 @@ ToggleMenuItemMorph >> basicDrawOn: aCanvas [ self hasIcon ifTrue: [ |iconForm| iconForm := self icon. self drawIcon: iconForm on: aCanvas in: stringBounds. - stringBounds := stringBounds left: stringBounds left + iconForm width + 2]. + stringBounds := stringBounds left: stringBounds left + (iconForm width) + (2*self displayScaleFactor)]. self hasMarker ifTrue: [ - stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8]. + stringBounds := stringBounds left: stringBounds left + self submorphBounds width + (8 * self displayScaleFactor)]. stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. stringBounds := stringBounds bottom: stringBounds top + self fontToUse height. self drawText: contents on: aCanvas in: stringBounds. @@ -71,7 +71,7 @@ ToggleMenuItemMorph >> drawIcon: aForm on: aCanvas in: aRectangle [ |iconForm| self isEnabled - ifTrue: [iconForm := aForm] + ifTrue: [iconForm := aForm.] ifFalse: [iconForm := Form extent: aForm extent depth: 32. iconForm fillColor: (Color white alpha: 0.003922). (iconForm getCanvas asAlphaBlendingCanvas: 0.5) @@ -105,8 +105,8 @@ ToggleMenuItemMorph >> drawSubMenuMarker: aForm on: aCanvas in: aRectangle [ "Draw the submenu marker on the canvas within the given bounds." |markerRect| - markerRect := aRectangle topRight + (aForm width negated @ (aRectangle height - aForm height // 2)) extent: aForm extent. - self drawIcon: aForm on: aCanvas in: markerRect + markerRect := aRectangle topRight + ((aForm width * self displayScaleFactor) negated @ (aRectangle height - (aForm height * self displayScaleFactor) // 2)) extent: aForm extent * self displayScaleFactor. + self drawIcon: aForm scaledByDisplayScaleFactor on: aCanvas in: markerRect ] { #category : #'drawing-private' } diff --git a/src/Morphic-Core/Morph.class.st b/src/Morphic-Core/Morph.class.st index 5a6e42cd4c1..609ace06bad 100644 --- a/src/Morphic-Core/Morph.class.st +++ b/src/Morphic-Core/Morph.class.st @@ -2178,6 +2178,12 @@ Morph >> displayExtentChanged [ " ] +{ #category : #settings } +Morph >> displayScaleFactor [ + + ^ World displayScaleFactor +] + { #category : #announcements } Morph >> doAnnounce: anAnnouncement [ "Take care of not creating the announcer when announcing. If the announcer doesn't exist then this means nobody has expressed an interest in the message." diff --git a/src/Morphic-Core/Point.extension.st b/src/Morphic-Core/Point.extension.st new file mode 100644 index 00000000000..7c614b5eaa8 --- /dev/null +++ b/src/Morphic-Core/Point.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #Point } + +{ #category : #'*Morphic-Core' } +Point >> scaledByDisplayScaleFactor [ + + ^ self * World displayScaleFactor. +] diff --git a/src/Morphic-Core/WorldMorph.class.st b/src/Morphic-Core/WorldMorph.class.st index cb51251f78a..22932d64d22 100644 --- a/src/Morphic-Core/WorldMorph.class.st +++ b/src/Morphic-Core/WorldMorph.class.st @@ -242,6 +242,12 @@ WorldMorph >> discoveredWorldMenu [ ^ worldState discoveredWorldMenu ] +{ #category : #geometry } +WorldMorph >> displayScaleFactor [ + + ^ 1 +] + { #category : #'world state' } WorldMorph >> displayWorld [ worldState displayWorld: self submorphs: submorphs diff --git a/src/Morphic-Widgets-Taskbar/TaskListMorph.class.st b/src/Morphic-Widgets-Taskbar/TaskListMorph.class.st index bfe5733e572..583023df78a 100644 --- a/src/Morphic-Widgets-Taskbar/TaskListMorph.class.st +++ b/src/Morphic-Widgets-Taskbar/TaskListMorph.class.st @@ -83,7 +83,7 @@ TaskListMorph >> addMorphs [ TaskListMorph >> defaultPreviewExtent [ "Answer the default extent of the preview holder." - ^320@320 + ^(320@320)scaledByDisplayScaleFactor ] { #category : #running } diff --git a/src/Morphic-Widgets-Windows/SystemWindow.class.st b/src/Morphic-Widgets-Windows/SystemWindow.class.st index 73bd8b9595c..a3787569767 100644 --- a/src/Morphic-Widgets-Windows/SystemWindow.class.st +++ b/src/Morphic-Widgets-Windows/SystemWindow.class.st @@ -459,8 +459,8 @@ SystemWindow >> boxExtent [ "answer the extent to use in all the buttons. The label height is used to be proportional to the standard window label font" - label ifNil: [^14 @ 14]. - ^ (14 @ 14) max: label height @ label height + label ifNil: [^(14 @ 14) * self displayScaleFactor]. + ^ (((14 @ 14) * self displayScaleFactor) max: label height @ label height) ] { #category : #testing } @@ -882,7 +882,7 @@ SystemWindow >> initialize [ self cellPositioning: #topLeft. "make the offsets easy to calculate!" self addGripsIfWanted. - self extent: 300 @ 200. + self extent: (300 @ 200) scaledByDisplayScaleFactor. mustNotClose := false. updatablePanes := Array new ] diff --git a/src/NautilusCommon/NautilusWindow.class.st b/src/NautilusCommon/NautilusWindow.class.st index d3f715062b0..cf630084734 100644 --- a/src/NautilusCommon/NautilusWindow.class.st +++ b/src/NautilusCommon/NautilusWindow.class.st @@ -53,5 +53,5 @@ NautilusWindow >> hasFocus [ { #category : #'open/close' } NautilusWindow >> initialExtent [ - ^ 850@620 + ^ (850@620) * self displayScaleFactor ] diff --git a/src/Pharo-Help/PharoWelcomePage.class.st b/src/Pharo-Help/PharoWelcomePage.class.st index c5d25b6475b..3ba9a4bc677 100644 --- a/src/Pharo-Help/PharoWelcomePage.class.st +++ b/src/Pharo-Help/PharoWelcomePage.class.st @@ -100,7 +100,7 @@ PharoWelcomePage class >> openForRelease [ detect: [ :each | (each isKindOf: SystemWindow) and: [ each label = self title ] ] ifFound: [ :oldWindow | oldWindow delete ]. window := self open. - window extent: 750@400. + window extent: (750@400) scaledByDisplayScaleFactor. window center: Display extent / 2 ] diff --git a/src/Polymorph-Widgets/PharoDarkTheme.class.st b/src/Polymorph-Widgets/PharoDarkTheme.class.st index df4ce1b1d9c..38e3d2f6c51 100644 --- a/src/Polymorph-Widgets/PharoDarkTheme.class.st +++ b/src/Polymorph-Widgets/PharoDarkTheme.class.st @@ -377,7 +377,7 @@ PharoDarkTheme >> menuBorderColor [ { #category : #'accessing colors' } PharoDarkTheme >> menuBorderWidth [ - ^ self borderWidth + ^ self borderWidth * World displayScaleFactor ] { #category : #defaults } diff --git a/src/Polymorph-Widgets/ThemeIcons.class.st b/src/Polymorph-Widgets/ThemeIcons.class.st index e2306df4f64..72c844c8987 100644 --- a/src/Polymorph-Widgets/ThemeIcons.class.st +++ b/src/Polymorph-Widgets/ThemeIcons.class.st @@ -265,14 +265,14 @@ ThemeIcons >> hasIcons [ { #category : #accessing } ThemeIcons >> iconNamed: aSymbol [ - ^ self + ^ (self iconNamed: aSymbol ifNone: [ self isReportingNotFound ifTrue: [ self crLog: (aSymbol, ' icon not found!'). self notFoundIcon ] - ifFalse: [ self blankIcon ]] + ifFalse: [ self blankIcon ]]) scaledByDisplayScaleFactor ] { #category : #accessing } diff --git a/src/Polymorph-Widgets/ThemeSettings.class.st b/src/Polymorph-Widgets/ThemeSettings.class.st index 6f3540f1db1..6cadc8dee2d 100644 --- a/src/Polymorph-Widgets/ThemeSettings.class.st +++ b/src/Polymorph-Widgets/ThemeSettings.class.st @@ -333,7 +333,7 @@ ThemeSettings >> menuBorderColor [ ThemeSettings >> menuBorderWidth [ "Answer the value of menuColor" - ^ 2 + ^ 2 * World displayScaleFactor ] { #category : #menu } diff --git a/src/Polymorph-Widgets/UITheme.class.st b/src/Polymorph-Widgets/UITheme.class.st index 4e42ef8fc23..c4c03ed8690 100644 --- a/src/Polymorph-Widgets/UITheme.class.st +++ b/src/Polymorph-Widgets/UITheme.class.st @@ -327,7 +327,7 @@ UITheme >> borderColor [ { #category : #accessing } UITheme >> borderWidth [ - ^ 1 + ^ 1 * World displayScaleFactor ] { #category : #accessing } @@ -502,7 +502,7 @@ UITheme >> buttonMiddleRightForm [ UITheme >> buttonMinHeight [ "Answer the minumum height of a button for this theme." - ^24 + ^24 * World displayScaleFactor ] { #category : #defaults } @@ -4793,7 +4793,7 @@ UITheme >> radioButtonForm [ UITheme >> radioButtonMarkerForm [ "Answer the form to use for a radio button marker." - ^self forms at: #radioButtonMarker ifAbsent: [Form extent: 12@12 depth: Display depth] + ^(self forms at: #radioButtonMarker ifAbsent: [Form extent: 12@12 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'border-styles-buttons' } @@ -5673,7 +5673,7 @@ UITheme >> textFont [ UITheme >> treeExpandedForm [ "Answer the form to use for an expanded tree item." - ^self forms at: #treeExpanded ifAbsent: [Form extent: 10@9 depth: Display depth] + ^(self forms at: #treeExpanded ifAbsent: [Form extent: 10@9 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'basic-colors' } @@ -5702,7 +5702,7 @@ UITheme >> treeLineWidth [ UITheme >> treeUnexpandedForm [ "Answer the form to use for an unexpanded tree item." - ^self forms at: #treeUnexpanded ifAbsent: [Form extent: 10@9 depth: Display depth] + ^(self forms at: #treeUnexpanded ifAbsent: [Form extent: 10@9 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'accessing colors' } @@ -5806,28 +5806,28 @@ UITheme >> watcherWindowInactiveFillStyleFor: aWindow [ UITheme >> whiteTreeExpandedForm [ "Answer the form to use for an expanded tree item when a contrasting one is needed." - ^self forms + ^(self forms at: #whiteTreeExpanded ifAbsent: [ | f | f := self treeExpandedForm deepCopy. f replaceColor: Color white withColor: Color transparent. (f colorsUsed reject: [:c | c isTransparent]) do: [:c | f replaceColor: c withColor: c whiter whiter whiter whiter whiter whiter]. self forms at: #whiteTreeExpanded put: f. - self whiteTreeExpandedForm] + self whiteTreeExpandedForm]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } UITheme >> whiteTreeUnexpandedForm [ "Answer the form to use for an unexpanded tree item when a contrasting one is needed." - ^self forms + ^(self forms at: #whiteTreeUnexpanded ifAbsent: [ | f | f := self treeUnexpandedForm deepCopy. f replaceColor: Color white withColor: Color transparent. (f colorsUsed reject: [:c | c isTransparent]) do: [:c | f replaceColor: c withColor: c whiter whiter whiter whiter whiter whiter]. self forms at: #whiteTreeUnexpanded put: f. - self whiteTreeUnexpandedForm] + self whiteTreeUnexpandedForm]) scaledByDisplayScaleFactor ] { #category : #'border-styles' } @@ -5875,7 +5875,7 @@ UITheme >> windowActiveTitleFillStyleFor: aWindow [ { #category : #defaults } UITheme >> windowBorderWidthFor: aWindow [ - ^ 4 + ^ 4 * World displayScaleFactor ] { #category : #defaults } @@ -5888,14 +5888,14 @@ UITheme >> windowBottomOffset [ UITheme >> windowCloseForm [ "Answer the form to use for the close button of a window." - ^self forms at: #windowClose ifAbsent: [Form extent: 10@10 depth: Display depth] + ^(self forms at: #windowClose ifAbsent: [Form extent: 10@10 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } UITheme >> windowCloseOverForm [ "Answer the form to use for mouse over window close buttons" - ^self forms at: #windowCloseOver ifAbsent: [Form extent: 16@16 depth: Display depth] + ^(self forms at: #windowCloseOver ifAbsent: [Form extent: 16@16 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } @@ -6018,14 +6018,14 @@ UITheme >> windowLeftOffset [ UITheme >> windowMaximizeForm [ "Answer the form to use for the maximize button of a window." - ^self forms at: #windowMaximize ifAbsent: [Form extent: 10@10 depth: Display depth] + ^(self forms at: #windowMaximize ifAbsent: [Form extent: 10@10 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } UITheme >> windowMaximizeOverForm [ "Answer the form to use for mouse over window maximize buttons" - ^self forms at: #windowMaximizeOver ifAbsent: [Form extent: 16@16 depth: Display depth] + ^(self forms at: #windowMaximizeOver ifAbsent: [Form extent: 16@16 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } @@ -6046,7 +6046,7 @@ UITheme >> windowMaximizeSound [ UITheme >> windowMenuForm [ "Answer the form to use for the menu button of a window." - ^self forms at: #windowMenu ifAbsent: [Form extent: 10@10 depth: Display depth] + ^(self forms at: #windowMenu ifAbsent: [Form extent: 10@10 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } @@ -6060,7 +6060,7 @@ UITheme >> windowMenuIconFor: aWindow [ UITheme >> windowMenuOverForm [ "Answer the form to use for mouse over window menu buttons" - ^self forms at: #windowMenuOver ifAbsent: [Form extent: 16@16 depth: Display depth] + ^(self forms at: #windowMenuOver ifAbsent: [Form extent: 16@16 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } @@ -6074,14 +6074,14 @@ UITheme >> windowMenuPassiveForm [ UITheme >> windowMinimizeForm [ "Answer the form to use for the minimize button of a window." - ^self forms at: #windowMinimize ifAbsent: [Form extent: 10@10 depth: Display depth] + ^(self forms at: #windowMinimize ifAbsent: [Form extent: 10@10 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' } UITheme >> windowMinimizeOverForm [ "Answer the form to use for mouse over window minimize buttons" - ^self forms at: #windowMinimizeOver ifAbsent: [Form extent: 16@16 depth: Display depth] + ^(self forms at: #windowMinimizeOver ifAbsent: [Form extent: 16@16 depth: Display depth]) scaledByDisplayScaleFactor ] { #category : #'label-styles' }