Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
SensorReporter
Last updated at 3:54 pm UTC on 4 April 2017
A small tool by John-Reed Maffeo which shows mouse and key press events. File it in and evaluate
 SensorReporter setupAndDisplay

http://forum.world.st/Mouse-button-tester-question-tt4941095.html#a4941221

Object subclass: #SensorReporter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SensorReporter'!

!SensorReporter methodsFor: 'user interface' stamp: 'jrm 12/30/2016 22:41'!
displayRow: aToken

	| row usm sm spacer |
	
	spacer := RectangleMorph new.
	spacer bounds: (Rectangle origin: 0@0 extent: 10 @ 10); borderWidth: 0.
	
	row := (RectangleMorph new) layoutPolicy: TableLayout new;
	  listDirection: #leftToRight;
	 wrapCentering: #topLeft;
	  hResizing: #shrinkWrap;
	  vResizing: #shrinkWrap;
	 borderWidth: 0.
	
	usm := UpdatingStringMorph on: Sensor selector: aToken.
	sm := StringMorph contents: 'Sensor ', aToken.
	
	^ row addMorph: usm; addMorph: spacer; addMorph: sm.


! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SensorReporter class
	instanceVariableNames: ''!

!SensorReporter class methodsFor: 'as yet unclassified' stamp: 'jrm 12/30/2016 23:06'!
setupAndDisplay
	"Setup a Morph to display #Sensor activity. self setupAndDisplay"

	| rootPane sReporter row1 row2 row3 row4 row5 row6 row7 |
	
	sReporter := self new.
	
	rootPane := (RectangleMorph new) layoutPolicy: TableLayout new;
	  listDirection: #topToBottom;
	 wrapCentering: #topLeft;
	  hResizing: #shrinkWrap;
	  vResizing: #shrinkWrap.
	
	
	row1 := sReporter displayRow: #shiftPressed.
	row2 := sReporter displayRow: #redButtonPressed.
	row3 := sReporter displayRow: #blueButtonPressed.
	row4 := sReporter displayRow: #yellowButtonPressed.
	row5 := sReporter displayRow: #controlKeyPressed.
	row6 := sReporter displayRow: #commandKeyPressed.
	row7 := sReporter displayRow: #rawMacOptionKeyPressed.
	rootPane addMorph: row1; addMorph: row2; addMorph: row3; addMorph: row4
	; addMorph: row5 ; addMorph: row6; addMorph: row7.
	rootPane openInHand.
	
	
	! !