'From Squeak3.1alpha of 5 February 2001 [latest update: #4045] on 18 May 2001 at 1:27:39 pm'! "Change Set: Biobranches9 Date: 18 May 2001 Author: Bob Arning The last two change sets had enough errors for a lifetime. Here it goes again. Adding a #stamp method to player so that a morph can leave a picture of itself behind before it moves on or is deleted. Added a #stampAndErase command to the Viewer to take advantage of the above Refactored a bit"! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 13:24'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ { self additionsToViewerCategoryBasic. "note: if you change the thing below you also need to change #tileScriptCommands." self additionsToViewerCategoryScripts. self additionsToViewerCategoryColorAndBorder. self additionsToViewerCategoryGeometry. self additionsToViewerCategoryMiscellaneous. self additionsToViewerCategoryMotion. self additionsToViewerCategoryPenUse. self additionsToViewerCategoryTests. }! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:45'! additionsToViewerCategoryBasic ^#( basic ( (slot x 'The x coordinate' number readWrite player getX player setX:) (slot y 'The y coordinate' number readWrite player getY player setY:) (slot heading 'Which direction the object is facing. 0 is straight up' number readWrite player getHeading player setHeading:) (command forward: 'Moves the object forward in the direction it is heading' number) (command turn: 'Change the heading of the object by the specified amount' number) (command beep: 'Make the specified sound' sound) ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:49'! additionsToViewerCategoryColorAndBorder ^#( #'color & border' ( (slot color 'The color of the object' color readWrite player getColor player setColor:) (slot colorUnder 'The color under the center of the object' color readOnly player getColorUnder unused unused ) (slot luminanceUnder 'The luminance under the center of the object' number readOnly player getLuminanceUnder unused unused) (slot saturationUnder 'The saturation under the center of the object' number readOnly player getSaturationUnder unused unused) (slot brightnessUnder 'The brightness under the center of the object' number readOnly player getBrightnessUnder unused unused) (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:) ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:50'! additionsToViewerCategoryGeometry ^#(geometry ( (slot scaleFactor 'The factor by which the object is magnified' number readWrite player getScaleFactor player setScaleFactor:) (slot left 'The left edge' number readWrite player getLeft player setLeft:) (slot right 'The right edge' number readWrite player getRight player setRight:) (slot top 'The top edge' number readWrite player getTop player setTop:) (slot bottom 'The bottom edge' number readWrite player getBottom player setBottom:) (slot width 'The width' number readWrite player getWidth player setWidth:) (slot height 'The height' number readWrite player getHeight player setHeight:) (slot x 'The x coordinate' number readWrite player getX player setX:) (slot y 'The y coordinate' number readWrite player getY player setY:) (slot heading 'Which direction the object is facing. 0 is straight up' number readWrite player getHeading player setHeading:) (slot distance 'The length of the vector connecting the origin to the object''s position' number readWrite player getDistance player setDistance:) (slot theta 'The angle between the positive x-axis and the vector connecting the origin to the object''s position' number readWrite player getTheta player setTheta: ) ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:51'! additionsToViewerCategoryMiscellaneous ^#( miscellaneous ( (command doMenuItem: 'do the menu item' menu) (command show 'make the object visible') (command hide 'make the object invisible') (command wearCostumeOf: 'wear the costume of...' player) (command startScript: 'start the given script ticking' string) (command stopScript: 'make the given script be "normal"' string) (command pauseScript: 'make the given script be "paused"' string) (command tellAllSiblings: 'send a message to all siblings' string) (command fire 'trigger any and all of this object''s button actions') (slot copy 'returns a copy of this object' player readOnly player getNewClone unused unused) (slot elementNumber 'my index in my container' number readWrite player getIndexInOwner player setIndexInOwner:) (command stampAndErase 'add my image to the pen trails and go away') ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:52'! additionsToViewerCategoryMotion ^#( motion ( (slot x 'The x coordinate' number readWrite player getX player setX:) (slot y 'The y coordinate' number readWrite player getY player setY:) (slot heading 'Which direction the object is facing. 0 is straight up' number readWrite player getHeading player setHeading:) (command forward: 'Moves the object forward in the direction it is heading' number) (slot obtrudes 'whether the object sticks out over its container''s edge' boolean readOnly player getObtrudes unused unused) (command moveToward: 'move toward the given object' player) (command turn: 'Change the heading of the object by the specified amount' number) (command bounce: 'bounce off the edge if hit' sound) (command wrap 'wrap off the edge if appropriate') (command followPath 'follow the yellow brick road') (command goToRightOf: 'place this object to the right of another' player) ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:53'! additionsToViewerCategoryPenUse ^#( #'pen use' ( (slot penColor 'the color of ink used by the pen' color readWrite player getPenColor player setPenColor:) (slot penSize 'the width of the pen' number readWrite player getPenSize player setPenSize:) (slot penDown 'whether the pen is currently down' boolean readWrite player getPenDown player setPenDown:) (command clearOwnersPenTrails 'clear all pen trails in my containing playfield') ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:48'! additionsToViewerCategoryScripts "note: if you change the thing below you also need to change #tileScriptCommands." ^#( scripts ( (command emptyScript 'an empty script') ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'RAA 5/18/2001 12:53'! additionsToViewerCategoryTests ^#( #tests ( (slot isOverColor 'whether any part of the object is over the given color' boolean readOnly player seesColor: unused unused) (slot isUnderMouse 'whether the object is under the current mouse position' boolean readOnly player getIsUnderMouse unused unused) (slot colorSees 'whether the given color sees the given color' boolean readOnly player color:sees: unused unused) (slot touchesA 'whether I touch something that looks like...' boolean readOnly player touchesA: unused unused) (slot obtrudes 'whether the object sticks out over its container''s edge' boolean readOnly player getObtrudes unused unused) ) ) ! ! !PasteUpMorph methodsFor: 'pen' stamp: 'RAA 5/18/2001 10:47'! 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@0. image displayOn: turtleTrailsForm at: aMorph topLeft - self topLeft rule: Form paint. self invalidRect: (image boundingBox translateBy: aMorph topLeft). ! ! !Player methodsFor: 'costume' stamp: 'RAA 5/18/2001 12:41'! stamp "stamp an image of ourself onto the pen trails form" costume pasteUpMorph addImageToPenTrailsFor: costume topRendererOrSelf! ! !Player methodsFor: 'costume' stamp: 'RAA 5/18/2001 09:21'! stampAndErase self stamp. self erase.! ! !Player methodsFor: 'misc' stamp: 'RAA 5/18/2001 09:28'! erase self costume topRendererOrSelf delete! ! !UniclassScript methodsFor: 'script editor' stamp: 'RAA 5/18/2001 13:25'! releaseCachedState "release all non-showing scriptors. What do we do about versions????" "18 May 2001 - get more aggressive in dropping stuff" formerScriptingTiles _ OrderedCollection new. currentScriptEditor ifNil: [^ self]. true ifTrue: [^ self]. "<<< to test the reconstruction of scripts, change to false" currentScriptEditor world ifNil: ["not showing" currentScriptEditor _ nil]! ! "Postscript: " Vocabulary initialize!