'From Squeak3.1alpha of 28 February 2001 [latest update: #4249] on 15 August 2001 at 1:41:18 pm'! "Change Set: WnldDistanceTo-ar Date: 15 August 2001 Author: Andreas Raab Add #distanceTo: to WonderlandActor's vocabulary."! !Vocabulary class methodsFor: 'testing and demo' stamp: 'ar 8/15/2001 13:23'! newWonderlandVocabulary "Vocabulary newWonderlandVocabulary" "Answer a Wonderland vocabulary -- highly experimental" | aVocabulary | self removeVocabularyNamed: #WonderlandVocabulary. aVocabulary _ Vocabulary new vocabularyName: #WonderlandVocabulary. 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 ! ! !WonderlandActor methodsFor: 'eToy-support' stamp: 'ar 8/15/2001 13:25'! tearOffTileForSelf | tiles | self currentHand attachMorph: (tiles _ self tileReferringToSelf). (tiles isKindOf: SyntaxMorph) ifTrue: [Preferences tileTranslucentDrag ifTrue: [tiles lookTranslucent] ifFalse: [tiles align: tiles topLeft with: self currentHand position + tiles cursorBaseOffset]] ! ! !WonderlandActor methodsFor: 'eToy-support' stamp: 'ar 8/15/2001 13:24'! tileReferringToSelf "answer a tile that refers to the receiver" | aTile nn tile | Preferences universalTiles ifTrue: [nn _ self externalName. "name it, if necessary, and put in References" (References includesKey: nn asSymbol) ifFalse: [ References at: nn asSymbol put: self]. tile _ SyntaxMorph new parseNode: (VariableNode new name: nn key: nn code: nil). tile layoutInset: 1; addMorph: (tile addString: nn special: false). tile color: (SyntaxMorph translateColor: #variable). tile extent: tile firstSubmorph extent + (2@2). ^ tile]. aTile _ TileMorph new setToReferTo: self. ^ aTile! ! !WonderlandWrapperMorph methodsFor: 'handles' stamp: 'ar 8/15/2001 13:26'! addHandlesTo: aHaloMorph box: box | dismissHandle s | s _ aHaloMorph handleSize. myActor getTexturePointer == nil ifFalse:[ aHaloMorph addHandleAt: box rightCenter color: Color lightGray on: #mouseDown send: #extractTexture: to: aHaloMorph target]. aHaloMorph addHandleAt: box topLeft color: Color red icon: 'Halo-Menu' on: #mouseDown send: #doMenu:with: to: aHaloMorph. aHaloMorph addHandleAt: (box leftCenter + (0 @ (s+2)) min: box leftCenter + box bottomLeft // 2) color: Color lightBrown icon: 'Halo-Tile' on: #mouseDown send: #tearOffTile to: self. dismissHandle _ aHaloMorph addHandleAt: (box topLeft + ((s+2)@0) min: box topLeft + box topCenter // 2) color: Color red muchLighter icon: 'Halo-Dismiss' on: #mouseDown send: #mouseDownInDimissHandle:with: to: aHaloMorph. dismissHandle on: #mouseUp send: #maybeDismiss:with: to: aHaloMorph. dismissHandle on: #mouseDown send: #setDismissColor:with: to: aHaloMorph. dismissHandle on: #mouseMove send: #setDismissColor:with: to: aHaloMorph. aHaloMorph addHandleAt: box leftCenter color: Color cyan icon: 'Halo-View' on: #mouseDown send: #openViewerForArgument to: self. aHaloMorph addHandleAt: box topCenter color: Color black icon: 'Halo-Grab' on: #mouseDown send: #grabFromHalo:with: to: self. (aHaloMorph addHandleAt: (box topCenter + ((s+2)@0) min: box topCenter + box topRight // 2) color: Color brown icon: 'Halo-Drag' on: #mouseDown send: #dragStartFromHalo:with: to: self) on: #mouseMove send: #dragMoveFromHalo:with: to: self; on: #mouseUp send: #dragEndFromHalo:with: to: self. (aHaloMorph addHandleAt: box topRight color: Color green icon: 'Halo-Dup' on: #mouseDown send: #dupStartFromHalo:with: to: self) on: #mouseMove send: #dupMoveFromHalo:with: to: self; on: #mouseUp send: #dupEndFromHalo:with: to: self. Preferences showDebugHaloHandle ifTrue: [aHaloMorph addHandleAt: ((box topRight + box rightCenter) // 2) color: Color blue veryMuchLighter icon: 'Halo-Debug' on: #mouseDown send: #doDebug:with: to: aHaloMorph]. (aHaloMorph addHandleAt: box bottomLeft color: Color blue icon: 'Halo-Rotate' on: #mouseDown send: #rotateStartFromHalo:with: to: self) on: #mouseMove send: #rotateMoveFromHalo:with: to: self; on: #mouseUp send: #rotateEndFromHalo:with: to: self. (aHaloMorph addHandleAt: box bottomRight color: Color yellow icon: 'Halo-Scale' on: #mouseDown send: #growStartFromHalo:with: to: self) on: #mouseMove send: #growMoveFromHalo:with: to: self; on: #mouseUp send: #growEndFromHalo:with: to: self. myActor isHandmade ifTrue: [ (aHaloMorph addHandleAt: box center color: Color white icon: 'Halo-Paint' on: #mouseUp send: #paintTexture to: self)] ! ! !WonderlandWrapperMorph methodsFor: 'handles' stamp: 'ar 8/15/2001 13:26'! tearOffTile ^ myActor tearOffTileForSelf! ! "Postscript: Re-initialize vocab." Vocabulary newWonderlandVocabulary.!