[squeak-dev] The Trunk: EToys-fbs.114.mczcommits at source.squeak.org commits at source.squeak.orgSat Nov 30 12:39:08 UTC 2013
Frank Shearar uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-fbs.114.mcz ==================== Summary ==================== Name: EToys-fbs.114 Author: fbs Time: 30 November 2013, 10:54:44.004 am UUID: 9c792e38-b75c-a34b-86e1-303566cfd28c Ancestors: EToys-fbs.113 Update eToys to the new selector-mangling API based on String/Symbol, rather than Utilities class. =============== Diff against EToys-fbs.113 =============== Item was changed: ----- Method: AssignmentTileMorph>>computeOperatorOrExpression (in category 'initialization') ----- computeOperatorOrExpression "Compute the operator or expression to use, and set the wording correectly on the tile face" | aSuffix wording anInterface getter doc | operatorOrExpression := (assignmentRoot, assignmentSuffix) asSymbol. aSuffix := self currentVocabulary translatedWordingFor: assignmentSuffix. + getter := assignmentRoot asGetterSelector. - getter := Utilities getterSelectorFor: assignmentRoot. anInterface := self currentVocabulary methodInterfaceAt: getter ifAbsent: [Vocabulary eToyVocabulary methodInterfaceAt: getter ifAbsent: [nil]]. wording := anInterface ifNotNil: [anInterface wording] ifNil: [assignmentRoot copyWithout: $:]. (anInterface notNil and: [(doc := anInterface documentation) notNil]) ifTrue: [self setBalloonText: doc]. operatorReadoutString := wording translated, ' ', aSuffix. self line1: operatorReadoutString. self addArrowsIfAppropriate! Item was changed: ----- Method: AssignmentTileMorph>>storeCodeOn:indent: (in category 'code generation') ----- storeCodeOn: aStream indent: tabCount "Generate code for an assignment statement. The code generated looks presentable in the case of simple assignment, though the code generated for the increment/decrement/multiply cases is still the same old assignGetter... sort for now" + aStream nextPutAll: (assignmentRoot asSetterSelector). - aStream nextPutAll: (Utilities setterSelectorFor: assignmentRoot). aStream space."Simple assignment, don't need existing value" assignmentSuffix = ':' ifFalse: ["Assignments that require that old values be retrieved" self assignmentReceiverTile storeCodeOn: aStream indent: tabCount. aStream space. + aStream nextPutAll: (assignmentRoot asGetterSelector). - aStream nextPutAll: (Utilities getterSelectorFor: assignmentRoot). aStream space. aStream nextPutAll: (self operatorForAssignmentSuffix: assignmentSuffix). aStream space]! Item was changed: ----- Method: CategoryViewer>>getterButtonFor:type: (in category 'get/set slots') ----- getterButtonFor: getterSelector type: partType "Answer a classic-tiles getter button for a part of the given name" | m inherent wording | m := TileMorph new adoptVocabulary: self currentVocabulary. + inherent := getterSelector inherentSelector. - inherent := Utilities inherentSelectorForGetter: getterSelector. wording := (scriptedPlayer slotInfo includesKey: inherent) ifTrue: [inherent] ifFalse: [self currentVocabulary tileWordingForSelector: getterSelector]. m setOperator: getterSelector andUseWording: wording. m typeColor: (ScriptingSystem colorForType: partType). m on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: getterSelector with: partType). ^ m! Item was changed: ----- Method: CategoryViewer>>makeSetter:event:from: (in category 'get/set slots') ----- 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 actualGetter | selectorAndTypePair first = #getPatchValueIn: ifTrue: [^ self makeSetterForGetPatchValue: selectorAndTypePair event: evt from: aMorph]. selectorAndTypePair first = #getRedComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #red event: evt from: aMorph]. selectorAndTypePair first = #getBlueComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #blue event: evt from: aMorph]. selectorAndTypePair first = #getGreenComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #green event: evt from: aMorph]. argType := selectorAndTypePair second. actualGetter := selectorAndTypePair first asSymbol. m := PhraseTileMorph new + setAssignmentRoot: actualGetter inherentSelector - setAssignmentRoot: (Utilities inherentSelectorForGetter: actualGetter) type: #command rcvrType: #Player argType: argType vocabulary: self currentVocabulary. argValue := self scriptedPlayer perform: selectorAndTypePair first asSymbol. argValue isPlayerLike ifTrue: [argTile := argValue tileReferringToSelf] ifFalse: [argTile := ScriptingSystem tileForArgType: argType. (argType == #Number and: [argValue isNumber]) ifTrue: [(scriptedPlayer decimalPlacesForGetter: actualGetter) ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]]. 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! Item was changed: ----- Method: CategoryViewer>>newTilesFor:setter: (in category 'get/set slots') ----- newTilesFor: aPlayer setter: aSpec | ms argValue | "Return universal tiles for a getter on this property. Record who self is." + argValue := aPlayer perform: (aSpec second asSymbol asGetterSelector). - argValue := aPlayer perform: (Utilities getterSelectorFor: aSpec second asSymbol). ms := MessageSend receiver: aPlayer selector: aSpec ninth arguments: (Array with: argValue). ^ ms asTilesIn: aPlayer class globalNames: (aPlayer class officialClass ~~ CardPlayer) "For CardPlayers, use 'self'. For others, name it, and use its name."! Item was changed: ----- Method: CategoryViewer>>phraseForVariableFrom: (in category 'entries') ----- 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 hotTileForSelf spacer buttonFont varName | aRow := ViewerLine newRow color: self color; beSticky; elementSymbol: (slotName := aMethodInterface selector); wrapCentering: #center; cellPositioning: #leftCenter. (universal := scriptedPlayer isUniversalTiles) ifFalse: [buttonFont := Preferences standardEToysFont. aRow addMorphBack: (Morph new color: self color; extent: (((buttonFont widthOfString: '!!') + 8) @ (buttonFont height + 6)); yourself)]. "spacer" aRow addMorphBack: (self infoButtonFor: slotName). aRow addMorphBack: (Morph new color: self color; extent: 0 at 10). " vertical 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: [hotTileForSelf := self tileForSelf bePossessive. hotTileForSelf on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: aMethodInterface selector with: aMethodInterface resultType). aRow addMorphBack: hotTileForSelf. aRow addMorphBack: (spacer := Morph new color: self color; extent: 2 at 10). spacer on: #mouseEnter send: #addGetterFeedback to: aRow. spacer on: #mouseLeave send: #removeHighlightFeedback to: aRow. spacer on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. spacer on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: aMethodInterface selector with: aMethodInterface resultType). hotTileForSelf on: #mouseEnter send: #addGetterFeedback to: aRow. hotTileForSelf on: #mouseLeave send: #removeHighlightFeedback to: aRow. hotTileForSelf on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. getterButton := self getterButtonFor: aMethodInterface selector type: aMethodInterface resultType]. aRow addMorphBack: getterButton. getterButton on: #mouseEnter send: #addGetterFeedback to: aRow. getterButton on: #mouseLeave send: #removeHighlightFeedback to: aRow. getterButton on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. (doc := aMethodInterface documentation) ifNotNil: [getterButton setBalloonText: doc]. + (scriptedPlayer slotInfo includesKey: (varName := slotName inherentSelector)) "user slot" - (scriptedPlayer slotInfo includesKey: (varName := Utilities inherentSelectorForGetter: slotName)) "user slot" ifTrue: ["aRow addTransparentSpacerOfSize: 3 at 0. aRow addMorphBack: (self slotTypeMenuButtonFor: varName)"]. universal ifFalse: [(slotName == #seesColor:) ifTrue: [self addIsOverColorDetailTo: aRow. ^ aRow]. (slotName == #touchesA:) ifTrue: [self addTouchesADetailTo: aRow. ^ aRow]. (slotName == #overlaps: or: [ slotName == #overlapsAny:]) ifTrue: [self addOverlapsDetailTo: aRow. ^ aRow]]. aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" (setter := aMethodInterface companionSetterSelector) ifNotNil: [aRow addMorphBack: (Morph new color: self color; extent: 2 at 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)]. anArrow beTransparent. universal ifFalse: [anArrow on: #mouseEnter send: #addSetterFeedback to: aRow. anArrow on: #mouseLeave send: #removeHighlightFeedback to: aRow. anArrow on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow]. aRow addMorphBack: anArrow]. (#(color:sees: playerSeeingColor copy touchesA: overlaps: getTurtleAt: getTurtleOf:) includes: slotName) ifFalse: [(universal and: [slotName == #seesColor:]) ifFalse: [aMethodInterface wantsReadoutInViewer ifTrue: [aRow addMorphBack: (self readoutFor: slotName type: aMethodInterface resultType readOnly: setter isNil getSelector: aMethodInterface selector putSelector: setter)]]]. anArrow ifNotNil: [anArrow step]. ^ aRow! Item was changed: ----- Method: EToyVocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'method list') ----- allMethodsInCategory: aCategoryName 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 | aCategoryName ifNil: [^ OrderedCollection new]. aClass isUniClass ifTrue: [aCategoryName = ScriptingSystem nameForScriptsCategory ifTrue: [^ aClass namedTileScriptSelectors]. aCategoryName = ScriptingSystem nameForInstanceVariablesCategory ifTrue: [^ aClass slotInfo keys asArray sort collect: + [:anInstVarName | anInstVarName asGetterSelector]]]. - [:anInstVarName | Utilities getterSelectorFor: anInstVarName]]]. unfiltered := (isAll := aCategoryName = self allCategoryName) ifTrue: [methodInterfaces collect: [:anInterface | anInterface selector]] ifFalse: [aCategory := categories detect: [:cat | cat categoryName = aCategoryName] 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 asArray sort collect: + [:anInstVarName | anInstVarName asGetterSelector])]. - [:anInstVarName | Utilities getterSelectorFor: anInstVarName])]. ^ (unfiltered copyWithoutAll: #(dummy unused)) asSortedArray! Item was changed: ----- Method: EToyVocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'initialization') ----- includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass "Answer whether the vocabulary includes the given selector for the given class (and instance, if provided), only considering method implementations in mostGenericClass and lower" | classToUse aClass | (aTargetClass isUniClass and: [(aTargetClass namedTileScriptSelectors includes: aSelector) or: [aTargetClass slotInfo keys anySatisfy: + [:anInstVarName | (anInstVarName asGetterSelector) = aSelector or: [(anInstVarName asSetterSelector) = aSelector]]]]) - [:anInstVarName | (Utilities getterSelectorFor: anInstVarName) = aSelector or: [(Utilities setterSelectorFor: anInstVarName) = aSelector]]]]) ifTrue: [^ true]. (methodInterfaces includesKey: aSelector) ifFalse: [^ false]. classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass. ^ (aClass := classToUse whichClassIncludesSelector: aSelector) ifNil: [false] ifNotNil: [aClass includesBehavior: mostGenericClass] ! Item was added: + TestCase subclass: #EtoysStringExtensionTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Etoys-Tests'! Item was added: + ----- Method: EtoysStringExtensionTest>>testGetterSelectorForReturnsAccessorName (in category 'as yet unclassified') ----- + testGetterSelectorForReturnsAccessorName + self assert: #getFoo equals: #foo asGetterSelector. + self assert: #getFoo equals: #Foo asGetterSelector. + self assert: #getFoo equals: 'foo' asGetterSelector. + + "Special cases:" + self assert: #seesColor: equals: 'isOverColor:' asGetterSelector. + self assert: #seesColor: equals: #isOverColor: asGetterSelector. + self assert: #getNewClone equals: 'copy' asGetterSelector. + self assert: #getNewClone equals: #copy asGetterSelector.! Item was added: + ----- Method: EtoysStringExtensionTest>>testInherentSelectorForGetterReturnsBaseName (in category 'as yet unclassified') ----- + testInherentSelectorForGetterReturnsBaseName + "Inverse of #asGetterSelector" + self assert: #foo equals: #getFoo inherentSelector. + self assert: #foo equals: #getfoo inherentSelector. + self assert: #foo equals: 'getFoo' inherentSelector. + + "Leaves other selector-like things alone, except for Symbol-ness" + self assert: #foo equals: 'foo' inherentSelector. + self assert: #foo equals: #foo inherentSelector. + self assert: #get equals: #get inherentSelector. + self assert: #GETAWAY equals: #GETAWAY inherentSelector. + self assert: #geFoo equals: #geFoo inherentSelector.! Item was added: + ----- Method: EtoysStringExtensionTest>>testSetterSelectorForReturnsMutatorName (in category 'as yet unclassified') ----- + testSetterSelectorForReturnsMutatorName + self assert: #setFoo: equals: #foo asSetterSelector. + self assert: #setFoo: equals: #Foo asSetterSelector. + self assert: #setFoo: equals: 'foo' asSetterSelector.! Item was changed: ----- Method: KedamaCategoryViewer>>makeSetter:event:from: (in category 'get/set slots') ----- 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 actualGetter | selectorAndTypePair first = #getPatchValueIn: ifTrue: [^ self makeSetterForGetPatchValue: selectorAndTypePair event: evt from: aMorph]. selectorAndTypePair first = #getRedComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #red event: evt from: aMorph]. selectorAndTypePair first = #getBlueComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #blue event: evt from: aMorph]. selectorAndTypePair first = #getGreenComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #green event: evt from: aMorph]. argType := selectorAndTypePair second. actualGetter := selectorAndTypePair first asSymbol. m := PhraseTileMorph new + setAssignmentRoot: actualGetter inherentSelector - setAssignmentRoot: (Utilities inherentSelectorForGetter: actualGetter) 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 := ScriptingSystem tileForArgType: argType. (argType == #Number and: [argValue isNumber]) ifTrue: [(scriptedPlayer decimalPlacesForGetter: actualGetter) ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]]. 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 replacePlayerInReadoutWith: scriptedPlayer. m openInHand! Item was changed: ----- Method: KedamaExamplerPlayer>>chooseSlotTypeFor: (in category 'player protocol') ----- chooseSlotTypeFor: aGetter "Let the user designate a type for the slot associated with the given getter" | typeChoices typeChosen slotName | + slotName := aGetter inherentSelector. - slotName := Utilities inherentSelectorForGetter: aGetter. typeChoices := Vocabulary typeChoices. typeChosen := UIManager default chooseFrom: (typeChoices collect: [:t | t translated])values: typeChoices title: ('Choose the TYPE for ' translated, slotName, ' (currently ' translated, (self slotInfoAt: slotName) type translated, ')'). typeChosen isEmptyOrNil ifTrue: [^ self]. (self typeForSlot: slotName) capitalized = 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))]. turtles setVectorSlotTypeFor: slotName typeChosen: typeChosen. sequentialStub ifNotNil: [sequentialStub setScalarSlotTypeFor: slotName typeChosen: typeChosen]. self updateAllViewers. "does siblings too" ! Item was changed: ----- Method: KedamaMorph>>makePrototypeOfExampler:color: (in category 'turtles') ----- makePrototypeOfExampler: examplerPlayer color: cPixel | array inst info | array := examplerPlayer turtles. info := array info. array size > 0 ifTrue: [ inst := array makePrototypeFromFirstInstance. cPixel ifNotNil: [inst at: (info at: #color) put: cPixel]. ^ inst. ]. inst := Array new: array instSize. info associationsDo: [:assoc | + inst at: (assoc value) put: (examplerPlayer perform: assoc key asGetterSelector). - inst at: (assoc value) put: (examplerPlayer perform: (Utilities getterSelectorFor: assoc key)). ]. cPixel ifNotNil: [inst at: (info at: #color) put: cPixel] ifNil: [inst at: (info at: #color) put: ((examplerPlayer getColor pixelValueForDepth: 32) bitAnd: 16rFFFFFF)]. inst at: (info at: #visible) put: ((inst at: (info at: #visible)) ifTrue: [1] ifFalse: [0]). ^ inst. ! Item was changed: ----- Method: Morph>>noteNegotiatedName:for: (in category '*Etoys-support') ----- noteNegotiatedName: uniqueName for: requestedName "This works, kind of, for morphs that have a single variable. Still holding out for generality of morphs being able to have multiple variables, but need a driving example" self setProperty: #variableName toValue: uniqueName. + self setProperty: #setterSelector toValue: (uniqueName asSetterSelector). - self setProperty: #setterSelector toValue: (Utilities setterSelectorFor: uniqueName). self setNameTo: uniqueName! Item was changed: ----- Method: Morph>>traverseRowTranslateSlotOld:of:to: (in category '*Etoys') ----- traverseRowTranslateSlotOld: oldSlotName of: aPlayer to: newSlotName "Traverse my submorphs, translating submorphs appropriately given the slot rename" submorphs do: [:tile | (tile isKindOf: AssignmentTileMorph) ifTrue: [tile assignmentRoot = oldSlotName ifTrue: [(self isPlayer: aPlayer ofReferencingTile: tile) ifTrue: [tile setRoot: newSlotName]]]. (tile isMemberOf: TileMorph) ifTrue: + [(tile operatorOrExpression = oldSlotName asGetterSelector) ifTrue: - [(tile operatorOrExpression = (Utilities getterSelectorFor: oldSlotName)) ifTrue: [(self isPlayer: aPlayer ofReferencingTile: tile) ifTrue: + [tile setOperator: newSlotName asGetterSelector]]]. - [tile setOperator: (Utilities getterSelectorFor: newSlotName)]]]. tile traverseRowTranslateSlotOld: oldSlotName of: aPlayer to: newSlotName]! Item was changed: ----- Method: Morph>>traverseRowTranslateSlotOld:to: (in category '*Etoys') ----- traverseRowTranslateSlotOld: oldSlotName to: newSlotName "Traverse my submorphs, translating submorphs appropriately given the slot rename" submorphs do: [:tile | (tile isKindOf: AssignmentTileMorph) ifTrue: [tile assignmentRoot = oldSlotName ifTrue: [tile setRoot: newSlotName]]. (tile isMemberOf: TileMorph) ifTrue: + [(tile operatorOrExpression = oldSlotName asGetterSelector) ifTrue: + [tile setOperator: newSlotName asGetterSelector]]. - [(tile operatorOrExpression = (Utilities getterSelectorFor: oldSlotName)) ifTrue: - [tile setOperator: (Utilities getterSelectorFor: newSlotName)]]. tile traverseRowTranslateSlotOld: oldSlotName to: newSlotName]! Item was changed: ----- Method: Player class>>slotGettersOfType: (in category 'slots') ----- 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: assoc key asGetterSelector]]. - [aList add: (Utilities getterSelectorFor: assoc key)]]. ^ aList! Item was changed: ----- Method: Player>>addInstanceVariable (in category 'slots-user') ----- addInstanceVariable "Offer the user the opportunity to add an instance variable, and if he goes through with it, actually add it." | itsName initialValue typeChosen usedNames initialAnswer setterSelector originalString | usedNames := self class instVarNames. initialAnswer := Utilities keyLike: ('var' translated, (usedNames size + 1) asString) satisfying: [:aKey | (usedNames includes: aKey) not]. originalString := UIManager default request: 'name for new variable: ' translated initialAnswer: initialAnswer. originalString isEmptyOrNil ifTrue: [^ self]. itsName := ScriptingSystem acceptableSlotNameFrom: originalString forSlotCurrentlyNamed: nil asSlotNameIn: self world: self costume world. itsName size = 0 ifTrue: [^ self]. self assureUniClass. typeChosen := self initialTypeForSlotNamed: itsName. self slotInfo at: itsName put: (SlotInformation new initialize type: typeChosen). initialValue := self initialValueForSlotOfType: typeChosen. self addInstanceVarNamed: itsName withValue: initialValue. self compileInstVarAccessorsFor: itsName. + setterSelector := itsName asSetterSelector. - setterSelector := Utilities setterSelectorFor: itsName. ((self class allSubInstances copyWithout: self) reject: [:e | e isSequentialStub]) do: [:anInstance | anInstance perform: setterSelector with: initialValue]. self updateAllViewersAndForceToShow: ScriptingSystem nameForInstanceVariablesCategory! Item was changed: ----- Method: Player>>addInstanceVariable2Named:type:value: (in category 'slots-user') ----- addInstanceVariable2Named: nameSymbol type: typeChosen value: aValue "Add an instance variable of the given name and type, and initialize it to have the given value" | initialValue setterSelector | self assureUniClass. self slotInfo at: nameSymbol put: (SlotInformation new initialize type: typeChosen). initialValue := aValue. self addInstanceVarNamed: nameSymbol withValue: aValue. self class compileAccessorsFor: nameSymbol. + setterSelector := nameSymbol asSetterSelector. - setterSelector := Utilities setterSelectorFor: nameSymbol. (self class allSubInstances copyWithout: self) do: [:anInstance | anInstance perform: setterSelector with: initialValue]. self updateAllViewersAndForceToShow: #'instance variables' ! Item was changed: ----- Method: Player>>addInstanceVariableNamed:type:value: (in category 'slots-user') ----- addInstanceVariableNamed: nameSymbol type: typeChosen value: aValue "Add an instance variable of the given name and type, and initialize it to have the given value" | initialValue setterSelector | self assureUniClass. self slotInfo at: nameSymbol put: (SlotInformation new type: typeChosen). initialValue := self initialValueForSlotOfType: typeChosen. self addInstanceVarNamed: nameSymbol withValue: aValue. self class compileAccessorsFor: nameSymbol. + setterSelector := nameSymbol asSetterSelector. - setterSelector := Utilities setterSelectorFor: nameSymbol. (self class allSubInstances copyWithout: self) do: [:anInstance | anInstance perform: setterSelector with: initialValue]. self updateAllViewersAndForceToShow: ScriptingSystem nameForInstanceVariablesCategory ! Item was changed: ----- Method: Player>>basicRemoveSlotNamed: (in category 'slots-user') ----- basicRemoveSlotNamed: aSlotName "The user has requested that an instance variable be removed..." | aSetter aGetter | (self okayToRemoveSlotNamed: aSlotName) ifFalse: [^ self inform: 'Sorry, ', aSlotName, ' is in use in a script.']. + aSetter := aSlotName asSetterSelector. + aGetter := aSlotName asGetterSelector. - aSetter := Utilities setterSelectorFor: aSlotName. - aGetter := Utilities getterSelectorFor: aSlotName. ((self systemNavigation allCallsOn: aSetter) size > 0 or: [(self systemNavigation allCallsOn: aGetter) size > 0]) ifTrue: [self inform: 'Caution!! There may be scripts belonging to other objects that may rely on the presence of this variable. If there are, they may now be broken. You may need to fix them up manually.']. self class removeInstVarName: aSlotName asString. self updateAllViewers! Item was changed: ----- Method: Player>>changeTypesInWatchersOf: (in category 'translation') ----- changeTypesInWatchersOf: slotName "The type of a variable has changed; adjust watchers to that fact." | aGetter | + aGetter := slotName asGetterSelector. - aGetter := Utilities getterSelectorFor: slotName. self allPossibleWatchersFromWorld do: [:aWatcher | | newWatcher | (aWatcher getSelector = aGetter) ifTrue: [(aWatcher ownerThatIsA: WatcherWrapper) ifNotNil: [:aWrapper | newWatcher := (aWrapper submorphs size = 1) ifTrue: [WatcherWrapper new unlabeledForPlayer: self getter: aGetter] ifFalse: [WatcherWrapper new fancyForPlayer: self getter: aGetter]. newWatcher position: aWatcher position. aWrapper owner replaceSubmorph: aWrapper by: newWatcher]]] ! Item was changed: ----- Method: Player>>chooseSlotTypeFor: (in category 'slots-user') ----- chooseSlotTypeFor: aGetter "Let the user designate a type for the slot associated with the given getter" | typeChoices typeChosen slotName | + slotName := aGetter inherentSelector. - slotName := Utilities inherentSelectorForGetter: aGetter. typeChoices := Vocabulary typeChoices. typeChosen := UIManager default chooseFrom: (typeChoices collect: [:t | t translated]) values: typeChoices title: ('Choose the TYPE for ' translated, slotName, ' (currently ' translated, (self slotInfoAt: slotName) type translated, ')'). typeChosen isEmptyOrNil ifTrue: [^ self]. (self typeForSlot: slotName) capitalized = 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" self changeTypesInWatchersOf: slotName "does siblings too" ! Item was changed: ----- Method: Player>>defaultFloatPrecisionFor: (in category 'misc') ----- defaultFloatPrecisionFor: aGetSelector "Answer the float position to use in conjunction with a readout for aGetSelector, which will be of the form 'getXXX'" | aSlotName slotInfo | + aSlotName := aGetSelector inherentSelector. - aSlotName := Utilities inherentSelectorForGetter: aGetSelector. (slotInfo := self slotInfoAt: aSlotName ifAbsent: [nil]) ifNotNil: [^ slotInfo floatPrecision]. self costume ifNotNil: [^ self costume renderedMorph defaultFloatPrecisionFor: aGetSelector]. ^ 1! Item was changed: ----- Method: Player>>elementTypeFor:vocabulary: (in category 'viewer') ----- 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 := aSymbol inherentSelector. - 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]! Item was changed: ----- Method: Player>>fancyWatcherFor: (in category 'slots-user') ----- fancyWatcherFor: aGetter "Anser a labeled readout for viewing a value textuallyi" | aWatcher aColor aLine itsName aSelector aLabel | aWatcher := self unlabeledWatcherFor: aGetter. aColor := Color r: 0.387 g: 0.581 b: 1.0. aLine := WatcherWrapper newRow. + aLine player: self variableName: (aSelector := aGetter inherentSelector). - aLine player: self variableName: (aSelector := Utilities inherentSelectorForGetter: aGetter). itsName := aWatcher externalName. aWatcher setNameTo: 'readout'. aLine addMorphFront: (self tileReferringToSelf borderWidth: 0; layoutInset: 4 at 0; typeColor: aColor; color: aColor; bePossessive). aLabel := StringMorph contents: aSelector translated, ' = ' font: ScriptingSystem fontForTiles. aLabel setProperty: #watcherLabel toValue: true. aLine addMorphBack: aLabel. aLine addMorphBack: aWatcher. aLine setNameTo: itsName. ^ aLine! Item was changed: ----- Method: Player>>methodInterfacesForInstanceVariablesCategoryIn: (in category 'slots-kernel') ----- methodInterfacesForInstanceVariablesCategoryIn: aVocabulary "Return a collection of methodInterfaces for the instance-variables category. The vocabulary parameter, at present anyway, is not used." | aList | aList := OrderedCollection new. self slotInfo associationsDo: [:assoc | | itsSlotName anInterface | anInterface := MethodInterface new. itsSlotName := assoc key. anInterface wording: itsSlotName; helpMessage: 'a variable defined by this object' translated. + anInterface selector: (itsSlotName asGetterSelector) type: assoc value type setter: (itsSlotName asSetterSelector). - anInterface selector: (Utilities getterSelectorFor: itsSlotName) type: assoc value type setter: (Utilities setterSelectorFor: itsSlotName). anInterface setToRefetch. aList add: anInterface]. ^ aList! Item was changed: ----- Method: Player>>offerGetterTiles: (in category 'slots-user') ----- 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 | typeChoices := Vocabulary typeChoices. typeChosen := UIManager default chooseFrom: (typeChoices collect: [:t | t translated]) values: typeChoices title: ('Choose the TYPE of data to get from {1}''s {2}' translated format: {self externalName. slotName translated}). typeChosen isEmptyOrNil ifTrue: [^self]. + thePlayerThereNow := self perform: slotName asGetterSelector. - thePlayerThereNow := self perform: (Utilities getterSelectorFor: slotName). thePlayerThereNow ifNil: [thePlayerThereNow := self presenter standardPlayer]. slotChoices := thePlayerThereNow slotNamesOfType: typeChosen. slotChoices isEmpty ifTrue: [^self inform: 'sorry -- no slots of that type' translated]. slotChoices := slotChoices asSortedArray. slotChosen := UIManager default chooseFrom: (slotChoices collect: [:t | t translated]) values: slotChoices title: ('Choose the datum you want to extract from {1}''s {2}' translated format: {self externalName. slotName translated}). 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 asGetterSelector - getterTilesFor: (Utilities getterSelectorFor: slotChosen) type: typeChosen. aCategoryViewer := CategoryViewer new initializeFor: self categoryChoice: 'basic'. playerGetter := aCategoryViewer + getterTilesFor: slotName asGetterSelector - getterTilesFor: (Utilities getterSelectorFor: slotName) type: #Player. getterTiles submorphs first acceptDroppingMorph: playerGetter event: nil. "the pad" "simulate a drop" getterTiles makeAllTilesGreen. getterTiles justGrabbedFromViewer: false. (getterTiles firstSubmorph) changeTableLayout; hResizing: #shrinkWrap; vResizing: #spaceFill. ActiveHand attachMorph: getterTiles! Item was changed: ----- Method: Player>>removeSlotNamed: (in category 'slots-user') ----- removeSlotNamed: aSlotName "The user has requested that an instance variable be removed..." | aSetter aGetter | (self okayToRemoveSlotNamed: aSlotName) ifFalse: [^ self inform: ('Sorry, {1} is in use in a script.' translated format: {aSlotName})]. + aSetter := aSlotName asSetterSelector. + aGetter := aSlotName asGetterSelector. - aSetter := Utilities setterSelectorFor: aSlotName. - aGetter := Utilities getterSelectorFor: aSlotName. ((self systemNavigation allCallsOn: aSetter) size > 0 or: [(self systemNavigation allCallsOn: aGetter) size > 0]) ifTrue: [self inform: 'Caution!! There may be scripts belonging to other objects that may rely on the presence of this variable. If there are, they may now be broken. You may need to fix them up manually.' translated]. self class removeInstVarName: aSlotName asString. self updateAllViewers! Item was changed: ----- Method: Player>>renameSlotInWatchersOld:new: (in category 'translation') ----- renameSlotInWatchersOld: oldName new: newName "A variable has been renamed; get all relevant extant watchers updated. All this assumed to be happening in the ActiveWorld" | oldGetter | + oldGetter := oldName asGetterSelector. - oldGetter := Utilities getterSelectorFor: oldName. self allPossibleWatchersFromWorld do: [:aWatcher | | wasStepping | (aWatcher getSelector = oldGetter) ifTrue: [(wasStepping := aWatcher isStepping) ifTrue: [aWatcher stopStepping]. + aWatcher getSelector: newName asGetterSelector. - aWatcher getSelector: (Utilities getterSelectorFor: newName). aWatcher putSelector ifNotNil: + [aWatcher putSelector: (newName asSetterSelector)]. - [aWatcher putSelector: (Utilities setterSelectorFor: newName)]. ((aWatcher isKindOf: UpdatingStringMorph) and: [aWatcher hasStructureOfComplexWatcher]) ifTrue: "Old style fancy watcher" [aWatcher owner owner traverseRowTranslateSlotOld: oldName to: newName. (aWatcher target labelFromWatcher: aWatcher) contents: newName, ' = ']. (aWatcher ownerThatIsA: WatcherWrapper) ifNotNil: [:wrapper | wrapper player: self variableName: newName]. wasStepping ifTrue: [aWatcher startStepping]]]! Item was changed: ----- Method: Player>>revealPlayerNamed:in: (in category 'misc') ----- revealPlayerNamed: aSymbol in: aWorld | getter | + getter := aSymbol asGetterSelector. - getter := Utilities getterSelectorFor: aSymbol. ^ (self perform: getter) revealPlayerIn: aWorld! Item was changed: ----- Method: Player>>setPrecisionFor: (in category 'slots-user') ----- setPrecisionFor: slotName "Set the precision for the given slot name" | aList reply aGetter places | + aGetter := slotName asGetterSelector. - aGetter := Utilities getterSelectorFor: slotName. places := Utilities decimalPlacesForFloatPrecision: (self defaultFloatPrecisionFor: aGetter). aList := #('0' '1' '2' '3' '4' '5' '6'). reply := UIManager default chooseFrom: aList values: (aList collect: [:m | m asNumber]) title: ('How many decimal places? (currently {1})' translated format: {places}). reply ifNotNil: [(self slotInfo includesKey: slotName) ifTrue: ["it's a user slot" (self slotInfoAt: slotName) floatPrecision: (Utilities floatPrecisionForDecimalPlaces: reply). self class allInstancesDo: [:anInst | | val | reply = 0 ifFalse: [((val := anInst instVarNamed: slotName asString) isInteger) ifTrue: [anInst instVarNamed: slotName asString put: val asFloat]]. anInst updateAllViewers]] ifFalse: ["it's specifying a preference for precision on a system-defined numeric slot" self noteDecimalPlaces: reply forGetter: aGetter. self updateAllViewers]]! Item was changed: ----- Method: Player>>slotInfoButtonHitFor:inViewer: (in category 'scripts-kernel') ----- 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 typeVocab interface selector | (#(+ - * /) includes: aGetterSymbol) ifTrue: [^ self inform: aGetterSymbol, ' is used for vector operations']. + slotSym := aGetterSymbol inherentSelector. - slotSym := Utilities inherentSelectorForGetter: aGetterSymbol. aType := self typeForSlotWithGetter: aGetterSymbol asSymbol. aMenu := MenuMorph new defaultTarget: self. interface := aViewer currentVocabulary methodInterfaceAt: aGetterSymbol ifAbsent: [nil]. selector := interface isNil ifTrue: [slotSym asString] ifFalse: [interface selector]. aMenu addTitle: (selector, ' (', (aType asString translated), ')'). aType = #Patch ifTrue: [ aMenu add: 'grab morph' translated target: (self perform: aGetterSymbol) selector: #grabPatchMorph argument: #(). aMenu addLine. ]. (typeVocab := Vocabulary vocabularyForType: aType) addWatcherItemsToMenu: aMenu forGetter: aGetterSymbol. (self slotInfo includesKey: slotSym) ifTrue: [aMenu add: 'change value type' translated selector: #chooseSlotTypeFor: argument: aGetterSymbol. typeVocab addUserSlotItemsTo: aMenu slotSymbol: slotSym. aMenu add: ('remove "{1}"' translated format: {slotSym}) selector: #removeSlotNamed: argument: slotSym. aMenu add: ('rename "{1}"' translated format: {slotSym}) selector: #renameSlot: argument: slotSym. aMenu addLine]. typeVocab addExtraItemsToMenu: aMenu forSlotSymbol: slotSym. "e.g. Player type adds hand-me-tiles" aMenu add: 'show categories....' translated target: aViewer selector: #showCategoriesFor: argument: aGetterSymbol. self addIdiosyncraticMenuItemsTo: aMenu forSlotSymol: slotSym. aMenu items isEmpty ifTrue: [aMenu add: 'ok' translated action: #yourself]. aMenu popUpForHand: aViewer primaryHand in: aViewer world! Item was changed: ----- Method: Player>>slotInfoForGetter: (in category 'slots-user') ----- 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: aGetter inherentSelector ifAbsent: [nil]! - ^ self slotInfo at: (Utilities inherentSelectorForGetter: aGetter) ifAbsent: [nil]! Item was changed: ----- Method: Player>>slotNamesOfType: (in category 'slots-user') ----- 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 | aSel inherentSelector]! - [:aSel | Utilities inherentSelectorForGetter: aSel]! Item was changed: ----- Method: Player>>tearOffWatcherFor: (in category 'slots-user') ----- tearOffWatcherFor: aSlotGetter "Tear off a simple textual watcher for the slot whose getter is provided" | aWatcher 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. aWatcher growable: true; getSelector: aSlotGetter; putSelector: (info notNil ifTrue: [ScriptingSystem setterSelectorForGetter: aSlotGetter] ifFalse: [anInterface companionSetterSelector]); setNameTo: (info notNil ifTrue: + [aSlotGetter inherentSelector] - [Utilities inherentSelectorForGetter: aSlotGetter] ifFalse: [anInterface wording]); target: self. isNumeric ifFalse: [aWatcher useStringFormat] ifTrue: [self setFloatPrecisionFor: aWatcher]. aWatcher step; fitContents; openInHand! Item was changed: ----- Method: Player>>typeForSlot: (in category 'slots-kernel') ----- 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: + [aSlotName asGetterSelector]. - [Utilities getterSelectorFor: aSlotName]. ^ (self currentVocabulary methodInterfaceAt: getter ifAbsent: [self error: 'Unknown slot name: ', aSlotName]) resultType! Item was changed: ----- Method: Player>>typeForSlot:vocabulary: (in category 'slots-kernel') ----- 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 := aSlotName inherentSelector. - inherentSelector := Utilities inherentSelectorForGetter: aSlotName. (self slotInfo includesKey: inherentSelector) ifTrue: [^ (self slotInfoAt: inherentSelector) type]. getter := (aSlotName beginsWith: 'get') ifTrue: [aSlotName] ifFalse: + [aSlotName asGetterSelector]. - [Utilities getterSelectorFor: aSlotName]. ^ (aVocabulary methodInterfaceAt: getter ifAbsent: [self error: 'Unknown slot name: ', aSlotName]) resultType! Item was changed: ----- Method: Player>>typeForSlotWithGetter: (in category 'slots-kernel') ----- typeForSlotWithGetter: aGetter "Answer the data type for values of the instance variable of the given name" | getter inherentSelector | (#(color:sees: seesColor: touchesA: overlaps: overlapsAny:) includes: aGetter) ifTrue: [^ #Boolean]. (#(+ * - /) includes: aGetter) ifTrue: [^ #Player]. "weird vector stuff" "Annoying special cases" + inherentSelector := aGetter inherentSelector. - inherentSelector := Utilities inherentSelectorForGetter: aGetter. (self slotInfo includesKey: inherentSelector) ifTrue: [^ (self slotInfoAt: inherentSelector) type]. getter := (aGetter beginsWith: 'get') ifTrue: [aGetter] ifFalse: + [aGetter asGetterSelector]. - [Utilities getterSelectorFor: aGetter]. ^ (Vocabulary eToyVocabulary methodInterfaceAt: getter ifAbsent: [self error: 'Unknown slot name: ', aGetter]) resultType! Item was changed: ----- Method: Player>>unlabeledWatcherFor: (in category 'slots-user') ----- unlabeledWatcherFor: aGetter "Answer an unnlabeled readout for viewing a numeric-valued slot of mine" | aWatcher info anInterface watcherWording itsType vocab aSetter | info := self slotInfoForGetter: aGetter. info ifNotNil: [itsType := info type. + watcherWording := aGetter inherentSelector. + aSetter := watcherWording asSetterSelector] - watcherWording := Utilities inherentSelectorForGetter: aGetter. - aSetter := Utilities setterSelectorFor: watcherWording] ifNil: [anInterface :=Vocabulary eToyVocabulary methodInterfaceAt: aGetter ifAbsent: [nil]. anInterface ifNotNil: [itsType := anInterface resultType. aSetter := anInterface companionSetterSelector] ifNil: [itsType := #Unknown. aSetter := nil]. watcherWording := anInterface ifNotNil: [anInterface wording] ifNil: ['*']]. vocab := Vocabulary vocabularyForType: itsType. aWatcher := vocab updatingTileForTarget: self partName: watcherWording getter: aGetter setter: aSetter. aWatcher setNameTo: (self externalName, '''s ', watcherWording). aWatcher minHeight: (vocab wantsArrowsOnTiles ifTrue: [22] ifFalse: [14]). ^ aWatcher! Item was changed: ----- Method: ScriptEditorMorph>>hasScriptReferencing:ofPlayer: (in category 'other') ----- hasScriptReferencing: aSlotName ofPlayer: aPlayer "Answer whether the receiver has any tiles in it which reference the given slot of the given player. By doing a text search on the decompiled method, this is able to work both with text and with tiles. The approach is still not perfect, because we can't really know until run-time whom the getters and setters are sent to. But practically speaking, this is all presumably a positive." | stringToSearch | "(aPlayer isKindOf: playerScripted class) ifFalse: [^ false]." stringToSearch := (playerScripted class compiledMethodAt: scriptName) decompileString. + {aSlotName asGetterSelector. aSlotName asSetterSelector} do: - {Utilities getterSelectorFor: aSlotName. Utilities setterSelectorFor: aSlotName} do: [:searchee | (stringToSearch findString: searchee startingAt: 1) = 0 ifFalse: [^ true]]. ^ false! Item was added: + ----- Method: String>>asGetterSelector (in category '*Etoys-support') ----- + asGetterSelector + "Answer the corresponding getter. Two idiosyncratic vectorings herein... " + | aSymbol | + (aSymbol := self asSymbol) == #isOverColor: ifTrue: [^ #seesColor:]. + aSymbol == #copy ifTrue: [^ #getNewClone]. + + ^ ('get', (self asString capitalized)) asSymbol! Item was added: + ----- Method: String>>asSetterSelector (in category '*Etoys-support') ----- + asSetterSelector + ^ (('set', (self asString capitalized)), ':') asSymbol! Item was added: + ----- Method: String>>inherentSelector (in category '*Etoys-support') ----- + inherentSelector + "Given a selector of the form #getAbc, return the inherent slotname selector that corresponds, which is to say, getterSelector with the leading 'get' removed and with the next character forced to lower case; this is the inverse of #getterSelectorFor:" + + "Utilities inherentSelectorForGetter: #getWidth" + ((self size < 4) or: [(self beginsWith: 'get') not]) + ifTrue: [ ^ self]. + ^ ((self at: 4) asLowercase asString, (self copyFrom: 5 to: self size)) asSymbol! Item was changed: ----- Method: SyntaxMorph>>setTarget: (in category 'card & stack') ----- setTarget: aPlayer "Find my UpdatingStringMorph and set its getSelector, putSelector, and target" | updatingString | (updatingString := self readOut) ifNil: [^ self]. + updatingString putSelector: (self knownName asSetterSelector). + updatingString getSelector: (self knownName asGetterSelector). - updatingString putSelector: (Utilities setterSelectorFor: self knownName). - updatingString getSelector: (Utilities getterSelectorFor: self knownName). updatingString target: aPlayer. ! Item was changed: ----- Method: TilePadMorph>>morphToDropFrom: (in category 'miscellaneous') ----- morphToDropFrom: aMorph "Given a morph being carried by the hand, which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service." | vwr | (aMorph isKindOf: WatcherWrapper) ifTrue: [^ aMorph getterTilesForDrop]. ^ ((self type capitalized = #Graphic) "Special-case requested by Alan 4/30/05" and: [(aMorph isKindOf: TileMorph) and: [aMorph resultType = #Player]]) ifFalse: [aMorph] ifTrue: [vwr := CategoryViewer new initializeFor: aMorph associatedPlayer categoryChoice: #basic. + vwr getterTilesFor: #graphic asGetterSelector type: #Graphic]! - vwr getterTilesFor: (Utilities getterSelectorFor: #graphic) type: #Graphic]! Item was removed: - ----- Method: Utilities class>>getterSelectorFor: (in category '*Etoys') ----- - getterSelectorFor: identifier - "Answer the corresponding getter. Two idiosyncratic vectorings herein... " - - "Utilities getterSelectorFor: #elvis" - - | aSymbol | - (aSymbol := identifier asSymbol) == #isOverColor: ifTrue: [^ #seesColor:]. - aSymbol == #copy ifTrue: [^ #getNewClone]. - - ^ ('get', (identifier asString capitalized)) asSymbol! Item was changed: ----- Method: VariableDock>>computePlayerGetterAndSetterSelectors (in category 'getters and setters') ----- computePlayerGetterAndSetterSelectors "Compute and remember the getter and setter selectors for obtaining and setting values from the player instance" + playerGetSelector := variableName asGetterSelector. + playerPutSelector := variableName asSetterSelector.! - playerGetSelector := Utilities getterSelectorFor: variableName. - playerPutSelector := Utilities setterSelectorFor: variableName! Item was changed: ----- Method: Vocabulary>>tileWordingForSelector: (in category '*Etoys-queries') ----- tileWordingForSelector: aSelector "Answer the wording to emblazon on tiles representing aSelector" | anInterface | anInterface := self methodInterfaceAt: aSelector asSymbol ifAbsent: [ | inherent | + inherent := aSelector inherentSelector. - inherent := Utilities inherentSelectorForGetter: aSelector. ^ inherent ifNil: [self translatedWordingFor: aSelector] ifNotNil: [inherent translated]]. ^ anInterface wording! Item was changed: ----- Method: WatcherWrapper>>buildForPlayer:getter: (in category 'initialization') ----- buildForPlayer: aPlayer getter: aGetter "Build up basic structure" | aColor | self player: aPlayer + variableName: aGetter inherentSelector. - variableName: (Utilities inherentSelectorForGetter: aGetter). aColor := Color r: 0.387 g: 0.581 b: 1.0. self listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: aColor; layoutInset: -1; borderWidth: 1; borderColor: aColor darker; listCentering: #center. self addMorphBack: (self buildReadout: aGetter)! Item was changed: ----- Method: WatcherWrapper>>getterTilesForDrop (in category 'accessing') ----- getterTilesForDrop "Answer getter tiles to use if there is an attempt to drop me onto a tile pad" | aCategoryViewer | aCategoryViewer := CategoryViewer new initializeFor: player categoryChoice: #basic. + ^ aCategoryViewer getterTilesFor: variableName asGetterSelector type: self resultType! - ^ aCategoryViewer getterTilesFor: (Utilities getterSelectorFor: variableName) type: self resultType! Item was changed: ----- Method: WatcherWrapper>>readoutInformation: (in category 'initialization') ----- readoutInformation: aGetter "Answer a triplet of {type. wording. setter}" | info anInterface | info := player slotInfoForGetter: aGetter. "In case of a variable" info + ifNotNil: [^ {info type. aGetter inherentSelector. variableName asSetterSelector}]. - ifNotNil: [^ {info type. Utilities inherentSelectorForGetter: aGetter. Utilities setterSelectorFor: variableName}]. "In case of a slot" anInterface := Vocabulary eToyVocabulary methodInterfaceAt: aGetter ifAbsent: [^ {#Unknown. '*'. nil}]. ^ {anInterface resultType. anInterface wording. anInterface companionSetterSelector}! Item was changed: ----- Method: WatcherWrapper>>resultType (in category 'accessing') ----- resultType "Answer the result type the receiver would produce." + ^ player typeForSlotWithGetter: variableName asGetterSelector! - ^ player typeForSlotWithGetter: (Utilities getterSelectorFor: variableName)!
More information about the Squeak-dev mailing list |