[Pkg] The Trunk: Morphic-ar.294.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Jan 3 23:44:36 UTC 2010
Andreas Raab uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ar.294.mcz
==================== Summary ====================
Name: Morphic-ar.294
Author: ar
Time: 4 January 2010, 12:41:38 pm
UUID: 38e0490f-19f0-a14e-9125-01e6672121ef
Ancestors: Morphic-ar.293
Make Etoys unloadable: Move lots of methods to Etoys package. Remove the old Fabrik remnants.
=============== Diff against Morphic-ar.293 ===============
Item was changed:
----- Method: MorphicProject>>finalEnterActions (in category 'enter') -----
finalEnterActions
"Perform the final actions necessary as the receiver project is entered"
+ | navigator armsLengthCmd navType thingsToUnhibernate |
- | navigator armsLengthCmd navType thingsToUnhibernate fixBlock |
self projectParameters
at: #projectsToBeDeleted
ifPresent: [ :projectsToBeDeleted |
self removeParameter: #projectsToBeDeleted.
projectsToBeDeleted do: [ :each |
Project deletingProject: each.
each removeChangeSetIfPossible]].
Locale switchAndInstallFontToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
- (thingsToUnhibernate anySatisfy:[:each|
- each isMorph and:[each hasProperty: #needsLayoutFixed]])
- ifTrue:[fixBlock := self displayFontProgress].
thingsToUnhibernate do: [:each | each unhibernate].
world removeProperty: #thingsToUnhibernate.
-
- fixBlock ifNotNil:[
- fixBlock value.
- world fullRepaintNeeded.
- ].
navType := ProjectNavigationMorph preferredNavigator.
armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
navigator := world findA: navType.
(Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
[(navigator := navType new)
bottomLeft: world bottomLeft;
openInWorld: world].
navigator notNil & armsLengthCmd notNil ifTrue:
[navigator color: Color lightBlue].
armsLengthCmd notNil ifTrue:
[Preferences showFlapsWhenPublishing
ifFalse:
[self flapsSuppressed: true.
navigator ifNotNil: [navigator visible: false]].
armsLengthCmd openInWorld: world].
world reformulateUpdatingMenus.
world presenter positionStandardPlayer.
self assureMainDockingBarPresenceMatchesPreference.
WorldState addDeferredUIMessage: [self startResourceLoading].!
Item was added:
+ ----- Method: Morph>>isSoundTile (in category 'classification') -----
+ isSoundTile
+ ^false!
Item was changed:
----- Method: PasteUpMorph>>allScriptEditors (in category 'misc') -----
allScriptEditors
^ self allMorphs select:
+ [:s | s isScriptEditorMorph]!
- [:s | s isKindOf: ScriptEditorMorph]!
Item was changed:
----- Method: Morph>>methodCommentAsBalloonHelp (in category 'accessing') -----
methodCommentAsBalloonHelp
"Given that I am a morph that is associated with an object and a method, answer a suitable method comment relating to that object & method if possible"
| inherentSelector actual |
(inherentSelector := self valueOfProperty: #inherentSelector)
ifNotNil:
+ [(actual := (self firstOwnerSuchThat:[:m| m isPhraseTileMorph or:[m isSyntaxMorph]]) actualObject) ifNotNil:
- [(actual := (self ownerThatIsA: PhraseTileMorph orA: SyntaxMorph) actualObject) ifNotNil:
[^ actual class precodeCommentOrInheritedCommentFor: inherentSelector]].
^ nil!
Item was added:
+ ----- Method: Morph>>defaultNameStemForInstances (in category 'accessing') -----
+ defaultNameStemForInstances
+ ^self class name!
Item was added:
+ ----- Method: Morph>>isNumericReadoutTile (in category 'classification') -----
+ isNumericReadoutTile
+ ^false!
Item was changed:
----- Method: Morph>>buildMetaMenu: (in category 'meta-actions') -----
buildMetaMenu: evt
"Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph."
| menu |
menu := MenuMorph new defaultTarget: self.
menu addStayUpItem.
menu add: 'grab' translated action: #grabMorph:.
menu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:.
self maybeAddCollapseItemTo: menu.
menu add: 'delete' translated action: #dismissMorph:.
menu addLine.
menu add: 'copy text' translated action: #clipText.
menu add: 'copy Postscript' translated action: #clipPostscript.
menu add: 'print Postscript to file...' translated action: #printPSToFile.
menu addLine.
menu add: 'go behind' translated action: #goBehind.
menu add: 'add halo' translated action: #addHalo:.
menu add: 'duplicate' translated action: #maybeDuplicateMorph:.
self addEmbeddingMenuItemsTo: menu hand: evt hand.
menu add: 'resize' translated action: #resizeMorph:.
"Give the argument control over what should be done about fill styles"
self addFillStyleMenuItems: menu hand: evt hand.
self addDropShadowMenuItems: menu hand: evt hand.
self addLayoutMenuItems: menu hand: evt hand.
menu addUpdating: #hasClipSubmorphsString target: self selector: #changeClipSubmorphs argumentList: #().
menu addLine.
(self morphsAt: evt position) size > 1 ifTrue:
[menu add: 'submorphs...' translated
target: self
selector: #invokeMetaMenuAt:event:
argument: evt position].
menu addLine.
menu add: 'inspect' translated selector: #inspectAt:event: argument: evt position.
menu add: 'explore' translated action: #explore.
menu add: 'browse hierarchy' translated action: #browseHierarchy.
menu add: 'make own subclass' translated action: #subclassMorph.
menu addLine.
- menu add: 'set variable name...' translated action: #choosePartName.
(self isMorphicModel) ifTrue:
[menu add: 'save morph as prototype' translated action: #saveAsPrototype.
(self ~~ self world modelOrNil) ifTrue:
[menu add: 'become this world''s model' translated action: #beThisWorldsModel]].
menu add: 'save morph in file' translated action: #saveOnFile.
(self hasProperty: #resourceFilePath)
ifTrue: [((self valueOfProperty: #resourceFilePath) endsWith: '.morph')
ifTrue: [menu add: 'save as resource' translated action: #saveAsResource].
menu add: 'update from resource' translated action: #updateFromResource]
ifFalse: [menu add: 'attach to resource' translated action: #attachToResource].
menu add: 'show actions' translated action: #showActions.
menu addLine.
self addDebuggingItemsTo: menu hand: evt hand.
self addCustomMenuItems: menu hand: evt hand.
^ menu
!
Item was changed:
----- Method: Morph>>okayToAddGrabHandle (in category 'halos and balloon help') -----
okayToAddGrabHandle
"Answer whether a halo on the receiver should offer a grab handle. This provides a hook for making it harder to deconstruct some strucures even momentarily"
+ ^ true!
- ^ self holdsSeparateDataForEachInstance not !
Item was changed:
----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') -----
exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory
"Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in?
Player classes are included automatically."
| is str ans revertSeg roots holder |
self flag: #toRemove.
self halt. "unused"
"world == World ifTrue: [^ false]."
"self inform: 'Can''t send the current world out'."
world ifNil: [^ false]. world presenter ifNil: [^ false].
Utilities emptyScrapsBook.
world currentHand pasteBuffer: nil. "don't write the paste buffer."
world currentHand mouseOverHandler initialize. "forget about any references here"
"Display checkCurrentHandForObjectToPaste."
Command initialize.
world clearCommandHistory.
world fullReleaseCachedState; releaseViewers.
world cleanseStepList.
world localFlapTabs size = world flapTabs size ifFalse: [
self error: 'Still holding onto Global flaps'].
world releaseSqueakPages.
- ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]).
holder := Project allProjects. "force them in to outPointers, where DiskProxys are made"
"Just export me, not my previous version"
revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil].
self projectParameters removeKey: #revertToMe ifAbsent: [].
roots := OrderedCollection new.
roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]).
roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"
catList do: [:sysCat |
(SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb |
roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]].
is := ImageSegment new copySmartRootsExport: roots asArray.
"old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"
is state = #tooBig ifTrue: [^ false].
str := ''.
"considered legal to save a project that has never been entered"
(is outPointers includes: world) ifTrue: [
str := str, '\Project''s own world is not in the segment.' withCRs].
str isEmpty ifFalse: [
ans := (UIManager default
chooseFrom: #('Do not write file' 'Write file anyway' 'Debug')
title: str).
ans = 1 ifTrue: [
revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
^ false].
ans = 3 ifTrue: [self halt: 'Segment not written']].
is writeForExportWithSources: aFileName inDirectory: aDirectory.
revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
holder.
world flapTabs do: [:ft |
(ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
is arrayOfRoots do: [:obj |
+ obj isScriptEditorMorph ifTrue: [obj unhibernate]].
- obj class == ScriptEditorMorph ifTrue: [obj unhibernate]].
^ true
!
Item was added:
+ ----- Method: Morph>>isStickySketchMorph (in category 'classification') -----
+ isStickySketchMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isPhraseTileMorph (in category 'classification') -----
+ isPhraseTileMorph
+ ^false!
Item was changed:
----- Method: Morph>>buildDebugMenu: (in category 'debug and other') -----
buildDebugMenu: aHand
"Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently"
| aMenu aPlayer |
aMenu := MenuMorph new defaultTarget: self.
aMenu addStayUpItem.
(self hasProperty: #errorOnDraw) ifTrue:
[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
aMenu addLine].
(self hasProperty: #errorOnStep) ifTrue:
[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
aMenu addLine].
aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
Smalltalk isMorphic ifFalse:
[aMenu add: 'inspect morph (in MVC)' translated action: #inspect].
self isMorphicModel ifTrue:
[aMenu add: 'inspect model' translated target: self model action: #inspect].
(aPlayer := self player) ifNotNil:
[aMenu add: 'inspect player' translated target: aPlayer action: #inspect].
aMenu add: 'explore morph' translated target: self selector: #explore.
aMenu addLine.
aPlayer ifNotNil:
[ aMenu add: 'viewer for Player' translated target: self player action: #beViewed.
aMenu balloonTextForLastItem: 'Opens a viewer on my Player -- this is the same thing you get if you click on the cyan "View" halo handle' translated ].
aMenu add: 'viewer for Morph' translated target: self action: #viewMorphDirectly.
aMenu balloonTextForLastItem: 'Opens a Viewer on this Morph, rather than on its Player' translated.
aMenu addLine.
aPlayer ifNotNil:
[aPlayer class isUniClass ifTrue: [
aMenu add: 'browse player class' translated target: aPlayer action: #browseHierarchy]].
aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy.
(self isMorphicModel)
ifTrue: [aMenu
add: 'browse model class'
target: self model
selector: #browseHierarchy].
aMenu addLine.
- aPlayer ifNotNil:
- [aMenu add: 'player protocol (tiles)' translated target: aPlayer action: #openInstanceBrowserWithTiles
- "#browseProtocolForPlayer"].
- aMenu add: 'morph protocol (text)' translated target: self selector: #haveFullProtocolBrowsed.
- aMenu add: 'morph protocol (tiles)' translated target: self selector: #openInstanceBrowserWithTiles.
- aMenu addLine.
-
self addViewingItemsTo: aMenu.
aMenu
add: 'make own subclass' translated action: #subclassMorph;
- add: 'internal name ' translated action: #choosePartName;
add: 'save morph in file' translated action: #saveOnFile;
addLine;
add: 'call #tempCommand' translated action: #tempCommand;
add: 'define #tempCommand' translated action: #defineTempCommand;
addLine;
add: 'control-menu...' translated target: self selector: #invokeMetaMenu:;
add: 'edit balloon help' translated action: #editBalloonHelpText.
^ aMenu!
Item was changed:
----- Method: Morph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
justDroppedInto: aMorph event: anEvent
"This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"
+ | aWindow partsBinCase cmd |
- | aWindow partsBinCase cmd aStack |
(self formerOwner notNil and: [self formerOwner ~~ aMorph])
ifTrue: [self removeHalo].
self formerOwner: nil.
self formerPosition: nil.
cmd := self valueOfProperty: #undoGrabCommand.
cmd ifNotNil:[aMorph rememberCommand: cmd.
self removeProperty: #undoGrabCommand].
(partsBinCase := aMorph isPartsBin) ifFalse:
[self isPartsDonor: false].
(aWindow := aMorph ownerThatIsA: SystemWindow) ifNotNil:
[aWindow isActive ifFalse:
[aWindow activate]].
(self isInWorld and: [partsBinCase not]) ifTrue:
[self world startSteppingSubmorphsOf: self].
"Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."
"An object launched by certain parts-launcher mechanisms should end up fully visible..."
(self hasProperty: #beFullyVisibleAfterDrop) ifTrue:
[aMorph == ActiveWorld ifTrue:
[self goHome].
self removeProperty: #beFullyVisibleAfterDrop].
-
- (self holdsSeparateDataForEachInstance and: [(aStack := self stack) notNil])
- ifTrue:
- [aStack reassessBackgroundShape]
!
Item was changed:
----- Method: PasteUpMorph>>prepareToBeSaved (in category 'misc') -----
prepareToBeSaved
"Prepare for export via the ReferenceStream mechanism"
| exportDict soundKeyList players |
super prepareToBeSaved.
turtlePen := nil.
self isWorldMorph
ifTrue:
[self removeProperty: #scriptsToResume.
soundKeyList := Set new.
(players := self presenter allExtantPlayers)
do: [:aPlayer | aPlayer slotInfo
associationsDo: [:assoc | assoc value type == #Sound
ifTrue: [soundKeyList
add: (aPlayer instVarNamed: assoc key)]]].
players
do: [:p | p allScriptEditors
do: [:e | (e allMorphs
+ select: [:m | m isSoundTile])
- select: [:m | m isKindOf: SoundTile])
do: [:aTile | soundKeyList add: aTile literal]]].
(self allMorphs
+ select: [:m | m isSoundTile])
+ isTileMorph
- select: [:m | m isKindOf: SoundTile])
do: [:aTile | soundKeyList add: aTile literal].
soundKeyList removeAllFoundIn: SampledSound universalSoundKeys.
soundKeyList
removeAllSuchThat: [:aKey | (SampledSound soundLibrary includesKey: aKey) not].
soundKeyList isEmpty
ifFalse: [exportDict := Dictionary new.
soundKeyList
do: [:aKey | exportDict
add: (SampledSound soundLibrary associationAt: aKey)].
self setProperty: #soundAdditions toValue: exportDict]]!
Item was changed:
----- Method: Morph>>renameTo: (in category 'testing') -----
renameTo: aName
"Set Player name in costume. Update Viewers. Fix all tiles (old style). fix
References. New tiles: recompile, and recreate open scripts. If coming in
from disk, and have name conflict, References will already have new
name. "
| aPresenter putInViewer aPasteUp renderer oldKey assoc classes oldName |
oldName := self knownName.
(renderer := self topRendererOrSelf) setNameTo: aName.
putInViewer := false.
((aPresenter := self presenter) isNil or: [renderer player isNil])
ifFalse:
[putInViewer := aPresenter currentlyViewing: renderer player.
putInViewer ifTrue: [renderer player viewerFlapTab hibernate]].
"empty it temporarily"
(aPasteUp := self topPasteUp)
ifNotNil: [aPasteUp allTileScriptingElements do: [:m | m bringUpToDate]].
"Fix References dictionary. See restoreReferences to know why oldKey is
already aName, but oldName is the old name."
oldKey := References keyAtIdentityValue: renderer player ifAbsent: [].
oldKey ifNotNil:
[assoc := References associationAt: oldKey.
oldKey = aName
ifFalse:
["normal rename"
assoc key: (renderer player uniqueNameForReferenceFrom: aName).
References rehash]].
putInViewer ifTrue: [aPresenter viewMorph: self].
"recreate my viewer"
oldKey ifNil: [^aName].
"Force strings in tiles to be remade with new name. New tiles only."
Preferences universalTiles ifFalse: [^aName].
classes := (self systemNavigation allCallsOn: assoc)
collect: [:each | each classSymbol].
classes asSet
do: [:clsName | (Smalltalk at: clsName) replaceSilently: oldName to: aName].
"replace in text body of all methods. Can be wrong!!"
"Redo the tiles that are showing. This is also done in caller in
unhibernate. "
aPasteUp ifNotNil:
[aPasteUp allTileScriptingElements do:
[:mm |
"just ScriptEditorMorphs"
nil.
+ (mm isScriptEditorMorph)
- (mm isKindOf: ScriptEditorMorph)
ifTrue:
[((mm playerScripted class compiledMethodAt: mm scriptName)
hasLiteral: assoc)
ifTrue:
[mm
hibernate;
unhibernate]]]].
^aName!
Item was changed:
----- Method: ColorPickerMorph>>getColorFromKedamaWorldIfPossible: (in category 'kedama') -----
getColorFromKedamaWorldIfPossible: aGlobalPoint
self world submorphs do: [:sub |
+ (sub isKedamaMorph) ifTrue: [
- (sub isKindOf: KedamaMorph) ifTrue: [
sub morphsAt: aGlobalPoint unlocked: false do: [:e |
^ e colorAt: (aGlobalPoint - e topLeft).
].
].
].
^ nil.
!
Item was changed:
----- Method: TransformationMorph>>adjustAfter: (in category 'private') -----
adjustAfter: changeBlock
"Cause this morph to remain cetered where it was before, and
choose appropriate smoothing, after a change of scale or rotation."
| oldRefPos |
oldRefPos := self referencePosition.
changeBlock value.
self chooseSmoothing.
+ self actorStateOrNil ifNotNil:[
+ self penUpWhile: [self position: self position + (oldRefPos - self referencePosition)].
+ ].
- self penUpWhile: [self position: self position + (oldRefPos - self referencePosition)].
self layoutChanged.
owner ifNotNil: [owner invalidRect: bounds]
!
Item was changed:
----- Method: Morph>>addHaloActionsTo: (in category 'menus') -----
addHaloActionsTo: aMenu
"Add items to aMenu representing actions requestable via halo"
| subMenu |
subMenu := MenuMorph new defaultTarget: self.
subMenu addTitle: self externalName.
subMenu addStayUpItemSpecial.
subMenu addLine.
subMenu add: 'delete' translated action: #dismissViaHalo.
subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated.
self maybeAddCollapseItemTo: subMenu.
subMenu add: 'grab' translated action: #openInHand.
subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated.
subMenu addLine.
subMenu add: 'resize' translated action: #resizeFromMenu.
subMenu balloonTextForLastItem: 'Change the size of this object' translated.
subMenu add: 'duplicate' translated action: #maybeDuplicateMorph.
subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated.
"Note that this allows access to the non-instancing duplicate even when this is a uniclass instance"
self couldMakeSibling ifTrue:
[subMenu add: 'make a sibling' translated action: #handUserASibling.
subMenu balloonTextForLastItem: 'Make a new sibling of this object and hand it to me' translated].
subMenu addLine.
subMenu add: 'property sheet' translated target: self renderedMorph action: #openAPropertySheet.
subMenu balloonTextForLastItem: 'Open a property sheet for me. Allows changing lots of stuff at once.' translated.
subMenu add: 'set color' translated target: self renderedMorph action: #changeColor.
subMenu balloonTextForLastItem: 'Change the color of this object' translated.
subMenu add: 'viewer' translated target: self action: #beViewed.
subMenu balloonTextForLastItem: 'Open a Viewer that will allow everything about this object to be seen and controlled.' translated.
- subMenu add: 'tile browser' translated target: self action: #openInstanceBrowserWithTiles.
subMenu balloonTextForLastItem: 'Open a tool that will facilitate tile scripting of this object.' translated.
subMenu add: 'hand me a tile' translated target: self action: #tearOffTile.
subMenu balloonTextForLastItem: 'Hand me a tile represting this object' translated.
subMenu addLine.
subMenu add: 'inspect' translated target: self action: #inspect.
subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated.
aMenu add: 'halo actions...' translated subMenu: subMenu
!
Item was changed:
----- Method: PasteUpMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
acceptDroppingMorph: dropped event: evt
"The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
| aMorph |
aMorph := self morphToDropFrom: dropped.
self isWorldMorph
ifTrue:["Add the given morph to this world and start stepping it if it wants to be."
self addMorphFront: aMorph.
(aMorph fullBounds intersects: self viewBox) ifFalse:
[Beeper beep. aMorph position: self bounds center]]
ifFalse:[super acceptDroppingMorph: aMorph event: evt].
aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]].
aMorph allMorphsDo: "Establish any penDown morphs in new world"
[:m | | tfm mm |
m player ifNotNil:
[m player getPenDown ifTrue:
[((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil])
ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition)
forPlayer: m player]]]].
self isPartsBin
ifTrue:
[aMorph isPartsDonor: true.
aMorph stopSteppingSelfAndSubmorphs.
aMorph suspendEventHandler]
ifFalse:
[self world startSteppingSubmorphsOf: aMorph].
+ " self presenter morph: aMorph droppedIntoPasteUpMorph: self."
- self presenter morph: aMorph droppedIntoPasteUpMorph: self.
self showingListView ifTrue:
[self sortSubmorphsBy: (self valueOfProperty: #sortOrder).
self currentWorld abandonAllHalos].
self bringTopmostsToFront.
!
Item was changed:
----- Method: PasteUpMorph>>makeNewDrawing:at: (in category 'world menu') -----
makeNewDrawing: evt at: aPoint
"make a new drawing, triggered by the given event, with the painting area centered around the given point"
| w newSketch newPlayer sketchEditor aPalette rect aPaintBox aPaintTab aWorld |
w := self world.
w assureNotPaintingElse: [^ self].
rect := self paintingBoundsAround: aPoint.
aPalette := self standardPalette.
aPalette ifNotNil: [aPalette showNoPalette; layoutChanged].
w prepareToPaint.
+ newSketch := self drawingClass new.
+ Smalltalk at: #UnscriptedPlayer ifPresent:[:aClass|
+ newSketch player: (newPlayer := aClass newUserInstance).
+ newPlayer costume: newSketch.
+ ].
- newSketch := self drawingClass new player: (newPlayer := UnscriptedPlayer newUserInstance).
- newPlayer costume: newSketch.
newSketch nominalForm: (Form extent: rect extent depth: w assuredCanvas depth).
newSketch bounds: rect.
sketchEditor := SketchEditorMorph new.
w addMorphFront: sketchEditor.
sketchEditor initializeFor: newSketch inBounds: rect pasteUpMorph: self.
sketchEditor
afterNewPicDo: [:aForm :aRect | | tfx ownerBeforeHack whereToPresent |
whereToPresent := self presenter.
newSketch form: aForm.
tfx := self transformFrom: w.
newSketch position: (tfx globalPointToLocal: aRect origin).
newSketch rotationStyle: sketchEditor rotationStyle.
newSketch forwardDirection: sketchEditor forwardDirection.
ownerBeforeHack := newSketch owner. "about to break the invariant!!!!"
newSketch privateOwner: self. "temp for halo access"
+ newPlayer ifNotNil:[newPlayer setHeading: sketchEditor forwardDirection].
- newPlayer setHeading: sketchEditor forwardDirection.
(aPaintTab := (aWorld := self world) paintingFlapTab)
ifNotNil:[aPaintTab hideFlap]
ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
"Includes newSketch rotationDegrees: sketchEditor forwardDirection."
newSketch privateOwner: ownerBeforeHack. "probably nil, but let's be certain"
+ self addMorphFront: (newPlayer ifNil:[newSketch] ifNotNil:[newPlayer costume]).
- self addMorphFront: newPlayer costume.
w startSteppingSubmorphsOf: newSketch.
whereToPresent drawingJustCompleted: newSketch]
ifNoBits:[
(aPaintTab := (aWorld := self world) paintingFlapTab)
ifNotNil:[aPaintTab hideFlap]
ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
aPalette ifNotNil: [aPalette showNoPalette].]!
Item was changed:
----- Method: UpdatingStringMorph>>decimalPlaces: (in category 'accessing') -----
decimalPlaces: aNumber
"Set the receiver's number of decimal places to be shown. If my target is a morph or a player, tell it about the change, in case it wants to remember it."
| constrained |
self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11).
self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).
+ (target isMorph or:[target isPlayer]) ifTrue:
- (target isKindOf: Morph orOf: Player) ifTrue:
[target noteDecimalPlaces: constrained forGetter: getSelector]!
Item was changed:
----- Method: Morph>>objectViewed (in category 'e-toy support') -----
objectViewed
"Answer the morph associated with the player that the structure the receiver currently finds itself within represents."
+ ^ (self outermostMorphThat: [:o | o isViewer or:[ o isScriptEditorMorph]]) objectViewed
+ !
- ^ (self outermostMorphThat: [:o | o isKindOf: Viewer orOf: ScriptEditorMorph]) objectViewed!
Item was changed:
----- Method: Morph>>tryToRenameTo: (in category 'naming') -----
tryToRenameTo: aName
"A new name has been submited; make sure it's appropriate, and react accordingly. This circumlocution provides the hook by which the simple renaming of a field can result in a change to variable names in a stack, etc. There are some problems to worry about here."
+ self renameTo: aName.!
- | aStack |
- (self holdsSeparateDataForEachInstance and: [(aStack := self stack) notNil])
- ifTrue:
- [self topRendererOrSelf setNameTo: aName.
- aStack reassessBackgroundShape]
- ifFalse:
- [self renameTo: aName]!
Item was changed:
----- Method: Morph>>openAPropertySheet (in category 'meta-actions') -----
openAPropertySheet
+ Smalltalk at: #ObjectPropertiesMorph ifPresent:[:aClass|
+ ^aClass basicNew
+ targetMorph: self;
+ initialize;
+ openNearTarget
+ ].
+ Beeper beep.!
- ObjectPropertiesMorph basicNew
- targetMorph: self;
- initialize;
- openNearTarget!
Item was changed:
----- Method: MorphicProject>>storeSegmentNoFile (in category 'file in/out') -----
storeSegmentNoFile
"For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
+ | is |
- | is str |
(World == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'."
world isInMemory ifFalse: [^ self]. "already done"
world ifNil: [^ self]. world presenter ifNil: [^ self].
"Do this on project enter"
World flapTabs do: [:ft | ft referent adaptToWorld: World].
"Hack to keep the Menu flap from pointing at my project"
"Preferences setPreference: #useGlobalFlaps toValue: false."
"Utilities globalFlapTabsIfAny do:
[:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false].
Utilities clobberFlapTabList. "
"project world deleteAllFlapArtifacts."
"self currentWorld deleteAllFlapArtifacts. "
Utilities emptyScrapsBook.
World checkCurrentHandForObjectToPaste2.
is := ImageSegment new copyFromRootsLocalFileFor:
(Array with: world presenter with: world) "world, and all Players"
sizeHint: 0.
is segment size < 800 ifTrue: ["debugging"
Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep].
- false ifTrue: [
- str := String streamContents: [:strm |
- strm nextPutAll: 'Only a tiny part of the project got into the segment'.
- strm nextPutAll: '\These are pointed to from the outside:' withCRs.
- is outPointers do: [:out |
- (out class == Presenter) | (out class == ScriptEditorMorph) ifTrue: [
- strm cr. out printOn: strm.
- self systemNavigation
- browseAllObjectReferencesTo: out
- except: (Array with: is outPointers)
- ifNone: [:obj | ]].
- (is arrayOfRoots includes: out class) ifTrue: [strm cr. out printOn: strm.
- self systemNavigation
- browseAllObjectReferencesTo: out
- except: (Array with: is outPointers)
- ifNone: [:obj | ]]]].
- self inform: str.
- ^ is inspect].
is extract.
"is instVarAt: 2 put: is segment clone." "different memory"
!
Item was changed:
----- Method: UpdatingStringMorph>>valueFromContents (in category 'accessing') -----
valueFromContents
"Return a new value from the current contents string."
"
| expression tilePadMorphOrNil asNumberBlock |
asNumberBlock := [:string | [string asNumber]
on: Error
do: []].
format = #string
ifTrue: [^ contents].
(format = #default
and: [self owner isKindOf: NumericReadoutTile])
ifTrue: [^ asNumberBlock value: contents].
tilePadMorphOrNil := self ownerThatIsA: TilePadMorph.
(tilePadMorphOrNil notNil
and: [tilePadMorphOrNil type = #Number])
ifTrue: [^ asNumberBlock value: contents].
expression := Vocabulary eToyVocabulary translationKeyFor: contents.
expression isNil
ifTrue: [expression := contents].
^ Compiler evaluate: expression
"
format = #symbol ifTrue: [^ lastValue].
format = #string ifTrue: [^ contents].
+ (owner notNil and: [owner isNumericReadoutTile]) ifTrue: [
- (owner notNil and: [owner isMemberOf: NumericReadoutTile]) ifTrue: [
^ Number readFrom: contents
].
target ifNotNil: [target owner ifNotNil: [
+ ((target owner isTilePadMorph) and: [target owner type = #Number])
- ((target owner isMemberOf: TilePadMorph) and: [target owner type = #Number])
ifTrue: [^ Number readFrom: contents]]].
^ Compiler evaluate: contents
!
Item was changed:
----- Method: Morph>>privateMoveBy: (in category 'private') -----
privateMoveBy: delta
"Private!! Use 'position:' instead."
| fill |
+ self player ifNotNil: ["Most cases eliminated fast by above test"
+ self getPenDown ifTrue: [
+ "If this is a costume for a player with its
+ pen down, draw a line."
+ self moveWithPenDownBy: delta]].
- extension ifNotNil: [extension player
- ifNotNil: ["Most cases eliminated fast by above test"
- self getPenDown
- ifTrue: ["If this is a costume for a player with its
- pen down, draw a line."
- self moveWithPenDownBy: delta]]].
bounds := bounds translateBy: delta.
fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta].
fill := self fillStyle.
fill isOrientedFill ifTrue: [fill origin: fill origin + delta]!
Item was added:
+ ----- Method: Morph>>isScriptEditorMorph (in category 'classification') -----
+ isScriptEditorMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isViewer (in category 'classification') -----
+ isViewer
+ ^false!
Item was changed:
----- Method: Morph>>okayToAddDismissHandle (in category 'halos and balloon help') -----
okayToAddDismissHandle
"Answer whether a halo on the receiver should offer a dismiss handle. This provides a hook for making it harder to disassemble some strucures even momentarily"
+ ^ self resistsRemoval not!
- ^ self holdsSeparateDataForEachInstance not and:
- [self resistsRemoval not]!
Item was changed:
+ ----- Method: PasteUpMorph>>adaptedToWorld: (in category 'initialization') -----
- ----- Method: PasteUpMorph>>adaptedToWorld: (in category 'scripting') -----
adaptedToWorld: aWorld
"If I refer to a world or a hand, return the corresponding items in the new world."
self isWorldMorph ifTrue:[^aWorld].!
Item was changed:
----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') -----
exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
directory: aDirectory
"Store my project out on the disk as an *exported*
ImageSegment. All outPointers will be in a form that can be resolved
in the target image. Name it <project name>.extSeg. Whatdo we do
about subProjects, especially if they are out as local image
segments? Force them to come in?
Player classes are included automatically."
| is str ans revertSeg roots holder collector fd mgr stacks |
"Files out a changeSet first, so that a project can contain
its own classes"
world ifNil: [^ false]. world presenter ifNil: [^ false].
Utilities emptyScrapsBook.
world currentHand pasteBuffer: nil. "don't write the paste buffer."
world currentHand mouseOverHandler initialize. "forget about any
references here"
"Display checkCurrentHandForObjectToPaste."
Command initialize.
world clearCommandHistory.
world fullReleaseCachedState; releaseViewers.
world cleanseStepList.
world localFlapTabs size = world flapTabs size ifFalse: [
self error: 'Still holding onto Global flaps'].
world releaseSqueakPages.
- ScriptEditorMorph writingUniversalTiles: (self projectParameterAt:
- #universalTiles ifAbsent: [false]).
holder := Project allProjects. "force them in to outPointers, where
DiskProxys are made"
"Just export me, not my previous version"
revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil].
self projectParameters removeKey: #revertToMe ifAbsent: [].
roots := OrderedCollection new.
roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
roots add: world activeHand.
"; addAll: classList; addAll: (classList collect: [:cls | cls class])"
roots := roots reject: [ :x | x isNil]. "early saves may not have
active hand or thumbnail"
fd := aDirectory directoryNamed: self resourceDirectoryName.
fd assureExistence.
"Clean up resource references before writing out"
mgr := self resourceManager.
self resourceManager: nil.
ResourceCollector current: ResourceCollector new.
ResourceCollector current localDirectory: fd.
ResourceCollector current baseUrl: self resourceUrl.
ResourceCollector current initializeFrom: mgr.
ProgressNotification signal: '2:findingResources' extra:
'(collecting resources...)' translated.
"Must activate old world because this is run at #armsLength.
Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
will not be captured correctly if referenced from blocks or user code."
world becomeActiveDuring:[
is := ImageSegment new copySmartRootsExport: roots asArray.
"old way was (is := ImageSegment new
copyFromRootsForExport: roots asArray)"
].
self resourceManager: mgr.
collector := ResourceCollector current.
ResourceCollector current: nil.
ProgressNotification signal: '2:foundResources' extra: ''.
is state = #tooBig ifTrue: [
collector replaceAll.
^ false].
str := ''.
"considered legal to save a project that has never been entered"
(is outPointers includes: world) ifTrue: [
str := str, '\Project''s own world is not in the segment.' translated withCRs].
str isEmpty ifFalse: [
ans := UIManager default chooseFrom: {
'Do not write file' translated.
'Write file anyway' translated.
'Debug' translated.
} title: str.
ans = 1 ifTrue: [
revertSeg ifNotNil: [projectParameters at:
#revertToMe put: revertSeg].
collector replaceAll.
^ false].
ans = 3 ifTrue: [
collector replaceAll.
self halt: 'Segment not written' translated]].
stacks := is findStacks.
is
writeForExportWithSources: aFileName
inDirectory: fd
changeSet: aChangeSetOrNil.
SecurityManager default signFile: aFileName directory: fd.
"Compress all files and update check sums"
collector forgetObsolete.
self storeResourceList: collector in: fd.
self storeHtmlPageIn: fd.
self storeManifestFileIn: fd.
self writeStackText: stacks in: fd registerIn: collector.
"local proj.005.myStack.t"
self compressFilesIn: fd to: aFileName in: aDirectory
resources: collector.
"also deletes the resource directory"
"Now update everything that we know about"
mgr updateResourcesFrom: collector.
revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
holder.
collector replaceAll.
world flapTabs do: [:ft |
(ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
is arrayOfRoots do: [:obj |
+ obj isScriptEditorMorph ifTrue: [obj unhibernate]].
- obj class == ScriptEditorMorph ifTrue: [obj unhibernate]].
^ true
!
Item was changed:
----- Method: PasteUpMorph>>presenter (in category 'accessing') -----
presenter
"Normally only the world will have a presenter, but the architecture supports individual localized presenters as well"
^ presenter ifNil:
[self isWorldMorph
+ ifTrue: [presenter := Presenter defaultPresenterClass new associatedMorph: self]
- ifTrue: [presenter := Presenter new associatedMorph: self]
ifFalse: [super presenter]]!
Item was added:
+ ----- Method: Morph>>isTilePadMorph (in category 'classification') -----
+ isTilePadMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isTileMorph (in category 'classification') -----
+ isTileMorph
+ ^false!
Item was changed:
----- Method: PluggableTextMorphWithModel>>newTextContents: (in category 'contents') -----
newTextContents: stringOrText
"Accept new text contents."
+ | newText myText |
- | newText aStack setter myText |
"Just underway; trying to make this work like TextMorph does, but not quite there yet."
newText := stringOrText asText.
(myText := textMorph text) = newText ifTrue: [^ self]. "No substantive change"
+
-
- (self holdsSeparateDataForEachInstance and: [(aStack := self stack) notNil])
- ifTrue:
- [setter := self valueOfProperty: #setterSelector.
- setter ifNotNil:
- [(self valueOfProperty: #cardInstance) perform: setter with: newText]].
-
self world ifNotNil:
[self world startSteppingSubmorphsOf: self ].
!
Item was changed:
----- Method: UpdatingStringMorph>>acceptValue: (in category 'editing') -----
acceptValue: aValue
- "If target is a CardPlayer, and its costume is one of my owners, change target to its current CardPlayer"
- target class superclass == CardPlayer ifTrue: [
- (self hasOwner: target costume) ifTrue: [
- self target: target costume player]].
-
self updateContentsFrom: (self acceptValueFromTarget: aValue).
!
Item was changed:
----- Method: Morph>>openATextPropertySheet (in category 'meta-actions') -----
openATextPropertySheet
"should only be sent to morphs that are actually supportive"
+ Smalltalk at: #TextPropertiesMorph ifPresent:[:aClass|
+ ^aClass basicNew
+ targetMorph: self;
+ initialize;
+ openNearTarget
+ ].
+ Beeper beep.!
- TextPropertiesMorph basicNew
- targetMorph: self;
- initialize;
- openNearTarget!
Item was added:
+ ----- Method: Morph>>isKedamaMorph (in category 'classification') -----
+ isKedamaMorph
+ ^false!
Item was changed:
----- Method: PasteUpMorph>>morphToDropFrom: (in category 'dropping/grabbing') -----
morphToDropFrom: aMorph
"Given a morph being carried by the hand, which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service."
| aNail representee handy posBlock |
handy := self primaryHand.
posBlock :=
[:z | | tempPos |
tempPos := handy position
- ((handy targetOffset - aMorph formerPosition)
* (z extent / aMorph extent)) rounded.
self pointFromWorld: tempPos].
self alwaysShowThumbnail
ifTrue:
[aNail := aMorph
representativeNoTallerThan: self maxHeightToAvoidThumbnailing
norWiderThan: self maximumThumbnailWidth
thumbnailHeight: self heightForThumbnails.
aNail == aMorph
ifFalse:
[aMorph formerPosition: aMorph position.
aNail position: (posBlock value: aNail)].
^aNail].
((aMorph isKindOf: MorphThumbnail)
and: [(representee := aMorph morphRepresented) owner isNil])
ifTrue:
[representee position: (posBlock value: representee).
^representee].
self showingListView
ifTrue:
[^aMorph
listViewLineForFieldList: (self valueOfProperty: #fieldListSelectors)].
(aMorph hasProperty: #newPermanentScript)
ifTrue: [^aMorph asEmptyPermanentScriptor].
+ ((aMorph isPhraseTileMorph) or: [aMorph isSyntaxMorph])
- ((aMorph isKindOf: PhraseTileMorph) or: [aMorph isSyntaxMorph])
ifFalse: [^aMorph].
aMorph userScriptSelector isEmptyOrNil
ifTrue:
["non-user"
self automaticPhraseExpansion ifFalse: [^aMorph]].
^aMorph morphToDropInPasteUp: self!
Item was added:
+ ----- Method: Morph>>isCompoundTileMorph (in category 'classification') -----
+ isCompoundTileMorph
+ ^false!
Item was changed:
----- Method: PasteUpMorph>>findWindow: (in category 'world menu') -----
findWindow: evt
"Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."
| menu expanded collapsed nakedMorphs |
menu := MenuMorph new.
expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not].
collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed].
nakedMorphs := self submorphsSatisfying:
+ [:m | (m isSystemWindow not and: [(m isStickySketchMorph) not]) and:
- [:m | (m isSystemWindow not and: [(m isKindOf: StickySketchMorph) not]) and:
[(m isFlapTab) not]].
(expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep].
(expanded asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
[:w | menu add: w label target: w action: #activateAndForceLabelToShow.
w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
(expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine].
(collapsed asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
[:w | menu add: w label target: w action: #collapseOrExpand.
w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
nakedMorphs isEmpty ifFalse: [menu addLine].
(nakedMorphs asSortedCollection: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do:
[:w | menu add: w nameForFindWindowFeature target: w action: #comeToFrontAndAddHalo].
menu addTitle: 'find window' translated.
menu popUpEvent: evt in: self.!
Item was changed:
----- Method: PasteUpMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
"Draw in order:
- background color
- grid, if any
- background sketch, if any
- Update and draw the turtleTrails form. See the comment in updateTrailsForm.
- cursor box if any
Later (in drawSubmorphsOn:) I will skip drawing the background sketch."
"draw background fill"
super drawOn: aCanvas.
"draw grid"
(self griddingOn and: [self gridVisible])
ifTrue:
[aCanvas fillRectangle: self bounds
fillStyle: (self
gridFormOrigin: self gridOrigin
grid: self gridModulus
background: nil
line: Color lightGray)].
"draw background sketch."
backgroundMorph ifNotNil: [
self clipSubmorphs ifTrue: [
aCanvas clipBy: self clippingBounds
during: [ :canvas | canvas fullDrawMorph: backgroundMorph ]]
ifFalse: [ aCanvas fullDrawMorph: backgroundMorph ]].
"draw turtle trails"
+ (lastTurtlePositions isNil or: [lastTurtlePositions isEmpty]) ifFalse:[
+ self updateTrailsForm.
+ ].
- self updateTrailsForm.
turtleTrailsForm
ifNotNil: [aCanvas paintImage: turtleTrailsForm at: self position].
"draw cursor"
(submorphs notEmpty and: [self indicateCursor])
ifTrue:
[aCanvas
frameRectangle: self selectedRect
width: 2
color: Color black]!
Item was changed:
----- Method: HaloMorph>>tearOffTileForTarget:with: (in category 'handles') -----
tearOffTileForTarget: evt with: aHandle
"Tear off a tile representing my inner target. If shift key is down, open up an instance browser on the morph itself, not the player, with tiles showing, instead"
self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
+ innerTarget tearOffTile!
- evt shiftPressed
- ifTrue: [innerTarget openInstanceBrowserWithTiles]
- ifFalse: [innerTarget tearOffTile]
- !
Item was removed:
- ----- Method: PasteUpMorph>>recreateScripts (in category 'scripting') -----
- 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 removed:
- ----- Method: PasteUpMorph>>setThumbnailHeight (in category 'options') -----
- 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 removed:
- ----- Method: Morph>>configureForKids (in category 'e-toy support') -----
- configureForKids
- submorphs ifNotNil:
- [submorphs do: [:m | m configureForKids]]!
Item was removed:
- ----- Method: PasteUpMorph>>becomeLikeAHolder (in category 'options') -----
- 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 removed:
- ----- Method: Morph>>convertNovember2000DropShadow:using: (in category 'object fileIn') -----
- convertNovember2000DropShadow: varDict using: smartRefStrm
- "Work hard to eliminate the DropShadow. Inst vars are already
- stored into."
-
- | rend |
- submorphs notEmpty
- ifTrue:
- [rend := submorphs first renderedMorph.
- "a text?"
- rend setProperty: #hasDropShadow toValue: true.
- rend setProperty: #shadowColor toValue: (varDict at: 'color').
- rend setProperty: #shadowOffset toValue: (varDict at: 'shadowOffset').
- "ds owner ifNotNil: [ds owner addAllMorphs: ds
- submorphs]. ^rend does this"
- rend privateOwner: owner.
- extension ifNotNil: [
- extension actorState ifNotNil: [rend actorState: self extension actorState].
- extension externalName ifNotNil: [rend setNameTo: self extension externalName].
- extension player ifNotNil: [
- rend player: extension player.
- extension player rawCostume: rend]].
- ^rend].
- (rend := Morph new) color: Color transparent.
- ^rend!
Item was removed:
- ----- Method: Morph>>bringUpToDate (in category 'scripting') -----
- bringUpToDate
-
- (self buttonProperties ifNil: [^self]) bringUpToDate!
Item was removed:
- ----- Method: PasteUpMorph>>linesAndArrowsForAllPens (in category 'pen') -----
- linesAndArrowsForAllPens
- "Set the trail style for all my objects to show arrows"
-
- self trailStyleForAllPens: #arrows!
Item was removed:
- ----- Method: Morph>>tabHitWithEvent: (in category '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 removed:
- ----- Method: Morph>>holdsSeparateDataForEachInstance (in category '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 removed:
- ----- Method: ScriptEditorMorph>>objectViewed (in category 'e-toy support') -----
- objectViewed
- ^ self playerScripted costume!
Item was removed:
- ----- Method: PasteUpMorph>>updateTrailsForm (in category '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 removed:
- ----- Method: Morph>>hasButtonProperties (in category 'button properties') -----
- hasButtonProperties
-
- ^self hasProperty: #universalButtonProperties!
Item was removed:
- ----- Method: ScriptEditorMorph>>setTimeStamp (in category 'other') -----
- setTimeStamp
- timeStamp := Date today mmddyyyy, ' ', (Time now print24 copyFrom: 1 to: 8).
- ^ timeStamp!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>traverseRowTranslateSlotOld:of:to: (in category 'translation') -----
- 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 removed:
- ----- Method: Morph>>insertAsStackBackground (in category '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 removed:
- ----- Method: PasteUpMorph>>showAllPlayers (in category 'scripting') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>explainDesignations (in category '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 removed:
- ----- Method: ComponentLikeModel>>showPins (in category 'components') -----
- showPins
- "Make up sensitized pinMorphs for each of my interface variables"
- self pinSpecs do: [:pinSpec | self addPinFromSpec: pinSpec]!
Item was removed:
- ----- Method: ComponentLikeModel>>renameMe (in category 'components') -----
- renameMe
- | otherNames newName |
- otherNames := Set newFrom: self pasteUpMorph allKnownNames.
- newName := UIManager default request: 'Please give this new a name'
- initialAnswer: self knownName.
- newName isEmpty ifTrue: [^ nil].
- (otherNames includes: newName) ifTrue:
- [self inform: 'Sorry, that name is already used'. ^ nil].
- self setNamePropertyTo: newName!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph class>>additionsToViewerCategoryPreferences (in category '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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>setMorph: (in category 'initialization') -----
- setMorph: anActorMorph
- "Not really the way to do this any more"
- playerScripted := anActorMorph player
- !
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>makeFenceSound (in category 'player commands') -----
- makeFenceSound
- Preferences soundsEnabled ifTrue:
- [self playSoundNamed: 'scratch'].
- !
Item was removed:
- ----- Method: Morph>>goToNextCardInStack (in category 'card in a stack') -----
- goToNextCardInStack
- "Tell my stack to advance to the next page"
-
- self stackDo: [:aStack | aStack goToNextCardInStack]!
Item was removed:
- ----- Method: ScriptEditorMorph>>codeString (in category 'other') -----
- codeString
- ^ String streamContents: [:aStream | self storeCodeOn: aStream indent: 1]
- !
Item was removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>makeIsolatedCodePane (in category 'buttons') -----
- makeIsolatedCodePane
- MethodHolder makeIsolatedCodePaneForClass: playerScripted class selector: scriptName!
Item was removed:
- ----- Method: PasteUpMorph>>linesForAllPens (in category 'pen') -----
- linesForAllPens
- "Set the trail style for all my objects to show lines only"
-
- self trailStyleForAllPens: #lines!
Item was removed:
- ----- Method: PasteUpMorph>>viewingBySizeString (in category '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 removed:
- ----- Method: PasteUpMorph>>modernizeBJProject (in category 'scripting') -----
- 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 removed:
- ----- Method: ComponentLikeModel>>pinSpecs (in category 'components') -----
- pinSpecs
- ^ pinSpecs!
Item was removed:
- ----- Method: PasteUpMorph>>automaticViewing: (in category 'options') -----
- automaticViewing: aBoolean
- self setProperty: #automaticViewing toValue: aBoolean!
Item was removed:
- ----- Method: PasteUpMorph>>relaunchAllViewers (in category 'scripting') -----
- 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 removed:
- ----- Method: PasteUpMorph>>hideAllPlayers (in category 'scripting') -----
- hideAllPlayers
-
- | a |
- a := OrderedCollection new.
- self allMorphsDo: [ :x |
- (x isKindOf: ViewerFlapTab) ifTrue: [a add: x]
- ].
- a do: [ :each | each delete].
- !
Item was removed:
- ----- Method: ScriptEditorMorph>>willingToBeDiscarded (in category 'dropping/grabbing') -----
- willingToBeDiscarded
- "Resist the drag-into-trash gesture"
-
- ^ false!
Item was removed:
- ----- Method: Morph>>isPlayer:ofReferencingTile: (in category 'translation') -----
- 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 removed:
- ----- Method: PasteUpMorph>>viewingByIconString (in category '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 removed:
- ----- Method: Morph>>isStackBackground (in category '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 removed:
- ----- Method: ScriptEditorMorph>>recreateScript (in category 'other') -----
- recreateScript
- | aUserScript |
- aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
- aUserScript recreateScriptFrom: self!
Item was removed:
- ----- Method: Morph>>tanOButton (in category 'e-toy 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 removed:
- ----- Method: Morph>>buttonProperties (in category 'button properties') -----
- buttonProperties
-
- ^self valueOfProperty: #universalButtonProperties!
Item was removed:
- ----- Method: Morph>>pinkXButton (in category 'e-toy 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 removed:
- ----- Method: ScriptEditorMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
- "Release any state that could be recomputed"
-
- super releaseCachedState.
- handWithTile := nil.
- self hibernate!
Item was removed:
- ----- Method: Morph>>reshapeBackground (in category '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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>noteNewLocation:forPlayer: (in category '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 removed:
- ----- Method: PasteUpMorph>>createOrResizeTrailsForm (in category '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 removed:
- ----- Method: PasteUpMorph>>dotsForAllPens (in category 'pen') -----
- dotsForAllPens
- "Set the trail style for all my objects to show dots"
-
- self trailStyleForAllPens: #dots!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>timeStamp (in category 'other') -----
- timeStamp
- ^ timeStamp!
Item was removed:
- ----- Method: MorphicProject>>currentStack (in category 'project parameters') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>currentDataValue (in category 'player') -----
- currentDataValue
- "Answer the data value associated with the receiver. Useful in conjunction with default-value setting"
-
- ^ nil!
Item was removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>backgroundForm: (in category 'painting') -----
- backgroundForm: aForm
-
- self backgroundSketch: (self drawingClass new
- center: self center;
- form: aForm)!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>enforceTileColorPolicy (in category 'e-toy support') -----
- enforceTileColorPolicy
- Preferences coloredTilesEnabled
- ifTrue:
- [self makeAllTilesColored]
- ifFalse:
- [self makeAllTilesGreen]!
Item was removed:
- ----- Method: PasteUpMorph>>backgroundForm (in category 'painting') -----
- backgroundForm
-
- ^ self backgroundSketch
- ifNil: [Form extent: self extent depth: Display depth]
- ifNotNil: [backgroundMorph form]!
Item was removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>paintBackground (in category 'painting') -----
- 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 removed:
- ----- Method: Morph>>isTileScriptingElement (in category 'scripting') -----
- isTileScriptingElement
-
- ^ self hasButtonProperties and: [self buttonProperties isTileScriptingElement]!
Item was removed:
- ----- Method: Morph>>showForegroundObjects (in category '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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>autoViewingString (in category 'menu & halo') -----
- 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 removed:
- ----- Method: Morph>>getPenDown (in category 'pen') -----
- getPenDown
- self player ifNil: [^ false].
- ^ self actorState getPenDown!
Item was removed:
- ----- Method: Morph>>assuredCardPlayer (in category 'player') -----
- 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 removed:
- ----- Method: PasteUpMorph>>tellAllContents: (in category 'scripting') -----
- 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 removed:
- ----- Method: StandardScriptingSystem class>>removeUnreferencedPlayers (in category 'utilities') -----
- removeUnreferencedPlayers
- "Remove existing but unreferenced player references"
- "StandardScriptingSystem removeUnreferencedPlayers"
- References keys do:
- [:key | (References at: key) costume pasteUpMorph
- ifNil: [References removeKey: key]].
- !
Item was removed:
- ----- Method: Morph>>fenceEnabled (in category 'e-toy support') -----
- fenceEnabled
-
- "in case a non-pasteUp is used as a container"
-
- ^Preferences fenceEnabled!
Item was removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>arrowsForAllPens (in category 'pen') -----
- arrowsForAllPens
- "Set the trail style for all my objects to show arrowheads only"
-
- self trailStyleForAllPens: #arrowheads!
Item was removed:
- ----- Method: ScriptEditorMorph>>scriptName (in category 'buttons') -----
- scriptName
- ^ scriptName!
Item was removed:
- ----- Method: Morph>>variableDocks (in category 'player') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>scriptSelectorToTriggerFor: (in category '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 removed:
- ----- Method: ScriptEditorMorph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
-
- ^ true
- !
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>jumpTo: (in category 'player commands') -----
- jumpTo: aPoint
- "Let my owner decide how I move."
-
- owner move: self toPosition: aPoint.
- !
Item was removed:
- ----- Method: PasteUpMorph>>trailMorph (in category 'pen') -----
- trailMorph
- "Yes, you can draw trails on me."
- ^ self!
Item was removed:
- ----- Method: Morph>>makeHoldSeparateDataForEachInstance (in category '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 removed:
- ----- Method: Morph>>asEmptyPermanentScriptor (in category '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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>isCandidateForAutomaticViewing (in category 'e-toy support') -----
- isCandidateForAutomaticViewing
- ^ false!
Item was removed:
- ----- Method: Morph>>traverseRowTranslateSlotOld:to: (in category 'translation') -----
- 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 removed:
- ----- Method: ScriptEditorMorph>>ceaseHavingAParameter (in category 'other') -----
- ceaseHavingAParameter
- "Cease having a parameter"
-
- playerScripted ceaseHavingAParameterFor: scriptName!
Item was removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>adaptToWorld: (in category 'e-toy support') -----
- adaptToWorld: aWorld
-
- self unhibernate "for universal tiles"!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>insertCard (in category '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 removed:
- ----- 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 removed:
- ----- Method: JoystickMorph class>>additionsToViewerCategories (in category '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 removed:
- ----- Method: Morph>>scriptPerformer (in category 'macpal') -----
- scriptPerformer
- ^ self topRendererOrSelf player ifNil: [self]!
Item was removed:
- ----- Method: PasteUpMorph>>updateSubmorphThumbnails (in category 'options') -----
- 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 removed:
- ----- Method: ScriptEditorMorph>>scriptEdited (in category 'private') -----
- scriptEdited
-
- | anEditor |
- (anEditor := self topEditor) ifNotNil: [anEditor recompileScript]!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>moveWithPenDownBy: (in category 'private') -----
- 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 removed:
- ----- Method: ComponentLikeModel>>duplicate:from: (in category 'initialization') -----
- duplicate: newGuy from: oldGuy
- "oldGuy has just been duplicated and will stay in this world. Make sure all the ComponentLikeModel requirements are carried out for the copy. Ask user to rename it. "
-
- newGuy installModelIn: oldGuy pasteUpMorph.
- newGuy copySlotMethodsFrom: oldGuy slotName.!
Item was removed:
- ----- Method: PasteUpMorph>>impartPrivatePresenter (in category 'misc') -----
- impartPrivatePresenter
- presenter ifNil:
- [presenter := Presenter new associatedMorph: self.
- presenter standardPlayer]!
Item was removed:
- ----- 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 removed:
- AlignmentMorph subclass: #ScriptEditorMorph
- instanceVariableNames: 'scriptName firstTileRow timeStamp playerScripted handWithTile showingMethodPane threadPolygon'
- classVariableNames: 'WritingUniversalTiles'
- poolDictionaries: ''
- category: 'Morphic-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 removed:
- ----- Method: Morph>>addPlayerItemsTo: (in category 'menus') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>followPath (in category 'e-toy 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 removed:
- ----- Method: PasteUpMorph>>toggleFenceEnabled (in category 'options') -----
- toggleFenceEnabled
-
- self fenceEnabled: self fenceEnabled not!
Item was removed:
- ----- Method: Morph>>accumlatePlayersInto:andSelectorsInto: (in category 'translation') -----
- 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 removed:
- ----- Method: Morph>>showDesignationsOfObjects (in category '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 removed:
- ----- Method: Morph>>listViewLineForFieldList: (in category 'e-toy 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 removed:
- ----- Method: ComponentLikeModel>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: anEvent
- | theModel |
- theModel := aMorph modelOrNil.
- ((aMorph isKindOf: ComponentLayout)
- and: [theModel isKindOf: Component]) ifFalse:
- ["Disconnect prior to removal by move"
- (theModel isKindOf: Component) ifTrue: [self unwire. model := nil].
- ^ super justDroppedInto: aMorph event: anEvent].
- theModel == model ifTrue: [^ self "Presumably just a move"].
- self initComponentIn: aMorph.
- super justDroppedInto: aMorph event: anEvent!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>setFrequencyTo: (in category 'frequency') -----
- setFrequencyTo: aNumber
- self scriptInstantiation frequency: aNumber!
Item was removed:
- ----- Method: StandardScriptingSystem class>>applyNewEToyLook (in category 'utilities') -----
- 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 removed:
- ----- Method: Morph>>enclosingEditor (in category 'e-toy 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>noteNegotiatedName:for: (in category 'e-toy 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 removed:
- ----- Method: PasteUpMorph>>viewingNonOverlappingString (in category '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 removed:
- ----- Method: Morph>>addStackItemsTo: (in category 'menus') -----
- 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 removed:
- ----- Method: Morph>>wrapWithAStack (in category '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 removed:
- ----- Method: PasteUpMorph>>playfieldOptionsMenu (in category 'menu & halo') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>behaveLikeAHolderString (in category 'options') -----
- 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 removed:
- ----- Method: ComponentLikeModel>>initFromPinSpecs (in category 'components') -----
- initFromPinSpecs
- "no-op for default"!
Item was removed:
- ----- Method: ScriptEditorMorph>>explainStatusAlternatives (in category 'customevents-other') -----
- explainStatusAlternatives
- (StringHolder new contents: (ScriptingSystem statusHelpStringFor: playerScripted))
- openLabel: 'Script Status' translated!
Item was removed:
- ----- Method: PasteUpMorph>>imposeListViewSortingBy:retrieving: (in category '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 removed:
- ----- Method: PasteUpMorph>>notePenDown:forPlayer:at: (in category 'pen') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>choosePartName (in category 'naming') -----
- choosePartName
- "Pick an unused name for this morph."
- | className |
- self world ifNil: [^nil].
- (self world model isKindOf: Component) ifTrue:
- [self knownName ifNil: [^ self nameMeIn: self world]
- ifNotNil: [^ self renameMe]].
- className := self class name.
- (className size > 5 and: [className endsWith: 'Morph'])
- ifTrue: [className := className copyFrom: 1 to: className size - 5].
- ^ self world model addPartNameLike: className withValue: self!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph class>>additionsToViewerCategoryConnection (in category 'connectors-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 removed:
- ----- Method: Morph>>makeAllTilesGreen (in category 'scripting') -----
- makeAllTilesGreen
- self allMorphsDo:
- [:m | m useUniformTileColor]!
Item was removed:
- ----- Method: Morph>>convertAugust1998:using: (in category 'object fileIn') -----
- convertAugust1998: varDict using: smartRefStrm
- "These variables are automatically stored into the new instance
- ('bounds' 'owner' 'submorphs' 'fullBounds' 'color' ).
- This method is for additional changes. Use statements like (foo :=
- varDict at: 'foo')."
-
- "Be sure to to fill in ('extension' ) and deal with the information
- in ('eventHandler' 'properties' 'costumee' )"
-
- "This method moves all property variables as well as
- eventHandler, and costumee into a morphicExtension."
-
- "Move refs to eventhandler and costumee into extension"
-
-
- (varDict at: 'eventHandler') isNil
- ifFalse: [self eventHandler: (varDict at: 'eventHandler')].
- (varDict at: 'costumee') isNil
- ifFalse: [self player: (varDict at: 'costumee')].
- (varDict at: 'properties') isNil
- ifFalse:
- [(varDict at: 'properties') keys do:
- [:key | | propVal |
- "Move property extensions into extension"
-
- propVal := (varDict at: 'properties') at: key.
- propVal ifNotNil:
- [key == #possessive
- ifTrue: [propVal == true ifTrue: [self bePossessive]]
- ifFalse:
- [key ifNotNil: [self assureExtension convertProperty: key toValue: propVal]]]]]!
Item was removed:
- ----- Method: ComponentLikeModel>>choosePartName (in category 'naming') -----
- choosePartName
- "When I am renamed, get a slot, make default methods, move any existing methods."
-
- | old |
- (self pasteUpMorph model isKindOf: Component)
- ifTrue:
- [self knownName ifNil: [^self nameMeIn: self pasteUpMorph]
- ifNotNil: [^self renameMe]].
- old := slotName.
- super choosePartName.
- slotName ifNil: [^self]. "user chose bad slot name"
- self model: self world model slotName: slotName.
- old isNil
- ifTrue: [self compilePropagationMethods]
- ifFalse: [self copySlotMethodsFrom: old]
- "old ones not erased!!"!
Item was removed:
- ----- Method: Morph>>defaultFloatPrecisionFor: (in category '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 removed:
- ----- Method: Morph>>topEditor (in category 'e-toy 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 removed:
- ----- Method: ScriptEditorMorph>>fixLayout (in category 'menu') -----
- fixLayout
- self fixLayoutOfSubmorphsNotIn: IdentitySet new!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>scriptEditorFor: (in category 'scripting') -----
- scriptEditorFor: aScriptName
- ^ self assuredPlayer scriptEditorFor: aScriptName!
Item was removed:
- ----- Method: ScriptEditorMorph>>installWithNewLiteral (in category 'buttons') -----
- installWithNewLiteral
-
- self removeSpaces.
- scriptName ifNotNil:
- [playerScripted ifNotNil: [playerScripted acceptScript: self topEditor for: scriptName]]!
Item was removed:
- ----- Method: Morph>>assuredPlayer (in category 'player') -----
- 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 removed:
- ----- Method: Morph>>choosePenSize (in category 'pen') -----
- choosePenSize
- self assuredPlayer choosePenSize!
Item was removed:
- ----- Method: PasteUpMorph>>makeDetachable (in category 'misc') -----
- makeDetachable
- presenter
- ifNil:
- [self impartPrivatePresenter.
- self borderWidth: 1; borderColor: Color green darker]
- ifNotNil:
- [self inform: 'This view is ALREADY detachable']!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>updateLiteralLabel (in category 'player viewer') -----
- updateLiteralLabel
- "Backstop -- updatingStringMorphs inform their owners with this message when they've changed; some Morphs care, others don't"!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>changeAllBorderColorsFrom:to: (in category 'e-toy 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 removed:
- ----- Method: PasteUpMorph>>viewByIcon (in category '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 removed:
- ----- Method: Morph>>goToPreviousCardInStack (in category 'card in a stack') -----
- goToPreviousCardInStack
- "Tell my stack to advance to the previous card"
-
- self stackDo: [:aStack | aStack goToPreviousCardInStack]!
Item was removed:
- ----- Method: PasteUpMorph>>autoExpansionString (in category 'menu & halo') -----
- 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 removed:
- ----- Method: Morph>>becomeSharedBackgroundField (in category '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 removed:
- ----- Method: PasteUpMorph>>fenceEnabled: (in category 'options') -----
- fenceEnabled: aBoolean
-
- self setProperty: #fenceEnabled toValue: aBoolean!
Item was removed:
- ----- Method: PasteUpMorph>>addImageToPenTrailsFor: (in category '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 removed:
- ----- Method: StandardScriptingSystem class>>removePlayersIn: (in category 'utilities') -----
- 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 removed:
- ----- Method: Morph>>containsCard: (in category '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: PasteUpMorph>>toggleIndicateCursor (in category 'options') -----
- toggleIndicateCursor
- indicateCursor := self indicateCursor not.
- self changed.!
Item was removed:
- ----- Method: PasteUpMorph>>liftAllPens (in category 'pen') -----
- liftAllPens
- submorphs do: [:m | m assuredPlayer liftPen]!
Item was removed:
- ----- Method: ScriptEditorMorph>>setParameterType: (in category 'testing') -----
- setParameterType: typeChosen
- "Set the parameter type as indicated"
-
- playerScripted setParameterFor: scriptName toType: typeChosen!
Item was removed:
- ----- Method: Morph>>fire (in category 'button') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>isTurtleRow (in category 'translation') -----
- 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 removed:
- ----- Method: Morph>>stackDo: (in category '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 removed:
- ----- Method: Morph>>couldHoldSeparateDataForEachInstance (in category '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 removed:
- ----- Method: PasteUpMorph>>batchPenTrailsString (in category 'menu & halo') -----
- 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 removed:
- ----- Method: ComponentLikeModel>>addPinFromSpec: (in category 'components') -----
- addPinFromSpec: pinSpec
- | pin |
- pin := PinMorph new component: self pinSpec: pinSpec.
- self addMorph: pin.
- pin placeFromSpec.
- ^ pin!
Item was removed:
- ----- Method: Morph>>penColor: (in category 'pen') -----
- penColor: aColor
- self assuredPlayer penColor: aColor!
Item was removed:
- ----- Method: PasteUpMorph>>toggleAlwaysShowThumbnail (in category 'options') -----
- toggleAlwaysShowThumbnail
- (self hasProperty: #alwaysShowThumbnail)
- ifTrue:
- [self removeProperty: #alwaysShowThumbnail]
- ifFalse:
- [self setProperty: #alwaysShowThumbnail toValue: true].
- self updateSubmorphThumbnails!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>choosePenColor: (in category 'pen') -----
- choosePenColor: evt
- self assuredPlayer choosePenColor: evt!
Item was removed:
- ----- Method: Morph>>stack (in category '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 removed:
- ----- Method: Morph>>relaxGripOnVariableNames (in category '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 removed:
- ----- Method: Morph>>deletePath (in category 'e-toy support') -----
- deletePath
- self removeProperty: #pathPoints!
Item was removed:
- ----- Method: Morph>>showPlayerMenu (in category 'player') -----
- showPlayerMenu
- self player ifNotNil:
- [self player showPlayerMenu]!
Item was removed:
- ----- Method: ScriptEditorMorph>>deleteThreadShowing (in category 'menu commands') -----
- deleteThreadShowing
-
- threadPolygon ifNotNil: [threadPolygon delete. threadPolygon := nil].
- !
Item was removed:
- ----- 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 removed:
- ----- Method: ComponentLikeModel>>initPinSpecs (in category 'components') -----
- initPinSpecs
- "no-op for default"
- pinSpecs := Array new.
- !
Item was removed:
- ----- Method: PasteUpMorph>>trailStyleForAllPens: (in category 'pen') -----
- trailStyleForAllPens: aTrailStyle
- "Ascribe the given trail style to all pens of objects within me"
-
- submorphs do: [:m | m assuredPlayer setTrailStyle: aTrailStyle]
- !
Item was removed:
- ----- Method: ScriptEditorMorph>>saveScriptVersion (in category 'save & revert') -----
- saveScriptVersion
- self userScriptObject saveScriptVersion: self setTimeStamp!
Item was removed:
- ----- Method: PluggableTextMorph>>selectionAsTiles (in category 'menu commands') -----
- selectionAsTiles
- self handleEdit: [textMorph editor selectionAsTiles]!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>newPlayerInstance (in category 'player') -----
- newPlayerInstance
- ^ UnscriptedPlayer newUserInstance!
Item was removed:
- ----- Method: ScriptEditorMorph>>isEmpty (in category 'other') -----
- isEmpty
- ^ submorphs size < firstTileRow!
Item was removed:
- ----- Method: PasteUpMorph>>addViewingItemsTo: (in category 'debug and other') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>adoptVocabulary: (in category 'e-toy support') -----
- adoptVocabulary: aVocabulary
- "Make aVocabulary be the one used by me and my submorphs"
-
- self submorphsDo: [:m | m adoptVocabulary: aVocabulary]!
Item was removed:
- ----- Method: ScriptEditorMorph>>replaceRow1 (in category 'buttons') -----
- replaceRow1
-
- submorphs first delete. "the button row"
- self addMorphFront: self buttonRowForEditor. "up to date"
- !
Item was removed:
- ----- Method: Morph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- (varDict at: #ClassName) == #DropShadowMorph ifTrue: [
- varDict at: #ClassName put: #Morph. "so we don't
- repeat this"
- ^ self convertNovember2000DropShadow: varDict using:
- smartRefStrm
- "always returns a new object of a different class"
- ].
- varDict at: 'costumee' ifPresent: [ :x |
- self convertAugust1998: varDict using: smartRefStrm].
- "never returns a different object"
-
- "5/18/2000"
- varDict at: 'openToDragNDrop' ifPresent: [ :x | self
- enableDragNDrop: x ].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>viewByName (in category '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 removed:
- ----- Method: ScriptEditorMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: evt
-
- ^ true
- !
Item was removed:
- ----- Method: PasteUpMorph>>fenceEnabledString (in category 'menu & halo') -----
- 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 removed:
- ----- Method: PasteUpMorph>>galleryOfPlayers (in category 'world menu') -----
- 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 removed:
- ----- Method: Morph>>wantsConnectionVocabulary (in category 'scripting') -----
- wantsConnectionVocabulary
- submorphs ifNil: [ ^true ]. "called from EToyVocabulary>>initialize after basicNew"
-
- ^ (Preferences valueOfFlag: #alwaysShowConnectionVocabulary)
- or: [ self connections isEmpty not ]!
Item was removed:
- ----- Method: Morph>>useUniformTileColor (in category 'scripting') -----
- useUniformTileColor
- self player ifNotNil:
- [self player allScriptEditors do:
- [:anEditor | anEditor allMorphsDo:
- [:m | m useUniformTileColor]]]!
Item was removed:
- ----- Method: ScriptEditorMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 1!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>definePath (in category 'e-toy 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 removed:
- ----- Method: Morph>>putOnForeground (in category 'menus') -----
- 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 removed:
- ----- Method: ScriptEditorMorph>>renameScript (in category 'other') -----
- renameScript
- "Rename the current script. Invoked at user menu request"
-
- playerScripted renameScript: self scriptName!
Item was removed:
- ----- Method: PasteUpMorph>>presentViewMenu (in category 'menu & halo') -----
- 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 removed:
- ----- Method: ScriptEditorMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ ScriptingSystem colorBehindTiles!
Item was removed:
- ----- Method: PasteUpMorph>>currentVocabularyFor: (in category 'scripting') -----
- 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 removed:
- ----- Method: PasteUpMorph>>backgroundSketch (in category 'painting') -----
- backgroundSketch
-
- backgroundMorph ifNil: [^ nil].
- backgroundMorph owner == self ifFalse:
- [backgroundMorph := nil]. "has been deleted"
- ^ backgroundMorph!
Item was removed:
- ----- Method: ScriptEditorMorph>>storeCodeOn:indent: (in category 'other') -----
- storeCodeOn: aStream indent: tabCount
- | lastOwner |
- lastOwner := nil.
- self tileRows do:
- [:r |
- r do:
- [:m |
- ((m isKindOf: TileMorph)
- or: [(m isKindOf: CompoundTileMorph) or: [m isKindOf: PhraseTileMorph]])
- 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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>mouseEnterDragging: (in category 'event handling') -----
- mouseEnterDragging: evt
- "Test button state elsewhere if at all"
- ^ self mouseEnter: evt!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>attemptCleanupReporting: (in category '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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>printOn: (in category 'access') -----
- printOn: aStream
- ^ aStream nextPutAll: 'ScriptEditor for #', scriptName asString, ' player: ', playerScripted externalName!
Item was removed:
- ----- Method: PasteUpMorph>>attemptCleanup (in category '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 removed:
- ----- 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 removed:
- ----- Method: Morph>>getPenColor (in category 'pen') -----
- getPenColor
- ^ self player ifNotNil: [self actorState getPenColor] ifNil: [Color green]!
Item was removed:
- ----- Method: Morph>>getPenSize (in category 'pen') -----
- getPenSize
- self player ifNil: [^ 1].
- ^ self actorState getPenSize!
Item was removed:
- ----- 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 removed:
- ----- Method: MorphExtension>>convertProperty:toValue: (in category 'object fileIn') -----
- convertProperty: aSymbol toValue: anObject
- "These special cases move old properties into named fields of the
- extension"
- aSymbol == #locked
- ifTrue: [^ locked := anObject].
- aSymbol == #visible
- ifTrue: [^ visible := anObject].
- aSymbol == #sticky
- ifTrue: [^ sticky := anObject].
- aSymbol == #balloonText
- ifTrue: [^ balloonText := anObject].
- aSymbol == #balloonTextSelector
- ifTrue: [^ balloonTextSelector := anObject].
- aSymbol == #actorState
- ifTrue: [^ actorState := anObject].
- aSymbol == #player
- ifTrue: [^ player := anObject].
- aSymbol == #name
- ifTrue: [^ externalName := anObject].
- "*renamed*"
- aSymbol == #partsDonor
- ifTrue: [^ isPartsDonor := anObject].
- "*renamed*"
- self assureOtherProperties at: aSymbol put: anObject!
Item was removed:
- ----- Method: PasteUpMorph>>fenceEnabled (in category 'e-toy support') -----
- fenceEnabled
-
- ^ self valueOfProperty: #fenceEnabled ifAbsent: [Preferences fenceEnabled]!
Item was removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ false!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ComponentLikeModel>>initComponentIn: (in category 'components') -----
- initComponentIn: aLayout
- model := aLayout model.
- self nameMeIn: aLayout.
- self color: Color lightCyan.
- self initPinSpecs.
- self initFromPinSpecs.
- self showPins.
- model addDependent: self!
Item was removed:
- ----- Method: ScriptEditorMorph>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: evt
- "Test button state elsewhere if at all"
- ^ self mouseLeave: evt!
Item was removed:
- ----- Method: PasteUpMorph>>toggleBehaveLikeAHolder (in category 'options') -----
- toggleBehaveLikeAHolder
- "Toggle whether or not the receiver is currently behaving like a holder"
-
- self behaveLikeHolder: (self behavingLikeAHolder not)!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>isValidWonderlandTexture (in category 'texture support') -----
- isValidWonderlandTexture
- "Return true if the receiver is a valid wonderland texture"
- ^ self
- valueOfProperty: #isValidWonderlandTexture
- ifAbsent: [true]!
Item was removed:
- ----- Method: ScriptEditorMorph>>showingMethodPane: (in category 'textually-coded scripts') -----
- showingMethodPane: val
- "Whether the receiver will show the textual method pane"
-
- showingMethodPane := val!
Item was removed:
- ----- Method: Morph>>putOnBackground (in category 'menus') -----
- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>tearOffTile (in category '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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>hasParameter (in category 'buttons') -----
- hasParameter
- "Answer whether the receiver has a parameter"
-
- ^ scriptName numArgs > 0!
Item was removed:
- MorphicModel subclass: #ComponentLikeModel
- instanceVariableNames: 'pinSpecs'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Components'!
Item was removed:
- ----- Method: Morph>>installAsCurrent: (in category '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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>scriptInstantiation (in category 'access') -----
- scriptInstantiation
- ^ playerScripted scriptInstantiationForSelector: scriptName!
Item was removed:
- ----- Method: PasteUpMorph>>backgroundSketch: (in category 'painting') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>restoreScriptName: (in category 'buttons') -----
- restoreScriptName: aScriptName
- "For fixup only..."
-
- scriptName := aScriptName!
Item was removed:
- ----- Method: PasteUpMorph>>clearTurtleTrails (in category 'pen') -----
- clearTurtleTrails
-
- turtleTrailsForm := nil.
- turtlePen := nil.
- self changed.
- !
Item was removed:
- ----- Method: Morph>>triggerScript: (in category 'scripting') -----
- triggerScript: aSymbol
- "Have my player perform the script of the given name, which is guaranteed to exist."
-
- ^self assuredPlayer triggerScript: aSymbol!
Item was removed:
- ----- Method: ScriptEditorMorph class>>writingUniversalTiles: (in category 'instance creation') -----
- writingUniversalTiles: boolean
-
- WritingUniversalTiles := boolean!
Item was removed:
- ----- Method: ScriptEditorMorph>>morph (in category 'access') -----
- morph
- ^ self playerScripted costume!
Item was removed:
- ----- Method: Morph>>beAStackBackground (in category '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 removed:
- ----- Method: ScriptEditorMorph>>playerScripted: (in category 'initialization') -----
- playerScripted: aPlayer
- playerScripted := aPlayer !
Item was removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>viewingByNameString (in category '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 removed:
- ----- 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 removed:
- ----- Method: Morph>>asWearableCostume (in category 'e-toy support') -----
- asWearableCostume
- "Return a wearable costume for some player"
- ^(World drawingClass withForm: self imageForm) copyCostumeStateFrom: self!
Item was removed:
- ----- Method: Morph>>abstractAModel (in category '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 removed:
- ----- Method: Morph>>showBackgroundObjects (in category '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 removed:
- ----- Method: ScriptEditorMorph>>localeChanged (in category 'e-toy support') -----
- localeChanged
- "Update myself to reflect the change in locale"
-
- self fixLayout!
Item was removed:
- ----- Method: PasteUpMorph>>lowerAllPens (in category 'pen') -----
- lowerAllPens
- submorphs do: [:m | m assuredPlayer lowerPen]
- !
Item was removed:
- ----- Method: Morph>>newCard (in category '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 removed:
- ----- Method: Morph>>liftPen (in category 'pen') -----
- liftPen
- self assuredPlayer liftPen!
Item was removed:
- ----- Method: ScriptEditorMorph>>playerScripted (in category 'buttons') -----
- playerScripted
- ^ playerScripted!
Item was removed:
- ----- Method: PasteUpMorph>>deleteBackgroundPainting (in category 'painting') -----
- deleteBackgroundPainting
- backgroundMorph
- ifNotNil:
- [backgroundMorph delete.
- backgroundMorph := nil]
- ifNil:
- [self inform: 'There is presently no
- background painting
- to delete.']!
Item was removed:
- ----- Method: Morph>>setAsDefaultValueForNewCard (in category '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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>toggleOriginAtCenter (in category 'options') -----
- toggleOriginAtCenter
- | hasIt |
- hasIt := self hasProperty: #originAtCenter.
- hasIt
- ifTrue:
- [self removeProperty: #originAtCenter]
- ifFalse:
- [self setProperty: #originAtCenter toValue: true]!
Item was removed:
- ----- Method: ComponentLikeModel>>pinsDo: (in category 'components') -----
- pinsDo: pinBlock
- self submorphsDo: [:m | (m isKindOf: PinMorph) ifTrue: [pinBlock value: m]]!
Item was removed:
- ----- Method: PasteUpMorph>>viewNonOverlapping (in category '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 removed:
- ----- 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 removed:
- ----- Method: Morph>>lowerPen (in category 'pen') -----
- lowerPen
- self assuredPlayer lowerPen!
Item was removed:
- ----- Method: PasteUpMorph>>toggleAutomaticPhraseExpansion (in category 'options') -----
- toggleAutomaticPhraseExpansion
- | expand |
- expand := self hasProperty: #automaticPhraseExpansion.
- expand
- ifTrue:
- [self removeProperty: #automaticPhraseExpansion]
- ifFalse:
- [self setProperty: #automaticPhraseExpansion toValue: true]!
Item was removed:
- ----- Method: Morph>>penUpWhile: (in category 'pen') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>trailMorph (in category 'pen') -----
- trailMorph
- "You can't draw trails on me, but try my owner."
-
- owner isNil ifTrue: [^nil].
- ^owner trailMorph!
Item was removed:
- ----- Method: Morph>>getCharacters (in category 'e-toy support') -----
- getCharacters
- "obtain a string value from the receiver. The default generic response is simply the name of the object."
-
- ^ self externalName!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>scriptorForTextualScript:ofPlayer: (in category 'scripting') -----
- 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 removed:
- ----- Method: Morph>>actorState (in category 'accessing') -----
- 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 removed:
- ----- Method: Morph>>creationStamp (in category 'system primitives') -----
- creationStamp
- "Answer the creation stamp stored within the receiver, if any"
-
- ^ self valueOfProperty: #creationStamp ifAbsent: [super creationStamp]!
Item was removed:
- ----- Method: ScriptEditorMorph>>tearOfButtonToFireScript (in category 'other') -----
- tearOfButtonToFireScript
- "Tear off a button to fire this script"
-
- playerScripted tearOffButtonToFireScriptForSelector: scriptName!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>bringTileScriptingElementsUpToDate (in category '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 removed:
- ----- Method: Morph class>>helpContributions (in category '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 removed:
- ----- Method: PasteUpMorph>>viewBySize (in category '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 removed:
- ----- Method: ScriptEditorMorph>>stepTime (in category 'testing') -----
- stepTime
-
- ^ 0!
Item was removed:
- ----- Method: ScriptEditorMorph class>>writingUniversalTiles (in category 'instance creation') -----
- writingUniversalTiles
- "Only valid during the write of a Project."
-
- ^ WritingUniversalTiles!
Item was removed:
- ----- Method: ScriptEditorMorph>>prepareToUndoDropOf: (in category 'dropping/grabbing') -----
- prepareToUndoDropOf: aMorph
- "No longer functional"!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>slotSpecifications (in category 'e-toy support') -----
- slotSpecifications
- "A once and possibly future feature; retained here for backward-compatibility bulletproofing."
-
- ^ #()!
Item was removed:
- ----- Method: Morph>>makeAllTilesColored (in category 'scripting') -----
- makeAllTilesColored
- self allMorphsDo:
- [:m | m restoreTypeColor]!
Item was removed:
- ----- Method: Morph>>ensuredButtonProperties (in category 'button properties') -----
- ensuredButtonProperties
-
- self hasButtonProperties ifFalse: [
- self buttonProperties: (ButtonProperties new visibleMorph: self)
- ].
- ^self buttonProperties!
Item was removed:
- ----- 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 isKindOf: PhraseTileMorph) 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 removed:
- ----- Method: Morph>>asWearableCostumeOfExtent: (in category 'e-toy support') -----
- asWearableCostumeOfExtent: extent
- "Return a wearable costume for some player"
- ^self asWearableCostume!
Item was removed:
- ----- Method: PasteUpMorph>>toggleAutomaticViewing (in category 'options') -----
- toggleAutomaticViewing
- | current |
- current := self automaticViewing.
- current
- ifTrue:
- [self removeProperty: #automaticViewing]
- ifFalse:
- [self setProperty: #automaticViewing toValue: true]!
Item was removed:
- ----- Method: Morph>>appearsToBeSameCostumeAs: (in category 'e-toy support') -----
- appearsToBeSameCostumeAs: aMorph
-
- ^false
- !
Item was removed:
- ----- Method: ComponentLikeModel>>extent: (in category 'geometry') -----
- extent: newExtent
- super extent: newExtent.
- self submorphsDo: [:m | (m isKindOf: PinMorph) ifTrue: [m placeFromSpec]]!
Item was removed:
- ----- Method: PasteUpMorph>>arrowheadsOnAllPens (in category 'pen') -----
- arrowheadsOnAllPens
-
- submorphs do: [:m | m assuredPlayer setPenArrowheads: true]
- !
Item was removed:
- ----- Method: ComponentLikeModel>>delete (in category 'submorphs-add/remove') -----
- delete
- "Delete the receiver. Possibly put up confirming dialog. Abort if user changes mind"
-
- (model isKindOf: Component) ifTrue: [^self deleteComponent].
- (model isMorphicModel) ifFalse: [^super delete].
- slotName ifNotNil:
- [(self confirm: 'Shall I remove the slot ' , slotName
- , '
- along with all associated methods?')
- ifTrue:
- [(model class selectors select: [:s | s beginsWith: slotName])
- do: [:s | model class removeSelector: s].
- (model class instVarNames includes: slotName)
- ifTrue: [model class removeInstVarName: slotName]]
- ifFalse:
- [(self
- confirm: '...but should I at least dismiss this morph?
- [choose no to leave everything unchanged]')
- ifFalse: [^self]]].
- super delete!
Item was removed:
- ----- Method: Morph>>defaultVariableName (in category 'e-toy 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 removed:
- ----- Method: Morph>>reassessBackgroundShape (in category '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 removed:
- ----- Method: Morph>>firedMouseUpCode (in category 'button') -----
- 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 removed:
- ----- Method: PasteUpMorph>>batchPenTrails (in category 'options') -----
- batchPenTrails
- "Answer whether pen trails should be batched in the receiver"
-
- ^ self valueOfProperty: #batchPenTrails ifAbsent: [Preferences batchPenTrails]!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>set: (in category 'player commands') -----
- set: aPointOrNumber
- "Set my position."
-
- self jumpTo: aPointOrNumber.
- !
Item was removed:
- ----- Method: Morph>>isTileLike (in category 'scripting') -----
- isTileLike
- "Cannot be dropped into a script"
- ^ false!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>currentDataInstance (in category 'card in a stack') -----
- currentDataInstance
- "Answer the current data instance"
-
- ^ self player!
Item was removed:
- ----- Method: Morph>>succeededInRevealing: (in category 'e-toy support') -----
- succeededInRevealing: aPlayer
- aPlayer == self player ifTrue: [^ true].
- submorphs do:
- [:m | (m succeededInRevealing: aPlayer) ifTrue: [^ true]].
- ^ false!
Item was removed:
- ----- Method: PasteUpMorph>>viewerFlapTabFor: (in category 'misc') -----
- 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 removed:
- ----- Method: Morph class>>hasAdditionsToViewerCategories (in category 'scripting') -----
- hasAdditionsToViewerCategories
- ^ self class selectors
- anySatisfy: [:each | each == #additionsToViewerCategories
- or: [(each beginsWith: 'additionsToViewerCategory')
- and: [(each at: 26 ifAbsent: []) ~= $:]]]!
Item was removed:
- ----- Method: Morph class>>additionsToViewerCategoryColorAndBorder (in category '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 removed:
- ----- Method: PasteUpMorph>>getCharacters (in category 'scripting') -----
- getCharacters
- "obtain a string value from the receiver"
-
- ^ String streamContents:
- [:aStream |
- submorphs do:
- [:m | aStream nextPutAll: m getCharacters]]!
Item was removed:
- ----- Method: PasteUpMorph>>batchPenTrails: (in category 'options') -----
- batchPenTrails: aBoolean
-
- self setProperty: #batchPenTrails toValue: aBoolean!
Item was removed:
- ----- Method: PasteUpMorph>>noArrowheadsOnAllPens (in category 'pen') -----
- noArrowheadsOnAllPens
-
- submorphs do: [:m | m assuredPlayer setPenArrowheads: false]
- !
Item was removed:
- ----- Method: Morph>>copyCostumeStateFrom: (in category 'e-toy 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 removed:
- ----- 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 removed:
- ----- Method: ScriptEditorMorph>>editMethodDescription (in category 'buttons') -----
- editMethodDescription
- "Edit the balloon help associated with the script"
-
- self userScriptObject editDescription.
- playerScripted updateAllViewers!
Item was removed:
- ----- Method: PasteUpMorph>>toggleBatchPenTrails (in category 'options') -----
- toggleBatchPenTrails
-
- self batchPenTrails: self batchPenTrails not!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>stopHoldingSeparateDataForEachInstance (in category 'card in a stack') -----
- stopHoldingSeparateDataForEachInstance
- "Make the receiver no longer hold separate data for each instance"
-
- self removeProperty: #holdsSeparateDataForEachInstance.
- self stack reassessBackgroundShape.!
Item was removed:
- ----- Method: ScriptEditorMorph>>revertScriptVersion (in category 'other') -----
- revertScriptVersion
- | aUserScript |
- aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
- aUserScript revertScriptVersionFrom: self!
Item was removed:
- ----- Method: PasteUpMorph>>elementCount (in category 'scripting') -----
- elementCount
- "Answer how many objects are contained within me"
-
- ^ submorphs size!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>arrowDeltaFor: (in category '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 removed:
- ----- 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 removed:
- ----- Method: PasteUpMorph>>abandonOldReferenceScheme (in category 'scripting') -----
- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>viewAfreshIn:showingScript:at: (in category '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 removed:
- ----- Method: Morph>>jettisonScripts (in category 'scripting') -----
- jettisonScripts
- self player ifNotNil: [self player class jettisonScripts]!
Item was removed:
- ----- Method: Morph>>affiliatedSelector (in category 'messenger') -----
- 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 removed:
- ----- Method: ScriptEditorMorph>>isTileScriptingElement (in category 'scripting') -----
- isTileScriptingElement
- ^ true!
Item was removed:
- ----- Method: PasteUpMorph>>drawPenTrailFor:from:to: (in category 'pen') -----
- 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 removed:
- ----- Method: ComponentLikeModel>>nameMeIn: (in category 'components') -----
- nameMeIn: aWorld
- | stem otherNames i partName className |
- className := self class name.
- stem := className.
- (stem size > 5 and: [stem endsWith: 'Morph'])
- ifTrue: [stem := stem copyFrom: 1 to: stem size - 5].
- stem := stem first asLowercase asString , stem allButFirst.
- otherNames := Set newFrom: aWorld allKnownNames.
- i := 1.
- [otherNames includes: (partName := stem , i printString)]
- whileTrue: [i := i + 1].
- self setNamePropertyTo: partName!
Item was removed:
- ----- Method: Morph>>beep: (in category 'player commands') -----
- beep: soundName
-
- self playSoundNamed: soundName
- !
Item was removed:
- ----- Method: ScriptEditorMorph>>isTileEditor (in category 'e-toy support') -----
- isTileEditor
- "Yes I am"
- ^true!
Item was removed:
- ----- Method: Morph>>currentVocabulary (in category 'macpal') -----
- currentVocabulary
- "Answer the receiver's current vocabulary"
-
- | outer |
- ^ (outer := self ownerThatIsA: StandardViewer orA: ScriptEditorMorph)
- ifNotNil:
- [outer currentVocabulary]
- ifNil:
- [super currentVocabulary]!
Item was removed:
- ----- Method: Morph>>buttonProperties: (in category 'button properties') -----
- buttonProperties: propertiesOrNil
-
- propertiesOrNil ifNil: [
- self removeProperty: #universalButtonProperties
- ] ifNotNil: [
- self setProperty: #universalButtonProperties toValue: propertiesOrNil
- ].!
Item was removed:
- ----- 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 removed:
- ----- Method: Morph>>restoreTypeColor (in category 'scripting') -----
- restoreTypeColor
- self player ifNotNil: [self player allScriptEditors do:
- [:anEditor | anEditor allMorphsDo:
- [:m | m restoreTypeColor]]]!
Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: Morph>>filterViewerCategoryDictionary: (in category '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 removed:
- ----- Method: ComponentLikeModel>>deleteComponent (in category 'components') -----
- deleteComponent
- model removeDependent: self.
- self pinsDo: [:pin | pin delete].
- ^ super delete!
More information about the Packages
mailing list