'From Squeak3.1alpha of 28 February 2001 [latest update: #4351] on 27 September 2001 at 6:37:18 pm'! "Change Set: typeVocabularies-sw Date: 27 September 2001 Author: Scott Wallace Establishes a regime of first-class type vocabularies for the etoy system and beyond. This scheme replaces a large amount special-purpose type-handling code with a general mechanism that allows the type objects themselves to make the decisions. Among other things, this provides a modular design so that new types can be easily added without having to mess with any generic methods. This update also fixes numerous bugs and provides may other cleanups regarding etoys and vocabularies."! Object subclass: #ElementTranslation instanceVariableNames: 'wording helpMessage naturalLanguageSymbol ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! ProtocolBrowser subclass: #Lexicon instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Tools'! Lexicon subclass: #InstanceBrowser instanceVariableNames: 'objectViewed ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Tools'! Object subclass: #ObjectWithDocumentation instanceVariableNames: 'authoringStamp properties elementSymbol naturalLanguageTranslations ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! ObjectWithDocumentation subclass: #ElementCategory instanceVariableNames: 'categoryName keysInOrder elementDictionary ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! ObjectWithDocumentation subclass: #MethodInterface instanceVariableNames: 'selector argumentVariables resultSpecification receiverType attributeKeywords defaultStatus ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! ObjectWithDocumentation subclass: #ResultSpecification instanceVariableNames: 'type companionSetterSelector refetchFrequency ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! ObjectWithDocumentation subclass: #Variable instanceVariableNames: 'defaultValue floatPrecision variableName variableType ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! ObjectWithDocumentation subclass: #Vocabulary instanceVariableNames: 'vocabularyName categories methodInterfaces object limitClass translationTable ' classVariableNames: 'AllStandardVocabularies ' poolDictionaries: '' category: 'Protocols-Kernel'! Vocabulary subclass: #DataType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #BooleanType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #ColorType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! Vocabulary subclass: #EToyVocabulary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Etoy'! EToyVocabulary subclass: #EToyVectorVocabulary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Etoy'! DataType subclass: #FullVocabulary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! DataType subclass: #GraphicType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #MenuType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #NumberType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #PlayerType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! FullVocabulary subclass: #ScreenedVocabulary instanceVariableNames: 'methodScreeningBlock categoryScreeningBlock ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Kernel'! DataType subclass: #SoundType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #StringType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #SymbolListType instanceVariableNames: 'symbols ' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! SymbolListType subclass: #ButtonPhaseType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! DataType subclass: #UnknownType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Protocols-Type Vocabularies'! !Object methodsFor: 'testing' stamp: 'sw 9/26/2001 11:58'! basicType "Answer a symbol representing the inherent type of the receiver" ^ #Object! ! !Object methodsFor: 'viewer' stamp: 'sw 9/26/2001 11:58'! initialTypeForSlotNamed: aName "Answer the initial type to be ascribed to the given instance variable" ^ #Object! ! !Object methodsFor: 'scripts-kernel' stamp: 'sw 9/27/2001 13:30'! universalTilesForGetterOf: aMethodInterface "Return universal tiles for a getter on the given method interface." | ms argTile argArray itsSelector | itsSelector _ aMethodInterface selector. argArray _ #(). "Three gratuituous special cases..." (itsSelector == #color:sees:) ifTrue: [argTile _ ScriptingSystem tileForArgType: #Color. argArray _ Array with: argTile colorSwatch color with: argTile colorSwatch color copy]. itsSelector == #seesColor: ifTrue: [argTile _ ScriptingSystem tileForArgType: #Color. argArray _ Array with: argTile colorSwatch color]. itsSelector == #touchesA: ifTrue: [argTile _ ScriptingSystem tileForArgType: #Player. argArray _ Array with: argTile actualObject]. ms _ MessageSend receiver: self selector: itsSelector arguments: argArray. ^ ms asTilesIn: self class! ! !Object methodsFor: 'scripts-kernel' stamp: 'sw 9/27/2001 13:30'! universalTilesForInterface: aMethodInterface "Return universal tiles for the given method interface. Record who self is." | ms argTile itsSelector aType argList | itsSelector _ aMethodInterface selector. argList _ OrderedCollection new. aMethodInterface argumentVariables doWithIndex: [:anArgumentVariable :anIndex | argTile _ ScriptingSystem tileForArgType: (aType _ aMethodInterface typeForArgumentNumber: anIndex). argList add: (aType == #Player ifTrue: [argTile actualObject] ifFalse: [argTile literal]). "default value for each type"]. ms _ MessageSend receiver: self selector: itsSelector arguments: argList asArray. ^ ms asTilesIn: self class! ! !Boolean methodsFor: 'printing' stamp: 'sw 9/27/2001 17:19'! basicType "Answer a symbol representing the inherent type of the receiver" ^ #Boolean! ! !Color methodsFor: 'queries' stamp: 'sw 9/27/2001 17:26'! basicType "Answer a symbol representing the inherent type of the receiver" ^ #Color! ! !CompoundTileMorph methodsFor: 'miscellaneous' stamp: 'sw 9/27/2001 17:27'! resultType "Answer the result type of the receiver" ^ #Command! ! !Morph class methodsFor: 'scripting' stamp: 'sw 9/27/2001 17:40'! additionsToViewerCategoryBasic "Answer viewer additions for the 'basic' category" ^#( 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: 'sw 9/27/2001 17:39'! 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 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: 'sw 9/26/2001 04:22'! additionsToViewerCategoryGeometry "answer additions to the geometry viewer category" ^ #(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: 'sw 9/27/2001 17:39'! additionsToViewerCategoryMiscellaneous "Answer viewer additions for the 'miscellaneous' category" ^#( 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 doScript: 'run the given script once, on the next tick' String) (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 startAll: 'start the given script ticking in the object and all of its siblings.' String) (command stopAll: 'make the given script be "normal" in the object and all of its siblings' String) (command pauseAll: 'make the given script be "paused" in the object and all of its siblings' 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:) (slot holder 'the object''s container' Player readOnly Player getHolder Player setHolder:) (command stampAndErase 'add my image to the pen trails and go away') ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'sw 9/27/2001 17:40'! additionsToViewerCategoryMotion "Answer viewer additions for the 'motion' category" ^#( 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: 'sw 9/27/2001 17:40'! additionsToViewerCategoryPenUse "Answer viewer additions for the 'pen use' category" ^#( #'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: 'sw 9/27/2001 17:39'! additionsToViewerCategoryTests "Answer viewer additions for the 'tests' category" ^#( #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) ) ) ! ! !Morph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:24'! vectorAdditions "Answer slot/command definitions for the vector experiment" ^ # ( (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: ) (command + 'Adds two players together, treating each as a vector from the origin.' Player) (command - 'Subtracts one player from another, treating each as a vector from the origin.' Player) (command * 'Multiply a player by a Number, treating the Player as a vector from the origin.' Number) (command / 'Divide a player by a Number, treating the Player as a vector from the origin.' Number) (command incr: 'Each Player is a vector from the origin. Increase one by the amount of the other.' Player) (command decr: 'Each Player is a vector from the origin. Decrease one by the amount of the other.' Player) (command multBy: 'A Player is a vector from the origin. Multiply its length by the factor.' Number) (command dividedBy: 'A Player is a vector from the origin. Divide its length by the factor.' Number) )! ! !BookMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 03:54'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((#'book navigation' ((command goto: 'go to the given page' Player) (command nextPage 'go to next page') (command previousPage 'go to previous page') (command firstPage 'go to first page') (command lastPage 'go to last page'))))! ! !FlashPlayerMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 03:56'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ # ( (collections ( (slot cursor 'The index of the chosen element' Number readWrite player getCursor player setCursorWrapped:) (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 graphicAtCursor 'the graphic worn by the object at the cursor' Graphic readOnly player getGraphicAtCursor unused unused) )) ) ! ! !GraphMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:19'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #( (basic ( (slot cursor 'The current cursor location, wrapped back to the beginning if appropriate' Number readWrite Player getCursor Player setCursorWrapped:) (slot sampleAtCursor 'The sample value at the current cursor location' Number readWrite Player getSampleAtCursor Player setSampleAtCursor:))) (sampling ( (slot cursor 'The current cursor location, wrapped back to the beginning if appropriate' Number readWrite Player getCursor Player setCursorWrapped:) (slot sampleAtCursor 'The sample value at the current cursor location' Number readWrite Player getSampleAtCursor Player setSampleAtCursor:) (slot lastValue 'The last value obtained' Number readWrite Player getLastValue Player setLastValue:) (command clear 'Clear the graph of current contents') (command loadSineWave 'Load a sine wave as the current graph') (command loadSound: 'Load the specified sound into the current graph' Sound) (command reverse 'Reverse the graph') (command play 'Play the current graph as a sound'))))! ! !Number methodsFor: 'testing' stamp: 'sw 9/27/2001 17:26'! basicType "Answer a symbol representing the inherent type of the receiver" ^ #Number! ! !MethodInterface methodsFor: 'initialization' stamp: 'sw 9/26/2001 11:58'! conjuredUpFor: aSelector class: aClass "Initialize the receiver to have the given selector, obtaining whatever info one can from aClass. This basically covers the situation where no formal definition has been made." | parts | self initializeFor: aSelector. self absorbTranslation: (ElementTranslation new wording: aSelector helpMessage: 'no help available' language: #English). receiverType _ #unknown. parts _ aClass formalHeaderPartsFor: aSelector. argumentVariables _ (1 to: selector numArgs) collect: [:anIndex | Variable new name: (parts at: (4 * anIndex)) type: #Object]. parts last isEmptyOrNil ifFalse: [self documentation: parts last]. ! ! !MethodInterface methodsFor: 'initialization' stamp: 'sw 9/26/2001 04:20'! initializeFromEToyCommandSpec: tuple category: aCategorySymbol "tuple holds an old etoy command-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to hold the same information" selector _ tuple second. receiverType _ #Player. selector numArgs == 1 ifTrue: [argumentVariables _ OrderedCollection with: (Variable new name: (Player formalHeaderPartsFor: selector) fourth type: tuple fourth)]. aCategorySymbol ifNotNil: [self flagAttribute: aCategorySymbol]. self absorbTranslation: (ElementTranslation new wording: (ScriptingSystem wordingForOperator: selector) helpMessage: tuple third language: #English)! ! !MethodInterface methodsFor: 'initialization' stamp: 'sw 9/26/2001 04:20'! initializeFromEToySlotSpec: tuple "tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to hold the same information" | setter | selector _ tuple seventh. self absorbTranslation: (ElementTranslation new wording: tuple second helpMessage: tuple third language: #English). receiverType _ #Player. resultSpecification _ ResultSpecification new. resultSpecification resultType: tuple fourth. (#(getNewClone "etc.") includes: selector) ifTrue: [self setNotToRefresh] "actually should already be nil" ifFalse: [self setToRefetch]. ((tuple fifth == #readWrite) and: [((tuple size >= 9) and: [(setter _ tuple at: 9) ~~ #unused])]) ifTrue: [resultSpecification companionSetterSelector: setter]. "An example of an old slot-item spec: (slot numericValue 'A number representing the current position of the knob.' number readWrite Player getNumericValue Player setNumericValue:) 1 #slot 2 wording 3 balloon help 4 type 5 #readOnly or #readWrite 6 #Player (not used -- ignore) 7 getter selector 8 #Player (not used -- ignore) 9 setter selector " ! ! !MethodInterface methodsFor: 'initialization' stamp: 'sw 9/26/2001 04:21'! initializeSetterFromEToySlotSpec: tuple "tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods. Initialize the receiver to represent the getter of this item" selector _ tuple ninth. self absorbTranslation: (ElementTranslation new wording: ('set ', tuple second) helpMessage: ('setter for', tuple third) language: #English). receiverType _ #Player. argumentVariables _ Array with: (Variable new variableType: tuple fourth) ! ! !PasteUpMorph methodsFor: 'scripting' stamp: 'sw 9/25/2001 23:17'! 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 isKindOf: Player) ifTrue: [^ Vocabulary eToyVocabulary]. (aScriptableObject isKindOf: Number) ifTrue: [^ Vocabulary numberVocabulary]. (aScriptableObject isKindOf: Time) ifTrue: [^ Vocabulary vocabularyForClass: Time]. (aScriptableObject isKindOf: String) ifTrue: [^ Vocabulary vocabularyForClass: String]. (aScriptableObject isKindOf: Point) ifTrue: [(aPointVocab _ Vocabulary vocabularyForClass: Point) ifNotNil: [^ aPointVocab]]. (aScriptableObject isKindOf: Date) ifTrue: [^ Vocabulary vocabularyForClass: Date]. "OrderedCollection and Holder??" ^Vocabulary fullVocabulary]! ! !PasteUpMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:25'! 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 NumberAtCursor 'the Number at the cursor' Number readWrite Player getNumberAtCursor Player setNumberAtCursor: ) (slot playerAtCursor 'the object currently at the cursor' Player readWrite Player getValueAtCursor unused unused) (slot graphicAtCursor 'the graphic worn by the object at the cursor' Graphic readOnly Player getGraphicAtCursor unused unused) (command unhideHiddenObjects 'Unhide all hidden objects.'))) (collections ( (slot cursor 'The index of the chosen element' Number readWrite Player getCursor Player setCursorWrapped:) (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 removeAll 'Remove all elements from the playfield') (command shuffleContents 'Shuffle the contents of the playfield') (command append: 'Add the object to my content' 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 clearTurtleTrails 'Clear all the pen trails in the interior.')))) ! ! !PhonemeRecognizerMorph methodsFor: 'button and menu commands' stamp: 'sw 9/26/2001 03:23'! makeTile "Make a scripting tile to fetch the current phoneme's mouth position. Attach it to the hand, allowing the user to drop it directly into a tile script." | tile argTile | tile _ PhraseTileMorph new setSlotRefOperator: #mouthPosition type: #Number. argTile _ self tileToRefer. argTile bePossessive. tile firstSubmorph addMorph: argTile. tile enforceTileColorPolicy. ActiveHand attachMorph: tile ! ! !PhraseTileMorph methodsFor: 'initialization' stamp: 'sw 9/26/2001 11:58'! setOperator: opSymbol type: opType rcvrType: rcvrType argType: argType "Set the operator, type, receiver type, and argument type for the phrase" | aTileMorph | resultType _ opType. opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)]. self removeAllMorphs. self addMorph: (TilePadMorph new setType: rcvrType). aTileMorph _ TileMorph new adoptVocabulary: self currentVocabulary. self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color). opSymbol numArgs = 1 ifTrue: [self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]! ! !PhraseTileMorph methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:41'! setSlotRefOperator: opSymbol type: opType "Set the given symbol as the receiver's slot-reference operator, adding tiles to the receiver appropriately" resultType _ opType. self color: (ScriptingSystem colorForType: opType). self removeAllMorphs. self addMorph: (TilePadMorph new setType: #Player). self addMorphBack: ((TileMorph new setSlotRefOperator: opSymbol asString) typeColor: color) ! ! !PhraseTileMorph methodsFor: 'miscellaneous' stamp: 'sw 9/27/2001 17:28'! resultType "Answer the result type of the receiver" ^ resultType! ! !Player methodsFor: 'slots-user' stamp: 'sw 9/27/2001 14:28'! chooseSlotTypeFor: aGetter "Let the user designate a type for the slot associated with the given getter" | typeChoices typeChosen slotName | slotName _ Utilities inherentSelectorForGetter: aGetter. typeChoices _ Vocabulary typeChoices.. typeChosen _ (SelectionMenu selections: typeChoices lines: #()) startUpWithCaption: ('Choose the TYPE for ', slotName, ' (currently ', (self slotInfoAt: slotName) type, ')'). typeChosen isEmptyOrNil ifTrue: [^ self]. (self typeForSlot: slotName) capitalized = typeChosen ifTrue: [^ self]. (self slotInfoAt: slotName) type: typeChosen. self class allInstancesDo: "allSubInstancesDo:" [:anInst | anInst instVarNamed: slotName asString put: (anInst valueOfType: typeChosen from: (anInst instVarNamed: slotName))]. self updateAllViewers. "does siblings too" ! ! !Player methodsFor: 'slots-user' stamp: 'sw 9/27/2001 17:41'! initialTypeForSlotNamed: aName "Answer the initial type to be ascribed to the given instance variable" ^ #Number! ! !Player methodsFor: 'slots-user' stamp: 'sw 9/25/2001 22:28'! initialValueForSlotOfType: aType "Answer the default initial value to ascribe to a slot of the given type" ^ (Vocabulary vocabularyForType: aType) initialValueForASlotFor: self! ! !Player methodsFor: 'slots-user' stamp: 'sw 9/26/2001 04:02'! offerGetterTiles: slotName "For a player-type slot, offer to build convenient compound tiles that otherwise would be hard to get" | typeChoices typeChosen thePlayerThereNow slotChoices slotChosen getterTiles aCategoryViewer playerGetter fromPhrase | typeChoices _ Vocabulary typeChoices. fromPhrase _ ' from ', self externalName, '''s ', slotName. typeChosen _ (SelectionMenu selections: typeChoices lines: #()) startUpWithCaption: 'Choose the TYPE of data to get', fromPhrase. typeChosen isEmptyOrNil ifTrue: [^ self]. thePlayerThereNow _ self perform: (ScriptingSystem getterSelectorFor: slotName). thePlayerThereNow ifNil: [thePlayerThereNow _ self presenter standardPlayer]. slotChoices _ thePlayerThereNow slotNamesOfType: typeChosen. slotChoices size == 0 ifTrue: [^ self inform: 'sorry -- no slots of that type']. slotChosen _ (SelectionMenu selections: slotChoices asSortedArray) startUpWithCaption: 'Choose the datum you want to extract from', fromPhrase. slotChosen isEmptyOrNil ifTrue: [^ self]. "Now we want to tear off tiles of the form holder's valueAtCursor's foo" getterTiles _ nil. aCategoryViewer _ CategoryViewer new initializeFor: thePlayerThereNow categoryChoice: 'basic'. getterTiles _ aCategoryViewer getterTilesFor: (Utilities getterSelectorFor: slotChosen) type: typeChosen. aCategoryViewer _ CategoryViewer new initializeFor: self categoryChoice: 'basic'. playerGetter _ aCategoryViewer getterTilesFor: (Utilities getterSelectorFor: slotName) type: #Player. getterTiles submorphs first "the pad" acceptDroppingMorph: playerGetter event: nil. "simulate a drop" getterTiles makeAllTilesGreen. getterTiles justGrabbedFromViewer: false. getterTiles firstSubmorph changeTableLayout; hResizing: #shrinkWrap; vResizing: #spaceFill. ActiveHand attachMorph: getterTiles ! ! !Player methodsFor: 'slots-user' stamp: 'sw 9/26/2001 03:24'! tearOffFancyWatcherFor: aGetter "Create 'Player3 heading = 43' as in independent entity. It keeps up with the truth, and may be edited to change the variable." | aWatcher aTile aLine aColor aTower precision ms slotMsg info isNumeric anInterface watcherWording | info _ self slotInfoForGetter: aGetter. info ifNotNil: [isNumeric _ info type == #Number. watcherWording _ Utilities inherentSelectorForGetter: aGetter] ifNil: [anInterface _Vocabulary eToyVocabulary methodInterfaceAt: aGetter ifAbsent: [nil]. isNumeric _ anInterface notNil and: [anInterface resultType == #Number]. watcherWording _ anInterface elementWording]. aColor _ Color r: 0.387 g: 0.581 b: 1.0. isNumeric ifTrue: [aTile _ NumericReadoutTile new typeColor: aColor]. aWatcher _ UpdatingStringMorph new. isNumeric ifTrue: [(precision _ self defaultFloatPrecisionFor: aGetter) ~= 1 ifTrue: [aWatcher floatPrecision: precision]]. aWatcher growable: true; getSelector: aGetter; putSelector: (info notNil ifTrue: [ScriptingSystem setterSelectorForGetter: aGetter] ifFalse: [anInterface companionSetterSelector]). aWatcher target: self. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: (self perform: aGetter) width: 30. Preferences universalTiles ifTrue: [ ms _ MessageSend receiver: self selector: aGetter asSymbol arguments: #(). slotMsg _ ms asTilesIn: self class. ms _ MessageSend receiver: 3 selector: #= asSymbol arguments: #(5). aLine _ ms asTilesIn: self class. aLine firstSubmorph delete. aLine addMorphFront: slotMsg. aLine lastSubmorph delete. aLine lastSubmorph delete. aLine color: aColor. aLine addMorphBack: aTile. aLine cellPositioning: #leftCenter] ifFalse: [ aLine _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: aColor. aLine layoutInset: -1. aLine borderWidth: 1; borderColor: aColor darker. aLine addMorphBack: (self tileReferringToSelf borderWidth: 0; typeColor: aColor; color: aColor; bePossessive). aLine addTransparentSpacerOfSize: (4@0). aTower _ AlignmentMorph newColumn color: aColor. aTower addTransparentSpacerOfSize: (0 @ 1). aTower addMorphBack: (StringMorph contents: watcherWording, ' = ' font: ScriptingSystem fontForTiles). aLine addMorphBack: aTower. aLine addMorphBack: aTile]. aWatcher step; fitContents. self currentHand attachMorph: aLine.! ! !Player methodsFor: 'slots-user' stamp: 'sw 9/26/2001 03:24'! tearOffWatcherFor: aSlotGetter "Tear off a watcher for the slot whose getter is provided" | aWatcher precision anInterface info isNumeric | info _ self slotInfoForGetter: aSlotGetter. info ifNotNil: [isNumeric _ info type == #Number] ifNil: [anInterface _ Vocabulary eToyVocabulary methodInterfaceAt: aSlotGetter ifAbsent: [nil]. isNumeric _ anInterface notNil and: [anInterface resultType == #Number]]. aWatcher _ UpdatingStringMorph new. isNumeric ifFalse: [aWatcher useStringFormat] ifTrue: [precision _ self defaultFloatPrecisionFor: aSlotGetter. precision ~= 1 ifTrue: [aWatcher floatPrecision: precision]]. aWatcher growable: true; getSelector: aSlotGetter; putSelector: (ScriptingSystem setterSelectorForGetter: aSlotGetter); setNameTo: (info notNil ifTrue: [Utilities inherentSelectorForGetter: aSlotGetter] ifFalse: [anInterface elementWording]). aWatcher target: self. aWatcher step. aWatcher fitContents. self currentHand attachMorph: aWatcher! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 9/26/2001 04:02'! methodInterfaceForEmptyScript "Answer a MethodInterface representing Andreas's 'emptyScript' feature" | anInterface | anInterface _ MethodInterface new. anInterface receiverType: #Player. anInterface flagAttribute: #scripts. anInterface absorbTranslation: (ElementTranslation new wording: (ScriptingSystem wordingForOperator: #emptyScript) helpMessage: 'an empty script; drop on desktop to get a new empty script for this object' language: #English). anInterface selector: #emptyScript type: nil setter: nil. ^ anInterface! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 9/27/2001 03:12'! slotInfoButtonHitFor: aGetterSymbol inViewer: aViewer "The user made a gesture asking for slot menu for the given getter symbol in a viewer; put up the menu." | aMenu slotSym aType typeVocab | slotSym _ Utilities inherentSelectorForGetter: aGetterSymbol. aType _ self typeForSlotWithGetter: aGetterSymbol asSymbol. aMenu _ MenuMorph new defaultTarget: self. (#(copy getNewClone newClone) includes: slotSym) ifTrue: [aMenu add: 'give me a copy now' action: #handTheUserACopy]. (typeVocab _ Vocabulary vocabularyForType: aType) addWatcherItemsToMenu: aMenu forGetter: slotSym. (self slotInfo includesKey: slotSym) ifTrue: [aMenu add: 'change data type' selector: #chooseSlotTypeFor: argument: aGetterSymbol. typeVocab addUserSlotItemsTo: aMenu slotSymbol: slotSym. "e.g. decimal places" aMenu add: 'remove "', slotSym, '"' selector: #removeSlotNamed: argument: slotSym. aMenu add: 'rename "', slotSym, '"' selector: #renameSlot: argument: slotSym]. typeVocab addExtraItemsToMenu: aMenu forSlotSymbol: slotSym. "e.g. Player type adds hand-me-tiles" aMenu items size == 0 ifTrue: [aMenu add: 'ok' action: #yourself]. aMenu addTitle: (aGetterSymbol asString, ' (', aType, ')'). aMenu popUpForHand: aViewer primaryHand in: aViewer world! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 9/27/2001 13:30'! tilesToCall: aMethodInterface "Answer a phrase for the non-typed command represented by aMethodInterface." | resultType cmd argType argTile selfTile aPhrase balloonTextSelector aDocString universal | self class namedTileScriptSelectors. resultType _ aMethodInterface resultType. cmd _ aMethodInterface selector. (universal _ self isUniversalTiles) ifTrue: [aPhrase _ self universalTilesForInterface: aMethodInterface] ifFalse: [cmd numArgs == 0 ifTrue: [aPhrase _ PhraseTileMorph new setOperator: cmd type: resultType rcvrType: #Player] ifFalse: ["only one arg supported in classic tiles, so if this is fed with a selector with > 1 arg, results will be very strange" argType _ aMethodInterface typeForArgumentNumber: 1. aPhrase _ PhraseTileMorph new setOperator: cmd type: resultType rcvrType: #Player argType: argType. argTile _ ScriptingSystem tileForArgType: argType. argTile position: aPhrase lastSubmorph position. aPhrase lastSubmorph addMorph: argTile]]. (self slotInfo includesKey: cmd) ifTrue: [balloonTextSelector _ #userSlot]. (self belongsToUniClass and: [self class includesSelector: cmd]) ifTrue: [aDocString _ (self class userScriptForPlayer: self selector: cmd) documentationOrNil. aDocString ifNotNil: [aPhrase submorphs second setBalloonText: aDocString] ifNil: [balloonTextSelector _ #userScript]]. (universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]) balloonTextSelector: (balloonTextSelector ifNil: [cmd]). universal ifFalse: [selfTile _ self tileToRefer. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile. aPhrase makeAllTilesGreen. aPhrase justGrabbedFromViewer: false]. ^ aPhrase! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 9/27/2001 13:30'! universalTilesForInterface: aMethodInterface "Return universal tiles for the given method interface. Record who self is." | ms argTile itsSelector aType argList | itsSelector _ aMethodInterface selector. argList _ OrderedCollection new. aMethodInterface argumentVariables doWithIndex: [:anArgumentVariable :anIndex | argTile _ ScriptingSystem tileForArgType: (aType _ aMethodInterface typeForArgumentNumber: anIndex). argList add: (aType == #Player ifTrue: [argTile actualObject] ifFalse: [argTile literal]). "default value for each type"]. ms _ MessageSend receiver: self selector: itsSelector arguments: argList asArray. ^ ms asTilesIn: self class! ! !Player methodsFor: 'misc' stamp: 'sw 9/27/2001 17:26'! basicType "Answer a symbol representing the inherent type of the receiver" ^ #Player! ! !Point methodsFor: 'printing' stamp: 'sw 9/27/2001 17:26'! basicType "Answer a symbol representing the inherent type of the receiver" ^ #Point! ! !Presenter methodsFor: 'tile support' stamp: 'sw 9/27/2001 17:44'! arithmeticTiles "Answer some numeric-valued tiles. This dates back to very early etoy work in 1997, and presently has no sent senders" | list rcvr op arg | list _ #( (1 + 1) (1 - 1) (2 * 2) (6 / 2) (4 max: 3) (7 min: 2)). ^ list collect: [:entry | rcvr _ entry first. op _ (entry at: 2) asSymbol. arg _ entry last. self phraseForReceiver: rcvr op: op arg: arg resultType: #Number]! ! !Presenter methodsFor: 'tile support' stamp: 'sw 9/27/2001 17:42'! booleanTiles "Answer some boolean-valued tiles. This dates back to very early etoy work in 1997, and presently has no sent senders" | list rcvr op arg | list _ #( (0 < 1) (0 <= 1) (0 = 1) (0 ~= 1) (0 > 1) (0 >= 1)). list _ list asOrderedCollection collect: [:entry | rcvr _ entry first. op _ (entry at: 2) asSymbol. arg _ entry last. self phraseForReceiver: rcvr op: op arg: arg resultType: #Boolean]. list add: (self phraseForReceiver: Color red op: #= arg: Color red resultType: #Boolean). ^ list "copyWith: CompoundTileMorph new"! ! !Presenter methodsFor: 'tile support' stamp: 'sw 9/27/2001 17:43'! constantTile: anObject "Answer a constant tile that represents the object" (anObject isKindOf: Color) ifTrue: [^ ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)]. ^ anObject newTileMorphRepresentative typeColor: (ScriptingSystem colorForType: (self typeForConstant: anObject))! ! !Presenter methodsFor: 'tile support' stamp: 'sw 9/27/2001 17:43'! valueTiles "Answer some constant-valued tiles. This dates back to very early etoy work in 1997, and presently has no senders" | tiles | tiles _ OrderedCollection new. tiles add: (5 newTileMorphRepresentative typeColor: (ScriptingSystem colorForType: #Number)). tiles add: (ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)). tiles add: (TileMorph new typeColor: (ScriptingSystem colorForType: #Number); setExpression: '(180 atRandom)' label: 'random'). tiles add: RandomNumberTile new. ^ tiles! ! !ReferenceMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:04'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((paintbox ((command makeNewDrawingIn: 'make a new drawing in the specified playfield' Player)))) ! ! !SampledSound class methodsFor: 'sound library' stamp: 'sw 9/27/2001 14:46'! soundNamed: aString "Answer the sound of the given name, or, if there is no sound of that name, put up an informer so stating, and answer nil" "(SampledSound soundNamed: 'shutterClick') play" ^ self soundNamed: aString ifAbsent: [self inform: aString, ' not found in the Sound Library'. nil]! ! !SampledSound class methodsFor: 'sound library' stamp: 'sw 9/27/2001 14:45'! soundNamed: aString ifAbsent: aBlock "Answer the sound of the given name, or if there is no sound of that name, answer the result of evaluating aBlock" "(SampledSound soundNamed: 'shutterClick') play" | entry samples | entry _ SoundLibrary at: aString ifAbsent: [^ aBlock value]. entry ifNil: [^ aBlock value]. samples _ entry at: 1. samples class isBytes ifTrue: [samples _ self convert8bitSignedTo16Bit: samples]. ^ self samples: samples samplingRate: (entry at: 2) ! ! !ScriptActivationButton class methodsFor: 'viewer' stamp: 'sw 9/26/2001 04:26'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((button ( (slot color 'The color of the object' Color readWrite Player getColor Player setColor:) (slot height 'The height' Number readWrite Player getHeight Player setHeight:) (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 actWhen 'When the script should fire' ButtonPhase readWrite Player getActWhen Player setActWhen: ))))! ! !ScriptableButton class methodsFor: 'viewer' stamp: 'sw 9/26/2001 04:26'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((button ( (slot label 'The wording on the button' String readWrite Player getLabel Player setLabel:) (slot color 'The color of the object' Color readWrite Player getColor Player setColor:) (slot height 'The height' Number readWrite Player getHeight Player setHeight:) (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 height 'The height' Number readWrite Player getHeight Player setHeight:) (slot roundedCorners 'Whether corners should be rounded' Boolean readWrite Player getRoundedCorners Player setRoundedCorners:) (slot actWhen 'When the script should fire' ButtonPhase readWrite Player getActWhen Player setActWhen: ))))! ! !SimpleSliderMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:27'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #( (slider ( (slot numericValue 'A number representing the current position of the knob.' Number readWrite Player getNumericValue Player setNumericValue:) (slot minVal 'The number represented when the knob is at the left or top of the slider; the smallest value returned by the slider.' Number readWrite Player getMinVal Player setMinVal:) (slot maxVal 'The number represented when the knob is at the right or bottom of the slider; the largest value returned by the slider.' Number readWrite Player getMaxVal Player setMaxVal:) (slot descending 'Tells whether the smallest value is at the top/left (descending = false) or at the bottom/right (descending = true)' Boolean readWrite Player getDescending Player setDescending:) (slot truncate 'If true, only whole numbers are used as values; if false, fractional values are allowed.' Boolean readWrite Player getTruncate Player setTruncate:) (slot color 'The color of the slider' Color readWrite Player getColor Player setColor:) (slot knobColor 'The color of the slider' Color readWrite Player getKnobColor Player setKnobColor:) (slot width 'The width' Number readWrite Player getWidth Player setWidth:) (slot height 'The height' Number readWrite Player getRight Player setHeight:))) (basic ( (slot numericValue 'A number representing the current position of the knob.' Number readWrite Player getNumericValue Player setNumericValue:)))) ! ! !SketchMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:27'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((graphics ( (slot graphic 'The picture currently being worn' Graphic readWrite Player getGraphic Player setGraphic:)))) ! ! !JoystickMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:20'! additionsToViewerCategories "Answer a list of ( ) 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)))) ! ! !SlotInformation methodsFor: 'access' stamp: 'sw 9/27/2001 17:44'! type "Answer the type of the receiver, initializing it to Number if it is nil" ^ type ifNil: [type _ #Number]! ! !SlotInformation methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:44'! initialize "Initialize the receiver's instance variables to default values" documentation _ 'as yet undocumented'. type _ #Number. floatPrecision _ 0.1.! ! !SpeakerMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:27'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((speaker ((slot conePosition 'the position of the speaker cone' Number readWrite Player getConePosition Player setConePosition:)))) ! ! !StandardScriptingSystem methodsFor: 'utilities' stamp: 'sw 9/26/2001 03:27'! holderWithAlphabet "Answer a fully instantiated Holder that has submorphs that represent the letters of the uppercase alphabet, with each one having an 'index' slot which bears the letter's index in the alphabet -- 1 for A, 2 for B, etc. A few special characters are provided as per ack request 10/00; for these the index provided is rather arbitrarily assigned" | aMorph aPlayer newMorph oneCharString aContainer aWrapper | "ScriptingSystem holderWithAlphabet openInHand" aContainer _ self prototypicalHolder useRoundedCorners. aContainer borderColor: Color blue lighter. aWrapper _ AlignmentMorph new hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 0. aWrapper addMorphBack: (aMorph _ TextMorph new contents: 'A'). aMorph beAllFont: ((TextStyle named: #ComicBold) fontOfSize: 24). aMorph width: 14; lock. aWrapper beTransparent; setNameTo: 'A'. aPlayer _ aWrapper assuredPlayer. aPlayer addInstanceVariableNamed: #index type: #Number value: 1. aContainer addMorphBack: aWrapper. 2 to: 26 do: [:anIndex | newMorph _ aWrapper usableSiblingInstance. newMorph player perform: #setIndex: with: anIndex. newMorph firstSubmorph contents: (oneCharString _ ($A asciiValue + anIndex - 1) asCharacter asString). newMorph setNameTo: oneCharString. aContainer addMorphBack: newMorph]. #(' ' '.' '#') with: #(27 28 29) do: [:aString :anIndex | newMorph _ aWrapper usableSiblingInstance. newMorph player perform: #setIndex: with: anIndex. newMorph firstSubmorph contents: aString. aString = ' ' ifTrue: [newMorph setNameTo: 'space'. newMorph color: (Color gray alpha: 0.2)] ifFalse: [newMorph setNameTo: aString]. aContainer addMorphBack: newMorph]. aContainer setNameTo: 'alphabet'. aContainer isPartsBin: true. aContainer enableDrop: false. aContainer indicateCursor: false; width: 162. aContainer color: (Color r: 0.839 g: 1.0 b: 1.0). "Color fromUser" ^ aContainer! ! !StandardScriptingSystem methodsFor: 'utilities' stamp: 'sw 9/27/2001 13:28'! tileForArgType: aType "Anwer a default tile to represent a datum of the given argument type, which may be either a symbol (e.g. #Color) or a class" (aType isKindOf: Class) "Allowed in Ted's work" ifTrue: [^ aType name asString newTileMorphRepresentative typeColor: Color gray]. ^ (Vocabulary vocabularyForType: aType) defaultArgumentTile! ! !StandardScriptingSystem methodsFor: 'universal slots & scripts' stamp: 'sw 9/27/2001 04:08'! systemSlotNamesOfType: aType "Answer the type of the slot name, or nil if not found." | aList | self flag: #deferred. "Hard-coded etoyVocabulary needed here to make this work." aList _ OrderedCollection new. Vocabulary eToyVocabulary methodInterfacesDo: [:anInterface | anInterface resultType = aType ifTrue: [aList add: anInterface selector]]. ^ aList! ! !StandardScriptingSystem methodsFor: 'tile colors' stamp: 'sw 9/27/2001 13:32'! colorForType: typeSymbol "Answer the color to use to represent the given type symbol" typeSymbol capitalized = #Command ifTrue: [^ Color fromRgbTriplet: #(0.065 0.258 1.0)]. "Command is historical and idiosyncratic and should be regularized" ^ (Vocabulary vocabularyForType: typeSymbol) typeColor! ! !String methodsFor: 'printing' stamp: 'sw 9/27/2001 17:26'! basicType "Answer a symbol representing the inherent type of the receiver" "Number String Boolean player collection sound color etc" ^ #String! ! !SyntaxMorph methodsFor: 'type checking' stamp: 'sw 9/26/2001 04:06'! resultType "Look up my result type. If I am a constant, use that class. If I am a message, look up the selector." | list value soundChoices | parseNode class == BlockNode ifTrue: [^ #blockContext]. parseNode class == AssignmentNode ifTrue: [^ #command]. parseNode class == ReturnNode ifTrue: [^ #command]. "Need more restriction than this" list _ submorphs select: [:ss | ss isSyntaxMorph and: [ss parseNode ~~ nil]]. list size > 1 ifTrue: [^ self resultTypeFor: self selector]. list size = 1 ifTrue: ["test for levels that are just for spacing in layout" (list first isSyntaxMorph and: [list first nodeClassIs: MessageNode]) ifTrue: [ ^ list first resultType]]. "go down one level" value _ self try. value class == Error ifTrue: [^ #unknown]. (value isKindOf: Number) ifTrue: [^ #Number]. (value isKindOf: Boolean) ifTrue: [^ #Boolean]. (value isKindOf: Form) ifTrue: [^ #Graphic]. value class == String ifTrue: [ soundChoices _ #('silence'). "default, if no SampledSound class" Smalltalk at: #SampledSound ifPresent: [:sampledSound | soundChoices _ sampledSound soundNames]. (soundChoices includes: value) ifTrue: [^ #Sound]]. (value isKindOf: Player) ifTrue: [^ #Player]. ^ value class name asLowercase "asSymbol (not needed)"! ! !SystemQueryPhrase methodsFor: 'initialization' stamp: 'sw 9/26/2001 03:04'! initialize "Initialize the receiver. In this case we primarily seek to undo the damage done by inherited implementors of #initialize" super initialize. self removeAllMorphs. resultType _ #Boolean. self vResizing: #shrinkWrap! ! !TextMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:28'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #( (text ( (slot characters 'The characters in my contents' String readWrite Player getCharacters Player setCharacters:) (slot firstCharacter 'The first character in my contents' String readWrite Player getFirstCharacter Player setFirstCharacter:) (slot allButFirst 'All my characters except the first one' String readWrite Player getAllButFirstCharacter Player setAllButFirstCharacter:) (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:)))) ! ! !TileMorph methodsFor: 'misc' stamp: 'sw 9/27/2001 17:46'! typeColor: aColor "Set the receiver's typeColor" borderColor _ aColor. typeColor _ aColor. color _ ScriptingSystem uniformTileInteriorColor ! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 9/27/2001 04:16'! setOperator: aString "Set the operator symbol from the string provided" self setOperator: aString andUseWording: (self currentVocabulary tileWordingForSelector: aString)! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 9/27/2001 04:09'! setOperator: aString andUseWording: wording "Set the operator symbol from the string provided" type _ #operator. operatorOrExpression _ aString asSymbol. self line1: wording. (ScriptingSystem doesOperatorWantArrows: operatorOrExpression) ifTrue: [self addArrows]. self updateLiteralLabel "operatorOrExpression == #heading ifTrue: [self halt]."! ! !TileMorph methodsFor: 'initialization' stamp: 'sw 9/26/2001 04:09'! setToReferTo: anObject "Set the receiver to bear an object reference to the given object." type _ #objRef. actualObject _ anObject. self line1: anObject nameForViewer. self typeColor: (ScriptingSystem colorForType: #Player). self enforceTileColorPolicy ! ! !TileMorph methodsFor: 'accessing' stamp: 'sw 9/27/2001 03:20'! resultType "Answer the result type of the receiver" type == #literal ifTrue: [(literal isKindOf: Number) ifTrue: [^ #Number]. (literal isKindOf: String) ifTrue: [^ #String]. (literal isKindOf: Boolean) ifTrue: [^ #Boolean]]. type == #expression ifTrue: [^ #Number]. type == #objRef ifTrue: [^ #Player]. ^ #unknown ! ! !TileMorph methodsFor: 'arrows' stamp: 'sw 9/26/2001 03:28'! arrowAction: delta "Do what is appropriate when an arrow on the tile is pressed; delta will be +1 or -1" | index aList | owner ifNil: [^ self]. (type == #literal and: [literal isNumber]) ifTrue: [self literal: literal + delta. ^ self layoutChanged.]. (type == #literal and: [literal isKindOf: Boolean]) ifTrue: [self literal: literal not. ^ self layoutChanged]. operatorOrExpression ifNotNil: [aList _ #(+ - * / // \\ min: max:). index _ aList indexOf: operatorOrExpression. index > 0 ifTrue: [self setOperatorAndUseArrows: (aList atWrap: index + delta)]. aList _ #(< <= = ~= > >= isDivisibleBy:). index _ aList indexOf: operatorOrExpression. index > 0 ifTrue: [owner firstSubmorph type = #Number ifTrue: [self setOperator: (aList atWrap: index + delta)] ifFalse: [self setOperator: (#(= ~=) atWrap: index - 2 + delta)]]. "Color does not understand <" submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: operatorOrExpression). ^ self acceptNewLiteral] ! ! !TileMorph methodsFor: 'arrows' stamp: 'sw 9/26/2001 03:28'! showSuffixChoices "The suffix arrow has been hit, so respond appropriately" | plusPhrase phrase pad outer num | (phrase _ self ownerThatIsA: PhraseTileMorph) ifNil: [^ self]. (type == #literal) & (literal isNumber) ifTrue: ["Tile is a constant number" phrase lastSubmorph == owner "pad" ifTrue: ["we are adding the first time (at end of our phrase)" plusPhrase _ self presenter phraseForReceiver: literal op: #+ arg: 1 resultType: #Number. plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+). owner acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent. num _ plusPhrase firstSubmorph firstSubmorph. num deleteSuffixArrow]]. type == #operator ifTrue: ["Tile is accessor of an expression" phrase resultType == #Number ifTrue: [outer _ phrase ownerThatIsA: PhraseTileMorph. pad _ self ownerThatIsA: TilePadMorph. outer ifNotNil: [outer lastSubmorph == pad ifTrue: [ "first time" plusPhrase _ self presenter phraseForReceiver: 1 op: #+ arg: 1 resultType: #Number. plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+). pad acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent. plusPhrase firstSubmorph removeAllMorphs; addMorph: phrase. "car's heading" self deleteSuffixArrow. pad topEditor install "recompile"]]]]. (phrase topEditor ifNil: [phrase]) enforceTileColorPolicy! ! !AssignmentTileMorph methodsFor: 'arrow' stamp: 'sw 9/27/2001 16:40'! addArrowsIfAppropriate "If the receiver's slot is of an appropriate type, add arrows to the tile." (Vocabulary vocabularyForType: dataType) ifNotNilDo: [:aVocab | aVocab wantsAssignmentTileVariants ifTrue: [self addArrows]]! ! !BooleanTile methodsFor: 'type' stamp: 'sw 9/27/2001 17:19'! resultType "Answer the result type of the receiver" ^ #Boolean! ! !ColorTileMorph methodsFor: 'other' stamp: 'sw 9/27/2001 17:27'! resultType "Answer the result type of the receiver" ^ #Color! ! !GraphicTile methodsFor: 'queries' stamp: 'sw 9/26/2001 04:05'! resultType "Answer the result type of the argument represented by the receiver" ^ #Graphic! ! !MenuTile methodsFor: 'type' stamp: 'sw 9/27/2001 17:28'! resultType "Answer the result type of the receiver" ^ #Menu! ! !RandomNumberTile methodsFor: 'initialization' stamp: 'sw 9/26/2001 03:24'! initialize "Initialize the receiver fully, including adding all its relevant submorphs" | m1 m2 | super initialize. self vResizing: #shrinkWrap. self typeColor: (ScriptingSystem colorForType: #Number). self addArrows. m1 _ StringMorph contents: 'random' font: ScriptingSystem fontForTiles. self addMorph: m1. m2 _ UpdatingStringMorph contents: '180' font: ScriptingSystem fontForTiles. m2 target: self; getSelector: #literal; putSelector: #literal:. m2 position: m1 topRight. self addMorphBack: m2. literal _ 180. self updateLiteralLabel. self makeAllTilesGreen! ! !SoundReadoutTile methodsFor: 'literal' stamp: 'sw 9/27/2001 17:45'! setLiteralTo: anObject width: w "Set the literal and width of the tile as indicated" | soundChoices index | soundChoices _ #('silence'). "default, if no SampledSound class" Smalltalk at: #SampledSound ifPresent: [:sampledSound | soundChoices _ sampledSound soundNames]. index _ soundChoices indexOf: anObject. self setLiteral: (soundChoices atWrap: index)! ! !SoundReadoutTile methodsFor: 'arrows' stamp: 'sw 9/27/2001 14:48'! arrowAction: delta "Do what is appropriate when an arrow on the tile is pressed; delta will be +1 or -1" | soundChoices index | soundChoices _ #('silence'). "default, if no SampledSound class" Smalltalk at: #SampledSound ifPresent: [:sampledSound | soundChoices _ sampledSound soundNames]. index _ soundChoices indexOf: literal. self literal: (soundChoices atWrap: (index + delta)). self playSoundNamed: literal ! ! !SoundTile methodsFor: 'type' stamp: 'sw 9/27/2001 17:28'! resultType "Answer the result type of the receiver" ^ #Sound! ! !SymbolListTile methodsFor: 'user interface' stamp: 'sw 9/27/2001 15:42'! literal: anObject "Set the receiver's literal as indicated" literal _ anObject. self updateLiteralLabel. self flag: #deferred. "The below formerly was necessary but now is problematical, leading to low-space condition etc. May need to revisit, since as I comment this out now I am uncertain what if anything this may break" "self labelMorph informTarget"! ! !TilePadMorph methodsFor: 'mouse' stamp: 'sw 9/26/2001 04:09'! canAccept: aMorph "Answer whether this pad can accept the given morph" ((aMorph isKindOf: PhraseTileMorph) or: [aMorph isKindOf: TileMorph]) ifTrue: [^ (aMorph resultType == type) or: [(aMorph resultType == #unknown) and: [type == #Player]]]. ^ false ! ! !Viewer methodsFor: 'special phrases' stamp: 'sw 9/27/2001 17:46'! colorSeesPhrase "In classic tiles, answer a complete phrase that represents the colorSees test" | outerPhrase | outerPhrase _ PhraseTileMorph new setOperator: #+ "temp dummy" type: #Boolean rcvrType: #Player argType: #Color. "Install (ColorSeerTile new) in middle position" (outerPhrase submorphs at: 2) delete. "operator" outerPhrase addMorphBack: ColorSeerTile new. (outerPhrase submorphs at: 2) goBehind. "Make it third" outerPhrase submorphs last addMorph: (ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)). ^ outerPhrase! ! !Viewer methodsFor: 'special phrases' stamp: 'sw 9/27/2001 17:46'! seesColorPhrase "In classic tiles, answer a complete phrase that represents the seesColor test" | outerPhrase seesColorTile | outerPhrase _ PhraseTileMorph new setOperator: #+ "temp dummy" type: #Boolean rcvrType: #Player argType: #Color. "Install (ColorSeerTile new) in middle position" (outerPhrase submorphs at: 2) delete. "operator" seesColorTile _ TileMorph new setOperator: #seesColor:. outerPhrase addMorphBack: seesColorTile. (outerPhrase submorphs at: 2) goBehind. "Make it third" " selfTile _ self tileForSelf bePossessive. Done by caller. selfTile position: 1. outerPhrase firstSubmorph addMorph: selfTile. " outerPhrase submorphs last addMorph: (ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)). ^ outerPhrase! ! !Viewer methodsFor: 'special phrases' stamp: 'sw 9/26/2001 04:09'! touchesAPhrase "Answer a conjured-up touchesA phrase in classic tile" | outerPhrase | outerPhrase _ PhraseTileMorph new setOperator: #+ "temp dummy" type: #Boolean rcvrType: #Player argType: #Player. (outerPhrase submorphs at: 2) delete. "operator" outerPhrase addMorphBack: (TileMorph new setOperator: #touchesA:). (outerPhrase submorphs at: 2) goBehind. "Make it third" outerPhrase submorphs last addMorph: scriptedPlayer tileToRefer. ^ outerPhrase! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 9/27/2001 13:29'! phraseForCommandFrom: aMethodInterface "Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles" | aRow resultType cmd names argType argTile selfTile aPhrase balloonTextSelector stat inst aDocString universal tileBearingHelp | aDocString _ aMethodInterface documentationOrNil. names _ scriptedPlayer class namedTileScriptSelectors. resultType _ aMethodInterface resultType. cmd _ aMethodInterface selector. (universal _ scriptedPlayer isUniversalTiles) ifTrue: [aPhrase _ scriptedPlayer universalTilesForInterface: aMethodInterface] ifFalse: [cmd numArgs == 0 ifTrue: [aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary.. aPhrase setOperator: cmd type: resultType rcvrType: #Player] ifFalse: ["only one arg supported in classic tiles, so if this is fed with a selector with > 1 arg, results will be very strange" argType _ aMethodInterface typeForArgumentNumber: 1. aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player argType: argType. argTile _ ScriptingSystem tileForArgType: argType. argTile position: aPhrase lastSubmorph position. aPhrase lastSubmorph addMorph: argTile]]. (scriptedPlayer slotInfo includesKey: cmd) ifTrue: [balloonTextSelector _ #userSlot]. (scriptedPlayer belongsToUniClass and: [scriptedPlayer class includesSelector: cmd]) ifTrue: [aDocString ifNil: [aDocString _ (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentationOrNil]. aDocString ifNil: [balloonTextSelector _ #userScript]]. tileBearingHelp _ universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]. aDocString ifNotNil: [tileBearingHelp setBalloonText: aDocString] ifNil: [balloonTextSelector ifNil: [tileBearingHelp setProperty: #inherentSelector toValue: cmd. balloonTextSelector _ #methodComment]. tileBearingHelp balloonTextSelector: balloonTextSelector]. aPhrase markAsPartsDonor. cmd == #emptyScript ifTrue: [aPhrase setProperty: #newPermanentScript toValue: true. aPhrase setProperty: #newPermanentPlayer toValue: scriptedPlayer. aPhrase submorphs second setBalloonText: 'drag and drop to add a new script']. universal ifFalse: [selfTile _ self tileForSelf. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile]. aRow _ ViewerRow newRow borderWidth: 0; color: self color. aRow elementSymbol: cmd asSymbol. aRow addMorphBack: (ScriptingSystem tryButtonFor: aPhrase). aRow addMorphBack: (Morph new extent: 4@2; beTransparent). aRow addMorphBack: (self infoButtonFor: cmd). aRow addMorphBack: aPhrase. (names includes: cmd) ifTrue: [aPhrase userScriptSelector: cmd. aPhrase beTransparent. aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer. aRow addMorphBack: (stat _ (inst _ scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph). inst updateStatusMorph: stat]. aRow beSticky; disableDragNDrop. ^ aRow! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 9/25/2001 21:13'! readoutFor: partName type: partType readOnly: readOnly getSelector: getSelector putSelector: putSelector "Answer a readout morph for the given part" | readout | readout _ (Vocabulary vocabularyForType: partType) updatingTileForTarget: scriptedPlayer partName: partName getter: getSelector setter: putSelector. readout step. ^ readout! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 9/27/2001 04:23'! getterButtonFor: getterSelector type: partType "Answer a classic-tiles getter button for a part of the given name" | m inherent wording | m _ TileMorph new adoptVocabulary: self currentVocabulary. inherent _ Utilities inherentSelectorForGetter: getterSelector. wording _ (scriptedPlayer slotInfo includesKey: inherent) ifTrue: [inherent] ifFalse: [self currentVocabulary tileWordingForSelector: getterSelector]. m setOperator: getterSelector andUseWording: wording. m typeColor: (ScriptingSystem colorForType: partType). m on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: getterSelector with: partType). ^ m! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 9/26/2001 03:18'! getterTilesFor: getterSelector type: aType "Answer classic getter for the given name/type" | selfTile selector aPhrase | "aPhrase _ nil, assumed" (#(color:sees: colorSees) includes: getterSelector) ifTrue: [aPhrase _ self colorSeesPhrase]. (#(seesColor: isOverColor) includes: getterSelector) ifTrue: [aPhrase _ self seesColorPhrase]. (#(touchesA: touchesA) includes: getterSelector) ifTrue: [aPhrase _ self touchesAPhrase]. aPhrase ifNil: [aPhrase _ PhraseTileMorph new setSlotRefOperator: getterSelector asSymbol type: aType]. selfTile _ self tileForSelf bePossessive. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile. selector _ aPhrase submorphs at: 2. (Vocabulary vocabularyNamed: aType capitalized) ifNotNilDo: [:aVocab | aVocab wantsSuffixArrow ifTrue: [selector addSuffixArrow]]. selector updateLiteralLabel. aPhrase enforceTileColorPolicy. ^ aPhrase! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 9/27/2001 13:28'! makeSetter: selectorAndTypePair event: evt from: aMorph "Classic tiles: make a Phrase that comprises a setter of a slot, and hand it to the user." | argType m argTile selfTile argValue | argType _ selectorAndTypePair second. m _ PhraseTileMorph new setAssignmentRoot: (Utilities inherentSelectorForGetter: selectorAndTypePair first asSymbol) type: #command rcvrType: #Player argType: argType vocabulary: self currentVocabulary. argValue _ self scriptedPlayer perform: selectorAndTypePair first asSymbol. (argValue isKindOf: Player) ifTrue: [argTile _ argValue tileReferringToSelf] ifFalse: [argTile _ ScriptingSystem tileForArgType: argType. argTile setLiteral: argValue; updateLiteralLabel.]. argTile position: m lastSubmorph position. m lastSubmorph addMorph: argTile. selfTile _ self tileForSelf bePossessive. selfTile position: m firstSubmorph position. m firstSubmorph addMorph: selfTile. m enforceTileColorPolicy. m openInHand! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'sw 9/27/2001 13:29'! newGetterTilesFor: aPlayer methodInterface: aMethodInterface "Return universal tiles for a getter on this property. Record who self is." | ms argTile argArray | ms _ MessageSend receiver: aPlayer selector: aMethodInterface selector arguments: #(). "Handle three idiosyncratic cases..." aMethodInterface selector == #color:sees: ifTrue: [argTile _ ScriptingSystem tileForArgType: #Color. argArray _ Array with: argTile colorSwatch color with: argTile colorSwatch color copy. ms arguments: argArray]. aMethodInterface selector == #seesColor: ifTrue: [argTile _ ScriptingSystem tileForArgType: #Color. ms arguments: (Array with: argTile colorSwatch color)]. aMethodInterface selector == #touchesA: ifTrue: [argTile _ ScriptingSystem tileForArgType: #Player. ms arguments: (Array with: argTile actualObject)]. ^ ms asTilesIn: aPlayer class! ! !CategoryViewer methodsFor: 'support' stamp: 'sw 9/27/2001 13:28'! booleanPhraseForRetrieverOfType: retrieverType retrieverOp: retrieverOp player: aPlayer "Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result" | outerPhrase getterPhrase receiverTile rel finalTile | rel _ (Vocabulary vocabularyForType: retrieverType) comparatorForSampleBoolean. outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType. getterPhrase _ PhraseTileMorph new setOperator: retrieverOp type: retrieverType rcvrType: #Player. getterPhrase submorphs last setSlotRefOperator: retrieverOp. getterPhrase submorphs first changeTableLayout. receiverTile _ aPlayer tileToRefer bePossessive. receiverTile position: getterPhrase firstSubmorph position. getterPhrase firstSubmorph addMorph: receiverTile. outerPhrase firstSubmorph addMorph: getterPhrase. finalTile _ ScriptingSystem tileForArgType: retrieverType. "comes with arrows" outerPhrase submorphs last addMorph: finalTile. outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel). ^ outerPhrase! ! !CategoryViewer methodsFor: 'support' stamp: 'sw 9/27/2001 16:39'! booleanPhraseFromPhrase: phrase "Answer, if possible, a boolean-valued phrase derived from the phrase provided" | retrieverOp retrieverTile | phrase isBoolean ifTrue: [^ phrase]. ((scriptedPlayer respondsTo: #costume) and:[scriptedPlayer costume isInWorld not]) ifTrue: [^ Array new]. ((retrieverTile _ phrase submorphs last) isKindOf: TileMorph) ifFalse: [^ phrase]. retrieverOp _ retrieverTile operatorOrExpression. (Vocabulary vocabularyForType: phrase resultType) affordsCoercionToBoolean ifTrue: [^ self booleanPhraseForRetrieverOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject]. ^ phrase! ! !Vocabulary methodsFor: 'queries' stamp: 'sw 9/27/2001 17:47'! asSymbol "Answer a symbol representing the receiver" ^ self vocabularyName! ! !Vocabulary methodsFor: 'queries' stamp: 'sw 9/27/2001 03:24'! representsAType "Answer whether this vocabulary represents an end-user-sensible data type" ^ false! ! !Vocabulary methodsFor: 'queries' stamp: 'sw 9/27/2001 04:37'! tileWordingForSelector: aSelector "Answer the wording to emblazon on tiles representing aSelector" | anInterface inherent | anInterface _ self methodInterfaceAt: aSelector asSymbol ifAbsent: [inherent _ Utilities inherentSelectorForGetter: aSelector. ^ inherent ifNil: [self translatedWordingFor: aSelector] ifNotNil: [inherent]]. ^ anInterface elementWording! ! !Vocabulary methodsFor: 'queries' stamp: 'sw 9/26/2001 12:01'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFrom: Color green! ! !Vocabulary methodsFor: 'color' stamp: 'sw 9/27/2001 17:47'! subduedColorFrom: aColor "Answer a subdued color derived from the given color" ^ aColor mixed: ScriptingSystem colorFudge with: ScriptingSystem uniformTileInteriorColor! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:36'! addExtraItemsToMenu: aMenu forSlotSymbol: slotSym "If the receiver has extra menu items to add to the slot menu, here is its chance to do it"! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:38'! addUserSlotItemsTo: aMenu slotSymbol: slotSym "Optionally add items to the menu that pertain to a user-defined slot of the given symbol" ! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:35'! addWatcherItemsToMenu: aMenu forGetter: aGetter "Add watcher items to the menu if appropriate, provided the getter is not an odd-ball one for which a watcher makes no sense" (#(colorSees copy newClone getNewClone) includes: aGetter) ifFalse: [aMenu add: 'simple watcher' selector: #tearOffWatcherFor: argument: aGetter]! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 02:29'! affordsCoercionToBoolean "Answer true if a tile of this data type, when dropped into a pane that demands a boolean, could plausibly be expanded into a comparison (of the form frog < toad or frog = toad) to provide a boolean expression" ^ true! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 02:53'! comparatorForSampleBoolean "Answer the comparator to use in tile coercions involving the receiver; normally, the equality comparator is used but NumberType overrides" ^ #=! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 13:15'! defaultArgumentTile "Answer a tile to represent the type" ^ 'arg' newTileMorphRepresentative typeColor: self typeColor! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:37'! newReadoutTile "Answer a tile that can serve as a readout for data of this type" ^ StringReadoutTile new typeColor: Color lightGray lighter! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/25/2001 21:18'! updatingTileForTarget: aTarget partName: partName getter: getter setter: setter "Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter" | aTile displayer actualSetter | actualSetter _ setter ifNotNil: [(#(none nil unused) includes: setter) ifTrue: [nil] ifFalse: [setter]]. aTile _ self newReadoutTile. displayer _ UpdatingStringMorph new getSelector: getter; target: aTarget; growable: true; minimumWidth: 24; putSelector: actualSetter. "Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details" self setFormatForDisplayer: displayer. aTile addMorphBack: displayer. (actualSetter notNil and: [self wantsArrowsOnTiles]) ifTrue: [aTile addArrows]. getter numArgs == 0 ifTrue: [aTile setLiteralInitially: (aTarget perform: getter)]. ^ aTile ! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:33'! wantsArrowsOnTiles "Answer whether this data type wants up/down arrows on tiles representing its values" ^ true! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/26/2001 03:11'! wantsAssignmentTileVariants "Answer whether an assignment tile for a variable of this type should show variants to increase-by, decrease-by, multiply-by. NumberType says yes, the rest of us say no" ^ false! ! !DataType methodsFor: 'tiles' stamp: 'sw 9/26/2001 03:18'! wantsSuffixArrow "Answer whether a tile showing data of this type would like to have a suffix arrow" ^ false! ! !DataType methodsFor: 'initial value' stamp: 'sw 9/26/2001 12:00'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ 'no value'! ! !DataType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:32'! setFormatForDisplayer: aDisplayer "Set up the displayer to have the right format characteristics" aDisplayer useDefaultFormat. aDisplayer growable: true ! ! !DataType methodsFor: 'color' stamp: 'sw 9/27/2001 17:32'! subduedColorFromTriplet: anRGBTriplet "Answer a subdued color derived from the rgb-triplet to use as a tile color. Don't pay too much attention to this whole branch, for it relates to an aspect whose use is basically in abeyance" ^ (Color fromRgbTriplet: anRGBTriplet) mixed: ScriptingSystem colorFudge with: ScriptingSystem uniformTileInteriorColor! ! !DataType methodsFor: 'queries' stamp: 'sw 9/27/2001 03:25'! representsAType "Answer whether this vocabulary represents an end-user-sensible data type" ^ (self class == DataType) not "i.e. subclasses yes, myself no"! ! !BooleanType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:20'! defaultArgumentTile "Answer a tile to represent the type" ^ true newTileMorphRepresentative typeColor: self typeColor! ! !BooleanType methodsFor: 'initial value' stamp: 'sw 9/27/2001 17:20'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ true! ! !BooleanType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:23'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. self vocabularyName: #Boolean! ! !BooleanType methodsFor: 'color' stamp: 'sw 9/27/2001 17:20'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(0.94 1.0 0.06)! ! !ColorType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:30'! defaultArgumentTile "Answer a tile to represent the type" ^ Color blue newTileMorphRepresentative! ! !ColorType methodsFor: 'tiles' stamp: 'sw 9/25/2001 21:08'! updatingTileForTarget: aTarget partName: partName getter: getter setter: setter "Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter" | readout | readout _ UpdatingRectangleMorph new. readout getSelector: getter; target: aTarget; borderWidth: 1; extent: 22@22. (setter isNil or: [#(unused none nil) includes: setter]) ifFalse: [readout putSelector: setter]. ^ readout ! ! !ColorType methodsFor: 'initial value' stamp: 'sw 9/27/2001 17:28'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ Color random! ! !ColorType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:23'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. self vocabularyName: #Color.! ! !ColorType methodsFor: 'color' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(1.0 0 0.065) ! ! !EToyVectorVocabulary methodsFor: 'initialization' stamp: 'sw 9/26/2001 03:56'! eToyVectorTable "Answer a table of specifications to send to #addFromTable: which add the 'players are vectors' extension to the etoy vocabulary." "(selector setterOrNil ((arg name arg type)...) resultType (category ...) 'help msg' 'wording' autoUpdate)" ^ #( (+ nil ((aVector Player)) Player (geometry) 'Adds two players together, treating each as a vector from the origin.') (- nil ((aVector Player)) Player (geometry) 'Subtracts one player from another, treating each as a vector from the origin.') (* nil ((aVector Number)) Player (geometry) 'Multiply a player by a number, treating the Player as a vector from the origin.') (/ nil ((aVector Number)) Player (geometry) 'Divide a player by a Number, treating the Player as a vector from the origin.') (incr: nil ((aVector Player)) unknown (geometry) 'Each Player is a vector from the origin. Increase one by the amount of the other.' 'increase by') (decr: nil ((aVector Player)) unknown (geometry) 'Each Player is a vector from the origin. Decrease one by the amount of the other.' 'decrease by') (multBy: nil ((factor Number)) unknown (geometry) 'A Player is a vector from the origin. Multiply its length by the factor.' 'multiplied by') (dividedBy: nil ((factor Number)) unknown (geometry) 'A Player is a vector from the origin. Divide its length by the factor.' 'divided by') "distance and theta are already in Player. See additionsToViewerCategoryGeometry" ).! ! !EToyVectorVocabulary methodsFor: 'initialization' stamp: 'sw 9/25/2001 21:20'! initialize "Initialize the vocabulary" super initialize. self addFromTable: self eToyVectorTable language: #English. self vocabularyName: #Vector. self documentation: 'This vocabulary adds to the basic etoy experience an interpretation of "players are vectors", requested by Alan Kay and implemented by Ted Kaehler in summer 2001'. ! ! !FullVocabulary methodsFor: 'initialization' stamp: 'sw 9/25/2001 21:52'! initialize "Initialize the receiver (automatically called when instances are created via 'new') Vocabulary initialize " super initialize. vocabularyName _ #Object. self documentation: '"Object" is all-encompassing vocabulary that embraces all methods understood by an object'. self rigAFewCategories! ! !FullVocabulary methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(1.0 0.26 0.98) ! ! !FullVocabulary methodsFor: 'queries' stamp: 'sw 9/27/2001 03:28'! representsAType "Answer whether this vocabulary represents an end-user-sensible data type" ^ false! ! !GraphicType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:30'! defaultArgumentTile "Answer a tile to represent the type" ^ GraphicTile new typeColor: self typeColor! ! !GraphicType methodsFor: 'tiles' stamp: 'sw 9/25/2001 21:06'! updatingTileForTarget: aTarget partName: partName getter: getter setter: setter "Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter" ^ ThumbnailMorph new objectToView: aTarget viewSelector: getter; extent: 21@21; yourself! ! !GraphicType methodsFor: 'initial value' stamp: 'sw 9/27/2001 17:29'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ ScriptingSystem formAtKey: #PaintTab! ! !GraphicType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:24'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. self vocabularyName: #Graphic.! ! !GraphicType methodsFor: 'color' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(0.806 1.0 0.806) ! ! !MenuType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:30'! defaultArgumentTile "Answer a tile to represent the type" ^ MenuTile new typeColor: self typeColor! ! !MenuType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:24'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. self vocabularyName: #Menu! ! !MenuType methodsFor: 'color' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(0.4 0.4 0.4) ! ! !NumberType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:38'! addUserSlotItemsTo: aMenu slotSymbol: slotSym "Optionally add items to the menu that pertain to a user-defined slot of the given symbol" aMenu add: 'decimal places...' selector: #setPrecisionFor: argument: slotSym! ! !NumberType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:36'! addWatcherItemsToMenu: aMenu forGetter: aGetter "Add watcher items to the menu if appropriate, provided the getter is not an odd-ball one for which a watcher makes no sense" super addWatcherItemsToMenu: aMenu forGetter: aGetter. aMenu add: 'detailed watcher' selector: #tearOffFancyWatcherFor: argument: aGetter! ! !NumberType methodsFor: 'tiles' stamp: 'sw 9/27/2001 02:53'! comparatorForSampleBoolean "Answer the comparator to use in tile coercions involving the receiver; normally, the equality comparator is used but NumberType overrides" ^ # <= >= ~= ~~)) (arithmetic 'Basic numeric operation' (* + - / // \\ abs negated quo: rem:)) (testing 'Testing a number' (even isDivisibleBy: negative odd positive sign)) (#'mathematical functions' 'Trigonometric and exponential functions' (cos exp ln log log: raisedTo: sin sqrt squared tan raisedToInteger:)) (converting 'Converting a number to another form' (@ asInteger asPoint degreesToRadians radiansToDegrees asSmallAngleDegrees asSmallPositiveDegrees)) (#'truncation and round off' 'Making a real number (with a decimal point) into an integer' (ceiling floor roundTo: roundUpTo: rounded truncateTo: truncated)) ) do: [:item | aMethodCategory _ ElementCategory new categoryName: item first. aMethodCategory documentation: item second. item third do: [:aSelector | aMethodInterface _ MethodInterface new conjuredUpFor: aSelector class: (Number whichClassIncludesSelector: aSelector). self atKey: aSelector putMethodInterface: aMethodInterface. aMethodCategory elementAt: aSelector put: aMethodInterface]. self addCategory: aMethodCategory]. " (('truncation and round off' ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated) ('testing' basicType even isDivisibleBy: isInf isInfinite isNaN isNumber isZero negative odd positive sign strictlyPositive) ('converting' @ adaptToCollection:andSend: adaptToFloat:andSend: adaptToFraction:andSend: adaptToInteger:andSend: adaptToPoint:andSend: adaptToString:andSend: asInteger asNumber asPoint asSmallAngleDegrees asSmallPositiveDegrees degreesToRadians radiansToDegrees) ('intervals' to: to:by: to:by:do: to:do:) ('printing' defaultLabelForInspector isOrAreStringWith: newTileMorphRepresentative printOn: printStringBase: storeOn: storeOn:base: storeStringBase: stringForReadout) ('comparing' closeTo:) ('filter streaming' byteEncode:) ('as yet unclassified' reduce)" ! ! !NumberType methodsFor: 'color' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(0.8 0.4 0.2)! ! !PlayerType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:36'! addExtraItemsToMenu: aMenu forSlotSymbol: slotSym "If the receiver has extra menu items to add to the slot menu, here is its chance to do it" aMenu add: 'tiles to get...' selector: #offerGetterTiles: argument: slotSym! ! !PlayerType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:30'! defaultArgumentTile "Answer a tile to represent the type" ^ ActiveWorld presenter standardPlayer tileToRefer! ! !PlayerType methodsFor: 'tiles' stamp: 'sw 9/25/2001 21:04'! updatingTileForTarget: aTarget partName: partName getter: getter setter: setter "Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter" ^ PlayerReferenceReadout new objectToView: aTarget viewSelector: getter putSelector: setter! ! !PlayerType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:33'! wantsArrowsOnTiles "Answer whether this data type wants up/down arrows on tiles representing its values" ^ false! ! !PlayerType methodsFor: 'initial value' stamp: 'sw 9/27/2001 17:29'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ aPlayer costume presenter standardPlayer! ! !PlayerType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:24'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. self vocabularyName: #Player! ! !PlayerType methodsFor: 'color' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(1.0 0 0.065)! ! !SoundType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:30'! defaultArgumentTile "Answer a tile to represent the type" ^ SoundTile new typeColor: self typeColor! ! !SoundType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:37'! newReadoutTile "Answer a tile that can serve as a readout for data of this type" ^ SoundReadoutTile new typeColor: Color lightGray lighter! ! !SoundType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:33'! setFormatForDisplayer: aDisplayer "Set up the displayer to have the right format characteristics" aDisplayer useStringFormat ! ! !SoundType methodsFor: 'initial value' stamp: 'sw 9/27/2001 17:29'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ 'croak'! ! !SoundType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:24'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. self vocabularyName: #Sound! ! !SoundType methodsFor: 'color' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(1.0 0.06 0.84) ! ! !StringType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:30'! defaultArgumentTile "Answer a tile to represent the type" ^ 'abc' newTileMorphRepresentative typeColor: self typeColor! ! !StringType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:33'! setFormatForDisplayer: aDisplayer "Set up the displayer to have the right format characteristics" aDisplayer useStringFormat ! ! !StringType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:33'! wantsArrowsOnTiles "Answer whether this data type wants up/down arrows on tiles representing its values" ^ false! ! !StringType methodsFor: 'initial value' stamp: 'sw 9/27/2001 17:29'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ 'abc'! ! !StringType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:24'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" | aMethodCategory aMethodInterface | super initialize. self vocabularyName: #String. #((accessing 'The basic info' (at: at:put: size endsWithDigit findString: findTokens: includesSubString: indexOf: indexOf:startingAt: indexOf:startingAt:ifAbsent: lineCorrespondingToIndex: lineCount lineNumber: startsWithDigit numArgs)) (more accessing 'More basic info' (allButFirst allButFirst: allButLast allButLast: at:ifAbsent: atAllPut: atPin: atRandom: atWrap: atWrap:put: fifth first first: fourth from:to:put: last last: lastIndexOf: lastIndexOf:ifAbsent: middle replaceAll:with: replaceFrom:to:with: replaceFrom:to:with:startingAt: second sixth third)) (comparing 'Determining which comes first alphabeticly' (< <= = > >= beginsWith: endsWith: endsWithAnyOf: howManyMatch: match:)) (testing 'Testing' (includes: isEmpty ifNil: ifNotNil: isAllDigits isAllSeparators isString lastSpacePosition)) (converting 'Converting it to another form' (asCharacter asDate asInteger asLowercase asNumber asString asStringOrText asSymbol asText asTime asUppercase asUrl capitalized keywords numericSuffix romanNumber reversed splitInteger surroundedBySingleQuotes withBlanksTrimmed withSeparatorsCompacted withoutTrailingBlanks withoutTrailingDigits asSortedCollection)) (copying 'Make another one like me' (copy copyFrom:to: copyUpTo: copyUpToLast: shuffled)) (enumerating 'Passing over the letters' (collect: collectWithIndex: do: from:to:do: reverseDo: select: withIndexDo: detect: detect:ifNone:)) ) do: [:item | aMethodCategory _ ElementCategory new categoryName: item first. aMethodCategory documentation: item second. item third do: [:aSelector | aMethodInterface _ MethodInterface new initializeFor: aSelector. self atKey: aSelector putMethodInterface: aMethodInterface. aMethodCategory elementAt: aSelector put: aMethodInterface]. self addCategory: aMethodCategory]. ! ! !StringType methodsFor: 'color' stamp: 'sw 9/27/2001 17:21'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(0.0 0.0 1.0) ! ! !SymbolListType methodsFor: 'tiles' stamp: 'sw 9/27/2001 02:34'! affordsCoercionToBoolean "Answer true if a tile of this data type, when dropped into a pane that demands a boolean, could plausibly be expanded into a comparison (of the form frog < toad or frog = toad) to provide a boolean expression" ^ false! ! !SymbolListType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:30'! defaultArgumentTile "Answer a tile to represent the type" | aTile | aTile _ SymbolListTile new choices: symbols dataType: self vocabularyName. aTile addArrows. aTile setLiteral: symbols first. ^ aTile! ! !SymbolListType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:37'! newReadoutTile "Answer a tile that can serve as a readout for data of this type" ^ SymbolListTile new choices: symbols copy dataType: self vocabularyName ! ! !SymbolListType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:45'! representsAType "Answer whether this vocabulary represents an end-user-sensible data type" ^ self class ~~ SymbolListType! ! !SymbolListType methodsFor: 'initial value' stamp: 'sw 9/27/2001 17:29'! initialValueForASlotFor: aPlayer "Answer the value to give initially to a newly created slot of the given type in the given player" ^ symbols first! ! !ButtonPhaseType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:23'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. self vocabularyName: #ButtonPhase. symbols _ #(buttonDown whilePressed buttonUp)! ! !ButtonPhaseType methodsFor: 'color' stamp: 'sw 9/27/2001 17:20'! typeColor "Answer the color for tiles to be associated with objects of this type" ^ self subduedColorFromTriplet: #(0.806 1.0 0.806) ! ! !UnknownType methodsFor: 'initialization' stamp: 'sw 9/27/2001 17:25'! initialize "Initialize the receiver (automatically called when instances are created via 'new')" super initialize. vocabularyName _ #unknown! ! !UnknownType methodsFor: 'tiles' stamp: 'sw 9/27/2001 13:33'! affordsCoercionToBoolean "Answer true if a tile of this data type, when dropped into a pane that demands a boolean, could plausibly be expanded into a comparison (of the form frog < toad or frog = toad) to provide a boolean expression" ^ false! ! !UnknownType methodsFor: 'tiles' stamp: 'sw 9/27/2001 17:33'! wantsArrowsOnTiles "Answer whether this data type wants up/down arrows on tiles representing its values" ^ false! ! !UnknownType methodsFor: 'queries' stamp: 'sw 9/27/2001 13:37'! representsAType "Answer whether this vocabulary represents an end-user-sensible data type" ^ false! ! !Vocabulary class methodsFor: 'class initialization' stamp: 'sw 9/27/2001 17:01'! embraceAddedTypeVocabularies "If there are any type-vocabulary subclases not otherwise accounted for, acknowledge them at this time" | aVocab | DataType allSubclasses do: [:cl | aVocab _ cl new. (aVocab representsAType and: [(AllStandardVocabularies includesKey: aVocab vocabularyName) not]) ifTrue: [self addStandardVocabulary: aVocab]]! ! !Vocabulary class methodsFor: 'class initialization' stamp: 'sw 9/27/2001 17:02'! initialize "Initialize a few standard vocabularies and place them in the AllVocabularies list. Call this to update all vocabularies." self initializeStandardVocabularies. self embraceAddedTypeVocabularies. self assureNaturalLanguageTranslationsInActiveWorld. "Vocabulary initialize" ! ! !Vocabulary class methodsFor: 'class initialization' stamp: 'sw 9/27/2001 12:22'! initializeStandardVocabularies "Initialize a few standard vocabularies and place them in the AllStandardVocabularies list." AllStandardVocabularies _ nil. self allStandardVocabularies. self addEToyVocabulary. self addEToyVectorVocabulary. self addStandardVocabulary: self newPublicVocabulary. self addStandardVocabulary: FullVocabulary new. self addStandardVocabulary: self newQuadVocabulary. self addStandardVocabulary: ColorType new. self addStandardVocabulary: BooleanType new. self addStandardVocabulary: GraphicType new. self addStandardVocabulary: PlayerType new. self addStandardVocabulary: SoundType new. self addStandardVocabulary: StringType new. self addStandardVocabulary: ButtonPhaseType new. self addStandardVocabulary: MenuType new. self addStandardVocabulary: UnknownType new. self numberVocabulary. "creates and adds it" self wonderlandVocabulary. "creates and adds it" self vocabularyForClass: Time. "creates and adds it" "Vocabulary initialize" ! ! !Vocabulary class methodsFor: 'testing and demo' stamp: 'sw 9/26/2001 03:51'! newQuadVocabulary "Answer a Quad vocabulary -- something to mess with, to illustrate and explore ideas. Applies to Quadrangles only." | aVocabulary | aVocabulary _ Vocabulary new vocabularyName: #Quad. aVocabulary documentation: 'A highly restricted test vocabulary that can be used with Quadrangle objects'. aVocabulary initializeFromTable: #( (borderColor borderColor: () Color (basic color) 'The color of the border' unused updating) (borderWidth borderWidth: () Number (basic geometry) 'The width of the border' unused updating) (insideColor insideColor: () Color (basic color) 'The color of the quadrangle' unused updating) (display none () none (basic display) 'Display the quadrangle directly on the screen') (width none () Number (geometry) 'The width of the object' unused updating) (left setLeft: () Number (geometry) 'The left edge' unused updating) (right setRight: () Number (geometry) 'The right edge' unused updating) (width setWidth: () Number (geometry) 'The width of the object' unused updating) (height setHeight: () Number (geometry) 'The height of the object' unused updating) (hasPositiveExtent none () Boolean (tests) 'Whether the corner is to the lower-right of the origin' unused updating) (isTall none () Boolean (tests) 'Whether the height is greater than the width' unused updating)). ^ aVocabulary "Vocabulary initialize" "Quadrangle exampleInViewer"! ! !Vocabulary class methodsFor: 'testing and demo' stamp: 'sw 9/26/2001 11:59'! newTestVocabulary "Answer a Test vocabulary -- something to mess with, to illustrate and explore ideas." | aVocabulary | aVocabulary _ Vocabulary new vocabularyName: #Test. aVocabulary documentation: 'An illustrative vocabulary for testing'. aVocabulary initializeFromTable: #( (isKindOf: none ((aClass Class)) Boolean (#'class membership') 'answer whether the receiver''s superclass chain includes aClass') (class none none Class (#'class membership' wimpy) 'answer the the class to which the receiver belongs') (respondsTo: none ((aSelector Symbol)) Boolean (#'class membership') 'answer whether the receiver responds to the given selector') (as: none ((aClass Class)) Object (conversion) 'answer the receiver converted to be a member of aClass')). ^ aVocabulary " #((#'class membership' 'Whether an object can respond to a given message, etc.' (isKindOf: class respondsTo:)) (conversion 'Messages to convert from one kind of object to another' (as: asString)) (copying 'Messages for making copies of objects' (copy copyFrom:)) (equality 'Testing whether two objects are equal' ( = ~= == ~~)) (dependents 'Support for dependency notification' (addDependent: removeDependent: release))) do: [:item | aMethodCategory _ ElementCategory new categoryName: item first. aMethodCategory documentation: item second. item third do: [:aSelector | aMethodInterface _ MethodInterface new initializeFor: aSelector. aVocabulary atKey: aSelector putMethodInterface: aMethodInterface. aMethodCategory elementAt: aSelector put: aMethodInterface]. aVocabulary addCategory: aMethodCategory]." ! ! !Vocabulary class methodsFor: 'type vocabularies' stamp: 'sw 9/25/2001 20:13'! newNumberVocabulary "Answer a Vocabulary object representing the Number vocabulary to the list of AllVocabularies" ^ NumberType new! ! !Vocabulary class methodsFor: 'type vocabularies' stamp: 'sw 9/26/2001 04:10'! newWonderlandVocabulary "Answer a Wonderland vocabulary -- highly experimental" | aVocabulary | "Vocabulary newWonderlandVocabulary" self removeStandardVocabularyNamed: #Wonderland. aVocabulary _ Vocabulary new vocabularyName: #Wonderland. aVocabulary documentation: 'A simple vocabulary for scripting Alice objects'. aVocabulary initializeFromTable: #( (color color: () Color (basic color) 'The color of the object' unused updating) "--" (getX setX: () Number (basic geometry) 'The x position' unused updating) (getY setY: () Number (basic geometry) 'The y position' unused updating) (getZ setZ: () Number (basic geometry) 'The z position' unused updating) "--" (width setWidth: () Number (geometry) 'The width of the object' unused updating) (height setHeight: () Number (geometry) 'The height of the object' unused updating) (depth setDepth: () Number (geometry) 'The depth of the object' unused updating) "--" (heading setHeading: () Number (basic geometry) 'The heading of the object' unused updating) (forwardBy: unused ((distance Number)) none (basic motion) 'Moves the object by the specified distance' 'forward by') (turnBy: unused ((angle Number)) none (basic motion) 'Turns the object by the specified number of degrees' 'turn by') (graphic setGraphic: () Graphic (basic graphics) 'The picture currently being worn' unused updating) (animationIndex setAnimationIndex: () Number (graphics) 'The index in the object''s animation chain' unused updating) (emptyScript unused () none (scripts) 'The empty script') (distanceToCamera setDistanceToCamera: () Number (geometry) 'The distance of the object from the camera' unused updating) (distanceTo: unused ((target Player)) Number (geometry) 'The distance of the object to the given target') ). ^ aVocabulary! ! !Vocabulary class methodsFor: 'type vocabularies' stamp: 'sw 9/27/2001 17:48'! typeChoices "Answer a list of all user-choosable data types" ^ (self allStandardVocabularies select: [:aVocab | aVocab representsAType] thenCollect: [:aVocab | aVocab vocabularyName]) asSortedArray ! ! !Vocabulary class methodsFor: 'type vocabularies' stamp: 'sw 9/27/2001 15:29'! vocabularyForType: aType "Answer a vocabulary appropriate to the given type, which is normally going to be a symbol such as #Number or #Color. Answer the Unknown vocabulary as a fall-back" | ucSym | (aType isKindOf: Vocabulary) ifTrue: [^ aType]. ucSym _ aType capitalized asSymbol. ^ AllStandardVocabularies detect: [:vocab | vocab vocabularyName = ucSym] ifNone: [self vocabularyNamed: #unknown]! ! !WonderlandCameraMorph class methodsFor: 'scripting' stamp: 'sw 9/27/2001 17:48'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((fog ( (slot fogColor 'The color of fog being applied' Color readWrite Player getFogColor Player setFogColor:) (slot fogType 'The type of fog being applied' Number readWrite Player getFogType Player setFogType:) (slot fogDensity 'The density of fog being applied' Number readWrite Player getFogDensity Player setFogDensity:) (slot fogRangeStart 'The range start of fog being applied' Number readWrite Player getFogRangeStart Player setFogRangeStart:) (slot fogRangeEnd 'The range start of fog being applied' Number readWrite Player getFogRangeEnd Player setFogRangeEnd:) )))! ! !ZoomAndScrollControllerMorph class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:28'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((#storyboard ( (slot cameraPoint 'the camera point' Point readWrite Player cameraPoint Player cameraPoint:) ) ))! ! !SoundReadoutTile reorganize! ('literal' setLiteralTo:width:) ('arrows' arrowAction:) ! !MenuTile reorganize! ('type' resultType) ('initialization' initialize) ('mouse' arrowAction: handlerForMouseDown: handlesMouseDown: mouseDown: mouseDownPriority) ! StandardScriptingSystem removeSelector: #initializeTypeColors! StandardScriptingSystem removeSelector: #setColors:forType:! !SlotInformation reorganize! ('access' documentation documentation: floatPrecision floatPrecision: type type: variableDock variableDock:) ('initialization' initialize) ('printing' printOn:) ! Object removeSelector: #tileForArgType:! Object removeSelector: #updatingTileForArgType:partName:getSelector:putSelector:! Smalltalk removeClassNamed: #TranslatedEToyVocabulary! "Postscript:" Vocabulary initialize. Object subclass: #StandardScriptingSystem instanceVariableNames: '' classVariableNames: 'ClassVarNamesInUse FormDictionary HelpStrings StandardPartsBin ' poolDictionaries: '' category: 'Morphic-Scripting'.!