'From Squeak3.3alpha of 18 January 2002 [latest update: #4976] on 3 October 2002 at 2:27:56 am'! "Change Set: lengthEtc-sw Date: 3 October 2002 Author: Scott Wallace Published as 4978lengthEtc-sw.cs to 3.3a. ¥ In viewers, replaces the former 'height' and 'width' variables with 'length' and a redefined 'width'. ¥ Length is measured in the direction the object is heading, Width is the orthogonal measure. These two measures are now invariant as an object rotates (except for small round-off artifacts.) ¥ Adds (this is a temporary name, until Alan tells me what the real name is ;-) #headingTheta, which gives the angle from positive-x that an object's major axis (i.e. the direction in which the 'length' is computed) makes. ¥ Puts commands for switching into and out of 'vector mode' into the personal menu for Alan (i.e. only if the hard-coded #isFlagship preference is true.) ¥ Note that the length and width computations for PolygonMorphs are very tortured and special-cased and slow. I would welcome this being cleaned up. AFAIK it is only PolygonMorph that is problematical in this way. ¥ For the particular forcing function behind this work, namely Alan's 'players-as-vectors' etoy work, PolygonMorphs that have precisely two vertices are special-cased to have intuitively correctly behavior for length and width; the Arrow found in the Objects catalog is a good prototype to use. ¥ Fixes a long-standing bug in methodInterfacesInPresentationOrderFrom:forCategory:"! !Object methodsFor: 'viewer' stamp: 'sw 9/17/2002 13:12'! methodInterfacesInPresentationOrderFrom: interfaceList forCategory: aCategory "Answer the interface list sorted in desired presentation order, using a static master-ordering list, q.v. The category parameter allows an escape in case one wants to apply different order strategies in different categories, but for now a single master-priority-ordering is used -- see the comment in method EToyVocabulary.masterOrderingOfPhraseSymbols" | masterOrder interfaces firstIndex secondIndex | masterOrder _ Vocabulary eToyVocabulary masterOrderingOfPhraseSymbols. interfaces _ interfaceList asSortedCollection: [:a :b | firstIndex _ masterOrder indexOf: a elementSymbol. secondIndex _ masterOrder indexOf: b elementSymbol. firstIndex > 0 ifTrue: [secondIndex = 0 or: [secondIndex > firstIndex]] ifFalse: [secondIndex == 0 ifTrue: [b elementSymbol < a elementSymbol] ifFalse: ["b in list, a not" false]]]. ^ interfaces asArray! ! !EToyVocabulary methodsFor: 'method list' stamp: 'sw 9/17/2002 13:57'! masterOrderingOfPhraseSymbols "Answer a dictatorially-imposed presentation list of phrase-symbols. This governs the order in which suitable phrases are presented in etoy viewers using the etoy vocabulary. For any given category, the default implementation is that any items that are in this list will occur first, in the order specified here; after that, all other items will come, in alphabetic order by formal selector." ^ #(beep: forward: turn: getX getY getHeading getScaleFactor getLeft getRight getTop getBottom getLength getWidth getTheta getDistance getHeadingTheta startScript: pauseScript: stopScript: startAll: pauseAll: stopAll: tellAllSiblings: doScript: getColor getUseGradientFill getSecondColor getRadialGradientFill getBorderWidth getBorderColor getBorderStyle getRoundedCorners getDropShadow getShadowColor getGraphic getBaseGraphic)! ! !Morph class methodsFor: 'scripting' stamp: 'sw 9/17/2002 13:58'! additionsToViewerCategoryGeometry "answer additions to the geometry viewer category" ^ #(geometry ( (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 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 length 'The length' Number readWrite Player getLength Player setLength:) (slot width 'The width' Number readWrite Player getWidth Player setWidth:) (slot headingTheta 'The angle, in degrees, that my heading vector makes with the positive x-axis' Number readWrite Player getHeadingTheta Player setHeadingTheta:) (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/17/2002 10:00'! 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: ) (slot headingTheta 'The angle that my heading vector makes with the positive x-axis' Number readWrite Player getHeadingTheta Player setHeadingTheta:) (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) )! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 9/17/2002 10:50'! getHeadingTheta "Answer the angle, in degrees, between the positive x-axis and the receiver's heading vector" | aHeading excess normalized | aHeading _ self getHeadingUnrounded. excess _ aHeading - (aHeading rounded). normalized _ (450 - aHeading) \\ 360. ^ normalized + excess! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 9/23/2002 22:27'! getLength "Answer the length of the object" | aLength cost | ((cost _ self costume) isKindOf: PolygonMorph) "annoying special case" ifTrue: [^ cost unrotatedLength]. aLength _ cost renderedMorph height. "facing upward when unrotated" cost isRenderer ifTrue: [aLength _ aLength * cost scaleFactor]. ^ aLength! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 9/23/2002 22:29'! getWidth "Answer the width of the object" | aWidth cost | ((cost _ self costume) isKindOf: PolygonMorph) "annoying special case" ifTrue: [^ cost unrotatedWidth]. aWidth _ cost renderedMorph width. "facing upward when unrotated" cost isRenderer ifTrue: [aWidth _ aWidth * cost scaleFactor]. ^ aWidth! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 9/17/2002 10:17'! setHeadingTheta: anAngle "Set the heading theta" self setHeading: (450 - anAngle)! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 10/3/2002 02:20'! setLength: aLength "Set the length of the receiver." | cost lengthToUse | ((cost _ self costume) isKindOf: PolygonMorph) ifTrue: [^ cost unrotatedLength: aLength]. lengthToUse _ cost isRenderer ifTrue: [aLength / cost scaleFactor] ifFalse: [aLength]. cost renderedMorph height: lengthToUse! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 9/23/2002 22:34'! setWidth: aWidth "Set the width" | cost widthToUse | ((cost _ self costume) isKindOf: PolygonMorph) ifTrue: [^ cost unrotatedWidth: aWidth]. widthToUse _ cost isRenderer ifTrue: [aWidth / cost scaleFactor] ifFalse: [aWidth]. cost renderedMorph width: widthToUse! ! !PolygonMorph methodsFor: 'editing' stamp: 'sw 9/25/2002 01:16'! newVertex: ix event: evt fromHandle: handle "Insert a new vertex and fix everything up!! Install the drag-handle of the new vertex as recipient of further mouse events." | pt | (self hasProperty: #noNewVertices) ifFalse: [pt _ evt cursorPoint. self setVertices: (vertices copyReplaceFrom: ix + 1 to: ix with: (Array with: pt)). evt hand newMouseFocus: (handles at: ((ix + 1) * 2) - 1)] ! ! !PolygonMorph methodsFor: 'menu' stamp: 'sw 9/24/2002 19:23'! arrowLength: aLength "Assumes that I have exactly two vertices" | theta horizontalOffset verticalOffset newTip delta | delta _ vertices second - vertices first. theta _ delta theta. horizontalOffset _ aLength * (theta cos). verticalOffset _ aLength * (theta sin). newTip _ vertices first + (horizontalOffset @ verticalOffset). self verticesAt: 2 put: newTip! ! !PolygonMorph methodsFor: 'menu' stamp: 'sw 9/24/2002 18:06'! unrotatedLength "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is" vertices size == 2 ifTrue: [^ (vertices second - vertices first) r]. ^ ((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) height! ! !PolygonMorph methodsFor: 'menu' stamp: 'sw 9/24/2002 18:54'! unrotatedLength: aLength "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is" vertices size == 2 ifTrue: [^ self arrowLength: aLength]. self setVertices: ((((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) height: aLength) rotationDegrees: 0) vertices! ! !PolygonMorph methodsFor: 'menu' stamp: 'sw 9/24/2002 18:17'! unrotatedWidth "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is" vertices size == 2 ifTrue: [^ self borderWidth]. ^ ((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) width! ! !PolygonMorph methodsFor: 'menu' stamp: 'sw 9/24/2002 18:18'! unrotatedWidth: aWidth "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is" self borderWidth: aWidth! ! !PolygonMorph class methodsFor: 'instance creation' stamp: 'sw 10/3/2002 02:19'! arrowPrototype "Answer an instance of the receiver that will serve as a prototypical arrow" | aa | aa _ self new. aa vertices: (Array with: 0@0 with: 40@40) color: Color black borderWidth: 2 borderColor: Color black. aa setProperty: #noNewVertices toValue: true. aa makeForwardArrow. "is already open" aa computeBounds. ^ aa! ! !Preferences class methodsFor: 'personalization' stamp: 'sw 10/3/2002 02:21'! personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal'. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' action: #goBack. aMenu add: 'load latest code updates' target: Utilities action: #updateFromServer. aMenu add: 'about this system...' target: Smalltalk action: #aboutThisSystem. Preferences isFlagship ifTrue: "For benefit of Alan" [aMenu addLine. aMenu add: 'start using vectors' target: ActiveWorld action: #installVectorVocabulary. aMenu add: 'stop using vectors' target: ActiveWorld action: #abandonVocabularyPreference]. aMenu addLine. aMenu addUpdating: #suppressFlapsString target: CurrentProjectRefactoring action: #currentToggleFlapsSuppressed. aMenu balloonTextForLastItem: 'Whether prevailing flaps should be shown in the project right now or not.'! !