'From Squeak2.9alpha of 13 June 2000 [latest update: #3412] on 20 February 2001 at 10:31:50 pm'! "Change Set: Genie-Integration Date: 20 February 2001 Author: Nathanael Scharli Genie is a character and gesture recognition system for Squeak. This changeset integrates Genie into Morphic. It consists of system integration code in classes like HandMorph, Morph, TextMorph, MorphicEvent, etc. NOTES: - Make sure that Genie-Engine is filed in before you file in this change-set!! - To get a ready-to-use Genie environment, file in the following changesets in this order: a) Genie-Engine.cs b) Genie-UI.cs c) Genie-Integration.cs"! Smalltalk renameClassNamed: #MorphicGestureEvent as: #CRGesture! Object subclass: #CRGesture instanceVariableNames: 'coordinates capturedFeature lookupResult target dictionary startEvent ' classVariableNames: '' poolDictionaries: '' category: 'Genie-Integration'! !CRGesture commentStamp: 'NS 2/20/2001 20:18' prior: 0! My instances describe a genie gesture. There are the following instance variables: capturedFeature Features of the captured gesture coordinates Coordinates of the captured feature dictionary Dictionary for the feature lookup lookupResult Result of the dictionary lookup for the captured feature target The target morph startEvent The event that started the capturing of this gesture The lookupResult provides a wide variety of informations about the lookup process and th best matches. (Usually it contains not only one match, but the best few matches). Amongst others, it provides an iterator to walk through the matches. A lot of methods in this class are just forwarded to the lookupResult. So, have a look at this class (and CRlookupItem) to get more informations. See the the class comment of AGenieDescription for more informations about the genie events. ! CRGesture class instanceVariableNames: ''! Smalltalk renameClassNamed: #CRGestureHandler as: #CRGestureProcessor! Object subclass: #CRGestureProcessor instanceVariableNames: 'target startEvent capsLockPressed mouseActionButton cursorBeforeFocus isEnabled isEscaped recognizer lastGesture focus hand ' classVariableNames: '' poolDictionaries: '' category: 'Genie-Integration'! !CRGestureProcessor commentStamp: 'NS 2/20/2001 20:16' prior: 0! This class is invoked is used to capture and process a gesture. It closely cooperates with HandMorph.! Object subclass: #EventHandler instanceVariableNames: 'mouseDownRecipient mouseDownSelector mouseMoveRecipient mouseMoveSelector mouseStillDownRecipient mouseStillDownSelector mouseUpRecipient mouseUpSelector mouseEnterRecipient mouseEnterSelector mouseLeaveRecipient mouseLeaveSelector mouseEnterDraggingRecipient mouseEnterDraggingSelector mouseLeaveDraggingRecipient mouseLeaveDraggingSelector keyStrokeRecipient keyStrokeSelector valueParameter startDragRecipient startDragSelector doubleClickSelector doubleClickRecipient clickSelector clickRecipient gestureSelector gestureRecipient gestureDictionaryOrName ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Events'! Morph subclass: #HandMorph instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners mouseClickState mouseOverHandler lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor ' classVariableNames: 'DoubleClickTime EventStats NewEventRules NormalCursor PasteBuffer ShowEvents ' poolDictionaries: 'EventSensorConstants ' category: 'Morphic-Kernel'! Morph subclass: #TextMorph instanceVariableNames: 'textStyle text wrapFlag paragraph editor container predecessor successor lastGesture ' classVariableNames: 'CaretForm ' poolDictionaries: '' category: 'Morphic-Basic'! !CRGesture methodsFor: 'private' stamp: 'NS 7/10/2000 16:56'! lookupResult: aCRLookupResult lookupResult _ aCRLookupResult! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/7/2000 15:04'! charAt: anInteger ^ self lookupResult charAt: anInteger ! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/12/2000 15:25'! charTypeAt: anInteger ^ self lookupResult charTypeAt: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 2/20/2001 19:59'! correspondingKeystrokes "Return the keystrokes corresponding to the character at the iterator position (if there are any). See the equally named method in CRLookupResult or CRLookupItem for more informations." ^ self correspondingKeystrokesAt: self lookupIndex. ! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/12/2000 15:30'! correspondingKeystrokesAt: anInteger ^ self lookupResult correspondingKeystrokesAt: anInteger ! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 2/20/2001 19:58'! correspondingMouseEvents "Return the mouse events corresponding to the character at the terator position (if there is one). See the equally named method in CRLookupResult or CRLookupItem for more informations." ^ self correspondingMouseEventsAt: self lookupIndex. ! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 2/19/2001 17:28'! correspondingMouseEventsAt: anInteger ^ self lookupResult correspondingMouseEventsHand: self hand position: self position buttons: self buttons ! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/10/2000 10:29'! correspondsToKeystrokes "Does the character at he iterator positon correspond to a keystroke? See the equally named method in CRLookupResult or CRLookupItem for more informations." ^ self correspondsToKeystrokesAt: self lookupIndex. ! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/13/2000 09:28'! correspondsToKeystrokesAt: anInteger ^ self lookupResult correspondsToKeystrokesAt: anInteger ! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 2/19/2001 17:26'! correspondsToMouseEvents "Does the character at the iterator position corresponds to a mouse event? See the equally named method in CRLookupResult or CRLookupItem for more informations." ^ self correspondsToMouseEventsAt: self lookupIndex! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 2/19/2001 17:27'! correspondsToMouseEventsAt: anInteger ^ self lookupResult correspondsToMouseEventsAt: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/7/2000 15:07'! distanceAt: anInteger ^ self lookupResult distanceAt: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/19/2000 16:02'! evaluateCodeAt: anInteger ^ self lookupResult evaluateCodeIn: self at: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/7/2000 15:07'! featureAt: anInteger ^ self lookupResult featureAt: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/19/2000 16:36'! isCodeAt: anInteger ^ self lookupResult isCodeAt: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/12/2000 15:22'! isCommandAt: anInteger ^ self lookupResult isCommandAt: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 7/19/2000 13:56'! isStrokesAt: anInteger ^ self lookupResult isStrokesAt: anInteger! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/10/2000 10:33'! lookupIndex "The current iterator position within the lookup result" ^ self lookupResult lookupIndex! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 2/14/2001 17:21'! lookupIndex: anInteger "Set the current iterator position within the lookup result" ^ self lookupResult lookupIndex: anInteger.! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/10/2000 10:35'! lookupResult "The lookup result that was generated by looking up the newly captured feature in the dictionary. Usually it contains more than one match. A lot of methods in this class are just foreward methods to the lookup result. See class CRLookupResult (and CRLookupItem, CRChar) for more informations" lookupResult isNil ifTrue: [self lookupResult: (self dictionary lookup: self capturedFeature)]. ^ lookupResult.! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/10/2000 10:39'! nextDistinctCharMatch "Move the result iterator to the next match that has a distinct character associated to it" "See class CRLookupResult, CRLookupItem for more informations" ^ self lookupResult nextDistinctCharMatch! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/10/2000 10:38'! nextDistinctCharMatchRollover: aBoolean "Move the result iterator to the next match that has a distinct character associated to it" "See class CRLookupResult, CRLookupItem for more informations" ^ self lookupResult nextDistinctCharMatchRollover: aBoolean! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/10/2000 10:39'! nextMatch "Move the result iterator to the next match" "See class CRLookupResult, CRLookupItem for more informations" ^ self lookupResult nextMatch! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/10/2000 10:40'! nextMatchRollover: aBoolean "Move the result iterator to the next match" "See class CRLookupResult, CRLookupItem for more informations" ^ self lookupResult nextMatchRollover: aBoolean! ! !CRGesture methodsFor: 'lookup result accessing' stamp: 'NS 8/14/2000 12:21'! normalizedCharAt: anInteger ^ self lookupResult normalizedCharAt: anInteger! ! !CRGesture methodsFor: 'testing' stamp: 'NS 2/14/2001 18:23'! anyModifierKeyPressed ^ self startEvent anyModifierKeyPressed! ! !CRGesture methodsFor: 'testing' stamp: 'NS 2/14/2001 18:23'! commandKeyPressed ^ self startEvent commandKeyPressed! ! !CRGesture methodsFor: 'testing' stamp: 'NS 2/14/2001 18:24'! controlKeyPressed ^ self startEvent controlKeyPressed! ! !CRGesture methodsFor: 'testing' stamp: 'NS 2/20/2001 20:00'! isAlert "Returns wheter an alert should inform the user about a amigiuous match" ^ self lookupResult isAlert: self dictionary parameters.! ! !CRGesture methodsFor: 'testing' stamp: 'NS 2/20/2001 20:00'! isCode "Is the character at the iterator position code?" ^ self isCodeAt: self lookupIndex! ! !CRGesture methodsFor: 'testing' stamp: 'NS 8/10/2000 10:33'! isCommand "Is the character at the iterato position a command?" ^ self isCommandAt: self lookupIndex! ! !CRGesture methodsFor: 'testing' stamp: 'NS 8/10/2000 10:19'! isReject "Is the match so ambigious that it should be rejected?" ^ self lookupResult isReject: self dictionary parameters.! ! !CRGesture methodsFor: 'testing' stamp: 'NS 8/10/2000 10:33'! isStrokes "Is the character at the iterato position a sequence of keystrokes (ascii characters)?" ^ self isStrokesAt: self lookupIndex! ! !CRGesture methodsFor: 'testing' stamp: 'NS 2/14/2001 18:24'! macOptionKeyPressed ^ self startEvent macOptionKeyPressed! ! !CRGesture methodsFor: 'testing' stamp: 'NS 2/14/2001 18:24'! shiftPressed ^ self startEvent shiftPressed! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/18/2001 09:28'! buttons ^ self startEvent buttons! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/20/2001 19:53'! capturedFeature "Return the captured feature of this gesture" ^ capturedFeature! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/20/2001 19:56'! char "Return the resulting character at the current iterator position. Usually, the lookup result (that is part of a morphic gesture event) contains not only the best match. An iterator can be used to go through the matches. See the equally named method in CRLookupResult or CRLookupItem for more informations." ^ self charAt: self lookupIndex. ! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/20/2001 19:56'! charType "Return the character type at the current iterator position. Basically there are 3 different character types: #strokes (for sequences of keystrokes), #command (for special commands stored as symbols) and #code (for code that can be executed with the morphic gesture event as a receiver). Usually, the lookup result (that is part of a morphic gesture event) contains not only the best match. An iterator can be used to go through the matches. See the equally named method in CRLookupResult or CRLookupItem for more informations." ^ self charTypeAt: self lookupIndex.! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 8/10/2000 10:26'! coordinates "Returns an instance of CRRecognizerCoordinates that stores a lot of informations about the screen coordnates (pixel) where the gesture was captured." ^ coordinates! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/20/2001 19:58'! correspondingKeystrokeEvents "Return the keystroke events corresponding to the character at the iterator position (if there are any). See the equally named method in CRLookupResult or CRLookupItem for more informations." ^ self correspondingKeystrokeEventsAt: self lookupIndex.! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/18/2001 18:18'! correspondingKeystrokeEventsAt: anInteger | events | (self correspondsToKeystrokesAt: anInteger) ifFalse: [^ nil]. events _ OrderedCollection new. (self correspondingKeystrokesAt: anInteger) do: [:each | | char | char _ (each isLetter and: [self shiftPressed]) ifTrue: [each isLowercase ifTrue: [each asUppercase] ifFalse: [each asLowercase]] ifFalse: [each]. events add: (self keystrokeEventFor: char)]. ^ events! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/14/2001 17:19'! cursorPoint "Backward compatibility" ^ self position! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 7/10/2000 16:50'! dictionary ^ dictionary! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 8/10/2000 10:31'! distance "The distance from the captured feature to the result feature at the iterator position". ^ self distanceAt: self lookupIndex! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 8/10/2000 10:32'! evaluateCode "Eveluate the code at the iterator position of the result with THIS INSTANCE AS A RECEIVER. (Only if the character at the iterator position is really code)". ^ self evaluateCodeAt: self lookupIndex ! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 8/10/2000 10:32'! feature "The result feature at the iterator position." ^ self featureAt: self lookupIndex.! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/14/2001 17:13'! hand ^ self startEvent hand! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/18/2001 11:14'! keystrokeEventFor: aCharacter ^ KeyboardEvent new setType: #keystroke buttons: self buttons position: self position keyValue: aCharacter asciiValue hand: self hand stamp: Time millisecondClockValue.! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 8/14/2000 12:22'! normalizedChar "Return the normalized character at the iterator position. See equally named method in CRLookupResult, CRLookupItem for more informations" ^ self normalizedCharAt: self lookupIndex.! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/14/2001 17:19'! position "The cursoprPoint of the event. For every gesture there is a hotspot (#top, #left, #topLeft, ...) definied. This method returns the coordinates of the hotspot in the captured feature" ^ self feature isNil ifTrue: [self startEvent position] ifFalse: [self coordinates pointAt: self feature hotspot].! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/18/2001 11:05'! startEvent ^ startEvent! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 8/10/2000 10:47'! target "Return the target morph of the gesture. Using this method it is possible to access the target morph from within code that is directly entered as the character. (The receiver of this code is the MorphicGestureEvent and so the target morph can be access using 'self target')" ^ target! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/19/2001 16:21'! toggleCommandKey ^ self startEvent toggleCommandKey! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/19/2001 16:21'! toggleControlKey ^ self startEvent toggleControlKey! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/19/2001 16:21'! toggleMacOptionKey ^ self startEvent toggleMacOptionKey! ! !CRGesture methodsFor: 'accessing' stamp: 'NS 2/19/2001 16:21'! toggleShift ^ self startEvent toggleShift! ! !CRGesture methodsFor: 'initialize-release' stamp: 'NS 2/18/2001 18:19'! initializeCapturedFeature: aCRFeature at: aCRRecognizingCoordinates dictionary: aCRDictionary startEvent: anEvent target: aMorph coordinates _ aCRRecognizingCoordinates. capturedFeature _ aCRFeature. dictionary _ aCRDictionary. target _ aMorph. startEvent _ anEvent ! ! !CRGesture class methodsFor: 'instance creation' stamp: 'NS 2/18/2001 18:19'! capturedFeature: aCRFeature at: aCRRecognizingCoordinates dictionary: aCRDictionary startEvent: aMouseEvent target: aMorph ^ super new initializeCapturedFeature: aCRFeature at: aCRRecognizingCoordinates dictionary: aCRDictionary startEvent: aMouseEvent target: aMorph! ! !CRGestureProcessor methodsFor: 'error handling' stamp: 'NS 2/20/2001 20:07'! doesNotUnderstand: aMessage "Forward unknown messages to the target morph. This is necessary since this morph is temporarily installed as the mouseFocus morph in the hand." ^ target isNil ifTrue: [super doesNotUnderstand: aMessage] ifFalse: [target perform: aMessage selector withArguments: aMessage arguments]! ! !CRGestureProcessor methodsFor: 'initialize-release' stamp: 'NS 2/17/2001 11:13'! initializeHand: aHandMorph enabled: aBoolean hand _ aHandMorph. isEnabled _ aBoolean. capsLockPressed _ false. isEscaped _ false. target _ nil. startEvent _ nil. mouseActionButton _ nil. cursorBeforeFocus _ nil. focus _ nil. recognizer _ nil. lastGesture _ nil.! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/17/2001 09:44'! addToRecognizerAndGiveChanceToEscape: anEvent (self giveChanceToEscape: anEvent) ifFalse: [recognizer addPoint: anEvent position]. ! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/20/2001 20:09'! allowsMouseAction: anEvent target: aMorph "There are speciel genie gestures that allows to do a mouse action with a certain button pressed afterwards. This method says wheter such a mouse action is possible" ^ mouseActionButton notNil and: [self isFocused not and: [target == aMorph]] ! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/18/2001 17:47'! disableFocus self isFocused ifFalse: [^ self]. hand showTemporaryCursor: cursorBeforeFocus. cursorBeforeFocus _ nil. focus _ nil. self releaseMouseFocus.! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/20/2001 20:10'! doMouseActionEvent: anEvent target: aMorph "There are speciel genie gestures that allows to do a mouse action with a certain button pressed afterwards. This method does such a mouse action for the spcecified target" | modEvent | modEvent _ self modifiedMouseActionEvent: anEvent. mouseActionButton _ nil. self handleEventEscaped: modEvent.! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/18/2001 10:03'! escapeFromRecognizer: anEventOrNil | oldStartEvent | oldStartEvent _ startEvent. self stopRecognizer. self handleEventEscaped: oldStartEvent. anEventOrNil ifNotNil: [self handleEventEscaped: anEventOrNil]! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/19/2001 17:48'! escapedDo: aBlock | wasEscaped | wasEscaped _ isEscaped. isEscaped _ true. self releaseMouseFocus. ^ aBlock ensure: [isEscaped _ wasEscaped].! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/17/2001 16:25'! giveChanceToEscape: anEventOrNil ^ target allowsGestureEscape and: [recognizer shouldEscape and: [self escapeFromRecognizer: anEventOrNil. true]].! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/19/2001 16:17'! inverseTransformation: anEvent target: aMorph ^ anEvent transformBy: (aMorph transformedFrom: nil) inverseTransformation.! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/20/2001 20:14'! modifiedMouseActionEvent: anEvent "There are speciel genie gestures that allows to do a mouse action with a certain button pressed afterwards. This method returns the event for such a mouse action" | newEvent | newEvent _ anEvent clone. newEvent handler: nil. newEvent wasHandled: false. mouseActionButton notNil ifTrue: [newEvent toggleRedButton. mouseActionButton = #red ifTrue: [newEvent toggleRedButton]. mouseActionButton = #blue ifTrue: [newEvent toggleBlueButton]. mouseActionButton = #yellow ifTrue: [newEvent toggleYellowButton]]. ^ newEvent! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/20/2001 20:14'! modifiedStartEvent: anEvent "Modify the event according to the last gesture" | char newEvent | newEvent _ anEvent clone. capsLockPressed ifTrue: [newEvent toggleShift]. (lastGesture isNil or: [lastGesture isCommand not or: [lastGesture target ~~ target]]) ifTrue: [^ newEvent]. char _ lastGesture normalizedChar. char = #shift ifTrue: [newEvent toggleShift]. char = #commandKey ifTrue: [newEvent toggleCommandKey]. char = #controlKey ifTrue: [newEvent toggleControlKey]. char = #macOptionKey ifTrue: [newEvent toggleMacOptionKey]. ^ newEvent! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/20/2001 22:30'! preprocessGesture: aCRGesture "Preprocess the recognized gesture. Return true if it should not be passed to the target morph, false otherwise" "Check for alert and reject" aCRGesture isReject ifTrue: [^ true]. aCRGesture isAlert ifTrue: [Smalltalk beep]. "Store mouse buttons if special mouse action gesture" (self updateMouseActionButton: aCRGesture) ifTrue: [^ true]. aCRGesture isCommand ifFalse: [^ false]. "Update capsLock state" aCRGesture normalizedChar = #capsLock ifTrue: [capsLockPressed _ capsLockPressed not. ^ true]. "Stop recognizing all gesture exclusively for one morph. NOTE: The exclusive recognition mode is never turned on in this preprocessing method (it has to be done in HandMorph). But it is terminated here for security reasons" (self isFocused and: [aCRGesture normalizedChar = #switchFocus or: [aCRGesture normalizedChar = #switchRecognizeAll]]) ifTrue: [self disableFocus. ^ true]. "Inspect the last gesture" (aCRGesture normalizedChar = #inspectLastGesture) ifTrue: [self inspectLastGesture. ^ true]. ^ false.! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/18/2001 18:19'! processGestureFeature: aCRFeature at: aCRRecognizerCoordinates dictionary: aCRDictionary startEvent: anEvent "Process a recognized gesture. Generate CRGesture, do some preprocessing (if not permitted) and it to the target Morph" | gesture passToMorph | gesture _ CRGesture capturedFeature: aCRFeature at: aCRRecognizerCoordinates dictionary: aCRDictionary startEvent: anEvent target: target. passToMorph _ target allowsGesturePreprocessing not or: [(self preprocessGesture: gesture) not]. lastGesture _ gesture. passToMorph ifTrue: [target gesture: gesture].! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/18/2001 17:40'! releaseMouseFocus hand releaseMouseFocus: self. hand releaseMouseFocus: target.! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/18/2001 16:15'! simulateEvent: anEvent anEvent wasHandled: false. anEvent handler: nil. anEvent hand handleEvent: anEvent! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/17/2001 13:13'! stopRecognizer recognizer stop. startEvent _ nil. self releaseMouseFocus. ! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/17/2001 09:49'! stopRecognizerAndDispatch: anEvent | coordinates feature dictionary modifiedEvent | recognizer addPoint: anEvent position. dictionary _ recognizer dictionary. coordinates _ recognizer stopAndCalculateCoordinates. feature _ recognizer stopAndCalculateFeature. modifiedEvent _ self modifiedStartEvent: startEvent. self stopRecognizer. ^ self processGestureFeature: feature at: coordinates dictionary: dictionary startEvent: modifiedEvent.! ! !CRGestureProcessor methodsFor: 'private' stamp: 'NS 2/15/2001 18:00'! updateMouseActionButton: aCRGesture | char | mouseActionButton _ nil. aCRGesture isCommand ifFalse: [^ false]. char _ aCRGesture normalizedChar. char = #redMouseAction ifTrue: [mouseActionButton _ #red. ^ true]. char = #blueMouseAction ifTrue: [mouseActionButton _ #blue. ^ true]. char = #yellowMouseAction ifTrue: [mouseActionButton _ #yellow. ^ true]. ^ false.! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 11:04'! disableFocus: aMorph (self isFocused: aMorph) ifTrue: [self disableFocus].! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 21:55'! disableGenie self reset. isEnabled _ false.! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 11:28'! enableFocus: aMorph self isEnabled ifFalse: [^ self]. focus _ aMorph. hand newMouseFocus: focus. cursorBeforeFocus _ hand temporaryCursor. hand showTemporaryCursor: Cursor marker.! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 21:55'! enableGenie self reset. isEnabled _ true.! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/19/2001 16:18'! gestureStart: anEvent target: aMorph self inverseTransformation: anEvent target: aMorph. (self allowsGestureStart: anEvent target: aMorph) ifFalse: [^ self]. (self allowsMouseAction: anEvent target: aMorph) ifTrue: [^ self doMouseActionEvent: anEvent target: aMorph]. recognizer _ CRRecognizer dictionary: aMorph gestureDictionary. recognizer ifNil: [^ self]. startEvent _ anEvent. target _ aMorph. anEvent hand newMouseFocus: self event: anEvent. recognizer resetAndStart. recognizer addPoint: anEvent position.! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 09:45'! giveChanceToEscape ^ self giveChanceToEscape: nil ! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/18/2001 10:01'! handleEventEscaped: anEvent self escapedDo: [self simulateEvent: anEvent].! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/15/2001 18:03'! inspectLastGesture lastGesture ifNotNil: [lastGesture hand attachMorph: (lastGesture dictionary newBrowser newMorphWithFeature: lastGesture capturedFeature)]! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/18/2001 17:58'! prepareMouseFocusChangeFrom: oldMorph to: newMorph (newMorph ~~ self and: [self isEnabled and: [self isFocused and: [self isEscaped not]]]) ifTrue: [hand newMouseFocus: self. ^ false]. ^ self isEnabled not or: [self isFocused not or: [newMorph == self or: [newMorph == target and: [self isEscaped]]]].! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 11:17'! reset self isRecognizing ifTrue: [self stopRecognizer]. self disableFocus. self initializeHand: hand enabled: self isEnabled.! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 22:04'! switchEnabled self reset. isEnabled _ isEnabled not.! ! !CRGestureProcessor methodsFor: 'accessing' stamp: 'NS 2/17/2001 22:05'! switchFocus: aMorph self isFocused ifTrue: [self disableFocus: aMorph] ifFalse: [self enableFocus: aMorph].! ! !CRGestureProcessor methodsFor: 'testing' stamp: 'NS 2/10/2001 12:14'! allowsGestureStart: anEvent target: aMorph ^ anEvent redButtonPressed and: [(self isEnabled or: [aMorph isKindOf: CRAddFeatureMorph]) and: [self isRecognizing not and: [self isEscaped not]]]! ! !CRGestureProcessor methodsFor: 'testing' stamp: 'NS 2/10/2001 11:54'! isEnabled ^ isEnabled! ! !CRGestureProcessor methodsFor: 'testing' stamp: 'NS 2/10/2001 11:56'! isEscaped ^ isEscaped! ! !CRGestureProcessor methodsFor: 'testing' stamp: 'NS 2/17/2001 11:10'! isFocused ^ focus notNil! ! !CRGestureProcessor methodsFor: 'testing' stamp: 'NS 2/17/2001 11:04'! isFocused: aMorph ^ self isFocused and: [aMorph == focus]! ! !CRGestureProcessor methodsFor: 'testing' stamp: 'NS 2/10/2001 12:14'! isRecognizing ^ startEvent notNil! ! !CRGestureProcessor methodsFor: 'event processing' stamp: 'NS 2/16/2001 21:31'! handleEvent: anEvent ^ anEvent sentTo: self.! ! !CRGestureProcessor methodsFor: 'event processing' stamp: 'NS 2/13/2001 14:47'! handleFocusEvent: anEvent ^ self handleEvent: anEvent! ! !CRGestureProcessor methodsFor: 'event processing' stamp: 'NS 2/19/2001 19:54'! handleMouseDown: anEvent ^ (target notNil and: [self isEscaped not or: [target fullBounds containsPoint: anEvent position]]) ifTrue: [target handleMouseDown: anEvent] ifFalse: [self]! ! !CRGestureProcessor methodsFor: 'event processing' stamp: 'NS 2/19/2001 16:05'! handleMouseMove: anEvent (self isRecognizing not or: [anEvent wasHandled]) ifTrue: [^ self]. self inverseTransformation: anEvent target: target. self addToRecognizerAndGiveChanceToEscape: anEvent. anEvent wasHandled: true.! ! !CRGestureProcessor methodsFor: 'event processing' stamp: 'NS 2/19/2001 15:58'! handleMouseUp: anEvent (self isRecognizing not or: [anEvent wasHandled]) ifTrue: [^ self]. self inverseTransformation: anEvent target: target. anEvent wasHandled: true. self stopRecognizerAndDispatch: anEvent.! ! !CRGestureProcessor class methodsFor: 'instance creation' stamp: 'NS 2/17/2001 11:13'! forHand: aHandMorph ^ self new initializeHand: aHandMorph enabled: false.! ! !EventHandler methodsFor: 'initialization' stamp: 'NS 2/9/2001 17:20'! on: eventName send: selector to: recipient eventName = #mouseDown ifTrue: [mouseDownRecipient _ recipient. mouseDownSelector _ selector. ^ self]. eventName = #mouseMove ifTrue: [mouseMoveRecipient _ recipient. mouseMoveSelector _ selector. ^ self]. eventName = #mouseStillDown ifTrue: [mouseStillDownRecipient _ recipient. mouseStillDownSelector _ selector. ^ self]. eventName = #mouseUp ifTrue: [mouseUpRecipient _ recipient. mouseUpSelector _ selector. ^ self]. eventName = #mouseEnter ifTrue: [mouseEnterRecipient _ recipient. mouseEnterSelector _ selector. ^ self]. eventName = #mouseLeave ifTrue: [mouseLeaveRecipient _ recipient. mouseLeaveSelector _ selector. ^ self]. eventName = #mouseEnterDragging ifTrue: [mouseEnterDraggingRecipient _ recipient. mouseEnterDraggingSelector _ selector. ^ self]. eventName = #mouseLeaveDragging ifTrue: [mouseLeaveDraggingRecipient _ recipient. mouseLeaveDraggingSelector _ selector. ^ self]. eventName = #click ifTrue: [clickRecipient _ recipient. clickSelector _ selector. ^ self]. eventName = #doubleClick ifTrue: [doubleClickRecipient _ recipient. doubleClickSelector _ selector. ^ self]. eventName = #startDrag ifTrue: [startDragRecipient _ recipient. startDragSelector _ selector. ^ self]. eventName = #keyStroke ifTrue: [keyStrokeRecipient _ recipient. keyStrokeSelector _ selector. ^ self]. eventName = #gesture ifTrue: [gestureRecipient _ recipient. gestureSelector _ selector. ^ self]. self error: 'Event name, ' , eventName , ' is not recognizable.' ! ! !EventHandler methodsFor: 'initialization' stamp: 'NS 2/9/2001 17:20'! onGestureUse: dictionary send: selector to: recipient "This method is similar to on:send:to:, but it has an aditional argument to pass the used gesture dictionary. Use this method instead of on:send:to: to make an EventHandler handle gesture events" self on: #gesture send: selector to: recipient. self gestureDictionaryOrName: dictionary. ! ! !EventHandler methodsFor: 'testing' stamp: 'NS 2/20/2001 20:23'! handlesGestureStart: evt "Does the associated morph want to handle gestures?" ^ gestureRecipient notNil and: [gestureRecipient gestureDictionary notNil]! ! !EventHandler methodsFor: 'testing' stamp: 'NS 2/9/2001 17:21'! hasGestureRecipient ^ gestureRecipient notNil! ! !EventHandler methodsFor: 'events' stamp: 'NS 2/9/2001 17:21'! gesture: aMorphicGestureEvent fromMorph: sourceMorph "Pass the gesture event to the target morph" ^ self send: gestureSelector to: gestureRecipient withEvent: aMorphicGestureEvent fromMorph: sourceMorph! ! !EventHandler methodsFor: 'access' stamp: 'NS 2/20/2001 20:22'! gestureDictionaryOrName "Gesture dictionary or name that should be used for the associated morph" ^ gestureDictionaryOrName! ! !EventHandler methodsFor: 'access' stamp: 'NS 2/20/2001 20:22'! gestureDictionaryOrName: aSymbol "Gesture dictionary or name that should be used for the associated morph" gestureDictionaryOrName _ aSymbol! ! !EventHandler methodsFor: 'access' stamp: 'NS 2/9/2001 18:35'! gestureRecipient ^ gestureRecipient! ! !EventHandler methodsFor: 'access' stamp: 'NS 2/9/2001 18:35'! gestureSelector ^ gestureSelector! ! !Morph methodsFor: 'submorphs-add/remove' stamp: 'NS 2/19/2001 20:53'! delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | aWorld | aWorld _ self world ifNil: [World]. "or some proper of getting the World" "Terminate genie recognition focus" aWorld notNil ifTrue: [aWorld currentHand disableGenieFocus: self]. owner ifNotNil: [(extension == nil or: [self player == nil]) ifTrue: [owner privateRemoveMorph: self. owner _ nil] ifFalse: ["Player must be notified" owner privateRemoveMorph: self. owner _ nil. self player noteDeletionOf: self fromWorld: aWorld] ].! ! !Morph methodsFor: 'events-processing' stamp: 'NS 2/18/2001 16:55'! handleMouseDown: anEvent "System level event handling." anEvent wasHandled ifTrue:[^self]. "not interested" anEvent hand removePendingBalloonFor: self. anEvent hand removePendingHaloFor: self. anEvent wasHandled: true. anEvent controlKeyPressed ifTrue:[^self invokeMetaMenu: anEvent]. "Make me modal during mouse transitions" anEvent hand newMouseFocus: self event: anEvent. anEvent blueButtonChanged ifTrue:[^self blueButtonDown: anEvent]. ((anEvent hand allowsGestureStart: anEvent target: self) and: [self handlesGestureStart: anEvent]) ifTrue: [^ self gestureStart: anEvent]. self mouseDown: anEvent. anEvent hand removeHaloFromClick: anEvent on: self. (self handlesMouseStillDown: anEvent) ifTrue:[ self startStepping: #handleMouseStillDown: at: Time millisecondClockValue + self mouseStillDownThreshold arguments: {anEvent copy resetHandlerFields} stepTime: 1]. ! ! !Morph methodsFor: 'events-processing' stamp: 'NS 2/18/2001 17:00'! handleMouseMove: anEvent "System level event handling." anEvent wasHandled ifTrue:[^self]. "not interested" "Rules say that by default a morph gets #mouseMove iff * the hand is not dragging anything, + and some button is down, + and the receiver is the current mouse focus." (anEvent hand hasSubmorphs) ifTrue:[^self]. (anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self]. anEvent wasHandled: true. self mouseMove: anEvent. (self handlesMouseStillDown: anEvent) ifTrue:[ "Step at the new location" self startStepping: #handleMouseStillDown: at: Time millisecondClockValue arguments: {anEvent copy resetHandlerFields} stepTime: 1]. ! ! !Morph methodsFor: 'meta-actions' stamp: 'NS 2/18/2001 16:26'! blueButtonDown: anEvent "Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph." | h tfm doNotDrag | h _ anEvent hand halo. "Prevent wrap around halo transfers originating from throwing the event back in" doNotDrag _ false. h ifNotNil:[ (h innerTarget == self) ifTrue:[doNotDrag _ true]. (h innerTarget hasOwner: self) ifTrue:[doNotDrag _ true]. (self hasOwner: h target) ifTrue:[doNotDrag _ true]]. tfm _ (self transformedFrom: nil) inverseTransformation. "cmd-drag on flexed morphs works better this way" h _ self addHalo: (anEvent transformedBy: tfm). doNotDrag ifTrue:[^self]. "Initiate drag transition if requested" anEvent hand waitForClicksOrDrag: h event: (anEvent transformedBy: tfm) selectors: { nil. nil. #dragTarget:. } threshold: 5. "Pass focus explicitly here" anEvent hand newMouseFocus: h.! ! !Morph methodsFor: 'meta-actions' stamp: 'NS 2/17/2001 21:50'! buildHandleMenu: aHand "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu." | menu | menu _ MenuMorph new defaultTarget: self. menu addStayUpItem. self addAddHandMenuItemsForHalo: menu hand: aHand. menu defaultTarget: self. self addCustomHaloMenuItems: menu hand: aHand. menu addLine. self player ifNotNil: [self player addPlayerMenuItemsTo: menu hand: aHand]. menu addLine. self addGenieMenuItems: menu hand: aHand. menu defaultTarget: aHand. ^ menu ! ! !Morph methodsFor: 'meta-actions' stamp: 'ar 11/4/2000 23:39'! buildMetaMenu: evt "Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph." | menu | menu _ MenuMorph new defaultTarget: self. menu addStayUpItem. menu add: 'grab' action: #grabMorph:. menu add: 'copy to paste buffer' action: #copyToPasteBuffer:. self maybeAddCollapseItemTo: menu. menu add: 'delete' action: #dismissMorph:. menu addLine. menu add: 'copy Postscript' action: #clipPostscript. menu add: 'print PS to file...' action: #printPSToFile. menu addLine. menu add: 'go behind' action: #goBehind. menu add: 'add halo' action: #addHalo:. menu add: 'duplicate' action: #maybeDuplicateMorph:. self potentialEmbeddingTargets size > 1 ifTrue: [menu add: 'embed...' action: #embedInto:]. menu add: 'resize' action: #resizeMorph:. "Give the argument control over what should be done about fill styles" self addFillStyleMenuItems: menu hand: evt hand. self addDropShadowMenuItems: menu hand: evt hand. self addLayoutMenuItems: menu hand: evt hand. menu addUpdating: #hasClipSubmorphsString target: self selector: #changeClipSubmorphs argumentList: #(). menu addLine. (self morphsAt: evt position) size > 1 ifTrue: [menu add: 'submorphs...' target: self selector: #invokeMetaMenuAt:event: argument: evt position]. menu addLine. menu add: 'inspect' selector: #inspectAt:event: argument: evt position. menu add: 'explore' action: #explore. menu add: 'browse hierarchy' action: #browseHierarchy. menu add: 'make own subclass' action: #subclassMorph. menu addLine. menu add: 'set variable name...' action: #choosePartName. (self isMorphicModel) ifTrue: [menu add: 'save morph as prototype' action: #saveAsPrototype. (self ~~ self world modelOrNil) ifTrue: [menu add: 'become this world''s model' action: #beThisWorldsModel]]. menu add: 'save morph in file' action: #saveOnFile. (self hasProperty: #resourceFilePath) ifTrue: [((self valueOfProperty: #resourceFilePath) endsWith: '.morph') ifTrue: [menu add: 'save as resource' action: #saveAsResource]. menu add: 'update from resource' action: #updateFromResource] ifFalse: [menu add: 'attach to resource' action: #attachToResource]. menu add: 'show actions' action: #showActions. menu addLine. self addCustomMenuItems: menu hand: evt hand. ^ menu ! ! !Morph methodsFor: 'genie-menu' stamp: 'NS 2/17/2001 21:35'! addGenieMenuItems: aMenu hand: aHandMorph aMenu add: 'change gesture dictionary' action: #changeGestureDictionary. self gestureDictionary ifNotNil: [aMenu add: 'inspect gesture dictionary' action: #inspectGestureDictionary. self hasNotExportedGestureDictionary ifFalse: [aMenu add: 'make own copy of gesture dictionary' action: #makeOwnCopyOfGestureDictionary. aMenu add: 'make own sub-gesture dictionary' action: #makeOwnSubGestureDictionary]].! ! !Morph methodsFor: 'genie-menu' stamp: 'NS 2/17/2001 21:14'! changeGestureDictionary "Asks the user for a new gesture dictionary name" | init dictName title | init _ self gestureDictionaryOrName isNil ifTrue: [''] ifFalse: [(self gestureDictionaryOrName isKindOf: CRDictionary) ifTrue: ['(reference to instance gesture dictionary)'] ifFalse: [self gestureDictionaryOrName asString]]. title _ 'Enter dictionary name (#none = none, #new = new):'. ((init = '') not and: [self gestureDictionary isNil]) ifTrue: [title _ title , ' (Current dictionary not available)']. dictName _ FillInTheBlank request: title initialAnswer: init. (dictName isEmptyOrNil or: [dictName = init]) ifFalse: [self gestureDictionaryOrName: (dictName = '#none' ifTrue: [nil] ifFalse: [dictName = '#new' ifTrue: [CRDictionary new name: ''; yourself] ifFalse: [dictName asSymbol]]). dictName = '#new' ifTrue: [self inspectGestureDictionary]. (dictName ~= '#none' and: [self gestureDictionary isNil]) ifTrue: [self inform: 'Dictionary not available']].! ! !Morph methodsFor: 'genie-menu' stamp: 'NS 2/17/2001 21:16'! hasNotExportedGestureDictionary "Is the assigned gesture dictionary exported" | dict | ^ (dict _ self gestureDictionary) notNil and: [dict exportedName isEmptyOrNil] ! ! !Morph methodsFor: 'genie-menu' stamp: 'NS 2/17/2001 21:16'! hasReferencedGestureDictionary "Is the gesture dictionary dicrectly referenced by this object or is it linked by name?" ^ self gestureDictionaryOrName isKindOf: CRDictionary! ! !Morph methodsFor: 'genie-menu' stamp: 'NS 2/17/2001 21:17'! inspectGestureDictionary "Opens an editor for the gesture dictionary" self gestureDictionary isNil ifTrue: [self inform: 'Dictionary not available'] ifFalse: [World currentHand attachMorph: self gestureDictionary asCloseableMorph].! ! !Morph methodsFor: 'genie-menu' stamp: 'NS 2/17/2001 21:17'! makeOwnCopyOfGestureDictionary "Make a copy of the gesture dictionary and assign it to this object" self gestureDictionary isNil ifTrue: [self inform: 'Dictionary not available']. self gestureDictionaryOrName: (self gestureDictionary copy name: #''; yourself). self inspectGestureDictionary. ! ! !Morph methodsFor: 'genie-menu' stamp: 'NS 2/17/2001 21:17'! makeOwnSubGestureDictionary "Make a sud-dictionary of the assigned gesture dictionary and assign it to this object" self gestureDictionary isNil ifTrue: [self inform: 'Dictionary not available']. self gestureDictionaryOrName: (CRDictionary new name: #''; addParent: self gestureDictionary; yourself). self inspectGestureDictionary.! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/20/2001 20:33'! blueButtonClickHand: aHandMorph shift: aBoolean "Simulate a blue button click with the given hand on this morph" | evt | evt _ MouseButtonEvent new setType: #mouseDown position: (self localPointToGlobal: self fullBounds center) which: 0 buttons: 0 hand: aHandMorph stamp: Time millisecondClockValue. evt toggleBlueButton. aBoolean ifTrue: [evt toggleShift]. aHandMorph handleEvent: evt. evt _ MouseButtonEvent new setType: #mouseUp position: (self localPointToGlobal: self fullBounds center) which: 0 buttons: 0 hand: aHandMorph stamp: Time millisecondClockValue. evt toggleBlueButton. aBoolean ifTrue: [evt toggleShift]. aHandMorph handleEvent: evt.! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/20/2001 20:44'! gesture: aCRGesture "This method gets called from the CRGestureProcessor after a gesture is captured entirely. If the Morph has an assigned EventHandler or a gesture handler, let them handle the gesture. Otherwise handleGesture: gets invoked." (self gestureHandler ~~ self) ifTrue: [^ self gestureHandler gesture: aCRGesture]. ^ self eventHandler isNil not ifTrue: [self eventHandler gesture: aCRGesture fromMorph: self] ifFalse: [self gestureHandler handleGesture: aCRGesture].! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/17/2001 21:52'! gestureCode: aCRGesture "If the gesture event contains code, execute it" ^ (aCRGesture isCode) and: [aCRGesture evaluateCode]. ! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/20/2001 22:29'! gestureCommand: aCRGesture "If the gesture event is a command, execute the corresponding action" | char | (aCRGesture isCommand) ifFalse: [^ false]. char _ aCRGesture normalizedChar. (char = #disableGenie) ifTrue: [aCRGesture hand disableGenie. ^ true]. (char = #inspectDictionaries) ifTrue: [aCRGesture hand attachMorph: CRDictionary instanceBrowser asMorph. ^ true]. (char = #inspectActiveDictionary) ifTrue: [aCRGesture hand attachMorph: (aCRGesture dictionary asCloseableMorph). ^ true]. (char = #browseActiveDictionary) ifTrue: [aCRGesture hand attachMorph: (aCRGesture dictionary newBrowser asMorph). ^ true]. (char = #inspectDisplayProperties) ifTrue: [aCRGesture hand attachMorph: CRDisplayProperties instanceBrowser asMorph. ^ true]. (char = #switchFocus or: [char = #switchRecognizeAll]) ifTrue: [aCRGesture hand switchGenieFocus: self. ^ true]. (char = #nextHalo) ifTrue: [self blueButtonClickHand: aCRGesture hand shift: false. ^ true]. (char = #previousHalo) ifTrue: [self blueButtonClickHand: aCRGesture hand shift: true. ^ true]. (char = #abandonHalos) ifTrue: [self world abandonAllHalos. ^ true]. ^ self gestureKeystrokes: aCRGesture. ! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 10:06'! gestureKeystrokes: aCRGesture "If the gesture event corresponds to keystrokes, simulate them" aCRGesture correspondsToKeystrokes ifFalse: [^ false]. aCRGesture correspondingKeystrokeEvents do: [:each | aCRGesture hand handleEventWithGenieEscaped: each]. ^ true.! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/19/2001 17:32'! gestureMouseEvent: aCRGesture "If the gesture corresponds to a mouse event (#redClick, ...), simulate it" | events | events _ aCRGesture correspondingMouseEvents. events ifNotNil: [events do: [:each | each hand handleEventWithGenieEscaped: each]. ^ true]. ^ false! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 10:23'! gestureStrokes: aCRGesture "If he gesture event is a string, simulate the sequence of keystrokes" ^ (aCRGesture isStrokes) and: [self gestureKeystrokes: aCRGesture].! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 18:20'! handleGesture: aCRGesture "This is the method that handles gestures events." (self gestureCode: aCRGesture) ifTrue: [^ true]. (self gestureMouseEvent: aCRGesture) ifTrue: [^ true]. (self gestureStrokes: aCRGesture) ifTrue: [^ true]. (self gestureCommand: aCRGesture) ifTrue: [^ true]. ^ false ! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 10:25'! isGestureUndoable: aCRGesture "Returns wheter a gesture event is undoable in the context of this Morph. NOTE: All the undo related methods can only undo keystrokes by simulating backspace. Therefore, they are only useful for Morphs that accept keyboard text." | keystrokes | (aCRGesture isStrokes) ifTrue: [^ true]. (keystrokes _ aCRGesture correspondingKeystrokes) notNil ifTrue: [keystrokes do: [:each | (self isSpecialCharacterUndoable: each) ifFalse: [^ false]]. ^ true]. ^ false! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 10:25'! isSpecialCharacterUndoable: aCharacter "Is the special character undoable? NOTE: All the undo related methods can only undo keystrokes by simulating backspace. Therefore, they are only useful for Morphs that accept keyboard text." (aCharacter = Character cr or: [aCharacter = Character tab]) ifTrue: [^ true]. ^ false! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/19/2001 16:33'! modifyGesture: originalCRGesture by: modifyCRGesture "Modify the effect of originalCRGesture depending on modifyCRGesture. NOTE: All the undo related methods can only undo keystrokes by simulating backspace. Therefore, they are only useful for Morphs that accept keyboard text." | command | originalCRGesture ifNil: [^ false]. (modifyCRGesture isCommand) ifFalse: [^ false]. command _ modifyCRGesture normalizedChar. command = #switchCase ifTrue: [^ (self undoGesture: originalCRGesture) and: [originalCRGesture toggleShift. self gestureStrokes: originalCRGesture]]. command = #nextMatch ifTrue: [^ (self undoGesture: originalCRGesture) and: [originalCRGesture nextDistinctCharMatch. self gesture: originalCRGesture. true]]. ^ false.! ! !Morph methodsFor: 'genie-dispatching' stamp: 'NS 2/19/2001 16:35'! undoGesture: aCRGesture "Undo the effect of a gesture event. NOTE: All the undo related methods can only undo keystrokes by simulating backspace. Therefore, they are only useful for Morphs that accept keyboard text." | evt | (self isGestureUndoable: aCRGesture) ifFalse: [^ false]. (aCRGesture correspondsToKeystrokes) ifTrue: [ | keystrokes | keystrokes _ aCRGesture correspondingKeystrokes. keystrokes size timesRepeat: [evt _ KeyboardEvent new setType: #keystroke buttons: 0 position: aCRGesture position keyValue: Character backspace hand: aCRGesture hand stamp: Time millisecondClockValue. aCRGesture hand handleEventWithGenieEscaped: evt]. ^ true]. ^ false ! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 20:34'! allowsGestureEscape "Is it allowed to escape from recognizing a gesture for this morph?" ^ true! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 20:34'! allowsGesturePreprocessing "Is the gesture processor allowed to do some preprocessing with the gesture before sending it to this morph?" ^ true! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/19/2001 18:13'! defaultGestureDictionaryOrName "This method returns the default gesture dictionary name for the instances of a Morph class. (It's also possible to directly return a dictionary but it's much more flexible to return the name). This generic implementation returns the class name if there is a dictionary exported under this name. If not, it tries the name of the superclass, etc." | class | self gestureHandler ~~ self ifTrue: [^ self gestureHandler defaultGestureDictionaryOrName]. class _ self class. [class ~= Morph and: [(CRDictionary exportedName: class name asSymbol) isNil]] whileTrue: [class _ class superclass]. ^ (CRDictionary exportedName: class name asSymbol) isNil ifTrue: [self class name asSymbol] ifFalse: [class name asSymbol].! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/16/2001 21:16'! disableGestures self gestureDictionaryOrName: nil.! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 20:37'! gestureDictionary "This method is invoked to determine the gesture dictionary of the Morph. Usually, gesture dictionaries are identified by names and so this method just converts names to dictionaries if necessary" ^ (self gestureDictionaryOrName isKindOf: CRDictionary) ifTrue: [self gestureDictionaryOrName] ifFalse: [CRDictionary exportedName: self gestureDictionaryOrName].! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 20:37'! gestureDictionaryOrName "If there is an GestureHandler or an EventHandler assigned to the object, return the gesture dictionary or name definied there. If not, return the default dictionary or name." (self gestureHandler ~~ self) ifTrue: [^ self gestureHandler gestureDictionaryOrName]. self eventHandler ifNotNil: [^ self eventHandler gestureDictionaryOrName]. ^ self defaultGestureDictionaryOrName! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/19/2001 18:15'! gestureDictionaryOrName: aSymbolOrCRDictionary "Assign the gesture dictionary or name to the object by using an EventHandler" (self gestureHandler ~~ self) ifTrue: [^ self gestureHandler gestureDictionaryOrName: aSymbolOrCRDictionary]. (self eventHandler isNil or: [self eventHandler hasGestureRecipient not]) ifTrue: [self onGestureUse: aSymbolOrCRDictionary send: #handleGesture: to: self] ifFalse: [self eventHandler gestureDictionaryOrName: aSymbolOrCRDictionary].! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 20:40'! gestureHandler "Usually a morph handles gestures itself or lets an associated EventHandler do it. However, sometimes a morph wants to let another morph handle the gesture for it. Example: If a TextMorph is part of a pane (like PluggableTextMorph), the PluggableTextMorph handles also the events for the TextMorph." ^ self! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 20:42'! gestureStart: anEvent "Start capturing a gesture for this morph" anEvent hand gestureStart: anEvent target: self.! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 19:32'! handlesGestureStart: anEvent "If true, the gesture handler is started when the morph gets a red button down event. If there is a gesture Handler or an EventHandler assigned to the object, let it decide what happens. Otherwise, return true if there is a valid default dictionary." (self gestureHandler ~~ self) ifTrue: [^ self gestureHandler handlesGestureStart: anEvent]. self eventHandler ifNotNil: [^ self eventHandler handlesGestureStart: anEvent]. ^ self gestureDictionary notNil! ! !Morph methodsFor: 'genie-processing' stamp: 'NS 2/20/2001 20:43'! onGestureUse: dictionary send: selector to: recipient "Tell a certain instance to use a particular gesture dictionary to lookup gestures. Also the selector and the recipient can be specified" (self gestureHandler ~~ self) ifTrue: [^ self gestureHandler onGestureUse: dictionary send: selector to: recipient]. self eventHandler ifNil: [self eventHandler: EventHandler new]. self eventHandler onGestureUse: dictionary send: selector to: recipient.! ! !HaloMorph methodsFor: 'private' stamp: 'NS 2/17/2001 21:49'! doMenu: evt with: menuHandle "Ask hand to invoke the halo menu for my inner target." | menu | evt hand obtainHalo: self. self removeAllHandlesBut: nil. "remove all handles" self world displayWorld. menu _ innerTarget buildHandleMenu: evt hand. innerTarget mightEntertainDirectionHandles ifTrue: [menu addLine. self showingDirectionHandles ifTrue: [menu add: 'hide direction handles' target: self selector: #showDirectionHandles: argument: false] ifFalse: [menu add: 'show direction handles' target: self selector: #showDirectionHandles: argument: true]]. innerTarget addTitleForHaloMenu: menu. menu popUpEvent: evt in: self world. ! ! !HandMorph methodsFor: 'initialization' stamp: 'ar 10/26/2000 14:58'! initialize super initialize. self initForEvents. keyboardFocus _ nil. mouseFocus _ nil. bounds _ 0@0 extent: Cursor normal extent. userInitials _ ''. damageRecorder _ DamageRecorder new. cachedCanvasHasHoles _ false. temporaryCursor _ temporaryCursorOffset _ nil. self initForEvents.! ! !HandMorph methodsFor: 'focus handling' stamp: 'NS 2/17/2001 18:02'! mouseFocus: aMorphOrNil (self prepareMouseFocusChangeFrom: mouseFocus to: aMorphOrNil) ifTrue: [mouseFocus _ aMorphOrNil].! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! allowsGestureStart: anEvent target: aMorph ^ self genieGestureProcessor notNil and: [self genieGestureProcessor allowsGestureStart: anEvent target: aMorph]! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! disableGenie self genieGestureProcessor ifNotNil: [self genieGestureProcessor disableGenie].! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 20:53'! disableGenieFocus: aMorph self genieGestureProcessor ifNotNil: [self genieGestureProcessor disableFocus: aMorph].! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:58'! enableGenie self ensureGenieGestureProcessor. self genieGestureProcessor enableGenie.! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:57'! ensureGenieGestureProcessor genieGestureProcessor ifNil: [genieGestureProcessor _ CRGestureProcessor forHand: self]. ^ genieGestureProcessor! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:57'! genieGestureProcessor ^ genieGestureProcessor! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! gestureStart: anEvent target: aMorph self genieGestureProcessor ifNil: [^ self]. self genieGestureProcessor gestureStart: anEvent target: aMorph! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! giveGenieChanceToEscape ^ self genieGestureProcessor notNil and: [self genieGestureProcessor giveChanceToEscape]! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! handleEventWithGenieEscaped: anEvent self isGenieEnabled ifTrue: [self genieGestureProcessor handleEventEscaped: anEvent] ifFalse: [self handleEvent: anEvent].! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! isGenieEnabled ^ self genieGestureProcessor notNil and: [self genieGestureProcessor isEnabled]! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! isGenieRecognizing ^ self genieGestureProcessor notNil and: [self genieGestureProcessor isRecognizing]! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 19:59'! prepareMouseFocusChangeFrom: oldMorph to: newMorph ^ self genieGestureProcessor isNil or: [self genieGestureProcessor prepareMouseFocusChangeFrom: oldMorph to: newMorph]! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 20:00'! resetGenie self genieGestureProcessor ifNotNil: [self genieGestureProcessor reset]! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 20:00'! switchGenieEnabled self ensureGenieGestureProcessor. self genieGestureProcessor switchEnabled.! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/19/2001 20:00'! switchGenieFocus: aMorph self genieGestureProcessor ifNotNil: [self genieGestureProcessor switchFocus: aMorph].! ! !HandMorph methodsFor: 'genie' stamp: 'NS 2/17/2001 11:01'! temporaryCursor ^ temporaryCursor! ! !PluggableTextMorph methodsFor: 'initialization' stamp: 'NS 2/18/2001 18:28'! initialize super initialize. hasUnacceptedEdits _ false. hasEditingConflicts _ false. askBeforeDiscardingEdits _ true. "Use the dictionary #Text for gestures" self onGestureUse: #Text send: #handleGesture: to: self.! ! !PluggableTextMorph methodsFor: 'genie-dispatching' stamp: 'NS 2/20/2001 20:50'! handleGesture: aCRGesture "Let the associated TextMorph handle the gesture. Add handling of special gestures (scrolling, ...) here and pass control to the TextMorph handler only if it's not already handled." ^ textMorph handleGesture: aCRGesture! ! !Project class methodsFor: 'utilities' stamp: 'NS 2/17/2001 10:07'! interruptName: labelString "Create a Notifier on the active scheduling process with the given label." | suspendingList projectProcess | Smalltalk isMorphic ifFalse: [^ ScheduledControllers interruptName: labelString]. World primaryHand ifNotNil: [World primaryHand releaseAllFoci. World primaryHand resetGenie]. projectProcess _ self uiProcess. "we still need the accessor for a while" (suspendingList _ projectProcess suspendingList) == nil ifTrue: [projectProcess == Processor activeProcess ifTrue: [projectProcess suspend]] ifFalse: [suspendingList remove: projectProcess. projectProcess offList]. Debugger openInterrupt: labelString onProcess: projectProcess ! ! !TextMorph methodsFor: 'genie-processing' stamp: 'NS 2/19/2001 20:47'! defaultGestureDictionaryOrName ^ #Text! ! !TextMorph methodsFor: 'genie-dispatching' stamp: 'NS 2/19/2001 18:06'! gestureHandler "If the TextMorph is part of a pane (like PluggableTextMorph), return it" | pane | pane _ self owner. [pane notNil] whileTrue: [(pane isKindOf: PluggableTextMorph) ifTrue: [^ pane]. pane _ pane owner]. ^ super gestureHandler! ! !TextMorph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 18:37'! handleGesture: aCRGesture "Handle the gesture and store the last handled gesture as lastGestureEvent. lastGestureEvent is used for undoing gestures" | handled | handled _ super handleGesture: aCRGesture. handled ifTrue: [self lastGesture: aCRGesture. ^ true]. (self modifyGesture: self lastGesture by: aCRGesture) ifTrue: [^ true]. (aCRGesture isCommand and: [aCRGesture normalizedChar = #alignment]) ifTrue: [self setAlignment: aCRGesture. ^ true]. ^ false.! ! !TextMorph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 18:36'! lastGesture ^ lastGesture! ! !TextMorph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 18:33'! lastGesture: aCRGesture "Store lastGestureEvent if it is undoable." lastGesture _ (self isGestureUndoable: aCRGesture) ifTrue: [aCRGesture] ! ! !TextMorph methodsFor: 'genie-dispatching' stamp: 'NS 2/18/2001 18:34'! setAlignment: aCRGesture "Sets the alignment of the TextMorph accoding to the cursorPoint of MorphicGestureEvent. If the point is at the left, it's left alignment. If in the center or or at the right, it's centered resp. right alignment. This is only one example of a tousands of possibilities how to integrate the gesure recognizer into the system" | min alignment newMin localX | localX _ (self globalPointToLocal: aCRGesture position) x. min _ localX abs. alignment _ #left. min > (newMin _ (localX - (self extent x // 2)) abs) ifTrue: [min _ newMin. alignment _ #centered]. min > (newMin _ (localX - self extent x) abs) ifTrue: [alignment _ #right]. alignment = #left ifTrue: [self leftFlush]. alignment = #centered ifTrue: [self centered]. alignment = #right ifTrue: [self rightFlush].! ! !TheWorldMenu methodsFor: 'construction' stamp: 'NS 2/15/2001 18:17'! helpMenu "Build the help menu for the world." | screenCtrl genieEnabledString | screenCtrl _ ScreenController new. genieEnabledString _ World currentHand isGenieEnabled ifTrue: ['disable'] ifFalse: ['enable']. ^self fillIn: (self menu: 'help...') from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {Utilities. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {Preferences. #openPreferencesInspector}. 'view and change various options.'}. nil. {genieEnabledString , ' genie'. {World currentHand. #switchGenieEnabled}. genieEnabledString , ' gesture recognizer for the world''s current hand'}. {'genie gesture dictionaries'. {CRDictionary. #openInstanceBrowserMorph}. 'edit or inspect gesture dictionaries'.}. {'genie display properties'. {CRDisplayProperties. #openInstanceBrowserMorph}. 'edit or inspect display properies'.}. nil. {'command-key help'. { Utilities . #openCommandKeyHelp}. 'summary of keyboard shortcuts.'}. {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { Utilities . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Smalltalk . #viewImageImports}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. {'standard graphics library' . { ScriptingSystem . #inspectFormDictionary}. 'lets you view and change the system''s standard library of graphics.'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { Preferences . #toggleSoundEnabling}. 'turning sound off will completely disable Squeak''s use of sound.'}. {'definition for...' . { Utilities . #lookUpDefinition}. 'if connected to the internet, use this to look up the definition of an English word.'}. nil. {'set author initials...' . { screenCtrl . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { screenCtrl . #vmStatistics}. 'obtain some intriguing data about the vm.'}. {'space left' . { screenCtrl . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}. } ! ! !UserInputEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:08'! addButtons: anInteger buttons _ buttons bitOr: anInteger! ! !UserInputEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:08'! toggleButtons: anInteger buttons _ buttons bitXor: anInteger! ! !UserInputEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:13'! toggleCommandKey self toggleButtons: 64! ! !UserInputEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:13'! toggleControlKey self toggleButtons: 16! ! !UserInputEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:14'! toggleMacOptionKey self toggleButtons: 32! ! !UserInputEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:14'! toggleShift self toggleButtons: 8! ! !MouseEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:10'! addMouseButtons: anInteger self addButtons: anInteger! ! !MouseEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:11'! toggleBlueButton self toggleMouseButtons: 1! ! !MouseEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:12'! toggleMouseButtons: anInteger self toggleButtons: anInteger! ! !MouseEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:12'! toggleRedButton self toggleMouseButtons: 4! ! !MouseEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:12'! toggleYellowButton self toggleMouseButtons: 2! ! !MouseButtonEvent methodsFor: 'genie' stamp: 'NS 2/14/2001 18:11'! addMouseButtons: anInteger super addMouseButtons: anInteger. whichButton bitOr: anInteger! ! !MouseButtonEvent methodsFor: 'genie' stamp: 'NS 2/18/2001 13:38'! toggleMouseButtons: anInteger super toggleMouseButtons: anInteger. whichButton _ whichButton bitXor: anInteger! ! !WorldState methodsFor: 'update cycle' stamp: 'NS 2/17/2001 09:48'! doOneCycleNowFor: aWorld | recognizing | "Do one cycle of the interactive loop. This method is called repeatedly when the world is running." recognizing _ false. self flag: #bob. "need to consider remote hands in lower worlds" "process user input events" LastCycleTime _ Time millisecondClockValue. self handsDo: [:h | activeHand _ h. h processEvents. h isGenieRecognizing ifTrue: [recognizing _ h giveGenieChanceToEscape not]. activeHand _ nil ]. "The gesture recognizer needs enough points to be accurate. Therefore morph stepping is disabled while capturing points for the recognizer" recognizing ifFalse: [aWorld runStepMethods]. "there are currently some variations here" self displayWorldSafely: aWorld. ! ! !TextMorph reorganize! ('initialization' beAllFont: configureForKids copy initialize releaseCachedState string:fontName:size: string:fontName:size:wrap:) ('accessing' asText contents contents: contents:wrappedTo: contentsAsIs: contentsWrapped: copyRecordingIn: currentDataValue editor fontName:size: getCharacters getFirstCharacter newContents: setCharacters: setFirstCharacter: setNumericValue: text textStyle userString) ('alignment' centered justified leftFlush rightFlush) ('drawing' drawBoundsOn: drawNullTextOn: drawOn:) ('editing' acceptContents cancelEdits chooseAlignment chooseEmphasis chooseEmphasisOrAlignment chooseFont chooseStyle clearTypeIn cornerStyle: handleEdit: handleInteraction:fromEvent: handleKeystroke: handlesKeyboard: handlesMouseDown: hasFocus hasUnacceptedEdits: keyStroke: keyboardFocusChange: mouseDown: mouseMove: mouseUp: passKeyboardFocusTo: xeqLinkText:withParameter:) ('printing' fullPrintOn:) ('geometry' bounds container containsPoint: defaultLineHeight extent: goBehind layoutChanged privateMoveBy: textBounds) ('menu' addCustomMenuItems:hand: followCurve reverseCurveDirection setCurveBaseline: shiftedYellowButtonActivity yellowButtonActivity) ('linked frames' addPredecessor: addSuccessor: firstCharacterIndex firstInChain isLinkedTo: lastCharacterIndex predecessor recomposeChain startingIndex successor withSuccessorsDo:) ('private' adjustLineIndicesBy: composeToBounds delete fit installEditor installEditorToReplace: loadCachedState paragraph paragraphClass predecessorChanged releaseEditor releaseParagraph selectionChanged setDefaultContentsIfNil setPredecessor: setSuccessor: text:textStyle: text:textStyle:wrap:color:predecessor:successor: updateFromParagraph updateReferencesUsing: wouldAcceptKeyboardFocusUponTab) ('object fileIn') ('containment' fillingOnOff occlusionsOnOff ownerChanged privateOwner: recognizerArena setContainer:) ('anchors' acceptDroppingMorph:event: addMorphFront:fromWorldPosition: privateRemoveMorph:) ('copying' veryDeepFixupWith: veryDeepInner:) ('scripting access' getAllButFirstCharacter getNumericValue setAllButFirstCharacter:) ('card & stack' couldHoldSeparateDataForEachInstance newContents:fromCard: setNewContentsFrom: variableDocks) ('genie-processing' defaultGestureDictionaryOrName) ('genie-dispatching' gestureHandler handleGesture: lastGesture lastGesture: setAlignment:) ! !HandMorph reorganize! ('initialization' initForEvents initialize) ('accessing' lastEvent mouseOverHandler targetOffset userInitials userPicture userPicture:) ('classification' isHandMorph) ('cursor' cursorBounds showTemporaryCursor: showTemporaryCursor:hotSpotOffset:) ('geometry' changed fullBounds invalidRect:from: position position: userInitials:andPicture:) ('drawing' colorForInsets drawOn: fullDrawOn: hasChanged hasUserInformation needsToBeDrawn nonCachingFullDrawOn: restoreSavedPatchOn: savePatchFrom: shadowForm shadowOffset trailMorph updateCacheCanvas:) ('event handling' checkForMoreKeyboard flushEvents handleEvent: noticeMouseOver:event: pauseEventRecorderIn: processEvents) ('focus handling' keyboardFocus keyboardFocus: mouseFocus mouseFocus: newKeyboardFocus: newMouseFocus: newMouseFocus:event: releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:) ('double click support' resetClickState waitForClicksOrDrag:event: waitForClicksOrDrag:event:selectors:threshold:) ('grabbing/dropping' attachMorph: dropMorph:event: dropMorphs dropMorphs: grabMorph: grabMorph:from: targetOffset:) ('listeners' addEventListener: addKeyboardListener: addListener:to: addMouseListener: eventListeners eventListeners: keyboardListeners keyboardListeners: mouseListeners mouseListeners: removeEventListener: removeKeyboardListener: removeListener:from: removeMouseListener:) ('balloon help' balloonHelp balloonHelp: deleteBalloonTarget: removePendingBalloonFor: spawnBalloonFor: triggerBalloonFor:after:) ('halo handling' halo halo: obtainHalo: releaseHalo: removeHaloFromClick:on: removePendingHaloFor: spawnHaloFor: triggerHaloFor:after:) ('paste buffer' copyToPasteBuffer: objectToPaste pasteBuffer pasteBuffer: pasteMorph) ('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: mouseTrailFrom: moveToEvent: sendEvent:focus: sendFocusEvent:to: sendListenEvent:to:) ('object fileIn') ('private' objectForDataStream: releaseCachedState veryDeepCopyWith:) ('genie' allowsGestureStart:target: disableGenie disableGenieFocus: enableGenie ensureGenieGestureProcessor genieGestureProcessor gestureStart:target: giveGenieChanceToEscape handleEventWithGenieEscaped: isGenieEnabled isGenieRecognizing prepareMouseFocusChangeFrom:to: resetGenie switchGenieEnabled switchGenieFocus: temporaryCursor) ! !Morph reorganize! ('initialization' initialExtent initialize intoWorld: openCenteredInWorld openInHand openInMVC openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openInWorld: outOfWorld: standardPalette) ('classification' isAlignmentMorph isBalloonHelp isFlap isFlapOrTab isFlapTab isFlashMorph isFlexMorph isHandMorph isModalShell isMorph isMorphicModel isPlayfieldLike isRenderer isSyntaxMorph isWorldMorph isWorldOrHandMorph) ('accessing' actorState actorState: actorStateOrNil asMorph balloonText balloonTextSelector: beSticky beUnsticky borderWidth borderWidth: color color: colorForInsets eventHandler eventHandler: forwardDirection hasTranslucentColor highlight highlightColor highlightColor: isLocked isShared isSticky lock lock: modelOrNil player player: regularColor regularColor: rememberedColor rememberedColor: sqkPage toggleStickiness unHighlight unlock unlockContents url userString) ('access properties' hasProperty: removeProperty: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifPresentDo:) ('copying' copy copyRecordingIn: copyWithoutSubmorphs deepCopy duplicate fullCopy fullCopyWithoutFormerOwner updateReferencesUsing: usableSiblingInstance veryDeepCopyWith: veryDeepCopyWithoutPlayer veryDeepFixupWith: veryDeepInner:) ('structure' activeHand allOwners allOwnersDo: bestGuessOfCurrentWorld currentHand firstOwnerSuchThat: hasOwner: isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph presenter primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world) ('submorphs-accessing' allKnownNames allMorphs allMorphsDo: allNonSubmorphMorphs findA: findDeepSubmorphThat:ifAbsent: findDeeplyA: firstSubmorph hasSubmorphWithProperty: hasSubmorphs indexOfMorphAbove: lastSubmorph morphsAt: morphsAt:behind:unlocked: morphsAt:unlocked: morphsAt:unlocked:do: rootMorphsAt: rootMorphsAtGlobal: shuffleSubmorphs submorphAfter submorphBefore submorphCount submorphNamed: submorphNamed:ifNone: submorphOfClass: submorphThat:ifNone: submorphWithProperty: submorphs submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo: submorphsSatisfying:) ('submorphs-add/remove' abandon addAllMorphs: addAllMorphs:after: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:behind: addMorph:fullFrame: addMorph:inFrontOf: addMorphBack: addMorphCentered: addMorphFront: addMorphFront:fromWorldPosition: addMorphNearBack: comeToFront copyWithoutSubmorph: delete deleteSubmorphsWithProperty: dismissViaHalo goBehind privateDelete removeAllMorphs removeAllMorphsIn: replaceSubmorph:by: submorphIndexOf:) ('drawing' areasRemainingToFill: boundingBoxOfSubmorphs changeClipSubmorphs clipLayoutCells clipLayoutCells: clipSubmorphs clipSubmorphs: clippingBounds doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawMouseDownHighlightOn: drawOn: drawOnCanvas: drawPostscriptOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flash fullDrawOn: fullDrawPostscriptOn: hasClipSubmorphsString hide highlightForMouseDown highlightForMouseDown: highlightedForMouseDown imageForm imageForm:forRectangle: imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: refreshWorld shadowForm show visible visible:) ('geometry' align:with: bottom bottom: bottomLeft bottomLeft: bottomRight bottomRight: bounds bounds: bounds:from: bounds:in: boundsIn: boundsInWorld center center: extent extent: fullBoundsInWorld globalPointToLocal: gridPoint: griddedPoint: height height: innerBounds left left: localPointToGlobal: minimumExtent minimumExtent: nextOwnerPage outerBounds point:from: point:in: pointFromWorld: pointInWorld: position position: positionInWorld positionSubmorphs previousOwnerPage right right: screenLocation screenRectangle setConstrainedPositionFrom: shiftSubmorphsBy: shiftSubmorphsOtherThan:by: top top: topLeft topLeft: topRight topRight: transformedBy: width width: worldBounds worldBoundsForHalo) ('rotate scale and flex' addFlexShell keepsTransform newTransformationMorph rotationDegrees) ('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer) ('geometry eToy' addTransparentSpacerOfSize: beTransparent cartesianBoundsTopLeft cartesianXY cartesianXY: color:sees: colorUnder degreesOfFlex forwardDirection: getIndexInOwner goHome heading heading: move:toPosition: referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: rotationCenter rotationCenter: setIndexInOwner: touchesColor: transparentSpacerOfSize: wrap x x: x:y: y y:) ('thumbnail' demandsThumbnailing morphRepresented permitsThumbnailing readoutForField: representativeNoTallerThan:norWiderThan:thumbnailHeight: updateThumbnailUrl updateThumbnailUrlInBook:) ('dropping/grabbing' aboutToBeGrabbedBy: asDraggableMorph disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDrag: enableDragNDrop enableDragNDrop: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform highlightForDrop highlightForDrop: highlightedForDrop justDroppedInto:event: rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: toggleDragNDrop transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded) ('event handling' click click: cursorPoint doubleClick: dropFiles: handlesKeyboard: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: handlesMouseStillDown: hasFocus keyDown: keyStroke: keyUp: keyboardFocusChange: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseStillDown: mouseStillDownThreshold mouseUp: on:send:to: on:send:to:withValue: removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler transformFrom: transformFromOutermostWorld transformFromWorld wantsDropFiles: wantsEveryMouseMove wantsKeyboardFocusFor: wouldAcceptKeyboardFocus wouldAcceptKeyboardFocusUponTab) ('pen' choosePenColor: choosePenSize getPenColor getPenDown getPenSize liftPen lowerPen penColor: penUpWhile: trailMorph) ('naming' choosePartName defaultNameStemForInstances downshiftedNameOfObjectRepresented externalName innocuousName knownName name: nameForFindWindowFeature nameInModel nameOfObjectRepresented renameTo: setNamePropertyTo: setNameTo: specialNameInModel tryToRenameTo: updateAllScriptingElements) ('stepping and presenter' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startStepping:at:arguments:stepTime: startSteppingIn: startSteppingSelector: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps) ('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addFillStyleMenuItems:hand: addPaintingItemsTo:hand: addTitleForHaloMenu: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: allMenuWordings changeColor changeDragAndDrop chooseNewGraphic chooseNewGraphicCoexisting: chooseNewGraphicFromHalo collapse doMenuItem: hasDragAndDropEnabledString inspectInMorphic inspectInMorphic: lockUnlockMorph lockedString makeNascentScript maybeAddCollapseItemTo: menuItemAfter: menuItemBefore: printPSToFile printPSToFileNamed: putOnBackground putOnForeground resetForwardDirection setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch) ('halos and balloon help' addHalo addHalo: addHalo:from: addHaloFor: addHandlesTo:box: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: boundsForBalloon comeToFrontAndAddHalo defaultBalloonColor defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: isLikelyRecipientForMouseOverHalos mightEntertainDirectionHandles mouseDownOnHelpHandle: noHelpString okayToAddGrabHandle removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon: showBalloon:hand: transferHalo:from: wantsBalloon wantsDirectionHandles wantsHalo wantsHaloFor: wantsHaloFromClick wantsScriptorHaloHandle) ('change reporting' changed colorChangedForSubmorph: invalidRect: invalidRect:from: ownerChanged userSelectedColor:) ('player' assureExternalName assuredPlayer currentDataValue newPlayerInstance okayToDuplicate showPlayerMenu variableDocks) ('player commands' beep beep: jumpTo: makeFenceSound set:) ('player viewer' openViewerForArgument updateLiteralLabel) ('scripting' asEmptyPermanentScriptor categoriesForViewer categoryElementsFor: instantiatedUserScriptsDo: isTileLike isTileScriptingElement jettisonScripts makeAllTilesColored makeAllTilesGreen restoreTypeColor scriptEditorFor: scriptPerformer tearOffTile updatingTileForArgType:partName:getSelector:putSelector: useUniformTileColor viewAfreshIn:showingScript:at:) ('e-toy support' adaptToWorld: allMorphsAndBookPagesInto: appearsToBeSameCostumeAs: asNumber: asWearableCostume automaticViewing configureForKids containingWindow copyCostumeStateFrom: couldHoldSeparateDataForEachInstance creationStamp currentPlayerDo: cursor cursor: defaultValueOrNil defaultVariableName definePath deletePath embedInWindow embeddedInMorphicWindowLabeled: enforceTileColorPolicy fenceEnabled followPath getNumericValue goToNextCardInStack goToPreviousCardInStack gridFormOrigin:grid:background:line: holdsSeparateDataForEachInstance isAViewer isCandidateForAutomaticViewing isStackBackground listViewLineForFieldList: makeGraphPaper makeGraphPaperGrid:background:line: makeHoldSeparateDataForEachInstance mustBeBackmost nextPageButton noteNegotiatedName:for: objectViewed previousPageButton referencePlayfield rotationStyle rotationStyle: setAsDefaultValueForNewCard setNumericValue: setStandardTexture slotSpecifications stack stackDo: stopHoldingSeparateDataForEachInstance succeededInRevealing: textureParameters unlockOneSubpart updateCachedThumbnail wrappedInWindow: wrappedInWindowWithTitle:) ('button') ('parts bin' inPartsBin isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin) ('printing' asEPS asPostscript asPostscriptPrintJob clipPostscript colorString: constructorString defaultLabelForInspector fullPrintOn: initString pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: structureString textToPaste) ('property extension' assureExtension copyPropertiesFrom:dict: extension otherProperties resetExtension) ('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState) ('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: altSpecialCursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators inspectArgumentsPlayerInMorphic: inspectOwnerChain installModelIn: ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: programmedMouseUp:for:with: removeMouseUpAction reportableSize resumeAfterDrawError resumeAfterStepError tempCommand) ('private' moveWithPenDownBy: moveWithPenDownByRAA: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFullMoveBy: privateMoveBy: privateOwner: privateRemoveMorph: privateRemoveMorphWithAbsolutelyNoSideEffects: privateSubmorphs privateSubmorphs:) ('fileIn/out' attachToResource objectForDataStream: prepareToBeSaved reserveUrl: saveAsResource saveDocPane saveOnFile saveOnURL saveOnURL: saveOnURLbasic storeDataOn: updateAllFromResources updateFromResource) ('object fileIn' convertAugust1998:using: convertNovember2000DropShadow:using: convertToCurrentVersion:refStream:) ('visual properties' canHaveFillStyles canSetColor cornerStyle defaultColor fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill) ('texture support' asTexture installAsWonderlandTextureOn: isValidWonderlandTexture isValidWonderlandTexture: mapPrimitiveVertex: wonderlandTexture wonderlandTexture:) ('WiW support' addMorphInFrontOfLayer: addMorphInLayer: eToyRejectDropMorph:event: morphicLayerNumber randomBoundsFor: shouldGetStepsFrom: worldMorphsDo: worldUnderCursor) ('rounding' roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners) ('undo' commandHistory undoMove:redo:owner:bounds:predecessor:) ('events-alarms' addAlarm:after: addAlarm:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: addAlarm:withArguments:after: addAlarm:withArguments:at: alarmScheduler removeAlarm: removeAlarm:at:) ('events-processing' containsPoint:event: defaultEventDispatcher handleDropFiles: handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleUnknownEvent: handlerForMouseDown: mouseDownPriority processEvent: processEvent:using: rejectDropEvent: rejectsEvent: transformedFrom:) ('meta-actions' applyStatusToAllSiblings: beThisWorldsModel blueButtonDown: blueButtonUp: bringAllSiblingsToMe: buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph: duplicateMorph: embedInto: grabMorph: handlerForBlueButtonDown: handlerForMetaMenu: inspectAt:event: invokeMetaMenu: invokeMetaMenuAt:event: makeMultipleSiblings: makeNewPlayerInstance: makeSiblings: makeSiblingsLookLikeMe: maybeDuplicateMorph: potentialEmbeddingTargets resizeMorph: saveAsPrototype showActions showHiders subclassMorph) ('testing' canDrawAtHigherResolution completeModificationHash isFlexed modificationHash) ('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadow: hasDropShadowString hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow) ('layout' acceptDroppingMorph:event: adjustLayoutBounds doLayoutIn: fullBounds layoutBounds layoutBounds: layoutChanged layoutInBounds: layoutProportionallyIn: minExtent minHeight minHeight: minWidth minWidth: privateFullBounds submorphBounds) ('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from:) ('layout-properties' assureLayoutProperties assureTableProperties cellInset cellInset: cellPositioning cellPositioning: cellPositioningString: cellSpacing cellSpacing: cellSpacingString: disableTableLayout disableTableLayout: hResizing hResizing: hResizingString: layoutFrame layoutFrame: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: listCentering listCentering: listCenteringString: listDirection listDirection: listDirectionString: listSpacing listSpacing: listSpacingString: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: vResizing vResizing: vResizingString: wrapCentering wrapCentering: wrapCenteringString: wrapDirection wrapDirection: wrapDirectionString:) ('piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll) ('genie-menu' addGenieMenuItems:hand: changeGestureDictionary hasNotExportedGestureDictionary hasReferencedGestureDictionary inspectGestureDictionary makeOwnCopyOfGestureDictionary makeOwnSubGestureDictionary) ('genie-dispatching' blueButtonClickHand:shift: gesture: gestureCode: gestureCommand: gestureKeystrokes: gestureMouseEvent: gestureStrokes: handleGesture: isGestureUndoable: isSpecialCharacterUndoable: modifyGesture:by: undoGesture:) ('genie-processing' allowsGestureEscape allowsGesturePreprocessing defaultGestureDictionaryOrName disableGestures gestureDictionary gestureDictionaryOrName gestureDictionaryOrName: gestureHandler gestureStart: handlesGestureStart: onGestureUse:send:to:) ! !CRGestureProcessor reorganize! ('error handling' doesNotUnderstand:) ('initialize-release' initializeHand:enabled:) ('private' addToRecognizerAndGiveChanceToEscape: allowsMouseAction:target: disableFocus doMouseActionEvent:target: escapeFromRecognizer: escapedDo: giveChanceToEscape: inverseTransformation:target: modifiedMouseActionEvent: modifiedStartEvent: preprocessGesture: processGestureFeature:at:dictionary:startEvent: releaseMouseFocus simulateEvent: stopRecognizer stopRecognizerAndDispatch: updateMouseActionButton:) ('accessing' disableFocus: disableGenie enableFocus: enableGenie gestureStart:target: giveChanceToEscape handleEventEscaped: inspectLastGesture prepareMouseFocusChangeFrom:to: reset switchEnabled switchFocus:) ('testing' allowsGestureStart:target: isEnabled isEscaped isFocused isFocused: isRecognizing) ('event processing' handleEvent: handleFocusEvent: handleMouseDown: handleMouseMove: handleMouseUp:) ! !CRGesture reorganize! ('private' lookupResult:) ('lookup result accessing' charAt: charTypeAt: correspondingKeystrokes correspondingKeystrokesAt: correspondingMouseEvents correspondingMouseEventsAt: correspondsToKeystrokes correspondsToKeystrokesAt: correspondsToMouseEvents correspondsToMouseEventsAt: distanceAt: evaluateCodeAt: featureAt: isCodeAt: isCommandAt: isStrokesAt: lookupIndex lookupIndex: lookupResult nextDistinctCharMatch nextDistinctCharMatchRollover: nextMatch nextMatchRollover: normalizedCharAt:) ('testing' anyModifierKeyPressed commandKeyPressed controlKeyPressed isAlert isCode isCommand isReject isStrokes macOptionKeyPressed shiftPressed) ('accessing' buttons capturedFeature char charType coordinates correspondingKeystrokeEvents correspondingKeystrokeEventsAt: cursorPoint dictionary distance evaluateCode feature hand keystrokeEventFor: normalizedChar position startEvent target toggleCommandKey toggleControlKey toggleMacOptionKey toggleShift) ('initialize-release' initializeCapturedFeature:at:dictionary:startEvent:target:) !