SystemOrganization addCategory: #CustomEvents! !Vocabulary class methodsFor: '*customevents-custom events' stamp: 'nk 8/18/2004 17:56'! newCustomEventsVocabulary ^UserCustomEventNameType new. ! ! !Vocabulary class methodsFor: '*customevents-custom events' stamp: 'nk 8/21/2004 19:58'! customEventsVocabulary "Vocabulary customEventsVocabulary" ^(self vocabularyNamed: #CustomEvents) ifNil: [ self addCustomEventsVocabulary ] ! ! !Vocabulary class methodsFor: '*customevents-custom events' stamp: 'nk 8/18/2004 17:57'! addCustomEventsVocabulary | vocab | self addStandardVocabulary: (vocab := self newCustomEventsVocabulary). SymbolListTile updateAllTilesForVocabularyNamed: #CustomEvents. ^vocab! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 9/26/2003 23:22'! userCustomEventNames ^ self currentWorld userCustomEventNames! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 7/20/2003 12:37'! removeCustomEventNamed: aSymbol for: registrant | registration helpString | registration _ self customEventsRegistry at: aSymbol ifAbsent: [ ^nil ]. helpString _ registration removeKey: registrant ifAbsent: []. registration isEmpty ifTrue: [ self customEventsRegistry removeKey: aSymbol ]. ^helpString! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 7/20/2003 12:33'! addCustomEventFor: registrant named: aSymbol help: helpString | registration | registration _ self customEventsRegistry at: aSymbol ifAbsentPut: [ IdentityDictionary new ]. registration at: registrant put: helpString. ! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 10/12/2003 13:14'! customEventsRegistry ^Smalltalk at: #CustomEventsRegistry ifAbsentPut: [ IdentityDictionary new ].! ! !StandardScriptingSystem methodsFor: '*customevents-help dictionary' stamp: 'nk 8/18/2004 18:02'! statusHelpString ^String streamContents: [ :stream | stream nextPutAll: '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' translated. "'keyStroke -- run when user hits a key' " stream cr; cr; nextPutAll: 'Global events:' translated; cr. self customEventsRegistry keysAndValuesDo: [ :key :value | stream cr; nextPutAll: key; nextPutAll: ' -- '. value do: [ :help | stream nextPutAll: help translated ] separatedBy: [ stream nextPutAll: ' or ' translated ]]. (Preferences allowEtoyUserCustomEvents) ifTrue: [ self userCustomEventNames isEmpty ifFalse: [ stream cr; cr; nextPutAll: 'User custom events:' translated; cr. self currentWorld userCustomEventsRegistry keysAndValuesDo: [ :key :value | stream cr; nextPutAll: key; nextPutAll: ' -- '; nextPutAll: value ]]]. ]! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 6/30/2004 18:16'! standardEventStati "Answer the events that can be directed to a particular morph by its event handler." ^ #(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" "keyStroke" "gesture" ) ! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 9/26/2003 23:30'! globalCustomEventNames ^self customEventsRegistry keys asArray sort! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 9/26/2003 23:23'! addUserCustomEventNamed: aSymbol help: helpString self currentWorld addUserCustomEventNamed: aSymbol help: helpString. "Vocabulary addStandardVocabulary: UserCustomEventNameType new." Vocabulary customEventsVocabulary. SymbolListTile updateAllTilesForVocabularyNamed: #CustomEvents! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 9/26/2003 23:31'! customEventStati ^self globalCustomEventNames, self userCustomEventNames! ! !StandardScriptingSystem methodsFor: '*customevents-custom events' stamp: 'nk 9/26/2003 23:26'! removeUserCustomEventNamed: eventName | retval | retval _ self currentWorld removeUserCustomEventNamed: eventName. "Vocabulary addStandardVocabulary: UserCustomEventNameType new." Vocabulary customEventsVocabulary. SymbolListTile updateAllTilesForVocabularyNamed: #CustomEvents. ^retval! ! !Morph class methodsFor: '*customevents-user events' stamp: 'nk 8/18/2004 18:02'! additionsToViewerCategoryUserEvents "Answer viewer additions relating to user-defined events for the 'scripting' category" ^(Preferences allowEtoyUserCustomEvents) ifTrue: [ #(scripting ((command triggerCustomEvent: 'trigger a user-defined (global) event' CustomEvents))) ] ifFalse: [ #(scripting ()) ] ! ! !Morph methodsFor: '*customevents-scripting' stamp: 'nk 9/24/2003 17:31'! instantiatedUserScriptsDo: aBlock self actorStateOrNil ifNotNilDo: [ :aState | aState instantiatedUserScriptsDictionary do: aBlock]! ! !Morph methodsFor: '*customevents-scripting' stamp: 'nk 9/25/2003 11:36'! removeAllEventTriggers "Remove all the event registrations for my Player. User custom events are triggered at the World, while system custom events are triggered on individual Morphs." | player | (player _ self player) ifNil: [ ^self ]. self removeAllEventTriggersFor: player. self currentWorld removeAllEventTriggersFor: player.! ! !Morph methodsFor: '*customevents-scripting' stamp: 'nk 9/24/2003 17:46'! removeAllEventTriggersFor: aPlayer "Remove all the event registrations for aPlayer. User custom events are triggered at the World, while system custom events are triggered on individual Morphs." self removeActionsSatisfying: [:action | action receiver == aPlayer and: [(#(#doScript: #triggerScript:) includes: action selector) ]].! ! !Morph methodsFor: '*customevents-scripting' stamp: 'nk 9/25/2003 11:11'! renameScriptActionsFor: aPlayer from: oldSelector to: newSelector self updateableActionMap keysAndValuesDo: [ :event :sequence | sequence asActionSequence do: [ :action | ((action receiver == aPlayer) and: [ (#(doScript: triggerScript:) includes: action selector) and: [ action arguments first == oldSelector ]]) ifTrue: [ action arguments at: 1 put: newSelector ]]] ! ! !Morph methodsFor: '*customevents-scripting' stamp: 'nk 9/25/2003 11:37'! removeEventTrigger: aSymbol "Remove all the event registrations for my Player that are triggered by aSymbol. User custom events are triggered at the World, while system custom events are triggered on individual Morphs." | player | (player _ self player) ifNil: [ ^self ]. self removeEventTrigger: aSymbol for: player. self currentWorld removeEventTrigger: aSymbol for: player.! ! !Morph methodsFor: '*customevents-scripting' stamp: 'nk 9/25/2003 11:24'! removeEventTrigger: aSymbol for: aPlayer "Remove all the event registrations for aPlayer that are triggered by aSymbol. User custom events are triggered at the World, while system custom events are triggered on individual Morphs." self removeActionsSatisfying: [:action | action receiver == aPlayer and: [(#(#doScript: #triggerScript: ) includes: action selector) and: [action arguments first == aSymbol]]]! ! !Morph methodsFor: '*customevents-scripting' stamp: 'nk 9/25/2003 11:37'! triggerCustomEvent: aSymbol "Trigger whatever scripts may be connected to the custom event named aSymbol" self currentWorld triggerEvent: aSymbol! ! ScrollPane subclass: #AlansTextPlusMorph instanceVariableNames: 'theTextMorph thePasteUp' classVariableNames: '' poolDictionaries: '' category: 'Morphic-GeeMail'! !AlansTextPlusMorph methodsFor: '*customevents-access' stamp: 'nk 10/12/2003 13:22'! visibleMorphs "Answer a collection of morphs that were visible as of the last step" ^Array withAll: (self valueOfProperty: #visibleMorphs ifAbsentPut: [ WeakArray new ]).! ! !AlansTextPlusMorph class methodsFor: '*customevents-class initialization' stamp: 'nk 7/20/2003 12:34'! initialize "AlansTextPlusMorph initialize" ScriptingSystem addCustomEventFor: self named: #scrolledIntoView help: 'when I am scrolled into view in a GeeMailMorph'. ScriptingSystem addCustomEventFor: self named: #scrolledOutOfView help: 'when I am scrolled out of view in a GeeMailMorph'. ! ! !AlansTextPlusMorph methodsFor: '*customevents-stepping and presenter' stamp: 'nk 10/12/2003 13:23'! step "For each submorph of thePasteUp that has just been scrolled into view, fire the script named #scrolledIntoView, if any. For each submorph of thePasteUp that has just been scrolled out of view, fire the script named #scrolledOutOfView, if any." | lastVisible nowVisible newlyVisible newlyInvisible | super step. lastVisible _ self visibleMorphs. nowVisible _ (thePasteUp submorphs copyWithoutAll: (self allTextPlusMorphs)) select: [ :m | self bounds intersects: (m boundsIn: self world) ]. newlyInvisible _ lastVisible difference: nowVisible. newlyInvisible do: [ :ea | ea triggerEvent: #scrolledOutOfView ]. newlyVisible _ nowVisible difference: lastVisible. newlyVisible do: [ :ea | ea triggerEvent: #scrolledIntoView ]. self visibleMorphs: nowVisible. ! ! !AlansTextPlusMorph methodsFor: '*customevents' stamp: 'nk 10/12/2003 13:23'! releaseCachedState super releaseCachedState. self removeProperty: #visibleMorphs! ! !AlansTextPlusMorph methodsFor: '*customevents-access' stamp: 'nk 10/12/2003 13:22'! visibleMorphs: morphs "Answer a collection of morphs that were visible as of the last step" self setProperty: #visibleMorphs toValue: (WeakArray withAll: morphs)! ! !AlansTextPlusMorph class methodsFor: '*customevents-class initialization' stamp: 'nk 7/20/2003 12:36'! unload ScriptingSystem removeCustomEventNamed: #scrolledIntoView for: self. ScriptingSystem removeCustomEventNamed: #scrolledOutOfView for: self.! ! !SymbolListTile class methodsFor: '*customevents-updating' stamp: 'nk 7/21/2003 22:16'! updateAllTilesForVocabularyNamed: aVocabularyName "The choices in the Vocabulary named aVocabularyName may have changed. Update my subinstances if necessary to reflect the changes." (self allSubInstances select: [ :ea | ea dataType = aVocabularyName ]) do: [ :ea | ea updateChoices ] ! ! !SymbolListTile methodsFor: '*customevents-accessing' stamp: 'nk 7/21/2003 22:02'! dataType ^dataType! ! !SymbolListTile methodsFor: '*customevents-initialization' stamp: 'nk 7/21/2003 22:14'! updateChoices choices _ (Vocabulary vocabularyNamed: dataType) choices. (choices includes: literal) ifFalse: [ literal _ choices first. self changed ]! ! !Player methodsFor: '*customevents-scripts-kernel' stamp: 'nk 9/25/2003 11:38'! renameScript: oldSelector newSelector: newSelector "Rename the given script to have the new selector" | aUserScript anInstantiation aDict | oldSelector = newSelector ifTrue: [^ self]. oldSelector numArgs == 0 ifTrue: [self class allSubInstancesDo: [:aPlayer | | itsCostume | anInstantiation _ aPlayer scriptInstantiationForSelector: oldSelector. newSelector numArgs == 0 ifTrue: [anInstantiation changeSelectorTo: newSelector]. aDict _ aPlayer costume actorState instantiatedUserScriptsDictionary. itsCostume _ aPlayer costume renderedMorph. itsCostume renameScriptActionsFor: aPlayer from: oldSelector to: newSelector. self currentWorld renameScriptActionsFor: aPlayer from: oldSelector to: newSelector. aDict removeKey: oldSelector. newSelector numArgs == 0 ifTrue: [aDict at: newSelector put: anInstantiation. anInstantiation assureEventHandlerRepresentsStatus]]] ifFalse: [newSelector numArgs == 0 ifTrue: [self class allSubInstancesDo: [:aPlayer | anInstantiation _ aPlayer scriptInstantiationForSelector: newSelector. anInstantiation assureEventHandlerRepresentsStatus]]]. aUserScript _ self class userScriptForPlayer: self selector: oldSelector. aUserScript renameScript: newSelector fromPlayer: self. "updates all script editors, and inserts the new script in my scripts directory" self class removeScriptNamed: oldSelector. ((self existingScriptInstantiationForSelector: newSelector) notNil and: [newSelector numArgs > 0]) ifTrue: [self error: 'ouch']. self updateAllViewersAndForceToShow: 'scripts'! ! !Player methodsFor: '*customevents-misc' stamp: 'nk 9/24/2003 18:26'! noteDeletionOf: aMorph fromWorld: aWorld "aMorph, while pointing to me as its costumee, has been deleted" "This may be too aggressive because deletion of a morph may not really mean deletion of its associated player -- in light of hoped-for multiple viewing" | viewers scriptors viewerFlaps | viewers _ OrderedCollection new. viewerFlaps _ OrderedCollection new. scriptors _ OrderedCollection new. aWorld allMorphs do: [:m | m isAViewer ifTrue: [viewers add: m]. ((m isKindOf: ViewerFlapTab) and: [m scriptedPlayer == self]) ifTrue: [viewerFlaps add: m]. ((m isKindOf: ScriptEditorMorph) and: [m myMorph == aMorph]) ifTrue: [scriptors add: m]]. aMorph removeAllEventTriggersFor: self. aWorld removeAllEventTriggersFor: self. viewers do: [:v | v noteDeletionOf: aMorph]. viewerFlaps do: [:v | v dismissViaHalo]. scriptors do: [:s | s privateDelete] ! ! !Player methodsFor: '*customevents-scripts-kernel' stamp: 'nk 8/18/2004 17:40'! pacifyScript: aSymbol "Make sure the script represented by the symbol doesn't do damage by lingering in related structures on the morph side" | aHandler aUserScript | aUserScript _ self class userScriptForPlayer: self selector: aSymbol. aUserScript ifNil: [self flag: #deferred. ^ Beeper beep]. "Maddeningly, without this line here the thing IS nil and the debugger is in a bad state (the above note dates from 1/12/99 ?!!" self class allInstancesDo: [:aPlayer | | itsCostume | aPlayer actorState instantiatedUserScriptsDictionary removeKey: aSymbol ifAbsent: []. itsCostume _ aPlayer costume renderedMorph. (aHandler _ itsCostume eventHandler) ifNotNil: [aHandler forgetDispatchesTo: aSymbol]. itsCostume removeEventTrigger: aSymbol ]! ! !Player methodsFor: '*customevents-scripts-kernel' stamp: 'nk 9/25/2003 11:53'! existingScriptInstantiationForSelector: scriptName "Answer the existing script instantiation for the given selector, or nil if none" scriptName ifNil: [^ nil]. Symbol hasInterned: scriptName ifTrue: [ :sym | self costume actorStateOrNil ifNotNilDo: [ :actorState | ^actorState instantiatedUserScriptsDictionary at: sym ifAbsent: [nil]]]. ^ nil! ! !Player methodsFor: '*customevents-custom events' stamp: 'nk 8/26/2003 10:50'! triggerCustomEvent: aSymbol "Trigger whatever scripts may be connected to the custom event named aSymbol" self costume renderedMorph triggerCustomEvent: aSymbol! ! !Player methodsFor: '*customevents-misc' stamp: 'nk 9/24/2003 17:32'! actorState "Answer the receiver's actorState, creating one if necessary." ^ self costume actorState! ! !Player methodsFor: '*customevents-scripts-kernel' stamp: 'nk 9/24/2003 17:36'! instantiatedUserScriptsDo: aBlock "Evaluate aBlock on behalf of all the instantiated user scripts in the receiver" | aState aCostume | ((aCostume _ self costume) notNil and: [(aState _ aCostume actorStateOrNil) notNil]) ifTrue: [aState instantiatedUserScriptsDictionary do: aBlock]! ! !Player methodsFor: '*customevents-costume' stamp: 'nk 9/24/2003 17:33'! costume: aMorph "Make aMorph be the receiver's current costume" | itsBounds | costume == aMorph ifTrue: [^ self]. costume ifNotNil: [self rememberCostume: costume renderedMorph. itsBounds _ costume bounds. (costume ownerThatIsA: HandMorph orA: PasteUpMorph) replaceSubmorph: costume topRendererOrSelf by: aMorph. aMorph position: itsBounds origin. aMorph actorState: costume actorStateOrNil. aMorph setNameTo: costume externalName]. aMorph player: self. costume _ aMorph. aMorph arrangeToStartStepping! ! !Player methodsFor: '*customevents-custom events' stamp: 'nk 8/21/2004 12:51'! triggerScript: aSymbol "Perform the script of the given name, which is guaranteed to exist. However, it's possible that the script may still result in a DNU, which will be swallowed and reported to the Transcript." ^ [self perform: aSymbol] on: MessageNotUnderstood do: [:ex | ScriptingSystem reportToUser: (String streamContents: [:s | s nextPutAll: self externalName; nextPutAll: ': exception in script '; print: aSymbol; nextPutAll: ' : '; print: ex]). ex return: self "ex pass"]! ! !ScriptEditorMorph methodsFor: '*customevents-other' stamp: 'nk 6/12/2004 14:23'! explainStatusAlternatives (StringHolder new contents: ScriptingSystem statusHelpString) openLabel: 'Script Status' translated! ! !ScriptEditorMorph methodsFor: '*customevents-buttons' stamp: 'nk 4/23/2004 07:28'! actuallyDestroyScript "Carry out the actual destruction of the associated script." | aHandler itsCostume | self delete. playerScripted class removeScriptNamed: scriptName. playerScripted actorState instantiatedUserScriptsDictionary removeKey: scriptName ifAbsent: []. "not quite enough yet in the multiple-instance case..." itsCostume _ playerScripted costume. (aHandler _ itsCostume renderedMorph eventHandler) ifNotNil: [aHandler forgetDispatchesTo: scriptName]. itsCostume removeActionsSatisfying: [ :act | act receiver == playerScripted and: [ act selector == scriptName ]]. itsCostume currentWorld removeActionsSatisfying: [ :act | act receiver == playerScripted and: [ act selector == scriptName ]]. playerScripted updateAllViewersAndForceToShow: ScriptingSystem nameForScriptsCategory! ! !Preferences class methodsFor: '*customevents-preferences' stamp: 'nk 8/18/2004 18:01'! allowEtoyUserCustomEvents ^ (self valueOfFlag: #allowEtoyUserCustomEvents ifAbsent: [false]) and: [ self eToyFriendly not ]! ! !PasteUpMorph methodsFor: '*customevents-scripting' stamp: 'nk 9/26/2003 23:18'! userCustomEventsRegistry ^self valueOfProperty: #userCustomEventsRegistry ifAbsentPut: [ IdentityDictionary new ].! ! !PasteUpMorph methodsFor: '*customevents-scripting' stamp: 'nk 9/26/2003 23:24'! addUserCustomEventNamed: aSymbol help: helpString self userCustomEventsRegistry at: aSymbol put: helpString. ! ! !PasteUpMorph methodsFor: '*customevents-scripting' stamp: 'nk 9/26/2003 23:26'! removeUserCustomEventNamed: aSymbol ^self userCustomEventsRegistry removeKey: aSymbol ifAbsent: [].! ! !PasteUpMorph methodsFor: '*customevents-scripting' stamp: 'nk 9/26/2003 23:20'! userCustomEventNames | reg | reg _ self valueOfProperty: #userCustomEventsRegistry ifAbsent: [ ^#() ]. ^reg keys asArray sort! ! SymbolListType subclass: #UserCustomEventNameType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CustomEvents'! !UserCustomEventNameType commentStamp: 'nk 6/12/2004 14:09' prior: 0! This is a data type that enumerates user-defined custom event names. You can turn off the display of such events in the script status popups by turning off the allowEtoyUserCustomEvents Preference.! !UserCustomEventNameType methodsFor: 'tiles' stamp: 'nk 8/18/2004 17:48'! representsAType "Answer whether this vocabulary represents an end-user-sensible data type" ^true! ! !UserCustomEventNameType methodsFor: 'queries' stamp: 'nk 9/26/2003 23:36'! choices "Answer an alphabetized list of known user custom event selectors" | choices | choices _ ScriptingSystem userCustomEventNames. ^choices isEmpty ifTrue: [ #('no event') ] ifFalse: [ choices ]! ! !UserCustomEventNameType class methodsFor: 'class initialization' stamp: 'nk 8/18/2004 18:02'! initialize Vocabulary embraceAddedTypeVocabularies. Preferences addPreference: #allowEtoyUserCustomEvents categories: #('scripting') default: false balloonHelp: 'If true, you can define your own events that can trigger scripts within a World.' projectLocal: false changeInformee: self changeSelector: #allowEtoyUserCustomEventsPreferenceChanged! ! !UserCustomEventNameType class methodsFor: 'class initialization' stamp: 'nk 6/12/2004 14:18'! allowEtoyUserCustomEventsPreferenceChanged Cursor wait showWhile: [ Vocabulary changeMadeToViewerAdditions ]! ! !UserCustomEventNameType methodsFor: 'initialization' stamp: 'nk 7/21/2003 20:42'! initialize "Initialize the CustomEvents vocabulary" super initialize. self vocabularyName: #CustomEvents! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 6/12/2004 14:23'! explainStatusAlternatives "Open a little window that explains the various status alternatives " (StringHolder new contents: ScriptingSystem statusHelpString) openLabel: 'Script Status' translated! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 9/25/2003 11:38'! status: newStatus "Set the receiver's status as indicated" | stati actualMorph | actualMorph := player costume renderedMorph. "standard (EventHandler) events" stati := ScriptingSystem standardEventStati. (stati includes: status) ifTrue: [actualMorph on: status send: nil to: nil "remove old link in event handler"]. (stati includes: newStatus) ifTrue: [actualMorph on: newStatus send: selector to: player. "establish new link in evt handler" player assureNoScriptOtherThan: self hasStatus: newStatus]. "user custom events are triggered at the World, while system custom events are triggered on individual Morphs." self removeEventTriggersForMorph: actualMorph. stati := ScriptingSystem customEventStati. (stati includes: newStatus) ifTrue: [(ScriptingSystem userCustomEventNames includes: newStatus) ifTrue: [self currentWorld when: newStatus send: #triggerScript: to: player withArguments: { selector}] ifFalse: [actualMorph when: newStatus evaluate: (MessageSend receiver: player selector: #triggerScript: arguments: { selector})]]. status := newStatus. self pausedOrTicking ifTrue: [lastTick := nil]. self flag: #arNote. "this from fall 2000" self flag: #workaround. "Code below was in #chooseTriggerFrom: which did not reflect status changes from other places (e.g., the stepping/pause buttons). It is not clear why this is necessary though - theoretically, any morph should step when it has a player but alas!! something is broken and I have no idea why and where." "14 feb 2001 - bob - I reinstated this after alan noticed that a newly drawn car would not go until you picked it up and dropped it. The reason is that unscripted players have #wantSteps ^false. If a morph enters the world with an unscripted player and then acquires a scripted player, that would be a good time to change, but this will work too" status == #ticking ifTrue: [player costume isStepping ifFalse: [player costume arrangeToStartStepping]]! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 7/21/2003 20:07'! defineNewEvent | newEventName newEventHelp | "Prompt the user for the name of a new event and install it into the custom event table" newEventName _ FillInTheBlankMorph request: 'What is the name of your new event?'. newEventName isEmpty ifTrue: [ ^self ]. newEventName _ newEventName asSymbol. (ScriptingSystem customEventStati includes: newEventName) ifTrue: [ self inform: 'That event is already defined.'. ^self ]. newEventHelp _ FillInTheBlankMorph request: 'Please describe this event:'. ScriptingSystem addUserCustomEventNamed: newEventName help: newEventHelp.! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 9/25/2003 11:35'! removeEventTriggersForMorph: actualMorph "user custom events are triggered at the World, while system custom events are triggered on individual Morphs." actualMorph removeActionsSatisfying: [:action | action receiver == player and: [(#(#doScript: #triggerScript:) includes: action selector) and: [action arguments first == selector]]] forEvent: status. self currentWorld removeActionsSatisfying: [:action | action receiver == player and: [(#(#doScript: #triggerScript:) includes: action selector) and: [action arguments first == selector]]] forEvent: status! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 6/30/2004 19:00'! addStatusChoices: choices toMenu: menu choices isEmpty ifFalse: [ choices do: [ :choice || label sym | (choice isKindOf: Array) ifTrue: [ label := choice first translated. sym := choice second ] ifFalse: [ label := choice translated. sym := choice ]. menu add: label target: menu selector: #modalSelection: argument: sym ]. menu addLine. ]. ^menu. ! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 7/17/2004 09:01'! addStatusChoices: choices toSubMenu: submenu forMenu: menu choices isEmpty ifFalse: [ choices do: [ :choice || label sym | (choice isKindOf: Array) ifTrue: [ label := choice first translated. sym := choice second ] ifFalse: [ label := choice translated. sym := choice ]. submenu add: label target: menu selector: #modalSelection: argument: sym ]. menu addLine. ]. ^menu. ! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 8/18/2004 18:01'! presentScriptStatusPopUp "Put up a menu of status alternatives and carry out the request" | reply m menu submenu | menu _ MenuMorph new. self addStatusChoices: #( normal " -- run when called" ) toMenu: menu. self addStatusChoices: #( paused "ready to run all the time" ticking "run all the time" ) toMenu: menu. self addStatusChoices: (ScriptingSystem standardEventStati copyFrom: 1 to: 3) toMenu: menu. self addStatusChoices: (ScriptingSystem standardEventStati allButFirst: 3) toMenu: menu. self addStatusChoices: #(opening "when I am being opened" closing "when I am being closed" ) toMenu: menu. submenu _ MenuMorph new. self addStatusChoices: ScriptingSystem globalCustomEventNames toSubMenu: submenu forMenu: menu. menu add: 'more... ' translated subMenu: submenu. (Preferences allowEtoyUserCustomEvents) ifTrue: [ submenu addLine. self addStatusChoices: ScriptingSystem userCustomEventNames toSubMenu: submenu forMenu: menu. submenu addLine. self addStatusChoices: (Array streamContents: [ :s | s nextPut: { 'define a new custom event'. #defineNewEvent }. ScriptingSystem userCustomEventNames isEmpty ifFalse: [ s nextPut: { 'delete a custom event'. #deleteCustomEvent } ]]) toSubMenu: submenu forMenu: menu ]. menu addLine. self addStatusChoices: #( ('what do these mean?'explainStatusAlternatives) ('apply my status to all siblings' assignStatusToAllSiblings) ) toMenu: menu. menu addTitle: 'When should this script run?' translated. menu submorphs last delete. menu invokeModal. reply := menu modalSelection. reply == #explainStatusAlternatives ifTrue: [^ self explainStatusAlternatives]. reply == #assignStatusToAllSiblings ifTrue: [^ self assignStatusToAllSiblings]. reply == #defineNewEvent ifTrue: [ ^self defineNewEvent ]. reply == #deleteCustomEvent ifTrue: [ ^self deleteCustomEvent ]. reply ifNotNil: [self status: reply. "Gets event handlers fixed up" reply == #paused ifTrue: [m _ player costume. (m isKindOf: SpeakerMorph) ifTrue: [m stopSound]]. self updateAllStatusMorphs] ! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'nk 7/21/2003 20:32'! deleteCustomEvent | userEvents eventName | userEvents _ ScriptingSystem userCustomEventNames. eventName _ (SelectionMenu selections: userEvents) startUpWithCaption: 'Remove which event?' at: ActiveHand position allowKeyboard: true. eventName ifNotNil: [ ScriptingSystem removeUserCustomEventNamed: eventName ]. self class allSubInstancesDo: [ :ea | ea status = eventName ifTrue: [ ea status: #normal ]]! ! AlansTextPlusMorph initialize! UserCustomEventNameType initialize!