'From Vancouver1.0 of 28 September 2004 [latest update: #345] on 13 November 2004 at 2:53:28 am'! "Change Set: newTiles-sw Date: 3 October 2004 Author: Scott Wallace Makes two new tiles available in viewers, as per requests from Ted and Alan. 'include at cursor' in #collections for PasteUpMorphs. 'background color' in #text (also in color & borrder) for TextMorphs Adapted 16Nov04 for Squeakland from Vancouver update 0248newTiles-sw"! !PasteUpMorph class methodsFor: 'scripting' stamp: 'sw 10/3/2004 01:14'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ # ( (playfield ( (command initiatePainting 'Initiate painting of a new object in the standard playfield.') (slot mouseX 'The x coordinate of the mouse pointer' Number readWrite Player getMouseX unused unused) (slot mouseY 'The y coordinate of the mouse pointer' Number readWrite Player getMouseY unused unused) (command roundUpStrays 'Bring all out-of-container subparts back into view.') (slot graphic 'The graphic shown in the background of this object' Graphic readWrite Player getGraphic Player setGraphic:) (command unhideHiddenObjects 'Unhide all hidden objects.'))) (scripting ( (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName))) (collections ( (slot cursor 'The index of the chosen element' Number readWrite Player getCursor Player setCursorWrapped:) (slot count 'How many elements are within me' Number readOnly Player getCount unused unused) (slot stringContents 'The characters of the objects inside me, laid end to end' String readOnly Player getStringContents unused unused) (slot playerAtCursor 'the object currently at the cursor' Player readWrite Player getValueAtCursor unused unused) (slot firstElement 'The first object in my contents' Player readWrite Player getFirstElement Player setFirstElement:) (slot numberAtCursor 'the number at the cursor' Number readWrite Player getNumberAtCursor Player setNumberAtCursor: ) (slot graphicAtCursor 'the graphic worn by the object at the cursor' Graphic readOnly Player getGraphicAtCursor unused unused) (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName) (command removeAll 'Remove all elements from the playfield') (command shuffleContents 'Shuffle the contents of the playfield') (command append: 'Add the object to the end of my contents list.' Player) (command prepend: 'Add the object at the beginning of my contents list.' Player) (command includeAtCursor: 'Add the object to my contents at my current cursor position' Player) (command include: 'Add the object to my contents' Player) )) (#'stack navigation' ( (command goToNextCardInStack 'Go to the next card') (command goToPreviousCardInStack 'Go to the previous card') (command goToFirstCardInBackground 'Go to the first card of the current background') (command goToFirstCardOfStack 'Go to the first card of the entire stack') (command goToLastCardInBackground 'Go to the last card of the current background') (command goToLastCardOfStack 'Go to the last card of the entire stack') (command deleteCard 'Delete the current card') (command insertCard 'Create a new card'))) "(viewing ( (slot viewingNormally 'whether contents are viewed normally' Boolean readWrite Player getViewingByIcon Player setViewingByIcon: )))" (#'pen trails' ( (command liftAllPens 'Lift the pens on all the objects in my interior.') (command lowerAllPens 'Lower the pens on all the objects in my interior.') (command trailStyleForAllPens: 'Set the trail style for pens of all objects within' TrailStyle) (command clearTurtleTrails 'Clear all the pen trails in the interior.')))) ! ! !Player methodsFor: 'scripts-standard' stamp: 'sw 10/3/2004 01:45'! getBackgroundColor "Answer the background color; the costume is presumed to be a TextMorph" ^ self costume renderedMorph backgroundColor ifNil: [Color transparent]! ! !Player methodsFor: 'scripts-standard' stamp: 'sw 10/3/2004 01:27'! includeAtCursor: aPlayer "Add aPlayer to the list of objects logically 'within' me, at my current cursor position. ." | aCostume | (aPlayer isNil or: [aPlayer == self]) ifTrue: [^self]. (aPlayer class == Text or: [aPlayer class == String]) ifTrue: [^ self costume class == TextFieldMorph ifTrue: [self costume append: aPlayer] ifFalse: [self]]. aCostume := self costume topRendererOrSelf. aPlayer costume goHome. "assure it's in view" (aCostume isKindOf: PasteUpMorph) ifTrue: [aCostume addMorph: aPlayer costume asElementNumber: self getCursor. aCostume invalidRect: aCostume bounds] ifFalse: [aCostume addMorphBack: aPlayer. self setCursor: aCostume submorphs size]! ! !Player methodsFor: 'scripts-standard' stamp: 'sw 10/3/2004 01:32'! setBackgroundColor: aColor "Set the background color; the costume is presumed to be a text morph." self costume renderedMorph backgroundColor: aColor! ! !Player methodsFor: 'slots-kernel' stamp: 'sw 10/16/2004 03:55'! usableMethodInterfacesIn: methodInterfaceList "Filter the list given by methodInterfaceList, to remove items inappropriate to the receiver" self hasCostumeThatIsAWorld ifTrue: "Formerly we had been hugely restrictive here, but let's try the other extreme for a while..." [^ methodInterfaceList reject: [:anInterface | #() includes: anInterface selector]]. self hasAnyBorderedCostumes ifTrue: [^ methodInterfaceList]. ^ self hasOnlySketchCostumes ifTrue: [methodInterfaceList select: [:anInterface | (#(getColor getSecondColor getBorderColor getBorderWidth getBorderStyle getRoundedCorners getUseGradientFill getRadialGradientFill ) includes: anInterface selector) not]] ifFalse: [methodInterfaceList select: [:anInterface | (#(getBorderColor getBorderWidth) includes: anInterface selector) not]]! ! !StandardScriptingSystem methodsFor: 'utilities' stamp: 'nk 10/14/2004 11:19'! wordingForOperator: aString "Answer the wording to be seen by the user for the given operator symbol/string" | toTest | toTest _ aString asString. #( (append: 'include at end') (arrowheadsOnAllPens 'arrowheads on all pens') (beep: 'make sound') (bounce: 'bounce') (clearTurtleTrails 'clear pen trails') (clearOwnersPenTrails 'clear all pen trails') (colorSees 'color sees') (color:sees: 'color sees') (doMenuItem: 'do menu item') (doScript: 'do') (forward: 'forward by') (goToRightOf: 'align after') (includeAtCursor: 'include at cursor') (isDivisibleBy: 'is divisible by') (liftAllPens 'lift all pens') (lowerAllPens 'lower all pens') (makeNewDrawingIn: 'start painting in') (max: 'max') (min: 'min') (moveToward: 'move toward') (noArrowheadsOnAllPens 'no arrowheads on pens') (overlapsAny 'overlaps any') (pauseAll: 'pause all') (pauseScript: 'pause script') (prepend: 'include at beginning') (seesColor: 'is over color') (startAll: 'start all') (startScript: 'start script') (stopProgramatically 'stop') (stopAll: 'stop all') (stopScript: 'stop script') (tellAllSiblings: 'tell all siblings') (tellSelfAndAllSiblings: 'send to all') (turn: 'turn by') (turnToward: 'turn toward') (wearCostumeOf: 'look like')) do: [:pair | toTest = pair first ifTrue: [^ pair second]]. ^ toTest "StandardScriptingSystem initialize" ! ! !TextMorph class methodsFor: 'scripting' stamp: 'sw 10/3/2004 01:34'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #( (#'color & border' ( (slot backgroundColor 'The color of the background behind the text' Color readWrite Player getBackgroundColor Player setBackgroundColor:))) (text ( (slot backgroundColor 'The color of the background behind the text' Color readWrite Player getBackgroundColor Player setBackgroundColor:) (slot characters 'The characters in my contents' String readWrite Player getCharacters Player setCharacters:) (slot cursor 'The position among my characters that replacement text would go' Number readWrite Player getCursor Player setCursor:) (slot characterAtCursor 'The character at the my cursor position' String readWrite Player getCharacterAtCursor Player setCharacterAtCursor:) (slot count 'How many characters I have' Number readOnly Player getCount unused unused) (slot firstCharacter 'The first character in my contents' String readWrite Player getFirstCharacter Player setFirstCharacter:) (slot lastCharacter 'The last character in my contents' String readWrite Player getLastCharacter Player setLastCharacter:) (slot allButFirst 'All my characters except the first one' String readWrite Player getAllButFirstCharacter Player setAllButFirstCharacter:) (command insertCharacters: 'insert the given string at my cursor position' String) (command insertContentsOf: 'insert the characters from another object at my cursor position' Player) (slot numericValue 'The number represented by my contents' Number readWrite Player getNumericValue Player setNumericValue:))) (basic ( (slot characters 'The characters in my contents' String readWrite Player getCharacters Player setCharacters:)))) ! !