'From Squeak3.1alpha of 28 February 2001 [latest update: #4109] on 31 May 2001 at 3:12:56 pm'! "Change Set: twoFixes-sw Date: 31 May 2001 Author: Scott Wallace (1) A fix for a problem with changing data type of an instance variable. (2) A fix for the tear-off-tile-getter-of-type feature."! !Player methodsFor: 'slots-user' stamp: 'sw 5/31/2001 15:08'! 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: (Utilities getterSelectorFor: slotChosen) type: typeChosen. aCategoryViewer _ CategoryViewer new initializeFor: self categoryChoice: 'basic'. playerGetter _ aCategoryViewer getterTilesFor: (Utilities getterSelectorFor: 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 ! ! !Presenter methodsFor: 'viewer' stamp: 'sw 5/31/2001 08:04'! 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 _ aCategorySymbol ifNotNil: [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! ! !StandardScriptingSystem methodsFor: 'universal slots & scripts' stamp: 'sw 5/31/2001 15:12'! systemSlotNamesOfType: aType "Answer the type of the slot name, or nil if not found." | aList | self flag: #deferred. "Hard-coded etoyVocabulary needed here to make this work." aList _ OrderedCollection new. Vocabulary eToyVocabulary methodInterfacesDo: [:anInterface | anInterface resultType == aType ifTrue: [aList add: anInterface selector]]. ^ aList! !