For those who play with scripting and wants to make their
scripts respond to keyStrokes. Most usefull for small games etc.
This change set adds a keyStroke to the playfield tiles and also 
the enables a out commented keyStroke script trigger.

Karl
-------------- next part --------------
'From Squeak2.9alpha of 13 June 2000 [latest update: #3193] on 22 January 2001 at 8:21:43 pm'!
BorderedMorph subclass: #PasteUpMorph
	instanceVariableNames: 'presenter model cursor padding backgroundMorph turtleTrailsForm turtlePen lastTurtlePositions isPartsBin autoLineLayout indicateCursor resizeToFit wantsMouseOverHalos worldState griddingOn '
	classVariableNames: 'DisableDeferredUpdates MinCycleLapse StillAlive '
	poolDictionaries: ''
	category: 'Morphic-Worlds'!

!PasteUpMorph methodsFor: 'misc' stamp: 'kfr 1/21/2001 21:25'!
getKeyStroke
 ^ self valueOfProperty: #karlKey! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'kfr 1/22/2001 20:08'!
handlesKeyboard: evt
	^(self isWorldMorph or:[evt keyCharacter == Character tab and:[self hasProperty: #tabAmongFields]]) or: [super handlesKeyboard: evt]! !

!PasteUpMorph methodsFor: 'event handling' stamp: 'kfr 1/22/2001 20:07'!
keyDown: event
        self setProperty: #karlKey toValue: event keyValue! !


!PasteUpMorph class methodsFor: 'scripting' stamp: 'kfr 1/21/2001 20:01'!
additionsToViewerCategories
	"Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."

	^ # (

(playfield (
(command initiatePainting 'Initiate painting of a new object in the standard playfield.')
(slot mouseX 'The x coordinate of the mouse pointer' number readWrite player getMouseX  unused unused)
(slot mouseY 'The y coordinate of the mouse pointer' number readWrite player getMouseY  unused unused)
(command roundUpStrays 'Bring all out-of-container subparts back into view.')
(slot numberAtCursor 'the number at the cursor' number readWrite player getNumberAtCursor player setNumberAtCursor: )
(slot playerAtCursor 'the object currently at the cursor' player readWrite player getValueAtCursor  unused unused)
(command unhideHiddenObjects 'Unhide all hidden objects.')
(slot keyStroke 'the key currently pressed' number readWrite player getKeyStroke  unused unused)))

(collections (
(slot cursor 'The index of the chosen element' number readWrite player getCursor player setCursorWrapped:)
(slot playerAtCursor 'the object currently at the cursor' player readWrite player getValueAtCursor  unused unused)
(slot firstElement  'The first object in my contents' player  readWrite player getFirstElement  player  setFirstElement:)
(slot numberAtCursor 'the number at the cursor' number readWrite player getNumberAtCursor player setNumberAtCursor: )
(command removeAll 'Remove all elements from the playfield')
(command shuffleContents 'Shuffle the contents of the playfield')
(command append: 'Add the object to my content' player)))

(#'stack navigation' (
(command goToNextCardInStack 'Go to the next card')
(command goToPreviousCardInStack  'Go to the previous card')
(command goToFirstCardInBackground 'Go to the first card of the current background')
(command goToFirstCardOfStack 'Go to the first card of the entire stack')
(command goToLastCardInBackground 'Go to the last card of the current background')
(command goToLastCardOfStack 'Go to the last card of the entire stack')
(command deleteCard 'Delete the current card')
(command insertCard 'Create a new card')))

(viewing (
(slot viewingNormally 'whether contents are viewed normally' boolean readWrite player getViewingByIcon player setViewingByIcon: )))


(#'pen trails' (
(command liftAllPens 'Lift the pens on all the objects in my interior.')
(command lowerAllPens  'Lower the pens on all the objects in my interior.')
(command clearTurtleTrails 'Clear all the pen trails in the interior.'))))
! !


!Player methodsFor: 'slot getters/setters' stamp: 'kfr 1/21/2001 19:34'!
getKeyStroke
 ^self  costume getKeyStroke! !


!ScriptInstantiation methodsFor: 'status control' stamp: 'kfr 1/22/2001 19:52'!
chooseTriggerFrom: aMorph
	"Put up a menu of status alternatives and carry out the request"

	| aMenu reply standardStati  m |
	"NB; the keyStroke branch commented out temporarily until keystrokes can actually be passed along to the user's scripting code"

	standardStati _ #(normal paused ticking mouseDown mouseStillDown mouseUp mouseEnter mouseLeave mouseEnterDragging mouseLeaveDragging opening closing keyStroke).
	aMenu _ SelectionMenu labelList:  #(
		'normal'		" -- run when called"		
		'paused' 		"ready to run all the time"
		'ticking'		"run all the time"
		'mouseDown'	"run when mouse goes down on me"
		'mouseStillDown'	"while mouse still down"
		'mouseUp'		"when mouse comes back up"
		'mouseEnter'	"when mouse enters my bounds, button up"
		'mouseLeave'	"when mouse exits my bounds, button up"
		'mouseEnterDragging'	"when mouse enters my bounds, button down"
		'mouseLeaveDragging'	"when mouse exits my bounds, button down"
		'opening'	"when I am being opened"
		'closing'	"when I am being closed"
		'keyStroke'	"run when user hits a key"
		'what do these mean?'
		)
		lines: #(1 3 6 10 12 13)
		selections: (standardStati, #(explainStatusAlternatives)).

	reply _ aMenu startUpWithCaption: 'When should this script run?'.
	"(reply == #keyStroke) ifTrue: [^ self inform: 'user-scripted fielding
of keystrokes is not
yet available.']."

	reply == #explainStatusAlternatives ifTrue: [^ self explainStatusAlternatives].
	reply ifNotNil: 
		[self status: reply.  "Gets event handlers fixed up"
		reply == #paused ifTrue:
			[m _ player costume.
			(m isKindOf: SpeakerMorph) ifTrue: [m stopSound]].
		self updateAllStatusMorphs]! !