[Pkg] The Trunk: EToys-ar.51.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Jan 3 23:34:15 UTC 2010
Andreas Raab uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-ar.51.mcz
==================== Summary ====================
Name: EToys-ar.51
Author: ar
Time: 4 January 2010, 12:32:51 pm
UUID: 5eefab0a-e4dc-8c47-b304-6fd6a0070763
Ancestors: EToys-nice.44
Move lots of stuff to the Etoys package to make it more self-consistent and (un|re)loadable.
=============== Diff against EToys-nice.44 ===============
Item was added:
+ ----- Method: PasteUpMorph>>toggleIndicateCursor (in category '*Etoys-viewing') -----
+ toggleIndicateCursor
+ indicateCursor := self indicateCursor not.
+ self changed.!
Item was added:
+ ----- Method: PasteUpMorph>>recreateScripts (in category '*eToys-support') -----
+ recreateScripts
+ "self currentWorld recreateScripts."
+
+ Preferences enable: #universalTiles.
+ Preferences enable: #capitalizedReferences.
+ "Rebuild viewers"
+ self flapTabs do:
+ [:ff |
+ (ff isMemberOf: ViewerFlapTab)
+ ifTrue:
+ [ff referent
+ submorphsDo: [:m | (m isStandardViewer) ifTrue: [m recreateCategories]]]].
+ "Rebuild scriptors"
+ ((self flapTabs collect: [:t | t referent]) copyWith: self)
+ do: [:w | w allScriptEditors do: [:scrEd | scrEd unhibernate]]!
Item was added:
+ ----- Method: PasteUpMorph>>setThumbnailHeight (in category '*Etoys-viewing') -----
+ setThumbnailHeight
+ | reply |
+ (self hasProperty: #alwaysShowThumbnail) ifFalse:
+ [^ self inform: 'setting the thumbnail height is only
+ applicable when you are currently
+ showing thumbnails.' translated].
+ reply := UIManager default
+ request: 'New height for thumbnails? ' translated
+ initialAnswer: self heightForThumbnails printString.
+ reply isEmpty ifTrue: [^ self].
+ reply := reply asNumber.
+ (reply > 0 and: [reply <= 150]) ifFalse:
+ [^ self inform: 'Please be reasonable!!' translated].
+ self setProperty: #heightForThumbnails toValue: reply.
+ self updateSubmorphThumbnails!
Item was added:
+ ----- Method: Morph>>selectorsForViewer (in category '*Etoys') -----
+ selectorsForViewer
+ "Answer a list of symbols representing all the selectors available in all my viewer categories"
+
+ | aClass aList itsAdditions added addBlock |
+ aClass := self renderedMorph class.
+ aList := OrderedCollection new.
+ added := Set new.
+ addBlock := [ :sym | (added includes: sym) ifFalse: [ added add: sym. aList add: sym ]].
+
+ [aClass == Morph superclass] whileFalse:
+ [(aClass hasAdditionsToViewerCategories)
+ ifTrue:
+ [itsAdditions := aClass allAdditionsToViewerCategories.
+ itsAdditions do: [ :add | add do: [:aSpec |
+ "the spec list"
+
+ aSpec first == #command ifTrue: [ addBlock value: aSpec second].
+ aSpec first == #slot
+ ifTrue:
+ [ addBlock value: (aSpec seventh).
+ addBlock value: aSpec ninth]]]].
+ aClass := aClass superclass].
+
+ ^aList copyWithoutAll: #(#unused #dummy)
+
+ "SimpleSliderMorph basicNew selectorsForViewer"!
Item was added:
+ ----- Method: PasteUpMorph>>liftAllPens (in category '*Etoys-pen') -----
+ liftAllPens
+ submorphs do: [:m | m assuredPlayer liftPen]!
Item was added:
+ ----- Method: Morph>>configureForKids (in category '*Etoys-support') -----
+ configureForKids
+ submorphs ifNotNil:
+ [submorphs do: [:m | m configureForKids]]!
Item was added:
+ ----- Method: Morph>>fire (in category '*Etoys-support') -----
+ fire
+ "If the receiver has any kind of button-action defined, fire that action now. Any morph can have special, personal mouseUpCodeToRun, and that will be triggered by this. Additionally, some morphs have specific buttonness, and these get sent the #doButtonAction message to carry out their firing. Finally, some morphs have mouse behaviors associated with one or more Player scripts.
+ For the present, we'll try out doing *all* the firings this object can do. "
+
+ self firedMouseUpCode. "This will run the mouseUpCodeToRun, if any"
+
+ self player ifNotNil:
+ [self player fireOnce]. "Run mouseDown and mouseUp scripts"
+
+ self doButtonAction "Do my native button action, if any"!
Item was added:
+ ----- Method: PasteUpMorph>>becomeLikeAHolder (in category '*Etoys-viewing') -----
+ becomeLikeAHolder
+ (self autoLineLayout
+ and: [self indicateCursor])
+ ifTrue: [^ self inform: 'This view is ALREADY
+ behaving like a holder, which
+ is to say, it is set to indicate the
+ cursor and to have auto-line-layout.' translated].
+ self behaveLikeHolder!
Item was added:
+ ----- Method: ScriptEditorMorph>>setParameterType: (in category 'testing') -----
+ setParameterType: typeChosen
+ "Set the parameter type as indicated"
+
+ playerScripted setParameterFor: scriptName toType: typeChosen!
Item was added:
+ ----- Method: Morph>>bringUpToDate (in category '*Etoys-scripting') -----
+ bringUpToDate
+
+ (self buttonProperties ifNil: [^self]) bringUpToDate!
Item was added:
+ ----- Method: Morph>>isTurtleRow (in category '*Etoys') -----
+ isTurtleRow
+
+ | aCollection selectorCollection |
+ aCollection := Set new.
+ selectorCollection := Set new.
+ self accumlatePlayersInto: aCollection andSelectorsInto: selectorCollection.
+ #(turtleCount: turtleCount grouped: grouped) do: [:sel |
+ (selectorCollection includes: sel) ifTrue: [^ false].
+ ].
+
+ aCollection do: [:e |
+ (e isKindOf: KedamaExamplerPlayer) ifTrue: [^ true].
+ ].
+ ^ false.
+ !
Item was added:
+ ----- Method: Morph>>stackDo: (in category '*Etoys-card in a stack') -----
+ stackDo: aBlock
+ "If the receiver has a stack, evaluate aBlock on its behalf"
+
+ | aStack |
+ (aStack := self ownerThatIsA: StackMorph) ifNotNil:
+ [^ aBlock value: aStack]!
Item was added:
+ ----- Method: Morph>>tabHitWithEvent: (in category '*Etoys-card in a stack') -----
+ tabHitWithEvent: anEvent
+ "The tab key was hit. The keyboard focus has referred this event to me, though this perhaps seems rather backwards. Anyway, the assumption is that I have the property #tabAmongFields, so now the task is to tab to the next field."
+
+ | currentFocus fieldList anIndex itemToHighlight variableBearingMorphs otherAmenableMorphs |
+ currentFocus := anEvent hand keyboardFocus.
+ fieldList := self allMorphs select:
+ [:aMorph | (aMorph wouldAcceptKeyboardFocusUponTab) and: [aMorph isLocked not]].
+
+ fieldList isEmpty ifTrue:[^ self].
+
+ variableBearingMorphs := self player isNil
+ ifTrue:[#()]
+ ifFalse:[self player class variableDocks collect: [:vd | vd definingMorph] thenSelect: [:m | m isInWorld]].
+ otherAmenableMorphs := (self allMorphs select:
+ [:aMorph | (aMorph wouldAcceptKeyboardFocusUponTab) and: [aMorph isLocked not]])
+ copyWithoutAll: variableBearingMorphs.
+ fieldList := variableBearingMorphs, otherAmenableMorphs.
+
+ anIndex := fieldList indexOf: currentFocus ifAbsent: [nil].
+ itemToHighlight := fieldList atWrap:
+ (anIndex ifNotNil: [anEvent shiftPressed ifTrue: [anIndex - 1] ifFalse: [anIndex + 1]]
+ ifNil: [1]).
+ anEvent hand newKeyboardFocus: itemToHighlight. self flag: #arNote. "really???"
+ itemToHighlight editor selectAll.
+ itemToHighlight invalidRect: itemToHighlight bounds !
Item was added:
+ ----- Method: PasteUpMorph>>linesAndArrowsForAllPens (in category '*Etoys-pen') -----
+ linesAndArrowsForAllPens
+ "Set the trail style for all my objects to show arrows"
+
+ self trailStyleForAllPens: #arrows!
Item was added:
+ ----- Method: ScriptEditorMorph>>scriptee (in category 'buttons') -----
+ scriptee
+ | editor |
+ playerScripted ifNotNil: [^ playerScripted].
+ (editor := self topEditor) == self ifTrue: [self error: 'unattached script editor'. ^ nil].
+ ^ editor scriptee!
Item was added:
+ ----- 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'].
+ 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 added:
+ ----- Method: Morph>>holdsSeparateDataForEachInstance (in category '*Etoys-card in a stack') -----
+ holdsSeparateDataForEachInstance
+ "Answer whether the receiver is currently behaving as a 'background field', i.e., whether it is marked as shared (viz. occurring on the background of a stack) *and* is marked as holding separate data for each instance"
+
+ ^ self isShared and: [self hasProperty: #holdsSeparateDataForEachInstance]!
Item was added:
+ ----- Method: NumericReadoutTile>>isNumericReadoutTile (in category 'accessing') -----
+ isNumericReadoutTile
+ ^true!
Item was added:
+ ----- Method: Object>>updateThresholdForGraphicInViewerTab (in category '*Etoys-viewer') -----
+ updateThresholdForGraphicInViewerTab
+ "When a Viewer is open on the receiver, its tab needs some graphic to show to the user. Computing this graphic can take quite some time so we want to make the update frequency depending on how long it takes to compute the thumbnail. The threshold returned by this method defines that the viewer will update at most every 'threshold * timeItTakesToDraw' milliseconds. Thus, if the time for computing the receiver's thumbnail is 200 msecs and the the threshold is 10, the viewer will update at most every two seconds."
+ ^20 "seems to be a pretty good general choice"!
Item was added:
+ ----- Method: Morph>>couldHoldSeparateDataForEachInstance (in category '*Etoys-card in a stack') -----
+ couldHoldSeparateDataForEachInstance
+ "Answer whether this type of morph is inherently capable of holding separate data for each instance ('card data')"
+
+ ^ false!
Item was added:
+ ----- Method: ScriptEditorMorph>>objectViewed (in category 'e-toy support') -----
+ objectViewed
+ ^ self playerScripted costume!
Item was added:
+ ----- Method: PasteUpMorph>>batchPenTrailsString (in category '*Etoys-viewing') -----
+ batchPenTrailsString
+ "Answer the string to be shown in a menu to represent the
+ batch-pen-trails enabled status"
+ ^ (self batchPenTrails
+ ifTrue: ['<on>']
+ ifFalse: ['<off>']), 'batch pen trails' translated!
Item was added:
+ ----- Method: EtoysPresenter>>stopRunningScripts (in category 'stop-step-go buttons') -----
+ stopRunningScripts
+ "Put all ticking scripts within my scope into paused mode. Get any scripting-control buttons to show the correct state"
+
+ self stopButtonState: #on.
+ self stepButtonState: #off.
+ self goButtonState: #off.
+ associatedMorph stopRunningAll.
+
+ "associatedMorph borderColor: Preferences borderColorWhenStopped"!
Item was added:
+ ----- Method: WordArray>>/ (in category '*Etoys-arithmetic') -----
+ / other
+
+ | result |
+ other isNumber ifTrue: [
+ other isFloat ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primDivScalar: self and: other into: result.
+ ] ifFalse: [
+ result := WordArray new: self size.
+ ^ self primDivScalar: self and: other into: result.
+ ].
+ ].
+ (other isMemberOf: WordArray) ifTrue: [
+ result := WordArray new: self size.
+ ^ self primDivArray: self and: other into: result.
+ ].
+ (other isMemberOf: KedamaFloatArray) ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primDivArray: self and: other into: result.
+ ].
+ ^ super / other.
+ !
Item was added:
+ ----- Method: PasteUpMorph>>updateTrailsForm (in category '*Etoys-pen') -----
+ updateTrailsForm
+ "Update the turtle-trails form using the current positions of all pens.
+ Only used in conjunction with Preferences batchPenTrails."
+
+ "Details: The positions of all morphs with their pens down are recorded each time the draw method is called. If the list from the previous display cycle isn't empty, then trails are drawn from the old to the new positions of those morphs on the turtle-trails form. The turtle-trails form is created on demand when the first pen is put down and removed (to save space) when turtle trails are cleared."
+
+ | removals |
+ self flag: #bob. "transformations WRONG here"
+ (lastTurtlePositions isNil or: [lastTurtlePositions isEmpty])
+ ifTrue: [^self].
+ removals := OrderedCollection new.
+ lastTurtlePositions associationsDo:
+ [:assoc | | player oldPoint newPoint morph tfm |
+ player := assoc key.
+ morph := player costume.
+ (player getPenDown and: [morph trailMorph == self])
+ ifTrue:
+ [oldPoint := assoc value.
+ tfm := morph owner transformFrom: self.
+ newPoint := tfm localPointToGlobal: morph referencePosition.
+ newPoint = oldPoint
+ ifFalse:
+ [assoc value: newPoint.
+ self
+ drawPenTrailFor: morph
+ from: oldPoint
+ to: newPoint]]
+ ifFalse: [removals add: player]].
+ removals do: [:key | lastTurtlePositions removeKey: key ifAbsent: []]!
Item was added:
+ ----- Method: EtoysPresenter>>stopRunningScriptsFrom: (in category 'stop-step-go buttons') -----
+ stopRunningScriptsFrom: ignored
+ "Stop running scripts; get all script-control buttons to reflect this"
+
+ self stopRunningScripts!
Item was added:
+ ----- Method: Morph>>penColor: (in category '*Etoys') -----
+ penColor: aColor
+ self assuredPlayer penColor: aColor!
Item was added:
+ ----- Method: Morph>>hasButtonProperties (in category '*Etoys-support') -----
+ hasButtonProperties
+
+ ^self hasProperty: #universalButtonProperties!
Item was added:
+ ----- Method: PasteUpMorph>>toggleAlwaysShowThumbnail (in category '*Etoys-viewing') -----
+ toggleAlwaysShowThumbnail
+ (self hasProperty: #alwaysShowThumbnail)
+ ifTrue:
+ [self removeProperty: #alwaysShowThumbnail]
+ ifFalse:
+ [self setProperty: #alwaysShowThumbnail toValue: true].
+ self updateSubmorphThumbnails!
Item was added:
+ ----- Method: ScriptEditorMorph>>fromExistingMethod:forPlayer: (in category 'tiles from method') -----
+ fromExistingMethod: aSelector forPlayer: aPlayer
+ "Create tiles for this method. "
+
+ self initialize.
+ playerScripted := aPlayer.
+ self setMorph: aPlayer costume scriptName: aSelector.
+ self insertUniversalTiles!
Item was added:
+ ----- Method: ScriptEditorMorph>>setTimeStamp (in category 'other') -----
+ setTimeStamp
+ timeStamp := Date today mmddyyyy, ' ', (Time now print24 copyFrom: 1 to: 8).
+ ^ timeStamp!
Item was added:
+ ----- 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 = (Utilities getterSelectorFor: oldSlotName)) ifTrue:
+ [(self isPlayer: aPlayer ofReferencingTile: tile) ifTrue:
+ [tile setOperator: (Utilities getterSelectorFor: newSlotName)]]].
+ tile traverseRowTranslateSlotOld: oldSlotName of: aPlayer to: newSlotName]!
Item was added:
+ ----- Method: ScriptEditorMorph>>typeForParameter (in category 'testing') -----
+ typeForParameter
+ "Answer a symbol representing the type of my parameter"
+
+ scriptName numArgs > 0 ifTrue:
+ [(playerScripted class scripts at: scriptName ifAbsent: [nil]) ifNotNil:
+ [:aScript | ^ aScript argumentVariables first variableType]].
+
+ ^ #Error!
Item was added:
+ ----- Method: PhraseTileMorph>>isPhraseTileMorph (in category 'e-toy support') -----
+ isPhraseTileMorph
+ ^true!
Item was added:
+ ----- Method: Morph>>choosePenColor: (in category '*Etoys') -----
+ choosePenColor: evt
+ self assuredPlayer choosePenColor: evt!
Item was added:
+ ----- Method: Object>>assureUniClass (in category '*Etoys-viewer') -----
+ assureUniClass
+ "If the receiver is not yet an instance of a uniclass, create a uniclass for it and make the receiver become an instance of that class."
+
+ | anInstance |
+ self belongsToUniClass ifTrue: [^ self].
+ anInstance := self class instanceOfUniqueClass.
+ self become: (self as: anInstance class).
+ ^ anInstance!
Item was added:
+ ----- Method: Morph>>insertAsStackBackground (in category '*Etoys-card in a stack') -----
+ insertAsStackBackground
+ "I am not yet in a stack. Find a Stack that my reference point (center) overlaps, and insert me as a new background."
+
+ | aMorph |
+ self isStackBackground ifTrue: [^ Beeper beep].
+ "already in a stack. Must clear flags when remove."
+ " self potentialEmbeddingTargets do: [:mm | No, force user to choose a stack.
+ (mm respondsTo: #insertAsBackground:resize:) ifTrue: [
+ ^ mm insertAsBackground: self resize: false]].
+ "
+ "None found, ask user"
+ self inform: 'Please click on a Stack' translated.
+ Sensor waitNoButton.
+ aMorph := self world chooseClickTarget.
+ aMorph ifNil: [^ self].
+ (aMorph ownerThatIsA: StackMorph) insertAsBackground: self resize: false.!
Item was added:
+ ----- Method: PasteUpMorph>>showAllPlayers (in category '*eToys-support') -----
+ showAllPlayers
+
+ | a |
+ a := OrderedCollection new.
+ self allMorphsDo: [ :x |
+ (x player notNil and: [x player hasUserDefinedScripts]) ifTrue: [a add: x]
+ ].
+ a do: [ :each | each openViewerForArgument].
+ !
Item was added:
+ ----- Method: EtoysPresenter>>allCurrentlyTickingScriptInstantiations (in category 'playerList') -----
+ allCurrentlyTickingScriptInstantiations
+ "Answer a list of ScriptInstantiation objects representing all the scripts within the scope of the receiver which are currently ticking."
+
+ ^ Array streamContents:
+ [:aStream |
+ self allExtantPlayers do:
+ [:aPlayer | aPlayer instantiatedUserScriptsDo:
+ [:aScriptInstantiation |
+ aScriptInstantiation status == #ticking ifTrue:
+ [aStream nextPut: aScriptInstantiation]]]]!
Item was added:
+ ----- Method: Morph>>stack (in category '*Etoys-card in a stack') -----
+ stack
+ "Answer the nearest containing Stack, or, if none, a stack in the current project, and if still none, nil. The extra messiness is because uninstalled backgrounds don't have an owner pointers to their stack."
+
+ | aStack bkgnd |
+ bkgnd := self orOwnerSuchThat: [:oo | oo hasProperty: #myStack].
+ bkgnd ifNotNil: [^ bkgnd valueOfProperty: #myStack].
+
+ "fallbacks"
+ (aStack := self ownerThatIsA: StackMorph) ifNotNil: [^ aStack].
+ ^ Project current currentStack!
Item was added:
+ ----- Method: ScriptEditorMorph>>insertUniversalTilesForClass:selector: (in category 'other') -----
+ insertUniversalTilesForClass: aClass selector: aSelector
+ "Add a submorph which holds the universal-tiles script for the given class and selector"
+
+ | source tree syn widget header |
+ source := aClass sourceCodeAt: aSelector ifAbsent: [
+ Transcript cr; show: aClass name, 'could not find selector ', aSelector.
+ ^ self delete].
+ tree := Compiler new
+ parse: source
+ in: aClass
+ notifying: nil.
+ (syn := tree asMorphicSyntaxUsing: SyntaxMorph)
+ parsedInClass: aClass.
+ aSelector numArgs = 0 ifTrue: [
+ "remove method header line"
+ (header := syn findA: SelectorNode) ifNotNil: [header delete]].
+ syn removeReturnNode. "if ^ self at end, remove it"
+ widget := syn inAScrollPane.
+ widget hResizing: #spaceFill;
+ vResizing: #spaceFill;
+ color: Color transparent;
+ setProperty: #hideUnneededScrollbars toValue: true.
+ self addMorphBack: widget.
+ (self hasProperty: #autoFitContents) ifFalse:
+ [self valueOfProperty: #sizeAtHibernate ifPresentDo:
+ [:oldExtent | self extent: oldExtent]].
+ syn finalAppearanceTweaks.!
Item was added:
+ ----- Method: DSCPostscriptCanvas>>fullDrawBookMorph: (in category '*Etoys-drawing') -----
+ fullDrawBookMorph: aBookMorph
+ " draw all the pages in a book morph, but only if it is the top-level morph "
+
+ morphLevel = 1 ifFalse: [^ super fullDrawBookMorph: aBookMorph].
+
+ "Unfortunately, the printable 'pages' of a StackMorph are the cards, but for a BookMorph, they are the pages. Separate the cases here."
+ (aBookMorph isKindOf: StackMorph)
+ ifTrue: [
+ aBookMorph cards do: [:aCard |
+ aBookMorph goToCard: aCard. "cause card-specific morphs to be installed"
+ pages := pages + 1.
+ target print: '%%Page: '; write: pages; space; write: pages; cr.
+ self drawPage: aBookMorph currentPage]]
+ ifFalse: [
+ aBookMorph pages do: [:aPage |
+ pages := pages + 1.
+ target print: '%%Page: '; write: pages; space; write: pages; cr.
+ self drawPage: aPage]].
+ morphLevel = 0 ifTrue: [ self writeTrailer: pages ].
+ !
Item was added:
+ ----- Method: Morph>>relaxGripOnVariableNames (in category '*Etoys-card in a stack') -----
+ relaxGripOnVariableNames
+ "Abandon any memory of specific variable names that should be preserved. The overall situation here is not yet completely understood, and this relaxation is basically always done on each reassessment of the background shape nowadays. But this doesn't feel quite right, because if the user has somehow intervened to specify certain name preference we should perhaps honored it. Or perhaps that is no longer relevant. ????"
+
+ self submorphs do:
+ [:m | m removeProperty: #variableName.
+ m removeProperty: #setterSelector].
+ self reassessBackgroundShape
+ !
Item was added:
+ ----- Method: Morph>>deletePath (in category '*Etoys-support') -----
+ deletePath
+ self removeProperty: #pathPoints!
Item was added:
+ ----- Method: ParseNode>>addCommentToMorph: (in category '*eToys-tiles') -----
+ addCommentToMorph: aMorph
+ | row |
+ (self comment isNil or: [self comment isEmpty]) ifTrue: [^ self].
+ row := aMorph addTextRow:
+ (String streamContents: [:strm | self printCommentOn: strm indent: 1]).
+ row firstSubmorph color: (SyntaxMorph translateColor: #comment).
+ row parseNode: (self as: CommentNode).
+ !
Item was added:
+ ----- Method: Morph>>explainDesignations (in category '*Etoys-card in a stack') -----
+ explainDesignations
+ "Hand the user an object that contains explanations for the designation feedback used"
+
+ StackMorph designationsExplainer openInHand
+
+ "self currentWorld explainDesignations"!
Item was added:
+ ----- Method: Morph>>showPlayerMenu (in category '*Etoys') -----
+ showPlayerMenu
+ self player ifNotNil:
+ [self player showPlayerMenu]!
Item was added:
+ ----- Method: ScriptEditorMorph>>deleteThreadShowing (in category 'menu commands') -----
+ deleteThreadShowing
+
+ threadPolygon ifNotNil: [threadPolygon delete. threadPolygon := nil].
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>isScriptEditorMorph (in category 'testing') -----
+ isScriptEditorMorph
+ ^true!
Item was added:
+ ----- Method: Object>>tilePhrasesForMethodInterfaces:inViewer: (in category '*Etoys-viewer') -----
+ tilePhrasesForMethodInterfaces: methodInterfaceList inViewer: aViewer
+ "Return a collection of ViewerLine objects corresponding to the method-interface list provided. The resulting list will be in the same order as the incoming list, but may be smaller if the viewer's vocbulary suppresses some of the methods, or if, in classic tiles mode, the selector requires more arguments than can be handled."
+
+ | toSuppress interfaces |
+ toSuppress := aViewer currentVocabulary phraseSymbolsToSuppress.
+ interfaces := methodInterfaceList reject: [:int | toSuppress includes: int selector].
+ Preferences universalTiles ifFalse: "Classic tiles have their limitations..."
+ [interfaces := interfaces select:
+ [:int |
+ | itsSelector |
+ itsSelector := int selector.
+ itsSelector numArgs < 2 or:
+ "The lone two-arg loophole in classic tiles"
+ [#(color:sees:) includes: itsSelector]]].
+
+ ^ interfaces collect:
+ [:aMethodInterface |
+ | resultType |
+ ((resultType := aMethodInterface resultType) notNil and: [resultType ~~ #unknown])
+ ifTrue:
+ [aViewer phraseForVariableFrom: aMethodInterface]
+ ifFalse:
+ [aViewer phraseForCommandFrom: aMethodInterface]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ self listDirection: #topToBottom;
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ cellPositioning: #topLeft;
+ setProperty: #autoFitContents toValue: true;
+ layoutInset: 2;
+ useRoundedCorners.
+ self setNameTo: 'Script Editor' translated.
+ firstTileRow := 1.
+ "index of first tile-carrying submorph"
+ self addNewRow.
+ showingMethodPane := false!
Item was added:
+ ----- Method: EtoysPresenter>>stepDown:with: (in category 'stop-step-go buttons') -----
+ stepDown: evt with: aMorph
+ self stopRunningScripts!
Item was added:
+ ----- Method: MethodInterface>>initializeFromEToySlotSpec: (in category '*Etoys') -----
+ initializeFromEToySlotSpec: tuple
+ "tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to hold the same information"
+
+ | setter |
+ selector _ tuple seventh.
+ self
+ wording: (ScriptingSystem wordingForOperator: tuple second);
+ helpMessage: tuple third.
+
+ receiverType _ #Player.
+ resultSpecification _ ResultSpecification new.
+ resultSpecification resultType: tuple fourth.
+ (#(getNewClone getTurtleAt: getTurtleOf: "seesColor: isOverColor:") includes: selector)
+ ifTrue:
+ [self setNotToRefresh] "actually should already be nil"
+ ifFalse:
+ [self setToRefetch].
+
+ ((tuple fifth == #readWrite) and: [((tuple size >= 9) and: [(setter _ tuple at: 9) ~~ #unused])]) ifTrue:
+ [resultSpecification companionSetterSelector: setter].
+
+ "An example of an old slot-item spec:
+ (slot numericValue 'A number representing the current position of the knob.' number readWrite Player getNumericValue Player setNumericValue:)
+ 1 #slot
+ 2 wording
+ 3 balloon help
+ 4 type
+ 5 #readOnly or #readWrite
+ 6 #Player (not used -- ignore)
+ 7 getter selector
+ 8 #Player (not used -- ignore)
+ 9 setter selector
+ "
+ !
Item was added:
+ ----- Method: EToyVocabulary>>isEToyVocabulary (in category 'testing') -----
+ isEToyVocabulary
+ ^true!
Item was added:
+ ----- Method: ScriptEditorMorph>>dismissViaHalo (in category 'submorphs-add/remove') -----
+ dismissViaHalo
+ "The user has clicked in the delete halo-handle. This provides a hook in case some concomitant action should be taken, or if the particular morph is not one which should be put in the trash can, for example."
+
+ self resistsRemoval ifTrue: [^ self].
+ self destroyScript!
Item was added:
+ ----- Method: PasteUpMorph class>>additionsToViewerCategoryPreferences (in category '*eToys-scripting') -----
+ additionsToViewerCategoryPreferences
+ "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."
+
+ ^ #(preferences (
+ (slot useVectorVocabulary 'Whether to use the Vector vocabulary with etoy scripting in this project' Boolean readWrite Player getUseVectorVocabulary Player setUseVectorVocabulary:)
+ (slot dropProducesWatcher 'Whether a drop of a value tile, such as "car''s x", on the desktop, should produce a watcher for that value' Boolean readWrite Player getDropProducesWatcher Player setDropProducesWatcher:)
+ (slot allowEtoyUserCustomEvents 'Whether to allow "custom events" in etoys.' Boolean readWrite Player getAllowEtoyUserCustomEvents Player setAllowEtoyUserCustomEvents:)
+ (slot batchPenTrails 'Whether pen trails should reflect small movements within the same tick or only should integrate all movement between ticks' Boolean readWrite Player getBatchPenTrails Player setBatchPenTrails:)
+ "(slot eToyFriendly 'Whether various restrictions should apply in many parts of the system. Intended to be set to true for younger users.' Boolean readWrite Player getEToyFriendly Player setEToyFriendly:)"
+ (slot fenceEnabled 'Whether an object hitting the edge of the screen should be kept "fenced in", rather than being allowed to escape and disappear' Boolean readWrite Player getFenceEnabled Player setFenceEnabled:)
+ (slot keepTickingWhilePainting 'Whether scripts should continue to run while you''re using the painting system' Boolean readWrite Player getKeepTickingWhilePainting Player setKeepTickingWhilePainting:)
+ (slot oliveHandleForScriptedObjects 'Whether the default green halo handle (at the top right of the halo) should, for scripted objects, be the olive-green handle, signifying that use will result in a sibling instance. ' Boolean readWrite Player getOliveHandleForScriptedObjects Player setOliveHandleForScriptedObjects: )
+ ))!
Item was added:
+ ----- Method: ScriptEditorMorph>>install (in category 'buttons') -----
+ install
+ "Accept the current classic tiles as the new source code for the script. In the case of universalTiles, initialize the method and its methodInterface if not already done."
+
+ Preferences universalTiles ifFalse:
+ [self removeSpaces].
+ scriptName ifNotNil:
+ [playerScripted acceptScript: self topEditor for: scriptName asSymbol]!
Item was added:
+ ----- Method: WordArray>>primSubScalar:and:into: (in category '*Etoys-arithmetic') -----
+ primSubScalar: rcvr and: other into: result
+
+ <primitive: 'primitiveSubScalar' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveSubScalar."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) - other.
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: PasteUpMorph>>trailStyleForAllPens: (in category '*Etoys-pen') -----
+ trailStyleForAllPens: aTrailStyle
+ "Ascribe the given trail style to all pens of objects within me"
+
+ submorphs do: [:m | m assuredPlayer setTrailStyle: aTrailStyle]
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>scriptTitle (in category 'buttons') -----
+ scriptTitle
+
+ ^ Preferences universalTiles
+ ifTrue: [SyntaxMorph new substituteKeywordFor: scriptName]
+ "spaces instead of capitals, no colons"
+ "Don't use property #syntacticallyCorrectContents.
+ scriptName here holds the truth"
+ ifFalse: [scriptName].
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>setMorph: (in category 'initialization') -----
+ setMorph: anActorMorph
+ "Not really the way to do this any more"
+ playerScripted := anActorMorph player
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>insertUniversalTiles (in category 'other') -----
+ insertUniversalTiles
+ "Insert universal tiles for the method at hand"
+
+ self removeAllButFirstSubmorph.
+ "fix a broken header in weasel"
+ submorphs isEmpty ifFalse: [
+ self firstSubmorph vResizing: #shrinkWrap.
+ ].
+ self insertUniversalTilesForClass: playerScripted class selector: scriptName!
Item was added:
+ ----- Method: ScriptEditorMorph>>saveScriptVersion (in category 'save & revert') -----
+ saveScriptVersion
+ self userScriptObject saveScriptVersion: self setTimeStamp!
Item was added:
+ ----- Method: ScriptEditorMorph>>phrase: (in category 'initialization') -----
+ phrase: aPhraseTileMorph
+ "Make the receiver be a Scriptor for a new script whose initial contents is the given phrase."
+
+ | aHolder |
+ firstTileRow := 2.
+ aHolder := AlignmentMorph newRow.
+ aHolder beTransparent; layoutInset: 0.
+ aHolder addMorphBack: aPhraseTileMorph.
+ self addMorphBack: aHolder.
+ self install!
Item was changed:
----- Method: TileMorph class>>downPicture (in category 'class initialization') -----
downPicture
+ ^ DownPicture ifNil:[DownPicture := Form
+ extent: 9 at 9
+ depth: 16
+ fromArray: #( 14253 862794605 862794605 862729101 934150144 14221 724182793 654911241 654913323 931987456 0 793519881 722086698 652880586 862781440 0 931998474 654977834 648621835 0 0 12107 654911209 717895565 0 0 13164 654976681 789250048 0 0 14254 722085546 929890304 0 0 0 860630796 934150144 0 0 0 934098861 0 0)
+ offset: 0 at 0]!
- ^ DownPicture!
Item was added:
+ ----- Method: Object>>offerViewerMenuFor:event: (in category '*Etoys-viewer') -----
+ offerViewerMenuFor: aViewer event: evt
+ "Offer the primary Viewer menu to the user. Copied up from Player code, but most of the functions suggested here don't work for non-Player objects, many aren't even defined, some relate to exploratory sw work not yet reflected in the current corpus. We are early in the life cycle of this method..."
+
+ | aMenu |
+ aMenu := MenuMorph new defaultTarget: self.
+ aMenu addStayUpItem.
+ aMenu title: '**CAUTION -- UNDER CONSTRUCTION!!**
+ Many things may not work!!
+ ', self nameForViewer.
+ (aViewer affordsUniclass and: [self belongsToUniClass not]) ifTrue:
+ [aMenu add: 'give me a Uniclass' action: #assureUniClass.
+ aMenu addLine].
+ aMenu add: 'choose vocabulary...' target: aViewer action: #chooseVocabulary.
+ aMenu add: 'choose limit class...' target: aViewer action: #chooseLimitClass.
+ aMenu add: 'add search pane' target: aViewer action: #addSearchPane.
+ aMenu balloonTextForLastItem: 'Specify which class should be the most generic one to have its methods shown in this Viewer'.
+ aMenu addLine.
+
+ self belongsToUniClass ifTrue:
+ [aMenu add: 'add a new instance variable' target: self selector: #addInstanceVariableIn: argument: aViewer.
+ aMenu add: 'add a new script' target: aViewer selector: #newPermanentScriptIn: argument: aViewer.
+ aMenu addLine.
+ aMenu add: 'make my class be first-class' target: self selector: #makeFirstClassClassIn: argument: aViewer.
+ aMenu add: 'move my changes up to my superclass' target: self action: #promoteChangesToSuperclass.
+ aMenu addLine].
+
+ aMenu add: 'tear off a tile' target: self selector: #launchTileToRefer.
+ aMenu addLine.
+
+ aMenu add: 'inspect me' target: self selector: #inspect.
+ aMenu add: 'inspect my class' target: self class action: #inspect.
+ aMenu addLine.
+
+ aMenu add: 'browse vocabulary' action: #haveFullProtocolBrowsed.
+ aMenu add: 'inspect this Viewer' target: aViewer action: #inspect.
+
+ aMenu popUpEvent: evt in: aViewer currentWorld
+
+ "
+ aMenu add: 'references to me' target: aViewer action: #browseReferencesToObject.
+ aMenu add: 'toggle scratch pane' target: aViewer selector: #toggleScratchPane.
+ aMenu add: 'make a nascent script for me' target: aViewer selector: #makeNascentScript.
+ aMenu add: 'rename me' target: aViewer selector: #chooseNewNameForReference.
+ aMenu add: 'browse full' action: #browseOwnClassFull.
+ aMenu add: 'browse hierarchy' action: #browseOwnClassHierarchy.
+ aMenu add: 'set user level...' target: aViewer action: #setUserLevel.
+ aMenu add: 'browse sub-protocol' action: #browseOwnClassSubProtocol.
+ aMenu addLine.
+
+ "!
Item was added:
+ ----- Method: Morph>>newPlayerInstance (in category '*Etoys') -----
+ newPlayerInstance
+ ^ UnscriptedPlayer newUserInstance!
Item was added:
+ ----- Method: EtoysPresenter>>uniclassesAndCounts (in category 'playerList') -----
+ uniclassesAndCounts
+ "Answer a list of all players known to the receiver that have uniclasses"
+
+ ^ (self allPlayersWithUniclasses collect: [:aPlayer | aPlayer class]) asSet asArray collect:
+ [:aClass | Array
+ with: aClass
+ with: aClass instanceCount]
+
+
+ "self currentWorld presenter uniclassesAndCounts"!
Item was added:
+ ----- Method: ScriptEditorMorph>>veryDeepFixupWith: (in category 'copying') -----
+ veryDeepFixupWith: deepCopier
+ "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
+
+ super veryDeepFixupWith: deepCopier.
+ playerScripted := deepCopier references at: playerScripted ifAbsent: [playerScripted].
+ !
Item was added:
+ ----- Method: EtoysPresenter>>addTrashCan (in category 'button creation') -----
+ addTrashCan
+ | aPosition aCan |
+ (aCan := associatedMorph findA: TrashCanMorph) ifNotNil: [^ aCan].
+ aCan := TrashCanMorph newSticky.
+ aPosition := associatedMorph positionNear: (associatedMorph bottomRight - aCan extent) forExtent: aCan extent adjustmentSuggestion: (-10 @ 0).
+ aCan position: aPosition.
+ associatedMorph addMorph: aCan.
+ aCan startStepping.
+ aCan setToAdhereToEdge: #bottomRight.
+ ^ aCan
+ !
Item was added:
+ ----- Method: WordArray>>primMulScalar:and:into: (in category '*Etoys-arithmetic') -----
+ primMulScalar: rcvr and: other into: result
+
+ <primitive: 'primitiveMulScalar' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveMulScalar."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) * other.
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: Morph>>makeFenceSound (in category '*Etoys-support') -----
+ makeFenceSound
+ Preferences soundsEnabled ifTrue:
+ [self playSoundNamed: 'scratch'].
+ !
Item was added:
+ ----- Method: EtoysPresenter>>updateViewer: (in category 'viewer') -----
+ updateViewer: aViewer
+ self updateViewer: aViewer forceToShow: nil!
Item was added:
+ ----- Method: Morph>>goToNextCardInStack (in category '*Etoys-card in a stack') -----
+ goToNextCardInStack
+ "Tell my stack to advance to the next page"
+
+ self stackDo: [:aStack | aStack goToNextCardInStack]!
Item was added:
+ ----- Method: ScriptEditorMorph>>codeString (in category 'other') -----
+ codeString
+ ^ String streamContents: [:aStream | self storeCodeOn: aStream indent: 1]
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>isEmpty (in category 'other') -----
+ isEmpty
+ ^ submorphs size < firstTileRow!
Item was added:
+ ----- Method: PasteUpMorph>>addViewingItemsTo: (in category '*Etoys-viewing') -----
+ addViewingItemsTo: aMenu
+ "Add viewing-related items to the given menu. If any are added, this method is also responsible for adding a line after them"
+
+ #( (viewingByIconString viewByIcon)
+ (viewingByNameString viewByName)
+ "(viewingBySizeString viewBySize)"
+ (viewingNonOverlappingString viewNonOverlapping)) do:
+ [:pair | aMenu addUpdating: pair first target: self action: pair second].
+ aMenu addLine
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aMorph event: evt
+ "Answer whether the receiver would be interested in accepting the morph"
+
+ ^ (aMorph isTileLike and: [self isTextuallyCoded not]) and:
+ [(#(Command Unknown) includes: aMorph resultType capitalized)]!
Item was added:
+ ----- Method: PasteUpMorph>>linesForAllPens (in category '*Etoys-pen') -----
+ linesForAllPens
+ "Set the trail style for all my objects to show lines only"
+
+ self trailStyleForAllPens: #lines!
Item was added:
+ ----- Method: ScriptEditorMorph>>trackDropZones (in category 'dropping/grabbing') -----
+ trackDropZones
+ "The fundamental heart of script-editor layout, by Dan Ingalls in fall 1997, though many hands have touched it since."
+
+ | hand insertion i space1 d space2 insHt nxtHt prevBot ht2 c1 c2 ii where |
+ hand := handWithTile ifNil: [self primaryHand].
+ ((self hasOwner: hand) not and: [hand submorphCount > 0])
+ ifTrue:
+ [insertion := hand firstSubmorph renderedMorph.
+ insHt := insertion fullBounds height. self removeSpaces.
+ where := self globalPointToLocal: hand position"insertion fullBounds topLeft".
+ i := (ii := self indexOfMorphAbove: where) min: submorphs size-1.
+ prevBot := i <= 0 ifTrue: [(self innerBounds) top]
+ ifFalse: [(self submorphs at: i) bottom].
+ nxtHt := (submorphs isEmpty
+ ifTrue: [insertion]
+ ifFalse: [self submorphs at: i+1]) height.
+ d := ii > i ifTrue: [nxtHt "for consistent behavior at bottom"]
+ ifFalse: [0 max: (where y - prevBot min: nxtHt)].
+
+ "Top and bottom spacer heights cause continuous motion..."
+ c1 := Color green. c2 := Color transparent.
+ ht2 := d*insHt//nxtHt.
+ space1 := Morph newBounds: (0 at 0 extent: 30@(insHt-ht2))
+ color: ((insHt-ht2) > (insHt//2+1) ifTrue: [c1] ifFalse: [c2]).
+ self privateAddMorph: space1 atIndex: (i+1 max: 1).
+ space2 := Morph newBounds: (0 at 0 extent: 30 at ht2)
+ color: (ht2 > (insHt//2+1) ifTrue: [c1] ifFalse: [c2]).
+ self privateAddMorph: space2 atIndex: (i+3 min: submorphs size+1)]
+ ifFalse:
+ [self stopSteppingSelector: #trackDropZones.
+ self removeSpaces]!
Item was added:
+ ----- Method: ScriptEditorMorph>>makeIsolatedCodePane (in category 'buttons') -----
+ makeIsolatedCodePane
+ MethodHolder makeIsolatedCodePaneForClass: playerScripted class selector: scriptName!
Item was added:
+ ----- Method: Morph>>adoptVocabulary: (in category '*Etoys-support') -----
+ adoptVocabulary: aVocabulary
+ "Make aVocabulary be the one used by me and my submorphs"
+
+ self submorphsDo: [:m | m adoptVocabulary: aVocabulary]!
Item was added:
+ ----- Method: StickySketchMorph>>isStickySketchMorph (in category 'e-toy support') -----
+ isStickySketchMorph
+ ^true!
Item was added:
+ ----- Method: PasteUpMorph>>viewingBySizeString (in category '*Etoys-viewing') -----
+ viewingBySizeString
+ "Answer a string to show in a menu representing whether the
+ receiver is currently viewing its subparts by size or not"
+ ^ ((self showingListView
+ and: [(self
+ valueOfProperty: #sortOrder
+ ifAbsent: [])
+ == #reportableSize])
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'view by size' translated!
Item was added:
+ ----- Method: EtoysPresenter>>goButtonState: (in category 'stop-step-go buttons') -----
+ goButtonState: newState
+ "Get all go buttons in my scope to show the correct state"
+
+ self allGoButtons do:
+ [:aButton | aButton state: newState]!
Item was added:
+ ----- Method: Viewer>>isViewer (in category 'queries') -----
+ isViewer
+ ^true!
Item was added:
+ ----- Method: WordArray>>primSubArray:and:into: (in category '*Etoys-arithmetic') -----
+ primSubArray: rcvr and: other into: result
+
+ <primitive: 'primitiveSubArrays' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveSubArrays."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) - (other at: i)
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: WordArray>>- (in category '*Etoys-arithmetic') -----
+ - other
+
+ | result |
+ other isNumber ifTrue: [
+ other isFloat ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primSubScalar: self and: other into: result.
+ ] ifFalse: [
+ result := WordArray new: self size.
+ ^ self primSubScalar: self and: other into: result.
+ ].
+ ].
+ (other isMemberOf: WordArray) ifTrue: [
+ result := WordArray new: self size.
+ ^ self primSubArray: self and: other into: result.
+ ].
+ (other isMemberOf: KedamaFloatArray) ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primSubArray: self and: other into: result.
+ ].
+ ^ super - other.
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>replaceRow1 (in category 'buttons') -----
+ replaceRow1
+
+ submorphs first delete. "the button row"
+ self addMorphFront: self buttonRowForEditor. "up to date"
+ !
Item was added:
+ ----- Method: Object>>tileToRefer (in category '*Etoys-viewer') -----
+ tileToRefer
+ "Answer a reference tile that comprises an alias to me"
+
+ ^ TileMorph new setToReferTo: self!
Item was added:
+ ----- Method: EtoysPresenter>>flushPlayerListCache (in category 'playerList') -----
+ flushPlayerListCache
+ playerList := nil!
Item was added:
+ ----- Method: PasteUpMorph>>viewByName (in category '*Etoys-viewing') -----
+ viewByName
+ "Make the receiver show its subparts as a vertical list of lines of information, sorted by object name"
+
+ self imposeListViewSortingBy: #downshiftedNameOfObjectRepresented retrieving: #(nameOfObjectRepresented reportableSize className oopString)!
Item was added:
+ ----- Method: EtoysPresenter>>nascentPartsViewerFor: (in category 'viewer') -----
+ nascentPartsViewerFor: aViewee
+ "Create a new, naked Viewer object for viewing aViewee. Give it a vocabulary if either the viewee insists on one or if the project insists on one."
+
+ | aViewer aVocab |
+ (aViewee isKindOf: KedamaExamplerPlayer) ifTrue: [^ KedamaStandardViewer new].
+ aViewer := StandardViewer new.
+ (aVocab := aViewee vocabularyDemanded)
+ ifNotNil:
+ [aViewer useVocabulary: aVocab]
+ ifNil:
+ [(aVocab := associatedMorph currentVocabularyFor: aViewee) ifNotNil:
+ [aViewer useVocabulary: aVocab]].
+
+ "If the viewee does not *demand* a special kind of Viewer, and if the project has not specified a preferred vocabulary, then the system defaults will kick in later"
+ ^ aViewer!
Item was added:
+ ----- Method: PasteUpMorph>>modernizeBJProject (in category '*eToys-support') -----
+ modernizeBJProject
+ "Prepare a kids' project from the BJ fork of September 2000 -- a once-off thing for converting such projects forward to a modern 3.1a image, in July 2001. Except for the #enableOnlyGlobalFlapsWithIDs: call, this could conceivably be called upon reloading *any* project, just for safety."
+
+ "ActiveWorld modernizeBJProject"
+
+ ScriptEditorMorph allInstancesDo:
+ [:m | m userScriptObject].
+ Flaps enableOnlyGlobalFlapsWithIDs: {'Supplies' translated}.
+ ActiveWorld abandonOldReferenceScheme.
+ ActiveWorld relaunchAllViewers.!
Item was added:
+ ----- Method: EtoysPresenter>>allExtantPlayers (in category 'intialize') -----
+ allExtantPlayers
+ "The initial intent here was to produce a list of Player objects associated with any Morph in the tree beneath the receiver's associatedMorph. whether it is the submorph tree or perhaps off on unseen bookPages. We have for the moment moved away from that initial intent, and in the current version we only deliver up players associated with the submorph tree only. <-- this note dates from 4/21/99
+
+ Call #flushPlayerListCache; to force recomputation."
+
+ | fullList |
+ playerList ifNotNil:
+ [^ playerList].
+
+ fullList := associatedMorph allMorphs select:
+ [:m | m player ~~ nil] thenCollect: [:m | m player].
+ fullList copy do:
+ [:aPlayer |
+ aPlayer class scripts do:
+ [:aScript | aScript isTextuallyCoded ifFalse:
+ [aScript currentScriptEditor ifNotNil: [:ed |
+ | objectsReferredToByTiles |
+ objectsReferredToByTiles := ed allMorphs
+ select:
+ [:aMorph | (aMorph isKindOf: TileMorph) and: [aMorph type == #objRef]]
+ thenCollect:
+ [:aMorph | aMorph actualObject].
+ fullList addAll: objectsReferredToByTiles]]]].
+
+ ^ playerList := (fullList asSet asSortedCollection:
+ [:a :b | a externalName < b externalName]) asArray!
Item was added:
+ ----- Method: EtoysPresenter>>booleanTiles (in category 'tile support') -----
+ booleanTiles
+ "Answer some boolean-valued tiles. This dates back to very early etoy work in 1997, and presently has no sent senders"
+
+ | list |
+ list := #(#(0 #< 1) #(0 #<= 1) #(0 #= 1) #(0 #~= 1) #(0 #> 1) #(0 #>= 1)).
+ list := list asOrderedCollection collect:
+ [:entry |
+ | rcvr op arg |
+ rcvr := entry first.
+ op := (entry second) asSymbol.
+ arg := entry last.
+ self
+ phraseForReceiver: rcvr
+ op: op
+ arg: arg
+ resultType: #Boolean].
+ list add: (self
+ phraseForReceiver: Color red
+ op: #=
+ arg: Color red
+ resultType: #Boolean).
+ ^list "copyWith: CompoundTileMorph new"!
Item was added:
+ ----- Method: EtoysPresenter>>goUp:with: (in category 'stop-step-go buttons') -----
+ goUp: evt with: aMorph
+ self startRunningScripts!
Item was added:
+ ----- Method: ScriptEditorMorph>>handlesMouseOverDragging: (in category 'event handling') -----
+ handlesMouseOverDragging: evt
+
+ ^ true
+ !
Item was added:
+ ----- Method: PasteUpMorph>>fenceEnabledString (in category '*eToys-support') -----
+ fenceEnabledString
+ "Answer the string to be shown in a menu to represent the
+ fence enabled status"
+ ^ (self fenceEnabled
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'fence enabled' translated!
Item was added:
+ ----- Method: PasteUpMorph>>galleryOfPlayers (in category '*Etoys-playfield') -----
+ galleryOfPlayers
+ "Put up a tool showing all the players in the project"
+
+ (ActiveWorld findA: AllPlayersTool) ifNotNil: [:aTool | ^ aTool comeToFront].
+ AllPlayersTool newStandAlone openInHand
+
+ "ActiveWorld galleryOfPlayers"!
Item was changed:
----- Method: TileMorph class>>upPicture (in category 'class initialization') -----
upPicture
+ ^ UpPicture ifNil:[UpPicture := Form
+ extent: 9 at 8
+ depth: 16
+ fromArray: #( 0 0 932001709 0 0 0 14254 793457484 0 0 0 13197 654912266 931987456 0 0 12107 654912266 862715904 0 0 931998474 722020105 724252557 0 0 793455401 724183850 724187021 0 14221 724182761 652879594 652816171 931987456 0 791422634 717892298 648686282 862781440)
+ offset: 0 at 0]!
- ^ UpPicture!
Item was added:
+ ----- Method: EtoysPresenter>>createStandardPlayer (in category 'standardPlayer etc') -----
+ createStandardPlayer
+ | aMorph |
+
+ aMorph := ImageMorph new image: (ScriptingSystem formAtKey: 'standardPlayer').
+ associatedMorph addMorphFront: aMorph.
+ (standardPlayer := aMorph assuredPlayer) renameTo: 'dot' translated.
+ aMorph setBalloonText: '...'.
+ self positionStandardPlayer.
+ ^ standardPlayer!
Item was added:
+ ----- Method: Morph>>wantsConnectionVocabulary (in category '*Etoys-scripting') -----
+ wantsConnectionVocabulary
+ submorphs ifNil: [ ^true ]. "called from EToyVocabulary>>initialize after basicNew"
+
+ ^ (Preferences valueOfFlag: #alwaysShowConnectionVocabulary)
+ or: [ self connections isEmpty not ]!
Item was added:
+ ----- Method: PasteUpMorph>>automaticViewing: (in category '*Etoys-viewing') -----
+ automaticViewing: aBoolean
+ self setProperty: #automaticViewing toValue: aBoolean!
Item was added:
+ SystemOrganization addCategory: #'EToys-Buttons'!
+ SystemOrganization addCategory: #'EToys-CustomEvents'!
+ SystemOrganization addCategory: #'EToys-Experimental'!
+ SystemOrganization addCategory: #'EToys-Outliner'!
+ SystemOrganization addCategory: #'EToys-Protocols'!
+ SystemOrganization addCategory: #'EToys-Protocols-Type Vocabularies'!
+ SystemOrganization addCategory: #'EToys-Scripting'!
+ SystemOrganization addCategory: #'EToys-Scripting Support'!
+ SystemOrganization addCategory: #'EToys-Scripting Tiles'!
+ SystemOrganization addCategory: #'EToys-Stacks'!
+ SystemOrganization addCategory: #'EToys-StarSqueak'!
+ SystemOrganization addCategory: #'EToys-Tile Scriptors'!
+ SystemOrganization addCategory: #'EToys-Widgets'!
+ SystemOrganization addCategory: #'Etoys-Scripting'!
Item was added:
+ ----- Method: PasteUpMorph>>relaunchAllViewers (in category '*eToys-support') -----
+ relaunchAllViewers
+ "Relaunch all the viewers in the project"
+
+
+ (self submorphs select: [:m | m isKindOf: ViewerFlapTab]) do:
+ [:aTab | | aViewer |
+ aViewer := aTab referent submorphs
+ detect: [:sm | sm isStandardViewer]
+ ifNone: [nil].
+ aViewer ifNotNil: [aViewer relaunchViewer]
+ "ActiveWorld relaunchAllViewers"]!
Item was added:
+ ----- Method: PasteUpMorph>>hideAllPlayers (in category '*eToys-world menu') -----
+ hideAllPlayers
+
+ | a |
+ a := OrderedCollection new.
+ self allMorphsDo: [ :x |
+ (x isKindOf: ViewerFlapTab) ifTrue: [a add: x]
+ ].
+ a do: [ :each | each delete].
+ !
Item was added:
+ ----- Method: Morph>>useUniformTileColor (in category '*Etoys-scripting') -----
+ useUniformTileColor
+ self player ifNotNil:
+ [self player allScriptEditors do:
+ [:anEditor | anEditor allMorphsDo:
+ [:m | m useUniformTileColor]]]!
Item was added:
+ ----- Method: EtoysPresenter>>world (in category 'access') -----
+ world
+ ^ associatedMorph world!
Item was added:
+ ----- Method: ScriptEditorMorph>>willingToBeDiscarded (in category 'dropping/grabbing') -----
+ willingToBeDiscarded
+ "Resist the drag-into-trash gesture"
+
+ ^ false!
Item was added:
+ ----- Method: EtoysPresenter>>toolToViewScriptInstantiations (in category 'playerList') -----
+ toolToViewScriptInstantiations
+ "Open a tool which shows, and allows the user to change the status of, all the instantiations of all the user-written scripts in the world"
+
+ AllScriptsTool launchAllScriptsToolFor: self
+
+ "self currentWorld presenter toolToViewScriptInstantiations"!
Item was added:
+ ----- Method: ScriptEditorMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ ^ 1!
Item was added:
+ ----- Method: EtoysPresenter>>drawingJustCompleted: (in category 'misc') -----
+ drawingJustCompleted: aSketchMorph
+ "The user just finished drawing. Now maybe put up a viewer"
+
+ | aWorld |
+ self flushPlayerListCache. "Because a new drawing already created one, thus obviating #assuredPlayer kicking in with its invalidation"
+
+ aWorld := associatedMorph world.
+ (aWorld hasProperty: #automaticFlapViewing)
+ ifTrue:
+ [^ aWorld presenter viewMorph: aSketchMorph].
+
+ (aSketchMorph pasteUpMorph hasProperty: #automaticViewing)
+ ifTrue:
+ [self viewMorph: aSketchMorph]!
Item was added:
+ ----- Method: ScriptEditorMorph>>fixLayoutOfSubmorphsNotIn: (in category 'menu') -----
+ fixLayoutOfSubmorphsNotIn: aCollection
+ self
+ allMorphsDo: [:m | (aCollection includes: m)
+ ifFalse: [m ~~ self
+ ifTrue: [(m respondsTo: #fixLayoutOfSubmorphsNotIn:)
+ ifTrue: [m fixLayoutOfSubmorphsNotIn: aCollection]].
+ m layoutChanged.
+ aCollection add: m]]!
Item was added:
+ ----- Method: Morph>>isPlayer:ofReferencingTile: (in category '*Etoys') -----
+ isPlayer: aPlayer ofReferencingTile: tile
+ "Answer whether the given player is the object referred to by the given tile, or a sibling of that object. This theoretically is only sent to PhraseTileMorphs, so this version is theoretically never reached"
+
+ ^ false!
Item was added:
+ ----- Method: Morph>>definePath (in category '*Etoys-support') -----
+ definePath
+ | points lastPoint aForm offset currentPoint dwell ownerPosition |
+ points := OrderedCollection new: 70.
+ lastPoint := nil.
+ aForm := self imageForm.
+ offset := aForm extent // 2.
+ ownerPosition := owner position.
+ Cursor move show.
+ Sensor waitButton.
+ [Sensor anyButtonPressed and: [points size < 100]] whileTrue:
+ [currentPoint := Sensor cursorPoint.
+ dwell := 0.
+ currentPoint = lastPoint
+ ifTrue:
+ [dwell := dwell + 1.
+ ((dwell \\ 1000) = 0) ifTrue:
+ [Beeper beep]]
+ ifFalse:
+ [self position: (currentPoint - offset).
+ self world displayWorld.
+ (Delay forMilliseconds: 20) wait.
+ points add: currentPoint.
+ lastPoint := currentPoint]].
+ points size > 1
+ ifFalse:
+ [self inform: 'no path obtained']
+ ifTrue:
+ [points size = 100 ifTrue: [self playSoundNamed: 'croak'].
+
+ Transcript cr; show: 'path defined with
+ ', points size printString, ' points'.
+ self renderedMorph setProperty: #pathPoints toValue:
+ (points collect: [:p | p - ownerPosition])].
+
+ Cursor normal show
+ !
Item was added:
+ ----- Method: EtoysPresenter>>standardPalette: (in category 'palette & parts bin') -----
+ standardPalette: aPalette
+ standardPalette := aPalette!
Item was added:
+ ----- Method: Morph>>putOnForeground (in category '*Etoys') -----
+ putOnForeground
+ "Place the receiver, formerly on the background, onto the foreground. If the receiver needs data carried on its behalf by the card, those data will be lost, so in this case get user confirmation before proceeding."
+
+ self holdsSeparateDataForEachInstance "later add the refinement of not putting up the following confirmer if only a single instance of the current background's uniclass exists"
+ ifTrue:
+ [self confirm: 'Caution -- every card of this background
+ formerly had its own value for this
+ item. If you put it on the foreground,
+ the values of this item on all other
+ cards will be lost' translated
+ orCancel: [^ self]].
+
+ self removeProperty: #shared.
+ self stack reassessBackgroundShape.
+ "still work to be done here!!"!
Item was added:
+ ----- Method: PasteUpMorph>>viewingByIconString (in category '*Etoys-viewing') -----
+ viewingByIconString
+ "Answer a string to show in a menu representing whether the
+ receiver is currently viewing its subparts by icon or not"
+ ^ ((self showingListView
+ or: [self autoLineLayout == true])
+ ifTrue: ['<no>']
+ ifFalse: ['<yes>']), 'view by icon' translated!
Item was added:
+ ----- Method: ScriptEditorMorph>>addDismissButtonTo: (in category 'buttons') -----
+ addDismissButtonTo: aRowMorph
+ "Add the brown dismiss button to the header"
+
+ | aButton |
+ aButton := self tanOButton.
+ aRowMorph addMorphBack: aButton.
+ aButton actionSelector: #dismiss;
+ setBalloonText:
+ 'Remove this script
+ from the screen
+ (you can open it
+ again from a Viewer)' translated.
+ ^ aRowMorph!
Item was added:
+ ----- Method: Morph>>isStackBackground (in category '*Etoys-card in a stack') -----
+ isStackBackground
+ "Answer whether the receiver serves as a background of a stack"
+
+ ^ ((owner isKindOf: StackMorph) and: [owner currentPage == self]) or:
+ [self hasProperty: #stackBackground]
+
+ "This odd property-based check is because when a paste-up-morph is not the *current* background of a stack, it is maddeningly ownerlyess"!
Item was added:
+ ----- Method: ScriptEditorMorph>>recreateScript (in category 'other') -----
+ recreateScript
+ | aUserScript |
+ aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
+ aUserScript recreateScriptFrom: self!
Item was added:
+ ----- Method: EtoysPresenter class>>unload (in category 'class initialization') -----
+ unload
+ Presenter defaultPresenterClass: nil.
+ PasteUpMorph allInstancesDo:[:p| p dumpPresenter].
+ !
Item was added:
+ ----- Method: Object>>defaultLimitClassForVocabulary: (in category '*Etoys-viewer') -----
+ defaultLimitClassForVocabulary: aVocabulary
+ "Answer the class to use, by default, as the limit class on a protocol browser or viewer opened up on the receiver, within the purview of the Vocabulary provided"
+
+ ^ (aVocabulary isKindOf: FullVocabulary)
+ ifTrue:
+ [self class superclass == Object
+ ifTrue:
+ [self class]
+ ifFalse:
+ [self class superclass]]
+ ifFalse:
+ [ProtoObject]!
Item was added:
+ ----- Method: Morph>>tanOButton (in category '*Etoys-support') -----
+ tanOButton
+ "Answer a button with the old O on a tan background, targeted to self"
+
+ | aButton |
+ aButton := IconicButton new labelGraphic: (ScriptingSystem formAtKey: #TanO).
+ aButton color: Color transparent; borderWidth: 0; shedSelvedge; actWhen: #buttonUp.
+ aButton target: self.
+ ^ aButton!
Item was added:
+ ----- Method: ScriptEditorMorph>>renameScript (in category 'other') -----
+ renameScript
+ "Rename the current script. Invoked at user menu request"
+
+ playerScripted renameScript: self scriptName!
Item was added:
+ ----- Method: EtoysPresenter>>allGoButtons (in category 'stop-step-go buttons') -----
+ allGoButtons
+ "Answer a list of all script-controlling Go buttons within my scope"
+
+ ^ associatedMorph allMorphs select:
+ [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
+ [aMorph actionSelector == #goUp:with:]]
+
+ "ActiveWorld presenter allGoButtons"!
Item was added:
+ ----- Method: PasteUpMorph>>presentViewMenu (in category '*Etoys-viewing') -----
+ presentViewMenu
+ "Answer an auxiliary menu with options specific to viewing playfields -- this is put up from the provisional 'view' halo handle, on pasteup morphs only."
+
+ | aMenu isWorld |
+ isWorld := self isWorldMorph.
+ aMenu := MenuMorph new defaultTarget: self.
+ aMenu addStayUpItem.
+ self addViewingItemsTo: aMenu.
+
+ #( "(autoLineLayoutString toggleAutoLineLayout
+ 'whether submorphs should automatically be laid out in lines')"
+ (indicateCursorString toggleIndicateCursor
+ 'whether the "current" submorph should be indicated with a dark black border')
+ (resizeToFitString toggleResizeToFit
+ 'whether I should automatically strive exactly to fit my contents')
+ (behaveLikeAHolderString toggleBehaveLikeAHolder
+ 'whether auto-line-layout, resize-to-fit, and indicate-cursor should be set to true; useful for animation control, etc.')
+ (isPartsBinString toggleIsPartsBin
+ 'whether dragging an object from the interior should produce a COPY of the object')
+ (isOpenForDragNDropString toggleDragNDrop
+ 'whether objects can be dropped into and dragged out of me')
+ (mouseOverHalosString toggleMouseOverHalos
+ 'whether objects should put up halos when the mouse is over them')
+ (autoExpansionString toggleAutomaticPhraseExpansion
+ 'whether tile phrases, dropped on me, should automatically sprout Scriptors around them')
+ (originAtCenterString toggleOriginAtCenter
+ 'whether the cartesian origin of the playfield should be at its lower-left corner or at the center of the playfield')
+ (showThumbnailString toggleAlwaysShowThumbnail
+ 'whether large objects should be represented by thumbnail miniatures of themselves')
+ (fenceEnabledString toggleFenceEnabled
+ 'whether moving objects should stop at the edge of their container')
+ (autoViewingString toggleAutomaticViewing
+ 'governs whether, when an object is touched inside me, a viewer should automatically be launched for it.')
+ (griddingString griddingOnOff
+ 'whether gridding should be used in my interior')
+ (gridVisibleString gridVisibleOnOff
+ 'whether the grid should be shown when gridding is on')
+
+
+ ) do:
+
+ [:triplet |
+ (isWorld and: [#(toggleAutoLineLayout toggleIndicateCursor toggleIsPartsBin toggleAlwaysShowThumbnail toggleAutomaticViewing ) includes: triplet second]) ifFalse:
+ [aMenu addUpdating: triplet first action: triplet second.
+ aMenu balloonTextForLastItem: triplet third translated]].
+
+ aMenu addLine.
+ aMenu add: 'round up strays' translated action: #roundUpStrays.
+ aMenu balloonTextForLastItem: 'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.' translated.
+ aMenu add: 'shuffle contents' translated action: #shuffleSubmorphs.
+ aMenu balloonTextForLastItem: 'Rearranges my contents in random order' translated.
+ aMenu add: 'set grid spacing...' translated action: #setGridSpec.
+ aMenu balloonTextForLastItem: 'Set the spacing to be used when gridding is on' translated.
+
+ isWorld ifFalse:
+ [aMenu add: 'set thumbnail height...' translated action: #setThumbnailHeight.
+ aMenu balloonTextForLastItem: 'if currently showing thumbnails governs the standard height for them' translated].
+
+ self backgroundSketch ifNotNil:
+ [aMenu add: 'delete background painting' translated action: #deleteBackgroundPainting.
+ aMenu balloonTextForLastItem: 'delete the graphic that forms the background for this me.' translated].
+ aMenu addLine.
+ self addPenTrailsMenuItemsTo: aMenu.
+ aMenu addLine.
+ aMenu add: 'use standard texture' translated action: #setStandardTexture.
+ aMenu balloonTextForLastItem: 'use a pale yellow-and-blue background texture here.' translated.
+ aMenu add: 'make graph paper...' translated action: #makeGraphPaper.
+ aMenu balloonTextForLastItem: 'Design your own graph paper and use it as the background texture here.' translated.
+ aMenu addTitle: ('viewing options for "{1}"' translated format: {self externalName}).
+
+ aMenu popUpForHand: self activeHand in: self world
+ !
Item was added:
+ ----- Method: Object>>elementTypeFor:vocabulary: (in category '*Etoys-viewer') -----
+ elementTypeFor: aStringOrSymbol vocabulary: aVocabulary
+ "Answer a symbol characterizing what kind of element aStringOrSymbol represents. Realistically, at present, this always just returns #systemScript; a prototyped but not-incorporated architecture supported use of a leading colon to characterize an inst var of a system class, and for the moment we still see its remnant here."
+
+ self flag: #deferred. "a loose end in the non-player case"
+ ^ #systemScript!
Item was added:
+ ----- Method: Morph>>buttonProperties (in category '*Etoys-support') -----
+ buttonProperties
+
+ ^self valueOfProperty: #universalButtonProperties!
Item was added:
+ ----- Method: Morph>>pinkXButton (in category '*Etoys-support') -----
+ pinkXButton
+ "Answer a button with the old X on a pink background, targeted to self"
+
+ | aButton |
+ aButton := IconicButton new labelGraphic: (ScriptingSystem formAtKey: #PinkX).
+ aButton color: Color transparent; borderWidth: 0; shedSelvedge; actWhen: #buttonUp.
+ aButton target: self.
+ ^ aButton!
Item was added:
+ ----- Method: ScriptEditorMorph>>releaseCachedState (in category 'caching') -----
+ releaseCachedState
+ "Release any state that could be recomputed"
+
+ super releaseCachedState.
+ handWithTile := nil.
+ self hibernate!
Item was added:
+ ----- Method: Morph class>>noteAddedSelector:meta: (in category '*Etoys') -----
+ noteAddedSelector: aSelector meta: isMeta
+ "Any change to an additionsToViewer... method can invalidate existing etoy vocabularies.
+ The #respondsTo: test is to allow loading the FlexibleVocabularies change set without having to worry about method ordering."
+ [(isMeta
+ and: [(aSelector beginsWith: 'additionsToViewer')
+ and: [self respondsTo: #hasAdditionsToViewerCategories]])
+ ifTrue: [Vocabulary changeMadeToViewerAdditions]] on: Error do:[].
+ super noteCompilationOf: aSelector meta: isMeta!
Item was added:
+ ----- Method: Morph>>reshapeBackground (in category '*Etoys-card in a stack') -----
+ reshapeBackground
+ "Abandon any memory of variable-name preferences, and reassess the shape of the background"
+
+ self relaxGripOnVariableNames.
+ "self reassessBackgroundShape. already done there"!
Item was added:
+ ----- Method: Object>>tilePhrasesForCategory:inViewer: (in category '*Etoys-viewer') -----
+ tilePhrasesForCategory: aCategorySymbol inViewer: aViewer
+ "Return a collection of phrases for the category."
+
+ | interfaces |
+ interfaces := self methodInterfacesForCategory: aCategorySymbol inVocabulary: aViewer currentVocabulary limitClass: aViewer limitClass.
+ interfaces := self methodInterfacesInPresentationOrderFrom: interfaces forCategory: aCategorySymbol.
+ ^ self tilePhrasesForMethodInterfaces: interfaces inViewer: aViewer!
Item was added:
+ ----- Method: ScriptEditorMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ ScriptingSystem colorBehindTiles!
Item was added:
+ ----- Method: PasteUpMorph>>currentVocabularyFor: (in category '*eToys-support') -----
+ currentVocabularyFor: aScriptableObject
+ "Answer the Vocabulary object to be applied when scripting an object in the world."
+
+ | vocabSymbol vocab aPointVocab |
+ vocabSymbol := self valueOfProperty: #currentVocabularySymbol
+ ifAbsent: [nil].
+ vocabSymbol ifNil:
+ [vocab := self valueOfProperty: #currentVocabulary ifAbsent: [nil].
+ vocab ifNotNil:
+ [vocabSymbol := vocab vocabularyName.
+ self removeProperty: #currentVocabulary.
+ self setProperty: #currentVocabularySymbol toValue: vocabSymbol]].
+ vocabSymbol ifNotNil: [^Vocabulary vocabularyNamed: vocabSymbol]
+ ifNil:
+ [(aScriptableObject isPlayerLike) ifTrue: [^Vocabulary eToyVocabulary].
+ (aScriptableObject isNumber)
+ ifTrue: [^Vocabulary numberVocabulary].
+ (aScriptableObject isKindOf: Time)
+ ifTrue: [^Vocabulary vocabularyForClass: Time].
+ (aScriptableObject isString)
+ ifTrue: [^Vocabulary vocabularyForClass: String].
+ (aScriptableObject isPoint)
+ ifTrue:
+ [(aPointVocab := Vocabulary vocabularyForClass: Point)
+ ifNotNil: [^aPointVocab]].
+ (aScriptableObject isKindOf: Date)
+ ifTrue: [^Vocabulary vocabularyForClass: Date].
+ "OrderedCollection and Holder??"
+ ^Vocabulary fullVocabulary]!
Item was added:
+ ----- Method: EtoysPresenter>>updateViewer:forceToShow: (in category 'viewer') -----
+ 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 itsVocabulary aCategory categoryInfo restrictedIndex |
+ aCategory := aCategorySymbol ifNotNil: [aViewer currentVocabulary translatedWordingFor: aCategorySymbol].
+ categoryInfo := aViewer categoryMorphs asOrderedCollection collect:
+ [:aMorph | aMorph categoryRestorationInfo].
+
+ itsVocabulary := aViewer currentVocabulary.
+ aCategory ifNotNil: [(categoryInfo includes: aCategorySymbol) ifFalse: [categoryInfo addFirst: aCategorySymbol]].
+ aPlayer := aViewer scriptedPlayer.
+ aPosition := aViewer position.
+ wasSticky := aViewer isSticky.
+ newViewer := aViewer species new visible: false.
+ (aViewer isMemberOf: KedamaStandardViewer)
+ ifTrue: [restrictedIndex := aViewer restrictedIndex].
+ 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 limitClass: aViewer limitClass.
+ newViewer initializeFor: aPlayer barHeight: barHeight includeDismissButton: aViewer hasDismissButton showCategories: categoryInfo.
+ (newViewer isMemberOf: KedamaStandardViewer)
+ ifTrue: [
+ newViewer providePossibleRestrictedView: 0.
+ newViewer providePossibleRestrictedView: restrictedIndex].
+ 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 ifNotNil: [:aWorld | aWorld startSteppingSubmorphsOf: newViewer].
+ newViewer layoutChanged!
Item was added:
+ ----- Method: EtoysPresenter>>allKnownUnaryScriptSelectors (in category 'playerList') -----
+ allKnownUnaryScriptSelectors
+ "Answer a list of all the unary selectors implemented by any user-scripted objected within the scope of the receiver; include #emptyScript as a bail-out"
+
+ | aSet allUniclasses |
+ aSet := Set with: #emptyScript.
+ allUniclasses := (self allPlayersWithUniclasses collect:
+ [:aPlayer | aPlayer class]) asSet.
+ allUniclasses do:
+ [:aUniclass | aSet addAll: aUniclass namedUnaryTileScriptSelectors].
+ ^ aSet asSortedArray
+
+ "ActiveWorld presenter allKnownUnaryScriptSelectors"
+ !
Item was added:
+ ----- 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.
+ {Utilities getterSelectorFor: aSlotName. Utilities setterSelectorFor: aSlotName} do:
+ [:searchee |
+ (stringToSearch findString: searchee startingAt: 1) = 0
+ ifFalse:
+ [^ true]].
+
+ ^ false!
Item was added:
+ ----- Method: PasteUpMorph>>backgroundSketch (in category '*Etoys-playfield') -----
+ backgroundSketch
+
+ backgroundMorph ifNil: [^ nil].
+ backgroundMorph owner == self ifFalse:
+ [backgroundMorph := nil]. "has been deleted"
+ ^ backgroundMorph!
Item was added:
+ ----- Method: EtoysPresenter>>allStepButtons (in category 'stop-step-go buttons') -----
+ allStepButtons
+ "Answer a list of all the script-controlling Step buttons within my scope"
+
+ ^ associatedMorph allMorphs select:
+ [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
+ [aMorph actionSelector == #stepStillDown:with:]]
+
+ "ActiveWorld presenter allStepButtons"!
Item was added:
+ ----- Method: ScriptEditorMorph>>storeCodeOn:indent: (in category 'other') -----
+ storeCodeOn: aStream indent: tabCount
+ | lastOwner |
+ lastOwner := nil.
+ self tileRows do:
+ [:r |
+ r do:
+ [:m |
+ ((m isTileMorph)
+ or: [(m isCompoundTileMorph) or: [m isPhraseTileMorph]])
+ ifTrue:
+ [tabCount timesRepeat: [aStream tab].
+ (m owner ~= lastOwner and: [lastOwner ~= nil])
+ ifTrue:
+ [aStream
+ nextPut: $.;
+ cr;
+ tab.
+ ]
+ ifFalse:
+ [lastOwner ~= nil ifTrue: [aStream space].
+ ].
+ m storeCodeOn: aStream indent: tabCount.
+ lastOwner := m owner]]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>extent: (in category 'other') -----
+ extent: x
+
+ | newExtent tw menu |
+ newExtent := x max: self minWidth at self minHeight.
+ (tw := self findA: TwoWayScrollPane) ifNil:
+ ["This was the old behavior"
+ ^ super extent: newExtent].
+
+ (self hasProperty: #autoFitContents) ifTrue: [
+ menu := MenuMorph new defaultTarget: self.
+ menu addUpdating: #autoFitString target: self action: #autoFitOnOff.
+ menu addTitle: 'To resize the script, uncheck the box below' translated.
+ menu popUpEvent: nil in: self world .
+ ^ self].
+
+ "Allow the user to resize to any size"
+ tw extent: ((newExtent x max: self firstSubmorph width)
+ @ (newExtent y - self firstSubmorph height)) - (borderWidth*2) + (-4 at -4). "inset?"
+ ^ super extent: newExtent!
Item was added:
+ ----- Method: ScriptEditorMorph>>mouseEnterDragging: (in category 'event handling') -----
+ mouseEnterDragging: evt
+ "Test button state elsewhere if at all"
+ ^ self mouseEnter: evt!
Item was added:
+ ----- Method: ScriptEditorMorph>>autoFitOnOff (in category 'menu') -----
+ autoFitOnOff
+ "Toggle between auto fit to size of code and manual resize with scrolling"
+ | tw |
+ (tw := self findA: TwoWayScrollPane) ifNil: [^ self].
+ (self hasProperty: #autoFitContents)
+ ifTrue: [self removeProperty: #autoFitContents.
+ self hResizing: #rigid; vResizing: #rigid]
+ ifFalse: [self setProperty: #autoFitContents toValue: true.
+ self hResizing: #shrinkWrap; vResizing: #shrinkWrap].
+ tw layoutChanged!
Item was added:
+ ----- Method: ScriptEditorMorph>>tryMe (in category 'buttons') -----
+ tryMe
+ "Evaluate the given script on behalf of the scripted object"
+
+ scriptName numArgs = 0
+ ifTrue:
+ [self playerScripted performScriptIfCan: scriptName ]
+
+ !
Item was added:
+ ----- Method: PasteUpMorph>>attemptCleanupReporting: (in category '*eToys-world menu') -----
+ attemptCleanupReporting: whetherToReport
+ "Try to fix up some bad things that are known to occur in some etoy projects we've seen. If the whetherToReport parameter is true, an informer is presented after the cleanups"
+
+ | fixes |
+ fixes := 0.
+ ActiveWorld ifNotNil:
+ [(ActiveWorld submorphs select:
+ [:m | (m isKindOf: ScriptEditorMorph) and: [m submorphs isEmpty]]) do:
+ [:m | m delete. fixes := fixes + 1]].
+
+ TransformationMorph allSubInstancesDo:
+ [:m | (m player notNil and: [m renderedMorph ~~ m])
+ ifTrue:
+ [m renderedMorph visible ifFalse:
+ [m renderedMorph visible: true. fixes := fixes + 1]]].
+
+ (Player class allSubInstances select: [:cl | cl isUniClass]) do:
+ [:aUniclass |
+ fixes := fixes + aUniclass cleanseScripts].
+
+ self presenter flushPlayerListCache; allExtantPlayers.
+ whetherToReport ifTrue:
+ [self inform: ('{1} [or more] repair(s) made' translated format: {fixes printString})]
+
+ "
+ ActiveWorld attemptCleanupReporting: true.
+ ActiveWorld attemptCleanupReporting: false.
+ "!
Item was added:
+ ----- Method: PasteUpMorph>>noteNewLocation:forPlayer: (in category '*Etoys-pen') -----
+ noteNewLocation: location forPlayer: player
+ "Note that a morph has just moved with its pen down, begining at startPoint.
+ Only used in conjunction with Preferences batchPenTrails."
+
+ lastTurtlePositions ifNil: [lastTurtlePositions := IdentityDictionary new].
+ lastTurtlePositions at: player put: location!
Item was added:
+ ----- Method: Object>>hasUserDefinedSlots (in category '*Etoys-viewer') -----
+ hasUserDefinedSlots
+ "Answer whether the receiver has any user-defined slots, in the omniuser sense of the term. This is needed to allow Viewers to look at any object, not just at Players."
+
+ ^ false!
Item was added:
+ ----- Method: PasteUpMorph>>createOrResizeTrailsForm (in category '*Etoys-pen') -----
+ createOrResizeTrailsForm
+ "If necessary, create a new turtleTrailsForm or resize the existing one to fill my bounds.
+ On return, turtleTrailsForm exists and is the correct size.
+ Use the Display depth so that color comparisons (#color:sees: and #touchesColor:) will work right."
+
+ | newForm |
+ (turtleTrailsForm isNil or: [ turtleTrailsForm extent ~= self extent ]) ifTrue:
+ ["resize TrailsForm if my size has changed"
+ newForm := Form extent: self extent depth: Display depth.
+ turtleTrailsForm ifNotNil: [
+ newForm copy: self bounds from: turtleTrailsForm
+ to: 0 at 0 rule: Form paint ].
+ turtleTrailsForm := newForm.
+ turtlePen := nil].
+
+ "Recreate Pen for this form"
+ turtlePen ifNil: [turtlePen := Pen newOnForm: turtleTrailsForm].!
Item was added:
+ ----- Method: PasteUpMorph>>dotsForAllPens (in category '*Etoys-pen') -----
+ dotsForAllPens
+ "Set the trail style for all my objects to show dots"
+
+ self trailStyleForAllPens: #dots!
Item was added:
+ ----- Method: ScriptEditorMorph>>handUserButtonDownTile (in category 'other') -----
+ handUserButtonDownTile
+ "Hand the user a button-down tile, presumably to drop in the script"
+
+
+ self currentHand attachMorph:
+ (self presenter systemQueryPhraseWithActionString: '(Sensor anyButtonPressed)' labelled: 'button down?' translated)
+ !
Item was added:
+ ----- Method: TileMorph>>isTileMorph (in category 'e-toy support') -----
+ isTileMorph
+ ^true!
Item was added:
+ ----- Method: ScriptEditorMorph>>setMorph:scriptName: (in category 'initialization') -----
+ setMorph: anActorMorph scriptName: aString
+ "Create a script editor for editing a named script."
+
+ self setMorph: anActorMorph.
+ scriptName := aString.
+ self addMorphFront: self buttonRowForEditor.
+ self updateStatus.
+ firstTileRow := 2
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>fixUponLoad:seg: (in category 'objects from disk') -----
+ fixUponLoad: aProject seg: anImageSegment
+ "We are in an old project that is being loaded from disk.
+ Fix up conventions that have changed."
+
+ (aProject projectParameters at: #substitutedFont ifAbsent: [#none])
+ ~~ #none ifTrue: [ self setProperty:
+ #needsLayoutFixed toValue: true ].
+
+ ^ super fixUponLoad: aProject seg: anImageSegment!
Item was added:
+ ----- Method: ScriptEditorMorph>>printOn: (in category 'access') -----
+ printOn: aStream
+ ^ aStream nextPutAll: 'ScriptEditor for #', scriptName asString, ' player: ', playerScripted externalName!
Item was added:
+ ----- Method: ScriptEditorMorph>>replaceReferencesToSlot:inPlayer:with: (in category 'e-toy support') -----
+ replaceReferencesToSlot: oldSlotName inPlayer: aPlayer with: newSlotName
+ "An instance variable has been renamed in a player; replace all references to the old instance variable of that player such that they become references to the new slot"
+
+ self tileRows do: [:row |
+ row do: [:c | c traverseRowTranslateSlotOld: oldSlotName of: aPlayer to: newSlotName]].
+ self install.
+ self fixLayout!
Item was added:
+ ----- Method: Object>>offerViewerMenuForEvt:morph: (in category '*Etoys-viewer') -----
+ offerViewerMenuForEvt: anEvent morph: aMorph
+ "Offer the viewer's primary menu to the user. aMorph is some morph within the viewer itself, the one within which a mousedown triggered the need for this menu, and it is used only to retrieve the Viewer itself"
+
+ self offerViewerMenuFor: (aMorph ownerThatIsA: StandardViewer) event: anEvent!
Item was added:
+ ----- Method: EtoysPresenter>>allKnownScriptSelectors (in category 'playerList') -----
+ allKnownScriptSelectors
+ "Answer a list of all the selectors implemented by any user-scripted objected within the scope of the receiver"
+
+ | aSet allUniclasses |
+ aSet := Set with: ('script' translated , '1') asSymbol.
+ allUniclasses := (self presenter allPlayersWithUniclasses collect:
+ [:aPlayer | aPlayer class]) asSet.
+ allUniclasses do:
+ [:aUniclass | aSet addAll: aUniclass namedTileScriptSelectors].
+ ^ aSet asSortedArray
+
+ "ActiveWorld presenter allKnownScriptSelectors"
+ !
Item was added:
+ ----- Method: MorphicProject>>currentStack (in category '*Etoys-stack') -----
+ currentStack
+ "Answer the current stack of the current project. Called basically as a bail-out when we can't find the stack in the owner chain of a morph, probably because it is on a background that is not currently installed. This method will always return a stack that is in the world, or nil if no stack is found in the world. Of course it would be nice to have multiple stacks concurrently open in the same world, but at the moment that is problematical."
+
+ | aStack curStack |
+
+ curStack := self projectParameterAt: #CurrentStack.
+ curStack ifNotNil: [curStack isInWorld ifTrue: [^ curStack]].
+
+ (aStack := world findA: StackMorph) ifNotNil:
+ [self currentStack: aStack].
+ ^ aStack!
Item was added:
+ ----- Method: ScriptEditorMorph>>timeStamp (in category 'other') -----
+ timeStamp
+ ^ timeStamp!
Item was added:
+ ----- Method: SoundTile>>isSoundTile (in category 'accessing') -----
+ isSoundTile
+ ^true!
Item was added:
+ ----- Method: WordArray>>+ (in category '*Etoys-arithmetic') -----
+ + other
+
+ | result |
+ other isNumber ifTrue: [
+ other isFloat ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primAddScalar: self and: other into: result.
+ ] ifFalse: [
+ result := WordArray new: self size.
+ ^ self primAddScalar: self and: other into: result.
+ ].
+ ].
+ (other isMemberOf: WordArray) ifTrue: [
+ result := WordArray new: self size.
+ ^ self primAddArray: self and: other into: result.
+ ].
+ (other isMemberOf: KedamaFloatArray) ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primAddArray: self and: other into: result.
+ ].
+ ^ super + other.
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>addYesNoToHand (in category 'buttons') -----
+ addYesNoToHand
+ "Place a test/yes/no complex in the hand of the beloved user"
+
+ | ms messageNodeMorph aMorph |
+ Preferences universalTiles
+ ifTrue:
+ [ms := MessageSend receiver: true selector: #ifTrue:ifFalse:
+ arguments: {['do nothing']. ['do nothing']}.
+ messageNodeMorph := ms asTilesIn: playerScripted class globalNames: true.
+ self primaryHand attachMorph: messageNodeMorph]
+ ifFalse:
+ [aMorph := CompoundTileMorph new.
+ ActiveHand attachMorph: aMorph.
+ aMorph setNamePropertyTo: 'TestTile' translated.
+ aMorph position: ActiveHand position.
+ aMorph formerPosition: ActiveHand position.
+ self startSteppingSelector: #trackDropZones.]!
Item was added:
+ ----- Method: PasteUpMorph>>attemptCleanup (in category '*eToys-world menu') -----
+ attemptCleanup
+ "Try to fix up some bad things that are known to occur in some etoy projects we've seen. This is a bare beginning, but a useful place to tack on further cleanups, which then can be invoked whenever the attempt-cleanup item invoked from the debug menu"
+
+ self attemptCleanupReporting: true
+
+ "
+ ActiveWorld attemptCleanup
+ "!
Item was added:
+ ----- Method: Morph>>categoriesForViewer (in category '*Etoys') -----
+ categoriesForViewer
+ "Answer a list of symbols representing the categories to offer in the
+ viewer, in order"
+ | dict |
+ dict := Dictionary new.
+ self unfilteredCategoriesForViewer
+ withIndexDo: [:cat :index | dict at: cat put: index].
+ self filterViewerCategoryDictionary: dict.
+ ^ dict keys asArray sort: [:a :b | (dict at: a)
+ < (dict at: b)]!
Item was added:
+ ----- Method: Morph class>>allAdditionsToViewerCategories (in category '*Etoys') -----
+ allAdditionsToViewerCategories
+ "Answer a Dictionary of (<categoryName> <list of category specs>) that
+ defines the phrases this kind of morph wishes to add to various Viewer categories.
+
+ This version allows each category definition to be defined in one or more separate methods.
+
+ Subclasses that have additions can either:
+ - override #additionsToViewerCategories, or
+ - (preferably) define one or more additionToViewerCategory* methods.
+
+ The advantage of the latter technique is that class extensions may be added by
+ external packages without having to re-define additionsToViewerCategories."
+
+ "
+ Morph allAdditionsToViewerCategories
+ "
+ | dict |
+ dict := IdentityDictionary new.
+ (self class includesSelector: #additionsToViewerCategories)
+ ifTrue: [self additionsToViewerCategories
+ do: [:group | group
+ pairsDo: [:key :list | (dict
+ at: key
+ ifAbsentPut: [OrderedCollection new])
+ addAll: list]]].
+ self class selectorsDo:
+ [:aSelector | ((aSelector beginsWith: 'additionsToViewerCategory')
+ and: [(aSelector at: 26 ifAbsent: []) ~= $:])
+ ifTrue: [(self perform: aSelector)
+ pairsDo: [:key :list | (dict
+ at: key
+ ifAbsentPut: [OrderedCollection new])
+ addAll: list]]].
+ ^ dict!
Item was added:
+ ----- Method: Morph>>currentDataValue (in category '*Etoys-card in a stack') -----
+ currentDataValue
+ "Answer the data value associated with the receiver. Useful in conjunction with default-value setting"
+
+ ^ nil!
Item was added:
+ ----- Method: Object>>uniqueNameForReferenceOrNil (in category '*Etoys-viewer') -----
+ uniqueNameForReferenceOrNil
+ "If the receiver has a unique name for reference, return it here, else return nil"
+
+ ^ References keyAtValue: self ifAbsent: [nil]!
Item was added:
+ ----- Method: EtoysPresenter>>reinvigorateAllScriptsTool: (in category 'playerList') -----
+ reinvigorateAllScriptsTool: anAllScriptsTool
+ "Rebuild the contents of an All Scripts tool"
+
+ | showingOnlyActiveScripts candidateList firstTwo oldList allExtantPlayers newList morphList |
+ showingOnlyActiveScripts := anAllScriptsTool showingOnlyActiveScripts.
+ self flushPlayerListCache.
+ "needed? Probably to pick up on programmatical script-status control only"
+
+ firstTwo := {anAllScriptsTool submorphs first. anAllScriptsTool submorphs second}.
+ oldList := (anAllScriptsTool submorphs copyFrom: 3 to: anAllScriptsTool submorphs size) collect:
+ [:aRow |
+ (aRow findA: UpdatingSimpleButtonMorph) target].
+
+ allExtantPlayers := self allExtantPlayers.
+ anAllScriptsTool showingAllInstances "take all instances of all classes"
+ ifTrue:
+ [candidateList := allExtantPlayers]
+
+ ifFalse: "include only one exemplar per uniclass. Try to get one that has some qualifying scripts"
+ [candidateList := Set new.
+ allExtantPlayers do:
+ [:aPlayer |
+ (candidateList detect: [:plyr | plyr isMemberOf: aPlayer class] ifNone: [nil]) ifNil:
+ [aPlayer instantiatedUserScriptsDo: [:aScriptInstantiation |
+ (showingOnlyActiveScripts not or: [aScriptInstantiation pausedOrTicking]) ifTrue:
+ [candidateList add: aPlayer]]]]].
+ newList := OrderedCollection new.
+ candidateList do:
+ [:aPlayer | aPlayer instantiatedUserScriptsDo:
+ [:aScriptInstantiation |
+ (showingOnlyActiveScripts not or: [aScriptInstantiation pausedOrTicking]) ifTrue:
+ [newList add: aScriptInstantiation]]].
+
+ oldList asSet = newList asSet
+ ifFalse:
+ [anAllScriptsTool removeAllMorphs; addAllMorphs: firstTwo.
+ morphList := newList collect:
+ [:aScriptInstantiation | aScriptInstantiation statusControlRowIn: anAllScriptsTool].
+ anAllScriptsTool addAllMorphs: morphList.
+ newList do:
+ [:aScriptInstantiation | aScriptInstantiation updateAllStatusMorphs]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>repelsMorph:event: (in category 'dropping/grabbing') -----
+ repelsMorph: aMorph event: ev
+ "Answer whether the receiver shoul repel the given morph"
+
+ ^ Preferences universalTiles
+ ifTrue:
+ [(aMorph respondsTo: #parseNode) not]
+ ifFalse:
+ [aMorph isTileLike not]!
Item was added:
+ ----- Method: ScriptEditorMorph>>methodNodeMorph (in category 'other') -----
+ methodNodeMorph
+ "Answer the morph that constitutes the receiver's method node"
+
+ submorphs size < 2 ifTrue: [^ nil].
+ ^ self findDeepSubmorphThat:
+ [:aMorph | (aMorph isSyntaxMorph) and:
+ [aMorph parseNode isKindOf: MethodNode]]
+ ifAbsent: [nil]!
Item was added:
+ ----- Method: EtoysPresenter>>positionStandardPlayer (in category 'standardPlayer etc') -----
+ positionStandardPlayer
+ "Put the standard player slightly off-screen"
+
+ standardPlayer ifNotNil:
+ [standardPlayer costume position: (associatedMorph topLeft - (13 at 0))]!
Item was added:
+ ----- Method: PasteUpMorph>>backgroundForm: (in category '*Etoys-playfield') -----
+ backgroundForm: aForm
+
+ self backgroundSketch: (self drawingClass new
+ center: self center;
+ form: aForm)!
Item was added:
+ ----- Method: Morph>>getPenColor (in category '*Etoys') -----
+ getPenColor
+ ^ self player ifNotNil: [self actorState getPenColor] ifNil: [Color green]!
Item was added:
+ ----- Method: Morph>>getPenSize (in category '*Etoys') -----
+ getPenSize
+ self player ifNil: [^ 1].
+ ^ self actorState getPenSize!
Item was added:
+ ----- Method: Player>>isPlayer (in category 'testing') -----
+ isPlayer
+ ^true!
Item was added:
+ ----- Method: ScrollableField class>>additionsToViewerCategories (in category '*Etoys-scripting') -----
+ additionsToViewerCategories
+ ^ TextMorph additionsToViewerCategories!
Item was added:
+ ----- Method: ScriptEditorMorph>>veryDeepInner: (in category 'copying') -----
+ veryDeepInner: deepCopier
+ "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
+
+ super veryDeepInner: deepCopier.
+ scriptName := scriptName veryDeepCopyWith: deepCopier.
+ firstTileRow := firstTileRow veryDeepCopyWith: deepCopier.
+ timeStamp := timeStamp veryDeepCopyWith: deepCopier.
+ playerScripted := playerScripted. "Weakly copied"
+ handWithTile := nil. "Just a cache"
+ showingMethodPane := showingMethodPane. "boolean"
+ threadPolygon := nil. "Just a cache".
+
+ !
Item was added:
+ ----- Method: Morph>>enforceTileColorPolicy (in category '*Etoys-support') -----
+ enforceTileColorPolicy
+ Preferences coloredTilesEnabled
+ ifTrue:
+ [self makeAllTilesColored]
+ ifFalse:
+ [self makeAllTilesGreen]!
Item was added:
+ ----- Method: ScriptEditorMorph>>isTextuallyCoded (in category 'other') -----
+ isTextuallyCoded
+ (self topEditor isKindOf: ScriptEditorMorph) ifFalse: [^ false]. "workaround for the case where the receiver is embedded in a free-standing CompoundTileMorph. Yecch!!"
+ ^ self userScriptObject isTextuallyCoded!
Item was added:
+ ----- Method: Object>>newScriptorAround: (in category '*Etoys-viewer') -----
+ newScriptorAround: aPhraseTileMorph
+ "Sprout a scriptor around aPhraseTileMorph, thus making a new script. This is where generalized scriptors will be threaded in"
+
+ ^ nil!
Item was added:
+ ----- Method: ColorType>>wantsArrowsOnTiles (in category '*eToys-tiles') -----
+ wantsArrowsOnTiles
+ "Answer whether this data type wants up/down arrows on tiles representing its values"
+
+ ^ false!
Item was added:
+ ----- Method: PasteUpMorph>>printVocabularySummary (in category '*Etoys-playfield') -----
+ printVocabularySummary
+ "Put up a window with summaries of all Morph vocabularies."
+
+
+ (StringHolder new contents: EToyVocabulary vocabularySummary)
+ openLabel: 'EToy Vocabulary'
+
+ "self currentWorld printVocabularySummary"!
Item was added:
+ ----- Method: PasteUpMorph>>fenceEnabled (in category '*eToys-support') -----
+ fenceEnabled
+
+ ^ self valueOfProperty: #fenceEnabled ifAbsent: [Preferences fenceEnabled]!
Item was added:
+ ----- Method: PasteUpMorph>>backgroundForm (in category '*Etoys-playfield') -----
+ backgroundForm
+
+ ^ self backgroundSketch
+ ifNil: [Form extent: self extent depth: Display depth]
+ ifNotNil: [backgroundMorph form]!
Item was added:
+ ----- Method: ScriptEditorMorph>>addNewRow (in category 'private') -----
+ addNewRow
+
+ | row |
+ row := AlignmentMorph newRow
+ vResizing: #spaceFill;
+ layoutInset: 0;
+ borderWidth: 0;
+ extent: (bounds width)@(TileMorph defaultH);
+ color: Color transparent.
+ self addMorphBack: row.
+ ^ row
+ !
Item was added:
+ ----- Method: Object>>graphicForViewerTab (in category '*Etoys-viewer') -----
+ graphicForViewerTab
+ "When a Viewer is open on the receiver, its tab needs some graphic to show to the user. Answer a form or a morph to serve that purpose. A generic image is used for arbitrary objects, but note my reimplementors"
+
+ ^ ScriptingSystem formAtKey: 'Image'!
Item was added:
+ ----- Method: ScriptEditorMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ "Not to be instantiated from the menu"
+ ^ false!
Item was added:
+ ----- Method: ScriptEditorMorph>>autoFitString (in category 'menu') -----
+ autoFitString
+ "Answer the string to put in a menu that will invite the user to
+ switch autoFit mode"
+ ^ ((self hasProperty: #autoFitContents)
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>'])
+ , 'auto fit' translated!
Item was added:
+ ----- Method: ScriptEditorMorph>>renameScriptTo: (in category 'other') -----
+ renameScriptTo: newSelector
+ "Rename the receiver's script so that it bears a new selector"
+
+ | aMethodNodeMorph methodMorph methodSource pos newMethodSource |
+
+ scriptName := newSelector.
+ self updateHeader.
+ Preferences universalTiles
+ ifFalse: "classic tiles"
+ [self showingMethodPane
+ ifTrue:
+ ["textually coded -- need to change selector"
+ methodMorph := self findA: MethodMorph.
+ methodSource := methodMorph text string.
+ pos := methodSource indexOf: Character cr ifAbsent: [self error: 'no cr'].
+ newMethodSource := newSelector.
+ newSelector numArgs > 0 ifTrue: [newMethodSource := newMethodSource, ' t1']. "for the parameter"
+ newMethodSource := newMethodSource, (methodSource copyFrom: pos to: methodSource size).
+ methodMorph editString: newMethodSource.
+ methodMorph model changeMethodSelectorTo: newSelector.
+ playerScripted class compile: newMethodSource classified: 'scripts'.
+ methodMorph accept]
+ ifFalse:
+ [self install]]
+ ifTrue: "universal tiles..."
+ [(aMethodNodeMorph := self methodNodeMorph) ifNotNil:
+ [aMethodNodeMorph acceptInCategory: 'scripts']]!
Item was added:
+ ----- Method: PasteUpMorph>>toggleBehaveLikeAHolder (in category '*Etoys-viewing') -----
+ toggleBehaveLikeAHolder
+ "Toggle whether or not the receiver is currently behaving like a holder"
+
+ self behaveLikeHolder: (self behavingLikeAHolder not)!
Item was added:
+ ----- Method: ScriptEditorMorph>>mouseLeaveDragging: (in category 'event handling') -----
+ mouseLeaveDragging: evt
+ "Test button state elsewhere if at all"
+ ^ self mouseLeave: evt!
Item was added:
+ ----- Method: EtoysPresenter>>cacheSpecs: (in category 'viewer') -----
+ cacheSpecs: aMorph
+ "For SyntaxMorph's type checking, cache the list of all viewer command specifications."
+
+ aMorph world ifNil: [^ true].
+ Preferences universalTiles ifFalse: [^ true].
+ Preferences eToyFriendly ifFalse: [^ true]. "not checking"
+ (Project current projectParameterAt: #fullCheck ifAbsent: [false])
+ ifFalse: [^ true]. "not checking"
+
+ SyntaxMorph initialize.!
Item was added:
+ ----- Method: Object>>browseOwnClassSubProtocol (in category '*Etoys-viewer') -----
+ browseOwnClassSubProtocol
+ "Open up a ProtocolBrowser on the subprotocol of the receiver"
+
+ ProtocolBrowser openSubProtocolForClass: self class
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>showSourceInScriptor (in category 'buttons') -----
+ showSourceInScriptor
+ "Remove tile panes, if any, and show textual source instead"
+
+ | aCodePane |
+
+ self isTextuallyCoded ifFalse: [self becomeTextuallyCoded].
+ "Mostly to fix up grandfathered ScriptEditors"
+
+ self removeAllButFirstSubmorph.
+
+ aCodePane := MethodHolder
+ isolatedCodePaneForClass: playerScripted class
+ selector: scriptName.
+
+ aCodePane
+ hResizing: #spaceFill;
+ vResizing: #spaceFill;
+ minHeight: 100.
+ self
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap.
+ self addMorphBack: aCodePane.
+ self fullBounds.
+ self
+ listDirection: #topToBottom;
+ hResizing: #rigid;
+ vResizing: #rigid;
+ rubberBandCells: true;
+ minWidth: self width.
+
+ showingMethodPane := true.
+ self currentWorld startSteppingSubmorphsOf: self!
Item was added:
+ ----- Method: ScriptEditorMorph>>removeSpaces (in category 'dropping/grabbing') -----
+ removeSpaces
+ "Remove vertical space"
+
+ self submorphsDo:
+ [:m | (m isMemberOf: Morph) ifTrue: [m delete]].
+ self removeEmptyRows.
+ submorphs isEmpty ifTrue: [self height: 14]!
Item was added:
+ ----- Method: EtoysPresenter>>constantTile: (in category 'tile support') -----
+ constantTile: anObject
+ "Answer a constant tile that represents the object"
+
+ (anObject isColor)
+ ifTrue:
+ [^ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)].
+ ^anObject newTileMorphRepresentative
+ typeColor: (ScriptingSystem colorForType: (self typeForConstant: anObject))!
Item was added:
+ ----- Method: PasteUpMorph>>paintBackground (in category '*Etoys-playfield') -----
+ paintBackground
+ | pic rect |
+ self world prepareToPaint.
+ pic := self backgroundSketch.
+ pic ifNotNil: [pic editDrawingIn: self forBackground: true] "need to resubmit it? (tck comment)"
+ ifNil: [rect := self bounds.
+ pic := self world drawingClass new form:
+ (Form extent: rect extent depth: Display depth).
+ pic bounds: rect.
+ "self world addMorphBack: pic. done below"
+ pic := self backgroundSketch: pic. "returns a different guy"
+ pic ifNotNil: [pic editDrawingIn: self forBackground: true]]!
Item was added:
+ ----- Method: Morph>>putOnBackground (in category '*Etoys') -----
+ putOnBackground
+ "Place the receiver, formerly private to its card, onto the shared background. If the receiver needs data carried on its behalf by the card, such data will be represented on every card."
+
+ (self hasProperty: #shared) ifTrue: [^ self]. "Already done"
+
+ self setProperty: #shared toValue: true.
+ self stack ifNotNil: [self stack reassessBackgroundShape]!
Item was added:
+ ----- Method: PasteUpMorph class>>additionsToViewerCategories (in category '*eToys-scripting') -----
+ additionsToViewerCategories
+ "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."
+
+ ^ # (
+
+ (playfield (
+ (command initiatePainting 'Initiate painting of a new object in the standard playfield.')
+ (slot mouseX 'The x coordinate of the mouse pointer' Number readWrite Player getMouseX unused unused)
+ (slot mouseY 'The y coordinate of the mouse pointer' Number readWrite Player getMouseY unused unused)
+ (command roundUpStrays 'Bring all out-of-container subparts back into view.')
+ (slot graphic 'The graphic shown in the background of this object' Graphic readWrite Player getGraphic Player setGraphic:)
+ (command unhideHiddenObjects 'Unhide all hidden objects.')))
+
+ (scripting (
+ (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName)))
+
+ (collections (
+ (slot cursor 'The index of the chosen element' Number readWrite Player getCursor Player setCursorWrapped:)
+ (slot count 'How many elements are within me' Number readOnly Player getCount unused unused)
+ (slot stringContents 'The characters of the objects inside me, laid end to end' String readOnly Player getStringContents unused unused)
+ (slot playerAtCursor 'the object currently at the cursor' Player readWrite Player getValueAtCursor unused unused)
+ (slot firstElement 'The first object in my contents' Player readWrite Player getFirstElement Player setFirstElement:)
+ (slot numberAtCursor 'the number at the cursor' Number readWrite Player getNumberAtCursor Player setNumberAtCursor: )
+ (slot graphicAtCursor 'the graphic worn by the object at the cursor' Graphic readOnly Player getGraphicAtCursor unused unused)
+ (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName)
+ (command removeAll 'Remove all elements from the playfield')
+ (command shuffleContents 'Shuffle the contents of the playfield')
+ (command append: 'Add the object to the end of my contents list.' Player)
+ (command prepend: 'Add the object at the beginning of my contents list.' Player)
+ (command includeAtCursor: 'Add the object to my contents at my current cursor position' Player)
+ (command include: 'Add the object to my contents' Player)
+ ))
+
+ (#'stack navigation' (
+ (command goToNextCardInStack 'Go to the next card')
+ (command goToPreviousCardInStack 'Go to the previous card')
+ (command goToFirstCardInBackground 'Go to the first card of the current background')
+ (command goToFirstCardOfStack 'Go to the first card of the entire stack')
+ (command goToLastCardInBackground 'Go to the last card of the current background')
+ (command goToLastCardOfStack 'Go to the last card of the entire stack')
+ (command deleteCard 'Delete the current card')
+ (command insertCard 'Create a new card')))
+
+ "(viewing (
+ (slot viewingNormally 'whether contents are viewed normally' Boolean readWrite Player getViewingByIcon Player setViewingByIcon: )))"
+
+ (#'pen trails' (
+ (command liftAllPens 'Lift the pens on all the objects in my interior.')
+ (command lowerAllPens 'Lower the pens on all the objects in my interior.')
+ (command trailStyleForAllPens: 'Set the trail style for pens of all objects within' TrailStyle)
+ (command clearTurtleTrails 'Clear all the pen trails in the interior.'))))
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>showingMethodPane: (in category 'textually-coded scripts') -----
+ showingMethodPane: val
+ "Whether the receiver will show the textual method pane"
+
+ showingMethodPane := val!
Item was added:
+ ----- Method: Morph>>isTileScriptingElement (in category '*Etoys-scripting') -----
+ isTileScriptingElement
+
+ ^ self hasButtonProperties and: [self buttonProperties isTileScriptingElement]!
Item was added:
+ ----- Method: Morph>>showForegroundObjects (in category '*Etoys-card in a stack') -----
+ showForegroundObjects
+ "Temporarily highlight the foreground objects"
+
+ self isStackBackground ifFalse: [^ self].
+ Display restoreAfter:
+ [self submorphsDo:
+ [:aMorph | aMorph renderedMorph isShared
+ ifFalse:
+ [Display border: (aMorph fullBoundsInWorld insetBy: -6)
+ width: 6 rule: Form over fillColor: Color orange]]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>unhibernate (in category 'other') -----
+ unhibernate
+ "I have been loaded as part of an ImageSegment.
+ Make sure that I am fixed up properly."
+ | fixMe |
+ (fixMe := self valueOfProperty: #needsLayoutFixed ifAbsent: [ false ])
+ ifTrue: [self removeProperty: #needsLayoutFixed ].
+
+ self topEditor == self
+ ifFalse: [^ self]. "Part of a compound test"
+
+ self updateHeader.
+ fixMe ifTrue: [ self fixLayout. self removeProperty: #needsLayoutFixed ].
+
+ "Recreate my tiles from my method if i have new universal tiles."
+
+ self world
+ ifNil: [(playerScripted isNil
+ or: [playerScripted isUniversalTiles not])
+ ifTrue: [^ self]]
+ ifNotNil: [Preferences universalTiles
+ ifFalse: [^ self]].
+ self insertUniversalTiles.
+ self showingMethodPane: false!
Item was added:
+ ----- Method: PasteUpMorph>>autoViewingString (in category '*Etoys-viewing') -----
+ autoViewingString
+ "Answer the string to be shown in a menu to represent the
+ automatic-viewing status"
+ ^ (self automaticViewing
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'automatic viewing' translated!
Item was added:
+ ----- Method: ScriptEditorMorph>>revertToTileVersion (in category 'save & revert') -----
+ revertToTileVersion
+ "The receiver, currently showing textual code, is asked to revert to the last-saved tile version"
+
+ | aUserScript |
+
+ self
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap.
+ aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
+ aUserScript revertToLastSavedTileVersionFor: self.
+ self currentWorld startSteppingSubmorphsOf: self!
Item was added:
+ ----- Method: ScriptEditorMorph>>actuallyDestroyScript (in category 'customevents-buttons') -----
+ actuallyDestroyScript
+ "Carry out the actual destruction of the associated script."
+
+ | aHandler itsCostume |
+ self delete.
+ playerScripted class removeScriptNamed: scriptName.
+ playerScripted actorState instantiatedUserScriptsDictionary removeKey: scriptName ifAbsent: [].
+ "not quite enough yet in the multiple-instance case..."
+ itsCostume := playerScripted costume.
+ (aHandler := itsCostume renderedMorph eventHandler) ifNotNil:
+ [aHandler forgetDispatchesTo: scriptName].
+ itsCostume removeActionsSatisfying: [ :act | act receiver == playerScripted and: [ act selector == scriptName ]].
+ itsCostume currentWorld removeActionsSatisfying: [ :act | act receiver == playerScripted and: [ act selector == scriptName ]].
+ playerScripted updateAllViewersAndForceToShow: ScriptingSystem nameForScriptsCategory!
Item was added:
+ ----- Method: Morph>>tearOffTile (in category '*Etoys-scripting') -----
+ tearOffTile
+ "Tear off a tile representing the player associated with the receiver. This is obtained from the top renderer"
+
+ ^ self topRendererOrSelf assuredPlayer tearOffTileForSelf!
Item was added:
+ ----- Method: EtoysPresenter>>standardPlayfield: (in category 'misc') -----
+ standardPlayfield: aPlayfield
+ standardPlayfield := aPlayfield!
Item was added:
+ ----- Method: ScriptEditorMorph>>chooseFrequency (in category 'buttons') -----
+ chooseFrequency
+ | currentFrequency aMenu |
+ currentFrequency := self scriptInstantiation frequency.
+ currentFrequency = 0 ifTrue: [currentFrequency := 1].
+ aMenu := MenuMorph new defaultTarget: self.
+ #(1 2 5 10 25 50 100 1000 5000 10000) do:
+ [:i | aMenu add: i printString selector: #setFrequencyTo: argument: i].
+
+ aMenu add: 'other...' translated action: #typeInFrequency.
+ aMenu addTitle: ('Choose frequency (current: {1})' translated format: {currentFrequency}).
+ aMenu popUpEvent: self currentEvent in: self world!
Item was added:
+ ----- Method: ScriptEditorMorph>>hasParameter (in category 'buttons') -----
+ hasParameter
+ "Answer whether the receiver has a parameter"
+
+ ^ scriptName numArgs > 0!
Item was added:
+ ----- Method: Morph>>installAsCurrent: (in category '*Etoys-card in a stack') -----
+ installAsCurrent: anInstance
+ "Install anInstance as the one currently viewed in the receiver. Dock up all the morphs in the receiver which contain data rooted in the player instance to the instance data. Run any 'opening' scripts that pertain."
+
+ | fieldList |
+ self player == anInstance ifTrue: [^ self].
+ fieldList := self allMorphs select:
+ [:aMorph | (aMorph wouldAcceptKeyboardFocusUponTab) and: [aMorph isLocked not]].
+ self currentWorld hands do:
+ [:aHand | | itsFocus |
+ (itsFocus := aHand keyboardFocus) notNil ifTrue:
+ [(fieldList includes: itsFocus) ifTrue: [aHand newKeyboardFocus: nil]]].
+
+ self player uninstallFrom: self. "out with the old"
+
+ anInstance installPrivateMorphsInto: self.
+ self changed.
+ anInstance costume: self.
+ self player: anInstance.
+ self player class variableDocks do:
+ [:aVariableDock | aVariableDock dockMorphUpToInstance: anInstance].
+ self currentWorld startSteppingSubmorphsOf: self!
Item was added:
+ ----- Method: Object>>externalName (in category '*Etoys-viewer') -----
+ externalName
+ "Answer an external name by which the receiver is known. Generic implementation here is a transitional backstop. probably"
+
+ ^ self nameForViewer!
Item was added:
+ ----- Method: ScriptEditorMorph>>mouseEnter: (in category 'event handling') -----
+ mouseEnter: evt
+ | hand tile |
+
+ self flag: #bob. "needed renderedMorph due to transformations"
+ hand := evt hand.
+ hand submorphs size = 1 ifFalse: [^self].
+ tile := hand firstSubmorph renderedMorph.
+ (self wantsDroppedMorph: tile event: evt) ifFalse: [^self].
+ handWithTile := hand.
+ self startSteppingSelector: #trackDropZones.!
Item was added:
+ ----- Method: Morph>>getPenDown (in category '*Etoys') -----
+ getPenDown
+ self player ifNil: [^ false].
+ ^ self actorState getPenDown!
Item was added:
+ ----- Method: ColorType>>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"
+
+ | readout |
+ readout _ UpdatingRectangleMorph new.
+ readout
+ getSelector: getter;
+ target: aTarget;
+ borderWidth: 1;
+ extent: 22 at 22.
+ ((aTarget isKindOf: KedamaExamplerPlayer) and: [getter = #getColor]) ifTrue: [
+ readout getSelector: #getColorOpaque.
+ ].
+ (setter isNil or: [#(unused none #nil) includes: setter]) ifFalse:
+ [readout putSelector: setter].
+ ^ readout
+ !
Item was added:
+ ----- Method: Object>>initialTypeForSlotNamed: (in category '*Etoys-viewer') -----
+ initialTypeForSlotNamed: aName
+ "Answer the initial type to be ascribed to the given instance variable"
+
+ ^ #Object!
Item was added:
+ ----- Method: Morph>>assuredCardPlayer (in category '*Etoys-card in a stack') -----
+ assuredCardPlayer
+ "Answer the receiver's player, creating a new one if none currently exists"
+
+ | aPlayer |
+ (aPlayer := self player) ifNotNil: [
+ (aPlayer isKindOf: CardPlayer)
+ ifTrue: [^ aPlayer]
+ ifFalse: [self error: 'Must convert to a CardPlayer']
+ "later convert using as: and remove the error"].
+ self assureExternalName. "a default may be given if not named yet"
+ self player: (aPlayer := UnscriptedCardPlayer newUserInstance).
+ "Force it to be a CardPlayer. Morph class no longer dictates what kind of player"
+ aPlayer costume: self.
+ self presenter ifNotNil: [self presenter flushPlayerListCache].
+ ^ aPlayer!
Item was added:
+ ----- Method: PasteUpMorph>>tellAllContents: (in category '*eToys-support') -----
+ tellAllContents: aMessageSelector
+ "Send the given message selector to all the objects within the receiver"
+
+ self submorphs do:
+ [:m |
+ m player ifNotNil:
+ [:p | p performScriptIfCan: aMessageSelector]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>scriptInstantiation (in category 'access') -----
+ scriptInstantiation
+ ^ playerScripted scriptInstantiationForSelector: scriptName!
Item was added:
+ ----- Method: PasteUpMorph>>backgroundSketch: (in category '*Etoys-playfield') -----
+ backgroundSketch: aSketchMorphOrNil
+ "Set the receiver's background graphic as indicated. If nil is supplied, remove any existing background graphic. In any case, delete any preexisting background graphic."
+
+ backgroundMorph ifNotNil: [backgroundMorph delete]. "replacing old background"
+
+ aSketchMorphOrNil ifNil: [backgroundMorph := nil. ^ self].
+
+ backgroundMorph := StickySketchMorph new form: aSketchMorphOrNil form.
+ backgroundMorph position: aSketchMorphOrNil position.
+ self addMorphBack: backgroundMorph.
+ aSketchMorphOrNil delete.
+ backgroundMorph lock.
+ backgroundMorph setProperty: #shared toValue: true.
+ ^ backgroundMorph
+ !
Item was added:
+ ----- Method: SyntaxMorph class>>allSpecs (in category 'accessing') -----
+ allSpecs
+ "Return all specs that the Viewer knows about. Cache them."
+ "SyntaxMorph allSpecs"
+
+ ^AllSpecs ifNil: [
+ AllSpecs := Dictionary new.
+ (EToyVocabulary morphClassesDeclaringViewerAdditions)
+ do: [:cls | cls allAdditionsToViewerCategories keysAndValuesDo: [ :k :v |
+ (AllSpecs at: k ifAbsentPut: [ OrderedCollection new ]) addAll: v ] ].
+ AllSpecs
+ ]!
Item was added:
+ ----- Method: StandardScriptingSystem class>>removeUnreferencedPlayers (in category '*Etoys') -----
+ removeUnreferencedPlayers
+ "Remove existing but unreferenced player references"
+ "StandardScriptingSystem removeUnreferencedPlayers"
+ References keys do:
+ [:key | (References at: key) costume pasteUpMorph
+ ifNil: [References removeKey: key]].
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>handUserParameterTile (in category 'other') -----
+ handUserParameterTile
+ "Hand the user a parameter, presumably to drop in the script"
+
+ | aTileMorph |
+ aTileMorph := ParameterTile new forScriptEditor: self.
+ self currentHand attachMorph: aTileMorph!
Item was added:
+ ----- Method: ScriptEditorMorph>>restoreScriptName: (in category 'buttons') -----
+ restoreScriptName: aScriptName
+ "For fixup only..."
+
+ scriptName := aScriptName!
Item was added:
+ ----- Method: ParseNode>>currentValueIn: (in category '*eToys-tiles') -----
+ currentValueIn: aContext
+
+ ^nil!
Item was added:
+ ----- Method: Object>>renameScript: (in category '*Etoys-viewer') -----
+ renameScript: oldSelector
+ "prompt the user for a new selector and apply it. Presently only works for players"
+
+ self notYetImplemented!
Item was added:
+ ----- Method: Morph>>triggerScript: (in category '*Etoys-scripting') -----
+ triggerScript: aSymbol
+ "Have my player perform the script of the given name, which is guaranteed to exist."
+
+ ^self assuredPlayer triggerScript: aSymbol!
Item was added:
+ ----- Method: PasteUpMorph>>clearTurtleTrails (in category '*Etoys-pen') -----
+ clearTurtleTrails
+
+ turtleTrailsForm := nil.
+ turtlePen := nil.
+ self changed.
+ !
Item was added:
+ ----- Method: Morph>>fenceEnabled (in category '*Etoys-support') -----
+ fenceEnabled
+
+ "in case a non-pasteUp is used as a container"
+
+ ^Preferences fenceEnabled!
Item was added:
+ ----- Method: ScriptEditorMorph>>showingMethodPane (in category 'textually-coded scripts') -----
+ showingMethodPane
+ "Answer whether the receiver is currently showing the textual method pane"
+
+ ^ showingMethodPane ifNil: [showingMethodPane := false]!
Item was added:
+ ----- Method: TheWorldMenu>>scriptingMenu (in category '*EToys') -----
+ scriptingMenu
+ "Build the authoring-tools menu for the world."
+
+ ^ self fillIn: (self menu: 'authoring tools...') from: {
+ { 'objects (o)' . { #myWorld . #activateObjectsTool }. 'A searchable source of new objects.'}.
+ nil. "----------"
+ { 'view trash contents' . { #myWorld . #openScrapsBook:}. 'The place where all your trashed morphs go.'}.
+ { 'empty trash can' . { Utilities . #emptyScrapsBook}. 'Empty out all the morphs that have accumulated in the trash can.'}.
+ nil. "----------"
+
+ { 'new scripting area' . { #myWorld . #detachableScriptingSpace}. 'A window set up for simple scripting.'}.
+
+ nil. "----------"
+
+ { 'status of scripts' . {#myWorld . #showStatusOfAllScripts}. 'Lets you view the status of all the scripts belonging to all the scripted objects of the project.'}.
+ { 'summary of scripts' . {#myWorld . #printScriptSummary}. 'Produces a summary of scripted objects in the project, and all of their scripts.'}.
+ { 'browser for scripts' . {#myWorld . #browseAllScriptsTextually}. 'Allows you to view all the scripts in the project in a traditional programmers'' "browser" format'}.
+
+
+ nil.
+
+ { 'gallery of players' . {#myWorld . #galleryOfPlayers}. 'A tool that lets you find out about all the players used in this project'}.
+
+ " { 'gallery of scripts' . {#myWorld . #galleryOfScripts}. 'Allows you to view all the scripts in the project'}."
+
+ { 'etoy vocabulary summary' . {#myWorld . #printVocabularySummary }. 'Displays a summary of all the pre-defined commands and properties in the pre-defined EToy vocabulary.'}.
+
+ { 'attempt misc repairs' . {#myWorld . #attemptCleanup}. 'Take measures that may help fix up some things about a faulty or problematical project.'}.
+
+ { 'remove all viewers' . {#myWorld . #removeAllViewers}. 'Remove all the Viewers from this project.'}.
+
+ { 'refer to masters' . {#myWorld . #makeAllScriptEditorsReferToMasters }. 'Ensure that all script editors are referring to the first (alphabetically by external name) Player of their type' }.
+
+ nil. "----------"
+
+ { 'unlock locked objects' . { #myWorld . #unlockContents}. 'If any items on the world desktop are currently locked, unlock them.'}.
+ { 'unhide hidden objects' . { #myWorld . #showHiders}. 'If any items on the world desktop are currently hidden, make them visible.'}.
+ }!
Item was added:
+ ----- Method: EtoysPresenter>>allStopButtons (in category 'stop-step-go buttons') -----
+ allStopButtons
+ "Answer a list of all script-controlling Stop buttons within my scope"
+
+ ^ associatedMorph allMorphs select:
+ [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
+ [aMorph actionSelector == #stopUp:with:]]
+
+ "ActiveWorld presenter allStopButtons"!
Item was added:
+ ----- Method: Object>>categoriesForVocabulary:limitClass: (in category '*Etoys-viewer') -----
+ categoriesForVocabulary: aVocabulary limitClass: aLimitClass
+ "Answer a list of categories of methods for the receiver when using the given vocabulary, given that one considers only methods that are implemented not further away than aLimitClass"
+
+ ^ aVocabulary categoryListForInstance: self ofClass: self class limitClass: aLimitClass!
Item was added:
+ ----- Method: PasteUpMorph>>arrowsForAllPens (in category '*Etoys-pen') -----
+ arrowsForAllPens
+ "Set the trail style for all my objects to show arrowheads only"
+
+ self trailStyleForAllPens: #arrowheads!
Item was added:
+ ----- Method: ScriptEditorMorph>>scriptName (in category 'buttons') -----
+ scriptName
+ ^ scriptName!
Item was added:
+ ----- Method: ScriptEditorMorph class>>writingUniversalTiles: (in category 'instance creation') -----
+ writingUniversalTiles: boolean
+
+ WritingUniversalTiles := boolean!
Item was added:
+ ----- Method: Morph>>variableDocks (in category '*Etoys-card in a stack') -----
+ variableDocks
+ "Answer a list of VariableDocker objects for docking up my data with an instance held in my containing playfield. The simple presence of some objects on a Playfield will result in the maintenance of instance data on the corresponding Card. This is a generalization of the HyperCard 'field' idea. If there is already a cachedVariableDocks cached, use that. For this all to work happily, one must be certain to invalidate the #cachedVariableDocks cache when that's appropriate."
+
+ ^ self valueOfProperty: #cachedVariableDocks ifAbsent: [#()]!
Item was added:
+ ----- Method: ScriptEditorMorph>>morph (in category 'access') -----
+ morph
+ ^ self playerScripted costume!
Item was added:
+ ----- Method: ScriptEditorMorph>>indexOfMorphAbove: (in category 'dropping/grabbing') -----
+ indexOfMorphAbove: aPoint
+ "Return index of lowest morph whose bottom is above aPoint.
+ Will return 0 if the first morph is not above aPoint"
+ submorphs doWithIndex:
+ [:m :i | m fullBounds bottom >= aPoint y ifTrue:
+ [^ (i max: firstTileRow) - 1]].
+ ^ submorphs size!
Item was added:
+ ----- Method: WordArray>>primMulArray:and:into: (in category '*Etoys-arithmetic') -----
+ primMulArray: rcvr and: other into: result
+
+ <primitive: 'primitiveMulArrays' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveMulArrays."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) * (other at: i)
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: Morph>>beAStackBackground (in category '*Etoys-card in a stack') -----
+ beAStackBackground
+ "Transform the receiver into one that has stack-background behavior. If just becoming a stack, allocate a uniclass to represent the cards (if one does not already exist"
+
+ self assuredCardPlayer assureUniClass.
+ self setProperty: #tabAmongFields toValue: true.
+ self setProperty: #stackBackground toValue: true.
+ "put my submorphs onto the background"
+ submorphs do: [:mm | mm setProperty: #shared toValue: true].
+ self reassessBackgroundShape!
Item was added:
+ ----- Method: PasteUpMorph>>scriptSelectorToTriggerFor: (in category '*Etoys-viewing') -----
+ scriptSelectorToTriggerFor: aButtonMorph
+ "Answer a new selector which will bear the code for aButtonMorph in the receiver"
+
+ | buttonName selectorName |
+ buttonName := aButtonMorph externalName.
+ selectorName := self assuredPlayer acceptableScriptNameFrom: buttonName forScriptCurrentlyNamed: nil.
+
+ buttonName ~= selectorName ifTrue:
+ [aButtonMorph setNameTo: selectorName].
+ ^ selectorName!
Item was added:
+ ----- Method: ScriptEditorMorph>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: evt
+
+ ^ true
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>playerScripted: (in category 'initialization') -----
+ playerScripted: aPlayer
+ playerScripted := aPlayer !
Item was added:
+ ----- Method: ScriptEditorMorph>>dismiss (in category 'buttons') -----
+ dismiss
+ "Dismiss the scriptor, usually nondestructively"
+
+ owner ifNil: [^ self].
+ scriptName ifNil: [^ self delete]. "ad hoc fixup for bkwrd compat"
+ (playerScripted isExpendableScript: scriptName) ifTrue: [playerScripted removeScript: scriptName fromWorld: self world].
+ handWithTile := nil.
+ self delete!
Item was added:
+ ----- Method: PasteUpMorph>>viewingByNameString (in category '*Etoys-viewing') -----
+ viewingByNameString
+ "Answer a string to show in a menu representing whether the
+ receiver is currently viewing its subparts by name or not"
+ ^ ((self showingListView
+ and: [(self
+ valueOfProperty: #sortOrder
+ ifAbsent: [])
+ == #downshiftedNameOfObjectRepresented])
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'view by name' translated!
Item was added:
+ ----- Method: Object>>methodInterfacesInPresentationOrderFrom:forCategory: (in category '*Etoys-viewer') -----
+ methodInterfacesInPresentationOrderFrom: interfaceList forCategory: aCategory
+ "Answer the interface list sorted in desired presentation order, using a
+ static master-ordering list, q.v. The category parameter allows an
+ escape in case one wants to apply different order strategies in different
+ categories, but for now a single master-priority-ordering is used -- see
+ the comment in method EToyVocabulary.masterOrderingOfPhraseSymbols"
+
+ | masterOrder ordered unordered |
+ masterOrder := Vocabulary eToyVocabulary masterOrderingOfPhraseSymbols.
+ ordered := SortedCollection sortBlock: [:a :b | a key < b key].
+ unordered := SortedCollection sortBlock: [:a :b | a wording < b wording].
+
+ interfaceList do: [:interface |
+ | index |
+ index := masterOrder indexOf: interface elementSymbol.
+ index isZero
+ ifTrue: [unordered add: interface]
+ ifFalse: [ordered add: index -> interface]].
+
+ ^ Array
+ streamContents: [:stream |
+ ordered do: [:assoc | stream nextPut: assoc value].
+ stream nextPutAll: unordered]!
Item was added:
+ ----- Method: EtoysPresenter>>stepStillDown:with: (in category 'stop-step-go buttons') -----
+ stepStillDown: dummy with: theButton
+ "The step button is still down; get temporary button feedback right and step all and then get all button feedback right again"
+
+ self stepButtonState: #pressed.
+ self stopButtonState: #off.
+ associatedMorph stepAll.
+ associatedMorph world displayWorld.
+ self stepButtonState: #off.
+ self stopButtonState: #on
+ !
Item was added:
+ ----- Method: Morph>>understandsBorderVocabulary (in category '*Etoys') -----
+ understandsBorderVocabulary
+ "Replace the 'isKindOf: BorderedMorph' so that (for instance) Connectors can have their border vocabulary visible in viewers."
+ ^false!
Item was added:
+ ----- Method: Morph class>>additionsToViewerCategories (in category '*Etoys') -----
+ additionsToViewerCategories
+ "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the
+ phrases this kind of morph wishes to add to various Viewer categories.
+
+ This version factors each category definition into a separate method.
+
+ Subclasses that have additions can either:
+ - override this method, or
+ - (preferably) define one or more additionToViewerCategory* methods.
+
+ The advantage of the latter technique is that class extensions may be added
+ by external packages without having to re-define additionsToViewerCategories.
+ "
+ ^#()!
Item was added:
+ ----- Method: Morph>>asWearableCostume (in category '*Etoys-support') -----
+ asWearableCostume
+ "Return a wearable costume for some player"
+ ^(World drawingClass withForm: self imageForm) copyCostumeStateFrom: self!
Item was added:
+ ----- Method: ScriptEditorMorph>>tileRows (in category 'other') -----
+ tileRows
+ "If using classic tiles, return a collection of arrays of Tiles in which each array is one line of tiles. (John Maloney's original design and code)."
+
+ | rows r |
+ rows := OrderedCollection new.
+ Preferences universalTiles ifTrue: [^ rows].
+ firstTileRow to: submorphs size do: [:i |
+ r := submorphs at: i.
+ r submorphCount > 0 ifTrue: [rows addLast: r submorphs]].
+ ^ rows
+ !
Item was added:
+ ----- Method: Morph>>abstractAModel (in category '*Etoys-card in a stack') -----
+ abstractAModel
+ "Find data-containing fields in me. Make a new class, whose instance variables are named for my fields, and whose values are the values I am showing. Use a CardPlayer for now. Force the user to name the fields. Make slots for text, Number Watchers, SketchMorphs, and ImageMorphs."
+
+ | unnamed ans player twoListsOfMorphs holdsSepData docks oldPlayer instVarNames |
+ (oldPlayer := self player) ifNotNil:
+ [oldPlayer belongsToUniClass
+ ifTrue:
+ ["Player"
+
+ oldPlayer class instVarNames notEmpty
+ ifTrue:
+ [self
+ inform: 'I already have a regular Player, so I can''t have a CardPlayer'.
+ ^true]]].
+ twoListsOfMorphs := StackMorph discoverSlots: self.
+ holdsSepData := twoListsOfMorphs first.
+ instVarNames := ''.
+ holdsSepData do:
+ [:ea | | iVarName |
+ iVarName := Scanner wellFormedInstanceVariableNameFrom: ea knownName.
+ iVarName = ea knownName ifFalse: [ea name: iVarName].
+ instVarNames := instVarNames , iVarName , ' '].
+ unnamed := twoListsOfMorphs second. "have default names"
+ instVarNames isEmpty
+ ifTrue:
+ [self
+ inform: 'No named fields were found.
+ Please get a halo on each field and give it a name.
+ Labels or non-data fields should be named "shared xxx".'.
+ ^false].
+ unnamed notEmpty
+ ifTrue:
+ [ans := (UIManager default
+ chooseFrom: #(
+ 'All other fields are non-data fields'.
+ 'Stop. Let me give a name to some more fields'.
+ ) title: 'Data fields are ' , instVarNames printString
+ , ('\Some fields are not named. Are they labels or non-data fields?'
+ , '\Please get a halo on each data field and give it a name.') withCRs) = 1.
+ ans ifFalse: [^false]].
+ unnamed
+ withIndexDo: [:mm :ind | mm setName: 'shared label ' , ind printString].
+ "Make a Player with instVarNames. Make me be the costume"
+ player := CardPlayer instanceOfUniqueClassWithInstVarString: instVarNames
+ andClassInstVarString: ''.
+ self player: player.
+ player costume: self.
+ "Fill in the instance values. Make docks first."
+ docks := OrderedCollection new.
+ holdsSepData do:
+ [:morph |
+ morph setProperty: #shared toValue: true. "in case it is deeply embedded"
+ morph setProperty: #holdsSeparateDataForEachInstance toValue: true.
+ player class compileInstVarAccessorsFor: morph knownName.
+ morph isSyntaxMorph ifTrue: [morph setTarget: player]. "hookup the UpdatingString!!"
+ docks addAll: morph variableDocks].
+ player class newVariableDocks: docks.
+ docks do: [:dd | dd storeMorphDataInInstance: player].
+ "oldPlayer class mdict do: [:assoc | move to player]. move methods to new class?"
+ "oldPlayer become: player."
+ ^true "success"!
Item was added:
+ ----- Method: Morph>>showBackgroundObjects (in category '*Etoys-card in a stack') -----
+ showBackgroundObjects
+ "Momentarily highlight just the background objects on the current playfield"
+
+ self isStackBackground ifFalse: [^ self].
+ self invalidRect: self bounds.
+ self currentWorld doOneCycle.
+ Display restoreAfter:
+ [self submorphsDo:
+ [:aMorph | (aMorph renderedMorph hasProperty: #shared)
+ ifTrue:
+ [Display border: (aMorph fullBoundsInWorld insetBy: -6)
+ width: 6 rule: Form over fillColor: Color blue]]]!
Item was added:
+ ----- Method: EtoysPresenter>>currentlyViewing: (in category 'misc') -----
+ currentlyViewing: aPlayer
+ "Only detects viewers in tabs"
+
+ aPlayer ifNil: [^false].
+ ^aPlayer viewerFlapTab notNil!
Item was added:
+ ----- Method: WordArray>>primDivArray:and:into: (in category '*Etoys-arithmetic') -----
+ primDivArray: rcvr and: other into: result
+
+ <primitive: 'primitiveDivArrays' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveDivArrays."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) / (other at: i)
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>localeChanged (in category 'e-toy support') -----
+ localeChanged
+ "Update myself to reflect the change in locale"
+
+ self fixLayout!
Item was added:
+ ----- Method: PasteUpMorph>>lowerAllPens (in category '*Etoys-pen') -----
+ lowerAllPens
+ submorphs do: [:m | m assuredPlayer lowerPen]
+ !
Item was added:
+ ----- Method: Morph>>newCard (in category '*Etoys-card in a stack') -----
+ newCard
+ "Create a new card for the receiver and return it"
+
+ | aNewInstance |
+ self isStackBackground ifFalse: [^ Beeper beep]. "bulletproof against deconstruction"
+ aNewInstance := self player class baseUniclass new.
+ ^ aNewInstance!
Item was added:
+ ----- Method: Morph class>>additionsToViewerCategory: (in category '*Etoys') -----
+ additionsToViewerCategory: aCategoryName
+ "Answer a list of viewer specs for items to be added to the given category on behalf of the receiver. Each class in a morph's superclass chain is given the opportunity to add more things"
+
+ aCategoryName == #vector ifTrue:
+ [^ self vectorAdditions].
+ ^self allAdditionsToViewerCategories at: aCategoryName ifAbsent: [ #() ].!
Item was added:
+ ----- Method: ScriptEditorMorph>>offerScriptorMenu (in category 'other') -----
+ offerScriptorMenu
+ "Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer"
+
+ | aMenu count |
+
+ self modernize.
+ ActiveHand showTemporaryCursor: nil.
+
+ aMenu := MenuMorph new defaultTarget: self.
+ aMenu addTitle: scriptName asString.
+
+ Preferences universalTiles ifFalse:
+ [count := self savedTileVersionsCount.
+ self showingMethodPane
+ ifFalse: "currently showing tiles"
+ [aMenu add: 'show code textually' translated action: #showSourceInScriptor.
+ count > 0 ifTrue:
+ [aMenu add: 'revert to tile version...' translated action: #revertScriptVersion].
+ aMenu add: 'save this version' translated action: #saveScriptVersion]
+
+ ifTrue: "current showing textual source"
+ [count >= 1 ifTrue:
+ [aMenu add: 'revert to tile version' translated action: #revertToTileVersion]]].
+
+ aMenu addList: {
+ #-.
+ {'destroy this script' translated. #destroyScript}.
+ {'rename this script' translated. #renameScript}.
+ }.
+
+ self hasParameter ifFalse:
+ [aMenu addList: {{'button to fire this script' translated. #tearOfButtonToFireScript}}].
+
+ aMenu addList: {
+ {'edit balloon help for this script' translated. #editMethodDescription}.
+ #-.
+ {'explain status alternatives' translated. #explainStatusAlternatives}.
+ #-.
+ {'hand me a tile for self' translated. #handUserTileForSelf}.
+ {'hand me a "random number" tile' translated. #handUserRandomTile}.
+ {'hand me a "button down?" tile' translated. #handUserButtonDownTile}.
+ {'hand me a "button up?" tile' translated. #handUserButtonUpTile}.
+ }.
+
+ aMenu addList: (self hasParameter
+ ifTrue: [{
+ #-.
+ {'remove parameter' translated. #ceaseHavingAParameter}}]
+ ifFalse: [{
+ {'fires per tick...' translated. #chooseFrequency}.
+ #-.
+ {'add parameter' translated. #addParameter}}]).
+
+ aMenu popUpInWorld: self currentWorld.
+ !
Item was added:
+ ----- Method: EtoysPresenter>>tempCommand (in category 'misc') -----
+ tempCommand
+ Transcript cr; show: '#tempCommand invoked for Presenter'!
Item was added:
+ ----- Method: ScriptEditorMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ "may need to unhibernate the script lazily here."
+
+ (Preferences universalTiles and: [self submorphs size < 2])
+ ifTrue:
+ [WorldState addDeferredUIMessage: [self unhibernate] fixTemps].
+
+ ^ super drawOn: aCanvas!
Item was added:
+ ----- Method: Morph>>jumpTo: (in category '*Etoys-support') -----
+ jumpTo: aPoint
+ "Let my owner decide how I move."
+
+ owner move: self toPosition: aPoint.
+ !
Item was added:
+ ----- Method: Morph>>selectorsForViewerIn: (in category '*Etoys') -----
+ selectorsForViewerIn: aCollection
+ "Answer a list of symbols representing all the selectors available in all my viewer categories, selecting only the ones in aCollection"
+
+ | aClass aList itsAdditions added addBlock |
+ aClass := self renderedMorph class.
+ aList := OrderedCollection new.
+ added := Set new.
+ addBlock := [ :sym |
+ (added includes: sym) ifFalse: [ (aCollection includes: sym)
+ ifTrue: [ added add: sym. aList add: sym ]]].
+
+ [aClass == Morph superclass] whileFalse:
+ [(aClass hasAdditionsToViewerCategories)
+ ifTrue:
+ [itsAdditions := aClass allAdditionsToViewerCategories.
+ itsAdditions do: [ :add | add do: [:aSpec |
+ "the spec list"
+
+ aSpec first == #command ifTrue: [ addBlock value: aSpec second].
+ aSpec first == #slot
+ ifTrue:
+ [ addBlock value: (aSpec seventh).
+ addBlock value: aSpec ninth]]]].
+ aClass := aClass superclass].
+
+ ^aList copyWithoutAll: #(#unused #dummy)
+
+ "SimpleSliderMorph basicNew selectorsForViewerIn:
+ #(setTruncate: getColor setColor: getKnobColor setKnobColor: getWidth setWidth: getHeight setHeight: getDropEnabled setDropEnabled:)
+ "!
Item was added:
+ ----- Method: TileMorph class>>suffixPicture (in category 'class initialization') -----
+ suffixPicture
+ ^ SuffixPicture ifNil:[SuffixPicture := Form
+ extent: 9 at 11
+ depth: 16
+ fromArray: #( 934084608 0 0 0 0 864825164 934150144 0 0 0 862726922 724252557 0 0 0 864824074 722021162 793509888 0 0 864824074 722086666 654977834 864813056 0 864889610 722086666 722085641 722088812 0 864889610 722086698 722086634 646524683 0 864889610 722085610 648686250 858535854 0 864889610 650717866 789264269 0 0 934095595 717894476 0 0 0 13165 931987456 0 0 0)
+ offset: 0 at 0]!
Item was added:
+ ----- Method: Morph>>liftPen (in category '*Etoys') -----
+ liftPen
+ self assuredPlayer liftPen!
Item was added:
+ ----- Method: PasteUpMorph>>trailMorph (in category '*Etoys-pen') -----
+ trailMorph
+ "Yes, you can draw trails on me."
+ ^ self!
Item was added:
+ ----- Method: EtoysPresenter>>stopUp:with: (in category 'stop-step-go buttons') -----
+ stopUp: dummy with: theButton
+ self flushPlayerListCache. "catch guys not in cache but who're running"
+ self stopRunningScripts!
Item was added:
+ ----- Method: Morph>>makeHoldSeparateDataForEachInstance (in category '*Etoys-card in a stack') -----
+ makeHoldSeparateDataForEachInstance
+ "Mark the receiver as holding separate data for each instance (i.e., like a 'background field') and reassess the shape of the corresponding background so that it will be able to accommodate this arrangement."
+
+ self setProperty: #holdsSeparateDataForEachInstance toValue: true.
+ self stack reassessBackgroundShape.!
Item was added:
+ ----- Method: EtoysPresenter>>viewObjectDirectly: (in category 'viewer') -----
+ viewObjectDirectly: anObject
+ "Open up and return a viewer on the given object"
+
+ | aViewer aRect aPoint nominalHeight aFlapTab flapLoc |
+
+ associatedMorph addMorph: (aViewer := self nascentPartsViewerFor: anObject).
+ flapLoc := associatedMorph "world".
+ Preferences viewersInFlaps ifTrue:
+ [aViewer setProperty: #noInteriorThumbnail toValue: true.
+ aViewer initializeFor: anObject barHeight: 0.
+ aViewer enforceTileColorPolicy.
+ flapLoc hideViewerFlapsOtherThanFor: anObject.
+ aFlapTab := flapLoc viewerFlapTabFor: anObject.
+ aFlapTab referent submorphs do:
+ [:m | (m isKindOf: Viewer) ifTrue: [m delete]].
+ aFlapTab referent addMorph: aViewer beSticky.
+ aViewer visible: true.
+ aFlapTab applyThickness: aViewer width + 25.
+ aFlapTab spanWorld.
+ aFlapTab showFlap.
+ aViewer position: aFlapTab referent position.
+ flapLoc startSteppingSubmorphsOf: aFlapTab.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ ^ aFlapTab].
+
+ "Caution: the branch below is historical and has not been used for a long time, though if you set the #viewersInFlaps preference to false you'd hit it. Not at all recently maintained."
+ aViewer initializeFor: anObject barHeight: 6.
+ aViewer enforceTileColorPolicy.
+ Preferences automaticViewerPlacement ifTrue:
+ [aPoint := anObject bounds right @
+ (anObject center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)).
+ aRect := (aPoint extent: (aViewer width @ nominalHeight)) translatedToBeWithin: flapLoc bounds.
+ aViewer position: aRect topLeft.
+ aViewer visible: true.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ "it's already in the world, somewhat coincidentally"
+ ^ aViewer].
+ anObject primaryHand attachMorph: (aViewer visible: true).
+ ^aViewer!
Item was added:
+ ----- 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 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 added:
+ ----- Method: ScriptEditorMorph>>playerScripted (in category 'buttons') -----
+ playerScripted
+ ^ playerScripted!
Item was added:
+ ----- Method: MethodInterface>>initializeFromEToyCommandSpec:category: (in category '*Etoys') -----
+ initializeFromEToyCommandSpec: tuple category: aCategorySymbol
+ "tuple holds an old etoy command-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to hold the same information"
+
+ selector := tuple second.
+ receiverType := #Player.
+ selector numArgs = 1 ifTrue:
+ [argumentVariables := OrderedCollection with:
+ (Variable new name: (Player formalHeaderPartsFor: selector) fourth type: tuple fourth)].
+
+ aCategorySymbol ifNotNil: [self flagAttribute: aCategorySymbol].
+ self
+ wording: (ScriptingSystem wordingForOperator: selector);
+ helpMessage: tuple third!
Item was added:
+ ----- Method: PasteUpMorph>>deleteBackgroundPainting (in category '*Etoys-playfield') -----
+ deleteBackgroundPainting
+ backgroundMorph
+ ifNotNil:
+ [backgroundMorph delete.
+ backgroundMorph := nil]
+ ifNil:
+ [self inform: 'There is presently no
+ background painting
+ to delete.']!
Item was added:
+ ----- Method: Morph>>asEmptyPermanentScriptor (in category '*Etoys-scripting') -----
+ asEmptyPermanentScriptor
+ "Answer a new empty permanent scriptor derived from info deftly secreted in the receiver. Good grief"
+
+ | aScriptor aPlayer |
+ aPlayer := self valueOfProperty: #newPermanentPlayer.
+ aPlayer assureUniClass.
+ aScriptor := aPlayer newScriptorAround: nil.
+ aScriptor position: (self world primaryHand position - (10 @ 10)).
+ aPlayer updateAllViewersAndForceToShow: #scripts.
+ ^ aScriptor!
Item was added:
+ ----- Method: WordArray>>primAddArray:and:into: (in category '*Etoys-arithmetic') -----
+ primAddArray: rcvr and: other into: result
+
+ <primitive: 'primitiveAddArrays' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveAddArrays."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) + (other at: i)
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: Morph>>setAsDefaultValueForNewCard (in category '*Etoys-card in a stack') -----
+ setAsDefaultValueForNewCard
+ "Set the receiver's current value as the one to be used to supply the default value for a variable on a new card. This implementation does not support multiple variables per morph, which is problematical"
+
+ self setProperty: #defaultValue toValue: self currentDataValue deepCopy!
Item was added:
+ ----- Method: EToyVocabulary class>>vocabularySummary (in category 'accessing') -----
+ vocabularySummary
+ "Answer a string describing all the vocabulary defined anywhere in the
+ system."
+ "
+ (StringHolder new contents: EToyVocabulary vocabularySummary)
+ openLabel: 'EToy Vocabulary' translated
+ "
+ | etoyVocab |
+ etoyVocab := Vocabulary eToyVocabulary.
+ etoyVocab initialize. "just to make sure that it's unfiltered."
+ ^ String streamContents: [:s |
+ self morphClassesDeclaringViewerAdditions do: [:cl | | allAdditions |
+ s nextPutAll: cl name; cr.
+ allAdditions := cl allAdditionsToViewerCategories.
+ cl unfilteredCategoriesForViewer do: [ :cat |
+ allAdditions at: cat ifPresent: [ :additions | | interfaces |
+ interfaces := ((etoyVocab categoryAt: cat) ifNil: [ ElementCategory new ]) elementsInOrder.
+ interfaces := interfaces
+ select: [:ea | additions
+ anySatisfy: [:tuple | (tuple first = #slot
+ ifTrue: [tuple at: 7]
+ ifFalse: [tuple at: 2])
+ = ea selector]].
+ s tab; nextPutAll: cat translated; cr.
+ interfaces
+ do: [:if | | rt |
+ s tab: 2.
+ rt := if resultType.
+ rt = #unknown
+ ifTrue: [s nextPutAll: 'command' translated]
+ ifFalse: [s nextPutAll: 'property' translated;
+ nextPut: $(;
+ nextPutAll: (if companionSetterSelector
+ ifNil: ['RO']
+ ifNotNil: ['RW']) translated;
+ space;
+ nextPutAll: rt translated;
+ nextPutAll: ') '].
+ s tab; print: if wording; space.
+ if argumentVariables
+ do: [:av | s nextPutAll: av variableName;
+ nextPut: $(;
+ nextPutAll: av variableType asString;
+ nextPut: $)]
+ separatedBy: [s space].
+ s tab; nextPutAll: if helpMessage; cr]]]]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>chooseTrigger (in category 'buttons') -----
+ chooseTrigger
+ "NB; the keyStroke branch commented out temporarily until keystrokes can actually be passed along to the user's scripting code"
+
+ self presentScriptStatusPopUp!
Item was added:
+ ----- Method: PasteUpMorph>>toggleOriginAtCenter (in category '*Etoys-viewing') -----
+ toggleOriginAtCenter
+ | hasIt |
+ hasIt := self hasProperty: #originAtCenter.
+ hasIt
+ ifTrue:
+ [self removeProperty: #originAtCenter]
+ ifFalse:
+ [self setProperty: #originAtCenter toValue: true]!
Item was added:
+ ----- Method: Morph class>>additionToViewerCategorySelectors (in category '*Etoys') -----
+ additionToViewerCategorySelectors
+ "Answer the list of my selectors matching additionsToViewerCategory*"
+ ^self class organization allMethodSelectors select: [ :ea |
+ (ea beginsWith: 'additionsToViewerCategory')
+ and: [ (ea at: 26 ifAbsent: []) ~= $: ]]!
Item was added:
+ ----- Method: WordArray>>primAddScalar:and:into: (in category '*Etoys-arithmetic') -----
+ primAddScalar: rcvr and: other into: result
+
+ <primitive: 'primitiveAddScalar' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveAddScalar."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) + other.
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>handUserTileForSelf (in category 'other') -----
+ handUserTileForSelf
+ "Hand the user a tile representing the player who is current the 'self' of this script"
+
+ playerScripted tileToRefer openInHand!
Item was added:
+ ----- Method: PasteUpMorph>>viewNonOverlapping (in category '*Etoys-viewing') -----
+ viewNonOverlapping
+ "Make the receiver show its contents as full-size morphs laid out left-to-right and top-to-bottom to be non-overlapping."
+
+ self viewingNormally ifTrue:
+ [self saveBoundsOfSubmorphs].
+ self showingListView ifTrue:
+ [self viewByIcon.
+ self removeProperty: #showingListView].
+ self autoLineLayout: true.!
Item was added:
+ ----- Method: ScriptEditorMorph>>isCandidateForAutomaticViewing (in category 'e-toy support') -----
+ isCandidateForAutomaticViewing
+ ^ false!
Item was added:
+ ----- 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 = (Utilities getterSelectorFor: oldSlotName)) ifTrue:
+ [tile setOperator: (Utilities getterSelectorFor: newSlotName)]].
+ tile traverseRowTranslateSlotOld: oldSlotName to: newSlotName]!
Item was added:
+ ----- Method: ScriptEditorMorph>>addDestroyButtonTo: (in category 'buttons') -----
+ addDestroyButtonTo: aRowMorph
+ "Add the destroiy button at the end of the header provided"
+
+ | aButton |
+ aButton := self pinkXButton.
+ aRowMorph addMorphBack: aButton.
+ aButton actionSelector: #destroyScript;
+ setBalloonText: 'Destroy this script
+ (CAUTION!!!!)' translated.
+ ^ aRowMorph!
Item was added:
+ ----- Method: ScriptEditorMorph>>ceaseHavingAParameter (in category 'other') -----
+ ceaseHavingAParameter
+ "Cease having a parameter"
+
+ playerScripted ceaseHavingAParameterFor: scriptName!
Item was added:
+ ----- Method: ScriptEditorMorph>>userScriptObject (in category 'other') -----
+ userScriptObject
+ "Answer the user-script object associated with the receiver"
+
+ | aPlayerScripted topEd |
+ aPlayerScripted := (topEd := self topEditor) playerScripted.
+ ^ aPlayerScripted class userScriptForPlayer: aPlayerScripted selector: topEd scriptName !
Item was added:
+ ----- Method: ScriptEditorMorph>>adaptToWorld: (in category 'e-toy support') -----
+ adaptToWorld: aWorld
+
+ self unhibernate "for universal tiles"!
Item was added:
+ ----- Method: Morph>>lowerPen (in category '*Etoys') -----
+ lowerPen
+ self assuredPlayer lowerPen!
Item was added:
+ ----- Method: PasteUpMorph>>toggleAutomaticPhraseExpansion (in category '*Etoys-viewing') -----
+ toggleAutomaticPhraseExpansion
+ | expand |
+ expand := self hasProperty: #automaticPhraseExpansion.
+ expand
+ ifTrue:
+ [self removeProperty: #automaticPhraseExpansion]
+ ifFalse:
+ [self setProperty: #automaticPhraseExpansion toValue: true]!
Item was added:
+ ----- Method: EtoysPresenter>>typeForConstant: (in category 'tile support') -----
+ typeForConstant: anObject
+ ^ anObject basicType!
Item was added:
+ ----- Method: ScriptEditorMorph>>hasScriptInvoking:ofPlayer: (in category 'other') -----
+ hasScriptInvoking: aScriptName ofPlayer: aPlayer
+ "Answer whether the receiver has any tiles in it which invoke the given script of the given player. Place-holder for now, needs to be implemented"
+ ^ false!
Item was added:
+ ----- Method: KedamaMorph>>isKedamaMorph (in category 'accessing') -----
+ isKedamaMorph
+ ^true!
Item was added:
+ ----- Method: Morph>>penUpWhile: (in category '*Etoys') -----
+ penUpWhile: changeBlock
+ "Suppress any possible pen trail during the execution of changeBlock"
+ self getPenDown
+ ifTrue: ["If this is a costume for a player with its pen down, suppress any line."
+ self liftPen.
+ changeBlock value.
+ self lowerPen]
+ ifFalse: ["But usually, just do it."
+ changeBlock value]!
Item was added:
+ ----- Method: EtoysPresenter>>stopButtonState: (in category 'stop-step-go buttons') -----
+ stopButtonState: newState
+ "Get all stop buttons in my scope to show the correct state"
+
+ self allStopButtons do:
+ [:aButton | aButton state: newState]!
Item was added:
+ ----- Method: ScriptEditorMorph>>resetHandWithTile (in category 'caching') -----
+ resetHandWithTile
+ "Set the handWithTile back to nil, in case it somehow got to be nonnil"
+
+ handWithTile := nil!
Item was added:
+ ----- Method: Morph>>insertCard (in category '*Etoys-card in a stack') -----
+ insertCard
+ "Insert a new card in the stack, with the receiver as its background, and have it become the current card of the stack"
+
+ self stackDo: [:aStack | aStack insertCardOfBackground: self]!
Item was added:
+ ----- Method: Morph>>trailMorph (in category '*Etoys') -----
+ trailMorph
+ "You can't draw trails on me, but try my owner."
+
+ owner isNil ifTrue: [^nil].
+ ^owner trailMorph!
Item was added:
+ ----- Method: Morph>>getCharacters (in category '*Etoys-support') -----
+ getCharacters
+ "obtain a string value from the receiver. The default generic response is simply the name of the object."
+
+ ^ self externalName!
Item was added:
+ ----- Method: EtoysPresenter>>allPlayersWithUniclasses (in category 'playerList') -----
+ allPlayersWithUniclasses
+ "Answer a list of all players known to the receiver that have uniclasses"
+
+ ^ self allExtantPlayers select: [:p | p belongsToUniClass]!
Item was added:
+ ----- Method: ScriptEditorMorph>>mouseLeave: (in category 'event handling') -----
+ mouseLeave: evt
+ owner ifNil: [^ self]. "left by being removed, not by mouse movement"
+ (self hasProperty: #justPickedUpPhrase) ifTrue:[
+ self removeProperty: #justPickedUpPhrase.
+ ^self].
+ self stopSteppingSelector: #trackDropZones.
+ handWithTile := nil.
+ self removeSpaces.!
Item was added:
+ ----- Method: ScriptEditorMorph>>createThreadShowing (in category 'menu commands') -----
+ createThreadShowing
+
+ | vertices |
+ self deleteThreadShowing.
+ vertices := OrderedCollection new.
+ self tileRows do: [:row | | b |
+ row first isTurtleRow ifTrue: [
+ b := row first bounds.
+ vertices add: ((b topLeft + (4 at 0)) + ((0 * 0.1 * b width)@0)).
+ 0 to: 9 do: [:i |
+ vertices add: ((b topLeft + (4 at 4))+ ((i * 0.1 * b width )@0)).
+ vertices add: ((b bottomLeft + (4 at -4)) + ((i * 0.1 * b width)@0)).
+ ].
+ vertices add: ((b bottomLeft + (4 at 0)) + ((9 * 0.1 * b width)@0)).
+ ] ifFalse: [
+ b := row first bounds.
+ vertices add: ((b origin x + b corner x)//2)@(b origin y).
+ vertices add: ((b origin x + b corner x)//2)@(b origin y + 4).
+ vertices add: ((b origin x + b corner x)//2)@(b corner y - 4).
+ vertices add: ((b origin x + b corner x)//2)@(b corner y).
+ ].
+ ].
+ threadPolygon := PolygonMorph vertices: vertices color: Color black borderWidth: 2 borderColor: Color black.
+ threadPolygon makeOpen.
+ threadPolygon openInWorld.
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>bringUpToDate (in category 'scripting') -----
+ bringUpToDate
+ "Make certain that the player name in my header is up to date. Names emblazoned on submorphs of mine are handled separately by direct calls to their #bringUpToDate methods -- the responsibility here is strictly for the name in the header."
+
+ | currentName |
+ playerScripted ifNil:
+ ["likely a naked test/yes/no fragment!!"
+
+ ^self].
+ currentName := playerScripted externalName.
+ submorphs isEmpty ifTrue: [^self].
+ (self firstSubmorph findDeepSubmorphThat: [:m | m knownName = 'title']
+ ifAbsent: [^self]) label: currentName font: ScriptingSystem fontForTiles!
Item was added:
+ ----- Method: EToyVocabulary>>initialize (in category 'initialization') -----
+ initialize
+ "Initialize the receiver (automatically called when instances are created via 'new')"
+
+ | classes categorySymbols |
+ super initialize.
+ self vocabularyName: #eToy.
+ self documentation: '"EToy" is a vocabulary that provides the equivalent of the 1997-2000 etoy prototype'.
+ categorySymbols := Set new.
+ classes := self class morphClassesDeclaringViewerAdditions.
+ classes do:
+ [:aMorphClass | categorySymbols addAll: aMorphClass unfilteredCategoriesForViewer].
+ self addCustomCategoriesTo: categorySymbols. "For benefit, e.g., of EToyVectorVocabulary"
+
+ categorySymbols asOrderedCollection do:
+ [:aCategorySymbol | | selectors aMethodCategory |
+ aMethodCategory := ElementCategory new categoryName: aCategorySymbol.
+ selectors := Set new.
+ classes do:
+ [:aMorphClass |
+ (aMorphClass additionsToViewerCategory: aCategorySymbol) do:
+ [:anElement | | selector aMethodInterface |
+ aMethodInterface := self methodInterfaceFrom: anElement.
+ selectors add: (selector := aMethodInterface selector).
+ (methodInterfaces includesKey: selector) ifFalse:
+ [methodInterfaces at: selector put: aMethodInterface].
+ self flag: #deferred.
+ "NB at present, the *setter* does not get its own method interface. Need to revisit"].
+
+ (selectors copyWithout: #unused) asSortedArray do:
+ [:aSelector |
+ aMethodCategory elementAt: aSelector put: (methodInterfaces at: aSelector)]].
+
+ self addCategory: aMethodCategory].
+
+ self addCategoryNamed: ScriptingSystem nameForInstanceVariablesCategory.
+ self addCategoryNamed: ScriptingSystem nameForScriptsCategory.
+ self setCategoryDocumentationStrings.
+ (self respondsTo: #applyMasterOrdering)
+ ifTrue: [ self applyMasterOrdering ].!
Item was added:
+ ----- Method: JoystickMorph class>>additionsToViewerCategories (in category '*eToys-scripting') -----
+ additionsToViewerCategories
+ "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."
+
+ ^ #((joystick (
+ (slot amount 'The amount of displacement' Number readOnly Player getAmount unused unused)
+ (slot angle 'The angular displacement' Number readOnly Player getAngle unused unused)
+ (slot leftRight 'The horizontal displacement' Number readOnly Player getLeftRight unused unused)
+ (slot upDown 'The vertical displacement' Number readOnly Player getUpDown unused unused)
+ (slot button1 'Button 1 pressed' Boolean readOnly Player getButton1 unused unused)
+ (slot button2 'Button 2 pressed' Boolean readOnly Player getButton2 unused unused)
+ )))
+
+
+ !
Item was added:
+ ----- Method: PasteUpMorph>>scriptorForTextualScript:ofPlayer: (in category '*eToys-support') -----
+ scriptorForTextualScript: aSelector ofPlayer: aPlayer
+ | aScriptor |
+ self world ifNil: [^ nil].
+ aScriptor := ScriptEditorMorph new setMorph: aPlayer costume scriptName: aSelector.
+ aScriptor position: (self primaryHand position - (10 @ 10)).
+ ^ aScriptor!
Item was added:
+ ----- Method: EToyVocabulary class>>masterOrderingOfCategorySymbols (in category 'accessing') -----
+ masterOrderingOfCategorySymbols
+ "Answer a dictatorially-imposed presentation list of category symbols.
+ This governs the order in which available vocabulary categories are presented in etoy viewers using the etoy vocabulary.
+ The default implementation is that any items that are in this list will occur first, in the order specified here; after that, all other items will come, in alphabetic order by their translated wording."
+
+ ^#(basic #'color & border' geometry motion #'pen use' tests layout #'drag & drop' scripting observation button search miscellaneous)!
Item was added:
+ ----- Method: Morph>>actorState (in category '*Etoys') -----
+ actorState
+ "This method instantiates actorState as a side-effect.
+ For simple queries, use actorStateOrNil"
+ | state |
+ state := self actorStateOrNil.
+ state ifNil:
+ [state := ActorState new initializeFor: self assuredPlayer.
+ self actorState: state].
+ ^ state!
Item was added:
+ ----- Method: Morph>>scriptPerformer (in category '*Etoys') -----
+ scriptPerformer
+ ^ self topRendererOrSelf player ifNil: [self]!
Item was added:
+ ----- Method: SyntaxMorph class>>clearAllSpecs (in category 'accessing') -----
+ clearAllSpecs
+ "Clear the specs that the Viewer knows about."
+ "SyntaxMorph clearAllSpecs"
+
+ AllSpecs := nil.!
Item was added:
+ ----- Method: Morph>>creationStamp (in category '*Etoys-support') -----
+ creationStamp
+ "Answer the creation stamp stored within the receiver, if any"
+
+ ^ self valueOfProperty: #creationStamp ifAbsent: [super creationStamp]!
Item was added:
+ ----- Method: PasteUpMorph>>updateSubmorphThumbnails (in category '*Etoys-viewing') -----
+ updateSubmorphThumbnails
+ | thumbsUp heightForThumbnails maxHeightToAvoidThumbnailing maxWidthForThumbnails |
+ thumbsUp := self alwaysShowThumbnail.
+ heightForThumbnails := self heightForThumbnails.
+ maxHeightToAvoidThumbnailing := self maxHeightToAvoidThumbnailing.
+ maxWidthForThumbnails := self maximumThumbnailWidth.
+ self submorphs do:
+ [:aMorph | | itsThumbnail |
+ thumbsUp
+ ifTrue:
+ [itsThumbnail := aMorph representativeNoTallerThan: maxHeightToAvoidThumbnailing norWiderThan: maxWidthForThumbnails thumbnailHeight: heightForThumbnails.
+ (aMorph == itsThumbnail)
+ ifFalse:
+ [self replaceSubmorph: aMorph by: itsThumbnail]]
+ ifFalse:
+ [(aMorph isKindOf: MorphThumbnail)
+ ifTrue:
+ [self replaceSubmorph: aMorph by: aMorph morphRepresented]]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>tearOfButtonToFireScript (in category 'other') -----
+ tearOfButtonToFireScript
+ "Tear off a button to fire this script"
+
+ playerScripted tearOffButtonToFireScriptForSelector: scriptName!
Item was added:
+ ----- Method: ScriptEditorMorph>>scriptEdited (in category 'private') -----
+ scriptEdited
+
+ | anEditor |
+ (anEditor := self topEditor) ifNotNil: [anEditor recompileScript]!
Item was added:
+ ----- Method: ScriptEditorMorph>>typeInFrequency (in category 'frequency') -----
+ typeInFrequency
+ | reply aNumber |
+ reply := UIManager default request: 'Number of firings per tick: ' translated initialAnswer: self scriptInstantiation frequency printString.
+
+ reply ifNotNil:
+ [aNumber := reply asNumber.
+ aNumber > 0 ifTrue:
+ [self setFrequencyTo: aNumber]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>updateStatusMorph: (in category 'buttons') -----
+ updateStatusMorph: statusMorph
+ "My status button may need to reflect an externally-induced change in status"
+
+ (playerScripted existingScriptInstantiationForSelector: scriptName) ifNotNil:
+ [:scriptInstantiation |
+ scriptInstantiation updateStatusMorph: statusMorph]!
Item was added:
+ ----- Method: Morph>>moveWithPenDownBy: (in category '*Etoys') -----
+ moveWithPenDownBy: delta
+ "If this is a costume for a player with its pen down, draw a line."
+
+ | trailMorph tfm start tfmEnd |
+ (trailMorph := self trailMorph) ifNotNil:
+ [tfm := self owner transformFrom: trailMorph.
+ start := self referencePosition.
+ trailMorph batchPenTrails
+ ifTrue: [trailMorph notePenDown: true
+ forPlayer: self player
+ at: (tfm localPointToGlobal: start)]
+ ifFalse: [trailMorph drawPenTrailFor: self
+ from: (tfm localPointToGlobal: start)
+ to: (tfmEnd := tfm localPointToGlobal: start + delta).
+ trailMorph noteNewLocation: tfmEnd forPlayer: self player]]
+ !
Item was added:
+ ----- Method: Player>>hasAnyBorderedCostumes (in category 'testing') -----
+ hasAnyBorderedCostumes
+ "Answer true if any costumes of the receiver are BorderedMorph descendents"
+
+ self costumesDo:
+ [:cost | (cost understandsBorderVocabulary) ifTrue: [^ true]].
+ ^ false!
Item was added:
+ ----- Method: EtoysPresenter>>startRunningScriptsFrom: (in category 'stop-step-go buttons') -----
+ startRunningScriptsFrom: ignored
+ "Start running all scripts. Get all script-control buttons to show the right thing."
+
+ self startRunningScripts!
Item was added:
+ ----- Method: PasteUpMorph>>impartPrivatePresenter (in category '*Etoys-playfield') -----
+ impartPrivatePresenter
+ presenter ifNil:
+ [presenter := EtoysPresenter new associatedMorph: self.
+ presenter standardPlayer]!
Item was added:
+ ----- Method: Morph>>bringTileScriptingElementsUpToDate (in category '*Etoys-scripting') -----
+ bringTileScriptingElementsUpToDate
+ "Send #bringUpToDate to every tile-scripting element of the receiver, including possibly the receiver itself"
+
+ (self allMorphs select: [:s | s isTileScriptingElement]) do:
+ [:el | el bringUpToDate]!
Item was added:
+ ----- Method: Morph class>>helpContributions (in category '*eToys-scripting') -----
+ helpContributions
+ "Answer a list of pairs of the form (<symbol> <help message> ) to contribute to the system help dictionary"
+
+ "NB: Many of the items here are not needed any more since they're specified as part of command definitions now. Someone needs to take the time to go through the list and remove items no longer needed. But who's got that kind of time?"
+
+ ^ #(
+ (acceptScript:for:
+ 'submit the contents of the given script editor as the code defining the given selector')
+ (actorState
+ 'return the ActorState object for the receiver, creating it if necessary')
+ (addInstanceVariable
+ 'start the interaction for adding a new variable to the object')
+ (addPlayerMenuItemsTo:hand:
+ 'add player-specific menu items to the given menu, on behalf of the given hand. At present, these are only commands relating to the turtle')
+ (addYesNoToHand
+ 'Press here to tear off a TEST/YES/NO unit which you can drop into your script')
+ (allScriptEditors
+ 'answer a list off the extant ScriptEditors for the receiver')
+ (amount
+ 'The amount of displacement')
+ (angle
+ 'The angular displacement')
+ (anonymousScriptEditorFor:
+ 'answer a new ScriptEditor object to serve as the place for scripting an anonymous (unnamed, unsaved) script for the receiver')
+ (append:
+ 'add an object to this container')
+ (prepend:
+ 'add an object to this container')
+ (assignDecrGetter:setter:amt:
+ 'evaluate the decrement variant of assignment')
+ (assignGetter:setter:amt:
+ 'evaluate the vanilla variant of assignment')
+ (assignIncrGetter:setter:amt:
+ 'evalute the increment version of assignment')
+ (assignMultGetter:setter:amt:
+ 'evaluate the multiplicative version of assignment')
+ (assureEventHandlerRepresentsStatus
+ 'make certain that the event handler associated with my current costume is set up to conform to my current script-status')
+ (assureExternalName
+ 'If I do not currently have an external name assigned, get one now')
+ (assureUniClass
+ 'make certain that I am a member a uniclass (i.e. a unique subclass); if I am not, create one now and become me into an instance of it')
+ (availableCostumeNames
+ 'answer a list of strings representing the names of all costumes currently available for me')
+ (availableCostumesForArrows
+ 'answer a list of actual, instantiated costumes for me, which can be cycled through as the user hits a next-costume or previous-costume button in a viewer')
+ (beep:
+ 'make the specified sound')
+ (borderColor
+ 'The color of the object''s border')
+ (borderWidth
+ 'The width of the object''s border')
+ (bottom
+ 'My bottom edge, measured downward from the top edge of the world')
+ (bounce:
+ 'If object strayed beyond the boundaries of its container, make it reflect back into it, making the specified noise while doing so.')
+ (bounce
+ 'If object strayed beyond the boundaries of its container, make it reflect back into it')
+ (chooseTrigger
+ 'When this script should run.
+ "normal" means "only when called"')
+ (clearTurtleTrails
+ 'Clear all the pen trails in the interior.')
+ (clearOwnersPenTrails
+ 'Clear all the pen trails in my container.')
+ (color
+ 'The object''s interior color')
+ (colorSees
+ 'Whether a given color in the object is over another given color')
+ (colorUnder
+ 'The color under the center of the object')
+ (copy
+ 'Return a new object that is very much like this one')
+ (cursor
+ 'The index of the chosen element')
+ (deleteCard
+ 'Delete the current card.')
+ (dismiss
+ 'Click here to dismiss me')
+ (doMenuItem:
+ 'Do a menu item, the same way as if it were chosen manually')
+ (doScript:
+ 'Perform the given script once, on the next tick.')
+ (elementNumber
+ 'My element number as seen by my owner')
+ (fire
+ 'Run any and all button-firing scripts of this object')
+ (firstPage
+ 'Go to first page of book')
+ (followPath
+ 'Retrace the path the object has memorized, if any.')
+ (forward:
+ 'Moves the object forward in the direction it is heading')
+ (goto:
+ 'Go to the specfied book page')
+ (goToNextCardInStack
+ 'Go to the next card')
+ (goToPreviousCardInStack
+ 'Go to the previous card.')
+ (goToRightOf:
+ 'Align the object just to the right of any specified object.')
+ (heading
+ 'Which direction the object is facing. 0 is straight up')
+ (height
+ 'The distance between the top and bottom edges of the object')
+ (hide
+ 'Make the object so that it does not display and cannot handle input')
+ (initiatePainting
+ 'Initiate painting of a new object in the standard playfield.')
+ (initiatePaintingIn:
+ 'Initiate painting of a new object in the given place.')
+ (isOverColor
+ 'Whether any part of this object is directly over the specified color')
+ (isUnderMouse
+ 'Whether any part of this object is beneath the current mouse-cursor position')
+ (lastPage
+ 'Go to the last page of the book.')
+ (left
+ 'My left edge, measured from the left edge of the World')
+ (leftRight
+ 'The horizontal displacement')
+ (liftAllPens
+ 'Lift the pens on all the objects in my interior.')
+ (lowerAllPens
+ 'Lower the pens on all the objects in my interior.')
+ (mouseX
+ 'The x coordinate of the mouse pointer')
+ (mouseY
+ 'The y coordinate of the mouse pointer')
+ (moveToward:
+ 'Move in the direction of another object.')
+ (insertCard
+ 'Create a new card.')
+ (nextPage
+ 'Go to next page.')
+ (numberAtCursor
+ 'The number held by the object at the chosen element')
+ (objectNameInHalo
+ 'Object''s name -- To change: click here, edit, hit ENTER')
+ (obtrudes
+ 'Whether any part of the object sticks out beyond its container''s borders')
+ (offerScriptorMenu
+ 'The Scriptee.
+ Press here to get a menu')
+ (pauseScript:
+ 'Make a running script become paused.')
+ (penDown
+ 'Whether the object''s pen is down (true) or up (false)')
+ (penColor
+ 'The color of the object''s pen')
+ (penSize
+ 'The size of the object''s pen')
+ (clearPenTrails
+ 'Clear all pen trails in the current playfield')
+ (playerSeeingColorPhrase
+ 'The player who "sees" a given color')
+ (previousPage
+ 'Go to previous page')
+
+ (show
+ 'If object was hidden, make it show itself again.')
+ (startScript:
+ 'Make a script start running.')
+ (stopScript:
+ 'Make a script stop running.')
+ (top
+ 'My top edge, measured downward from the top edge of the world')
+ (right
+ 'My right edge, measured from the left edge of the world')
+ (roundUpStrays
+ 'Bring all out-of-container subparts back into view.')
+ (scaleFactor
+ 'The amount by which the object is scaled')
+ (stopScript:
+ 'make the specified script stop running')
+ (tellAllSiblings:
+ 'send a message to all of my sibling instances')
+ (try
+ 'Run this command once.')
+ (tryMe
+ 'Click here to run this script once; hold button down to run repeatedly')
+ (turn:
+ 'Change the heading of the object by the specified amount')
+ (unhideHiddenObjects
+ 'Unhide all hidden objects.')
+ (upDown
+ 'The vertical displacement')
+ (userScript
+ 'This is a script defined by you.')
+ (userSlot
+ 'This is a variable defined by you. Click here to change its type')
+ (valueAtCursor
+ 'The chosen element')
+ (wearCostumeOf:
+ 'Wear the same kind of costume as the other object')
+ (width
+ 'The distance between the left and right edges of the object')
+ (wrap
+ 'If object has strayed beond the boundaries of its container, make it reappear from the opposite edge.')
+ (x
+ 'The x coordinate, measured from the left of the container')
+ (y
+ 'The y-coordinate, measured upward from the bottom of the container')
+
+ )
+ !
Item was added:
+ ----- Method: PasteUpMorph>>viewBySize (in category '*Etoys-viewing') -----
+ viewBySize
+ "Make the receiver show its subparts as a vertical list of lines of information, sorted by object size"
+
+ self imposeListViewSortingBy: #reportableSize retrieving: #(externalName reportableSize className oopString)!
Item was added:
+ ----- Method: EtoysPresenter>>morph:droppedIntoPasteUpMorph: (in category 'misc') -----
+ morph: aMorph droppedIntoPasteUpMorph: aPasteUpMorph
+ aPasteUpMorph automaticViewing ifTrue:
+ [aMorph isCandidateForAutomaticViewing ifTrue:
+ [self viewMorph: aMorph]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>hibernate (in category 'other') -----
+ hibernate
+ "Possibly delete the tiles, but only if using universal tiles."
+
+ | tw |
+ Preferences universalTiles ifFalse: [^self].
+ (tw := self findA: TwoWayScrollPane) isNil
+ ifFalse:
+ [self setProperty: #sizeAtHibernate toValue: self extent. "+ tw xScrollerHeight"
+ submorphs size > 1 ifTrue: [tw delete]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>stepTime (in category 'testing') -----
+ stepTime
+
+ ^ 0!
Item was added:
+ ----- Method: TileMorph class>>retractPicture (in category 'class initialization') -----
+ retractPicture
+ ^ RetractPicture ifNil:[RetractPicture := Form
+ extent: 9 at 11
+ depth: 16
+ fromArray: #( 0 0 0 0 934084608 0 0 0 934162252 864813056 0 0 14221 724249354 862715904 0 0 793520938 722021130 864813056 0 864824106 654977802 722086666 864813056 13164 722085641 722086666 722086666 864878592 12043 646523626 722086698 722086666 864878592 14254 858532522 648685290 722086666 864878592 0 14221 789260970 650717962 864878592 0 0 13132 717892331 934084608 0 0 0 932000621 0)
+ offset: 8 at 0]!
Item was added:
+ AlignmentMorph subclass: #ScriptEditorMorph
+ instanceVariableNames: 'scriptName firstTileRow timeStamp playerScripted handWithTile showingMethodPane threadPolygon'
+ classVariableNames: 'WritingUniversalTiles'
+ poolDictionaries: ''
+ category: 'Etoys-Scripting'!
+
+ !ScriptEditorMorph commentStamp: '<historical>' prior: 0!
+ Presents an EToy script to the user on the screen. Has in it:
+
+ a Morph with the controls for the script.
+ a Morph with the tiles. Either PhraseMorphs and TileMorphs,
+ or a TwoWayScroller with SyntaxMorphs in it.
+
+ WritingUniversalTiles -- only vlaid while a project is being written out.
+ True if using UniversalTiles in that project.!
Item was added:
+ ----- Method: Morph>>addPlayerItemsTo: (in category '*Etoys') -----
+ addPlayerItemsTo: aMenu
+ "Add player-related items to the menu if appropriate"
+
+ | aPlayer subMenu |
+ self couldMakeSibling ifFalse: [^ self].
+ aPlayer := self topRendererOrSelf player.
+ subMenu := MenuMorph new defaultTarget: self.
+ subMenu add: 'make a sibling instance' translated target: self action: #makeNewPlayerInstance:.
+ subMenu balloonTextForLastItem: 'Makes another morph whose player is of the same class as this one. Both siblings will share the same scripts' translated.
+
+ subMenu add: 'make multiple siblings...' translated target: self action: #makeMultipleSiblings:.
+ subMenu balloonTextForLastItem: 'Make any number of sibling instances all at once' translated.
+
+ (aPlayer belongsToUniClass and: [aPlayer class instanceCount > 1]) ifTrue:
+ [subMenu addLine.
+ subMenu add: 'make all siblings look like me' translated target: self action: #makeSiblingsLookLikeMe:.
+ subMenu balloonTextForLastItem: 'make all my sibling instances look like me.' translated.
+
+ subMenu add: 'bring all siblings to my location' translated target: self action: #bringAllSiblingsToMe:.
+ subMenu balloonTextForLastItem: 'find all sibling instances and bring them to me' translated.
+
+ subMenu add: 'apply status to all siblngs' translated target: self action: #applyStatusToAllSiblings:.
+ subMenu balloonTextForLastItem: 'apply the current status of all of my scripts to the scripts of all my siblings' translated].
+
+ subMenu add: 'indicate all siblings' translated target: self action: #indicateAllSiblings.
+ subMenu balloonTextForLastItem: 'momentarily show, by flashing , all of my visible siblings.'.
+
+ aMenu add: 'siblings...' translated subMenu: subMenu
+
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>reinsertSavedTiles: (in category 'other') -----
+ reinsertSavedTiles: savedTiles
+ "Revert the scriptor to show the saved tiles"
+
+ self submorphs doWithIndex: [:m :i | i > 1 ifTrue: [m delete]].
+ self addAllMorphs: savedTiles.
+ self allMorphsDo: [:m | m isTileScriptingElement ifTrue: [m bringUpToDate]].
+ self install.
+ self showingMethodPane: false!
Item was added:
+ ----- Method: StandardScriptingSystem class>>noteAddedSelector:meta: (in category '*Etoys') -----
+ noteAddedSelector: aSelector meta: isMeta
+ [aSelector == #wordingForOperator: ifTrue:
+ [Vocabulary changeMadeToViewerAdditions]] on: Error do:[].
+ super noteAddedSelector: aSelector meta: isMeta!
Item was added:
+ ----- Method: Object>>uniqueInstanceVariableNameLike:excluding: (in category '*Etoys-viewer') -----
+ uniqueInstanceVariableNameLike: aString excluding: takenNames
+ "Answer a nice instance-variable name to be added to the receiver which resembles aString, making sure it does not coincide with any element in takenNames"
+
+ | okBase uniqueName usedNames |
+ usedNames := self class allInstVarNamesEverywhere.
+ usedNames removeAllFoundIn: self class instVarNames.
+ usedNames addAll: takenNames.
+ okBase := Scanner wellFormedInstanceVariableNameFrom: aString.
+
+ uniqueName := Utilities keyLike: okBase satisfying:
+ [:aKey | (usedNames includes: aKey) not].
+
+ ^ uniqueName!
Item was added:
+ ----- Method: Morph>>followPath (in category '*Etoys-support') -----
+ followPath
+ | pathPoints offset |
+ (pathPoints := self renderedMorph valueOfProperty: #pathPoints) ifNil: [^ Beeper beep].
+ offset := owner position - (self extent // 2).
+ pathPoints do:
+ [:aPoint |
+ self position: aPoint + offset.
+ self world displayWorld.
+ (Delay forMilliseconds: 20) wait]!
Item was added:
+ ----- Method: PasteUpMorph>>toggleFenceEnabled (in category '*Etoys-viewing') -----
+ toggleFenceEnabled
+
+ self fenceEnabled: self fenceEnabled not!
Item was added:
+ ----- Method: ScriptEditorMorph class>>writingUniversalTiles (in category 'instance creation') -----
+ writingUniversalTiles
+ "Only valid during the write of a Project."
+
+ ^ WritingUniversalTiles!
Item was added:
+ ----- Method: Morph>>accumlatePlayersInto:andSelectorsInto: (in category '*Etoys') -----
+ accumlatePlayersInto: aCollection andSelectorsInto: selectorsCollection
+
+ submorphs do: [:tile |
+ (tile isMemberOf: TileMorph) ifTrue: [
+ (tile type = #objRef and: [tile actualObject isKindOf: Player]) ifTrue: [
+ aCollection add: tile actualObject
+ ]
+ ].
+ (tile isKindOf: AssignmentTileMorph) ifTrue: [
+ (tile type = #operator) ifTrue: [
+ selectorsCollection add: tile operatorOrExpression
+ ]
+ ].
+ tile accumlatePlayersInto: aCollection andSelectorsInto: selectorsCollection
+ ].
+ !
Item was added:
+ ----- Method: Morph>>showDesignationsOfObjects (in category '*Etoys-card in a stack') -----
+ showDesignationsOfObjects
+ "Momentarily show the designations of objects on the receiver"
+
+ | colorToUse |
+ self isStackBackground ifFalse: [^self].
+ self submorphsDo:
+ [:aMorph | | aLabel |
+ aLabel :=aMorph renderedMorph holdsSeparateDataForEachInstance
+ ifTrue:
+ [colorToUse := Color orange.
+ aMorph externalName]
+ ifFalse:
+ [colorToUse := aMorph isShared ifFalse: [Color red] ifTrue: [Color green].
+ nil].
+ Display
+ border: (aMorph fullBoundsInWorld insetBy: -6)
+ width: 6
+ rule: Form over
+ fillColor: colorToUse.
+ aLabel ifNotNil:
+ [aLabel asString
+ displayOn: Display
+ at: aMorph fullBoundsInWorld bottomLeft + (0 @ 5)
+ textColor: Color blue]].
+ Sensor anyButtonPressed
+ ifTrue: [Sensor waitNoButton]
+ ifFalse: [Sensor waitButton].
+ World fullRepaintNeeded!
Item was added:
+ ----- Method: ScriptEditorMorph>>prepareToUndoDropOf: (in category 'dropping/grabbing') -----
+ prepareToUndoDropOf: aMorph
+ "No longer functional"!
Item was added:
+ ----- Method: Morph>>listViewLineForFieldList: (in category '*Etoys-support') -----
+ listViewLineForFieldList: aFieldList
+ "Answer a ListLineView object which describes the receiver"
+
+ | aLine |
+ aLine := ListViewLine new objectRepresented: self.
+ aFieldList do:
+ [:fieldSym | aLine addMorphBack: (self readoutForField: fieldSym).
+ aLine addTransparentSpacerOfSize: (7 @ 0)].
+ ^ aLine!
Item was added:
+ ----- Method: CompoundTileMorph>>isCompoundTileMorph (in category 'testing') -----
+ isCompoundTileMorph
+ ^true!
Item was added:
+ ----- Method: Object>>usableMethodInterfacesIn: (in category '*Etoys-viewer') -----
+ usableMethodInterfacesIn: aListOfMethodInterfaces
+ "Filter aList, returning a subset list of apt phrases"
+
+ ^ aListOfMethodInterfaces
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>assureParameterTilesValid (in category 'dropping/grabbing') -----
+ assureParameterTilesValid
+ "Make certain that parameter tiles in my interior are still type valid; replace any that now intimate type errors"
+
+ self isTextuallyCoded ifFalse:
+ [(self allMorphs select: [:m | m isKindOf: ParameterTile]) do:
+ [:aTile | aTile assureTypeStillValid].
+ self install]!
Item was added:
+ ----- Method: Morph>>slotSpecifications (in category '*Etoys-support') -----
+ slotSpecifications
+ "A once and possibly future feature; retained here for backward-compatibility bulletproofing."
+
+ ^ #()!
Item was added:
+ ----- Method: EtoysPresenter>>phraseForReceiver:op:arg:resultType: (in category 'tile support') -----
+ phraseForReceiver: rcvr op: op arg: arg resultType: resultType
+ "Answer a PhraseTileMorph affiliated with the given receiver, initialized to hold the given operator, argument, and result type"
+
+ | m argTile rcvrTile |
+ arg isNil
+ ifTrue:
+ [m := PhraseTileMorph new
+ setOperator: op
+ type: resultType
+ rcvrType: (self typeForConstant: rcvr)]
+ ifFalse:
+ [m := PhraseTileMorph new
+ setOperator: op
+ type: resultType
+ rcvrType: (self typeForConstant: rcvr)
+ argType: (self typeForConstant: arg).
+ argTile := self constantTile: arg.
+ argTile position: m lastSubmorph position.
+ m lastSubmorph addMorph: argTile].
+ rcvrTile := self constantTile: rcvr.
+ " TilePadMorph makeReceiverColorOfResultType ifTrue: [rcvrTile color: m color]."
+ rcvrTile position: m firstSubmorph position.
+ m firstSubmorph addMorph: rcvrTile.
+ m vResizing: #shrinkWrap.
+ ^m!
Item was added:
+ ----- Method: Morph>>ensuredButtonProperties (in category '*Etoys') -----
+ ensuredButtonProperties
+
+ self hasButtonProperties ifFalse: [
+ self buttonProperties: (ButtonProperties new visibleMorph: self)
+ ].
+ ^self buttonProperties!
Item was added:
+ ----- Method: Morph>>makeAllTilesColored (in category '*Etoys-scripting') -----
+ makeAllTilesColored
+ self allMorphsDo:
+ [:m | m restoreTypeColor]!
Item was added:
+ ----- Method: ScriptEditorMorph>>toggleWhetherShowingTiles (in category 'other') -----
+ toggleWhetherShowingTiles
+ "Toggle between showing the method pane and showing the tiles pane"
+
+ self showingMethodPane
+ ifFalse: "currently showing tiles"
+ [self showSourceInScriptor]
+
+ ifTrue: "current showing textual source"
+ [Preferences universalTiles
+ ifTrue: [^ self revertToTileVersion].
+ self savedTileVersionsCount >= 1
+ ifTrue:
+ [(self userScriptObject lastSourceString = (playerScripted class compiledMethodAt: scriptName) decompileString)
+ ifFalse:
+ [(self confirm:
+ 'Caution -- this script was changed
+ textually; if you revert to tiles at this
+ point you will lose all the changes you
+ may have made textually. Do you
+ really want to do this?' translated) ifFalse: [^ self]].
+ self revertToTileVersion]
+ ifFalse:
+ [Beeper beep]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
+ acceptDroppingMorph: aMorph event: evt
+ "Allow the user to add tiles and program fragments just by dropping them on this morph."
+
+ | i slideMorph p1 p2 |
+
+ self prepareToUndoDropOf: aMorph.
+ "Find where it will go, and prepare to animate the move..."
+ i := self rowInsertionIndexFor: aMorph fullBounds center.
+ slideMorph := aMorph imageForm offset: 0 at 0.
+ p1 := aMorph screenRectangle topLeft.
+ aMorph delete.
+ self stopSteppingSelector: #trackDropZones.
+ self world displayWorld. "Clear old image prior to animation"
+
+ (aMorph isPhraseTileMorph) ifTrue:
+ [aMorph justGrabbedFromViewer: false].
+ aMorph tileRows do: [:tileList |
+ self insertTileRow: (Array with:
+ (tileList first rowOfRightTypeFor: owner forActor: aMorph associatedPlayer))
+ after: i.
+ i := i + 1].
+ self removeSpaces.
+ self enforceTileColorPolicy.
+ self layoutChanged.
+ self fullBounds. "force layout"
+
+ "Now animate the move, before next Morphic update.
+ NOTE: This probably should use ZoomMorph instead"
+ p2 := (self submorphs atPin: (i-1 max: firstTileRow)) screenRectangle topLeft.
+ slideMorph slideFrom: p1 to: p2 nSteps: 5 delay: 50 andStay: true.
+ self playSoundNamed: 'scritch'.
+ self topEditor install "Keep me for editing, a copy goes into lastAcceptedScript"!
Item was added:
+ ----- Method: ScriptEditorMorph>>destroyScript (in category 'buttons') -----
+ destroyScript
+ "At user request, and only after confirmation, destroy the script, thus removing it from the uniclass's method dictionary and removing its instantiations from all instances of uniclass, etc."
+
+ (self confirm: 'Caution -- this destroys this script
+ permanently; are you sure you want to do this?' translated) ifFalse: [^ self].
+ true ifTrue: [^ playerScripted removeScript: scriptName fromWorld: self world].
+
+ self flag: #deferred. "revisit"
+ (playerScripted okayToDestroyScriptNamed: scriptName)
+ ifFalse:
+ [^ self inform: 'Sorry, this script is being called
+ from another script.' translated].
+
+ self actuallyDestroyScript!
Item was added:
+ ----- Method: StandardScriptingSystem class>>applyNewEToyLook (in category '*Etoys') -----
+ applyNewEToyLook
+ "Apply the new EToy look based on free fonts, approximating the classic look as closely as possible."
+
+ "StandardScriptingSystem applyNewEToyLook"
+
+ " | aTextStyle aFont |
+ aTextStyle := TextStyle named: #BitstreamVeraSansMono.
+ aFont := aTextStyle fontOfSize: 12.
+ aFont := aFont emphasis: 1.
+ Preferences setEToysFontTo: aFont.
+ Preferences setButtonFontTo: aFont.
+
+ aTextStyle := TextStyle named: #Accushi.
+ aFont := aTextStyle fontOfSize: 12.
+ Preferences setFlapsFontTo: aFont.
+
+ (aTextStyle := TextStyle named: #Accuny)
+ ifNotNil:
+ [Preferences setSystemFontTo: (aTextStyle fontOfSize: 12)]"
+
+ Preferences setDefaultFonts: #(
+ (setEToysFontTo: BitstreamVeraSansBold 10)
+ (setButtonFontTo: BitstreamVeraSansMono 9)
+ (setFlapsFontTo: Accushi 12)
+ (setSystemFontTo: Accuny 10)
+ (setWindowTitleFontTo: BitstreamVeraSansBold 12)
+ )
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>setFrequencyTo: (in category 'frequency') -----
+ setFrequencyTo: aNumber
+ self scriptInstantiation frequency: aNumber!
Item was added:
+ ----- Method: Morph>>enclosingEditor (in category '*Etoys-support') -----
+ enclosingEditor
+ "Return the next editor around the receiver"
+
+ | tested |
+ tested := owner.
+ [tested isNil] whileFalse:
+ [tested isTileEditor ifTrue: [^tested].
+ tested := tested owner].
+ ^nil!
Item was added:
+ ----- 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 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 added:
+ ----- Method: ScriptEditorMorph>>insertTileRow:after: (in category 'private') -----
+ insertTileRow: tileList after: index
+ "Return a row to be used to insert an entire row of tiles."
+
+ | row |
+ row := AlignmentMorph newRow
+ vResizing: #spaceFill;
+ layoutInset: 0;
+ extent: (bounds width)@(TileMorph defaultH);
+ color: Color transparent.
+ row addAllMorphs: tileList.
+ self privateAddMorph: row atIndex: index + 1.
+ !
Item was added:
+ ----- Method: Morph>>asWearableCostumeOfExtent: (in category '*Etoys-support') -----
+ asWearableCostumeOfExtent: extent
+ "Return a wearable costume for some player"
+ ^self asWearableCostume!
Item was added:
+ ----- 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: (Utilities setterSelectorFor: uniqueName).
+ self setNameTo: uniqueName!
Item was added:
+ ----- Method: PasteUpMorph>>toggleAutomaticViewing (in category '*Etoys-viewing') -----
+ toggleAutomaticViewing
+ | current |
+ current := self automaticViewing.
+ current
+ ifTrue:
+ [self removeProperty: #automaticViewing]
+ ifFalse:
+ [self setProperty: #automaticViewing toValue: true]!
Item was added:
+ ----- Method: Object>>defaultNameStemForInstances (in category '*Etoys-viewer') -----
+ defaultNameStemForInstances
+ "Answer a basis for names of default instances of the receiver. The default is to let the class specify, but certain instances will want to override. (PasteUpMorphs serving as Worlds come to mind"
+
+ ^ self class defaultNameStemForInstances!
Item was added:
+ ----- Method: PasteUpMorph>>viewingNonOverlappingString (in category '*Etoys-viewing') -----
+ viewingNonOverlappingString
+ "Answer a string to show in a menu representing whether the
+ receiver is currently viewing its subparts by
+ non-overlapping-icon (aka auto-line-layout)"
+ ^ ((self showingListView
+ or: [self autoLineLayout ~~ true])
+ ifTrue: ['<no>']
+ ifFalse: ['<yes>']), 'view with line layout' translated!
Item was added:
+ ----- Method: Morph>>addStackItemsTo: (in category '*Etoys-card in a stack') -----
+ addStackItemsTo: aMenu
+ "Add stack-related items to the menu"
+
+ | stackSubMenu |
+ stackSubMenu := MenuMorph new defaultTarget: self.
+ (owner notNil and: [owner isStackBackground]) ifTrue:
+ [self isShared
+ ifFalse:
+ [self couldHoldSeparateDataForEachInstance
+ ifTrue:
+ [stackSubMenu add: 'Background field, shared value' translated target: self action: #putOnBackground.
+ stackSubMenu add: 'Background field, individual values' translated target: self action: #becomeSharedBackgroundField]
+ ifFalse:
+ [stackSubMenu add: 'put onto Background' translated target: self action: #putOnBackground]]
+ ifTrue:
+ [stackSubMenu add: 'remove from Background' translated target: self action: #putOnForeground.
+ self couldHoldSeparateDataForEachInstance ifTrue:
+ [self holdsSeparateDataForEachInstance
+ ifFalse:
+ [stackSubMenu add: 'start holding separate data for each instance' translated target: self action: #makeHoldSeparateDataForEachInstance]
+ ifTrue:
+ [stackSubMenu add: 'stop holding separate data for each instance' translated target: self action: #stopHoldingSeparateDataForEachInstance].
+ stackSubMenu add: 'be default value on new card' translated target: self action: #setAsDefaultValueForNewCard.
+ (self hasProperty: #thumbnailImage)
+ ifTrue:
+ [stackSubMenu add: 'stop using for reference thumbnail' translated target: self action: #stopUsingForReferenceThumbnail]
+ ifFalse:
+ [stackSubMenu add: 'start using for reference thumbnail' translated target: self action: #startUsingForReferenceThumbnail]]].
+ stackSubMenu addLine].
+
+ (self isStackBackground) ifFalse:
+ [stackSubMenu add: 'be a card in an existing stack...' translated action: #insertAsStackBackground].
+ stackSubMenu add: 'make an instance for my data' translated action: #abstractAModel.
+ (self isStackBackground) ifFalse:
+ [stackSubMenu add: 'become a stack of cards' translated action: #wrapWithAStack].
+ aMenu add: 'stacks and cards...' translated subMenu: stackSubMenu
+ !
Item was added:
+ ----- 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 add: 'ok' action: nil]. "in case it was a slot -- weird, transitional"
+
+ aMenu addTitle: anElement asString, ' (', elementType, ')'.
+
+ aMenu popUpInWorld: self currentWorld.
+ !
Item was added:
+ ----- Method: Morph>>appearsToBeSameCostumeAs: (in category '*Etoys-support') -----
+ appearsToBeSameCostumeAs: aMorph
+
+ ^false
+ !
Item was added:
+ ----- Method: EtoysPresenter>>associatedMorph: (in category 'access') -----
+ associatedMorph: aMorph
+ associatedMorph := aMorph!
Item was added:
+ ----- Method: Morph>>wrapWithAStack (in category '*Etoys-card in a stack') -----
+ wrapWithAStack
+ "Install me as a card inside a new stack. The stack has no border or controls, so I my look is unchanged. If I don't already have a CardPlayer, find my data fields and make one. Be ready to make new cards in the stack that look like me, but hold different field data."
+
+ self player class officialClass == CardPlayer ifFalse: [
+ self abstractAModel ifFalse: [^ false]].
+ StackMorph new initializeWith: self.
+ self stack addHalo. "Makes it easier for the user"!
Item was added:
+ ----- Method: EtoysPresenter>>systemQueryPhraseWithActionString:labelled: (in category 'palette & parts bin') -----
+ systemQueryPhraseWithActionString: anActionString labelled: aLabel
+ "Answer a SystemQueryPhrase with the given action string and label"
+
+ | aTile aPhrase |
+
+ aPhrase := SystemQueryPhrase new.
+ aTile := BooleanTile new.
+ aTile setExpression: anActionString label: aLabel.
+ aPhrase addMorph: aTile.
+ aPhrase enforceTileColorPolicy.
+ ^ aPhrase!
Item was added:
+ ----- Method: PasteUpMorph>>arrowheadsOnAllPens (in category '*Etoys-pen') -----
+ arrowheadsOnAllPens
+
+ submorphs do: [:m | m assuredPlayer setPenArrowheads: true]
+ !
Item was added:
+ ----- Method: EtoysPresenter class>>initialize (in category 'class initialization') -----
+ initialize
+ Presenter defaultPresenterClass: self.
+ PasteUpMorph allInstancesDo:[:p| p dumpPresenter].
+ Vocabulary initializeStandardVocabularies.!
Item was added:
+ ----- Method: Morph>>defaultVariableName (in category '*Etoys-support') -----
+ defaultVariableName
+ "If the receiver is of the sort that wants a variable maintained on its behalf in the 'card' data, then return a variable name to be used for that datum. What is returned here is only a point of departure in the forthcoming negotiation"
+
+ ^ Scanner wellFormedInstanceVariableNameFrom: (self valueOfProperty: #variableName ifAbsent: [self externalName])!
Item was added:
+ ----- Method: PasteUpMorph>>playfieldOptionsMenu (in category '*Etoys-playfield') -----
+ playfieldOptionsMenu
+ "Answer an auxiliary menu with options specific to playfields -- too many to be housed in the main menu"
+
+ | aMenu isWorld |
+ isWorld := self isWorldMorph.
+ aMenu := MenuMorph new defaultTarget: self.
+ aMenu addStayUpItem.
+ aMenu add: 'save on file...' translated action: #saveOnFile.
+ Preferences eToyFriendly ifFalse: [
+ aMenu add: 'save as SqueakPage at url...' translated action: #saveOnURL.
+ aMenu add: 'update all from resources' translated action: #updateAllFromResources].
+
+ aMenu add: 'round up strays' translated action: #roundUpStrays.
+ aMenu balloonTextForLastItem: 'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.' translated.
+ aMenu add: 'show all players' translated action: #showAllPlayers.
+ aMenu balloonTextForLastItem: 'Make visible the viewers for all players which have user-written scripts in this playfield.' translated.
+ aMenu add: 'hide all players' translated action: #hideAllPlayers.
+ aMenu balloonTextForLastItem: 'Make invisible the viewers for all players in this playfield. This will save space before you publish this project' translated.
+
+
+ aMenu addLine.
+ aMenu add: 'shuffle contents' translated action: #shuffleSubmorphs.
+ aMenu balloonTextForLastItem: 'Rearranges my contents in random order' translated.
+ self griddingOn
+ ifTrue: [aMenu add: 'turn gridding off' translated action: #griddingOnOff.
+ aMenu add: (self gridVisible ifTrue: ['hide'] ifFalse: ['show']) translated, ' grid' translated
+ action: #gridVisibleOnOff.
+ aMenu add: 'set grid spacing...' translated action: #setGridSpec]
+ ifFalse: [aMenu add: 'turn gridding on' translated action: #griddingOnOff].
+ aMenu addLine.
+
+ #( (autoLineLayoutString toggleAutoLineLayout
+ 'whether submorphs should automatically be laid out in lines')
+ (indicateCursorString toggleIndicateCursor
+ 'whether the "current" submorph should be indicated with a dark black border')
+ (isPartsBinString toggleIsPartsBin
+ 'whether dragging an object from the interior should produce a COPY of the object')
+ (isOpenForDragNDropString toggleDragNDrop
+ 'whether objects can be dropped into and dragged out of me')
+ (mouseOverHalosString toggleMouseOverHalos
+ 'whether objects should put up halos when the mouse is over them')
+ (autoExpansionString toggleAutomaticPhraseExpansion
+ 'whether tile phrases, dropped on me, should automatically sprout Scriptors around them')
+ (originAtCenterString toggleOriginAtCenter
+ 'whether the cartesian origin of the playfield should be at its lower-left corner or at the center of the playfield')
+ (showThumbnailString toggleAlwaysShowThumbnail
+ 'whether large objects should be represented by thumbnail miniatures of themselves')
+ (fenceEnabledString toggleFenceEnabled
+ 'whether moving objects should stop at the edge of their container')
+ (batchPenTrailsString toggleBatchPenTrails
+ 'if true, detailed movement of pens between display updates is ignored. Thus multiple line segments drawn within a script may not be seen individually.')
+
+ ) do:
+
+ [:triplet |
+ (isWorld and: [#(toggleAutoLineLayout toggleIndicateCursor toggleIsPartsBin toggleAlwaysShowThumbnail) includes: triplet second]) ifFalse:
+ [aMenu addUpdating: triplet first action: triplet second.
+ aMenu balloonTextForLastItem: triplet third translated]].
+
+ aMenu addUpdating: #autoViewingString action: #toggleAutomaticViewing.
+ aMenu balloonTextForLastItem: 'governs whether, when an object is touched inside me, a viewer should automatically be launched for it.' translated.
+
+ ((isWorld not or: [self backgroundSketch notNil]) or: [presenter isNil])
+ ifTrue:
+ [aMenu addLine].
+
+ isWorld ifFalse:
+ [aMenu add: 'set thumbnail height...' translated action: #setThumbnailHeight.
+ aMenu balloonTextForLastItem: 'if currently showing thumbnails governs the standard height for them' translated.
+ aMenu add: 'behave like a Holder' translated action: #becomeLikeAHolder.
+ aMenu balloonTextForLastItem: 'Set properties to make this object nicely set up to hold frames of a scripted animation.' translated].
+
+ self backgroundSketch ifNotNil:
+ [aMenu add: 'delete background painting' translated action: #deleteBackgroundPainting.
+ aMenu balloonTextForLastItem: 'delete the graphic that forms the background for this me.' translated].
+ presenter ifNil:
+ [aMenu add: 'make detachable' translated action: #makeDetachable.
+ aMenu balloonTextForLastItem: 'Allow this area to be separately governed by its own controls.' translated].
+
+ aMenu addLine.
+ aMenu add: 'use standard texture' translated action: #setStandardTexture.
+ aMenu balloonTextForLastItem: 'use a pale yellow-and-blue background texture here.' translated.
+ aMenu add: 'make graph paper...' translated action: #makeGraphPaper.
+ aMenu balloonTextForLastItem: 'Design your own graph paper and use it as the background texture here.' translated.
+ aMenu addTitle: 'playfield options...' translated.
+
+ ^ aMenu
+ !
Item was added:
+ ----- Method: Morph>>reassessBackgroundShape (in category '*Etoys-card in a stack') -----
+ reassessBackgroundShape
+ "A change has been made which may affect the instance structure of the Card uniclass that holds the instance state, which can also be thought of as the 'card data'."
+
+ "Caution: still to be done: the mechanism so that when a new instance variable is added, it gets initialized in all subinstances of the receiver's player, which are the cards of this shape. One needs to take into account here the instance variable names coming in; those that are unchanged should keep their values, but those that have newly arrived should obtain their default values from the morphs on whose behalf they are being maintained in the model"
+
+ | requestedName |
+ self isStackBackground ifFalse: [^Beeper beep]. "bulletproof against deconstruction"
+ Cursor wait showWhile:
+ [ | variableDocks takenNames sepDataMorphs sorted existing |variableDocks := OrderedCollection new. "This will be stored in the uniclass's
+ class-side inst var #variableDocks"
+ takenNames := OrderedCollection new.
+ sepDataMorphs := OrderedCollection new. "fields, holders of per-card data"
+ self submorphs do:
+ [:aMorph |
+ aMorph renderedMorph holdsSeparateDataForEachInstance
+ ifTrue: [sepDataMorphs add: aMorph renderedMorph]
+ ifFalse:
+ ["look for buried fields, inside a frame"
+
+ aMorph renderedMorph isShared
+ ifTrue:
+ [aMorph allMorphs do:
+ [:mm |
+ mm renderedMorph holdsSeparateDataForEachInstance
+ ifTrue: [sepDataMorphs add: mm renderedMorph]]]]].
+ sorted := SortedCollection new
+ sortBlock: [:a :b | (a valueOfProperty: #cardInstance) notNil]. "puts existing ones first"
+ sorted addAll: sepDataMorphs.
+ sorted do:
+ [:aMorph | | docks |
+ docks := aMorph variableDocks.
+ "Each morph can request multiple variables.
+ This complicates matters somewhat but creates a generality for Fabrk-like uses.
+ Each spec is an instance of VariableDock, and it provides a point of departure
+ for the negotiation between the PasteUp and its constitutent morphs"
+ docks do:
+ [:aVariableDock | | uniqueName |
+ uniqueName := self player
+ uniqueInstanceVariableNameLike: (requestedName := aVariableDock
+ variableName)
+ excluding: takenNames.
+ uniqueName ~= requestedName
+ ifTrue:
+ [aVariableDock variableName: uniqueName.
+ aMorph noteNegotiatedName: uniqueName for: requestedName].
+ takenNames add: uniqueName].
+ variableDocks addAll: docks].
+ existing := self player class instVarNames.
+ variableDocks := (variableDocks asSortedCollection:
+ [:dock1 :dock2 | | name2 name1 |
+ name1 := dock1 variableName.
+ name2 := dock2 variableName.
+ (existing indexOf: name1 ifAbsent: [0])
+ < (existing indexOf: name2 ifAbsent: [variableDocks size])])
+ asOrderedCollection.
+ self player class setNewInstVarNames: (variableDocks
+ collect: [:info | info variableName asString]).
+ "NB: sets up accessors, and removes obsolete ones"
+ self player class newVariableDocks: variableDocks]!
Item was added:
+ ----- Method: Object>>isPlayerLike (in category '*Etoys-viewer') -----
+ isPlayerLike
+ "Return true if the receiver is a player-like object"
+ ^false!
Item was added:
+ ----- Method: PasteUpMorph>>behaveLikeAHolderString (in category '*Etoys-viewing') -----
+ behaveLikeAHolderString
+ "Answer a string to be displayed in a menu to characterize
+ whether the receiver is currently behaving like a holder"
+ ^ (self behavingLikeAHolder
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>'])
+ , 'behave like a holder' translated!
Item was added:
+ ----- Method: ScriptEditorMorph>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add custom menu items to a menu"
+
+ super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff.
+ aCustomMenu addLine.
+ aCustomMenu add: 'fix layout' target: self action: #fixLayout.
+ threadPolygon ifNil: [
+ aCustomMenu add: 'show thread' target: self action: #createThreadShowing.
+ ] ifNotNil: [
+ aCustomMenu add: 'hide thread' target: self action: #deleteThreadShowing.
+ ].!
Item was added:
+ ----- Method: Morph>>firedMouseUpCode (in category '*Etoys-support') -----
+ firedMouseUpCode
+ "If the user has special mouseUpCodeToRun, then fire it once right now and return true, else return false"
+
+ | evt |
+ (self world isNil or: [self mouseUpCodeOrNil isNil]) ifTrue: [^false].
+ evt := MouseEvent new
+ setType: nil
+ position: self center
+ buttons: 0
+ hand: self world activeHand.
+ self programmedMouseUp: evt for: self.
+ ^true!
Item was added:
+ ----- Method: PasteUpMorph>>batchPenTrails (in category '*Etoys-viewing') -----
+ batchPenTrails
+ "Answer whether pen trails should be batched in the receiver"
+
+ ^ self valueOfProperty: #batchPenTrails ifAbsent: [Preferences batchPenTrails]!
Item was added:
+ ----- Method: Morph>>set: (in category '*Etoys-support') -----
+ set: aPointOrNumber
+ "Set my position."
+
+ self jumpTo: aPointOrNumber.
+ !
Item was added:
+ ----- Method: Morph>>isTileLike (in category '*Etoys-scripting') -----
+ isTileLike
+ "Cannot be dropped into a script"
+ ^ false!
Item was added:
+ ----- Method: ScriptEditorMorph>>updateToPlayer: (in category 'initialization') -----
+ updateToPlayer: newPlayer
+ "Make certain that the script name and the names of actors within are up to date"
+
+ playerScripted ifNil:
+ ["likely a naked test/yes/no fragment!!"
+ ^ self].
+ newPlayer == playerScripted ifTrue: [^ self]. "Already points to him"
+ self allMorphs do: [:m |
+ (m isKindOf: TileMorph) ifTrue:
+ [m retargetFrom: playerScripted to: newPlayer.
+ m bringUpToDate]].
+ playerScripted := newPlayer.
+ self replaceRow1!
Item was added:
+ ----- Method: ScriptEditorMorph>>myMorph (in category 'access') -----
+ myMorph
+ "Answer the morph that serves as the costume of my associated player. If for some reason I have no associated player, answer nil"
+
+ | aPlayer |
+ ^ (aPlayer := self playerScripted) ifNotNil: [aPlayer costume]!
Item was added:
+ ----- Method: Morph>>currentDataInstance (in category '*Etoys-card in a stack') -----
+ currentDataInstance
+ "Answer the current data instance"
+
+ ^ self player!
Item was added:
+ ----- Method: Morph>>succeededInRevealing: (in category '*Etoys-support') -----
+ succeededInRevealing: aPlayer
+ aPlayer == self player ifTrue: [^ true].
+ submorphs do:
+ [:m | (m succeededInRevealing: aPlayer) ifTrue: [^ true]].
+ ^ false!
Item was added:
+ ----- Method: EtoysPresenter>>valueTiles (in category 'tile support') -----
+ valueTiles
+ "Answer some constant-valued tiles. This dates back to very early etoy work in 1997, and presently has no senders"
+
+ | tiles |
+ tiles := OrderedCollection new.
+ tiles add: (5 newTileMorphRepresentative typeColor: (ScriptingSystem colorForType: #Number)).
+ tiles add: (ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)).
+ tiles add: (TileMorph new typeColor: (ScriptingSystem colorForType: #Number);
+ setExpression: '(180 atRandom)'
+ label: 'random').
+ tiles add: RandomNumberTile new.
+ ^ tiles!
Item was added:
+ ----- Method: ScriptEditorMorph>>explainStatusAlternatives (in category 'customevents-other') -----
+ explainStatusAlternatives
+ (StringHolder new contents: (ScriptingSystem statusHelpStringFor: playerScripted))
+ openLabel: 'Script Status' translated!
Item was added:
+ ----- Method: PasteUpMorph>>imposeListViewSortingBy:retrieving: (in category '*Etoys-viewing') -----
+ imposeListViewSortingBy: sortOrderSymbol retrieving: fieldListSelectors
+ "Establish a list view of the receiver's contents, sorting the contents by the criterion represented by sortOrderSymbol, and displaying readouts as indicated by the list of field selectors."
+
+
+ self setProperty: #sortOrder toValue: sortOrderSymbol.
+ self setProperty: #fieldListSelectors toValue: fieldListSelectors.
+
+ self showingListView ifFalse:
+ [self autoLineLayout ifFalse: [self saveBoundsOfSubmorphs].
+ self setProperty: #showingListView toValue: true.
+ self layoutPolicy: TableLayout new.
+ self layoutInset: 2; cellInset: 2.
+ self listDirection: #topToBottom.
+ self wrapDirection: #none].
+
+ self submorphs "important that it be a copy" do:
+ [:aMorph | | rep |
+ rep := aMorph listViewLineForFieldList: fieldListSelectors.
+ rep hResizing: #spaceFill.
+ self replaceSubmorph: aMorph by: rep].
+
+ self sortSubmorphsBy: (self valueOfProperty: #sortOrder).!
Item was added:
+ ----- Method: PasteUpMorph>>notePenDown:forPlayer:at: (in category '*Etoys-playfield') -----
+ notePenDown: penDown forPlayer: player at: location
+ "Note that a morph has just moved with its pen down, begining at startPoint.
+ Only used in conjunction with Preferences batchPenTrails."
+
+ | startLoc |
+ lastTurtlePositions ifNil: [lastTurtlePositions := IdentityDictionary new].
+ penDown
+ ifTrue: ["Putting the Pen down -- record current location"
+ (lastTurtlePositions includesKey: player) ifFalse:
+ [lastTurtlePositions at: player put: location]]
+ ifFalse: ["Picking the Pen up -- draw to current location and remove"
+ (startLoc := lastTurtlePositions at: player ifAbsent: [nil]) ifNotNil:
+ [self drawPenTrailFor: player costume
+ from: startLoc to: location].
+ lastTurtlePositions removeKey: player ifAbsent: []]!
Item was added:
+ ----- Method: EtoysPresenter>>stepUp:with: (in category 'stop-step-go buttons') -----
+ stepUp: evt with: aMorph
+ "The step button came up; get things right"
+
+ self stepButtonState: #off!
Item was added:
+ ----- Method: EtoysPresenter>>stepButtonState: (in category 'stop-step-go buttons') -----
+ stepButtonState: newState
+ "Get all step buttons in my scope to show the correct state"
+
+ self allStepButtons do:
+ [:aButton | aButton state: newState]!
Item was added:
+ ----- 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])
+ ifTrue:
+ [self replaceRow1].
+ self updateStatusMorph: (self firstSubmorph findA: ScriptStatusControl)]!
Item was added:
+ ----- Method: PasteUpMorph>>viewerFlapTabFor: (in category '*Etoys-playfield') -----
+ viewerFlapTabFor: anObject
+ "Open up a Viewer on aMorph in its own flap, creating it if necessary"
+
+ | bottomMost aPlayer aFlapTab tempFlapTab |
+ bottomMost := self top.
+ aPlayer := anObject isMorph ifTrue: [anObject assuredPlayer] ifFalse: [anObject objectRepresented].
+ self flapTabs do:
+ [:aTab | ((aTab isKindOf: ViewerFlapTab) or: [aTab hasProperty: #paintingFlap])
+ ifTrue:
+ [bottomMost := aTab bottom max: bottomMost.
+ ((aTab isKindOf: ViewerFlapTab) and: [aTab scriptedPlayer == aPlayer])
+ ifTrue:
+ [^ aTab]]].
+ "Not found; make a new one"
+ tempFlapTab := Flaps newFlapTitled: anObject nameForViewer onEdge: #right inPasteUp: self.
+ tempFlapTab arrangeToPopOutOnDragOver: false;
+ arrangeToPopOutOnMouseOver: false.
+ "For some reason those event handlers were causing trouble, as reported by ar 11/22/2001, after di's flapsOnBottom update."
+ aFlapTab := tempFlapTab as: ViewerFlapTab.
+
+ aFlapTab initializeFor: aPlayer topAt: bottomMost + 2.
+ aFlapTab referent color: (Color green muchLighter alpha: 0.5).
+ aFlapTab referent borderWidth: 0.
+ aFlapTab referent setProperty: #automaticPhraseExpansion toValue: true.
+ Preferences compactViewerFlaps
+ ifTrue: [aFlapTab makeFlapCompact: true].
+ self addMorphFront: aFlapTab.
+ aFlapTab adaptToWorld: self.
+ aFlapTab setProperty: #isEToysFlap toValue: true.
+ ^ aFlapTab!
Item was added:
+ ----- Method: TilePadMorph>>isTilePadMorph (in category 'miscellaneous') -----
+ isTilePadMorph
+ ^true!
Item was added:
+ ----- Method: ScriptEditorMorph>>updateHeader (in category 'initialization') -----
+ updateHeader
+ "Replace my header morph with another one assured of being structurally au courant"
+
+ (firstTileRow notNil and: [firstTileRow > 1]) ifTrue:
+ [self replaceRow1]!
Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryConnection (in category '*eToys-scripting') -----
+ additionsToViewerCategoryConnection
+ "Answer viewer additions for the 'connection' category"
+ "Vocabulary initialize"
+
+ ^{
+ #'connections to me'.
+ #(
+ (command tellAllPredecessors: 'Send a message to all graph predecessors' ScriptName)
+ (command tellAllSuccessors: 'Send a message to all graph predecessors' ScriptName)
+ (command tellAllIncomingConnections: 'Send a message to all the connectors whose destination end is connected to me' ScriptName)
+ (command tellAllOutgoingConnections: 'Send a message to all the connectors whose source end is connected to me' ScriptName)
+ (slot incomingConnectionCount 'The number of connectors whose destination end is connected to me' Number readOnly Player getIncomingConnectionCount unused unused)
+ (slot outgoingConnectionCount 'The number of connectors whose source end is connected to me' Number readOnly Player getOutgoingConnectionCount unused unused)
+ )
+ }
+ !
Item was added:
+ Presenter subclass: #EtoysPresenter
+ instanceVariableNames: 'associatedMorph standardPlayer standardPlayfield standardPalette playerList'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'EToys-Scripting'!
+
+ !EtoysPresenter commentStamp: '<historical>' prior: 0!
+ Optionally associated with a PasteUpMorph, provides a local scope for the running of scripts.
+
+ Once more valuable, may be again, but at present occupies primarily a historical niche.
+
+ Maintains a playerList cache.
+
+ Holds, optionally three 'standard items' -- standardPlayer standardPlayfield standardPalette -- originally providing idiomatic support of ongoing squeak-team internal work, but now extended to more general applicability.
+
+ !
Item was added:
+ ----- Method: Morph class>>hasAdditionsToViewerCategories (in category '*eToys-scripting') -----
+ hasAdditionsToViewerCategories
+ ^ self class selectors
+ anySatisfy: [:each | each == #additionsToViewerCategories
+ or: [(each beginsWith: 'additionsToViewerCategory')
+ and: [(each at: 26 ifAbsent: []) ~= $:]]]!
Item was added:
+ ----- Method: WordArray>>primDivScalar:and:into: (in category '*Etoys-arithmetic') -----
+ primDivScalar: rcvr and: other into: result
+
+ <primitive: 'primitiveDivScalar' module:'KedamaPlugin'>
+ "^ KedamaPlugin doPrimitive: #primitiveDivScalar."
+
+ 1 to: rcvr size do: [:i |
+ result at: i put: (rcvr at: i) / other.
+ ].
+ ^ result.
+ !
Item was added:
+ ----- Method: Morph>>makeAllTilesGreen (in category '*Etoys-scripting') -----
+ makeAllTilesGreen
+ self allMorphsDo:
+ [:m | m useUniformTileColor]!
Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryColorAndBorder (in category '*eToys-scripting') -----
+ additionsToViewerCategoryColorAndBorder
+ "Answer viewer additions for the 'color & border' category"
+
+ ^#(
+ #'color & border'
+ (
+ (slot color 'The color of the object' Color readWrite Player getColor Player setColor:)
+ (slot opacity '0 means completely transparent, 1 means completely opaque' Number readWrite Player getAlpha Player setAlpha:)
+ (slot borderStyle 'The style of the object''s border' BorderStyle readWrite Player getBorderStyle player setBorderStyle:)
+ (slot borderColor 'The color of the object''s border' Color readWrite Player getBorderColor Player setBorderColor:)
+ (slot borderWidth 'The width of the object''s border' Number readWrite Player getBorderWidth Player setBorderWidth:)
+ (slot roundedCorners 'Whether corners should be rounded' Boolean readWrite Player getRoundedCorners Player setRoundedCorners:)
+
+ (slot gradientFill 'Whether a gradient fill should be used' Boolean readWrite Player getUseGradientFill Player setUseGradientFill:)
+ (slot secondColor 'The second color used when gradientFill is in effect' Color readWrite Player getSecondColor Player setSecondColor:)
+
+ (slot radialFill 'Whether the gradient fill, if used, should be radial' Boolean readWrite Player getRadialGradientFill Player setRadialGradientFill:)
+
+ (slot dropShadow 'Whether a drop shadow is shown' Boolean readWrite Player getDropShadow Player setDropShadow:)
+ (slot shadowColor 'The color of the drop shadow' Color readWrite Player getShadowColor Player setShadowColor:)
+ )
+ )
+
+ !
Item was added:
+ ----- Method: EtoysPresenter>>associatedMorph (in category 'access') -----
+ associatedMorph
+ ^ associatedMorph!
Item was added:
+ ----- Method: PasteUpMorph>>getCharacters (in category '*eToys-support') -----
+ getCharacters
+ "obtain a string value from the receiver"
+
+ ^ String streamContents:
+ [:aStream |
+ submorphs do:
+ [:m | aStream nextPutAll: m getCharacters]]!
Item was added:
+ ----- Method: PasteUpMorph>>batchPenTrails: (in category '*Etoys-viewing') -----
+ batchPenTrails: aBoolean
+
+ self setProperty: #batchPenTrails toValue: aBoolean!
Item was added:
+ ----- Method: EtoysPresenter>>nascentPartsViewer (in category 'viewer') -----
+ nascentPartsViewer
+ ^ StandardViewer new!
Item was added:
+ ----- Method: PasteUpMorph>>noArrowheadsOnAllPens (in category '*Etoys-pen') -----
+ noArrowheadsOnAllPens
+
+ submorphs do: [:m | m assuredPlayer setPenArrowheads: false]
+ !
Item was added:
+ ----- Method: Morph>>copyCostumeStateFrom: (in category '*Etoys-support') -----
+ copyCostumeStateFrom: aMorph
+ "Copy all state that should be persistant for costumes from aMorph"
+ self rotationCenter: aMorph rotationCenter.
+ self rotationStyle: aMorph rotationStyle.
+ self referencePosition: aMorph referencePosition.
+ self forwardDirection: aMorph forwardDirection.
+ !
Item was added:
+ ----- Method: EtoysPresenter>>adaptedToWorld: (in category 'scripting') -----
+ adaptedToWorld: aWorld
+ "If I refer to a world or a hand, return the corresponding items in the new world."
+ ^aWorld presenter!
Item was added:
+ ----- Method: ScriptEditorMorph>>editMethodDescription (in category 'buttons') -----
+ editMethodDescription
+ "Edit the balloon help associated with the script"
+
+ self userScriptObject editDescription.
+ playerScripted updateAllViewers!
Item was added:
+ ----- Method: ScriptEditorMorph>>modernize (in category 'other') -----
+ modernize
+ "If the receiver appears to date from the past, try to fix it up"
+
+ Preferences universalTiles ifFalse:
+ [(self isTextuallyCoded and: [self showingMethodPane not]) ifTrue:
+ ["Fix up old guys that are not showing the code in place"
+ self showSourceInScriptor]]!
Item was added:
+ ----- Method: PasteUpMorph>>toggleBatchPenTrails (in category '*Etoys-viewing') -----
+ toggleBatchPenTrails
+
+ self batchPenTrails: self batchPenTrails not!
Item was added:
+ ----- Method: Morph>>defaultFloatPrecisionFor: (in category '*Etoys-scripting') -----
+ defaultFloatPrecisionFor: aGetSelector
+ "Answer a number indicating the default float precision to be used in a numeric readout for which the receiver provides the data. Individual morphs can override this. Showing fractional values for readouts of getCursor was in response to an explicit request from ack"
+
+ (self renderedMorph decimalPlacesForGetter: aGetSelector) ifNotNil: [:places | ^ (Utilities floatPrecisionForDecimalPlaces: places)].
+
+ (#(getCursor getNumericValue getNumberAtCursor getCursorWrapped getScaleFactor getUnitVector getAlpha) includes: aGetSelector)
+ ifTrue:
+ [^ 0.01].
+ ^ 1!
Item was added:
+ ----- Method: Morph>>topEditor (in category '*Etoys-support') -----
+ topEditor
+ "Return the top-most editor around the receiver"
+
+ | found tested |
+ tested := self.
+ [tested isNil] whileFalse:
+ [tested isTileEditor ifTrue: [found := tested].
+ tested := tested owner].
+ ^found!
Item was added:
+ ----- Method: EtoysPresenter>>hasAnyTextuallyCodedScripts (in category 'playerList') -----
+ hasAnyTextuallyCodedScripts
+ "Answer whether any uniclasses in the receiver have any textually coded scripts"
+
+ self uniclassesAndCounts do:
+ [:classAndCount |
+ classAndCount first scripts do:
+ [:aScript | aScript isTextuallyCoded ifTrue: [^ true]]].
+ ^ false
+
+ "
+ ActiveWorld presenter hasAnyTextuallyCodedScripts
+ "!
Item was added:
+ ----- Method: EtoysPresenter>>startRunningScripts (in category 'stop-step-go buttons') -----
+ startRunningScripts
+ "Start running scripts; get stop-step-go buttons to show the right thing"
+
+ self stopButtonState: #off.
+ self stepButtonState: #off.
+ self goButtonState: #on.
+ associatedMorph startRunningAll.
+
+ "associatedMorph borderColor: Preferences borderColorWhenRunning."
+
+ ThumbnailMorph recursionReset. "needs to be done once in a while (<- tk note from 1997)"!
Item was added:
+ ----- Method: ScriptEditorMorph>>recompileScript (in category 'other') -----
+ recompileScript
+ "A hook called in several places in the UI when something has been dragged & dropped into or out of the script."
+
+ self install.
+ "self stopScript"!
Item was added:
+ ----- Method: EtoysPresenter>>standardPlayer (in category 'standardPlayer etc') -----
+ standardPlayer
+ standardPlayer ifNil:
+ [self createStandardPlayer].
+ standardPlayer costume isInWorld ifFalse: [associatedMorph addMorphNearBack: standardPlayer costume].
+ ^ standardPlayer!
Item was added:
+ ----- Method: Morph>>stopHoldingSeparateDataForEachInstance (in category '*Etoys-card in a stack') -----
+ stopHoldingSeparateDataForEachInstance
+ "Make the receiver no longer hold separate data for each instance"
+
+ self removeProperty: #holdsSeparateDataForEachInstance.
+ self stack reassessBackgroundShape.!
Item was added:
+ ----- Method: ScriptEditorMorph>>savedTileVersionsCount (in category 'save & revert') -----
+ savedTileVersionsCount
+ "Answer the number of saved tile versions that currently exist for this script"
+
+ ^ self userScriptObject savedTileVersionsCount!
Item was added:
+ ----- Method: EtoysPresenter>>printOn: (in category 'printing') -----
+ printOn: aStream
+ super printOn: aStream.
+ aStream nextPutAll: ' (', self identityHash printString, ')'!
Item was added:
+ ----- Method: ScriptEditorMorph>>revertScriptVersion (in category 'other') -----
+ revertScriptVersion
+ | aUserScript |
+ aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
+ aUserScript revertScriptVersionFrom: self!
Item was added:
+ ----- Method: EToyVocabulary class>>morphClassesDeclaringViewerAdditions (in category 'accessing') -----
+ morphClassesDeclaringViewerAdditions
+ "Answer a list of actual morph classes that either implement #additionsToViewerCategories,
+ or that have methods that match #additionToViewerCategory* ."
+
+ ^(Morph class allSubInstances select: [ :ea | ea hasAdditionsToViewerCategories ])
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>fixLayout (in category 'menu') -----
+ fixLayout
+ self fixLayoutOfSubmorphsNotIn: IdentitySet new!
Item was added:
+ ----- Method: Morph>>unfilteredCategoriesForViewer (in category '*Etoys') -----
+ unfilteredCategoriesForViewer
+ "Answer a list of symbols representing the categories to offer in the viewer, in order of:
+ - masterOrderingOfCategorySymbols first
+ - others last in order by translated wording"
+ "
+ Morph basicNew unfilteredCategoriesForViewer
+ "
+ ^self renderedMorph class unfilteredCategoriesForViewer.
+ !
Item was added:
+ ----- Method: WordArray>>* (in category '*Etoys-arithmetic') -----
+ * other
+
+ | result |
+ other isNumber ifTrue: [
+ other isFloat ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primMulScalar: self and: other into: result.
+ ] ifFalse: [
+ result := WordArray new: self size.
+ ^ self primMulScalar: self and: other into: result.
+ ].
+ ].
+ (other isMemberOf: WordArray) ifTrue: [
+ result := WordArray new: self size.
+ ^ self primMulArray: self and: other into: result.
+ ].
+ (other isMemberOf: KedamaFloatArray) ifTrue: [
+ result := KedamaFloatArray new: self size.
+ ^ self primMulArray: self and: other into: result.
+ ].
+ ^ super * other.
+ !
Item was added:
+ ----- Method: Object>>categoriesForViewer: (in category '*Etoys-viewer') -----
+ categoriesForViewer: aViewer
+ "Answer a list of categories to offer in the given viewer"
+
+ ^ aViewer currentVocabulary categoryListForInstance: self ofClass: self class limitClass: aViewer limitClass!
Item was changed:
+ ----- Method: Object>>newTileMorphRepresentative (in category '*Etoys-viewer') -----
- ----- Method: Object>>newTileMorphRepresentative (in category '*eToys-tiles') -----
newTileMorphRepresentative
^ TileMorph new setLiteral: self!
Item was added:
+ ----- Method: Object>>belongsToUniClass (in category '*Etoys-viewer') -----
+ belongsToUniClass
+ "Answer whether the receiver belongs to a uniclass. For the moment (this is not entirely satisfactory) this is precisely equated with the classname ending in a digit"
+
+ ^ self class name endsWithDigit!
Item was added:
+ ----- Method: PasteUpMorph>>elementCount (in category '*eToys-support') -----
+ elementCount
+ "Answer how many objects are contained within me"
+
+ ^ submorphs size!
Item was added:
+ ----- Method: Morph>>scriptEditorFor: (in category '*Etoys-scripting') -----
+ scriptEditorFor: aScriptName
+ ^ self assuredPlayer scriptEditorFor: aScriptName!
Item was added:
+ ----- Method: ScriptEditorMorph>>removeEmptyRows (in category 'private') -----
+ removeEmptyRows
+ submorphs copy do: [:m |
+ (m isAlignmentMorph and: [m submorphCount = 0])
+ ifTrue: [m delete]].
+ self flag: #arNote. "code below lead to large and unnecessary recomputations of layouts; without it things just fly"
+ " self fullBounds.
+ self layoutChanged."
+
+ self flag: #noteToJohn. "Screws up when we have nested IFs. got broken in 11/97 when you made some emergency fixes for some other reason, and has never worked since... Would be nice to have a more robust reaction to this!!"
+ "
+ self removeEmptyLayoutMorphs.
+
+ spacer := LayoutMorph new extent: 10 at 12.
+ spacer vResizing: #rigid.
+ self privateAddMorph: spacer atIndex: self indexForLeadingSpacer.
+
+ spacer := LayoutMorph new extent: 10 at 12.
+ spacer vResizing: #rigid.
+ self privateAddMorph: spacer atIndex: (submorphs size + 1).
+
+ self fullBounds; layoutChanged."
+ !
Item was added:
+ ----- Method: ScriptEditorMorph>>installWithNewLiteral (in category 'buttons') -----
+ installWithNewLiteral
+
+ self removeSpaces.
+ scriptName ifNotNil:
+ [playerScripted ifNotNil: [playerScripted acceptScript: self topEditor for: scriptName]]!
Item was added:
+ ----- Method: Morph>>assuredPlayer (in category '*Etoys') -----
+ assuredPlayer
+ "Answer the receiver's player, creating a new one if none currently exists"
+
+ | aPlayer |
+ (aPlayer := self player) ifNil:
+ [self assureExternalName. "a default may be given if not named yet"
+ self player: (aPlayer := self newPlayerInstance).
+ "Different morphs may demand different player types"
+ aPlayer costume: self.
+ self presenter ifNotNil: [self presenter flushPlayerListCache]].
+ ^ aPlayer!
Item was added:
+ ----- Method: Morph>>choosePenSize (in category '*Etoys') -----
+ choosePenSize
+ self assuredPlayer choosePenSize!
Item was added:
+ ----- Method: PasteUpMorph>>makeDetachable (in category '*Etoys-playfield') -----
+ makeDetachable
+ presenter
+ ifNil:
+ [self impartPrivatePresenter.
+ self borderWidth: 1; borderColor: Color green darker]
+ ifNotNil:
+ [self inform: 'This view is ALREADY detachable']!
Item was added:
+ ----- Method: ScriptEditorMorph>>rowInsertionIndexFor: (in category 'private') -----
+ rowInsertionIndexFor: aPoint
+ "Return the row into which the given morph should be inserted."
+
+ | m |
+ firstTileRow to: submorphs size do: [:i |
+ m := submorphs at: i.
+ ((m top <= aPoint y) and: [m bottom >= aPoint y]) ifTrue:
+ [(aPoint y > m center y)
+ ifTrue: [^ i]
+ ifFalse: [^ (i - 1) max: firstTileRow]]].
+ ^ firstTileRow > submorphs size
+ ifTrue:
+ [submorphs size]
+ ifFalse:
+ [(submorphs at: firstTileRow) top > aPoint y
+ ifTrue: [firstTileRow - 1]
+ ifFalse: [submorphs size]]
+ !
Item was added:
+ ----- Method: Morph>>arrowDeltaFor: (in category '*Etoys-scripting') -----
+ arrowDeltaFor: aGetSelector
+ "Answer a number indicating the default arrow delta to be
+ used in a numeric readout with the given get-selector. This is
+ a hook that subclasses of Morph can reimplement."
+ aGetSelector == #getScaleFactor
+ ifTrue: [^ 0.1].
+ ^ 1!
Item was added:
+ ----- Method: ScriptEditorMorph>>handUserRandomTile (in category 'other') -----
+ handUserRandomTile
+ "Hand the user a random-number tile, presumably to drop in the script"
+
+ self currentHand attachMorph: RandomNumberTile new markAsPartsDonor makeAllTilesGreen
+
+ !
Item was added:
+ ----- Method: Morph>>updateLiteralLabel (in category '*Etoys-support') -----
+ updateLiteralLabel
+ "Backstop -- updatingStringMorphs inform their owners with this message when they've changed; some Morphs care, others don't"!
Item was added:
+ ----- Method: ScriptEditorMorph>>buttonRowForEditor (in category 'buttons') -----
+ buttonRowForEditor
+ "Answer a row of buttons that comprise the header at the top of the Scriptor"
+
+ | aRow aString buttonFont aStatusMorph aButton aColumn aTile |
+ buttonFont := Preferences standardButtonFont.
+ aRow := AlignmentMorph newRow color: Color transparent; layoutInset: 0.
+ aRow hResizing: #shrinkWrap.
+ aRow vResizing: #shrinkWrap.
+ self hasParameter ifFalse:
+ [aRow addMorphFront:
+ (SimpleButtonMorph new
+ label: '!!' font: Preferences standardEToysFont;
+ target: self;
+ color: Color yellow;
+ borderWidth: 0;
+ actWhen: #whilePressed;
+ actionSelector: #tryMe;
+ balloonTextSelector: #tryMe).
+ aRow addTransparentSpacerOfSize: 6 at 10].
+ self addDismissButtonTo: aRow.
+ aRow addTransparentSpacerOfSize: 6 at 1.
+ aColumn := AlignmentMorph newColumn beTransparent.
+ aColumn addTransparentSpacerOfSize: 0 at 4.
+ aButton := UpdatingThreePhaseButtonMorph checkBox.
+ aButton
+ target: self;
+ actionSelector: #toggleWhetherShowingTiles;
+ getSelector: #showingMethodPane.
+ aButton setBalloonText: 'toggle between showing tiles and showing textual code' translated.
+ aColumn addMorphBack: aButton.
+ aRow addMorphBack: aColumn.
+
+ aRow addTransparentSpacerOfSize: 6 at 10.
+
+ aString := playerScripted externalName.
+ aRow addMorphBack:
+ (aButton := SimpleButtonMorph new useSquareCorners label: aString font: buttonFont; target: self; setNameTo: 'title').
+ aButton actWhen: #buttonDown; actionSelector: #offerScriptorMenu.
+ aButton
+ on: #mouseEnter send: #menuButtonMouseEnter: to: aButton;
+ on: #mouseLeave send: #menuButtonMouseLeave: to: aButton.
+
+ aButton borderColor: (Color fromRgbTriplet: #(0.065 0.258 1.0)).
+ aButton color: ScriptingSystem uniformTileInteriorColor.
+ aButton balloonTextSelector: #offerScriptorMenu.
+ aRow addTransparentSpacerOfSize: 4 at 1.
+ aButton := (Preferences universalTiles ifTrue: [SyntaxUpdatingStringMorph]
+ ifFalse: [UpdatingStringMorph]) new.
+ aButton useStringFormat;
+ target: self;
+ getSelector: #scriptTitle;
+ setNameTo: 'script name';
+ font: ScriptingSystem fontForNameEditingInScriptor;
+ putSelector: #setScriptNameTo:;
+ setProperty: #okToTextEdit toValue: true;
+ step;
+ yourself.
+ aRow addMorphBack: aButton.
+ aButton setBalloonText: 'Click here to edit the name of the script.' translated.
+ aRow addTransparentSpacerOfSize: 6 at 0.
+ self hasParameter
+ ifTrue:
+ [aTile := TypeListTile new choices: Vocabulary typeChoices dataType: nil.
+ aTile addArrows.
+ aTile setLiteral: #Number.
+ "(aButton := SimpleButtonMorph new useSquareCorners label: 'parameter' translated font: buttonFont; target: self; setNameTo: 'parameter').
+ aButton actWhen: #buttonDown; actionSelector: #handUserParameterTile.
+
+ "
+ aRow addMorphBack: aTile.
+ aTile borderColor: Color red.
+ aTile color: ScriptingSystem uniformTileInteriorColor.
+ aTile setBalloonText: 'Drag from here to get a parameter tile' translated]
+ ifFalse:
+ [aRow addMorphBack: (aStatusMorph := self scriptInstantiation statusControlMorph)].
+
+ aRow addTransparentSpacerOfSize: 6 at 1.
+
+ aRow addMorphBack:
+ (IconicButton new borderWidth: 0;
+ labelGraphic: (ScriptingSystem formAtKey: 'AddTest'); color: Color transparent;
+ actWhen: #buttonDown;
+ target: self;
+ actionSelector: #addYesNoToHand;
+ shedSelvedge;
+ balloonTextSelector: #addYesNoToHand).
+ aRow addTransparentSpacerOfSize: 12 at 10.
+ self addDestroyButtonTo: aRow.
+ (playerScripted existingScriptInstantiationForSelector: scriptName)
+ ifNotNil:
+ [:inst | inst updateStatusMorph: aStatusMorph].
+ ^ aRow!
Item was added:
+ ----- Method: PasteUpMorph>>abandonOldReferenceScheme (in category '*eToys-world menu') -----
+ abandonOldReferenceScheme
+ "Perform a one-time changeover"
+ "ActiveWorld abandonOldReferenceScheme"
+
+ Preferences setPreference: #capitalizedReferences toValue: true.
+ (self presenter allExtantPlayers collect: [:aPlayer | aPlayer class]) asSet do:
+ [:aPlayerClass |
+ aPlayerClass isUniClass ifTrue:
+ [aPlayerClass abandonOldReferenceScheme]]!
Item was added:
+ ----- Method: ScriptEditorMorph>>handUserButtonUpTile (in category 'other') -----
+ handUserButtonUpTile
+ "Hand the user a button-up tile, presumably to drop in the script"
+
+
+ self currentHand attachMorph:
+ (self presenter systemQueryPhraseWithActionString: '(Sensor noButtonPressed)' labelled: 'button up?' translated)
+ !
Item was changed:
----- Method: TileMorph class>>initialize (in category 'class initialization') -----
initialize
"TileMorph readInArrowGraphics -- call manually if necessary to bring graphics forward"
"TileMorph initialize"
UpdatingOperators := Dictionary new.
UpdatingOperators at: #incr: put: #+.
UpdatingOperators at: #decr: put: #-.
UpdatingOperators at: #set: put: ''.
+ self downPicture; upPicture; suffixPicture; retractPicture.
+ SuffixArrowAllowance := 5 + self suffixPicture width + self retractPicture width.
-
- RetractPicture ifNil: [
- RetractPicture := (SuffixPicture flipBy: #horizontal centerAt: (SuffixPicture center))].
- SuffixArrowAllowance := 5 + SuffixPicture width + RetractPicture width.
UpArrowAllowance := 10.
!
Item was added:
+ ----- Method: ScriptEditorMorph>>methodString (in category 'other') -----
+ methodString
+ "Answer the source-code string for the receiver. This is for use by classic tiles, but is also used in universal tiles to formulate an initial method declaration for a nascent user-defined script; in universalTiles mode, the codeString (at present anyway) is empty -- the actual code derives from the SyntaxMorph in that case"
+
+ | k methodNode string |
+ playerScripted class compileSilently: (string := String streamContents:
+ [:aStream |
+ aStream nextPutAll: scriptName.
+ scriptName endsWithAColon ifTrue:
+ [aStream nextPutAll: ' parameter'].
+ aStream cr; cr; tab.
+ aStream nextPutAll: self codeString.
+ ]) classified: 'temporary'.
+
+ k := KedamaVectorizer new initialize.
+ (k includesTurtlePlayer: (playerScripted class decompile: scriptName) for: playerScripted) ifFalse: [^ string].
+
+ methodNode := k vectorize: (playerScripted class decompile: scriptName) object: playerScripted.
+ ^ methodNode decompileString.
+ !
Item was added:
+ ----- Method: Morph>>changeAllBorderColorsFrom:to: (in category '*Etoys-support') -----
+ changeAllBorderColorsFrom: oldColor to: newColor
+ "Set any occurrence of oldColor as a border color in my entire submorph tree to be newColor"
+
+ (self allMorphs select: [:m | m respondsTo: #borderColor:]) do:
+ [:aMorph | aMorph borderColor = oldColor ifTrue: [aMorph borderColor: newColor]]!
Item was added:
+ ----- Method: PasteUpMorph>>viewByIcon (in category '*Etoys-viewing') -----
+ viewByIcon
+ "The receiver has been being viewed in some constrained layout view; now restore it to its normal x-y-layout view"
+
+ | oldSubs |
+ self showingListView
+ ifTrue:
+ [oldSubs := submorphs.
+ self removeAllMorphs.
+ self layoutPolicy: nil.
+ oldSubs do:
+ [:aSubmorph |
+ self addMorphBack: aSubmorph objectRepresented].
+ self restoreBoundsOfSubmorphs.
+ self removeProperty: #showingListView]
+ ifFalse:
+ [self autoLineLayout == true ifTrue: [self toggleAutoLineLayout]]!
Item was added:
+ ----- Method: Vocabulary class>>instanceWhoRespondsTo: (in category '*Etoys-queries') -----
+ instanceWhoRespondsTo: aSelector
+ "Find the most likely class that responds to aSelector. Return an instance
+ of it. Look in vocabularies to match the selector."
+ "Most eToy selectors are for Players"
+ | mthRefs |
+ ((self vocabularyNamed: #eToy)
+ includesSelector: aSelector)
+ ifTrue: [aSelector == #+
+ ifFalse: [^ Player new costume: Morph new]].
+ "Numbers are a problem"
+ ((self vocabularyNamed: #Number)
+ includesSelector: aSelector)
+ ifTrue: [^ 1].
+ "Is a Float any different?"
+ "String Point Time Date"
+ #()
+ do: [:nn | ((self vocabularyNamed: nn)
+ includesSelector: aSelector)
+ ifTrue: ["Ask Scott how to get a prototypical instance"
+ ^ (Smalltalk at: nn) new]].
+ mthRefs := self systemNavigation allImplementorsOf: aSelector.
+ "every one who implements the selector"
+ mthRefs
+ sortBlock: [:a :b | (Smalltalk at: a classSymbol) allSuperclasses size < (Smalltalk at: b classSymbol) allSuperclasses size].
+ mthRefs size > 0
+ ifTrue: [^ (Smalltalk at: mthRefs first classSymbol) new].
+ ^ Error new!
Item was added:
+ ----- Method: EtoysPresenter>>ownStandardPalette (in category 'palette & parts bin') -----
+ ownStandardPalette
+ ^ standardPalette!
Item was added:
+ ----- Method: Morph>>viewAfreshIn:showingScript:at: (in category '*Etoys-scripting') -----
+ viewAfreshIn: aPasteUp showingScript: aScriptName at: aPosition
+ "Obtain a smartly updated ScriptEditor for the given script name and zap it into place at aPosition"
+
+ | anEditor |
+ self player updateAllViewersAndForceToShow: #scripts.
+ anEditor := self player scriptEditorFor: aScriptName.
+ aPasteUp ifNotNil: [aPasteUp addMorph: anEditor].
+ anEditor position: aPosition.
+ anEditor currentWorld startSteppingSubmorphsOf: anEditor!
Item was added:
+ ----- Method: Morph>>jettisonScripts (in category '*Etoys-scripting') -----
+ jettisonScripts
+ self player ifNotNil: [self player class jettisonScripts]!
Item was added:
+ ----- Method: Morph class>>unfilteredCategoriesForViewer (in category '*Etoys') -----
+ unfilteredCategoriesForViewer
+ "Answer a list of symbols representing the categories to offer in the viewer for one of my instances, in order of:
+ - masterOrderingOfCategorySymbols first
+ - others last in order by translated wording"
+ "
+ Morph unfilteredCategoriesForViewer
+ "
+
+ | aClass additions masterOrder |
+ aClass := self.
+ additions := OrderedCollection new.
+ [aClass == Morph superclass ] whileFalse: [
+ additions addAll: (aClass allAdditionsToViewerCategories keys asArray
+ sort: [ :a :b | a translated < b translated ]).
+ aClass := aClass superclass ].
+
+ masterOrder := EToyVocabulary masterOrderingOfCategorySymbols.
+
+ ^(masterOrder intersection: additions), (additions difference: masterOrder).!
Item was added:
+ ----- Method: Object>>tilePhrasesForSelectorList:inViewer: (in category '*Etoys-viewer') -----
+ tilePhrasesForSelectorList: aList inViewer: aViewer
+ "Particular to the search facility in viewers. Answer a list, in appropriate order, of ViewerLine objects to put into the viewer."
+
+ | interfaces aVocab |
+ aVocab := aViewer currentVocabulary.
+ interfaces := self
+ methodInterfacesInPresentationOrderFrom:
+ (aList collect: [:aSel | aVocab methodInterfaceForSelector: aSel class: self class])
+ forCategory: #search.
+ ^ self tilePhrasesForMethodInterfaces: interfaces inViewer: aViewer!
Item was added:
+ ----- Method: Morph>>affiliatedSelector (in category '*Etoys-support') -----
+ affiliatedSelector
+ "Answer a selector affiliated with the receiver for the purposes of launching a messenger. Reimplement this to plug into the messenger service"
+
+ ^ nil!
Item was added:
+ ----- Method: ScriptEditorMorph>>isTileScriptingElement (in category 'scripting') -----
+ isTileScriptingElement
+ ^ true!
Item was added:
+ ----- Method: PasteUpMorph>>drawPenTrailFor:from:to: (in category '*Etoys-playfield') -----
+ drawPenTrailFor: aMorph from: oldPoint to: targetPoint
+ "Draw a pen trail for aMorph, using its pen state (the pen is assumed to be down)."
+ "The turtleTrailsForm is created on demand when the first pen is put down and removed (to save space) when turtle trails are cleared."
+
+ | origin mPenSize offset turtleTrailsDelta newPoint aPlayer trailStyle aRadius dotSize |
+ turtleTrailsDelta := self valueOfProperty: #turtleTrailsDelta ifAbsent:[0 at 0].
+ newPoint := targetPoint - turtleTrailsDelta.
+ oldPoint = newPoint ifTrue: [^ self].
+ self createOrResizeTrailsForm.
+ origin := self topLeft.
+ mPenSize := aMorph getPenSize.
+ turtlePen color: aMorph getPenColor.
+ turtlePen sourceForm width ~= mPenSize
+ ifTrue: [turtlePen squareNib: mPenSize].
+ offset := (mPenSize // 2)@(mPenSize // 2).
+ (#(lines arrows) includes: (trailStyle := (aPlayer := aMorph player) getTrailStyle))
+ ifTrue:
+ [turtlePen drawFrom: (oldPoint - origin - offset) asIntegerPoint
+ to: (newPoint - origin - offset) asIntegerPoint].
+ ((#(arrowheads arrows) includes: trailStyle) and: [oldPoint ~= newPoint]) ifTrue:
+ [turtlePen
+ arrowHeadFrom: (oldPoint - origin - offset)
+ to: (newPoint - origin - offset)
+ forPlayer: aPlayer].
+ (#(dots) includes: trailStyle)
+ ifTrue:
+ [dotSize := aPlayer getDotSize.
+ turtlePen
+ putDotOfDiameter: dotSize at: (oldPoint - origin).
+ turtlePen
+ putDotOfDiameter: dotSize at: (targetPoint - origin).
+ aRadius := (dotSize // 2) + 1.
+ dotSize := dotSize + 1. "re round-off-derived gribblies"
+ self invalidRect: ((oldPoint - origin - (aRadius @ aRadius)) extent: (dotSize @ dotSize)).
+ self invalidRect: ((targetPoint - origin - (aRadius @ aRadius)) extent: (dotSize @ dotSize))]
+ ifFalse:
+ [self invalidRect: ((oldPoint rect: newPoint) expandBy: mPenSize)]!
Item was changed:
----- Method: PluggableTileScriptorMorph>>update: (in category 'updating') -----
update: aSymbol
"Update the receiver in the manner suggested by aSymbol"
aSymbol == #flash ifTrue: [^ self flash].
+ !
- (aSymbol == #contents or: [aSymbol == #tiles])
- ifTrue: [^ self containingWindow model installTilesForSelection]!
Item was added:
+ ----- Method: Morph>>goToPreviousCardInStack (in category '*Etoys-card in a stack') -----
+ goToPreviousCardInStack
+ "Tell my stack to advance to the previous card"
+
+ self stackDo: [:aStack | aStack goToPreviousCardInStack]!
Item was added:
+ ----- Method: EtoysPresenter>>reportPlayersAndScripts (in category 'playerList') -----
+ reportPlayersAndScripts
+ "Open a window which contains a report on players and their scripts"
+
+ | aList aString |
+ (aList := self uniclassesAndCounts) ifEmpty: [^ self inform: 'there are no scripted players' translated].
+ aString := String streamContents:
+ [:aStream |
+ aList do:
+ [:aPair |
+ aStream nextPutAll: aPair first name, ' -- ', aPair second printString.
+ aStream nextPutAll: ' ', (aPair second > 1 ifTrue: ['instances'] ifFalse: ['instance']) translated, ', '.
+ aStream nextPutAll: 'named' translated.
+ aPair first allInstancesDo: [:inst | aStream space; nextPutAll: inst externalName].
+ aStream cr].
+ aStream cr.
+ aList do:
+ [:aPair |
+ aStream cr.
+ aStream nextPutAll:
+ '--------------------------------------------------------------------------------------------'.
+ aStream cr; nextPutAll: aPair first typicalInstanceName.
+ aStream nextPutAll: '''s' translated.
+ aStream nextPutAll: ' scripts:' translated.
+ aPair first addDocumentationForScriptsTo: aStream]].
+
+ (StringHolder new contents: aString)
+ openLabel: 'All scripts in this project' translated
+
+ "self currentWorld presenter reportPlayersAndScripts"!
Item was added:
+ ----- Method: Morph>>beep: (in category '*Etoys-support') -----
+ beep: soundName
+
+ self playSoundNamed: soundName
+ !
Item was added:
+ ----- Method: BorderedMorph>>understandsBorderVocabulary (in category '*Etoys') -----
+ understandsBorderVocabulary
+ "Replace the 'isKindOf: BorderedMorph' so that (for instance) Connectors can have their border vocabulary visible in viewers."
+ ^true!
Item was added:
+ ----- Method: ScriptEditorMorph>>isTileEditor (in category 'e-toy support') -----
+ isTileEditor
+ "Yes I am"
+ ^true!
Item was added:
+ ----- Method: Morph>>currentVocabulary (in category '*Etoys') -----
+ currentVocabulary
+ "Answer the receiver's current vocabulary"
+
+ | outer |
+ ^ (outer := self ownerThatIsA: StandardViewer orA: ScriptEditorMorph)
+ ifNotNil:
+ [outer currentVocabulary]
+ ifNil:
+ [super currentVocabulary]!
Item was added:
+ ----- Method: Morph>>buttonProperties: (in category '*Etoys-support') -----
+ buttonProperties: propertiesOrNil
+
+ propertiesOrNil ifNil: [
+ self removeProperty: #universalButtonProperties
+ ] ifNotNil: [
+ self setProperty: #universalButtonProperties toValue: propertiesOrNil
+ ].!
Item was added:
+ ----- Method: ScriptEditorMorph>>addParameter (in category 'other') -----
+ addParameter
+ "Transform the receiver so that it bears a parameter. This will require a selector change, e.g. from #script3 to #script3:"
+
+ playerScripted startHavingParameterFor: scriptName asSymbol!
Item was added:
+ ----- Method: PasteUpMorph>>autoExpansionString (in category '*Etoys-viewing') -----
+ autoExpansionString
+ "Answer the string to be shown in a menu to represent the
+ auto-phrase-expansion status"
+ ^ ((self hasProperty: #automaticPhraseExpansion)
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'auto-phrase-expansion' translated!
Item was added:
+ ----- Method: Morph>>becomeSharedBackgroundField (in category '*Etoys-card in a stack') -----
+ becomeSharedBackgroundField
+ "Mark the receiver as holding separate data for each instance (i.e., like a 'background field') and reassess the shape of the corresponding background so that it will be able to accommodate this arrangement."
+
+ ((self hasProperty: #shared) and: [self hasProperty: #holdsSeparateDataForEachInstance])
+ ifFalse:
+ [self setProperty: #shared toValue: true.
+ self setProperty: #holdsSeparateDataForEachInstance toValue: true.
+ self stack reassessBackgroundShape]!
Item was added:
+ ----- Method: Morph>>restoreTypeColor (in category '*Etoys-scripting') -----
+ restoreTypeColor
+ self player ifNotNil: [self player allScriptEditors do:
+ [:anEditor | anEditor allMorphsDo:
+ [:m | m restoreTypeColor]]]!
Item was added:
+ ----- Method: EtoysPresenter>>viewObject: (in category 'viewer') -----
+ viewObject: anObject
+ "Open up and return a viewer on the given object. If the object is a Morph, open a viewer on its associated Player"
+
+ anObject isMorph
+ ifTrue:
+ [self viewMorph: anObject] "historic morph/player implementation"
+ ifFalse:
+ [self viewObjectDirectly: anObject]!
Item was added:
+ ----- Method: EtoysPresenter>>viewMorph: (in category 'viewer') -----
+ viewMorph: aMorph
+ | aPlayer openViewers aViewer aPalette aRect aPoint nominalHeight aFlapTab topItem flapLoc |
+ Sensor leftShiftDown
+ ifFalse:
+ [((aPalette := aMorph standardPalette) notNil and: [aPalette isInWorld])
+ ifTrue: [^aPalette viewMorph: aMorph]].
+ aPlayer := (topItem := aMorph topRendererOrSelf) assuredPlayer.
+ openViewers := aPlayer allOpenViewers.
+ aViewer := openViewers isEmpty ifFalse: [ openViewers first ] ifTrue: [ self nascentPartsViewer ].
+ self cacheSpecs: topItem. "redo the spec cache once in a while"
+
+ "19 sept 2000 - allow flaps in any paste up"
+ flapLoc := associatedMorph. "world"
+ Preferences viewersInFlaps ifTrue: [
+ aViewer owner ifNotNil: [ :f | ^f flapTab showFlap; yourself ].
+ aViewer setProperty: #noInteriorThumbnail toValue: true.
+ aViewer initializeFor: aPlayer barHeight: 0.
+ aViewer enforceTileColorPolicy.
+ aViewer fullBounds. "force layout"
+ "associatedMorph addMorph: aViewer." "why???"
+ flapLoc hideViewerFlapsOtherThanFor: aPlayer.
+ aFlapTab := flapLoc viewerFlapTabFor: topItem.
+ aFlapTab referent submorphs
+ do: [:m | (m isKindOf: Viewer) ifTrue: [m delete]].
+ aViewer visible: true.
+ aFlapTab applyThickness: aViewer width + 25.
+ aFlapTab spanWorld.
+ aFlapTab showFlap.
+ aViewer position: aFlapTab referent position.
+ aFlapTab referent addMorph: aViewer beSticky. "moved"
+ flapLoc startSteppingSubmorphsOf: aFlapTab.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ ^aFlapTab].
+ aViewer initializeFor: aPlayer barHeight: 6.
+ aViewer enforceTileColorPolicy.
+ aViewer fullBounds. "force layout"
+ Preferences automaticViewerPlacement
+ ifTrue:
+ [aPoint := aMorph bounds right
+ @ (aMorph center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)).
+ aRect := (aPoint extent: aViewer width @ nominalHeight)
+ translatedToBeWithin: flapLoc bounds.
+ aViewer position: aRect topLeft.
+ aViewer visible: true.
+ associatedMorph addMorph: aViewer.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ "it's already in the world, somewhat coincidentally"
+ ^aViewer].
+ aMorph primaryHand attachMorph: (aViewer visible: true).
+ ^aViewer!
Item was added:
+ ----- Method: ScriptEditorMorph>>setScriptNameTo: (in category 'other') -----
+ setScriptNameTo: aNewName
+ "The user has typed into the script-name pane. Accept the changed contents as the new script name, and take action accordingly"
+
+ playerScripted renameScript: self scriptName newSelector:
+ (playerScripted acceptableScriptNameFrom: aNewName forScriptCurrentlyNamed: self scriptName)!
Item was added:
+ ----- Method: PasteUpMorph>>fenceEnabled: (in category '*Etoys-viewing') -----
+ fenceEnabled: aBoolean
+
+ self setProperty: #fenceEnabled toValue: aBoolean!
Item was added:
+ ----- Method: ScriptEditorMorph>>becomeTextuallyCoded (in category 'other') -----
+ becomeTextuallyCoded
+ "If the receiver is not currently textually coded, make it become so now, and show its source in place in the Scriptor"
+
+ self isTextuallyCoded ifTrue: [^ self].
+ self saveScriptVersion.
+ Preferences universalTiles ifFalse: [self userScriptObject becomeTextuallyCoded].
+ (submorphs copyFrom: 2 to: submorphs size) do: [:m | m delete]!
Item was added:
+ ----- Method: PasteUpMorph>>addImageToPenTrailsFor: (in category '*Etoys-pen') -----
+ addImageToPenTrailsFor: aMorph
+
+ "The turtleTrailsForm is created on demand when the first pen is put down and removed (to save space) when turtle trails are cleared."
+ | image |
+
+ self createOrResizeTrailsForm.
+ "origin := self topLeft."
+ image := aMorph imageForm offset: 0 at 0.
+ image
+ displayOn: turtleTrailsForm
+ at: aMorph topLeft - self topLeft
+ rule: Form paint.
+ self invalidRect: (image boundingBox translateBy: aMorph topLeft).
+ !
Item was added:
+ ----- Method: EtoysPresenter>>reinvigoratePlayersTool: (in category 'playerList') -----
+ reinvigoratePlayersTool: aPlayersTool
+ "Rebuild the contents of the Players tool"
+
+ | firstTwo oldList newList rowsForPlayers |
+ firstTwo := {aPlayersTool submorphs first. aPlayersTool submorphs second}.
+ oldList := (aPlayersTool submorphs copyFrom: 3 to: aPlayersTool submorphs size) collect:
+ [:aRow |
+ aRow playerRepresented].
+ self flushPlayerListCache.
+ newList := self allExtantPlayers.
+ oldList asSet = newList asSet
+ ifFalse:
+ [aPlayersTool removeAllMorphs; addAllMorphs: firstTwo.
+ rowsForPlayers := newList collect:
+ [:aPlayer | aPlayer entryForPlayersTool: aPlayersTool].
+ aPlayersTool addAllMorphs: rowsForPlayers ]!
Item was added:
+ ----- Method: ScriptEditorMorph>>wantsHaloHandleWithSelector:inHalo: (in category 'menus') -----
+ wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph
+ "Answer whether the receiver would like to offer the halo handle with the given selector (e.g. #addCollapseHandle:)"
+
+ (#(addDupHandle: addMakeSiblingHandle:) includes: aSelector) ifTrue:
+ [^ false].
+
+ ^ super wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph!
Item was added:
+ ----- Method: Object>>chooseNewNameForReference (in category '*Etoys-viewer') -----
+ chooseNewNameForReference
+ "Offer an opportunity for the receiver, presumed already to be known in the References registry, to be renamed"
+
+ | nameSym current newName |
+ current := References keyAtValue: self ifAbsent: [^ self error: 'not found in References'].
+
+ newName := UIManager default request: 'Please enter new name' initialAnswer: current.
+ "Want to user some better way of determining the validity of the chosen identifier, and also want to give more precise diagnostic if the string the user types in is not acceptable. Work to be done here."
+
+ newName isEmpty ifTrue: [^ nil].
+ ((Scanner isLiteralSymbol: newName) and: [(newName includes: $:) not])
+ ifTrue:
+ [nameSym := newName capitalized asSymbol.
+ (((References includesKey: nameSym) not and:
+ [(Smalltalk includesKey: nameSym) not]) and:
+ [(ScriptingSystem allKnownClassVariableNames includes: nameSym) not])
+ ifTrue:
+ [(References associationAt: current) key: nameSym.
+ References rehash.
+ ^ nameSym]].
+ self inform: 'Sorry, that name is not available.'.
+ ^ nil!
Item was added:
+ ----- Method: StandardScriptingSystem class>>removePlayersIn: (in category '*Etoys') -----
+ removePlayersIn: project
+ "Remove existing player references for project"
+
+ References keys do:
+ [:key | (References at: key) costume pasteUpMorph == project world
+ ifTrue: [References removeKey: key]].
+ !
Item was added:
+ ----- Method: Morph>>filterViewerCategoryDictionary: (in category '*Etoys-scripting') -----
+ filterViewerCategoryDictionary: dict
+ "dict has keys of categories and values of priority.
+ You can re-order or remove categories here."
+
+ self wantsConnectionVocabulary
+ ifFalse: [ dict removeKey: #'connections to me' ifAbsent: [].
+ dict removeKey: #connection ifAbsent: []].
+ self wantsConnectorVocabulary
+ ifFalse: [ dict removeKey: #connector ifAbsent: [] ].
+ self wantsEmbeddingsVocabulary
+ ifFalse: [dict removeKey: #embeddings ifAbsent: []].
+ Preferences eToyFriendly
+ ifTrue:
+ [dict removeKey: #layout ifAbsent: []].
+ (Preferences eToyFriendly or: [self isWorldMorph not]) ifTrue:
+ [dict removeKey: #preferences ifAbsent: []].!
Item was added:
+ ----- Method: Morph>>containsCard: (in category '*Etoys-card in a stack') -----
+ containsCard: aCard
+ "Answer whether the given card belongs to the uniclass representing the receiver"
+
+ ^ self isStackBackground and: [aCard isKindOf: self player class baseUniclass]!
Item was removed:
- ----- Method: Presenter>>allKnownUnaryScriptSelectors (in category 'playerList') -----
- allKnownUnaryScriptSelectors
- "Answer a list of all the unary selectors implemented by any user-scripted objected within the scope of the receiver; include #emptyScript as a bail-out"
-
- | aSet allUniclasses |
- aSet := Set with: #emptyScript.
- allUniclasses := (self allPlayersWithUniclasses collect:
- [:aPlayer | aPlayer class]) asSet.
- allUniclasses do:
- [:aUniclass | aSet addAll: aUniclass namedUnaryTileScriptSelectors].
- ^ aSet asSortedArray
-
- "ActiveWorld presenter allKnownUnaryScriptSelectors"
- !
Item was removed:
- ----- Method: Preferences class>>allowEtoyUserCustomEvents (in category '*eToys-customevents-preferences') -----
- allowEtoyUserCustomEvents
- ^ self
- valueOfFlag: #allowEtoyUserCustomEvents
- ifAbsent: [false]!
Item was removed:
- ----- Method: SyntaxMorph>>inAPluggableScrollPane (in category 'initialization') -----
- inAPluggableScrollPane
- "Answer a PluggableTileScriptorMorph that holds the receiver"
-
- | widget |
- widget := PluggableTileScriptorMorph new.
- widget extent: 10 at 10; borderWidth: 0.
- widget scroller addMorph: self.
- widget setScrollDeltas.
- widget hResizing: #spaceFill; vResizing: #spaceFill.
- ^ widget
-
- !
Item was removed:
- ----- Method: Presenter>>allKnownScriptSelectors (in category 'playerList') -----
- allKnownScriptSelectors
- "Answer a list of all the selectors implemented by any user-scripted objected within the scope of the receiver"
-
- | aSet allUniclasses |
- aSet := Set with: ('script' translated , '1') asSymbol.
- allUniclasses := (self presenter allPlayersWithUniclasses collect:
- [:aPlayer | aPlayer class]) asSet.
- allUniclasses do:
- [:aUniclass | aSet addAll: aUniclass namedTileScriptSelectors].
- ^ aSet asSortedArray
-
- "ActiveWorld presenter allKnownScriptSelectors"
- !
Item was removed:
- ----- Method: Presenter>>phraseForReceiver:op:arg:resultType: (in category 'tile support') -----
- phraseForReceiver: rcvr op: op arg: arg resultType: resultType
- "Answer a PhraseTileMorph affiliated with the given receiver, initialized to hold the given operator, argument, and result type"
-
- | m argTile rcvrTile |
- arg isNil
- ifTrue:
- [m := PhraseTileMorph new
- setOperator: op
- type: resultType
- rcvrType: (self typeForConstant: rcvr)]
- ifFalse:
- [m := PhraseTileMorph new
- setOperator: op
- type: resultType
- rcvrType: (self typeForConstant: rcvr)
- argType: (self typeForConstant: arg).
- argTile := self constantTile: arg.
- argTile position: m lastSubmorph position.
- m lastSubmorph addMorph: argTile].
- rcvrTile := self constantTile: rcvr.
- " TilePadMorph makeReceiverColorOfResultType ifTrue: [rcvrTile color: m color]."
- rcvrTile position: m firstSubmorph position.
- m firstSubmorph addMorph: rcvrTile.
- m vResizing: #shrinkWrap.
- ^m!
Item was removed:
- ----- Method: Presenter>>cacheSpecs: (in category 'viewer') -----
- cacheSpecs: aMorph
- "For SyntaxMorph's type checking, cache the list of all viewer command specifications."
-
- aMorph world ifNil: [^ true].
- Preferences universalTiles ifFalse: [^ true].
- Preferences eToyFriendly ifFalse: [^ true]. "not checking"
- (Project current projectParameterAt: #fullCheck ifAbsent: [false])
- ifFalse: [^ true]. "not checking"
-
- SyntaxMorph initialize.!
Item was removed:
- ----- Method: Presenter>>constantTile: (in category 'tile support') -----
- constantTile: anObject
- "Answer a constant tile that represents the object"
-
- (anObject isColor)
- ifTrue:
- [^ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)].
- ^anObject newTileMorphRepresentative
- typeColor: (ScriptingSystem colorForType: (self typeForConstant: anObject))!
Item was removed:
- ----- Method: Presenter>>standardPlayfield: (in category 'misc') -----
- standardPlayfield: aPlayfield
- standardPlayfield := aPlayfield!
Item was removed:
- ----- Method: Presenter>>systemQueryPhraseWithActionString:labelled: (in category 'palette & parts bin') -----
- systemQueryPhraseWithActionString: anActionString labelled: aLabel
- "Answer a SystemQueryPhrase with the given action string and label"
-
- | aTile aPhrase |
-
- aPhrase := SystemQueryPhrase new.
- aTile := BooleanTile new.
- aTile setExpression: anActionString label: aLabel.
- aPhrase addMorph: aTile.
- aPhrase enforceTileColorPolicy.
- ^ aPhrase!
Item was removed:
- ----- Method: Presenter>>allStopButtons (in category 'stop-step-go buttons') -----
- allStopButtons
- "Answer a list of all script-controlling Stop buttons within my scope"
-
- ^ associatedMorph allMorphs select:
- [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
- [aMorph actionSelector == #stopUp:with:]]
-
- "ActiveWorld presenter allStopButtons"!
Item was removed:
- ----- Method: Presenter>>currentlyViewing: (in category 'misc') -----
- currentlyViewing: aPlayer
- "Only detects viewers in tabs"
-
- aPlayer ifNil: [^false].
- ^aPlayer viewerFlapTab notNil!
Item was removed:
- ----- Method: Presenter>>tempCommand (in category 'misc') -----
- tempCommand
- Transcript cr; show: '#tempCommand invoked for Presenter'!
Item was removed:
- Object subclass: #Presenter
- instanceVariableNames: 'associatedMorph standardPlayer standardPlayfield standardPalette playerList'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'EToys-Scripting'!
-
- !Presenter commentStamp: '<historical>' prior: 0!
- Optionally associated with a PasteUpMorph, provides a local scope for the running of scripts.
-
- Once more valuable, may be again, but at present occupies primarily a historical niche.
-
- Maintains a playerList cache.
-
- Holds, optionally three 'standard items' -- standardPlayer standardPlayfield standardPalette -- originally providing idiomatic support of ongoing squeak-team internal work, but now extended to more general applicability.
-
- !
Item was removed:
- ----- Method: Presenter>>associatedMorph (in category 'access') -----
- associatedMorph
- ^ associatedMorph!
Item was removed:
- ----- Method: Presenter>>nascentPartsViewer (in category 'viewer') -----
- nascentPartsViewer
- ^ StandardViewer new!
Item was removed:
- ----- Method: Presenter>>adaptedToWorld: (in category 'scripting') -----
- adaptedToWorld: aWorld
- "If I refer to a world or a hand, return the corresponding items in the new world."
- ^aWorld presenter!
Item was removed:
- ----- Method: Presenter>>viewObjectDirectly: (in category 'viewer') -----
- viewObjectDirectly: anObject
- "Open up and return a viewer on the given object"
-
- | aViewer aRect aPoint nominalHeight aFlapTab flapLoc |
-
- associatedMorph addMorph: (aViewer := self nascentPartsViewerFor: anObject).
- flapLoc := associatedMorph "world".
- Preferences viewersInFlaps ifTrue:
- [aViewer setProperty: #noInteriorThumbnail toValue: true.
- aViewer initializeFor: anObject barHeight: 0.
- aViewer enforceTileColorPolicy.
- flapLoc hideViewerFlapsOtherThanFor: anObject.
- aFlapTab := flapLoc viewerFlapTabFor: anObject.
- aFlapTab referent submorphs do:
- [:m | (m isKindOf: Viewer) ifTrue: [m delete]].
- aFlapTab referent addMorph: aViewer beSticky.
- aViewer visible: true.
- aFlapTab applyThickness: aViewer width + 25.
- aFlapTab spanWorld.
- aFlapTab showFlap.
- aViewer position: aFlapTab referent position.
- flapLoc startSteppingSubmorphsOf: aFlapTab.
- flapLoc startSteppingSubmorphsOf: aViewer.
- ^ aFlapTab].
-
- "Caution: the branch below is historical and has not been used for a long time, though if you set the #viewersInFlaps preference to false you'd hit it. Not at all recently maintained."
- aViewer initializeFor: anObject barHeight: 6.
- aViewer enforceTileColorPolicy.
- Preferences automaticViewerPlacement ifTrue:
- [aPoint := anObject bounds right @
- (anObject center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)).
- aRect := (aPoint extent: (aViewer width @ nominalHeight)) translatedToBeWithin: flapLoc bounds.
- aViewer position: aRect topLeft.
- aViewer visible: true.
- flapLoc startSteppingSubmorphsOf: aViewer.
- "it's already in the world, somewhat coincidentally"
- ^ aViewer].
- anObject primaryHand attachMorph: (aViewer visible: true).
- ^aViewer!
Item was removed:
- ----- Method: Presenter>>printOn: (in category 'printing') -----
- printOn: aStream
- super printOn: aStream.
- aStream nextPutAll: ' (', self identityHash printString, ')'!
Item was removed:
- ----- Method: Presenter>>reportPlayersAndScripts (in category 'playerList') -----
- reportPlayersAndScripts
- "Open a window which contains a report on players and their scripts"
-
- | aList aString |
- (aList := self uniclassesAndCounts) ifEmpty: [^ self inform: 'there are no scripted players' translated].
- aString := String streamContents:
- [:aStream |
- aList do:
- [:aPair |
- aStream nextPutAll: aPair first name, ' -- ', aPair second printString.
- aStream nextPutAll: ' ', (aPair second > 1 ifTrue: ['instances'] ifFalse: ['instance']) translated, ', '.
- aStream nextPutAll: 'named' translated.
- aPair first allInstancesDo: [:inst | aStream space; nextPutAll: inst externalName].
- aStream cr].
- aStream cr.
- aList do:
- [:aPair |
- aStream cr.
- aStream nextPutAll:
- '--------------------------------------------------------------------------------------------'.
- aStream cr; nextPutAll: aPair first typicalInstanceName.
- aStream nextPutAll: '''s' translated.
- aStream nextPutAll: ' scripts:' translated.
- aPair first addDocumentationForScriptsTo: aStream]].
-
- (StringHolder new contents: aString)
- openLabel: 'All scripts in this project' translated
-
- "self currentWorld presenter reportPlayersAndScripts"!
Item was removed:
- ----- Method: Presenter>>startRunningScriptsFrom: (in category 'stop-step-go buttons') -----
- startRunningScriptsFrom: ignored
- "Start running all scripts. Get all script-control buttons to show the right thing."
-
- self startRunningScripts!
Item was removed:
- ----- Method: Presenter>>morph:droppedIntoPasteUpMorph: (in category 'misc') -----
- morph: aMorph droppedIntoPasteUpMorph: aPasteUpMorph
- aPasteUpMorph automaticViewing ifTrue:
- [aMorph isCandidateForAutomaticViewing ifTrue:
- [self viewMorph: aMorph]]!
Item was removed:
- ----- Method: Presenter>>reinvigoratePlayersTool: (in category 'playerList') -----
- reinvigoratePlayersTool: aPlayersTool
- "Rebuild the contents of the Players tool"
-
- | firstTwo oldList newList rowsForPlayers |
- firstTwo := {aPlayersTool submorphs first. aPlayersTool submorphs second}.
- oldList := (aPlayersTool submorphs copyFrom: 3 to: aPlayersTool submorphs size) collect:
- [:aRow |
- aRow playerRepresented].
- self flushPlayerListCache.
- newList := self allExtantPlayers.
- oldList asSet = newList asSet
- ifFalse:
- [aPlayersTool removeAllMorphs; addAllMorphs: firstTwo.
- rowsForPlayers := newList collect:
- [:aPlayer | aPlayer entryForPlayersTool: aPlayersTool].
- aPlayersTool addAllMorphs: rowsForPlayers ]!
Item was removed:
- ----- Method: MorphExtension>>actorState: (in category '*eToys-accessing') -----
- actorState: anActorState
- "change the receiver's actorState"
- actorState := anActorState!
Item was removed:
- ----- Method: Presenter>>associatedMorph: (in category 'access') -----
- associatedMorph: aMorph
- associatedMorph := aMorph!
Item was removed:
- ----- Method: Presenter>>stopRunningScripts (in category 'stop-step-go buttons') -----
- stopRunningScripts
- "Put all ticking scripts within my scope into paused mode. Get any scripting-control buttons to show the correct state"
-
- self stopButtonState: #on.
- self stepButtonState: #off.
- self goButtonState: #off.
- associatedMorph stopRunningAll.
-
- "associatedMorph borderColor: Preferences borderColorWhenStopped"!
Item was removed:
- ----- Method: Presenter>>stopRunningScriptsFrom: (in category 'stop-step-go buttons') -----
- stopRunningScriptsFrom: ignored
- "Stop running scripts; get all script-control buttons to reflect this"
-
- self stopRunningScripts!
Item was removed:
- ----- Method: Presenter>>stepDown:with: (in category 'stop-step-go buttons') -----
- stepDown: evt with: aMorph
- self stopRunningScripts!
Item was removed:
- ----- Method: Presenter>>valueTiles (in category 'tile support') -----
- valueTiles
- "Answer some constant-valued tiles. This dates back to very early etoy work in 1997, and presently has no senders"
-
- | tiles |
- tiles := OrderedCollection new.
- tiles add: (5 newTileMorphRepresentative typeColor: (ScriptingSystem colorForType: #Number)).
- tiles add: (ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)).
- tiles add: (TileMorph new typeColor: (ScriptingSystem colorForType: #Number);
- setExpression: '(180 atRandom)'
- label: 'random').
- tiles add: RandomNumberTile new.
- ^ tiles!
Item was removed:
- ----- Method: Presenter>>stepUp:with: (in category 'stop-step-go buttons') -----
- stepUp: evt with: aMorph
- "The step button came up; get things right"
-
- self stepButtonState: #off!
Item was removed:
- ----- Method: Presenter>>stepButtonState: (in category 'stop-step-go buttons') -----
- stepButtonState: newState
- "Get all step buttons in my scope to show the correct state"
-
- self allStepButtons do:
- [:aButton | aButton state: newState]!
Item was removed:
- SystemOrganization addCategory: #'EToys-Buttons'!
- SystemOrganization addCategory: #'EToys-CustomEvents'!
- SystemOrganization addCategory: #'EToys-Experimental'!
- SystemOrganization addCategory: #'EToys-Outliner'!
- SystemOrganization addCategory: #'EToys-Protocols'!
- SystemOrganization addCategory: #'EToys-Protocols-Type Vocabularies'!
- SystemOrganization addCategory: #'EToys-Scripting'!
- SystemOrganization addCategory: #'EToys-Scripting Support'!
- SystemOrganization addCategory: #'EToys-Scripting Tiles'!
- SystemOrganization addCategory: #'EToys-Stacks'!
- SystemOrganization addCategory: #'EToys-StarSqueak'!
- SystemOrganization addCategory: #'EToys-Tile Scriptors'!
- SystemOrganization addCategory: #'EToys-Widgets'!
Item was removed:
- ----- Method: Presenter>>hasAnyTextuallyCodedScripts (in category 'playerList') -----
- hasAnyTextuallyCodedScripts
- "Answer whether any uniclasses in the receiver have any textually coded scripts"
-
- self uniclassesAndCounts do:
- [:classAndCount |
- classAndCount first scripts do:
- [:aScript | aScript isTextuallyCoded ifTrue: [^ true]]].
- ^ false
-
- "
- ActiveWorld presenter hasAnyTextuallyCodedScripts
- "!
Item was removed:
- ----- Method: Presenter>>startRunningScripts (in category 'stop-step-go buttons') -----
- startRunningScripts
- "Start running scripts; get stop-step-go buttons to show the right thing"
-
- self stopButtonState: #off.
- self stepButtonState: #off.
- self goButtonState: #on.
- associatedMorph startRunningAll.
-
- "associatedMorph borderColor: Preferences borderColorWhenRunning."
-
- ThumbnailMorph recursionReset. "needs to be done once in a while (<- tk note from 1997)"!
Item was removed:
- ----- Method: Presenter>>standardPlayer (in category 'standardPlayer etc') -----
- standardPlayer
- standardPlayer ifNil:
- [self createStandardPlayer].
- standardPlayer costume isInWorld ifFalse: [associatedMorph addMorphNearBack: standardPlayer costume].
- ^ standardPlayer!
Item was removed:
- ----- Method: MorphExtension>>player: (in category '*eToys-accessing') -----
- player: anObject
- "change the receiver's player"
- player := anObject !
Item was removed:
- ----- Method: Presenter>>booleanTiles (in category 'tile support') -----
- booleanTiles
- "Answer some boolean-valued tiles. This dates back to very early etoy work in 1997, and presently has no sent senders"
-
- | list |
- list := #(#(0 #< 1) #(0 #<= 1) #(0 #= 1) #(0 #~= 1) #(0 #> 1) #(0 #>= 1)).
- list := list asOrderedCollection collect:
- [:entry |
- | rcvr op arg |
- rcvr := entry first.
- op := (entry second) asSymbol.
- arg := entry last.
- self
- phraseForReceiver: rcvr
- op: op
- arg: arg
- resultType: #Boolean].
- list add: (self
- phraseForReceiver: Color red
- op: #=
- arg: Color red
- resultType: #Boolean).
- ^list "copyWith: CompoundTileMorph new"!
Item was removed:
- ----- Method: Presenter>>goUp:with: (in category 'stop-step-go buttons') -----
- goUp: evt with: aMorph
- self startRunningScripts!
Item was removed:
- ----- Method: MorphExtension>>player (in category '*eToys-accessing') -----
- player
- "answer the receiver's player"
- ^ player!
Item was removed:
- ----- Method: Presenter>>drawingJustCompleted: (in category 'misc') -----
- drawingJustCompleted: aSketchMorph
- "The user just finished drawing. Now maybe put up a viewer"
-
- | aWorld |
- self flushPlayerListCache. "Because a new drawing already created one, thus obviating #assuredPlayer kicking in with its invalidation"
-
- aWorld := associatedMorph world.
- (aWorld hasProperty: #automaticFlapViewing)
- ifTrue:
- [^ aWorld presenter viewMorph: aSketchMorph].
-
- (aSketchMorph pasteUpMorph hasProperty: #automaticViewing)
- ifTrue:
- [self viewMorph: aSketchMorph]!
Item was removed:
- ----- Method: MorphExtension>>actorState (in category '*eToys-accessing') -----
- actorState
- "answer the redeiver's actorState"
- ^ actorState !
Item was removed:
- ----- Method: CodeHolder>>installTilesForSelection (in category '*eToys-tiles') -----
- installTilesForSelection
- "Install universal tiles into the code pane."
- | source aSelector aClass tree syn tileScriptor aWindow codePane |
- (aWindow := self containingWindow)
- ifNil: [self error: 'hamna dirisha'].
- tileScriptor := ((aSelector := self selectedMessageName) isNil
- or: [(aClass := self selectedClassOrMetaClass whichClassIncludesSelector: aSelector) isNil])
- ifTrue: [PluggableTileScriptorMorph new]
- ifFalse: [source := aClass sourceCodeAt: aSelector.
- tree := Compiler new
- parse: source
- in: aClass
- notifying: nil.
- (syn := tree asMorphicSyntaxUsing: SyntaxMorph) parsedInClass: aClass.
- syn inAPluggableScrollPane].
- codePane := aWindow
- findDeepSubmorphThat: [:m | (m isKindOf: PluggableTextMorph)
- and: [m getTextSelector == #contents]]
- ifAbsent: [].
- codePane
- ifNotNil: [codePane hideScrollBars].
- codePane
- ifNil: [codePane := aWindow
- findDeepSubmorphThat: [:m | m isKindOf: PluggableTileScriptorMorph]
- ifAbsent: [self error: 'no code pane']].
- tileScriptor color: aWindow paneColorToUse;
- setProperty: #hideUnneededScrollbars toValue: true.
- aWindow replacePane: codePane with: tileScriptor.
- currentCompiledMethod := aClass
- ifNotNil: [aClass compiledMethodAt: aSelector].
- tileScriptor owner clipSubmorphs: true.
- tileScriptor extent: codePane extent!
Item was removed:
- ----- Method: Presenter>>updateViewer:forceToShow: (in category 'viewer') -----
- 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 itsVocabulary aCategory categoryInfo restrictedIndex |
- aCategory := aCategorySymbol ifNotNil: [aViewer currentVocabulary translatedWordingFor: aCategorySymbol].
- categoryInfo := aViewer categoryMorphs asOrderedCollection collect:
- [:aMorph | aMorph categoryRestorationInfo].
-
- itsVocabulary := aViewer currentVocabulary.
- aCategory ifNotNil: [(categoryInfo includes: aCategorySymbol) ifFalse: [categoryInfo addFirst: aCategorySymbol]].
- aPlayer := aViewer scriptedPlayer.
- aPosition := aViewer position.
- wasSticky := aViewer isSticky.
- newViewer := aViewer species new visible: false.
- (aViewer isMemberOf: KedamaStandardViewer)
- ifTrue: [restrictedIndex := aViewer restrictedIndex].
- 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 limitClass: aViewer limitClass.
- newViewer initializeFor: aPlayer barHeight: barHeight includeDismissButton: aViewer hasDismissButton showCategories: categoryInfo.
- (newViewer isMemberOf: KedamaStandardViewer)
- ifTrue: [
- newViewer providePossibleRestrictedView: 0.
- newViewer providePossibleRestrictedView: restrictedIndex].
- 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 ifNotNil: [:aWorld | aWorld startSteppingSubmorphsOf: newViewer].
- newViewer layoutChanged!
Item was removed:
- ----- Method: Presenter>>ownStandardPalette (in category 'palette & parts bin') -----
- ownStandardPalette
- ^ standardPalette!
Item was removed:
- ----- Method: Presenter>>allStepButtons (in category 'stop-step-go buttons') -----
- allStepButtons
- "Answer a list of all the script-controlling Step buttons within my scope"
-
- ^ associatedMorph allMorphs select:
- [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
- [aMorph actionSelector == #stepStillDown:with:]]
-
- "ActiveWorld presenter allStepButtons"!
Item was removed:
- ----- Method: Presenter>>viewObject: (in category 'viewer') -----
- viewObject: anObject
- "Open up and return a viewer on the given object. If the object is a Morph, open a viewer on its associated Player"
-
- anObject isMorph
- ifTrue:
- [self viewMorph: anObject] "historic morph/player implementation"
- ifFalse:
- [self viewObjectDirectly: anObject]!
Item was removed:
- ----- Method: Presenter>>viewMorph: (in category 'viewer') -----
- viewMorph: aMorph
- | aPlayer openViewers aViewer aPalette aRect aPoint nominalHeight aFlapTab topItem flapLoc |
- Sensor leftShiftDown
- ifFalse:
- [((aPalette := aMorph standardPalette) notNil and: [aPalette isInWorld])
- ifTrue: [^aPalette viewMorph: aMorph]].
- aPlayer := (topItem := aMorph topRendererOrSelf) assuredPlayer.
- openViewers := aPlayer allOpenViewers.
- aViewer := openViewers isEmpty ifFalse: [ openViewers first ] ifTrue: [ self nascentPartsViewer ].
- self cacheSpecs: topItem. "redo the spec cache once in a while"
-
- "19 sept 2000 - allow flaps in any paste up"
- flapLoc := associatedMorph. "world"
- Preferences viewersInFlaps ifTrue: [
- aViewer owner ifNotNil: [ :f | ^f flapTab showFlap; yourself ].
- aViewer setProperty: #noInteriorThumbnail toValue: true.
- aViewer initializeFor: aPlayer barHeight: 0.
- aViewer enforceTileColorPolicy.
- aViewer fullBounds. "force layout"
- "associatedMorph addMorph: aViewer." "why???"
- flapLoc hideViewerFlapsOtherThanFor: aPlayer.
- aFlapTab := flapLoc viewerFlapTabFor: topItem.
- aFlapTab referent submorphs
- do: [:m | (m isKindOf: Viewer) ifTrue: [m delete]].
- aViewer visible: true.
- aFlapTab applyThickness: aViewer width + 25.
- aFlapTab spanWorld.
- aFlapTab showFlap.
- aViewer position: aFlapTab referent position.
- aFlapTab referent addMorph: aViewer beSticky. "moved"
- flapLoc startSteppingSubmorphsOf: aFlapTab.
- flapLoc startSteppingSubmorphsOf: aViewer.
- ^aFlapTab].
- aViewer initializeFor: aPlayer barHeight: 6.
- aViewer enforceTileColorPolicy.
- aViewer fullBounds. "force layout"
- Preferences automaticViewerPlacement
- ifTrue:
- [aPoint := aMorph bounds right
- @ (aMorph center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)).
- aRect := (aPoint extent: aViewer width @ nominalHeight)
- translatedToBeWithin: flapLoc bounds.
- aViewer position: aRect topLeft.
- aViewer visible: true.
- associatedMorph addMorph: aViewer.
- flapLoc startSteppingSubmorphsOf: aViewer.
- "it's already in the world, somewhat coincidentally"
- ^aViewer].
- aMorph primaryHand attachMorph: (aViewer visible: true).
- ^aViewer!
Item was removed:
- ----- Method: Presenter>>reinvigorateAllScriptsTool: (in category 'playerList') -----
- reinvigorateAllScriptsTool: anAllScriptsTool
- "Rebuild the contents of an All Scripts tool"
-
- | showingOnlyActiveScripts candidateList firstTwo oldList allExtantPlayers newList morphList |
- showingOnlyActiveScripts := anAllScriptsTool showingOnlyActiveScripts.
- self flushPlayerListCache.
- "needed? Probably to pick up on programmatical script-status control only"
-
- firstTwo := {anAllScriptsTool submorphs first. anAllScriptsTool submorphs second}.
- oldList := (anAllScriptsTool submorphs copyFrom: 3 to: anAllScriptsTool submorphs size) collect:
- [:aRow |
- (aRow findA: UpdatingSimpleButtonMorph) target].
-
- allExtantPlayers := self allExtantPlayers.
- anAllScriptsTool showingAllInstances "take all instances of all classes"
- ifTrue:
- [candidateList := allExtantPlayers]
-
- ifFalse: "include only one exemplar per uniclass. Try to get one that has some qualifying scripts"
- [candidateList := Set new.
- allExtantPlayers do:
- [:aPlayer |
- (candidateList detect: [:plyr | plyr isMemberOf: aPlayer class] ifNone: [nil]) ifNil:
- [aPlayer instantiatedUserScriptsDo: [:aScriptInstantiation |
- (showingOnlyActiveScripts not or: [aScriptInstantiation pausedOrTicking]) ifTrue:
- [candidateList add: aPlayer]]]]].
- newList := OrderedCollection new.
- candidateList do:
- [:aPlayer | aPlayer instantiatedUserScriptsDo:
- [:aScriptInstantiation |
- (showingOnlyActiveScripts not or: [aScriptInstantiation pausedOrTicking]) ifTrue:
- [newList add: aScriptInstantiation]]].
-
- oldList asSet = newList asSet
- ifFalse:
- [anAllScriptsTool removeAllMorphs; addAllMorphs: firstTwo.
- morphList := newList collect:
- [:aScriptInstantiation | aScriptInstantiation statusControlRowIn: anAllScriptsTool].
- anAllScriptsTool addAllMorphs: morphList.
- newList do:
- [:aScriptInstantiation | aScriptInstantiation updateAllStatusMorphs]]!
Item was removed:
- ----- Method: Presenter>>positionStandardPlayer (in category 'standardPlayer etc') -----
- positionStandardPlayer
- "Put the standard player slightly off-screen"
-
- standardPlayer ifNotNil:
- [standardPlayer costume position: (associatedMorph topLeft - (13 at 0))]!
Item was removed:
- ----- Method: Lexicon>>installTilesForSelection (in category '*eToys-tiles') -----
- installTilesForSelection
- "Install universal tiles into the code pane."
- | source aSelector aClass tree syn tileScriptor aWindow codePane |
- (aWindow := self containingWindow)
- ifNil: [self error: 'hamna dirisha'].
- aSelector := self selectedMessageName.
- aClass := self selectedClassOrMetaClass
- ifNil: [targetClass].
- aClass
- ifNotNil: [aSelector
- ifNil: [source := SyntaxMorph sourceCodeTemplate]
- ifNotNil: [aClass := self selectedClassOrMetaClass whichClassIncludesSelector: aSelector.
- source := aClass sourceCodeAt: aSelector].
- tree := Compiler new
- parse: source
- in: aClass
- notifying: nil.
- (syn := tree asMorphicSyntaxUsing: SyntaxMorph) parsedInClass: aClass.
- tileScriptor := syn inAPluggableScrollPane].
- codePane := aWindow
- findDeepSubmorphThat: [:m | (m isKindOf: PluggableTextMorph)
- and: [m getTextSelector == #contents]]
- ifAbsent: [].
- codePane
- ifNotNil: [codePane hideScrollBars].
- codePane
- ifNil: [codePane := aWindow
- findDeepSubmorphThat: [:m | m isKindOf: PluggableTileScriptorMorph]
- ifAbsent: [self error: 'no code pane']].
- tileScriptor color: aWindow paneColorToUse;
- setProperty: #hideUnneededScrollbars toValue: true.
- aWindow replacePane: codePane with: tileScriptor.
- currentCompiledMethod := aClass
- ifNotNil: [aClass
- compiledMethodAt: aSelector
- ifAbsent: []].
- tileScriptor owner clipSubmorphs: true.
- tileScriptor extent: codePane extent!
Item was removed:
- ----- Method: Presenter>>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'].
- 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 removed:
- ----- Method: Presenter>>allCurrentlyTickingScriptInstantiations (in category 'playerList') -----
- allCurrentlyTickingScriptInstantiations
- "Answer a list of ScriptInstantiation objects representing all the scripts within the scope of the receiver which are currently ticking."
-
- ^ Array streamContents:
- [:aStream |
- self allExtantPlayers do:
- [:aPlayer | aPlayer instantiatedUserScriptsDo:
- [:aScriptInstantiation |
- aScriptInstantiation status == #ticking ifTrue:
- [aStream nextPut: aScriptInstantiation]]]]!
Item was removed:
- ----- Method: Presenter>>stepStillDown:with: (in category 'stop-step-go buttons') -----
- stepStillDown: dummy with: theButton
- "The step button is still down; get temporary button feedback right and step all and then get all button feedback right again"
-
- self stepButtonState: #pressed.
- self stopButtonState: #off.
- associatedMorph stepAll.
- associatedMorph world displayWorld.
- self stepButtonState: #off.
- self stopButtonState: #on
- !
Item was removed:
- ----- Method: Presenter>>uniclassesAndCounts (in category 'playerList') -----
- uniclassesAndCounts
- "Answer a list of all players known to the receiver that have uniclasses"
-
- ^ (self allPlayersWithUniclasses collect: [:aPlayer | aPlayer class]) asSet asArray collect:
- [:aClass | Array
- with: aClass
- with: aClass instanceCount]
-
-
- "self currentWorld presenter uniclassesAndCounts"!
Item was removed:
- ----- Method: CodeHolder>>toggleShowingTiles (in category '*eToys-tiles') -----
- toggleShowingTiles
- "Toggle whether tiles should be shown in the code pane"
-
- self okToChange ifTrue:
- [self showingTiles
- ifTrue:
- [contentsSymbol := #source.
- self setContentsToForceRefetch.
- self installTextualCodingPane.
- self contentsChanged]
- ifFalse:
- [contentsSymbol := #tiles.
- self installTilesForSelection.
- self changed: #tiles]]!
Item was removed:
- ----- Method: Presenter>>addTrashCan (in category 'button creation') -----
- addTrashCan
- | aPosition aCan |
- (aCan := associatedMorph findA: TrashCanMorph) ifNotNil: [^ aCan].
- aCan := TrashCanMorph newSticky.
- aPosition := associatedMorph positionNear: (associatedMorph bottomRight - aCan extent) forExtent: aCan extent adjustmentSuggestion: (-10 @ 0).
- aCan position: aPosition.
- associatedMorph addMorph: aCan.
- aCan startStepping.
- aCan setToAdhereToEdge: #bottomRight.
- ^ aCan
- !
Item was removed:
- ----- Method: Presenter>>updateViewer: (in category 'viewer') -----
- updateViewer: aViewer
- self updateViewer: aViewer forceToShow: nil!
Item was removed:
- ----- Method: Presenter>>stopUp:with: (in category 'stop-step-go buttons') -----
- stopUp: dummy with: theButton
- self flushPlayerListCache. "catch guys not in cache but who're running"
- self stopRunningScripts!
Item was removed:
- ----- Method: Presenter>>goButtonState: (in category 'stop-step-go buttons') -----
- goButtonState: newState
- "Get all go buttons in my scope to show the correct state"
-
- self allGoButtons do:
- [:aButton | aButton state: newState]!
Item was removed:
- ----- Method: Presenter>>flushPlayerListCache (in category 'playerList') -----
- flushPlayerListCache
- playerList := nil!
Item was removed:
- ----- Method: Presenter>>nascentPartsViewerFor: (in category 'viewer') -----
- nascentPartsViewerFor: aViewee
- "Create a new, naked Viewer object for viewing aViewee. Give it a vocabulary if either the viewee insists on one or if the project insists on one."
-
- | aViewer aVocab |
- (aViewee isKindOf: KedamaExamplerPlayer) ifTrue: [^ KedamaStandardViewer new].
- aViewer := StandardViewer new.
- (aVocab := aViewee vocabularyDemanded)
- ifNotNil:
- [aViewer useVocabulary: aVocab]
- ifNil:
- [(aVocab := associatedMorph currentVocabularyFor: aViewee) ifNotNil:
- [aViewer useVocabulary: aVocab]].
-
- "If the viewee does not *demand* a special kind of Viewer, and if the project has not specified a preferred vocabulary, then the system defaults will kick in later"
- ^ aViewer!
Item was removed:
- ----- Method: Presenter>>allExtantPlayers (in category 'intialize') -----
- allExtantPlayers
- "The initial intent here was to produce a list of Player objects associated with any Morph in the tree beneath the receiver's associatedMorph. whether it is the submorph tree or perhaps off on unseen bookPages. We have for the moment moved away from that initial intent, and in the current version we only deliver up players associated with the submorph tree only. <-- this note dates from 4/21/99
-
- Call #flushPlayerListCache; to force recomputation."
-
- | fullList |
- playerList ifNotNil:
- [^ playerList].
-
- fullList := associatedMorph allMorphs select:
- [:m | m player ~~ nil] thenCollect: [:m | m player].
- fullList copy do:
- [:aPlayer |
- aPlayer class scripts do:
- [:aScript | aScript isTextuallyCoded ifFalse:
- [aScript currentScriptEditor ifNotNil: [:ed |
- | objectsReferredToByTiles |
- objectsReferredToByTiles := ed allMorphs
- select:
- [:aMorph | (aMorph isKindOf: TileMorph) and: [aMorph type == #objRef]]
- thenCollect:
- [:aMorph | aMorph actualObject].
- fullList addAll: objectsReferredToByTiles]]]].
-
- ^ playerList := (fullList asSet asSortedCollection:
- [:a :b | a externalName < b externalName]) asArray!
Item was removed:
- ----- Method: Presenter>>createStandardPlayer (in category 'standardPlayer etc') -----
- createStandardPlayer
- | aMorph |
-
- aMorph := ImageMorph new image: (ScriptingSystem formAtKey: 'standardPlayer').
- associatedMorph addMorphFront: aMorph.
- (standardPlayer := aMorph assuredPlayer) renameTo: 'dot' translated.
- aMorph setBalloonText: '...'.
- self positionStandardPlayer.
- ^ standardPlayer!
Item was removed:
- ----- Method: Presenter>>world (in category 'access') -----
- world
- ^ associatedMorph world!
Item was removed:
- ----- Method: Presenter>>toolToViewScriptInstantiations (in category 'playerList') -----
- toolToViewScriptInstantiations
- "Open a tool which shows, and allows the user to change the status of, all the instantiations of all the user-written scripts in the world"
-
- AllScriptsTool launchAllScriptsToolFor: self
-
- "self currentWorld presenter toolToViewScriptInstantiations"!
Item was removed:
- ----- Method: Presenter>>standardPalette: (in category 'palette & parts bin') -----
- standardPalette: aPalette
- standardPalette := aPalette!
Item was removed:
- ----- Method: Presenter>>typeForConstant: (in category 'tile support') -----
- typeForConstant: anObject
- ^ anObject basicType!
Item was removed:
- ----- Method: Presenter>>allGoButtons (in category 'stop-step-go buttons') -----
- allGoButtons
- "Answer a list of all script-controlling Go buttons within my scope"
-
- ^ associatedMorph allMorphs select:
- [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
- [aMorph actionSelector == #goUp:with:]]
-
- "ActiveWorld presenter allGoButtons"!
Item was removed:
- ----- Method: Presenter>>stopButtonState: (in category 'stop-step-go buttons') -----
- stopButtonState: newState
- "Get all stop buttons in my scope to show the correct state"
-
- self allStopButtons do:
- [:aButton | aButton state: newState]!
Item was removed:
- ----- Method: Presenter>>allPlayersWithUniclasses (in category 'playerList') -----
- allPlayersWithUniclasses
- "Answer a list of all players known to the receiver that have uniclasses"
-
- ^ self allExtantPlayers select: [:p | p belongsToUniClass]!
More information about the Packages
mailing list