Christoph Thiede uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-ct.2051.mcz

==================== Summary ====================

Name: Morphic-ct.2051
Author: ct
Time: 19 November 2022, 8:35:59.299387 pm
UUID: 6d037f4d-9ad4-8f48-8a0b-b40df261c00c
Ancestors: Morphic-mt.2049

Makes keyboard exerciser scale-factor-aware. Fixes layout of instruction text, which was previously not wrapped within the morph, overlapped the check buttons, and caused invalidations when moving or closing the exerciser. For this, uses a classical row-based tabel layout.

=============== Diff against Morphic-mt.2049 ===============

Item was changed:
  Morph subclass: #KeyboardExerciser
+ 	instanceVariableNames: 'checkButtons eventPane'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Morphic-Demo'!

Item was added:
+ ----- Method: KeyboardExerciser>>addCheckButtons (in category 'initialization') -----
+ addCheckButtons
+ 
+ 	| buttonPane |
+ 	buttonPane := Morph new
+ 		beTransparent;
+ 		changeTableLayout;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		listDirection: #leftToRight;
+ 		wrapDirection: #topToBottom;
+ 		cellGap: 10 px;
+ 		yourself.
+ 	
+ 	checkButtons := OrderedCollection new.
+ 	#(processKeyStroke 'Test key stroke'
+ 	processKeyDown 'Test key down'
+ 	processKeyUp 'Test key up')
+ 		groupsDo: [:selector :label |
+ 			| button |
+ 			button := ThreePhaseButtonMorph checkBox
+ 				target: self;
+ 				actionSelector: selector;
+ 				label: label;
+ 				yourself.
+ 			checkButtons addLast: button.
+ 			buttonPane addMorphBack: button].
+ 	
+ 	self addMorphBack: buttonPane.
+ 	^ buttonPane!

Item was added:
+ ----- Method: KeyboardExerciser>>addEventPane (in category 'initialization') -----
+ addEventPane
+ 
+ 	eventPane := Morph new
+ 		beTransparent;
+ 		changeTableLayout;
+ 		listDirection: #leftToRight;
+ 		wrapDirection: #topToBottom;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		cellGap: 10 px;
+ 		height: 0;
+ 		yourself.
+ 	
+ 	self addMorphBack: eventPane.
+ 	^ eventPane!

Item was added:
+ ----- Method: KeyboardExerciser>>addTitle (in category 'initialization') -----
+ addTitle
+ 
+ 	| title |
+ 	title := TextMorph new
+ 		contents: 'Move your mouse cursor to here and start typing. Try modifiers, too.' translated;
+ 		font: Preferences standardButtonFont;
+ 		color: Color gray;
+ 		hResizing: #spaceFill;
+ 		lock;
+ 		yourself.
+ 	
+ 	self addMorphBack: title.
+ 	^ title!

Item was changed:
  ----- Method: KeyboardExerciser>>checkButton: (in category 'initialization') -----
  checkButton: checkIndex
  
