Am 19.11.2022 20:36:17 schrieb commits@source.squeak.org <commits@source.squeak.org>:

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