'From Squeak3.1alpha [latest update: #''Squeak3.1alpha'' of 28 February 2001 update 3905] on 5 April 2001 at 6:16:52 pm'! "Change Set: tilesToFire-sw Date: 5 April 2001 Author: Scott Wallace Adds an item to the halo menu which allows the user to tear off a tile phrase that will, when run, fire the script. Fixes up the References-handing-out scheme so that it always constructs a key that is a valid identifier beginning with an upper-case character, with invalid characters stripped."! !Object methodsFor: 'viewer' stamp: 'sw 4/5/2001 16:46'! uniqueNameForReference "Answer a nice name by which the receiver can be referred to by other objects. At present this uses a global References dictionary to hold the database of references, but in due course this will need to acquire some locality" | aName nameSym stem knownClassVars | (References includesIdentity: self) ifTrue: [^ References keyAtValue: self]. (stem _ self knownName) ifNil: [stem _ self defaultNameStemForInstances asString]. stem _ stem select: [:ch | ch isLetter or: [ch isDigit]]. stem size == 0 ifTrue: [stem _ 'A']. stem first isLetter ifFalse: [stem _ 'A', stem]. stem _ stem capitalized. knownClassVars _ ScriptingSystem allKnownClassVariableNames. aName _ Utilities keyLike: stem satisfying: [:jinaLake | nameSym _ jinaLake asSymbol. ((References includesKey: nameSym) not and: [(Smalltalk includesKey: nameSym) not]) and: [(knownClassVars includes: nameSym) not]]. References at: (aName _ aName asSymbol) put: self. ^ aName! ! !Morph methodsFor: 'menus' stamp: 'sw 4/5/2001 17:15'! addAddHandMenuItemsForHalo: aMenu hand: aHandMorph "Add halo menu items to be handled by the invoking hand. The halo menu is invoked by clicking on the menu-handle of the receiver's halo." | unlockables aPlayer | aMenu addLine. self maybeAddCollapseItemTo: aMenu. aMenu add: 'copy to paste buffer' action: #copyToPasteBuffer:. aMenu addLine. aMenu add: 'copy Postscript' action: #clipPostscript. aMenu add: 'print PS to file...' target: self selector: #printPSToFile. (aPlayer _ self topRendererOrSelf player) ifNotNil: [aMenu addLine. aMenu add: 'make a sibling instance' target: self action: #makeNewPlayerInstance:. aMenu balloonTextForLastItem: 'Makes another morph whose player is of the same class as this one. Both siblings will share the same scripts'. aMenu add: 'make multiple siblings...' target: self action: #makeMultipleSiblings:. aMenu balloonTextForLastItem: 'Make any number of sibling instances all at once'. (aPlayer belongsToUniClass and: [aPlayer class instanceCount > 1]) ifTrue: [aMenu add: 'make all siblings look like me' target: self action: #makeSiblingsLookLikeMe:. aMenu balloonTextForLastItem: 'make all my sibling instances look like me.'. aMenu add: 'bring all siblings to my location' target: self action: #bringAllSiblingsToMe:. aMenu balloonTextForLastItem: 'find all sibling instances and bring them to me'. aMenu add: 'apply status to all siblngs' target: self action: #applyStatusToAllSiblings:. aMenu balloonTextForLastItem: 'apply the current status of all of my scripts to the scripts of all my siblings']]. aMenu addLine. aMenu add: 'open a property sheet' target: self action: #openAPropertySheet. aMenu balloonTextForLastItem: 'Open a property sheet for me. Allows changing lots of stuff at once.'. self addFillStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addExportMenuItems: aMenu hand: aHandMorph. aMenu addUpdating: #hasClipSubmorphsString target: self selector: #changeClipSubmorphs argumentList: #(). aMenu addLine. self potentialEmbeddingTargets size > 1 ifTrue: [aMenu add: 'embed...' target: self action: #embedInto:]. aMenu defaultTarget: self. aMenu addUpdating: #lockedString action: #lockUnlockMorph. unlockables _ self submorphs select: [:m | m isLocked]. unlockables size == 1 ifTrue: [aMenu add: 'unlock "', unlockables first externalName, '"' action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' action: #unlockContents. aMenu add: 'unlock...' action: #unlockOneSubpart]. aMenu addLine. aMenu defaultTarget: self; add: 'add mouse up action' action: #addMouseUpAction; add: 'remove mouse up action' action: #removeMouseUpAction; add: 'hand me tiles to fire this button' action: #handMeTilesToFire. aMenu addLine. (owner notNil and: [owner isStackBackground]) ifTrue: [self isShared ifFalse: [aMenu add: 'put onto Background' target: self action: #putOnBackground] ifTrue: [aMenu add: 'remove from Background' target: self action: #putOnForeground. self couldHoldSeparateDataForEachInstance ifTrue: [self holdsSeparateDataForEachInstance ifFalse: [aMenu add: 'start holding separate data for each instance' target: self action: #makeHoldSeparateDataForEachInstance] ifTrue: [aMenu add: 'stop holding separate data for each instance' target: self action: #stopHoldingSeparateDataForEachInstance]. aMenu add: 'be default value on new card' target: self action: #setAsDefaultValueForNewCard. (self hasProperty: #thumbnailImage) ifTrue: [aMenu add: 'stop using for reference thumbnail' target: self action: #stopUsingForReferenceThumbnail] ifFalse: [aMenu add: 'start using for reference thumbnail' target: self action: #startUsingForReferenceThumbnail]]]. aMenu addLine]. aMenu defaultTarget: self topRendererOrSelf. aMenu add: 'draw new path' action: #definePath. (self hasProperty: #pathPoints) ifTrue: [aMenu add: 'follow path' action: #followPath. aMenu add: 'delete path' action: #deletePath]. (owner == nil) ifFalse: [aMenu add: 'send to back' action: #goBehind. aMenu add: 'bring to front' action: #comeToFront]. aMenu defaultTarget: aHandMorph. ! ! !Morph methodsFor: 'debug and other' stamp: 'sw 4/5/2001 16:33'! handMeTilesToFire "Construct a phrase of tiles and hand them to the user" ActiveHand attachMorph: (self assuredPlayer tilesToCall: (Vocabulary eToyVocabulary methodInterfaceAt: #fire ifAbsent: [nil])) ! ! !CategoryViewer methodsFor: 'support' stamp: 'sw 4/5/2001 15:11'! currentVocabulary | outerViewer | "Answer the vocabulary currently installed in the viewer. The outer StandardViewer object holds this information." ^ (outerViewer _ self outerViewer) ifNotNil: [outerViewer currentVocabulary] ifNil: [ActiveWorld currentVocabularyFor: scriptedPlayer]! ! !PasteUpMorph methodsFor: 'scripting' stamp: 'sw 4/5/2001 15:12'! currentVocabularyFor: aScriptableObject "Answer the Vocabulary object to be applied when scripting an object in the world." ^ Project current projectParameterAt: #currentVocabulary ifAbsent: [(aScriptableObject isKindOf: Player) ifTrue: [Vocabulary eToyVocabulary] ifFalse: [Vocabulary fullVocabulary]]! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 4/5/2001 17:08'! tilesToCall: aMethodInterface "Answer a phrase for the non-typed command represented by aMethodInterface." | resultType cmd argType argTile selfTile aPhrase balloonTextSelector aDocString universal | self class namedTileScriptSelectors. resultType _ aMethodInterface resultType. cmd _ aMethodInterface selector. (universal _ self isUniversalTiles) ifTrue: [aPhrase _ self universalTilesForInterface: aMethodInterface] ifFalse: [cmd numArgs == 0 ifTrue: [aPhrase _ PhraseTileMorph new setOperator: cmd type: resultType rcvrType: #player] ifFalse: ["only one arg supported in classic tiles, so if this is fed with a selector with > 1 arg, results will be very strange" argType _ aMethodInterface typeForArgumentNumber: 1. aPhrase _ PhraseTileMorph new setOperator: cmd type: resultType rcvrType: #player argType: argType. argTile _ self tileForArgType: argType inViewer: self. argTile position: aPhrase lastSubmorph position. aPhrase lastSubmorph addMorph: argTile]]. (self slotInfo includesKey: cmd) ifTrue: [balloonTextSelector _ #userSlot]. (self belongsToUniClass and: [self class includesSelector: cmd]) ifTrue: [aDocString _ (self class userScriptForPlayer: self selector: cmd) documentationOrNil. aDocString ifNotNil: [aPhrase submorphs second setBalloonText: aDocString] ifNil: [balloonTextSelector _ #userScript]]. (universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]) balloonTextSelector: (balloonTextSelector ifNil: [cmd]). universal ifFalse: [selfTile _ self tileForPlayer: self. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile. aPhrase makeAllTilesGreen. aPhrase justGrabbedFromViewer: false]. ^ aPhrase! ! !TileMorph methodsFor: 'accessing' stamp: 'sw 4/5/2001 17:22'! playerBearingCode "Answer the actual Player object who will be the 'self' when the receiver is being asked to generate code" | anEditor | (anEditor _ self topEditor) ifNotNil: [^ anEditor playerScripted]. actualObject ifNotNil: [^ actualObject]. ^ (self nearestOwnerThat: [:m | m isAViewer]) scriptedPlayer! !