'From Squeak3.1alpha [latest update: #''Squeak3.1alpha'' of 28 February 2001 update 3923] on 11 April 2001 at 8:24:10 pm'! "Change Set: doublePossessive-sw Date: 11 April 2001 Author: Scott Wallace Allows easy construction of otherwise-awkward 'double-possessive' phrases in classic tiles, by adding a menu-item in the viewer for player-valued slots so that you can directly obtain tile phrases of the form 'holder's playerAtCursor's graphic'. Also removes a number of methods and does various cleanup in some of the terrain traversed."! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 4/6/2001 00:58'! getterTilesFor: partName type: aType "Answer classic getter for the given name/type" | m selfTile selector | (#(colorSees isOverColor touchesA) includes: partName) ifFalse: [m _ PhraseTileMorph new setSlotRefOperator: partName asSymbol type: aType] ifTrue: [partName == #colorSees ifTrue: [m _ self colorSeesPhrase]. partName == #isOverColor ifTrue: [m _ self seesColorPhrase]. partName == #touchesA ifTrue: [m _ self touchesAPhrase]]. selfTile _ self tileForSelf bePossessive. selfTile position: m firstSubmorph position. m firstSubmorph addMorph: selfTile. selector _ m submorphs at: 2. (aType == #number) ifTrue: [selector addSuffixArrow]. selector updateLiteralLabel. m enforceTileColorPolicy. ^ m! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 4/6/2001 00:59'! makeGetter: args event: evt from: aMorph "Hand the user tiles representing a classic getter on the slot represented by aMorph" | tiles | tiles _ self getterTilesFor: args first type: args second. owner ifNotNil: [self primaryHand attachMorph: tiles] ifNil: [^ tiles] ! ! !MethodInterface methodsFor: 'access' stamp: 'sw 4/5/2001 22:21'! printOn: aStream "print the receiver on a stream. Overridden to provide details about wording, selector, result type, and companion setter." super printOn: aStream. aStream nextPutAll: ' - wording: ''', self elementWording asString, ''' selector: #', selector asString. self argumentVariables size > 0 ifTrue: [aStream nextPutAll: 'Arguments: '. argumentVariables doWithIndex: [:aVariable :anIndex | aStream nextPutAll: 'argument #', anIndex printString, ' name = ', aVariable variableName asString, ', type = ', aVariable variableType]]. resultSpecification ifNotNil: [aStream nextPutAll: ' result type = ', resultSpecification resultType asString. resultSpecification companionSetterSelector ifNotNil: [aStream nextPutAll: ' setter = ', resultSpecification companionSetterSelector asString]] ! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 4/5/2001 22:13'! getFirstElement "Answer a player representing the receiver's costume's first submorph" | itsMorphs | ^ (itsMorphs _ costume submorphs) size > 0 ifFalse: [costume presenter standardPlayer] ifTrue: [itsMorphs first assuredPlayer]! ! !Player methodsFor: 'slots-user' stamp: 'sw 4/8/2001 00:26'! 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; "listDirection: #leftToRight; wrapCentering: #center;" hResizing: #shrinkWrap; vResizing: #spaceFill. ActiveHand attachMorph: getterTiles ! ! !Player methodsFor: 'slots-user' stamp: 'sw 4/8/2001 00:11'! slotNamesOfType: aType "Answer a list of potential slot names of the given type in the receiver" | fullList forViewer | fullList _ (ScriptingSystem systemSlotNamesOfType: aType), (self slotInfo select: [:info | info type == aType] thenCollect: [:info | info slotName]). forViewer _ costume renderedMorph selectorsForViewer select: [:aSel | aSel beginsWith: 'get'] thenCollect: [:aSel | Utilities inherentSelectorForGetter: aSel]. ^ fullList select: [:anItem | forViewer includes: anItem]! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 4/5/2001 21:58'! slotInfoButtonHitFor: aSlotName inViewer: aViewer "The user made a gesture asking for info/menu relating" | aMenu slotSym aType | slotSym _ aSlotName asSymbol. aType _ self typeForSlot: aSlotName asSymbol. aMenu _ MenuMorph new defaultTarget: self. (#(colorSees copy getNewClone) includes: slotSym) ifFalse: [aMenu add: 'simple watcher' selector: #tearOffWatcherFor: argument: slotSym]. (#(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: slotSym]. (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 "', aSlotName, '"' selector: #removeSlotNamed: argument: slotSym. aMenu add: 'rename "', aSlotName, '"' 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: (aSlotName asString, ' (', aType, ')'). aMenu popUpForHand: aViewer primaryHand in: aViewer world! ! !PlayerReferenceReadout methodsFor: 'mouse down' stamp: 'sw 4/5/2001 21:48'! mouseDown: evt "Allow the user to respecify this by direct clicking" | aMorph | (putSelector == #unused or: [putSelector == nil]) ifTrue: [^ self]. Sensor waitNoButton. aMorph _ self world chooseClickTarget. aMorph ifNil: [^ self]. objectToView perform: putSelector with: aMorph assuredPlayer. self changed! ! !StandardScriptingSystem methodsFor: 'universal slots & scripts' stamp: 'sw 4/5/2001 22:47'! systemSlotNamesOfType: aType "Answer the type of the slot name, or nil if not found." | aList | aList _ OrderedCollection new. SystemSlotDictionary associationsDo: [:assoc | assoc value == aType ifTrue: [aList add: assoc key]]. ^ aList! ! !StandardScriptingSystem methodsFor: 'universal slots & scripts' stamp: 'sw 4/5/2001 22:41'! typeForSlotNamed: aSlotName "Answer the type of the slot name, or nil if not found." ^ SystemSlotDictionary at: aSlotName ifAbsent: [^ nil]! ! TilePadMorph removeSelector: #tilesFrom:in:! TileMorph removeSelector: #tilesFrom:type:in:! BooleanScriptEditor removeSelector: #tilesFrom:! ScriptEditorMorph removeSelector: #tilesFrom:! !PlayerReferenceReadout reorganize! ('initialization' objectToView:viewSelector:putSelector:) ('mouse down' handlesMouseDown: mouseDown:) ! Player removeSelector: #standardPlayer! PhraseTileMorph removeSelector: #tilesFrom:in:! CompoundTileMorph removeSelector: #tilesFrom:in:! CategoryViewer removeSelector: #getterTilesFor:type:event:from:!