[squeak-dev] The Trunk: Morphic-mt.1774.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jun 18 06:42:50 UTC 2021


Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1774.mcz

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

Name: Morphic-mt.1774
Author: mt
Time: 18 June 2021, 8:42:44.573904 am
UUID: 1e89964d-814b-4345-b3e6-fef6a4f54cc0
Ancestors: Morphic-mt.1773

Complements Kernel-mt.1403.

Adds #key to all keyboard events to be used as a cross-platform identifier (or object) for virtual keys. Works the same for keyUp, keyDown, and keystroke events.

Adds #keyCode, which is the low-level version of #key. For example, #keyCode would answer 29 while #key would answer "Character arrowRight" - an actual object that identifies the physically pressed key.

Use #key when implementing keyboard shortcuts. Feel free to check for modifiers or keyUp/Down/Stroke depending on your use case.

Note that this change relies on the fact that #keyDown will ALWAYS come before a #keystroke. Always. And that #keyDown events will carry the virtual key-code (or scan code), not a higher-level (Unicode) character for text input.

For more background information see http://forum.world.st/Please-try-out-Cross-platform-mapping-for-virtual-key-codes-tp5129188.html

=============== Diff against Morphic-mt.1773 ===============

Item was changed:
  Morph subclass: #HandMorph
+ 	instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset lastMouseEvent lastKeyDownEvent damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter externalDropMorph'
- 	instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset lastMouseEvent damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter externalDropMorph'
  	classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
  	poolDictionaries: 'EventSensorConstants'
  	category: 'Morphic-Kernel'!
  
  !HandMorph commentStamp: '<historical>' prior: 0!
  The cursor may be thought of as the HandMorph.  The hand's submorphs hold anything being carried by dragging.  
  
  There is some minimal support for multiple hands in the same world.!

Item was changed:
  ----- Method: HandMorph>>generateKeyboardEvent: (in category 'private events') -----
  generateKeyboardEvent: evtBuf
  	"Generate the appropriate mouse event for the given raw event buffer"
  
