'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 22 June 2005 at 1:32:40 am'! !Hierarchical methodsFor: 'private' stamp: 'sumim 3/10/2002 01:44'! intendedChildrenNamesAndChildren: prefix "Return the object's children's menu, each menu item appended to the prefix." | nameList argList nest | nameList _ OrderedCollection new. argList _ OrderedCollection new. myChildren do: [ :child | (child appearsInChildLists) ifTrue: [ nameList addLast: (prefix , (child getName)). argList addLast: child. nameList _ nameList , ((nest _ child intendedChildrenNamesAndChildren: prefix , ' ') at: 1). argList _ argList , (nest at: 2)]]. ^ {nameList. argList}. ! ! !Hierarchical methodsFor: 'private' stamp: 'sumim 3/9/2002 21:53'! removeChildSlots: aChild "Remove an object from this instance's list of children" self class removeSelectorSimply: (aChild getName asSymbol). (self class allInstVarNames includes: aChild getName) ifTrue: [self class removeInstVarName: aChild getName]! ! !Hierarchical methodsFor: 'initialization' stamp: 'sumim 3/9/2002 16:58'! uniqueNameFrom: aString "Return a unique name for the string in the context of the receiver's name space" "| index aName myNamespace | aName _ aString. myNamespace _ self getChildren asSet collect:[:each| each getName]. (myNamespace includes: aName) ifFalse: [ ^ aName ]. aName endsWithDigit ifTrue:[ index _ aName findLast:[:ch| ch isDigit]. aName _ (aName copyFrom: 1 to: index-1). ]. index _ 1. [ myNamespace includes: (aName , (index asString)) ] whileTrue: [ index _ index + 1 ]. ^ aName , (index asString)." ^self getWonderland uniqueNameFrom: aString.! ! !PhraseTileMorph methodsFor: 'mouse' stamp: 'sumim 6/22/2005 00:43'! morphToDropInPasteUp: aPasteUp "Answer the morph to drop in aPasteUp, given that the receiver is the putative droppee" | actualObject itsSelector aScriptor pos aWatcher op | ((actualObject := self actualObject) isNil or: [(actualObject isPlayerLike) ifTrue: [actualObject costume isInWorld not] ifFalse: [false]]) ifTrue: [^ self]. self isCommand ifFalse: "Can't expand to a scriptor, but maybe launch a watcher..." [^ (Preferences dropProducesWatcher and: [(#(unknown command) includes: self resultType) not] and: [(op := self operatorTile operatorOrExpression) notNil] and: [op numArgs = 0] and: [(Vocabulary gettersForbiddenFromWatchers includes: op) not]) ifTrue: [aWatcher := self associatedPlayer fancyWatcherFor: op. aWatcher position: self position] ifFalse: [self]]. self justGrabbedFromViewer ifFalse: [^ self]. actualObject assureUniClass. itsSelector := self userScriptSelector. pos := self position. aScriptor := itsSelector isEmptyOrNil ifFalse: [actualObject scriptEditorFor: itsSelector] ifTrue: ["It's a system-defined selector; construct an anonymous scriptor around it" actualObject newScriptorAround: self]. aScriptor ifNil:[^self]. (self hasOwner: aScriptor) ifTrue:[ aScriptor fullBounds. "force layout" aScriptor position: pos - self position. ] ifFalse:[ aScriptor position: self position. ]. ^ aScriptor! ! !Wonderland methodsFor: 'creating' stamp: 'sumim 3/9/2002 15:12'! duplicateActor: anActor ^ self duplicateActor: anActor at: anActor getParent! ! !Wonderland methodsFor: 'creating' stamp: 'sumim 3/9/2002 23:27'! duplicateActor: anActor at: aParent | newActor | newActor _ anActor clone postCopy. "aParent _ anActor getParent." (aParent == nil or: [aParent class == WonderlandScene]) ifTrue:[ newActor setName: (self uniqueNameFrom: newActor getName). myNamespace at: newActor getName put: newActor] ifFalse:[ newActor setName: (aParent uniqueNameFrom: newActor getName). myNamespace at: newActor getName put: newActor. (aParent class allInstVarNames includes: newActor getName) ifFalse: [ aParent addInstanceVarNamed: newActor getName withValue: newActor. aParent class compile: (newActor getName , '\ ^ ' , newActor getName, '.') withCRs]]. aParent ifNotNil: [aParent addChild: newActor]. newActor setParent: aParent. newActor fixChildren. newActor getReactions do: [ :reactions | reactions do: [ :reac | (reac reaction home receiver) == anActor ifTrue: [reac reaction home receiver: newActor]]]. scriptEditor updateActorBrowser. "Add an undo item to undo the creation of this object" myUndoStack push: (UndoAction new: [ newActor removeFromScene. scriptEditor updateActorBrowser. ]). ^ newActor.! ! !WonderlandActor methodsFor: 'private' stamp: 'sumim 3/9/2002 03:12'! fixNameFrom: aString "Fix the name to be a valid Smalltalk name (e.g., so that we can compile it as an inst var and accessor message)" | aName | aName _ aString select:[:c| c isAlphaNumeric]. aName isEmpty ifTrue:[aName _ 'unkwown']. aName first isUppercase ifTrue:[aName _ aName first asLowercase asString, (aName copyFrom: 2 to: aName size)]. aName first isLetter ifFalse:[aName _ 'a', aName]. ^aName! ! !WonderlandActor methodsFor: 'private' stamp: 'sumim 3/9/2002 23:35'! postCopy | props oldReactions | myName _ myName copy. myChildren _ myChildren copy. myTexture _ myTexture copy bits: myTexture bits copy. myMaterial _ myMaterial copy. myColor _ myColor copy. oldReactions _ myReactions copy. myReactions _ Dictionary new. oldReactions keysAndValuesDo: [ :key :value | myReactions at: key put: (value collect: [ :reac | reac copy reaction: (reac reaction copy fixTemps)]) ]. myMesh _ myMesh shallowCopy. composite _ composite copy. scaleMatrix _ scaleMatrix copy. props _ myProperties. myProperties _ nil. props = nil ifFalse:[ props keysAndValuesDo:[:k :v| self setProperty: k toValue: v]].! ! !WonderlandActor methodsFor: 'private' stamp: 'sumim 3/9/2002 23:37'! removeFromScene "Remove this actor from the scene." "Break ties with the current parent" self allChildrenDo: [ :child | self getWonderland getNamespace removeKey: child getName ifAbsent: []]. myParent removeChildSlots: self. myParent removeChild: self. self getWonderland getNamespace removeKey: myName ifAbsent: [] ! ! !WonderlandActor methodsFor: 'private' stamp: 'sumim 3/10/2002 00:08'! reparentTo: anObject "Make this actor a child of the specified object." | newComposite classList parentClass | classList _ myWonderland getActorClassList. "First break ties with the current parent" myParent removeChildSlots: self. myParent removeChild: self. self getWonderland getNamespace removeKey: myName ifAbsent: []. "Figure out the new composite transformation matrix" newComposite _ anObject getMatrixToRoot. newComposite _ newComposite composeWith: (self getMatrixFromRoot). "Now build ties with the new parent" anObject addChild: self. myParent _ anObject. parentClass _ myParent class. (myWonderland getNamespace at: myName ifAbsent: [ nil ]) ifNotNil: [ myName _ myWonderland uniqueNameFrom: myName ]. myWonderland getNamespace at: myName put: self. (parentClass == WonderlandScene) ifFalse: [ myName _ parentClass uniqueNameFrom: myName. classList remove: parentClass. myParent addInstanceVarNamed: myName withValue: self. (myParent class) compile: (myName , '\ ^ ' , myName, '.') withCRs. classList addLast: (myParent class)]. composite _ newComposite. "Now update the actor browser" myWonderland getEditor updateActorBrowser.! ! !WonderlandActor methodsFor: 'accessing' stamp: 'sumim 3/9/2002 19:34'! fixChildren myChildren do: [ :child | self removeChild: child. myWonderland duplicateActor: child at: self]. ! ! !WonderlandActor methodsFor: 'eToy-support' stamp: 'sumim 6/21/2005 23:40'! arrowDeltaFor: aGetSelector "Answer a number indicating the default arrow delta to be used in a numeric readout with the given get-selector. This is a hook that subclasses of Morph can reimplement." aGetSelector == #getScaleFactor ifTrue: [^ 0.1]. ^ 1! ! !WonderlandActor methodsFor: 'eToy-support' stamp: 'sumim 6/22/2005 00:43'! isPlayerLike "Return true if the receiver is a player-like object" ^false! ! !WonderlandActor methodsFor: 'eToy-support' stamp: 'sumim 6/21/2005 23:42'! setFloatPrecisionFor: aReadout "If appropriate, set the floatPrecision for the given watcher readout (an UpdatingStringMorph), whose getter is assumed already to be established." | precision | (precision := self defaultFloatPrecisionFor: aReadout getSelector) ~= 1 ifTrue: [aReadout floatPrecision: precision]! ! !WonderlandActor methodsFor: 'copying' stamp: 'sumim 6/22/2005 00:56'! veryDeepInner: deepCopier "Special code that handles user-added instance variables of a uniClass. Copy all of my instance variables. Some need to be not copied at all, but shared. This is special code for the dictionary. See DeepCopier." | instVar weak subAss | super veryDeepInner: deepCopier. "my own instance variables are completely normal" myName := myName veryDeepCopyWith: deepCopier. myWonderland := myWonderland. "don't make a new one" myMesh := myMesh veryDeepCopyWith: deepCopier. myTexture := myTexture veryDeepCopyWith: deepCopier. myMaterial := myMaterial veryDeepCopyWith: deepCopier. myColor := myColor veryDeepCopyWith: deepCopier. scaleMatrix := scaleMatrix veryDeepCopyWith: deepCopier. hidden := hidden veryDeepCopyWith: deepCopier. firstClass := firstClass veryDeepCopyWith: deepCopier. myReactions := myReactions veryDeepCopyWith: deepCopier. myProperties := myProperties veryDeepCopyWith: deepCopier. "may copy too deeply" WonderlandActor instSize + 1 to: self class instSize do: [:index | instVar := self instVarAt: index. weak := instVar isMorph | instVar isPlayerLike | (instVar isKindOf: WonderlandActor). (subAss := deepCopier references associationAt: instVar ifAbsent: [nil]) "use association, not value, so nil is an exceptional value" ifNil: [weak ifFalse: [ self instVarAt: index put: (instVar veryDeepCopyWith: deepCopier)]] ifNotNil: [self instVarAt: index put: subAss value]. ]. ! ! !WonderlandActor methodsFor: 'eToy-fake' stamp: 'sumim 3/10/2002 02:22'! renameTo: aName | aPresenter putInViewer oldKey assoc oldName parentClass myWonderlandNamespace | oldName _ myName. self setName: aName. parentClass _ myParent class. myWonderlandNamespace _ myWonderland getNamespace. myWonderlandNamespace removeKey: oldName ifAbsent: []. (myWonderlandNamespace at: myName ifAbsent: [ nil ]) ifNotNil: [ myName _ myWonderland uniqueNameFrom: myName ]. myWonderlandNamespace at: myName put: self. (parentClass == WonderlandScene) ifFalse: [ parentClass removeSelectorSimply: (oldName asSymbol). (parentClass allInstVarNames includes: oldName) ifTrue: [parentClass removeInstVarName: oldName]. myName _ parentClass uniqueNameFrom: myName. myParent addInstanceVarNamed: myName withValue: self. parentClass compile: (myName , '\ ^ ' , myName, '.') withCRs.]. putInViewer _ false. ((aPresenter _ self presenter) isNil) ifFalse: [putInViewer _ aPresenter currentlyViewing: self. putInViewer ifTrue: [self viewerFlapTab hibernate]]. "empty it temporarily" "Fix References dictionary. See restoreReferences to know why oldKey is already myName, but oldName is the old name." oldKey _ References keyAtIdentityValue: self ifAbsent: [nil]. oldKey ifNotNil: [assoc _ References associationAt: oldKey. oldKey = myName ifFalse: ["normal rename" assoc key: myName asSymbol. References rehash]]. World allTileScriptingElements do: [:m | m bringUpToDate]. putInViewer ifTrue: [aPresenter viewObject: self]. "recreate my viewer" "oldKey ifNil: [^ myName]." myWonderland getEditor updateActorBrowser. ^ myName! ! !WonderlandActor methodsFor: 'get property' stamp: 'sumim 3/9/2002 20:16'! getReactions ^ myReactions! ! !WonderlandActor methodsFor: 'set property' stamp: 'sumim 3/9/2002 03:13'! setName: newName "Sets the object's name" myName _ self fixNameFrom: newName. ! ! !WonderlandActorBrowser methodsFor: 'actor list functions' stamp: 'sumim 3/10/2002 02:18'! actorMenu: aMenu "Builds the menu to display when the user right clicks on an actor" selectedActor ifNil: [^ aMenu]. (selectedActor isKindOf: WonderlandScene) ifTrue: [^ aMenu addList: {{'Load actor'. #loadActor}}]. aMenu addList: {{'Point camera at'. #pointAt}. {'Turn around once'. #turnAround}}. (selectedActor getParent isKindOf: WonderlandScene) ifTrue: [aMenu addList: {{'Become child and part of...'. #becomeChildAndPartOf}}] ifFalse: [aMenu addList: {{'Become child of scene'. #becomeChildOfScene}}]. selectedActor isFirstClass ifTrue: [aMenu addList: {{'Become part'. #becomePart}}] ifFalse: [aMenu addList: {{'Become first class'. #becomeFirstClass }}]. ^ aMenu addList: {{'Stand up'. #standUp}. {'Grow'. #grow}. {'Shrink'. #shrink}. {'Squash'. #squash}. {'Stretch'. #stretch}. {'Rename'. #renameActor}. {'Destroy'. #destroy}}. ! ! !WonderlandActorBrowser methodsFor: 'actor menu functions' stamp: 'sumim 3/10/2002 02:11'! becomeChildAndPartOf "Make the selected actor a child of another actor and a part" | nameAndChildList menu | menu _ MenuMorph new. ((nameAndChildList _ myWonderland getScene intendedChildrenNamesAndChildren: '') at: 1) doWithIndex: [:itm :idx | menu add: itm target: self selector: #becomeChildAndPartOf: argument: ((nameAndChildList at: 2) at: idx)]. menu invokeModal! ! !WonderlandActorBrowser methodsFor: 'actor menu functions' stamp: 'sumim 3/10/2002 01:51'! becomeChildAndPartOf: aParent "Make the selected actor a child of another actor and a part" selectedActor ~~ aParent ifTrue: [ selectedActor becomeChildOf: aParent. selectedActor becomePart]! ! !WonderlandActorBrowser methodsFor: 'actor menu functions' stamp: 'sumim 3/10/2002 00:02'! becomeChildOfScene selectedActor becomeChildOf: selectedActor getWonderland getScene. selectedActor becomeFirstClass! ! !WonderlandActorBrowser methodsFor: 'actor menu functions' stamp: 'sumim 3/10/2002 02:16'! renameActor "rename selected Actor" | ans | (ans _ FillInTheBlank request: 'Type new name and return' initialAnswer: selectedActor getName) = '' ifFalse: [selectedActor renameTo: ans]! ! !WonderlandCameraMorph methodsFor: 'pooh' stamp: 'sumim 6/21/2005 22:57'! createPoohActor | actor pointList box scale center subdivision mesh tex | pointList := self outline. pointList reset. pointList := pointList contents. pointList size < 2 ifTrue:[ self clearStroke. ^errorSound play]. pointList := self simplify: pointList. pointList := self smoothen: pointList length: 10. pointList := self regularize: pointList. box := Rectangle encompassing: pointList. scale := bounds extent y * 0.5. scale := 1.0 / (scale @ scale negated). center := box origin + box corner * 0.5. pointList := pointList collect:[:each| each - center * scale]. subdivision _ PoohSubdivision points: pointList shuffled. subdivision constraintOutline: pointList. mesh := subdivision build3DObject. mesh ifNil:[ errorSound play. ] ifNotNil:[ actor := self getWonderland makeActorNamed: 'sketch'. actor setProperty: #handmade toValue: true; setBackfaceCulling: #ccw; setMesh: mesh; setColor: gray. Preferences twoSidedPoohTextures ifTrue:[tex := (Form extent: 256@512 depth: 32) asTexture fillColor: Color white] ifFalse:[tex := (Form extent: 256@256 depth: 32) asTexture fillColor: Color white]. actor setTexturePointer: tex. actor setComposite: (myCamera getMatrixFromRoot composedWithLocal: (B3DMatrix4x4 withOffset: 0@0@2)). actor scaleByMatrix: (B3DRotation axis: 0@1@0 angle: 180) asMatrix4x4. actor rotateByMatrix: (B3DRotation axis: 0@1@0 angle:-180) asMatrix4x4. ]. self clearStroke. self mode: nil. Cursor normal show. ! ! !WonderlandReaction methodsFor: 'accessing' stamp: 'sumim 3/9/2002 19:59'! reaction ^ reaction! ! !WonderlandReaction methodsFor: 'accessing' stamp: 'sumim 3/9/2002 23:06'! reaction: reac reaction _ reac! !