Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/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.!
packages@lists.squeakfoundation.org