+ 	| buttons modifiers type pressType stamp keyValue keyCode |
- 	| buttons modifiers type pressType stamp keyValue |
  	stamp := evtBuf second.
  	stamp = 0 ifTrue: [stamp := Sensor eventTimeNow].
  	pressType := evtBuf fourth.
  	pressType = EventKeyDown ifTrue: [type := #keyDown].
  	pressType = EventKeyUp ifTrue: [type := #keyUp].
  	pressType = EventKeyChar ifTrue: [type := #keystroke].
  	modifiers := evtBuf fifth.
  	buttons := (modifiers bitShift: MouseEvent numButtons) bitOr: (lastMouseEvent buttons bitAnd: MouseEvent anyButton).
  	type = #keystroke
+ 		ifTrue: [
+ 			keyValue := (self keyboardInterpreter nextCharFrom: EventSensor default firstEvt: evtBuf) asInteger.
+ 			keyCode := lastKeyDownEvent keyValue]
+ 		ifFalse: [keyValue := keyCode := evtBuf third].
- 		ifTrue: [keyValue := (self keyboardInterpreter nextCharFrom: Sensor firstEvt: evtBuf) asInteger]
- 		ifFalse: [keyValue := evtBuf third].
  	^ KeyboardEvent new
  		setType: type
  		buttons: buttons
  		position: self position
  		keyValue: keyValue
+ 		keyCode: keyCode
  		hand: self
  		stamp: stamp.
  !

Item was changed:
  ----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
  handleEvent: unfilteredEvent
  
  	| filteredEvent |
  	owner ifNil: [^ unfilteredEvent  "not necessary but good style -- see Morph >> #handleEvent:"].
  	
  	self logEvent: unfilteredEvent.
  
  	"Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
  	unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].
  
  	self showEvent: unfilteredEvent.
  	self sendListenEvents: unfilteredEvent.
  	
  	filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
  	"filteredEvent := unfilteredEvent" " <-- use this to disable global capture filters"
  	
  	filteredEvent wasIgnored ifTrue: [
  		self mouseOverHandler processMouseOver: lastMouseEvent.
  		^ filteredEvent].
  	
  	filteredEvent isWindowEvent ifTrue: [
  		self sendEvent: filteredEvent focus: nil.
  		self mouseOverHandler processMouseOver: lastMouseEvent.
  		^ filteredEvent].
  
+ 	filteredEvent isKeyboard ifTrue: [
+ 		filteredEvent isKeyDown ifTrue: [lastKeyDownEvent := filteredEvent].
- 	filteredEvent isKeyboard ifTrue:[
  		self sendKeyboardEvent: filteredEvent.
  		self mouseOverHandler processMouseOver: lastMouseEvent.
  		^ filteredEvent].
  			
  	filteredEvent isDropEvent ifTrue:[
  		self sendEvent: filteredEvent focus: nil.
  		self mouseOverHandler processMouseOver: lastMouseEvent.
  		^ filteredEvent].
  
  	filteredEvent isMouse ifFalse: [
  		self mouseOverHandler processMouseOver: lastMouseEvent.
  		^ filteredEvent].
  
  	" ********** MOUSE EVENT *********** "
  
  	lastMouseEvent := filteredEvent.
  
  	"Check for pending drag or double click operations."
  	mouseClickState ifNotNil:[
  		(mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
  			"Possibly dispatched #click: or something and will not re-establish otherwise"
  			self mouseOverHandler processMouseOver: lastMouseEvent.
  			^ filteredEvent]].
  
  	filteredEvent isMouseWheel ifTrue: [
  		self class sendMouseWheelToKeyboardFocus
  			ifFalse: [self sendMouseEvent: filteredEvent]
  			ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
  		self mouseOverHandler processMouseOver: lastMouseEvent.
  		^ filteredEvent].
  
  	filteredEvent isMove ifTrue:[
  		self position: filteredEvent position.
  		self sendMouseEvent: filteredEvent.
  		self mouseOverHandler processMouseOver: lastMouseEvent.
  		^ filteredEvent].
  
  	"Issue a synthetic move event if we're not at the position of the event"
  	self flag: #bug. "mt: Incompatible with how #mouseMove: is handled when #wantsEveryMouseMove: answers false. Handler might think that #mouseDown: was already received. For example, TextEditor and HaloMorph will issue drags in their #mouseMove: based on old data. That is, the first #mouseMove: appears to come before #mouseDown: while actually sent due to #moveToEvent:."
  	filteredEvent position = self position
  		ifFalse: [self moveToEvent: filteredEvent].
  	
  	"Drop submorphs on button events"
  	self hasSubmorphs
  		ifTrue:[self dropMorphs: filteredEvent]
  		ifFalse:[self sendMouseEvent: filteredEvent].
  
  	self mouseOverHandler processMouseOver: lastMouseEvent.
  	^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:"	!

Item was changed:
  ----- Method: HandMorph>>initForEvents (in category 'initialization') -----
  initForEvents
  	mouseOverHandler := nil.
  	lastMouseEvent := MouseEvent new setType: #mouseMove position: 0 at 0 buttons: 0 hand: self.
+ 	lastKeyDownEvent := KeyboardEvent new setType: #keyDown buttons: 0 position: 0 at 0 keyValue: 0 hand: self stamp: 0.
  	lastEventBuffer := {1. 0. 0. 0. 0. 0. nil. nil}.
  	self resetClickState.
  	self addKeyboardCaptureFilter: self. "to convert unusual VM events"!

Item was changed:
  ----- Method: HandMorph>>logEvent: (in category 'events-debugging') -----
  logEvent: anEvent
  	"Update statistics for processed events."
  	
  	EventStats ifNil: [EventStats := IdentityDictionary new].
  	EventStats at: #count put: (EventStats at: #count ifAbsent: [0]) + 1.
  	EventStats at: anEvent type put: (EventStats at: anEvent type ifAbsent: [0]) + 1.!

Item was changed:
  UserInputEvent subclass: #KeyboardEvent
+ 	instanceVariableNames: 'keyValue keyCode'
- 	instanceVariableNames: 'keyValue'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Morphic-Events'!

Item was changed:
+ ----- Method: KeyboardEvent>>asMorph (in category 'morphic/tools - converting') -----
- ----- Method: KeyboardEvent>>asMorph (in category 'converting') -----
  asMorph
  	"Answers a graphical reprsentation for this keyboard event. Does not work for keyUp and keyDown because we do not have platform-specific mapping tables for the key codes."
  
+ 	| box color arrow |
- 	| box color |
  	box := Morph new
  		color: Color transparent;
  		layoutPolicy: TableLayout new;
  		listDirection: #leftToRight;
  		hResizing: #shrinkWrap;
  		vResizing: #shrinkWrap;
  		cellGap: 2;
  		yourself.
  	color := self userInterfaceTheme get: #textColor for: #PluggableButtonMorph.
  		
+ 	self physicalModifiers
- 	self labelsForPhysicalModifiers
  		do: [:modifier |
+ 			box addMorphBack: (ToolIcons keyboardButtonLabeled: modifier capitalized dyed: color) asMorph.
- 			box addMorphBack: (ToolIcons keyboardButtonLabeled: modifier dyed: color) asMorph.
  			box addMorphBack: (('+' asText addAttribute: (TextColor color: color); asMorph) lock)].
  					
+ 	"Visualize arrow keys."
+ 	arrow := self key.
+ 	(arrow isCharacter and: [arrow asciiValue between: 28 and: 31]) ifTrue: [			
+ 		box addMorphBack: (ToolIcons keyboardButtonLabeled: (
+ 			ScrollBar
+ 				arrowOfDirection: (#(left right top bottom) at: arrow asciiValue - 27)
+ 				size: Preferences standardButtonFont height
+ 				color: Color black) dyed: color) asMorph.
+ 		^ box].
- 	(self keyValue between: 28 and: 31)
- 		ifTrue: [ "arrow keys"			
- 			box addMorphBack: (ToolIcons keyboardButtonLabeled: (
- 				ScrollBar
- 					arrowOfDirection: (#(left right top bottom) at: self keyValue - 27)
- 					size: Preferences standardButtonFont height
- 					color: Color black) dyed: color) asMorph.
- 			^ box].
  	
  	box addMorphBack: (ToolIcons
+ 		keyboardButtonLabeled: self physicalKey asString capitalized
- 		keyboardButtonLabeled: (self isKeystroke	
- 			ifTrue: [self labelForPhysicalKeyStroke]
- 			ifFalse: [self labelForPhysicalKeyDown])
  		dyed: color) asMorph.
  	
  	^ box!

Item was added:
+ ----- Method: KeyboardEvent>>key (in category 'keyboard') -----
+ key
+ 	"Answers a representation for the (non-modifier) key, which should be consistent across platforms considering its cause."
+ 
+ 	^ EventSensor virtualKeyAt: keyCode!

Item was added:
+ ----- Method: KeyboardEvent>>keyCode (in category 'keyboard') -----
+ keyCode
+ 	"Answers the virtual-key code (or scan code) for this event."
+ 
+ 	^ keyCode!

Item was removed:
- ----- Method: KeyboardEvent>>labelForPhysicalKeyDown (in category 'printing') -----
- labelForPhysicalKeyDown
- 	"#keyDown and #keyUp -- needs platform-specific mapping for virtual key codes"
- 
- 	^ 'VK-0x', (self keyValue printPaddedWith: $0 to: 2 base: 16)!

Item was removed:
- ----- Method: KeyboardEvent>>labelForPhysicalKeyStroke (in category 'printing') -----
- labelForPhysicalKeyStroke
- 
- 	^ (self keyValue <= 32 or: [self keyValue = 127])
- 		ifFalse: [
- 			self keyCharacter asUppercase asString]
- 		ifTrue: [
- 			(self controlKeyPressed and: [self keyValue < 28 "no arrows or space"])
- 				ifTrue: [
- 					"Most likely a physical key with a readable (uppercase) label. Be aware that this cannot cover the cases where the physical contro key was pressed together with the CTRL modifier."
- 					(self keyValue bitOr: 16r40) asCharacter asString "+64"]
- 				ifFalse: [
- 					self keyValue caseOf: {
- 						[ 1 ] -> [ 'Home' translated ].
- 						[ 4 ] -> [ 'End' translated ].
- 						[ 5 ] -> [ 'Insert' translated ].
- 						[ 8 ] -> [ 'Backspace' translated ].
- 						[ 9 ] -> [ 'Tab' ].
- 						[ 10 ] -> [ 'LF' ].
- 						[ 11 ] -> [ 'PageUp' translated ].
- 						[ 12 ] -> [ 'PageDown' translated ].
- 						[ 13 ] -> [ 'Return' translated "CR" ].
- 						[ 27 ] -> [ 'Esc' ].
- 						[ 32 ] -> [ 'Space' translated ].
- 						[ 127 ] -> [ 'Del' translated ].
- 					} otherwise: [ 
- 						'ASCII-', (self keyValue printPaddedWith: $0 to: 2 base: 10)]]]!

Item was removed:
- ----- Method: KeyboardEvent>>labelsForPhysicalModifiers (in category 'printing') -----
- labelsForPhysicalModifiers
- 	"Help users understand the physical modifier keys that where involved in this event. Note that, due to historical reasons, the SHIFT modifier comes first on macOS but last on other platforms."
- 
- 	| result |
- 	result := OrderedCollection new.
- 
- 	Smalltalk platformName = 'Mac OS'
- 		ifTrue: [
- 			self shiftPressed ifTrue: [result add: 'Shift'].
- 			self controlKeyPressed ifTrue: [result add: 'Ctrl'].
- 			self optionKeyPressed ifTrue: [result add: 'Opt'].
- 			self commandKeyPressed ifTrue: [result add: 'Cmd']]
- 		ifFalse: [ "Linux/Windows"
- 			self controlKeyPressed
- 				ifTrue: [result add: 'Ctrl']
- 				ifFalse: [
- 					Smalltalk platformName = 'Win32'
- 						ifTrue: [
- 							(self commandKeyPressed or: [self optionKeyPressed])
- 								ifTrue: [result add: 'Alt']]
- 						ifFalse: ["Linux/ARM"
- 							self commandKeyPressed
- 								ifTrue: [result add: 'Alt']
- 								ifFalse: [self optionKeyPressed
- 									ifTrue: [
- 										result add: 'Strg'.
- 										result add: 'Alt']]]].
- 			self shiftPressed ifTrue: [result add: 'Shift']].
- 	^ result!

Item was added:
+ ----- Method: KeyboardEvent>>physicalKey (in category 'morphic/tools - accessing') -----
+ physicalKey
+ 
+ 	^ self key
+ 		ifNil: ['VK-0x', (self keyCode printPaddedWith: $0 to: 2 base: 16)]
+ 		ifNotNil: [:key |
+ 			(#(control command option) includes: key)
+ 				ifTrue: [ "Similar to #physicalModifiers"
+ 					Smalltalk platformName = 'Mac OS'
+ 						ifTrue: [key]
+ 						ifFalse: [
+ 							self controlKeyPressed
+ 								ifTrue: [(self optionKeyPressed and: [self commandKeyPressed])
+ 									ifTrue: [#alt "Linux/X11"]
+ 									ifFalse: [#control]]
+ 								ifFalse: [#alt]]]
+ 				ifFalse: [
+ 					(key isCharacter
+ 						ifTrue: [(Character constantNameFor: key) ifNil: [key]]
+ 						ifFalse: [key]) ]]!

Item was added:
+ ----- Method: KeyboardEvent>>physicalModifiers (in category 'morphic/tools - accessing') -----
+ physicalModifiers
+ 	"Help users understand the physical modifier keys that where involved in this event. Note that, due to historical reasons, the SHIFT modifier comes first on macOS but last on other platforms."
+ 
+ 	| result |
+ 	result := OrderedCollection new.
+ 
+ 	Smalltalk platformName = 'Mac OS'
+ 		ifTrue: [
+ 			self shiftPressed ifTrue: [result add: #shift].
+ 			self controlKeyPressed ifTrue: [result add: #ctrl].
+ 			self optionKeyPressed ifTrue: [result add: #opt].
+ 			self commandKeyPressed ifTrue: [result add: #cmd]]
+ 		ifFalse: [ "Linux/Windows"
+ 			self controlKeyPressed
+ 				ifTrue: [result add: #ctrl]
+ 				ifFalse: [
+ 					Smalltalk platformName = 'Win32'
+ 						ifTrue: [
+ 							(self commandKeyPressed or: [self optionKeyPressed])
+ 								ifTrue: [result add: #alt]]
+ 						ifFalse: ["Linux/ARM"
+ 							self commandKeyPressed
+ 								ifTrue: [result add: #alt]
+ 								ifFalse: [self optionKeyPressed
+ 									ifTrue: [
+ 										result add: #ctrl.
+ 										result add: #alt]]]].
+ 			self shiftPressed ifTrue: [result add: #shift]].
+ 	^ result!

Item was changed:
  ----- Method: KeyboardEvent>>printKeyStringOn: (in category 'printing') -----
  printKeyStringOn: aStream
  	"Print a readable string representing the receiver on a given stream"
  
  	| kc inBrackets firstBracket keyString |
  	kc := self keyCharacter.
  	inBrackets := false.
  	firstBracket := [ inBrackets ifFalse: [ aStream nextPut: $<. inBrackets := true ]].
+ 	self modifiers do: [:modifier |
+ 		firstBracket value. aStream nextPutAll: modifier; nextPutAll: '-' ].
- 	self controlKeyPressed ifTrue: [ 	firstBracket value. aStream nextPutAll: 'Ctrl-' ].
- 	self commandKeyPressed ifTrue: [ firstBracket value. aStream nextPutAll: 'Cmd-' ].
- 	self optionKeyPressed ifTrue: [ firstBracket value. aStream nextPutAll: 'Opt-' ].
- 	self shiftPressed ifTrue: [ firstBracket value. aStream nextPutAll: 'Shift-' ].
  
+ 	keyString := (Character constantNameFor: kc)
+ 		ifNil: [String with: kc].
- 	keyString := (kc caseOf: {
- 		[ Character space ] -> [ 'space' ].
- 		[ Character tab ] -> [ 'tab' ].
- 		[ Character cr ] -> [ 'cr' ].
- 		[ Character lf ] -> [ 'lf' ].
- 		[ Character enter ] -> [ 'enter' ].
- 
- 		[ Character backspace ] -> [ 'backspace' ].
- 		[ Character delete ] -> [ 'delete' ].
- 
- 		[ Character escape ] -> [ 'escape' ].
- 
- 		[ Character arrowDown ] -> [ 'down' ].
- 		[ Character arrowUp ] -> [ 'up' ].
- 		[ Character arrowLeft ] -> [ 'left' ].
- 		[ Character arrowRight ] -> [ 'right' ].
- 
- 		[ Character end ] -> [ 'end' ].
- 		[ Character home ] -> [ 'home' ].
- 		[ Character pageDown ] -> [ 'pageDown' ].
- 		[ Character pageUp ] -> [ 'pageUp' ].
- 
- 		[ Character euro ] -> [ 'euro' ].
- 		[ Character insert ] -> [ 'insert' ].
- 
- 		} otherwise: [ String with: kc ]).
  		
  	keyString size > 1 ifTrue: [ firstBracket value ].
  	aStream nextPutAll: keyString.
  
  	inBrackets ifTrue: [aStream nextPut: $> ]!

Item was changed:
  ----- Method: KeyboardEvent>>printOn: (in category 'printing') -----
  printOn: aStream
  	"Print the receiver on a stream"
  
  	aStream nextPut: $[.
  	aStream nextPutAll: self cursorPoint printString; space.
  	aStream nextPutAll: type; space. 
  	
  	self isKeystroke ifTrue: [
  		aStream nextPutAll: ''''.		
  		self printKeyStringOn: aStream.
+ 		aStream nextPut: $'; space].
- 		aStream nextPut: $'; space.
- 		aStream nextPutAll: '['.
- 		self printPhysicalModifiersOn: aStream.
- 		aStream nextPutAll: '] '].
  	
  	aStream nextPut: $(.
  	aStream nextPutAll: keyValue printString.
  	aStream nextPut: $); space.
  	
  	aStream nextPutAll: timeStamp printString.
  	aStream nextPut: $]!

Item was removed:
- ----- Method: KeyboardEvent>>printPhysicalModifiersOn: (in category 'printing') -----
- printPhysicalModifiersOn: aStream
- 	"Help users understand the physical modifier keys that where involved in this event."
- 
- 	self labelsForPhysicalModifiers
- 		do: [:modifier | aStream nextPutAll: modifier]
- 		separatedBy: [aStream nextPutAll: ' + '].!

Item was removed:
- ----- Method: KeyboardEvent>>scanCode: (in category 'private') -----
- scanCode: ignore
- 	" OB-Tests expects this "!

Item was changed:
  ----- Method: KeyboardEvent>>setType:buttons:position:keyValue:hand:stamp: (in category 'private') -----
  setType: aSymbol buttons: anInteger position: pos keyValue: aValue hand: aHand stamp: stamp
+ 
+ 	self
+ 		setType: aSymbol
+ 		buttons: anInteger
+ 		position: pos
+ 		keyValue: aValue
+ 		keyCode: #unknown
+ 		hand: aHand
+ 		stamp: stamp.!
- 	type := aSymbol.
- 	buttons := anInteger.
- 	position := pos.
- 	keyValue := aValue.
- 	source := aHand.
- 	wasHandled := false.
- 	timeStamp := stamp.!

Item was added:
+ ----- Method: KeyboardEvent>>setType:buttons:position:keyValue:keyCode:hand:stamp: (in category 'private') -----
+ setType: aSymbol buttons: anInteger position: pos keyValue: aValue keyCode: aCode hand: aHand stamp: stamp
+ 	type := aSymbol.
+ 	buttons := anInteger.
+ 	position := pos.
+ 	keyValue := aValue.
+ 	keyCode := aCode.
+ 	source := aHand.
+ 	wasHandled := false.
+ 	timeStamp := stamp.!

Item was changed:
  ----- Method: KeyboardEvent>>storeOn: (in category 'printing') -----
  storeOn: aStream
  
  	aStream nextPutAll: type.
  	aStream space.
  	self timeStamp storeOn: aStream.
  	aStream space.
  	buttons storeOn: aStream.
  	aStream space.
  	keyValue storeOn: aStream.
+ 	aStream space.
+ 	keyCode storeOn: aStream.
  !

Item was changed:
  ----- Method: KeyboardEvent>>type:readFrom: (in category 'initialize') -----
  type: eventType readFrom: aStream
  	type := eventType.
  	timeStamp := Integer readFrom: aStream.
  	aStream skip: 1.
  	buttons := Integer readFrom: aStream.
  	aStream skip: 1.
+ 	keyValue := Integer readFrom: aStream.
+ 	aStream skip: 1.
+ 	keyCode := Integer readFrom: aStream.!
- 	keyValue := Integer readFrom: aStream.!

Item was added:
+ ----- Method: KeyboardEvent>>virtualKey (in category 'morphic/tools - accessing') -----
+ virtualKey
+ 
+ 	^ self key!

Item was added:
+ ----- Method: KeyboardEvent>>virtualModifiers (in category 'morphic/tools - accessing') -----
+ virtualModifiers
+ 
+ 	^ self modifiers!

Item was added:
+ ----- Method: KeyboardExerciser>>lastEvent (in category 'accessing') -----
+ lastEvent
+ 
+ 	| view event |
+ 	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: {7}\Virtual modifiers: {4}\\Physical key: {8}\Physical modifiers: {5}\\Key value: 0x{1} ({2}) \Key character: {3}\\{6}' withCRs format: {
- 		balloonText: ('Click to inspect. Shift+click to explore.\\Key value: 0x{1} ({2}) \Key character: {3}\Virtual modifiers: {4}\Physical modifiers: {5}\\{6}' withCRs format: {
  			evt keyValue printPaddedWith: $0 to: 2 base: 16.
  			evt keyValue.
  			evt isKeystroke ifTrue: [evt keyCharacter printString] ifFalse: ['-'].
+ 			(evt virtualModifiers joinSeparatedBy: ' ') asUppercase.
+ 			(evt physicalModifiers joinSeparatedBy: ' ') asUppercase.
+ 			evt printString.
+ 			evt virtualKey printString.
+ 			evt physicalKey asString printString}).
- 			evt modifierString.
- 			(evt labelsForPhysicalModifiers joinSeparatedBy: ' ') asUppercase.
- 			evt printString}).
  			
  	eventMorph
  		on: #mouseEnter send: #handleEvent:emphasize: to: self;
  		on: #mouseLeave send: #handleEvent:deemphasize: to: self;
  		on: #mouseDown send: #handleEvent:inspect: to: self.
  
  	self addMorphBack: eventMorph.!

Item was added:
+ ----- Method: KeyboardExerciser>>logEventRepetition: (in category 'event handling') -----
+ logEventRepetition: evt
+ 
+ 	| label lastEvents box |
+ 	(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).
+ 			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: ['... ', (lastEvents size - 10), ' older events and:', String cr] 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.!

Item was added:
+ ----- Method: UserInputEvent>>modifiers (in category 'accessing') -----
+ modifiers
+ 
+ 	^ Array streamContents: [:s |
+ 		self controlKeyPressed ifTrue: [s nextPut: #ctrl].
+ 		self optionKeyPressed ifTrue:[s nextPut: #opt].
+ 		self commandKeyPressed ifTrue:[s nextPut: #cmd].
+ 		self shiftPressed ifTrue:[s nextPut: #shift]]!



More information about the Squeak-dev mailing list