[Cuis-dev] RFC: UI Scaling Changes

Wed Jul 29 12:31:43 PDT 2020

Hi Juan, hi Everybody,

I had some problems hitting the border of SystemWindows and recognizing 
the HaloMorphs.
To improve the situation I added made some
changes to scale the HaloMorphs and the SystemWindow's border.

I think I still needs some tweaking and optimizations, but some feedback 
would
be appreciated, especially about the preferences
interface.

HTH and Best Regards,

Gerald
-------------- next part --------------
'From Cuis 5.0 [latest update: #4257] on 29 July 2020 at 9:03:17 pm'!

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'KLG 7/29/2020 20:56:57'!
haloHandleScale
	^ self
		preferenceAt: #haloHandleScale
		ifAbsent: [ 1 ].! !

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'KLG 7/29/2020 20:52:47'!
haloHandleScale: aScale
	"Set the scaling factor for the system window border width."

	HaloMorph releaseClassCachedState.
	^ self 
		setPreference: #haloHandleScale
		toValue: aScale asInteger! !

!HaloMorph methodsFor: 'private' stamp: 'KLG 7/29/2020 21:00:35'!
addHandle: handleSpec
	"Add a handle within the halo box as per the haloSpec, and set it up to respond to the given event by sending the given selector to the given recipient.  Return the handle."

	| handle aPoint colorToUse form icon |
	aPoint _ self 
				positionIn: haloBox
				horizontalPlacement: handleSpec horizontalPlacement
				verticalPlacement: handleSpec verticalPlacement.
	colorToUse _ Color colorFrom: handleSpec color.
	handle _ HaloHandleMorph new color: colorToUse.
	self addMorph: handle.
	handle morphBoundsInWorld: (Rectangle center: aPoint extent: self class handleSize asPoint).
	handleSpec iconSymbol ifNotNil: [ :iconName |
			form _ self class icons at: iconName ifAbsent: [self class perform: iconName].
			form ifNotNil: [
				| handleSize |
				handleSize _ self class handleSize.
				icon _ ImageMorph new
					image: ((handleSize = 16) ifFalse: [  ": Non default size, scale that bugger!!"
						form  ": Be as smooth as possible, these images are small."
							magnify: form boundingBox
							to: (handleSize @ handleSize)
							smoothing: 1 ] ifTrue: [ form ]);
					color: colorToUse makeForegroundColor;
					lock.
				handle addMorphFront: icon position: `0 at 0` ]].
	handle mouseUpSelector: #endInteraction.
	handle setBalloonText: handleSpec hoverHelp.
	^ handle! !

!HaloMorph class methodsFor: 'cached state access' stamp: 'KLG 7/29/2020 20:53:19'!
handleSize
	HandleSize ifNil: [
		HandleSize _ 16 * Preferences haloHandleScale ].
	^ HandleSize! !

-------------- next part --------------
'From Cuis 5.0 [latest update: #4257] on 29 July 2020 at 8:18:51 pm'!
!classDefinition: #WindowEdgeAdjustingMorph category: #'Morphic-Layouts'!
LayoutAdjustingMorph subclass: #WindowEdgeAdjustingMorph
	instanceVariableNames: 'selector coordinateGetter cursorKey sensitiveBorder '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Layouts'!

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'KLG 7/29/2020 20:15:22'!
systemWindowBorderWidthScale: aScale
	"Set the scaling factor for the system window border width."

	^ self 
		setPreference: #systemWindowBorderWidthScale 
		toValue: aScale asInteger! !

!Preferences class methodsFor: 'standard queries'!
systemWindowBorderWidthScale
	^ self
		valueOfFlag: #systemWindowBorderWidthScale
		ifAbsent: [ 5 ].! !

!SystemWindow methodsFor: 'initialization' stamp: 'KLG 7/29/2020 17:38:16'!
titleBarButtonsOrigin

	^ self labelHeight + borderWidth - self titleBarButtonsExtent // 2 * (1 at 1)! !

!WindowEdgeAdjustingMorph methodsFor: 'accessing' stamp: 'KLG 7/29/2020 15:27:51'!
sensitiveBorder: anObject
	"Set the value of sensitiveBorder"

	sensitiveBorder _ anObject! !

!SystemWindow methodsFor: 'drawing' stamp: 'jmv 9/5/2019 08:20:12'!
drawLabelOn: aCanvas

	| x0 y0 f w availableW l |
	f _ Preferences windowTitleFont.
	x0 _  f lineSpacing * 4 + 14.
	y0 _ 2+3.
	y0 _ f lineSpacing - f ascent // 2.
	availableW _ extent x - x0.
	l _ labelString.
	w _ f widthOfString: l.
	[ w > availableW ] whileTrue: [
		l _ l squeezedTo: (1.0 * l size * availableW / w) truncated.
		l isEmpty ifTrue: [ ^self ].
		w _ f widthOfString: l ].
	aCanvas
		drawString: l
		at: x0 at y0
		font: f
		color: Theme current windowLabel
		embossed: Theme current embossedTitles! !