+ 	self checkButtons do: [:button |
+ 		button state: #off].
- 	1 to: 3 do: [:index |
- 		(self submorphs at: index)
- 			state: #off].
  	
+ 	(self checkButtons at: checkIndex) state: #on.!
- 	(self submorphs at: checkIndex) state: #on.!

Item was added:
+ ----- Method: KeyboardExerciser>>checkButtons (in category 'accessing') -----
+ checkButtons
+ 
+ 	^ checkButtons!

Item was changed:
  ----- Method: KeyboardExerciser>>clear (in category 'initialization') -----
  clear
  
+ 	eventPane removeAllMorphs.
+ 	eventPane height: 0.!
- 	(self submorphs allButFirst: 3) do: [:m | m delete].!

Item was removed:
- ----- Method: KeyboardExerciser>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- 
- 	super drawOn: aCanvas.
- 	
- 	aCanvas
- 		drawString: 'Move your mouse cursor to here and start typing. Try modifiers, too.' translated
- 		at: self topLeft
- 		font: Preferences standardButtonFont
- 		color: Color gray.!

Item was added:
+ ----- Method: KeyboardExerciser>>eventMorphs (in category 'accessing') -----
+ eventMorphs
+ 
+ 	^ eventPane submorphs!

Item was changed:
  ----- Method: KeyboardExerciser>>handleEvent:inspect: (in category 'actions') -----
  handleEvent: mouseEvent inspect: morph
  
+ 	mouseEvent shiftPressed
- 	mouseEvent	 shiftPressed
  		ifTrue: [(morph valueOfProperty: #event) explore]
  		ifFalse: [(morph valueOfProperty: #event) inspect].!

Item was changed:
  ----- Method: KeyboardExerciser>>initialize (in category 'initialization') -----
  initialize
  
  	super initialize.
  	
  	self
+ 		color: ((self userInterfaceTheme get: #color for: #ScrollPane) ifNil: [Color white]);
+ 		borderStyle: ((self userInterfaceTheme get: #borderStyle for: #ScrollPane) ifNil: [BorderStyle simple]) copy;
+ 		borderColor: ((self userInterfaceTheme get: #borderColor for: #ScrollPane) ifNil: [Color gray: 0.6]);
+ 		borderWidth: (((self userInterfaceTheme get: #borderWidth for: #ScrollPane) ifNil: [1]) * RealEstateAgent scaleFactor) truncated;
+ 		extent: 300 px @ 50 px;
- 		color: (self userInterfaceTheme get: #color for: #ScrollPane);
- 		extent: 300 at 50;
  		layoutPolicy: TableLayout new;
+ 		listDirection: #topToBottom;
- 		listDirection: #leftToRight;
- 		wrapDirection: #topToBottom;
  		hResizing: #rigid;
  		vResizing: #shrinkWrap;
+ 		cellGap: 10 px;
+ 		layoutInset: 20 px;
- 		cellGap: 10;
- 		layoutInset: 20;
  		yourself.
  	
+ 	self addTitle.
+ 	self addCheckButtons.
+ 	self addEventPane.
- 	#(processKeyStroke 'Test key stroke'
- 	processKeyDown 'Test key down'
- 	processKeyUp 'Test key up')
- 		groupsDo: [:selector :label |
- 			self addMorphBack: (ThreePhaseButtonMorph checkBox
- 				target: self;
- 				actionSelector: selector;
- 				label: label;
- 				yourself)].
  	
  	self processKeyStroke.!

Item was added:
+ ----- Method: KeyboardExerciser>>instructionMorph (in category 'accessing') -----
+ instructionMorph
+ 
+ 	^ self hasSubmorphs ifTrue: [self firstSubmorph]!

Item was changed:
  ----- Method: KeyboardExerciser>>lastEvent (in category 'accessing') -----
  lastEvent
  
  	| view event |
+ 	view := (self eventMorphs ifEmpty: [^ nil]) last.
- 	view := self submorphs last.
  	(view hasProperty: #event) ifFalse: [^ nil].	
  	event := view valueOfProperty: #event.
  	event isCollection ifTrue: [event := event last].
  	^ event!

Item was changed:
  ----- Method: KeyboardExerciser>>logEvent: (in category 'event handling') -----
  logEvent: evt
  
  	| eventMorph |
  	evt = self lastEvent
  		ifTrue: [^ self logEventRepetition: evt].
  
  	eventMorph := evt asMorph.
  	eventMorph
  		setProperty: #event toValue: evt copy;
  		balloonText: ('Click to inspect. Shift+click to explore.\\Virtual key: {8}\Virtual modifiers: {5}\\Physical key: {9}\Physical modifiers: {6}\\Key value: 0x{1} ({2}) \Key character: {3}\Key string: {4}\\{7}' translated withCRs format: {
  			evt keyValue printPaddedWith: $0 to: 2 base: 16.
  			evt keyValue.
  			evt isKeystroke ifTrue: [evt keyCharacter printString] ifFalse: ['-'].
  			evt isKeystroke ifTrue: [evt keyString printString] ifFalse: ['-'].
  			(evt virtualModifiers joinSeparatedBy: ' ') asUppercase.
  			(evt physicalModifiers joinSeparatedBy: ' ') asUppercase.
  			evt printString.
  			evt virtualKey printString.
  			evt physicalKey asString printString}).
  			
  	eventMorph
  		on: #mouseEnter send: #handleEvent:emphasize: to: self;
  		on: #mouseLeave send: #handleEvent:deemphasize: to: self;
  		on: #mouseDown send: #handleEvent:inspect: to: self.
  
+ 	eventPane addMorphBack: eventMorph.!
- 	self addMorphBack: eventMorph.!

Item was changed:
  ----- Method: KeyboardExerciser>>logEventRepetition: (in category 'event handling') -----
  logEventRepetition: evt
  
  	| label lastEvents box |
+ 	(self eventMorphs last hasProperty: #repetition)
+ 		ifTrue: [box := self eventMorphs last. label := box submorphs first]
- 	(self submorphs last hasProperty: #repetition)
- 		ifTrue: [box := self submorphs last. label := box submorphs first]
  		ifFalse: [
  			box := Morph new
  				setProperty: #repetition toValue: true;
  				color: Color transparent;
  				layoutPolicy: TableLayout new;
  				hResizing: #shrinkWrap;
  				vResizing:#shrinkWrap;
  				yourself.
  			label := '' asText asMorph lock.
  			box addMorph: label.
  			box setProperty: #event toValue: (OrderedCollection with: self lastEvent).
+ 			eventPane addMorphBack: box].
- 			self addMorphBack: box].
  
  	lastEvents := box valueOfProperty: #event.
  	lastEvents add: evt copy.
  	box setProperty: #event toValue: lastEvents.
  
  	label newContents: (('x ', (lastEvents size)) asText
  		addAttribute: (TextFontReference toFont: Preferences standardButtonFont);
  		yourself).
  	box balloonText: ('{1}{2}'  format: {
  		lastEvents size > 10 ifTrue: ['... {1} older events and:\' translated withCRs format: {lastEvents size - 10}] ifFalse: [''].
  		(lastEvents last: (10 min: lastEvents size)) joinSeparatedBy: String cr.
  		}).
  			
  	box
  		on: #mouseEnter send: #handleEvent:emphasize: to: self;
  		on: #mouseLeave send: #handleEvent:deemphasize: to: self;
  		on: #mouseDown send: #handleEvent:inspect: to: self.!