'From Squeak3.1alpha of 28 February 2001 [latest update: #4077] on 25 May 2001 at 10:50:03 am'! "Change Set: wordingEtc-sw Date: 25 May 2001 Author: Scott Wallace Make the elementWording of a MethodInterface provide the wording on classic tiles. Universal tiles are another matter here. Provides support for natural-language translations of vocabularies. Illustratively offers a full sample translation of the etoy vocabulary"! Object subclass: #ElementTranslation instanceVariableNames: 'wording helpMessage ' classVariableNames: '' poolDictionaries: '' category: 'System-Protocols'! TileLikeMorph subclass: #PhraseTileMorph instanceVariableNames: 'resultType brightenedOnEnter userScriptSelector justGrabbedFromViewer vocabulary ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Scripting Tiles'! RectangleMorph subclass: #TileMorph instanceVariableNames: 'type slotName literal operatorOrExpression actualObject downArrow upArrow suffixArrow typeColor lastArrowTick nArrowTicks operatorReadoutString possessive retractArrow vocabulary ' classVariableNames: 'DownPicture RetractPicture SuffixArrowAllowance SuffixPicture UpArrowAllowance UpPicture UpdatingOperators ' poolDictionaries: '' category: 'Morphic-Scripting Tiles'! ObjectWithDocumentation subclass: #Vocabulary instanceVariableNames: 'vocabularyName categories methodInterfaces object limitClass translationTable ' classVariableNames: 'AllMethodInterfaces AllVocabularies ' poolDictionaries: '' category: 'System-Protocols'! EToyVocabulary subclass: #TranslatedEToyVocabulary instanceVariableNames: 'languageName ' classVariableNames: '' poolDictionaries: '' category: 'System-Protocols'! !Object methodsFor: 'macpal' stamp: 'sw 5/17/2001 12:08'! currentVocabulary "Answer the currently-prevailing default vocabulary." ^ Smalltalk isMorphic ifTrue: [ActiveWorld currentVocabulary] ifFalse: [Vocabulary fullVocabulary]! ! !Object methodsFor: 'viewer' stamp: 'sw 5/22/2001 16:53'! elementTypeFor: aStringOrSymbol vocabulary: aVocabulary "Answer a symbol characterizing what kind of element aStringOrSymbol represents. Realistically, at present, this always just returns #systemScript; a prototyped but not-incorporated architecture supported use of a leading colon to characterize an inst var of a system class, and for the moment we still see its remnant here." self flag: #deferred. "a loose end in the non-player case" ^ #systemScript! ! !Object methodsFor: 'viewer' stamp: 'sw 5/22/2001 12:31'! infoFor: anElement inViewer: aViewer "The user made a gesture asking for info/menu relating to me. Some of the messages dispatched here are not yet available in this image" | aMenu elementType | elementType _ self elementTypeFor: anElement vocabulary: aViewer currentVocabulary. ((elementType = #systemSlot) | (elementType == #userSlot)) ifTrue: [^ self slotInfoButtonHitFor: anElement inViewer: aViewer]. self flag: #deferred. "Use a traditional MenuMorph, and reinstate the pacify thing" aMenu _ MenuMorph new defaultTarget: aViewer. #( ('implementors' browseImplementorsOf:) ('senders' browseSendersOf:) ('versions' browseVersionsOf:) - ('browse full' browseMethodFull:) ('inheritance' browseMethodInheritance:) - ('about this method' aboutMethod:)) do: [:pair | pair = '-' ifTrue: [aMenu addLine] ifFalse: [aMenu add: pair first target: aViewer selector: pair second argument: anElement]]. aMenu addLine. aMenu defaultTarget: self. #( ('destroy script' removeScript:) ('rename script' renameScript:) ('pacify script' pacifyScript:)) do: [:pair | aMenu add: pair first target: self selector: pair second argument: anElement]. aMenu items size == 0 ifTrue: [aMenu add: 'ok' action: nil]. "in case it was a slot -- weird, transitional" aMenu addTitle: anElement asString, ' (', elementType, ')'. aMenu popUpInWorld: self currentWorld. ! ! !Object methodsFor: 'scripts-kernel' stamp: 'sw 5/16/2001 09:30'! universalTilesForGetterOf: aMethodInterface "Return universal tiles for a getter on the given method interface." | ms argTile argArray itsSelector | itsSelector _ aMethodInterface selector. argArray _ #(). "Three gratuituous special cases..." (itsSelector == #color:sees:) ifTrue: [argTile _ self tileForArgType: #color. argArray _ Array with: argTile colorSwatch color with: argTile colorSwatch color copy]. itsSelector == #seesColor: ifTrue: [argTile _ self tileForArgType: #color. argArray _ Array with: argTile colorSwatch color]. itsSelector == #touchesA: ifTrue: [argTile _ self tileForArgType: #player. argArray _ Array with: argTile actualObject]. ms _ MessageSend receiver: self selector: itsSelector arguments: argArray. ^ ms asTilesIn: self class! ! !CodeHolder methodsFor: 'what to show' stamp: 'sw 5/24/2001 14:14'! offerWhatToShowMenu "Offer a menu governing what to show" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addTitle: 'What to show'. aMenu addStayUpItem. self addContentsTogglesTo: aMenu. aMenu popUpInWorld ! ! !ElementTranslation methodsFor: 'access' stamp: 'sw 5/22/2001 10:34'! helpMessage "Answer the helpMessage" ^ helpMessage! ! !ElementTranslation methodsFor: 'access' stamp: 'sw 5/22/2001 10:33'! wording "Answer the wording" ^ wording! ! !ElementTranslation methodsFor: 'initialization' stamp: 'sw 5/22/2001 10:32'! wording: aWording helpMessage: aHelpMessage "Set state directly" wording _ aWording. helpMessage _ aHelpMessage! ! !ElementTranslation methodsFor: 'printing' stamp: 'sw 5/25/2001 10:46'! printOn: aStream "Print the receiver on the stream" aStream nextPutAll: '('. super printOn: aStream. aStream nextPutAll: ' wording: ', wording asString, ')'! ! !ElementTranslation class methodsFor: 'instance creation' stamp: 'sw 5/22/2001 10:33'! fromPair: wordingAndHelpMessagePair "Answer an instance with the given wording and help message" ^ self new wording: wordingAndHelpMessagePair first helpMessage: wordingAndHelpMessagePair second! ! !Lexicon methodsFor: 'menu commands' stamp: 'sw 5/18/2001 10:53'! offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addStayUpItem. aMenu addList: #( ('vocabulary...' chooseVocabulary) - ('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) "('toggle search pane' toggleSearch)" - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('inst var refs (local)' setLocalInstVarRefs) ('inst var defs (local)' setLocalInstVarDefs) ('class var refs (local)' setLocalClassVarRefs) - ('inst var refs' browseInstVarRefs) ('inst var defs' browseInstVarDefs) ('class var refs' browseClassVarRefs) - ('more...' shiftedYellowButtonActivity)). aMenu popUpInWorld: ActiveWorld! ! !InstanceBrowser methodsFor: 'initialization' stamp: 'sw 5/25/2001 01:50'! defaultBackgroundColor "Answer the default background color for the window" ^ Color r: 0.806 g: 1.0 b: 0.806 "Color fromUser" "23 haveFullProtocolBrowsed"! ! !InstanceBrowser methodsFor: 'initialization' stamp: 'sw 5/25/2001 10:47'! desiredWindowLabelHeightIn: aSystemWindow "Answer the desired window label height. To be exploited in due course" self flag: #deferred. "For tweaking appearance in due course" ^ nil! ! !InstanceBrowser methodsFor: 'initialization' stamp: 'sw 5/25/2001 01:52'! windowWithLabel: aLabel "Answer a SystemWindow associated with the receiver, with appropriate border characteristics" | window | self flag: #deferred. "A pretty nice effect -- a large draggable border when active. But can't really use this until there is a substitute place to show the title" "(window _ SystemWindow newWithoutLabel) model: self. window setProperty: #borderWidthWhenActive toValue: 8. window setProperty: #borderWidthWhenInactive toValue: 1. window borderWidth: 8." (window _ SystemWindow labelled: aLabel) model: self. ^ window ! ! !InstanceBrowser methodsFor: 'menu commands' stamp: 'sw 5/24/2001 14:14'! offerMenu "Offer a menu to the user, in response to the hitting of the menu button on the tool pane" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu title: 'Messages of ', objectViewed nameForViewer. aMenu addStayUpItem. aMenu addList: #( ('vocabulary...' chooseVocabulary) ('what to show...' offerWhatToShowMenu) - ('navigate to a sender...' navigateToASender) ('recent...' navigateToRecentMethod) ('show methods in current change set' showMethodsInCurrentChangeSet) "('toggle search pane' toggleSearch)" - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('versions (v)' browseVersions) ('inheritance (i)' methodHierarchy) - ('inst var refs' browseInstVarRefs) ('inst var defs' browseInstVarDefs) ('class var refs' browseClassVarRefs) - ('viewer on me' viewViewee) ('inspector on me' inspectViewee) - ('more...' shiftedYellowButtonActivity)). aMenu popUpInWorld: ActiveWorld! ! !MethodInterface methodsFor: 'initialization' stamp: 'sw 5/16/2001 14:27'! initializeFromEToyCommandSpec: tuple category: aCategorySymbol "tuple holds an old etoy command-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to hold the same information" selector _ tuple second. self documentation: tuple third. receiverType _ #player. selector numArgs == 1 ifTrue: [argumentVariables _ OrderedCollection with: (Variable new name: (Player formalHeaderPartsFor: selector) fourth type: tuple fourth)]. aCategorySymbol ifNotNil: [self flagAttribute: aCategorySymbol]. elementWording _ ScriptingSystem wordingForOperator: selector! ! !MethodInterface methodsFor: 'access' stamp: 'sw 5/22/2001 17:02'! elementWording "Answer the wording to be shown on friendly tiles representing the receiver; by default, it is just the same as the method selector itself, but anything special-cased via #wordingForOperator:, and all getters/setters of slots, are transformed into somethingfriendlier here" ^ elementWording ifNil: [elementWording _ "grandfathered case is problematical here" ((selector beginsWith: 'get') and: [selector size > 3]) ifTrue: [(selector copyFrom: 4 to: selector size) withFirstCharacterDownshifted] ifFalse: [((selector beginsWith: 'set') and: [selector size > 4]) ifTrue: [(selector copyFrom: 4 to: selector size - 1) withFirstCharacterDownshifted] ifFalse: ["ultimate fallback" ScriptingSystem wordingForOperator: selector]]]! ! !MethodWithInterface methodsFor: 'rename' stamp: 'sw 5/25/2001 10:47'! renameScript: newSelector fromPlayer: aPlayer "The receiver's selector has changed to the new selector. Get various things right, including the physical appearance of any Scriptor open on this method" self allScriptEditors do: [:aScriptEditor | aScriptEditor renameScriptTo: newSelector]. selector _ newSelector asSymbol. elementWording _ newSelector asSymbol. self bringUpToDate. self playerClass atSelector: selector putScript: self. ! ! !Morph methodsFor: 'initialization' stamp: 'sw 5/17/2001 17:57'! currentVocabulary "Answer the receiver's current vocabulary" | outer | ^ (outer _ self ownerThatIsA: StandardViewer orA: ScriptEditorMorph) ifNotNil: [outer currentVocabulary] ifNil: [super currentVocabulary]! ! !Morph methodsFor: 'e-toy support' stamp: 'sw 5/17/2001 12:47'! adoptVocabulary: aVocabulary "Make aVocabulary be the one used by me and my submorphs" self submorphsDo: [:m | m adoptVocabulary: aVocabulary]! ! !Morph methodsFor: 'debug and other' stamp: 'sw 5/25/2001 10:24'! handMeTilesToFire "Construct a phrase of tiles comprising a line of code that will 'fire' this object, and hand it to the user" ActiveHand attachMorph: (self assuredPlayer tilesToCall: (self currentVocabulary methodInterfaceAt: #fire ifAbsent: [nil])) ! ! !PasteUpMorph methodsFor: 'scripting' stamp: 'sw 5/22/2001 17:43'! currentVocabulary "Answer the default Vocabulary object to be applied when scripting" ^ self valueOfProperty: #currentVocabulary ifAbsent: [Vocabulary fullVocabulary]! ! !PhraseTileMorph methodsFor: 'initialization' stamp: 'sw 5/25/2001 10:25'! currentVocabulary "Answer the current vocabulary" ^ vocabulary ifNil: [super currentVocabulary]! ! !PhraseTileMorph methodsFor: 'initialization' stamp: 'sw 5/17/2001 18:04'! setOperator: opSymbol type: opType rcvrType: rcvrType argType: argType "Set the operator, type, receiver type, and argument type for the phrase" | aTileMorph | resultType _ opType. opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)]. self removeAllMorphs. self addMorph: (TilePadMorph new setType: rcvrType). aTileMorph _ TileMorph new adoptVocabulary: self currentVocabulary. self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color). opSymbol numArgs = 1 ifTrue: [self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#object]))]! ! !PhraseTileMorph methodsFor: 'initialization' stamp: 'sw 5/25/2001 10:48'! vocabulary: aVocab "Set the vocabulary" vocabulary _ aVocab! ! !Player methodsFor: 'slots-kernel' stamp: 'sw 5/17/2001 12:12'! typeForSlot: aSlotName "Answer the data type for values of the instance variable of the given name" | getter inherentSelector | inherentSelector _ Utilities inherentSelectorForGetter: aSlotName. (self slotInfo includesKey: inherentSelector) ifTrue: [^ (self slotInfoAt: inherentSelector) type]. getter _ (aSlotName beginsWith: 'get') ifTrue: [aSlotName] ifFalse: [Utilities getterSelectorFor: aSlotName]. ^ (self currentVocabulary methodInterfaceAt: getter ifAbsent: [self error: 'Unknown slot name: ', aSlotName]) resultType! ! !Player methodsFor: 'slots-kernel' stamp: 'sw 5/24/2001 14:29'! typeForSlot: aSlotName vocabulary: aVocabulary "Answer the data type for values of the instance variable of the given name. Presently has no senders but retained for a while..." | getter inherentSelector | inherentSelector _ Utilities inherentSelectorForGetter: aSlotName. (self slotInfo includesKey: inherentSelector) ifTrue: [^ (self slotInfoAt: inherentSelector) type]. getter _ (aSlotName beginsWith: 'get') ifTrue: [aSlotName] ifFalse: [Utilities getterSelectorFor: aSlotName]. ^ (aVocabulary methodInterfaceAt: getter ifAbsent: [self error: 'Unknown slot name: ', aSlotName]) resultType! ! !Player methodsFor: 'slots-kernel' stamp: 'sw 5/22/2001 13:56'! typeForSlotWithGetter: aGetter "Answer the data type for values of the instance variable of the given name" | getter inherentSelector | inherentSelector _ Utilities inherentSelectorForGetter: aGetter. (self slotInfo includesKey: inherentSelector) ifTrue: [^ (self slotInfoAt: inherentSelector) type]. getter _ (aGetter beginsWith: 'get') ifTrue: [aGetter] ifFalse: [Utilities getterSelectorFor: aGetter]. ^ (Vocabulary eToyVocabulary methodInterfaceAt: getter ifAbsent: [self error: 'Unknown slot name: ', aGetter]) resultType! ! !Player methodsFor: 'slots-user' stamp: 'sw 5/16/2001 18:31'! offerGetterTiles: slotName "For a player-type slot, offer to build convenient compound tiles that otherwise would be hard to get" | typeChoices typeChosen thePlayerThereNow slotChoices slotChosen getterTiles aCategoryViewer playerGetter fromPhrase | typeChoices _ #(number boolean color string player graphic sound buttonPhase "point costume"). fromPhrase _ ' from ', self externalName, '''s ', slotName. typeChosen _ (SelectionMenu selections: typeChoices lines: #()) startUpWithCaption: 'Choose the TYPE of data to get', fromPhrase. typeChosen isEmptyOrNil ifTrue: [^ self]. thePlayerThereNow _ self perform: (ScriptingSystem getterSelectorFor: slotName). thePlayerThereNow ifNil: [thePlayerThereNow _ self presenter standardPlayer]. slotChoices _ thePlayerThereNow slotNamesOfType: typeChosen. slotChoices size == 0 ifTrue: [^ self inform: 'sorry -- no slots of that type']. slotChosen _ (SelectionMenu selections: slotChoices asSortedArray) startUpWithCaption: 'Choose the datum you want to extract from', fromPhrase. slotChosen isEmptyOrNil ifTrue: [^ self]. "Now we want to tear off tiles of the form holder's valueAtCursor's foo" getterTiles _ nil. aCategoryViewer _ CategoryViewer new initializeFor: thePlayerThereNow categoryChoice: 'basic'. getterTiles _ aCategoryViewer getterTilesFor: slotChosen type: typeChosen. aCategoryViewer _ CategoryViewer new initializeFor: self categoryChoice: 'basic'. playerGetter _ aCategoryViewer getterTilesFor: slotName type: #player. getterTiles submorphs first "the pad" acceptDroppingMorph: playerGetter event: nil. "simulate a drop" getterTiles makeAllTilesGreen. getterTiles justGrabbedFromViewer: false. getterTiles firstSubmorph changeTableLayout; hResizing: #shrinkWrap; vResizing: #spaceFill. ActiveHand attachMorph: getterTiles ! ! !Player methodsFor: 'slots-user' stamp: 'sw 5/16/2001 13:01'! slotInfoForGetter: aGetter "Answer a SlotInformation object which describes an instance variable of mine retrieved via the given getter, or nil if none" ^ self slotInfo at: (Utilities inherentSelectorForGetter: aGetter) ifAbsent: [nil]! ! !Player methodsFor: 'slots-user' stamp: 'sw 5/16/2001 18:29'! slotNamesOfType: aType "Answer a list of potential slot names of the given type in the receiver" | fullList forViewer gettersToOffer | fullList _ (ScriptingSystem systemSlotNamesOfType: aType), (self class slotGettersOfType: aType). forViewer _ costume renderedMorph selectorsForViewer select: [:aSel | aSel beginsWith: 'get']. gettersToOffer _ fullList select: [:anItem | forViewer includes: anItem]. ^ gettersToOffer collect: [:aSel | Utilities inherentSelectorForGetter: aSel]! ! !Player methodsFor: 'slots-user' stamp: 'sw 5/22/2001 14:01'! tearOffFancyWatcherFor: aGetter "Create 'Player3 heading = 43' as in independent entity. It keeps up with the truth, and may be edited to change the variable." | aWatcher aTile aLine aColor aTower precision ms slotMsg info isNumeric anInterface watcherWording | info _ self slotInfoForGetter: aGetter. info ifNotNil: [isNumeric _ info type == #number. watcherWording _ Utilities inherentSelectorForGetter: aGetter] ifNil: [anInterface _Vocabulary eToyVocabulary methodInterfaceAt: aGetter ifAbsent: [nil]. isNumeric _ anInterface notNil and: [anInterface resultType == #number]. watcherWording _ anInterface elementWording]. aColor _ Color r: 0.387 g: 0.581 b: 1.0. isNumeric ifTrue: [aTile _ NumericReadoutTile new typeColor: aColor]. aWatcher _ UpdatingStringMorph new. isNumeric ifTrue: [(precision _ self defaultFloatPrecisionFor: aGetter) ~= 1 ifTrue: [aWatcher floatPrecision: precision]]. aWatcher growable: true; getSelector: aGetter; putSelector: (info notNil ifTrue: [ScriptingSystem setterSelectorForGetter: aGetter] ifFalse: [anInterface companionSetterSelector]). aWatcher target: self. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: (self perform: aGetter) width: 30. Preferences universalTiles ifTrue: [ ms _ MessageSend receiver: self selector: aGetter asSymbol arguments: #(). slotMsg _ ms asTilesIn: self class. ms _ MessageSend receiver: 3 selector: #= asSymbol arguments: #(5). aLine _ ms asTilesIn: self class. aLine firstSubmorph delete. aLine addMorphFront: slotMsg. aLine lastSubmorph delete. aLine lastSubmorph delete. aLine color: aColor. aLine addMorphBack: aTile. aLine cellPositioning: #leftCenter] ifFalse: [ aLine _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: aColor. aLine layoutInset: -1. aLine borderWidth: 1; borderColor: aColor darker. aLine addMorphBack: (self tileReferringToSelf borderWidth: 0; typeColor: aColor; color: aColor; bePossessive). aLine addTransparentSpacerOfSize: (4@0). aTower _ AlignmentMorph newColumn color: aColor. aTower addTransparentSpacerOfSize: (0 @ 1). aTower addMorphBack: (StringMorph contents: watcherWording, ' = ' font: ScriptingSystem fontForTiles). aLine addMorphBack: aTower. aLine addMorphBack: aTile]. aWatcher step; fitContents. self currentHand attachMorph: aLine.! ! !Player methodsFor: 'slots-user' stamp: 'sw 5/22/2001 14:00'! tearOffWatcherFor: aSlotGetter "Tear off a watcher for the slot whose getter is provided" | aWatcher precision anInterface info isNumeric | info _ self slotInfoForGetter: aSlotGetter. info ifNotNil: [isNumeric _ info type == #number] ifNil: [anInterface _ Vocabulary eToyVocabulary methodInterfaceAt: aSlotGetter ifAbsent: [nil]. isNumeric _ anInterface notNil and: [anInterface resultType == #number]]. aWatcher _ UpdatingStringMorph new. isNumeric ifFalse: [aWatcher useStringFormat] ifTrue: [precision _ self defaultFloatPrecisionFor: aSlotGetter. precision ~= 1 ifTrue: [aWatcher floatPrecision: precision]]. aWatcher growable: true; getSelector: aSlotGetter; putSelector: (ScriptingSystem setterSelectorForGetter: aSlotGetter); setNameTo: (info notNil ifTrue: [Utilities inherentSelectorForGetter: aSlotGetter] ifFalse: [anInterface elementWording]). aWatcher target: self. aWatcher step. aWatcher fitContents. self currentHand attachMorph: aWatcher! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 5/22/2001 14:56'! elementTypeFor: aStringOrSymbol vocabulary: aVocabulary "Answer whether aStringOrSymbol is best characterized as a #systemSlot, #systemScript, #userSlot, or #userScript. This is ancient and odious but too tedious to rip out at this point." | aSymbol anInterface aSlotName | aSymbol _ aStringOrSymbol asSymbol. aSlotName _ Utilities inherentSelectorForGetter: aSymbol. (self slotInfo includesKey: aSlotName) ifTrue: [^ #userSlot]. (self class isUniClass and: [self class scripts includesKey: aSymbol]) ifTrue: [^ #userScript]. anInterface _ aVocabulary methodInterfaceAt: aSymbol ifAbsent: [nil]. ^ anInterface ifNotNil: [(anInterface resultType == #unknown) ifTrue: [#systemScript] ifFalse: [#systemSlot]] ifNil: [#systemScript]! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 5/22/2001 12:08'! infoFor: anElement inViewer: aViewer "The user made a gesture asking for info/menu relating" | aMenu elementType aSelector | elementType _ self elementTypeFor: anElement vocabulary: aViewer currentVocabulary. ((elementType = #systemSlot) | (elementType == #userSlot)) ifTrue: [^ self slotInfoButtonHitFor: anElement inViewer: aViewer]. aMenu _ MenuMorph new defaultTarget: self. aMenu defaultTarget: self. aSelector _ anElement asSymbol. (elementType == #userScript) ifTrue: [aMenu add: 'destroy "', anElement, '"' selector: #removeScriptWithSelector: argument: aSelector. aMenu add: 'rename "', anElement, '"' selector: #renameScript: argument: aSelector. aMenu add: 'textual scripting pane' selector: #makeIsolatedCodePaneForSelector: argument: aSelector. aMenu add: 'button to fire this script' selector: #tearOffButtonToFireScriptForSelector: argument: aSelector. aMenu add: 'edit balloon help' selector: #editDescriptionForSelector: argument: aSelector. "aMenu add: 'pacify this script' selector: #pacifyScript: argument: aSelector"]. aMenu items size == 0 ifTrue: [aMenu add: 'ok' action: nil]. aMenu addTitle: anElement asString, ' (', elementType, ')'. aMenu popUpInWorld: aViewer world! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 5/25/2001 10:29'! slotInfoButtonHitFor: aGetterSymbol inViewer: aViewer "The user made a gesture asking for slot menu for the given getter symbol in a viewer; put up the menu." | aMenu slotSym aType | slotSym _ Utilities inherentSelectorForGetter: aGetterSymbol. aType _ self typeForSlotWithGetter: aGetterSymbol asSymbol. aMenu _ MenuMorph new defaultTarget: self. (#(colorSees copy getNewClone) includes: slotSym) ifFalse: [aMenu add: 'simple watcher' selector: #tearOffWatcherFor: argument: aGetterSymbol]. (#(copy getNewClone) includes: slotSym) ifTrue: [aMenu add: 'give me a copy now' action: #handTheUserACopy]. aType == #number "later others" ifTrue: [aMenu add: 'detailed watcher' selector: #tearOffFancyWatcherFor: argument: aGetterSymbol]. (self slotInfo includesKey: slotSym) ifTrue: "User slot" [aMenu add: 'change data type' selector: #chooseSlotTypeFor: argument: slotSym. aType == #number ifTrue: [aMenu add: 'decimal places...' selector: #setPrecisionFor: argument: slotSym]. aMenu add: 'remove "', aGetterSymbol, '"' selector: #removeSlotNamed: argument: slotSym. aMenu add: 'rename "', aGetterSymbol, '"' selector: #renameSlot: argument: slotSym]. aType == #player ifTrue: [aMenu add: 'tiles to get...' selector: #offerGetterTiles: argument: slotSym]. aMenu items size == 0 ifTrue: [aMenu add: 'ok' action: #yourself]. aMenu addTitle: (aGetterSymbol asString, ' (', aType, ')'). aMenu popUpForHand: aViewer primaryHand in: aViewer world! ! !Player methodsFor: 'misc' stamp: 'sw 5/22/2001 13:50'! defaultFloatPrecisionFor: aGetSelector "Answer the float position to use in conjunction with a readout for aGetSelector, which will be of the form 'getXXX'" | aSlotName | aSlotName _ Utilities inherentSelectorForGetter: aGetSelector. (self slotInfo includesKey: aSlotName) ifTrue: [^ #userSlot]. self costume ifNotNil: [^ self costume defaultFloatPrecisionFor: aGetSelector]. ^ 1! ! !Player methodsFor: 'misc' stamp: 'sw 5/18/2001 14:44'! offerAlternateViewerMenuFor: aViewer event: evt "Put up an alternate Viewer menu on behalf of the receiver." | aMenu aWorld | aWorld _ aViewer world. aMenu _ MenuMorph new defaultTarget: self. costumes ifNotNil: [(costumes size > 1 or: [costumes size == 1 and: [costumes first ~~ costume renderedMorph]]) ifTrue: [aMenu add: 'forget other costumes' target: self selector: #forgetOtherCostumes]]. aMenu addLine. aMenu add: 'expunge empty scripts' target: self action: #expungeEmptyScripts. aMenu add: 'lexicon with search pane' target: aViewer action: #openSearchingProtocolBrowser. aMenu addLine. aMenu add: 'inspect morph' target: costume selector: #inspect. aMenu add: 'inspect player' target: self selector: #inspect. self belongsToUniClass ifTrue: [aMenu add: 'browse class' target: self action: #browsePlayerClass. aMenu add: 'inspect class' target: self class action: #inspect]. aMenu add: 'inspect this Viewer' target: aViewer selector: #inspect. aMenu add: 'inspect this Vocabulary' target: aViewer currentVocabulary selector: #inspect. aMenu addLine. aMenu add: 'relaunch this Viewer' target: aViewer action: #relaunchViewer. aMenu popUpEvent: evt in: aWorld ! ! !Player methodsFor: 'misc' stamp: 'sw 5/18/2001 10:19'! offerViewerMenuFor: aViewer event: evt "Put up the Viewer menu on behalf of the receiver." | aMenu aWorld | aWorld _ aViewer world. aMenu _ MenuMorph new defaultTarget: self. aMenu add: 'add a new instance variable' target: self action: #addInstanceVariable. aMenu balloonTextForLastItem: 'Add a new instance variable to this object and all of its siblings. You will be asked to supply a name for it.'. aMenu add: 'add a new script' target: aViewer action: #newPermanentScript. aMenu balloonTextForLastItem: 'Add a new script that will work for this object and all of its siblings'. aMenu addLine. aMenu add: 'grab me' target: self selector: #grabPlayerIn: argument: aWorld. aMenu balloonTextForLastItem: 'This will actually pick up the object this Viewer is looking at, and hand it to you. Click the (left) button to drop it'. aMenu add: 'reveal me' target: self selector: #revealPlayerIn: argument: aWorld. aMenu balloonTextForLastItem: 'If you have misplaced the object that this Viewer is looking at, use this item to (try to) make it visible'. aMenu addLine. aMenu add: 'choose vocabulary...' target: aViewer action: #chooseVocabulary. aMenu balloonTextForLastItem: 'Choose a different vocabulary for this Viewer.'. aMenu add: 'open lexicon' target: aViewer action: #openLexicon. aMenu balloonTextForLastItem: 'open a window that shows the code for this object in traditional programmer format'. aMenu addLine. aMenu add: 'tile representing me' action: #tearOffTileForSelf. aMenu addLine. aMenu add: 'more...' target: self selector: #offerAlternateViewerMenuFor:event: argumentList: {aViewer. evt}. aMenu popUpEvent: evt in: aWorld ! ! !Player class methodsFor: 'slots' stamp: 'sw 5/25/2001 10:26'! slotGettersOfType: aType "Answer a list of gettter selectors for slots of mine of the given type" | aList | aList _ OrderedCollection new. self slotInfo associationsDo: [:assoc | (assoc value type = aType) ifTrue: [aList add: (Utilities getterSelectorFor: assoc key)]]. ^ aList! ! !Presenter methodsFor: 'viewer' stamp: 'sw 5/25/2001 01:17'! updateViewer: aViewer forceToShow: aCategory "Update the given viewer to make sure it is in step with various possible changes in the outside world, and when reshowing it be sure it shows the given category" | aPlayer aPosition newViewer oldOwner wasSticky barHeight cats itsVocabulary | cats _ aViewer categoriesCurrentlyShowing asOrderedCollection. itsVocabulary _ aViewer currentVocabulary. aCategory ifNotNil: [(cats includes: aCategory) ifFalse: [cats addFirst: aCategory]]. aPlayer _ aViewer scriptedPlayer. aPosition _ aViewer position. wasSticky _ aViewer isSticky. newViewer _ aViewer species new visible: false. barHeight _ aViewer submorphs first listDirection == #topToBottom ifTrue: [aViewer submorphs first submorphs first height] ifFalse: [0]. Preferences viewersInFlaps ifTrue: [newViewer setProperty: #noInteriorThumbnail toValue: true]. newViewer rawVocabulary: itsVocabulary. newViewer initializeFor: aPlayer barHeight: barHeight includeDismissButton: aViewer hasDismissButton showCategories: cats. wasSticky ifTrue: [newViewer beSticky]. oldOwner _ aViewer owner. oldOwner ifNotNil: [oldOwner replaceSubmorph: aViewer by: newViewer]. "It has happened that old readouts are still on steplist. We may see again!!" newViewer position: aPosition. newViewer enforceTileColorPolicy. newViewer visible: true. newViewer world doIfNotNil: [:aWorld | aWorld startSteppingSubmorphsOf: newViewer]. newViewer layoutChanged! ! !StandardScriptingSystem methodsFor: 'utilities' stamp: 'sw 5/16/2001 12:58'! setterSelectorForGetter: aGetterSymbol "Answer the setter selector corresponding to a given getter" ^ (('s', (aGetterSymbol copyFrom: 2 to: aGetterSymbol size)), ':') asSymbol "ScriptingSystem setterSelectorForGetter: #getCursor"! ! !StandardScriptingSystem methodsFor: 'universal slots & scripts' stamp: 'sw 5/16/2001 12:34'! acceptableScriptNameFrom: originalString forScriptCurrentlyNamed: currentName asScriptNameIn: aPlayer world: aWorld "Produce an acceptable script name, derived from the current name, for aPlayer. This method will always return a valid script name that will be suitable for use in the given situation, though you might not like its beauty sometimes." | aString stemAndSuffix proscribed stem suffix putative | aString _ originalString asIdentifier: false. "get an identifier not lowercase" stemAndSuffix _ aString stemAndNumericSuffix. proscribed _ #(self super thisContext costume costumes dependents true false size). stem _ stemAndSuffix first. suffix _ stemAndSuffix last. putative _ aString asSymbol. [(putative ~~ currentName) and: [(proscribed includes: putative) or: [(aPlayer respondsTo: putative) or: [Smalltalk includesKey: putative]]]] whileTrue: [suffix _ suffix + 1. putative _ (stem, suffix printString) asSymbol]. ^ putative! ! !StandardScriptingSystem methodsFor: 'universal slots & scripts' stamp: 'sw 5/16/2001 12:24'! acceptableSlotNameFrom: originalString forSlotCurrentlyNamed: currentName asSlotNameIn: aPlayer world: aWorld "Produce an acceptable slot name, derived from the current name, for aPlayer. This method will always return a valid slot name that will be suitable for use in the given situation, though you might not like its beauty sometimes." | aString stemAndSuffix proscribed stem suffix putative | aString _ originalString asIdentifier: false. "get an identifier not lowercase" stemAndSuffix _ aString stemAndNumericSuffix. proscribed _ #(self super thisContext costume costumes dependents true false size), aPlayer class allInstVarNames. stem _ stemAndSuffix first. suffix _ stemAndSuffix last. putative _ aString asSymbol. [(putative ~~ currentName) and: [(proscribed includes: putative) or: [(aPlayer respondsTo: putative) or: [Smalltalk includesKey: putative]]]] whileTrue: [suffix _ suffix + 1. putative _ (stem, suffix printString) asSymbol]. ^ putative! ! !StandardScriptingSystem methodsFor: 'universal slots & scripts' stamp: 'sw 5/17/2001 12:13'! systemSlotNamesOfType: aType "Answer the type of the slot name, or nil if not found." | aList | aList _ OrderedCollection new. self currentVocabulary methodInterfacesDo: [:anInterface | anInterface resultType == aType ifTrue: [aList add: anInterface selector]]. ^ aList! ! !StandardScriptingSystem class methodsFor: 'class initialization' stamp: 'sw 5/16/2001 12:34'! initialize "Initialize the scripting system. Sometimes this method is vacuously changed just to get it in a changeset so that its invocation will occur as part of an update" (Smalltalk at: #ScriptingSystem ifAbsent: [nil]) ifNil: [Smalltalk at: #ScriptingSystem put: self new]. ScriptingSystem initializeHelpStrings "StandardScriptingSystem initialize"! ! !SyntaxMorph methodsFor: 'type checking' stamp: 'sw 5/17/2001 12:15'! currentVocabulary "Answer the current vocabulary associated with the receiver. If none is yet set, determine an appropriate vocabulary and cache it within my properties dictionary." | aVocab | (aVocab _ self valueOfProperty: #currentVocabulary) ifNotNil: [^ aVocab]. aVocab _ super currentVocabulary. self setProperty: #currentVocabulary toValue: aVocab. ^ aVocab! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/17/2001 14:50'! adoptVocabulary: aVocabulary "Set the receiver's vocabulary" vocabulary _ aVocabulary. super adoptVocabulary: aVocabulary! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/17/2001 17:20'! currentVocabulary "Answer the receiver's current vocabulary" | outer | ^ vocabulary ifNil: [(outer _ self ownerThatIsA: StandardViewer orA: ScriptEditorMorph) ifNotNil: [vocabulary _ outer currentVocabulary] ifNil: [super currentVocabulary]]! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/17/2001 18:24'! setOperator: aString "Set the operator symbol from the string provided" type _ #operator. operatorOrExpression _ aString asSymbol. self line1: (self currentVocabulary tileWordingForSelector: operatorOrExpression). (ScriptingSystem doesOperatorWantArrows: operatorOrExpression) ifTrue: [self addArrows; updateLiteralLabel]. "operatorOrExpression == #heading ifTrue: [self halt]."! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/17/2001 12:17'! setOperatorAndUseArrows: aString "Set the operator as per aString, and add up/down arrows" type _ #operator. operatorOrExpression _ aString asSymbol. self line1: (self currentVocabulary tileWordingForSelector: operatorOrExpression). self addArrows; updateLiteralLabel. submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: operatorOrExpression)! ! !TileMorph methodsFor: 'private' stamp: 'sw 5/17/2001 12:17'! updateLiteralLabel "Update the wording emblazoned on the tile, if needed" | myLabel | (myLabel _ self labelMorph) ifNil: [^ self]. myLabel acceptValue: (type == #literal ifTrue: [literal] ifFalse: [operatorReadoutString ifNil: [self currentVocabulary tileWordingForSelector: operatorOrExpression] ifNotNil: [operatorReadoutString]]). self changed.! ! !TileMorph methodsFor: 'copying' stamp: 'sw 5/17/2001 20:52'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. type _ type veryDeepCopyWith: deepCopier. slotName _ slotName veryDeepCopyWith: deepCopier. literal _ literal veryDeepCopyWith: deepCopier. operatorOrExpression _ operatorOrExpression veryDeepCopyWith: deepCopier. "actualObject _ actualObject. Weakly copied" downArrow _ downArrow veryDeepCopyWith: deepCopier. upArrow _ upArrow veryDeepCopyWith: deepCopier. suffixArrow _ suffixArrow veryDeepCopyWith: deepCopier. typeColor _ typeColor veryDeepCopyWith: deepCopier. lastArrowTick _ lastArrowTick veryDeepCopyWith: deepCopier. nArrowTicks _ nArrowTicks veryDeepCopyWith: deepCopier. operatorReadoutString _ operatorReadoutString veryDeepCopyWith: deepCopier. possessive _ possessive veryDeepCopyWith: deepCopier. retractArrow _ retractArrow veryDeepCopyWith: deepCopier. vocabulary _ vocabulary. "Weakly copied"! ! !Viewer methodsFor: 'commands' stamp: 'sw 5/25/2001 01:11'! chooseVocabulary "Put up a menu allowing the user to specify which protocol to use in this viewer" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addTitle: 'Choose a vocabulary'. Vocabulary allVocabularies do: [:aVocabulary | (scriptedPlayer class implementsVocabulary: aVocabulary) ifTrue: [aMenu add: aVocabulary vocabularyName selector: #switchToVocabulary: argument: aVocabulary. aVocabulary == self currentVocabulary ifTrue: [aMenu lastItem color: Color blue]. aMenu balloonTextForLastItem: aVocabulary documentation]]. aMenu popUpInWorld: self currentWorld! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 5/22/2001 13:28'! infoButtonFor: aScriptOrSlotSymbol "Answer a fully-formed morph that will serve as the 'info button' alongside an entry corresponding to the given slot or script symbol. If no such button is appropriate, answer a transparent graphic that fills the same space." | aButton | (self wantsRowMenuFor: aScriptOrSlotSymbol) ifFalse: ["Fill the space with sweet nothing, since there is no meaningful menu to offer". aButton _ RectangleMorph new beTransparent extent: (17@20). aButton borderWidth: 0. ^ aButton]. aButton _ IconicButton new labelGraphic: Cursor menu. aButton target: scriptedPlayer; actionSelector: #infoFor:inViewer:; arguments: (Array with: (self currentVocabulary symbolWhoseTranslationIs: aScriptOrSlotSymbol) with: self); color: Color transparent; borderWidth: 0; shedSelvedge; actWhen: #buttonDown. aButton setBalloonText: 'Press here to get a menu'. ^ aButton! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 5/17/2001 18:23'! phraseForCommandFrom: aMethodInterface "Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles" | aRow resultType cmd names argType argTile selfTile aPhrase balloonTextSelector stat inst aDocString universal tileBearingHelp | aDocString _ aMethodInterface documentationOrNil. names _ scriptedPlayer class namedTileScriptSelectors. resultType _ aMethodInterface resultType. cmd _ aMethodInterface selector. (universal _ scriptedPlayer isUniversalTiles) ifTrue: [aPhrase _ scriptedPlayer universalTilesForInterface: aMethodInterface] ifFalse: [cmd numArgs == 0 ifTrue: [aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary.. aPhrase setOperator: cmd type: resultType rcvrType: #player] ifFalse: ["only one arg supported in classic tiles, so if this is fed with a selector with > 1 arg, results will be very strange" argType _ aMethodInterface typeForArgumentNumber: 1. aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #player argType: argType. argTile _ self tileForArgType: argType. argTile position: aPhrase lastSubmorph position. aPhrase lastSubmorph addMorph: argTile]]. (scriptedPlayer slotInfo includesKey: cmd) ifTrue: [balloonTextSelector _ #userSlot]. (scriptedPlayer belongsToUniClass and: [scriptedPlayer class includesSelector: cmd]) ifTrue: [aDocString ifNil: [aDocString _ (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentationOrNil]. aDocString ifNil: [balloonTextSelector _ #userScript]]. tileBearingHelp _ universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]. aDocString ifNotNil: [tileBearingHelp setBalloonText: aDocString] ifNil: [tileBearingHelp balloonTextSelector: (balloonTextSelector ifNil: [cmd])]. aPhrase markAsPartsDonor. cmd == #emptyScript ifTrue: [aPhrase setProperty: #newPermanentScript toValue: true. aPhrase setProperty: #newPermanentPlayer toValue: scriptedPlayer. aPhrase submorphs second setBalloonText: 'drag and drop to add a new script']. universal ifFalse: [selfTile _ self tileForSelf. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile]. aRow _ ViewerRow newRow borderWidth: 0; color: self color. aRow elementSymbol: cmd asSymbol. aRow addMorphBack: (ScriptingSystem tryButtonFor: aPhrase). aRow addMorphBack: (Morph new extent: 4@2; beTransparent). aRow addMorphBack: (self infoButtonFor: cmd). aRow addMorphBack: aPhrase. (names includes: cmd) ifTrue: [aPhrase userScriptSelector: cmd. aPhrase beTransparent. aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer. aRow addMorphBack: (stat _ (inst _ scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph). inst updateStatusMorph: stat]. aRow beSticky; disableDragNDrop. ^ aRow! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 5/16/2001 11:24'! phraseForVariableFrom: aMethodInterface "Return a structure consisting of tiles and controls and a readout representing a 'variable' belonging to the player, complete with an appropriate readout when indicated. Functions in both universalTiles mode and classic mode. Slightly misnamed in that this path is used for any methodInterface that indicates an interesting resultType." | anArrow slotName getterButton cover inner aRow doc setter tryer universal | aRow _ ViewerRow newRow color: self color; beSticky; elementSymbol: (slotName _ aMethodInterface selector); wrapCentering: #center; cellPositioning: #leftCenter. (universal _ scriptedPlayer isUniversalTiles) ifFalse: [aRow addMorphBack: (Morph new color: self color; extent: 11 @ 22; yourself)]. "spacer" aRow addMorphBack: (self infoButtonFor: slotName). aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" universal ifTrue: [inner _ scriptedPlayer universalTilesForGetterOf: aMethodInterface. cover _ Morph new color: Color transparent. cover extent: inner fullBounds extent. (getterButton _ cover copy) addMorph: cover; addMorphBack: inner. cover on: #mouseDown send: #makeUniversalTilesGetter:event:from: to: self withValue: aMethodInterface. aRow addMorphFront: (tryer _ ScriptingSystem tryButtonFor: inner). tryer color: tryer color lighter lighter] ifFalse: [aRow addMorphBack: self tileForSelf bePossessive. aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" getterButton _ self getterButtonFor: aMethodInterface elementWording type: aMethodInterface resultType]. aRow addMorphBack: getterButton. (doc _ aMethodInterface documentationOrNil) ifNotNil: [getterButton setBalloonText: doc]. universal ifFalse: [(slotName == #seesColor:) ifTrue: [self addIsOverColorDetailTo: aRow. ^ aRow]. (slotName == #touchesA:) ifTrue: [self addTouchesADetailTo: aRow. ^ aRow]]. aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" (setter _ aMethodInterface companionSetterSelector) ifNotNil: [aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" anArrow _ universal ifTrue: [self arrowSetterButton: #newMakeSetterFromInterface:evt:from: args: aMethodInterface] ifFalse: [self arrowSetterButton: #makeSetter:from:forPart: args: (Array with: slotName with: aMethodInterface resultType)]. aRow addMorphBack: anArrow]. (#(color:sees: playerSeeingColor copy touchesA:) includes: slotName) ifFalse: [(universal and: [slotName == #seesColor:]) ifFalse: [aRow addMorphBack: (self readoutFor: slotName type: aMethodInterface resultType readOnly: setter isNil getSelector: aMethodInterface selector putSelector: setter)]]. anArrow ifNotNil: [anArrow step]. ^ aRow! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 5/22/2001 12:28'! wantsRowMenuFor: aSymbol "Answer whether a viewer row for the given symbol should have a menu button on it" | elementType | elementType _ scriptedPlayer elementTypeFor: aSymbol vocabulary: self currentVocabulary. (elementType == #systemScript) ifTrue: [^ false]. ((elementType == #systemSlot) and: [#(color:sees: touchesA:) includes: aSymbol]) ifTrue: [^ false]. ^ true! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 5/16/2001 13:58'! getterTilesFor: partName type: aType "Answer classic getter for the given name/type" | selfTile selector aPhrase | "aPhrase _ nil, assumed" (#(color:sees: colorSees) includes: partName) ifTrue: [aPhrase _ self colorSeesPhrase]. (#(seesColor: isOverColor) includes: partName) ifTrue: [aPhrase _ self seesColorPhrase]. (#(touchesA: touchesA) includes: partName) ifTrue: [aPhrase _ self touchesAPhrase]. aPhrase ifNil: [aPhrase _ PhraseTileMorph new setSlotRefOperator: partName asSymbol type: aType]. selfTile _ self tileForSelf bePossessive. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile. selector _ aPhrase submorphs at: 2. (aType == #number) ifTrue: [selector addSuffixArrow]. selector updateLiteralLabel. aPhrase enforceTileColorPolicy. ^ aPhrase! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 5/17/2001 10:30'! makeSetter: selectorAndTypePair event: evt from: aMorph "Classic tiles: make a Phrase that comprises a setter of a slot, and hand it to the user." | argType m argTile selfTile argValue | argType _ selectorAndTypePair second. m _ PhraseTileMorph new setAssignmentRoot: (Utilities inherentSelectorForGetter: selectorAndTypePair first asSymbol) type: #command rcvrType: #player argType: argType. argValue _ self scriptedPlayer perform: selectorAndTypePair first asSymbol. (argValue isKindOf: Player) ifTrue: [argTile _ argValue tileReferringToSelf] ifFalse: [argTile _ self tileForArgType: argType. argTile setLiteral: argValue; updateLiteralLabel.]. argTile position: m lastSubmorph position. m lastSubmorph addMorph: argTile. selfTile _ self tileForSelf bePossessive. selfTile position: m firstSubmorph position. m firstSubmorph addMorph: selfTile. m enforceTileColorPolicy. m openInHand! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 5/17/2001 10:35'! newGetterTilesFor: aPlayer methodInterface: aMethodInterface "Return universal tiles for a getter on this property. Record who self is." | ms argTile argArray | ms _ MessageSend receiver: aPlayer selector: aMethodInterface selector arguments: #(). "Handle three idiosyncratic cases..." aMethodInterface selector == #color:sees: ifTrue: [argTile _ self tileForArgType: #color. argArray _ Array with: argTile colorSwatch color with: argTile colorSwatch color copy. ms arguments: argArray]. aMethodInterface selector == #seesColor: ifTrue: [argTile _ self tileForArgType: #color. ms arguments: (Array with: argTile colorSwatch color)]. aMethodInterface selector == #touchesA: ifTrue: [argTile _ self tileForArgType: #player. ms arguments: (Array with: argTile actualObject)]. ^ ms asTilesIn: aPlayer class! ! !StandardViewer methodsFor: 'categories' stamp: 'sw 5/17/2001 17:29'! addCategoryViewerFor: aStartingCategory "Add a category viewer for the given category" | aViewer | self addMorphBack: (aViewer _ CategoryViewer new). aViewer adoptVocabulary: self currentVocabulary. aViewer initializeFor: scriptedPlayer categoryChoice: aStartingCategory. self world ifNotNil: [self world startSteppingSubmorphsOf: aViewer]! ! !StandardViewer methodsFor: 'user interface' stamp: 'sw 5/18/2001 10:46'! openLexicon "Open a lexicon browser on the receiver, showing its current vocabulary" | littleHim | littleHim _ scriptedPlayer assureUniClass. (InstanceBrowser new useVocabulary: self currentVocabulary) openOnObject: littleHim inWorld: ActiveWorld showingSelector: nil! ! !StandardViewer methodsFor: 'initialization' stamp: 'sw 5/25/2001 01:17'! rawVocabulary: aVocabulary "Mark the receiver as having aVocabulary as its vocabulary" self setProperty: #currentVocabulary toValue: aVocabulary! ! !StandardViewer methodsFor: 'initialization' stamp: 'sw 5/17/2001 12:56'! switchToVocabulary: aVocabulary "Make the receiver show categories and methods as dictated by aVocabulary. If this constitutes a switch, then wipe out existing category viewers, which may be showing the wrong thing." self adoptVocabulary: aVocabulary. "for benefit of submorphs" self setProperty: #currentVocabulary toValue: aVocabulary. (self submorphs select: [:m | m isKindOf: CategoryViewer]) do: [:m | m delete]. "New vocabulary may not have the same categories" self addCategoryViewer! ! !ViewerRow methodsFor: 'access' stamp: 'sw 5/25/2001 10:36'! entryType "Answer one of: #systemSlot #userSlot #systemScript #userScript" ^ self playerBearingCode elementTypeFor: elementSymbol vocabulary: self currentVocabulary! ! !Vocabulary methodsFor: 'queries' stamp: 'sw 5/25/2001 10:42'! methodInterfacesDo: aBlock "Evaluate aBlock on behalf, in turn, of each of my methodInterfaces" methodInterfaces do: aBlock ! ! !Vocabulary methodsFor: 'queries' stamp: 'sw 5/16/2001 14:50'! tileWordingForSelector: aSelector "Answer the wording to emblazon on tiles representing aSelector" | anInterface | anInterface _ self methodInterfaceAt: aSelector asSymbol ifAbsent: [^ aSelector]. ^ anInterface elementWording! ! !Vocabulary methodsFor: 'initialization' stamp: 'sw 5/22/2001 11:08'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. vocabularyName _ #unnamed. categories _ OrderedCollection new. methodInterfaces _ IdentityDictionary new. translationTable _ IdentityDictionary new. self documentation: 'A vocabulary that has not yet been documented'. ! ! !Vocabulary methodsFor: 'initialization' stamp: 'sw 5/25/2001 10:42'! renameCategoryFrom: oldName to: newName "Rename the category currently known by oldName to be newName. No senders at present but once a UI is establshed for renaming categories, this will be useful." | aCategory | (aCategory _ self categoryAt: oldName) ifNil: [^ self]. aCategory categoryName: newName! ! !Vocabulary methodsFor: 'translation' stamp: 'sw 5/25/2001 10:43'! symbolWhoseTranslationIs: aString "If I have a key that translates into aSymbol, return it, else return aSymbol. Caveat: at present this mechanism is only germane to the names of *categories*" | aSymbol | (translationTable == nil or: [aString == nil]) ifTrue: [^ aString]. aSymbol _ aString asSymbol. translationTable associationsDo: [:assoc | assoc value wording = aSymbol ifTrue: [^ assoc key]]. ^ aSymbol! ! !Vocabulary methodsFor: 'translation' stamp: 'sw 5/24/2001 11:03'! translateCategories: categoryTriplets "Go through my categories, translating wordings via catetgoryTriplets. Each triplet has: (oldCategoryName newCategoryWording balloon-help)" | itsName | translationTable ifNil: [translationTable _ IdentityDictionary new]. categoryTriplets do: [:trip | translationTable at: trip first put: (ElementTranslation fromPair: trip allButFirst)]. categories do: [:aCategory | itsName _ aCategory categoryName. categoryTriplets do: [:trip | trip first = itsName ifTrue: [aCategory categoryName: trip second asSymbol. trip size > 2 ifTrue: [aCategory documentation: trip third]]]]! ! !Vocabulary methodsFor: 'translation' stamp: 'sw 5/24/2001 14:28'! translateMethodInterfaceWordings: wordingTriplets "Go through my MethodInterfaces, translating wordings via wordingTriplets. Each triplet has: (selector wording balloon-help)" | wordingTable | wordingTable _ IdentityDictionary new. wordingTriplets do: [:trip | wordingTable at: trip first put: trip]. methodInterfaces do: [:anInterface | (wordingTable at: anInterface selector ifAbsent: [nil]) ifNotNilDo: [:aTriplet | anInterface elementWording: aTriplet second. anInterface documentation: aTriplet third]]! ! !Vocabulary methodsFor: 'translation' stamp: 'sw 5/25/2001 10:44'! translatedWordingFor: aSymbol "If I have a translated wording for aSymbol, return it, else return aSymbol. Caveat: at present, this mechanism is only germane for *categories*" | translation | translationTable ifNil: [^ aSymbol]. translation _ translationTable at: aSymbol ifAbsent: [^ aSymbol]. ^ translation wording ! ! !Vocabulary methodsFor: 'translation' stamp: 'sw 5/25/2001 10:45'! translatedWordingsFor: symbolList "Answer a list giving the translated wordings for the input list. Caveat: at present, this mechanism is only germane for *categories*" ^ symbolList collect: [:sym | self translatedWordingFor: sym] ! ! !EToyVocabulary methodsFor: 'category list' stamp: 'sw 5/22/2001 17:34'! categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass "Answer the category list for the given object, considering only code implemented in aClass and lower" ^ (anObject isKindOf: Player) ifTrue: [self flag: #deferred. "The bit commented out on next line is desirable but not yet workable, because it delivers categories that are not relevant to the costume in question" "#(scripts #'instance variables'), (super categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass)]" ^ self translatedWordingsFor: ((mostGenericClass == aClass) ifFalse: [anObject categories] ifTrue: [#(scripts #'instance variables')])] ifFalse: [super categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass]! ! !EToyVocabulary methodsFor: 'method list' stamp: 'sw 5/24/2001 13:56'! allMethodsInCategory: translatedName forInstance: anObject ofClass: aClass "Answer a list of all methods in the etoy interface which are in the given category, on behalf of anObject, or if it is nil, aClass" | aCategory unfiltered suitableSelectors isAll categoryName | categoryName _ self symbolWhoseTranslationIs: translatedName. categoryName ifNil: [^ OrderedCollection new]. aClass isUniClass ifTrue: [categoryName == #scripts ifTrue: [^ aClass namedTileScriptSelectors]. categoryName == #'instance variables' ifTrue: [^ aClass slotInfo keys asSortedArray collect: [:anInstVarName | Utilities getterSelectorFor: anInstVarName]]]. unfiltered _ (isAll _ categoryName = self allCategoryName) ifTrue: [methodInterfaces collect: [:anInterface | anInterface selector]] ifFalse: [aCategory _ categories detect: [:cat | cat categoryName == translatedName] ifNone: [^ OrderedCollection new]. aCategory elementsInOrder collect: [:anElement | anElement selector]]. (anObject isKindOf: Player) ifTrue: [suitableSelectors _ anObject costume selectorsForViewer. unfiltered _ unfiltered select: [:aSelector | suitableSelectors includes: aSelector]]. (isAll and: [aClass isUniClass]) ifTrue: [unfiltered addAll: aClass namedTileScriptSelectors. unfiltered addAll: (aClass slotInfo keys asSortedArray collect: [:anInstVarName | Utilities getterSelectorFor: anInstVarName])]. ^ (unfiltered copyWithoutAll: #(dummy unused)) asSortedArray! ! !ScreenedVocabulary methodsFor: 'enumeration' stamp: 'sw 1/5/2001 06:55'! allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass "Answer a list of all methods in the vocabulary which are in the given category, on behalf of the given class and object" ^ (super allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass) select: [:aSelector | self includesSelector: aSelector]! ! !ScreenedVocabulary methodsFor: 'enumeration' stamp: 'sw 12/14/2000 14:03'! categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass "Answer the category list for the given object/class, considering only code implemented in mostGenericClass and lower" ^ (super categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass) select: [:aCategory | categoryScreeningBlock value: aCategory]! ! !ScreenedVocabulary methodsFor: 'queries' stamp: 'sw 12/14/2000 14:06'! includesSelector: aSelector "Answer whether the given selector is known to the vocabulary" ^ methodScreeningBlock value: aSelector! ! !ScreenedVocabulary methodsFor: 'queries' stamp: 'sw 12/14/2000 06:01'! includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass "Answer whether the vocabulary includes the given selector for the given object, only considering method implementations in mostGenericClass and lower" ^ (super includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass) and: [self includesSelector: aSelector]! ! !ScreenedVocabulary methodsFor: 'initialization' stamp: 'sw 12/14/2000 13:58'! categoryScreeningBlock: aBlock "Set the receiver's categoryScreeningBlock to the block provided" categoryScreeningBlock _ aBlock! ! !ScreenedVocabulary methodsFor: 'initialization' stamp: 'sw 12/4/2000 04:40'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. vocabularyName _ #Public. self documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'! ! !ScreenedVocabulary methodsFor: 'initialization' stamp: 'sw 12/14/2000 13:57'! methodScreeningBlock: aBlock "Set the receiver's methodScreeningBlock to the block provided" methodScreeningBlock _ aBlock! ! !Vocabulary class methodsFor: 'class initialization' stamp: 'sw 5/24/2001 13:49'! addKiswahiliVocabulary "Add a Kiswahili vocabulary" "Vocabulary addKiswahiliVocabulary" | voc | voc _ EToyVocabulary new vocabularyName: 'Kiswahili'. self addVocabulary: voc. voc translateMethodInterfaceWordings: #( (append: 'tia mwishoni' 'weka kitu hicho mwishoni') (beep: 'fanya kelele' 'piga kelele fulani') (bounce: 'ruka duta' 'ruka duta kama mpira') (cameraPoint 'penye kamera' 'mahali penya kamera') (clear 'kumba' 'ondoa vilivyokwemo') (clearOwnersPenTrails 'ondoa nyayo' 'ondoa nyayo za wino') (clearTurtleTrails 'ondoa nyayo ndani' 'ondoa nyayo za wino zilzo ndani') (color:sees: 'rangi yaona rangi' 'kama rangi fulana yaona rangi nyingine') (deleteCard 'tupa karata' 'tupa karata hii') (doMenuItem: 'fanya uchaguzi' 'fanya uchaguzi fulani') (emptyScript 'script tupu' 'tengeneza script mpya tupu') (fire 'waka' 'waka script, yaani kuianzisha') (firstPage 'nenda mwanzoni' 'nenda penye ukurasa wa kwanza') (followPath 'fuata njia' 'fuata njia iliyofanywa kabla') (forward: 'nenda mbele' 'sogea mbela kwa kiasi fulani') (goToFirstCardInBackground 'endea kwanza ya nyuma' 'endea karata kwanza ya nyuma') (goToFirstCardOfStack 'endea kwanza ya stack' 'endea karata iliyo ya kwanza ya stack') (goToLastCardInBackground 'endea mwisho ya nyuma' 'endea karata ya mwisho ya nyuma') (goToLastCardOfStack 'endea mwisho ya stack' 'endea karata ya mwisho ya stack') (goToNextCardInStack 'endea karata ifuatayo' 'endea karata itakayofuata penye stack') (goToPreviousCardInStack 'endea karata itanguliayo' 'endea karata kliyonitangulia penye stack') (goToRightOf: 'endea karibu ya kulia' 'sogea hata nipo upande wa kulia kuhusu kitu fulani') (goto: 'endea mahali fulani' 'endea mahali fulani') (hide 'ficha' 'nifanywe ili nisionekane') (initiatePainting 'anza kupiga picha' 'anza kupiga picha mpya') (insertCard 'weka karata mpya' 'weka karata mpya ndani ya stack') (lastPage 'ukurasa wa mwisho' 'endea ukurasa ya mwisho') (liftAllPens 'inua kalamu zote' 'inua kalamu zote zilizomo ndani, ili zisipige rangi') (loadSineWave 'pakia wimbi la sine' 'pakia wimibi (la kitrigonometry) la sine') (loadSound: 'pakia kelele' 'pakia kelele fulani') (lowerAllPens 'telemsha kalamu zote' 'telemsha kalamu zote ya vitu vyote vilivyomo ndani') (makeNewDrawingIn: 'anza kupiga picha kiwanjani' 'anza kupaga picha mpya ndani ya kiwanja') (moveToward: 'nenda upande wa' 'nenda upande wa kitu fulani') (nextPage 'endea ukurasa ufuatao' 'nenda ukurasani unaofuata') (pauseScript: 'pumzisha script' 'pumzisha script fulani') (play 'cheza' 'cheza, basi!!') (previousPage 'endea ukurasa uliotangulia' 'enda ukurasa uliotangulia ukurusa huu') (removeAll 'ondoa vyote vilivyokuwemo' 'ondoa vitu vyote vilvyomo dani') (reverse 'kinyume' 'kinyume cha upande') (roundUpStrays 'kusanya' 'sanya vitu vilovyopotoleka') (seesColor: 'yaona rangi' 'kama naona rangi fulani') (show 'onyesha' 'fanya hata naonekana') (shuffleContents 'changanya' 'changanya orodha ya ndani') (stampAndErase 'piga chapa na kufuta' 'piga chapa, halafu kufuta') (startScript: 'anzisha script' 'anzisha script ya jina fulani') (stopScript: 'simamisa skriptu' 'simamisha script ya jana fulani') (tellAllSiblings: 'watangazie ndugu' 'tangaza habari kwa ndugu zangu wote') (touchesA: 'yagusa' 'kama nagusa kitu cha aina fulani') (turn: 'geuka' 'geuka kwa pembe fulani') (unhideHiddenObjects 'onyesha vilivyofichwa' 'onyesha vitu ndani vilivyofichwa') (wearCostumeOf: 'vaa nguo za' 'vaa nguo za mtu mwingine') (wrap 'zunguka' 'baada ya kutoka, ingia n''gambo') (getActWhen 'waka kama' 'lini ya waka') (getAllButFirstCharacter 'herufi ila ya kwanza' 'herufi zote isipokuwa ile ya kwanza tu') (getAmount 'kiasi' 'kiasi gani') (getAngle 'pembe' 'pembe iliyopo (degree)') (getBorderColor 'rangi ya mpaka' 'rangi ya mpaka wangu') (getBorderWidth 'upana wa mpaka' 'upana wa mpaka wangu') (getBottom 'chini' 'chini yangu') (getBrightnessUnder 'mng''aro chini' 'mwangaza chini yangu') (getCharacters 'herufi' 'herufi zangu') (getColor 'rangi' 'rangi yangu') (getColorUnder 'rangi chini' 'rangi chini yangu') (getConePosition 'penye cone' 'mahali penye cone') (getCursor 'kidole' 'namba ya kitu ndani kilichagulwa') (getDescending 'kama yaenda chini' 'kama naonyesha vitu chini') (getDistance 'urefu' 'urefu kutoka asili') (getFirstCharacter 'herufi ya kwanza' 'herufi yangu ya kwanza') (getFirstElement 'kitu cha kwanza' 'kitu changu cha ndani cha kwanza') (getFogColor 'rangi ya ukungu' 'rangi ya ukungu wangu') (getFogDensity 'nguvu wa ukungu' 'nguvu ya ukungu wangu') (getFogRangeEnd 'mwisho wa ukungu' 'mwisho wa upana wa ukungu wangu') (getFogRangeStart 'mwanzo wa ukungu' 'mwanzo wa upana wa ukungu wangu') (getFogType 'aina ya ukungu' 'aina ya ukungu wangu') (getGraphic 'picha' 'picha ninayonyesha') (getGraphicAtCursor 'picha penye kidolee' 'picha iliyopo penye kidole changu') (getHeading 'upande' 'upande gani ninayoelekea') (getHeight 'urefu' 'urefu wangu') (getIndexInOwner 'namba kataki mwenyeji' 'namba niliyo nayo katika mwenyeji') (getIsUnderMouse 'chini kipanya' 'kama nipo chini ya kipanya') (getKnobColor 'rangi ya ndani' 'rangi ya sehemu yangu ya ndani') (getLabel 'tangazo' 'iliyoandishwa juu yangu') (getLastValue 'mapimo' 'iliyokuwemo ndani') (getLeft 'kushoto' 'mpaka wa kushoto') (getLeftRight 'kiasi cha sawasawa' 'kiasi cha kushoto ama kulia') (getLuminanceUnder 'uNg''aa chini' 'uNg''aa ya sehemu chini yangu') (getMaxVal 'kiasi cha juu' 'kiasi cha juu humu ndani') (getMinVal 'kiasi cha chini' 'kiasi cha chini humu ndani') (getMouseX 'x ya kipanya' 'mahali pa x pa kipanya') (getMouseY 'y ya kipanya' 'mahali pa y pa kipanya') (getNewClone 'nakala' 'fanya nakala yangu') (getNumberAtCursor 'namba kidoleni' 'namba iliyopo kidoleni') (getNumericValue 'namba humu' 'namba iliyopo katika kituc hicho') (getObtrudes 'jiingiliza' 'kama kitu hicho hujiingiliza') (getPenColor 'rangi ya kalamu' 'rangi ninayotumia kwa kalamu') (getPenDown 'kalamu chini' 'kama kalamu hukaa chini') (getPenSize 'upana wa kalamu' 'urefu wa kalamu ninayotumia') (getRight 'kulia' 'mpaka wa kulia') (getRoundedCorners 'viringisha' 'tumia pembe zilizoviringishwa') (getSampleAtCursor 'kiasi kidoleni' 'kiasi kilichopo kidoleni') (getSaturationUnder 'kunyewesha chini' 'kiasi cha kunyewesha chini ya kati yangu') (getScaleFactor 'kuzidisha kwa' 'kiasi ninachozidishwa nacho') (getTheta 'theta' 'pemba kwa x-axis') (getTop 'juu' 'mpaka wa juu') (getTruncate 'kata' 'kama kukata ama sivyo') (getUpDown 'juu/chini' 'kiasi cha juu ama cha chini') (getValueAtCursor 'mchezaji kidoleni' 'mchechazji aliyepo kidoneni') (getViewingByIcon 'angalia kwa picha' 'kama vitu vilivyomo ndani huanagaliwa kwa picha ama sivyo') (getX 'x' 'mahali pa x') (getY 'y' 'mahali ya y') (getWidth 'upana' 'upana wangu')). voc translateCategories: #( (basic muhimu 'mambo muhimu muhimu') (#'book navigation' #'kuongoza vitabu' 'kuhusu kuongozea vitabu') (button kifungo 'mambo kuhusu vifungo') (collections mikusanyo 'kuhusu mikusanyo ya vitu') (fog ukungu 'kuhusu ukungu (3D)') (geometry kupimia 'urefu na kadhaliki') (#'color & border' #'rangi & mpaka' 'kuhusu rangi na mpaka') (graphics picha 'mambo kuhusu picha') (#'instance variables' badiliko 'data zilizoundwa na yule atumiaye') (joystick #'fimbo la furaha' 'kuhusu fimbo la furaha, yaani "joystick"') (miscellaneous mbalimbali 'mambo mbalimbali') (motion kusogea 'kwenda, kuegeuka, etc.') (paintbox #'kupiga rangi' 'vitu kuhusu kupigia rangi') (#'pen trails' #'nyayo za kalamu' 'kuhusu nyay za kalamu') (#'pen use' #'kalamu' 'kuhusu kalamu') (playfield kiwanja 'vitu kuhusu kiwanjani') (sampling kuchagua 'mambo kuhusu kuchagua') (scripts scripts 'taratibu zilizoundwa na atumiaye') (slider telezo 'kitu kionyeshacho kiasi cha namba fulani') (speaker spika 'kuhusu spika za kelele') (#'stack navigation' #'kuongoza chungu' 'kuhuso kuongozea chungu') (storyboard kusimulia 'kusimilia hadithi') (tests kama 'amua kama hali fulani i kweli ama sivyo') (text maneno 'maandiko ya maneno') (viewing kuangaliwa 'kuhusu kuangalia vitu') ). ! ! !Vocabulary class methodsFor: 'class initialization' stamp: 'sw 5/23/2001 21:53'! initializeStandardVocabularies "Initialize a few standard vocabularies and place them in the AllVocabularies list." AllVocabularies _ OrderedCollection new. AllMethodInterfaces _ IdentityDictionary new. self addVocabulary: EToyVocabulary new. self addVocabulary: self newPublicVocabulary. self addVocabulary: FullVocabulary new. self addVocabulary: self newQuadVocabulary. self addKiswahiliVocabulary. "For testing/demo purposes" "self addVocabulary: self newNumberVocabulary." "self addVocabulary: self newTestVocabulary." "Vocabulary initialize" ! ! !Vocabulary class methodsFor: 'testing and demo' stamp: 'sw 5/25/2001 10:41'! kiswahiliVocabulary "Answer the kiswahili etoy vocabulary. This vocabulary provides a complete translation for the wordings on tiles in the classic Etoy vocabulary, and serves as a detailed illustration of the multilingual possibilities of tiling. No senders, other than from doits in debugging code, as in: Vocabulary kiswahiliVocabulary inspect" ^ self vocabularyNamed: 'Kiswahili'! ! EToyVocabulary removeSelector: #translateWordings:! Vocabulary removeSelector: #addTranslationsFrom:! Vocabulary removeSelector: #translateWordings:! Vocabulary removeSelector: #translationTable! Vocabulary removeSelector: #translationTable:! !Vocabulary reorganize! ('queries' allCategoryName allMethodsInCategory: allMethodsInCategory:forInstance:ofClass: allSelectorsInVocabulary atKey:putMethodInterface: categories categoriesContaining:forClass: categoryAt: categoryCommentFor: categoryList categoryListForInstance:ofClass:limitClass: categoryWithNameIn:thatIncludesSelector:forInstance:ofClass: classToUseFromInstance:ofClass: encompassesAPriori: includesDefinitionForSelector: includesSelector: includesSelector:forInstance:ofClass:limitClass: methodInterfaceAt:ifAbsent: methodInterfacesDo: methodInterfacesInCategory:forInstance:ofClass: someCategoryThatIncludes: tileWordingForSelector: vocabularyName) ('initialization' addCategory: addCategoryNamed: initialize initializeFor: initializeFromTable: renameCategoryFrom:to: vocabularyName:) ('translation' symbolWhoseTranslationIs: translateCategories: translateMethodInterfaceWordings: translatedWordingFor: translatedWordingsFor:) ('printing' printOn:) ! StandardViewer removeSelector: #adoptVocabulary:! StandardViewer removeSelector: #installVocabulary:! TileMorph removeSelector: #vocabulary:! StandardScriptingSystem initialize! StandardScriptingSystem removeSelector: #initReservedScriptNames! StandardScriptingSystem removeSelector: #initializeSystemSlotDictionary! StandardScriptingSystem removeSelector: #isAcceptablePlayerSlotName:! StandardScriptingSystem removeSelector: #isSystemScriptName:! StandardScriptingSystem removeSelector: #typeForSlotNamed:! StandardScriptingSystem removeSelector: #typeForSystemSlotNamed:! Player removeSelector: #elementTypeFor:! Player removeSelector: #universalTilesForGetterOf:! Lexicon removeSelector: #codePaneProvenanceButton! !ElementTranslation class reorganize! ('instance creation' fromPair:) ! !ElementTranslation reorganize! ('access' helpMessage wording) ('initialization' wording:helpMessage:) ('printing' printOn:) ! Object removeSelector: #elementTypeFor:! "Postscript:" Vocabulary initialize. !