!SystemWindow methodsFor: 'initialization' stamp: 'KLG 7/29/2020 20:13:01'!
defaultBorderWidth
	"answer the default border width for the receiver"

	^ (Theme current minimalWindows ifTrue: [ 1 ] ifFalse: [
		Theme current roundWindowCorners
			ifTrue: [ 3 ]
			ifFalse: [ 2 ] ]) * Preferences systemWindowBorderWidthScale! !

!SystemWindow methodsFor: 'initialization' stamp: 'KLG 7/29/2020 15:31:58'!
initialize
	"Initialize a system window. Add label, stripes, etc., if desired"

	super initialize.
	labelString ifNil: [ labelString _ 'Untitled Window'].

	self initializeLabelArea.
	extent _ `300 @ 200`.

	adjusters _ Dictionary new.
	adjusters at: #topAdjuster put: WindowEdgeAdjustingMorph forTop.
	adjusters at: #bottomAdjuster put: WindowEdgeAdjustingMorph forBottom.
	adjusters at: #leftAdjuster put: WindowEdgeAdjustingMorph forLeft.
	adjusters at: #rightAdjuster put: WindowEdgeAdjustingMorph forRight.
	adjusters at: #topLeftAdjuster put: WindowEdgeAdjustingMorph forTopLeft.
	adjusters at: #bottomLeftAdjuster put: WindowEdgeAdjustingMorph forBottomLeft.
	adjusters at: #topRightAdjuster put: WindowEdgeAdjustingMorph forTopRight.
	adjusters at: #bottomRightAdjuster put: WindowEdgeAdjustingMorph forBottomRight.
	adjusters do: [ :m |
		self addMorphFront: m.
		m sensitiveBorder: borderWidth ].

	"by default"
	self beColumn! !

!SystemWindow methodsFor: 'initialization' stamp: 'KLG 7/29/2020 17:38:16'!
initializeLabelArea
	"Initialize the label area (titlebar) for the window."

	| topLeft spacing |
	topLeft _ self titleBarButtonsOrigin.
	spacing _ self titleBarButtonsExtent x *14//10.
	self addMorph: self createCloseButton position: topLeft.
	self addMorph: self createCollapseButton position: spacing at 0 + topLeft.
	self addMorph: self createExpandButton position: spacing*2 at 0 + topLeft.
	self addMorph: self createMenuButton position: spacing*3 at 0 + topLeft! !

!WindowEdgeAdjustingMorph methodsFor: 'geometry testing' stamp: 'KLG 7/29/2020 17:40:24'!
morphContainsPoint: aLocalPoint
	|  sensitiveBounds |
	sensitiveBorder ifNil: [ sensitiveBorder _ 4] ifNotNil: [ sensitiveBorder max: 4 ]..
	sensitiveBounds _ self morphLocalBounds expandBy: sensitiveBorder.
	sensitiveBounds _ selector caseOf: {
		[ #windowTop: ] -> [ 
			sensitiveBounds insetOriginBy: sensitiveBorder @ 0 cornerBy: sensitiveBorder @ 0 ].
		[ #windowBottom: ] -> [ 
			sensitiveBounds insetOriginBy: sensitiveBorder @ 0 cornerBy: sensitiveBorder @ 0 ].
		[ #windowLeft: ] -> [
			| origin |
			origin _ 	(owner respondsTo: #titleBarButtonsOrigin) ifTrue: [
				owner titleBarButtonsOrigin ] ifFalse: [ 0 ].
			sensitiveBounds insetOriginBy: origin cornerBy: 0 @ sensitiveBorder ].
		[ #windowRight: ] -> [ 
			sensitiveBounds insetOriginBy: 0 @ sensitiveBorder cornerBy: 0 @ sensitiveBorder ].
	} 
	otherwise: [ sensitiveBounds ].
	( sensitiveBounds containsPoint: aLocalPoint) ifFalse: [ ^false ].
	selector caseOf: {
		[ #windowTopLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]].
		[ #windowTopRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]].
		[ #windowBottomLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ extent y- aLocalPoint y <= sensitiveBorder ]].
		[ #windowBottomRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ extent y - aLocalPoint y <= sensitiveBorder ]].
	}
	otherwise: [
		"all the morph is sensitive for horizontal and vertical (i.e. non corner) instances."
		^true ]! !

!classDefinition: #WindowEdgeAdjustingMorph category: #'Morphic-Layouts'!
LayoutAdjustingMorph subclass: #WindowEdgeAdjustingMorph
	instanceVariableNames: 'selector coordinateGetter cursorKey sensitiveBorder'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Layouts'!

!WindowEdgeAdjustingMorph reorganize!
('initialization' initializeBottom initializeBottomLeft initializeBottomRight initializeLeft initializeRight initializeTop initializeTopLeft initializeTopRight)
('adjusting' adjustOwnerAt:)
('accessing' cursor sensitiveBorder:)
('drawing' drawOn:)
('testing' isOpaqueMorph isOrthoRectangularMorph)
('geometry testing' morphContainsPoint:)
!