'From Squeak3.1alpha of 28 February 2001 [latest update: #4103] on 30 May 2001 at 2:04:46 am'! "Change Set: vocabSwitch-sw Date: 30 May 2001 Author: Scott Wallace When the user switches to a different vocabulary in a Viewer, all the scripts and viewer panes belonging to the object in question are now transformed so that they show the new vocabulary."! Viewer subclass: #CategoryViewer instanceVariableNames: 'namePane chosenCategorySymbol ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Scripting'! !Object methodsFor: 'macpal' stamp: 'sw 5/29/2001 22:33'! methodInterfacesForCategory: aCategorySymbol inViewer: aViewer "Return a list of methodInterfaces for use in a viewer on the receiver. aCategorySymbol is the inherent category symbol, not necessarily the wording as expressed in the current vocabulary." | categorySymbol | categorySymbol _ aCategorySymbol asSymbol. (categorySymbol == #'instance variables') ifTrue: "user-defined instance variables" [^ self methodInterfacesForInstanceVariablesCategoryIn: aViewer]. (categorySymbol == #scripts) ifTrue: "user-defined scripts" [^ self methodInterfacesForScriptsCategoryIn: aViewer]. ^ (self usableMethodInterfacesIn: (aViewer currentVocabulary methodInterfacesInCategory: (aViewer currentVocabulary translatedWordingFor: categorySymbol) forInstance: self ofClass: self class)) "all others"! ! !Object methodsFor: 'viewer' stamp: 'sw 5/29/2001 22:44'! tilePhrasesForCategory: aCategorySymbol inViewer: aViewer "Return a collection of phrases for the category. If using classic tiles, only include phrases that have fewer than two arguments, because all that they can handle." | interfaces itsSelector | interfaces _ self methodInterfacesForCategory: aCategorySymbol inViewer: aViewer. Preferences universalTiles ifFalse: [interfaces _ interfaces select: [:int | itsSelector _ int selector. itsSelector numArgs < 2 or: "The lone two-arg loophole in classic tiles" [#(color:sees:) includes: itsSelector]]]. ^ interfaces collect: [:aMethodInterface | aMethodInterface wantsReadoutInViewer ifTrue: [aViewer phraseForVariableFrom: aMethodInterface] ifFalse: [aViewer phraseForCommandFrom: aMethodInterface]]! ! !PhraseTileMorph methodsFor: 'initialization' stamp: 'sw 5/29/2001 17:28'! setAssignmentRoot: opSymbol type: opType rcvrType: rcvrType argType: argType vocabulary: aVocabulary "Add submorphs to make me constitute a setter of the given symbol" | anAssignmentTile | resultType _ opType. self color: (ScriptingSystem colorForType: opType). self removeAllMorphs. self addMorph: (TilePadMorph new setType: rcvrType). anAssignmentTile _ AssignmentTileMorph new rawVocabulary: aVocabulary. self addMorphBack: (anAssignmentTile typeColor: color). anAssignmentTile setRoot: opSymbol asString dataType: argType. self addMorphBack: (TilePadMorph new setType: argType)! ! !Player methodsFor: 'pen' stamp: 'sw 5/29/2001 11:07'! addPlayerMenuItemsTo: aMenu hand: aHandMorph "Note that these items are primarily available in another way in an object's Viewer" | subMenu | subMenu _ MenuMorph new defaultTarget: self. self getPenDown ifTrue: [subMenu add: 'lift pen' action: #liftPen] ifFalse: [subMenu add: 'lower pen' action: #lowerPen]. subMenu add: 'choose pen size...' action: #choosePenSize. subMenu add: 'choose pen color...' action: #choosePenColor:. aMenu add: 'pen...' subMenu: subMenu! ! !Player methodsFor: 'slots-kernel' stamp: 'sw 5/29/2001 13:57'! typeForSlot: aSlotName "Answer the data type for values of the instance variable of the given name" | getter | (self slotInfo includesKey: aSlotName) ifTrue: [^ (self slotInfoAt: aSlotName) 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-user' stamp: 'sw 5/29/2001 11:10'! chooseSlotTypeFor: aGetter "Let the user designate a type for the slot associated with the given getter" | typeChoices typeChosen slotName | slotName _ Utilities inherentSelectorForGetter: aGetter. typeChoices _ #(number player boolean color string graphic sound "point costume"). typeChosen _ (SelectionMenu selections: typeChoices lines: #()) startUpWithCaption: 'Choose the TYPE for ', slotName. typeChosen isEmptyOrNil ifTrue: [^ self]. (self typeForSlot: slotName) = typeChosen ifTrue: [^ self]. (self slotInfoAt: slotName) type: typeChosen. self class allInstancesDo: "allSubInstancesDo:" [:anInst | anInst instVarNamed: slotName asString put: (anInst valueOfType: typeChosen from: (anInst instVarNamed: slotName))]. self updateAllViewers. "does siblings too" ! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 5/29/2001 19:45'! 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 newClone getNewClone) includes: slotSym) ifFalse: [aMenu add: 'simple watcher' selector: #tearOffWatcherFor: argument: aGetterSymbol]. (#(copy getNewClone newClone) 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: aGetterSymbol. aType == #number ifTrue: [aMenu add: 'decimal places...' selector: #setPrecisionFor: argument: slotSym]. aMenu add: 'remove "', slotSym, '"' selector: #removeSlotNamed: argument: slotSym. aMenu add: 'rename "', slotSym, '"' 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! ! !Presenter methodsFor: 'viewer' stamp: 'sw 5/29/2001 23:47'! updateViewer: aViewer forceToShow: aCategorySymbol "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 aCategory | aCategory _ aViewer currentVocabulary translatedWordingFor: aCategorySymbol. cats _ aViewer symbolsOfCategoriesCurrentlyShowing asOrderedCollection. itsVocabulary _ aViewer currentVocabulary. aCategory ifNotNil: [(cats includes: aCategorySymbol) ifFalse: [cats addFirst: aCategorySymbol]]. 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! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/29/2001 00:00'! adoptVocabulary: aVocabulary "Set the receiver's vocabulary" vocabulary _ aVocabulary. self updateWordingToMatchVocabulary. super adoptVocabulary: aVocabulary! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/29/2001 13:41'! rawVocabulary: aVocabulary "Set the receiver's vocabulary, without side effects." vocabulary _ aVocabulary! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/29/2001 00:40'! 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]. self updateLiteralLabel "operatorOrExpression == #heading ifTrue: [self halt]."! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/29/2001 01:03'! setSlotRefOperator: getter "getter represents the name of a slot that the receiver is to represent; configure the receiver to serve thi duty, and set upthe wording on the tile appropriately" type _ #operator. operatorOrExpression _ getter asSymbol. self line1: (self currentVocabulary tileWordingForSelector: operatorOrExpression). self updateLiteralLabel! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 5/29/2001 17:42'! updateWordingToMatchVocabulary "The current vocabulary has changed; change the wording on my face, if appropriate" | aMethodInterface | type == #operator ifTrue: [self line1: (self currentVocabulary tileWordingForSelector: operatorOrExpression). (ScriptingSystem doesOperatorWantArrows: operatorOrExpression) ifTrue: [self addArrows]. self updateLiteralLabel. aMethodInterface _ self currentVocabulary methodInterfaceAt: operatorOrExpression ifAbsent: [Vocabulary eToyVocabulary methodInterfaceAt: operatorOrExpression ifAbsent: [^ self]]. self setBalloonText: aMethodInterface documentation. "submorphs last setBalloonText: aMethodInterface documentation"]! ! !AssignmentTileMorph methodsFor: 'initialization' stamp: 'sw 5/30/2001 02:00'! computeOperatorOrExpression "Compute the operator or expression to use, and set the wording correectly on the tile face" | aSuffix wording anInterface getter | operatorOrExpression _ (assignmentRoot, assignmentSuffix) asSymbol. aSuffix _ self currentVocabulary translatedWordingFor: assignmentSuffix. getter _ Utilities getterSelectorFor: assignmentRoot. anInterface _ self currentVocabulary methodInterfaceAt: getter ifAbsent: [Vocabulary eToyVocabulary methodInterfaceAt: getter ifAbsent: [nil]]. wording _ anInterface ifNotNil: [anInterface elementWording] ifNil: [assignmentRoot copyWithout: $:]. operatorReadoutString _ wording, ' ', aSuffix. self line1: operatorReadoutString. self addArrowsIfAppropriate! ! !Viewer methodsFor: 'commands' stamp: 'sw 5/30/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'. "aMenu addStayUpItem." "For debugging only" 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: 'initialization' stamp: 'sw 5/29/2001 10:44'! initializeFor: aPlayer categoryChoice: aChoice "Initialize the receiver to be associated with the player and category specified" self listDirection: #topToBottom; hResizing: #spaceFill; vResizing: #spaceFill; borderWidth: 1; beSticky. self color: Color green muchLighter muchLighter. scriptedPlayer _ aPlayer. self addHeaderMorph. self chosenCategorySymbol: aChoice asSymbol ! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 17:49'! adoptVocabulary: aVocabulary "Answer the inherent category currently being shown, not necessarily the same as the translated word" chosenCategorySymbol ifNil: [^ self delete]. self updateCategoryNameTo: (aVocabulary translatedWordingFor: chosenCategorySymbol). super adoptVocabulary: aVocabulary! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 22:06'! categoryWording: aCategoryWording "Make the category with the given wording be my current one." | bin actualPane | (actualPane _ namePane renderedMorph) firstSubmorph contents: aCategoryWording; color: Color black. actualPane extent: actualPane firstSubmorph extent. bin _ PhraseWrapperMorph new borderWidth: 0; listDirection: #topToBottom. bin addAllMorphs: ((scriptedPlayer tilePhrasesForCategory: chosenCategorySymbol inViewer: self) collect: [:aViewerRow | self viewerEntryFor: aViewerRow]). bin enforceTileColorPolicy. submorphs size < 2 ifTrue: [self addMorphBack: bin] ifFalse: [self replaceSubmorph: self listPane by: bin]. self secreteCategorySymbol. self world ifNotNil: [self world startSteppingSubmorphsOf: self] ! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 10:46'! chooseCategory "The mouse went down on the receiver; pop up a list of category choices" | aList aMenu reply aLinePosition lineList | aList _ scriptedPlayer categoriesForViewer: self. aLinePosition _ aList indexOf: #miscellaneous ifAbsent: [nil]. lineList _ aLinePosition ifNil: [#()] ifNotNil: [Array with: aLinePosition]. aMenu _ CustomMenu labels: aList lines: lineList selections: aList. reply _ aMenu startUpWithCaption: 'category'. reply ifNil: [^ self]. self chooseCategoryWhoseTranslatedWordingIs: reply asSymbol ! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 10:46'! chooseCategoryWhoseTranslatedWordingIs: aWording "Choose the category with the given wording" self chosenCategorySymbol: (self currentVocabulary symbolWhoseTranslationIs: aWording asSymbol) ! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 22:43'! chosenCategorySymbol "Answer the inherent category currently being shown, not necessarily the same as the translated word." ^ chosenCategorySymbol ifNil: [self secreteCategorySymbol]! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/30/2001 01:06'! chosenCategorySymbol: aCategorySymbol "Make the given category be my current one." chosenCategorySymbol _ aCategorySymbol. self categoryWording: (self currentVocabulary translatedWordingFor: aCategorySymbol)! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 10:47'! nextCategory "Change the receiver to point at the category following the one currently seen" | aList anIndex newIndex already aChoice | aList _ scriptedPlayer categoriesForViewer: self. already _ self outerViewer ifNil: [#()] ifNotNil: [self outerViewer categoriesCurrentlyShowing]. anIndex _ aList indexOf: self currentCategory ifAbsent: [0]. newIndex _ anIndex = aList size ifTrue: [1] ifFalse: [anIndex + 1]. [already includes: (aChoice _ aList at: newIndex)] whileTrue: [newIndex _ (newIndex \\ aList size) + 1]. self chooseCategoryWhoseTranslatedWordingIs: aChoice! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 10:47'! previousCategory "Change the receiver to point at the category preceding the one currently seen" | aList anIndex newIndex already aChoice | aList _ scriptedPlayer categoriesForViewer: self. already _ self outerViewer ifNil: [#()] ifNotNil: [self outerViewer categoriesCurrentlyShowing]. anIndex _ aList indexOf: self currentCategory ifAbsent: [aList size + 1]. newIndex _ anIndex = 1 ifTrue: [aList size] ifFalse: [anIndex - 1]. [already includes: (aChoice _ aList at: newIndex)] whileTrue: [newIndex _ newIndex = 1 ifTrue: [aList size] ifFalse: [newIndex - 1]]. self chooseCategoryWhoseTranslatedWordingIs: aChoice! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 09:48'! secreteCategorySymbol "Set my chosenCategorySymbol by translating back from its representation in the namePane. Answer the chosenCategorySymbol" ^ chosenCategorySymbol _ self currentVocabulary symbolWhoseTranslationIs: self currentCategory! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 11:41'! updateCategoryNameTo: aName "Update the category name, because of a language change." | actualPane | (actualPane _ namePane firstSubmorph) contents: aName; color: Color black. namePane extent: actualPane extent. self world ifNotNil: [self world startSteppingSubmorphsOf: self] ! ! !CategoryViewer methodsFor: 'header pane' stamp: 'sw 5/30/2001 00:30'! addHeaderMorph "Add the header at the top of the viewer, with a control for choosing the category, etc." | header aFont aButton wrpr | header _ AlignmentMorph newRow color: self color; wrapCentering: #center; cellPositioning: #leftCenter. aFont _ Preferences standardButtonFont. header addMorph: (aButton _ SimpleButtonMorph new label: 'O' font: aFont). aButton target: self; color: Color tan; actionSelector: #delete; setBalloonText: 'remove this pane from the screen don''t worry -- nothing will be lost!!.'. header addTransparentSpacerOfSize: 5@5. header addUpDownArrowsFor: self. (wrpr _ header submorphs last) submorphs second setBalloonText: 'previous category'. wrpr submorphs first setBalloonText: 'next category'. header beSticky. self addMorph: header. namePane _ RectangleMorph newSticky color: Color brown veryMuchLighter. namePane borderWidth: 0. aButton _ (StringButtonMorph contents: '-----' font: (StrikeFont familyName: #NewYork size: 12)) color: Color black. aButton target: self; arguments: Array new; actionSelector: #chooseCategory. aButton actWhen: #buttonDown. namePane addMorph: aButton. aButton position: namePane position. namePane align: namePane topLeft with: (bounds topLeft + (50 @ 0)). namePane setBalloonText: 'category (click here to choose a different one)'. header addMorphBack: namePane. (namePane isKindOf: RectangleMorph) ifTrue: [namePane addDropShadow. namePane shadowColor: Color gray]. chosenCategorySymbol _ #basic! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 5/29/2001 11:44'! 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: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/29/2001 00: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 selector 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: 'get/set slots' stamp: 'sw 5/29/2001 14:24'! getterButtonFor: getterSelector type: partType "Answer a classic-tiles getter button for a part of the given name" | m | m _ TileMorph new adoptVocabulary: self currentVocabulary. m setOperator: getterSelector. m typeColor: (ScriptingSystem colorForType: partType). m on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: getterSelector with: partType). ^ m! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 5/29/2001 17:48'! getterTilesFor: getterSelector type: aType "Answer classic getter for the given name/type" | selfTile selector aPhrase | "aPhrase _ nil, assumed" (#(color:sees: colorSees) includes: getterSelector) ifTrue: [aPhrase _ self colorSeesPhrase]. (#(seesColor: isOverColor) includes: getterSelector) ifTrue: [aPhrase _ self seesColorPhrase]. (#(touchesA: touchesA) includes: getterSelector) ifTrue: [aPhrase _ self touchesAPhrase]. aPhrase ifNil: [aPhrase _ PhraseTileMorph new setSlotRefOperator: getterSelector 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/29/2001 13:44'! 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 vocabulary: self currentVocabulary. 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! ! !StandardViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 23:11'! addCategoryViewerFor: catSymbol "Add a category viewer for the given category" | aViewer | self addMorphBack: (aViewer _ CategoryViewer new). aViewer initializeFor: scriptedPlayer categoryChoice: catSymbol. self world ifNotNil: [self world startSteppingSubmorphsOf: aViewer]! ! !StandardViewer methodsFor: 'categories' stamp: 'sw 5/29/2001 22:43'! symbolsOfCategoriesCurrentlyShowing "Answer the category symbols of my categoryMorphs" ^ self categoryMorphs collect: [:m | m chosenCategorySymbol]! ! !StandardViewer methodsFor: 'initialization' stamp: 'sw 5/29/2001 11:31'! 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. ((scriptedPlayer isKindOf: Player) and: [self isUniversalTiles not]) ifTrue: [scriptedPlayer allScriptEditors do: [:aScriptEditor | aScriptEditor adoptVocabulary: aVocabulary]]! ! !Vocabulary methodsFor: 'queries' stamp: 'sw 5/29/2001 11:56'! tileWordingForSelector: aSelector "Answer the wording to emblazon on tiles representing aSelector" | anInterface | anInterface _ self methodInterfaceAt: aSelector asSymbol ifAbsent: [^ Utilities inherentSelectorForGetter: aSelector]. ^ anInterface elementWording! ! !Vocabulary methodsFor: 'translation' stamp: 'sw 5/30/2001 00:40'! addToTranslationTableFrom: categoryTriplets "Create entries in my translationTable from catetgoryTriplets. Each triplet has: (key wording balloon-help)" translationTable ifNil: [translationTable _ IdentityDictionary new]. categoryTriplets do: [:trip | translationTable at: trip first put: (ElementTranslation fromPair: trip allButFirst)]. ! ! !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/30/2001 00:40'! translateCategories: categoryTriplets "Go through my categories, translating wordings via catetgoryTriplets. Each triplet has: (oldCategoryName newCategoryWording balloon-help)" | itsName | self addToTranslationTableFrom: categoryTriplets. 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/30/2001 02:00'! 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 asSymbol ifAbsent: [^ aSymbol]. ^ translation wording ! ! !EToyVocabulary methodsFor: 'initialization' stamp: 'sw 5/30/2001 00:47'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" | classes aMethodCategory selector selectors categorySymbols | super initialize. self vocabularyName: #eToy. self documentation: '"EToy" is a vocabulary that provides the equivalent of the 1997-2000 etoy prototype'. categorySymbols _ Set new. classes _ self morphClassesDeclaringViewerAdditions. classes do: [:aMorphClass | categorySymbols addAll: aMorphClass basicNew categoriesForViewer]. categorySymbols asOrderedCollection do: [:aCategorySymbol | aMethodCategory _ ElementCategory new categoryName: aCategorySymbol. selectors _ Set new. classes do: [:aMorphClass | (aMorphClass additionsToViewerCategory: aCategorySymbol) do: [:anElement | anElement first == #command ifTrue: [selectors add: (selector _ anElement second). (methodInterfaces includesKey: selector) ifFalse: [methodInterfaces at: selector put: (MethodInterface new initializeFromEToyCommandSpec: anElement category: aCategorySymbol)]] ifFalse: "#slot format" [selectors add: (selector _ anElement seventh). "the getter" (methodInterfaces includesKey: selector) ifFalse: [self addGetterAndSetterInterfacesFromOldSlotSpec: anElement]]]]. (selectors copyWithout: #unused) asSortedArray do: [:aSelector | aMethodCategory elementAt: aSelector put: (methodInterfaces at: aSelector)]. self addCategory: aMethodCategory]. #(scripts #'instance variables') do: [:sym | self addCategoryNamed: sym]. self setCategoryDocumentationStrings. self addToTranslationTableFrom: #( (: '_' 'assign value') (Incr: 'increase by' 'increase value by') (Decr: 'decrease by' 'decrease value by') (Mult: 'multiply by' 'multiply value by')). ! ! !Vocabulary class methodsFor: 'class initialization' stamp: 'sw 5/30/2001 00:43'! addKiswahiliVocabulary "Add a Kiswahili vocabulary" "Vocabulary addKiswahiliVocabulary" | voc | self removeVocabularyNamed: 'Kiswahili'. self removeVocabularyNamed: 'Kiswahili - EToy'. voc _ EToyVocabulary new vocabularyName: 'Kiswahili - EToy'. 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 addToTranslationTableFrom: #( (: '_' 'tia ndani') (Incr: 'pamoja na' 'tia thamani + fulani') (Decr: 'toa' 'tia thamani - fulani') (Mult: 'mara' 'tia thamani * fulani')). 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 taratibu '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/29/2001 11:16'! 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. self addGermanVocabulary. "self addVocabulary: self newNumberVocabulary." "self addVocabulary: self newTestVocabulary." "Vocabulary initialize" ! ! !Vocabulary class methodsFor: 'testing and demo' stamp: 'sw 5/29/2001 11:15'! 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 - EToy'! ! CategoryViewer removeSelector: #categoryChoice:! Player removeSelector: #changeVariableType! Player removeSelector: #methodInterfacesForCategory:inViewer:! "Postscript:" Vocabulary initialize. !