[Pkg] The Trunk: EToys-ul.76.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Nov 16 03:49:20 UTC 2010
Levente Uzonyi uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-ul.76.mcz
==================== Summary ====================
Name: EToys-ul.76
Author: ul
Time: 16 November 2010, 4:48:28.756 am
UUID: 9547b97a-0e6b-254b-8932-f5c4d22eacd8
Ancestors: EToys-ar.75
- use #= for integer comparison instead of #== (http://bugs.squeak.org/view.php?id=2788 )
=============== Diff against EToys-ar.75 ===============
Item was changed:
----- Method: CategoryViewer>>chooseCategory (in category 'categories') -----
chooseCategory
"The mouse went down on my category-list control; pop up a list of category choices"
| aList reply aLinePosition lineList |
aList := scriptedPlayer categoriesForViewer: self.
aLinePosition := aList indexOf: #miscellaneous ifAbsent: [nil].
aList := aList collect:
[:aCatSymbol | self currentVocabulary categoryWordingAt: aCatSymbol].
lineList := aLinePosition ifNil: [#()] ifNotNil: [Array with: aLinePosition].
+ aList size = 0 ifTrue: [aList add: ScriptingSystem nameForInstanceVariablesCategory translated].
- aList size == 0 ifTrue: [aList add: ScriptingSystem nameForInstanceVariablesCategory translated].
reply := UIManager default
chooseFrom: aList
values: aList
lines: lineList
title: 'category' translated.
reply ifNil: [^ self].
self chooseCategoryWhoseTranslatedWordingIs: reply asSymbol
!
Item was changed:
----- Method: CategoryViewer>>phraseForCommandFrom: (in category 'entries') -----
phraseForCommandFrom: aMethodInterface
"Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles"
| aRow resultType cmd names argType argTile selfTile aPhrase balloonTextSelector stat inst aDocString universal tileBearingHelp |
aDocString := aMethodInterface documentation.
aDocString = 'no help available' ifTrue: [aDocString := nil].
names := scriptedPlayer class namedTileScriptSelectors.
resultType := aMethodInterface resultType.
cmd := aMethodInterface selector.
(universal := scriptedPlayer isUniversalTiles)
ifTrue:
[aPhrase := scriptedPlayer universalTilesForInterface: aMethodInterface]
+ ifFalse: [cmd numArgs = 0
- ifFalse: [cmd numArgs == 0
ifTrue:
[aPhrase := PhraseTileMorph new vocabulary: self currentVocabulary.
aPhrase 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 vocabulary: self currentVocabulary.
(self isSpecialPatchReceiver: scriptedPlayer and: cmd) ifTrue: [
aPhrase setOperator: cmd
type: resultType
rcvrType: #Patch
argType: argType.
] ifFalse: [
aPhrase setOperator: cmd
type: resultType
rcvrType: #Player
argType: argType.
].
(self isSpecialPatchCase: scriptedPlayer and: cmd) ifTrue: [
argTile := (Vocabulary vocabularyForType: argType) defaultArgumentTileFor: scriptedPlayer.
] ifFalse: [
argTile := ScriptingSystem tileForArgType: argType.
].
(#(bounce: wrap:) includes: cmd) ifTrue:
["help for the embattled bj"
argTile setLiteral: 'silence'; updateLiteralLabel].
argTile position: aPhrase lastSubmorph position.
aPhrase lastSubmorph addMorph: argTile]].
(scriptedPlayer slotInfo includesKey: cmd)
ifTrue: [balloonTextSelector := #userSlot].
(scriptedPlayer belongsToUniClass and: [scriptedPlayer class includesSelector: cmd])
ifTrue:
[aDocString ifNil:
[aDocString := (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentation].
aDocString ifNil:
[balloonTextSelector := #userScript]].
tileBearingHelp := universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile].
aDocString
ifNotNil:
[tileBearingHelp setBalloonText: aDocString]
ifNil:
[balloonTextSelector ifNil:
[tileBearingHelp setProperty: #inherentSelector toValue: cmd.
balloonTextSelector := #methodComment].
tileBearingHelp balloonTextSelector: balloonTextSelector].
aPhrase markAsPartsDonor.
cmd == #emptyScript ifTrue:
[aPhrase setProperty: #newPermanentScript toValue: true.
aPhrase setProperty: #newPermanentPlayer toValue: scriptedPlayer.
aPhrase submorphs second setBalloonText:
'drag and drop to
add a new script' translated].
universal ifFalse:
[selfTile := self tileForSelf.
selfTile position: aPhrase firstSubmorph position.
aPhrase firstSubmorph addMorph: selfTile].
aRow := ViewerLine newRow borderWidth: 0; color: self color.
aRow elementSymbol: cmd asSymbol.
aRow addMorphBack: (ScriptingSystem tryButtonFor: aPhrase).
aRow addMorphBack: (Morph new extent: 2 at 2; beTransparent).
aRow addMorphBack: (self infoButtonFor: cmd).
aRow addMorphBack: aPhrase.
aPhrase on: #mouseEnter send: #addCommandFeedback to: aRow.
aPhrase on: #mouseLeave send: #removeHighlightFeedback to: aRow.
aPhrase on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow.
(names includes: cmd) ifTrue:
[aPhrase userScriptSelector: cmd.
+ cmd numArgs = 0 ifTrue:
- cmd numArgs == 0 ifTrue:
[aPhrase beTransparent.
aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer.
aRow addMorphBack: (stat := (inst := scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph).
inst updateStatusMorph: stat]].
aRow beSticky; disableDragNDrop.
^ aRow!
Item was changed:
----- Method: DataType>>updatingTileForTarget:partName:getter:setter: (in category '*Etoys-tiles') -----
updatingTileForTarget: aTarget partName: partName getter: getter setter: setter
"Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter"
| aTile displayer actualSetter |
actualSetter := setter ifNotNil:
[(#(none #nil unused) includes: setter) ifTrue: [nil] ifFalse: [setter]].
aTile := self newReadoutTile.
displayer := UpdatingStringMorph new
getSelector: getter;
target: aTarget;
growable: true;
minimumWidth: 24;
putSelector: actualSetter.
"Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details"
self setFormatForDisplayer: displayer.
aTile addMorphBack: displayer.
(actualSetter notNil and: [self wantsArrowsOnTiles]) ifTrue: [aTile addArrows].
+ getter numArgs = 0 ifTrue:
- getter numArgs == 0 ifTrue:
[aTile setLiteralInitially: (aTarget perform: getter)].
^ aTile
!
Item was changed:
----- Method: EToyTextNode>>addNewChildAfter: (in category 'as yet unclassified') -----
addNewChildAfter: anotherOrNilOrZero
| where newNode |
+ anotherOrNilOrZero = 0 ifTrue: [
- anotherOrNilOrZero == 0 ifTrue: [
newNode := EToyTextNode newNode.
children := {newNode} asOrderedCollection,children.
^newNode
].
where := children indexOf: anotherOrNilOrZero ifAbsent: [children size].
children add: (newNode := EToyTextNode newNode) afterIndex: where.
^newNode
!
Item was changed:
----- Method: EtoysPresenter>>browseAllScriptsTextually (in category 'playerList') -----
browseAllScriptsTextually
"Open a method-list browser on all the scripts in the project"
| aList aMethodList |
+ (aList := self uniclassesAndCounts) size = 0 ifTrue: [^ self inform: 'there are no scripted players'].
- (aList := self uniclassesAndCounts) size == 0 ifTrue: [^ self inform: 'there are no scripted players'].
aMethodList := OrderedCollection new.
aList do:
[:aPair | aPair first addMethodReferencesTo: aMethodList].
aMethodList size > 0 ifFalse: [^ self inform: 'there are no scripts in this project!!'].
SystemNavigation new
browseMessageList: aMethodList
name: 'All scripts in this project'
autoSelect: nil
"
ActiveWorld presenter browseAllScriptsTextually
"!
Item was changed:
----- Method: Inspector>>tearOffTile (in category '*Etoys-menu commands') -----
tearOffTile
"Tear off a tile that refers to the receiver's selection, and place it in the mophic hand"
| objectToRepresent |
+ objectToRepresent := self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection].
- objectToRepresent := self selectionIndex == 0 ifTrue: [object] ifFalse: [self selection].
self currentHand attachMorph: (TileMorph new referTo: objectToRepresent)
!
Item was changed:
----- Method: KedamaPatchType>>updatingTileForTarget:partName:getter:setter: (in category 'tile protocol') -----
updatingTileForTarget: aTarget partName: partName getter: getter setter: setter
| aTile displayer actualSetter |
actualSetter := setter ifNotNil:
[(#(none nil unused) includes: setter) ifTrue: [nil] ifFalse: [setter]].
aTile := self newReadoutTile.
displayer := UpdatingStringMorph new
getSelector: #externalName;
target: (aTarget perform: getter) costume renderedMorph;
growable: true;
minimumWidth: 24;
putSelector: nil.
displayer stepTime: 1000.
"Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details"
self setFormatForDisplayer: displayer.
aTile addMorphBack: displayer.
(actualSetter notNil and: [self wantsArrowsOnTiles]) ifTrue: [aTile addArrows].
+ getter numArgs = 0 ifTrue:
- getter numArgs == 0 ifTrue:
[aTile setLiteralInitially: (aTarget perform: getter)].
displayer useStringFormat.
^ aTile
!
Item was changed:
----- Method: Object>>infoFor:inViewer: (in category '*Etoys-viewer') -----
infoFor: anElement inViewer: aViewer
"The user made a gesture asking for info/menu relating to me. Some of the messages dispatched here are not yet available in this image"
| aMenu elementType |
elementType := self elementTypeFor: anElement vocabulary: aViewer currentVocabulary.
((elementType = #systemSlot) | (elementType == #userSlot))
ifTrue: [^ self slotInfoButtonHitFor: anElement inViewer: aViewer].
self flag: #deferred. "Use a traditional MenuMorph, and reinstate the pacify thing"
aMenu := MenuMorph new defaultTarget: aViewer.
#( ('implementors' browseImplementorsOf:)
('senders' browseSendersOf:)
('versions' browseVersionsOf:)
-
('browse full' browseMethodFull:)
('inheritance' browseMethodInheritance:)
-
('about this method' aboutMethod:)) do:
[:pair |
pair = '-'
ifTrue:
[aMenu addLine]
ifFalse:
[aMenu add: pair first target: aViewer selector: pair second argument: anElement]].
aMenu addLine.
aMenu defaultTarget: self.
#( ('destroy script' removeScript:)
('rename script' renameScript:)
('pacify script' pacifyScript:)) do:
[:pair |
aMenu add: pair first target: self selector: pair second argument: anElement].
aMenu addLine.
aMenu add: 'show categories....' target: aViewer selector: #showCategoriesFor: argument: anElement.
+ aMenu items size = 0 ifTrue: "won't happen at the moment a/c the above"
- aMenu items size == 0 ifTrue: "won't happen at the moment a/c the above"
[aMenu add: 'ok' action: nil]. "in case it was a slot -- weird, transitional"
aMenu addTitle: anElement asString, ' (', elementType, ')'.
aMenu popUpInWorld: self currentWorld.
!
Item was changed:
----- Method: Object>>uniqueNameForReference (in category '*Etoys-viewer') -----
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 stem knownClassVars |
(aName := self uniqueNameForReferenceOrNil) ifNotNil: [^ aName].
(stem := self knownName) ifNil:
[stem := self defaultNameStemForInstances asString].
stem := stem select: [:ch | ch isLetter or: [ch isDigit]].
+ stem size = 0 ifTrue: [stem := 'A'].
- 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 |
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!
Item was changed:
----- Method: Object>>uniqueNameForReferenceFrom: (in category '*Etoys-viewer') -----
uniqueNameForReferenceFrom: proposedName
"Answer a satisfactory symbol, similar to the proposedName but obeying the rules, to represent the receiver"
| aName stem |
proposedName = self uniqueNameForReferenceOrNil
ifTrue: [^ proposedName]. "No change"
stem := proposedName select: [:ch | ch isLetter or: [ch isDigit]].
+ stem size = 0 ifTrue: [stem := 'A'].
- stem size == 0 ifTrue: [stem := 'A'].
stem first isLetter ifFalse:
[stem := 'A', stem].
stem := stem capitalized.
aName := Utilities keyLike: stem satisfying:
[:jinaLake |
| nameSym okay |
nameSym := jinaLake asSymbol.
okay := true.
(self class bindingOf: nameSym) ifNotNil: [okay := false "don't use it"].
okay].
^ aName asSymbol!
Item was changed:
----- Method: Player classSide>>addDocumentationForScriptsTo: (in category 'user-scripted subclasses') -----
addDocumentationForScriptsTo: aStream
"Add documentation for every script in the receiver to the stream"
self scripts do:
[:aScript |
aScript selector ifNotNil:
[aStream cr; cr.
aStream nextPutAll: self typicalInstanceName, '.'.
self printMethodChunk: aScript selector withPreamble: false on: aStream moveSource: false toFile: nil.
aStream position: (aStream position - 2)]].
+ self scripts size = 0 ifTrue:
- self scripts size == 0 ifTrue:
[aStream cr; tab; nextPutAll: 'has no scripts']!
Item was changed:
----- Method: Player classSide>>namedUnaryTileScriptSelectors (in category 'scripts') -----
namedUnaryTileScriptSelectors
"Answer a list of all the selectors of named unary tile scripts"
scripts ifNil: [^ OrderedCollection new].
+ ^ scripts select: [:aScript | | sel | (sel := aScript selector) notNil and: [sel numArgs = 0]]
- ^ scripts select: [:aScript | | sel | ((sel := aScript selector) ~~ nil) and: [sel numArgs == 0]]
thenCollect: [:aScript | aScript selector]!
Item was changed:
----- Method: Player classSide>>playersWithUnnecessarySubclasses (in category 'housekeeping') -----
playersWithUnnecessarySubclasses
"Return a list of all players whose scripts dictionaries contain entries with nil selectors"
"Player playersWithUnnecessarySubclasses size"
^ self withAllSubclasses select:
+ [:p | p class isSystemDefined not and: [p scripts size = 0 and: [p instVarNames size = 0]]] !
- [:p | p class isSystemDefined not and: [p scripts size == 0 and: [p instVarNames size == 0]]] !
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].
- 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 := 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>>chooseUserSlot (in category 'slots-user') -----
chooseUserSlot
| names result |
+ (names := self slotNames) size = 1
- (names := self slotNames) size == 1
ifTrue: [^ names first].
result := UIManager default
chooseFrom: names
values: names
title: 'Please choose a variable'.
result isEmptyOrNil ifTrue: [^ nil].
^ result!
Item was changed:
----- Method: Player>>newTextualScriptorFor: (in category 'scripts-kernel') -----
newTextualScriptorFor: aSelector
"Sprout a scriptor for aSelector, opening up in textual mode. Rather special-purpose, consult my lone sender"
| aMethodWithInterface aScriptEditor |
(self class includesSelector: aSelector) ifTrue: [self error: 'selector already exists'].
aMethodWithInterface := self class permanentUserScriptFor: aSelector player: self.
aScriptEditor := aMethodWithInterface instantiatedScriptEditorForPlayer: self.
aScriptEditor install.
aScriptEditor showSourceInScriptor.
+ aMethodWithInterface selector numArgs = 0 ifTrue:
- aMethodWithInterface selector numArgs == 0 ifTrue:
[self class allSubInstancesDo: [:anInst | anInst scriptInstantiationForSelector: aMethodWithInterface selector]].
"The above assures the presence of a ScriptInstantiation for the new selector in all siblings"
self updateAllViewersAndForceToShow: #scripts.
^ aScriptEditor!
Item was changed:
----- Method: Player>>offerAlternateViewerMenuFor:event: (in category 'misc') -----
offerAlternateViewerMenuFor: aViewer event: evt
"Put up an alternate Viewer menu on behalf of the receiver."
| aMenu aWorld |
aWorld := aViewer world.
aMenu := MenuMorph new defaultTarget: self.
costumes ifNotNil:
+ [(costumes size > 1 or: [costumes size = 1 and: [costumes first ~~ costume renderedMorph]])
- [(costumes size > 1 or: [costumes size == 1 and: [costumes first ~~ costume renderedMorph]])
ifTrue:
[aMenu add: 'forget other costumes' translated target: self selector: #forgetOtherCostumes]].
aMenu add: 'expunge empty scripts' translated target: self action: #expungeEmptyScripts.
aMenu addLine.
aMenu add: 'choose vocabulary...' translated target: aViewer action: #chooseVocabulary.
aMenu balloonTextForLastItem: 'Choose a different vocabulary for this Viewer.' translated.
aMenu add: 'choose limit class...' translated target: aViewer action: #chooseLimitClass.
aMenu balloonTextForLastItem: 'Specify what the limitClass should be for this Viewer -- i.e., the most generic class whose methods and categories should be considered here.' translated.
aMenu add: 'open standard lexicon' translated target: aViewer action: #openLexicon.
aMenu balloonTextForLastItem: 'open a window that shows the code for this object in traditional programmer format' translated.
aMenu add: 'open lexicon with search pane' translated target: aViewer action: #openSearchingProtocolBrowser.
aMenu balloonTextForLastItem: 'open a lexicon that has a type-in pane for search (not recommended!!)' translated.
aMenu addLine.
aMenu add: 'inspect morph' translated target: costume selector: #inspect.
aMenu add: 'inspect player' translated target: self selector: #inspect.
self belongsToUniClass ifTrue:
[aMenu add: 'browse class' translated target: self action: #browsePlayerClass.
aMenu add: 'inspect class' translated target: self class action: #inspect].
aMenu add: 'inspect this Viewer' translated target: aViewer selector: #inspect.
aMenu add: 'inspect this Vocabulary' translated target: aViewer currentVocabulary selector: #inspect.
aMenu addLine.
aMenu add: 'relaunch this Viewer' translated target: aViewer action: #relaunchViewer.
aMenu add: 'attempt repairs' translated target: ActiveWorld action: #attemptCleanup.
aMenu add: 'view morph directly' translated target: aViewer action: #viewMorphDirectly.
aMenu balloonTextForLastItem: 'opens a Viewer directly on the rendered morph.' translated.
(costume renderedMorph isSketchMorph) ifTrue:
[aMenu addLine.
aMenu add: 'impart scripts to...' translated target: self action: #impartSketchScripts].
aMenu popUpEvent: evt in: aWorld!
Item was changed:
----- Method: Player>>renameScript:newSelector: (in category 'scripts-kernel') -----
renameScript: oldSelector newSelector: newSelector
"Rename the given script to have the new selector"
| aUserScript anInstantiation |
oldSelector = newSelector ifTrue: [^ self].
+ oldSelector numArgs = 0
- oldSelector numArgs == 0
ifTrue:
[self class allSubInstancesDo:
[:aPlayer | | itsCostume aDict |
anInstantiation := aPlayer scriptInstantiationForSelector: oldSelector.
anInstantiation ifNotNil: [
+ newSelector numArgs = 0
- newSelector numArgs == 0
ifTrue:
[anInstantiation changeSelectorTo: newSelector].
aDict := aPlayer costume actorState instantiatedUserScriptsDictionary.
itsCostume := aPlayer costume renderedMorph.
itsCostume renameScriptActionsFor: aPlayer from: oldSelector to: newSelector.
self currentWorld renameScriptActionsFor: aPlayer from: oldSelector to: newSelector.
aDict removeKey: oldSelector.
+ newSelector numArgs = 0 ifTrue:
- newSelector numArgs == 0 ifTrue:
[aDict at: newSelector put: anInstantiation.
anInstantiation assureEventHandlerRepresentsStatus]]]]
ifFalse:
+ [newSelector numArgs = 0 ifTrue:
- [newSelector numArgs == 0 ifTrue:
[self class allSubInstancesDo:
[:aPlayer |
anInstantiation := aPlayer scriptInstantiationForSelector: newSelector.
anInstantiation ifNotNil: [anInstantiation assureEventHandlerRepresentsStatus]]]].
aUserScript := self class userScriptForPlayer: self selector: oldSelector.
aUserScript renameScript: newSelector fromPlayer: self.
"updates all script editors, and inserts the new script in my scripts directory"
self class removeScriptNamed: oldSelector.
((self existingScriptInstantiationForSelector: newSelector) notNil and:
[newSelector numArgs > 0]) ifTrue: [self error: 'ouch'].
self updateAllViewersAndForceToShow: 'scripts'!
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 := 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
- 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>>tilesToCall: (in category 'scripts-kernel') -----
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
- 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 := ScriptingSystem tileForArgType: argType.
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) documentation.
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 tileToRefer.
selfTile position: aPhrase firstSubmorph position.
aPhrase firstSubmorph addMorph: selfTile.
aPhrase makeAllTilesGreen.
aPhrase justGrabbedFromViewer: false].
^ aPhrase!
Item was changed:
----- Method: ScriptEditorMorph>>updateStatus (in category 'buttons') -----
updateStatus
"Update that status in the receiver's header. "
+ (self topEditor == self and: [firstTileRow ~= 1]) ifTrue:
+ [(submorphs size = 0 or: [(self firstSubmorph findA: ScriptStatusControl) isNil])
- (self topEditor == self and: [firstTileRow ~~ 1]) ifTrue:
- [(submorphs size == 0 or: [(self firstSubmorph findA: ScriptStatusControl) isNil])
ifTrue:
[self replaceRow1].
self updateStatusMorph: (self firstSubmorph findA: ScriptStatusControl)]!
Item was changed:
----- Method: StackMorph>>insertCardOfBackground (in category 'as yet unclassified') -----
insertCardOfBackground
"Prompt the user for choice of a background, and insert a new card of that background"
| bgs aBackground |
+ (bgs := self backgrounds) size = 1 ifTrue:
- (bgs := self backgrounds) size == 1 ifTrue:
[self inform:
'At this time, there IS only one kind of
background in this stack, so that''s
what you''ll get' translated.
^ self insertCard].
aBackground := UIManager default
chooseFrom: (bgs collect: [:bg | bg externalName])
values: bgs.
aBackground ifNotNil:
[self insertCardOfBackground: aBackground]!
Item was changed:
----- Method: UniclassScript>>instantiatedScriptEditorForPlayer: (in category 'script editor') -----
instantiatedScriptEditorForPlayer: aPlayer
"Return the current script editor, creating it if necessary"
currentScriptEditor ifNil:
[currentScriptEditor := (self playerClass includesSelector: selector)
ifTrue:
[Preferences universalTiles
ifFalse:
[self error: 'duplicate selector'].
ScriptEditorMorph new fromExistingMethod: selector forPlayer: aPlayer]
ifFalse:
[ScriptEditorMorph new setMorph: aPlayer costume scriptName: selector].
+ (defaultStatus == #ticking and: [selector numArgs = 0]) ifTrue:
- (defaultStatus == #ticking and: [selector numArgs == 0]) ifTrue:
[aPlayer costume arrangeToStartStepping]].
^ currentScriptEditor!
Item was changed:
----- Method: UniclassScript>>revertScriptVersionFrom: (in category 'versions') -----
revertScriptVersionFrom: anEditor
"Let user choose which prior tile version to revert to, and revert to it"
| chosenStampAndTileList |
formerScriptingTiles isEmptyOrNil ifTrue: [^Beeper beep].
+ chosenStampAndTileList := formerScriptingTiles size = 1
- chosenStampAndTileList := formerScriptingTiles size == 1
ifTrue: [ formerScriptingTiles first]
ifFalse:
[UIManager default
chooseFrom: (formerScriptingTiles collect: [:e | e first])
values: formerScriptingTiles].
chosenStampAndTileList ifNotNil:
[anEditor reinsertSavedTiles: chosenStampAndTileList second.
isTextuallyCoded := false]!
Item was changed:
----- Method: UserScript>>revertScriptVersionFrom: (in category 'versions') -----
revertScriptVersionFrom: anEditor
"Let user choose which prior tile version to revert to, and revert to it"
| result |
formerScriptEditors isEmptyOrNil ifTrue: [^Beeper beep].
+ result := formerScriptEditors size = 1
- result := formerScriptEditors size == 1
ifTrue: [formerScriptEditors first]
ifFalse:
[UIManager default
chooseFrom: (formerScriptEditors collect: [:e | e timeStamp])
values: formerScriptEditors].
result
ifNotNil: [self revertScriptVersionFrom: anEditor installing: result]!
More information about the Packages
mailing list