On Friday 26 October 2001 05:06 pm, I wrote:

> Ok, try the attached change set (it's not a full demo, but it shows the
> keyboard hooking).

Here's a better version that distinguishes between key up and key down, and 
doesn't use keyboard repeat.

-- 
Ned Konz
currently: Stanwood, WA
email:     ned at bike-nomad.com
homepage:  http://bike-nomad.com

--------------Boundary-00=_D8BUZYFESXYXSXF1SX19
Content-Type: text/plain;
  charset="iso-8859-1";
  name="KeyboardListenerDemo-nk.2.cs"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="KeyboardListenerDemo-nk.2.cs"

'From Squeak3.2alpha of 3 October 2001 [latest update: #4441] on 26 October 2001 at 6:08:58 pm'!
"Change Set:		KeyboardListenerDemo-nk
Date:			26 October 2001
Author:			Ned Konz

KeyboardTestMorph demo

This shows how you can use addKeyboardListener: to hook keyboard events."!

Morph subclass: #KeyboardTestMorph
	instanceVariableNames: 'keyMapping delta '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NK-Demo'!

!KeyboardTestMorph commentStamp: 'nk 10/26/2001 18:08' prior: 0!
This is a little demo of using the HandMorph>>addKeyboardListener functions.
Just go:
KeyboardTestMorph demo!


!KeyboardEvent methodsFor: 'testing' stamp: 'nk 10/26/2001 17:50'!
isKeyDown
	^self type == #keyDown! !


!KeyboardTestMorph methodsFor: 'events-processing' stamp: 'nk 10/26/2001 17:48'!
handleListenEvent: evt
	| mapping |
	mapping _ keyMapping at: evt keyValue ifAbsent: [ ^self ].
	(mapping at: evt type ifAbsent: [ ^self ]) value: self! !

!KeyboardTestMorph methodsFor: 'events-processing' stamp: 'nk 10/26/2001 17:46'!
onKeyDown: keyCharacter do: aValuableObject
	(keyMapping at: keyCharacter asInteger ifAbsentPut: [ IdentityDictionary new ])
		at: #keyDown
		put: aValuableObject.! !

!KeyboardTestMorph methodsFor: 'events-processing' stamp: 'nk 10/26/2001 17:46'!
onKeyUp: keyCharacter do: aValuableObject
	(keyMapping at: keyCharacter asInteger ifAbsentPut: [ IdentityDictionary new ])
		at: #keyUp
		put: aValuableObject.! !

!KeyboardTestMorph methodsFor: 'events-processing' stamp: 'nk 10/26/2001 17:47'!
onKeystroke: keyCharacter do: aValuableObject
	(keyMapping at: keyCharacter asInteger ifAbsentPut: [ IdentityDictionary new ])
		at: #keystroke
		put: aValuableObject.! !

!KeyboardTestMorph methodsFor: 'initialization' stamp: 'nk 10/26/2001 17:59'!
initialize
	super initialize.
	delta _ 0 at 0.
	keyMapping _ IdentityDictionary new.
	self currentHand addKeyboardListener: self. ! !

!KeyboardTestMorph methodsFor: 'submorphs-add/remove' stamp: 'nk 10/26/2001 17:51'!
delete
	self currentHand removeKeyboardListener: self.
	^super delete.! !

!KeyboardTestMorph methodsFor: 'stepping and presenter' stamp: 'nk 10/26/2001 17:54'!
step
	delta isZero ifFalse: [
		self position: self position + delta
	]! !

!KeyboardTestMorph methodsFor: 'stepping and presenter' stamp: 'nk 10/26/2001 18:07'!
stepTime
	^20! !

!KeyboardTestMorph methodsFor: 'accessing' stamp: 'nk 10/26/2001 18:02'!
delta: aPoint
	delta _ aPoint.
! !

!KeyboardTestMorph methodsFor: 'accessing' stamp: 'nk 10/26/2001 17:57'!
onKey: aKeycode moveBy: aDelta
	self onKeyDown: aKeycode do: [ :k | self delta: aDelta ].
	self onKeyUp: aKeycode do: [ :k | self delta: 0 at 0 ].! !


!KeyboardTestMorph class methodsFor: 'as yet unclassified' stamp: 'nk 10/26/2001 18:06'!
demo
	"KeyboardTestMorph demo"
	"Opens up two KeyboardTestMorphs that you can control with the arrow keys"

| m1 m2 increment |

increment _ 0 at 10.

m1 _ KeyboardTestMorph new.
m1 onKey: Character arrowDown moveBy: increment.
m1 onKey: Character arrowUp moveBy: increment negated.
m1 position: 20 at 200; openInWorld.

m2 _ KeyboardTestMorph new.
m2 onKey: Character arrowRight moveBy: increment.
m2 onKey: Character arrowLeft moveBy: increment negated.
m2 position: 200 at 200; color: Color red; openInWorld.! !

KeyboardTestMorph removeSelector: #fred!
KeyboardTestMorph removeSelector: #on:do:!