'From Squeak3.2alpha of 3 October 2001 [latest update: #4599] on 31 December 2001 at 4:11:04 pm'! "Change Set: MorphBoundsRefactoring Date: 31 December 2001 Author: Joshua Gargus Changes direct gets/sets of 'bounds' into sends of #bounds and #privateBounds:. An example of when this might be useful is when where a higher level system cares when a Morph's bounds change (I used it to integrate Cassowary with Morphic). For the selfish reason that it was a pain to bring this up to date from a summer version, I urge harvesters to consider this changeset. Profiling shows that performance is virtually unchanged; the extra flexibility comes essentially for free."! !Morph methodsFor: 'copying' stamp: 'jcg 7/2/2001 00:29'! veryDeepInner: deepCopier "The inner loop, so it can be overridden when a field should not be traced." "super veryDeepInner: deepCopier. know Object has no inst vars" self privateBounds: self bounds clone. "Points are shared with original" "owner _ ow! ner. special, see veryDeepFixupWith:" submorphs _ submorphs veryDeepCopyWith: deepCopier. "each submorph's fixup will install me as the owner" "fullBounds _ fullBounds. fullBounds is shared with original!!" color _ color veryDeepCopyWith: deepCopier. "color, if simple, will return self. may be complex" extension _ extension veryDeepCopyWith: deepCopier. "extension is treated like any generic inst var" ! ! !Morph methodsFor: 'submorphs-add/remove' stamp: 'jcg 7/1/2001 22:32'! addMorphCentered: aMorph aMorph position: self center - (aMorph extent // 2). self addMorphFront: aMorph. ! ! !Morph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:30'! boundingBoxOfSubmorphs | aBox | aBox _ self position extent: self minimumExtent. "so won't end up with something empty" submorphs do: [:m | m visible ifTrue: [aBox _ aBox quickMerge: m fullBounds]]. ^ aBox ! ! !Morph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:32'! drawErrorOn: aCanvas "The morph (or one of its ! submorphs) had an error in its drawing method." aCanvas frameAndFillRectangle: self bounds fillColor: Color red borderWidth: 1 borderColor: Color yellow. aCanvas line: self topLeft to: self bottomRight width: 1 color: Color yellow. aCanvas line: self topRight to: self bottomLeft width: 1 color: Color yellow.! ! !Morph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:33'! shadowForm "Return a form representing the 'shadow' of the receiver - e.g., all pixels that are occupied by the receiver are one, all others are zero." | canvas | canvas _ (Display defaultCanvasClass extent: self extent depth: 1) asShadowDrawingCanvas: Color black. "Color black represents one for 1bpp" canvas translateBy: self topLeft negated during:[:tempCanvas| tempCanvas fullDrawMorph: self]. ^ canvas form offset: self topLeft ! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:26'! bottom ^ self bounds bottom! ! !Morph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:30'! bo! ttom: aNumber self position: (self left @ (aNumber - self height))! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:28'! bottomLeft ^ self bounds bottomLeft! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:26'! bottomRight ^ self bounds bottomRight! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:29'! center ^ self bounds center! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:29'! extent ^ self bounds extent! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:33'! extent: aPoint self extent = aPoint ifTrue: [^ self]. self changed. self privateBounds: (self topLeft extent: aPoint). self layoutChanged. self changed. ! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'! height ^ self bounds height! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'! innerBounds "Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is! just its bounds." ^ self bounds! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'! left ^ self bounds left! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:35'! left: aNumber self position: (aNumber @ self top)! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:31'! position ^ self bounds topLeft! ! !Morph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:31'! position: aPoint "Change the position of this morph and and all of its submorphs." | delta box | delta _ aPoint - self position. (delta x = 0 and: [delta y = 0]) ifTrue: [^ self]. "Null change" box _ self fullBounds. (delta dotProduct: delta) > 100 ifTrue:[ "e.g., more than 10 pixels moved" self invalidRect: box. self invalidRect: (box translateBy: delta). ] ifFalse:[ self invalidRect: (box merge: (box translateBy: delta)). ]. self privateFullMoveBy: delta.! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:31'! right ^ self bounds right! ! !Morph methods! For: 'geometry' stamp: 'jcg 12/31/2001 15:31'! right: aNumber self position: ((aNumber - self width) @ self top)! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:30'! top ^ self bounds top! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:34'! top: aNumber self position: (self left @ aNumber)! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:27'! topLeft ^ self bounds topLeft! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:28'! topRight ^ self bounds topRight! ! !Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:26'! width ^ self bounds width! ! !Morph methodsFor: 'geometry eToy' stamp: 'jcg 7/1/2001 22:34'! cartesianBoundsTopLeft "Answer the origin of this morph relative to it's container's cartesian origin. NOTE: y DECREASES toward the bottom of the screen" | w container | w _ self world ifNil: [^ self bounds origin]. container _ self referencePlayfield ifNil: [w]. ^ (self left - container cartesianOrigin x) @ (c! ontainer cartesianOrigin y - self top)! ! !Morph methodsFor: 'geometry eToy' stamp: 'jcg 7/1/2001 22:33'! x: aNumber "Set my horizontal position relative to the cartesian origin of the playfield or the world." | offset aPlayfield newX | aPlayfield _ self referencePlayfield. offset _ self left - self referencePosition x. aPlayfield == nil ifTrue: [newX _ aNumber + offset] ifFalse: [newX _ aPlayfield cartesianOrigin x + aNumber + offset]. self position: newX@self top. ! ! !Morph methodsFor: 'geometry eToy' stamp: 'jcg 12/31/2001 15:33'! y "Return my vertical position relative to the cartesian origin of the playfield or the world. Note that larger y values are closer to the top of the screen." | w aPlayfield | w _ self world ifNil: [^ self top]. aPlayfield _ self referencePlayfield. ^ aPlayfield == nil ifTrue: [w cartesianOrigin y - self referencePosition y] ifFalse: [aPlayfield cartesianOrigin y - self referencePosition y]! ! !Morph methodsFor: 'ge! ometry eToy' stamp: 'jcg 7/1/2001 22:35'! y: aNumber "Set my vertical position relative to the cartesian origin of the playfield or the world. Note that larger y values are closer to the top of the screen." | w offset newY aPlayfield | w _ self world. w ifNil: [^ self position: self left @ aNumber]. aPlayfield _ self referencePlayfield. offset _ self top - self referencePosition y. aPlayfield == nil ifTrue: [newY _ (w bottom - aNumber) + offset] ifFalse: [newY _ (aPlayfield cartesianOrigin y - aNumber) + offset]. self position: self left @ newY. ! ! !Morph methodsFor: 'menus' stamp: 'jcg 7/1/2001 22:33'! snapToEdgeIfAppropriate | edgeSymbol oldBounds aWorld | (edgeSymbol _ self valueOfProperty: #edgeToAdhereTo) ifNotNil: [oldBounds _ self bounds. self adhereToEdge: edgeSymbol. self bounds ~= oldBounds ifTrue: [(aWorld _ self world) ifNotNil: [aWorld viewBox ifNotNil: [aWorld displayWorld]]]]! ! !Morph methodsFor: 'printing' stamp: 'jcg 7/1/2001 22:! 34'! fullPrintOn: aStream aStream nextPutAll: self class name , ' newBounds: ('; print: self bounds; nextPutAll: ') color: ' , (self colorString: color)! ! !Morph methodsFor: 'private' stamp: 'jcg 12/31/2001 15:47'! privateBounds: boundsRect "Private!! Use position: and/or extent: instead." fullBounds _ nil. ^ bounds _ boundsRect.! ! !Morph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:35'! privateMoveBy: delta "Private!! Use 'position:' instead." | fill | extension ifNotNil:[ extension player ifNotNil:[ "Most cases eliminated fast by above test" self getPenDown ifTrue:[ "If this is a costume for a player with its pen down, draw a line." self moveWithPenDownBy: delta]]]. self privateBounds: (self bounds translateBy: delta). fullBounds ifNotNil:[fullBounds _ fullBounds translateBy: delta]. fill _ self fillStyle. fill isOrientedFill ifTrue:[fill origin: fill origin + delta]. ! ! !Morph methodsFor: 'undo' stamp: 'jcg 7/1/2001 22:34'! undoMove! : cmd redo: redo owner: formerOwner bounds: formerBounds predecessor: formerPredecessor "Handle undo and redo of move commands in morphic" self owner ifNil: [^ self beep]. redo ifFalse: ["undo sets up the redo state first" cmd redoTarget: self selector: #undoMove:redo:owner:bounds:predecessor: arguments: {cmd. true. owner. self bounds. (owner morphPreceding: self)}]. formerOwner ifNotNil: [formerPredecessor ifNil: [formerOwner addMorphFront: self] ifNotNil: [formerOwner addMorph: self after: formerPredecessor]]. self bounds: formerBounds. (self isKindOf: SystemWindow) ifTrue: [self activate]! ! !Morph methodsFor: 'layout' stamp: 'jcg 7/1/2001 11:47'! layoutBounds: aRectangle "Set the bounds for laying out children of the receiver. Note: written so that #layoutBounds can be changed without touching this method" | outer inner | outer _ self bounds. inner _ self layoutBounds. self privateBounds: (aRectangle origin + (outer origin - inner orig! in) corner: aRectangle corner + (outer corner - inner corner)).! ! !Morph methodsFor: 'layout' stamp: 'jcg 9/4/2001 10:01'! layoutInBounds: cellBounds "Layout specific. Apply the given bounds to the receiver after being layed out in its owner." | box aSymbol delta | fullBounds ifNil:["We are getting new bounds here but we haven't computed the receiver's layout yet. Although the receiver has reported its minimal size before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds." cellBounds origin = self bounds origin ifFal! se:[ box _ self outerBounds. delta _ cellBounds origin - self bounds origin. self invalidRect: (box merge: (box translateBy: delta)). self privateFullMoveBy: delta]. "sigh..." box _ cellBounds origin extent: "adjust for #rigid receiver" (self hResizing == #rigid ifTrue:[self bounds extent x] ifFalse:[cellBounds extent x]) @ (self vResizing == #rigid ifTrue:[self bounds extent y] ifFalse:[cellBounds extent y]). "Compute inset of layout bounds" box _ box origin - (self bounds origin - self layoutBounds origin) corner: box corner - (self bounds corner - self layoutBounds corner). "And do the layout within the new bounds" self layoutBounds: box. self doLayoutIn: box]. cellBounds = self fullBounds ifTrue:[^self]. "already up to date" cellBounds extent = self fullBounds extent "nice fit" ifTrue:[^self position: cellBounds origin]. box _ self bounds. "match #spaceFill constraints" self hResizing == #spaceFill ifTrue:[box _ box origin ext! ent: cellBounds width @ box height]. self vResizing == #spaceFill ifTrue:[box _ box origin extent: box width @ cellBounds height]. "align accordingly" aSymbol _ (owner ifNil:[self]) cellPositioning. box _ box align: (box perform: aSymbol) with: (cellBounds perform: aSymbol). "and install new bounds" self bounds: box.! ! !AlignmentMorphBob1 methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:23'! fullDrawOn: aCanvas | mask | super fullDrawOn: aCanvas. mask _ self valueOfProperty: #disabledMaskColor ifAbsent: [^self]. aCanvas fillRectangle: self bounds color: mask. ! ! !B3DSceneMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:41'! debugDraw self fullDrawOn: (Display getCanvas). Display forceToScreen: self bounds.! ! !B3DSceneMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:40'! drawAcceleratedOn: aCanvas | myRect | myRect _ (self bounds: self bounds in: nil) intersect: (0@0 extent: DisplayScreen actualScreenSize). (myRenderer notNil and:[myR! enderer isAccelerated]) ifFalse:[ myRenderer ifNotNil:[myRenderer destroy]. myRenderer _ nil. ]. myRenderer ifNotNil:[ myRenderer _ myRenderer bufferRect: myRect. ]. myRenderer ifNil:[ myRenderer _ B3DHardwareEngine newIn: myRect. myRenderer ifNil:[^self drawSimulatedOn: aCanvas]. ] ifNotNil:[ myRenderer reset. ]. myRenderer viewportOffset: aCanvas origin. myRenderer clipRect: aCanvas clipRect. self renderOn: myRenderer. Display addExtraRegion: myRect for: self.! ! !BackgroundMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:05'! drawOn: aCanvas "The tiling is solely determined by bounds, subBounds and offset. The extent of display is determined by bounds and the clipRect of the canvas." | start d subBnds | submorphs isEmpty ifTrue: [^ super drawOn: aCanvas]. subBnds _ self subBounds. running ifFalse: [super drawOn: aCanvas. ^ aCanvas fillRectangle: subBnds color: Color lightBlue]. start _ subBnds topLeft + offset - self topLe! ft - (1@1) \\ subBnds extent - subBnds extent + (1@1). d _ subBnds topLeft - self topLeft. "Sensor redButtonPressed ifTrue: [self halt]." start x to: self width - 1 by: subBnds width do: [:x | start y to: self height - 1 by: subBnds height do: [:y | aCanvas translateBy: (x@y) - d clippingTo: self bounds during:[:tileCanvas| self drawSubmorphsOn: tileCanvas]]].! ! !BackgroundMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:04'! fullDrawOn: aCanvas running ifFalse: [ ^aCanvas clipBy: (self bounds translateBy: aCanvas origin) during:[:clippedCanvas| super fullDrawOn: clippedCanvas]]. aCanvas drawMorph: self. ! ! !BalloonRectangleMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:20'! drawOn: aCanvas (color isKindOf: OrientedFillStyle) ifTrue:[ color origin: self center. color direction: (self width * 0.7) @ 0. color normal: 0@(self height * 0.7). ]. (borderColor isKindOf: OrientedFillStyle) ifTrue:[ borderColor origin: self to! pLeft. borderColor direction: (self width) @ 0. borderColor normal: 0@(self height). ]. aCanvas asBalloonCanvas drawRectangle: (self bounds insetBy: borderWidth // 2) color: color borderWidth: borderWidth borderColor: borderColor.! ! !BouncingAtomsMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 23:03'! step "Bounce those atoms!!" | r bounces | super step. bounces _ 0. r _ self topLeft corner: self bottomRight - (8@8). self submorphsDo: [ :m | (m isMemberOf: AtomMorph) ifTrue: [ (m bounceIn: r) ifTrue: [bounces _ bounces + 1]]]. "compute a 'temperature' that is proportional to the number of bounces divided by the circumference of the enclosing rectangle" self updateTemperature: (10000.0 * bounces) / (r width + r height). transmitInfection ifTrue: [self transmitInfection]. ! ! !BouncingAtomsMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 23:03'! addAtoms: n "Add a bunch of new atoms." | a | n timesRepeat: [ a _ AtomMorph new. a random! PositionIn: self bounds maxVelocity: 10. self addMorph: a]. self stopStepping. ! ! !BouncingAtomsMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 23:04'! invalidRect: damageRect from: aMorph "Try setting 'quickRedraw' to true. This invalidates the entire morph, whose bounds typically subsume all it's submorphs. (However, this code checks that assumption and passes through any damage reports for out-of-bounds submorphs. Note that atoms with super-high velocities do occaisionally shoot through the walls!!) An additional optimization is to only submit only damage report per display cycle by using the damageReported flag, which is reset to false when the morph is drawn." | quickRedraw | quickRedraw _ true. "false gives the original invalidRect: behavior" (quickRedraw and: [(self topLeft <= damageRect topLeft) and: [damageRect bottomRight <= self bottomRight]]) ifTrue: [ "can use quick redraw if damage is within my bounds" damageReported ifFalse: [super invalidRec! t: self bounds from: self]. "just report once" damageReported _ true. ] ifFalse: [super invalidRect: damageRect from: aMorph]. "ordinary damage report"! ! !CRLineMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:38'! getPoint: aNumber aNumber = 1 ifTrue: [^ self bottomLeft + (1@-1)]. aNumber = 2 ifTrue: [^ self bottomRight + (-1@-1)]. aNumber = 3 ifTrue: [^ self topRight + (-1@1)]. aNumber = 4 ifTrue: [^ self topLeft + (1@1)]. ! ! !CRLineMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:23'! privateSetStart: startPoint end: endPoint | xDiff yDiff | xDiff _ endPoint x - startPoint x. yDiff _ endPoint y - startPoint y. quadrant _ (yDiff <= 0 ifTrue: [xDiff >= 0 ifTrue: [1] ifFalse: [2]] ifFalse: [xDiff >= 0 ifTrue: [4] ifFalse: [3]]). self privateBounds: (((endPoint x min: startPoint x) - 1) @ ((endPoint y min: startPoint y) - 1) corner: ((endPoint x max: startPoint x) + 1) @ ((endPoint y max: startPoint y) + 1)).! ! !CRStrokeMorph methodsFor: 'ad! ding' stamp: 'jcg 12/31/2001 16:06'! addPoint: aPoint "We can save some time if we don't open this morph before we know the first point." | r | (points size > 0 and: [points last = aPoint]) ifTrue: [^self]. points add: aPoint. r := points last extent: 1@1. self privateBounds: (points size = 1 ifTrue: [r] ifFalse: [self bounds merge: r]). points size = 1 ifTrue: [self openInWorld] ifFalse: [World canvas line: (points at: (points size-1 max: 1)) to: points last color: self color].! ! !CategoryViewer methodsFor: 'header pane' stamp: 'jcg 7/1/2001 23:22'! addHeaderMorph "Add the header at the top of the viewer, with a control for choosing the category, etc." | header aFont aButton wrpr | header _ AlignmentMorph newRow color: self color; wrapCentering: #center; cellPositioning: #leftCenter. aFont _ Preferences standardButtonFont. header addMorph: (aButton _ SimpleButtonMorph new label: 'O' font: aFont). aButton target: self; color: Colo! r tan; actionSelector: #delete; setBalloonText: 'remove this pane from the screen don''t worry -- nothing will be lost!!.'. header addTransparentSpacerOfSize: 5@5. header addUpDownArrowsFor: self. (wrpr _ header submorphs last) submorphs second setBalloonText: 'previous category'. wrpr submorphs first setBalloonText: 'next category'. header beSticky. self addMorph: header. namePane _ RectangleMorph newSticky color: Color brown veryMuchLighter. namePane borderWidth: 0. aButton _ (StringButtonMorph contents: '-----' font: (StrikeFont familyName: #NewYork size: 12)) color: Color black. aButton target: self; arguments: Array new; actionSelector: #chooseCategory. aButton actWhen: #buttonDown. namePane addMorph: aButton. aButton position: namePane position. namePane align: namePane topLeft with: (self topLeft + (50 @ 0)). namePane setBalloonText: 'category (click here to choose a different one)'. header addMorphBack: namePane. (namePane isKindOf: Rectan! gleMorph) ifTrue: [namePane addDropShadow. namePane shadowColor: Color gray]. chosenCategorySymbol _ #basic! ! !EToyFridgeMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:24'! drawOn: aCanvas | f cache | f _ self class fridgeForm ifNil: [^super drawOn: aCanvas]. cache _ Form extent: self extent depth: aCanvas depth. f displayInterpolatedIn: cache boundingBox truncated on: cache. cache replaceColor: Color black withColor: Color transparent. aCanvas translucentImage: cache at: self position. ! ! !EToyMultiChatMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:23'! wantsDroppedMorph: aMorph event: evt (aMorph isKindOf: EToySenderMorph) ifFalse: [^false]. (self bounds containsPoint: evt cursorPoint) ifFalse: [^false]. ^true.! ! !EllipseMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:16'! containsPoint: aPoint | radius other delta xOverY | (self bounds containsPoint: aPoint) ifFalse: [^ false]. "quick! elimination" (self width = 1 or: [self height = 1]) ifTrue: [^ true]. "Degenerate case -- code below fails by a bit" radius _ self height asFloat / 2. other _ self width asFloat / 2. delta _ aPoint - self topLeft - (other@radius). xOverY _ self width asFloat / self height asFloat. ^ (delta x asFloat / xOverY) squared + delta y squared <= radius squared! ! !EllipseMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:16'! drawOn: aCanvas aCanvas isShadowDrawing ifTrue: [^ aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: 0 borderColor: nil]. aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: borderWidth borderColor: borderColor. ! ! !EmbeddedWorldBorderMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:21'! extent: aPoint self extent = aPoint ifFalse: [ self changed. self privateBounds: (self position extent: aPoint). self myWorldChanged. ]. ! ! !EmbeddedWorldBorderMorph methodsFor: 'a! s yet unclassified' stamp: 'jcg 7/1/2001 23:23'! myWorldChanged | trans | trans _ self myTransformation. self changed. self layoutChanged. trans ifNotNil:[ trans extentFromParent: self innerBounds extent. self privateBounds: (self topLeft extent: trans extent + (borderWidth * 2)). ]. self changed. ! ! !EmbeddedWorldBorderMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:23'! toggleZoom self bounds: ( self bounds area > (Display boundingBox area * 0.9) ifTrue: [ Display extent // 4 extent: Display extent // 2. ] ifFalse: [ Display boundingBox ] ) ! ! !EnvelopeEditorMorph methodsFor: 'construction' stamp: 'jcg 7/1/2001 23:19'! addKeyboard keyboard _ PianoKeyboardMorph new soundPrototype: sound. keyboard align: keyboard bounds bottomCenter with: self bounds bottomCenter - (0@4). self addMorph: keyboard! ! !EnvelopeEditorMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 23:18'! step | mouseDown hand | hand _ self world firstHand.! (self bounds containsPoint: hand position) ifFalse: [^ self]. mouseDown _ hand lastEvent redButtonPressed. mouseDown not & prevMouseDown ifTrue: ["Mouse just went up" limitXs = (limits collect: [:i | (envelope points at: i) x]) ifFalse: ["Redisplay after changing limits" self editEnvelope: envelope]]. prevMouseDown _ mouseDown! ! !EtoyLoginMorph methodsFor: 'initialize' stamp: 'jcg 12/31/2001 16:04'! initialize | fs | super initialize. self beSticky. fs _ GradientFillStyle ramp: {0.0 -> (Color r: 0.5 g: 0.5 b: 1.0). 1.0 -> (Color r: 0.8 g: 0.8 b: 1.0) }. self vResizing: #shrinkWrap. self hResizing: #shrinkWrap. color _ Color paleYellow. borderWidth _ 8. borderColor _ color darker. self layoutInset: 4. self useRoundedCorners. self rebuild. fs origin: self position. fs direction: 0@self fullBounds height. self fillStyle: fs.! ! !GraphMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:21'! drawOn: aCanvas | c | cachedForm = nil ifTrue: [ ! c _ Display defaultCanvasClass extent: self extent. c translateBy: self position negated during:[:tempCanvas| self drawDataOn: tempCanvas]. cachedForm _ c form]. aCanvas cache: self bounds using: cachedForm during:[:cachingCanvas| self drawDataOn: cachingCanvas]. self drawCursorOn: aCanvas. ! ! !GraphMorph methodsFor: 'events' stamp: 'jcg 7/1/2001 23:21'! mouseMove: evt | x w | x _ evt cursorPoint x - (self left + borderWidth). w _ self width - (2 * borderWidth). self changed. x < 0 ifTrue: [ cursor _ startIndex + (3 * x). cursor _ (cursor max: 1) min: data size. ^ self startIndex: cursor]. x > w ifTrue: [ cursor _ startIndex + w + (3 * (x - w)). cursor _ (cursor max: 1) min: data size. ^ self startIndex: cursor - w]. cursor _ ((startIndex + x) max: 1) min: data size. ! ! !GraphMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:21'! drawDataOn: aCanvas | yScale baseLine x start end value left top bottom right | super drawOn: aCanv! as. data isEmpty ifTrue: [^ self]. maxVal = minVal ifTrue: [ yScale _ 1. ] ifFalse: [ yScale _ (self height - (2 * borderWidth)) asFloat / (maxVal - minVal)]. baseLine _ self bottom - borderWidth + (minVal * yScale) truncated. left _ top _ 0. right _ 10. bottom _ 0. x _ self left + borderWidth. start _ (startIndex asInteger max: 1) min: data size. end _ (start + self width) min: data size. start to: end do: [:i | left _ x truncated. right _ x + 1. right > (self right - borderWidth) ifTrue: [^ self]. value _ (data at: i) asFloat. value >= 0.0 ifTrue: [ top _ baseLine - (yScale * value) truncated. bottom _ baseLine. ] ifFalse: [ top _ baseLine. bottom _ baseLine - (yScale * value) truncated]. aCanvas fillRectangle: (left@top corner: right@bottom) color: dataColor. x _ x + 1]. ! ! !GraphMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:21'! keepIndexInView: index | w newStart | w _ self width - (2 * borderWidth). index < startIndex! ifTrue: [ newStart _ index - w + 1. ^ self startIndex: (newStart max: 1)]. index > (startIndex + w) ifTrue: [ ^ self startIndex: (index min: data size)]. ! ! !HaloMorph methodsFor: 'events' stamp: 'jcg 7/1/2001 23:32'! containsPoint: aPoint event: anEvent "Blue buttons are handled by the halo" (anEvent isMouse and:[anEvent isMouseDown and:[anEvent blueButtonPressed]]) ifFalse:[^super containsPoint: aPoint event: anEvent]. ^ self bounds containsPoint: anEvent position! ! !HandMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 23:38'! position ^temporaryCursor ifNil: [self bounds topLeft] ifNotNil: [self bounds topLeft - temporaryCursorOffset]! ! !HandMorph methodsFor: 'cursor' stamp: 'jcg 12/31/2001 15:23'! showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset "Set the temporary cursor to the given Form. If the argument is nil, revert to the normal hardware cursor." self changed. temporaryCursorOffset ifNotNil:[ self privateBounds: (self! bounds translateBy: temporaryCursorOffset negated). ]. cursorOrNil == nil ifTrue: [temporaryCursor _ temporaryCursorOffset _ nil] ifFalse: [temporaryCursor _ cursorOrNil asCursorForm. temporaryCursorOffset _ temporaryCursor offset - hotSpotOffset]. self privateBounds: self cursorBounds. self userInitials: userInitials andPicture: (self userPicture); layoutChanged; changed ! ! !HandMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:38'! drawOn: aCanvas | userPic | "Draw the hand itself (i.e., the cursor)." temporaryCursor == nil ifTrue: [aCanvas paintImage: NormalCursor at: self topLeft] ifFalse: [aCanvas paintImage: temporaryCursor at: self topLeft]. self hasUserInformation ifTrue: [ aCanvas text: userInitials at: (self cursorBounds topRight + (0@4)) font: nil color: color. (userPic _ self userPicture) ifNotNil: [ aCanvas paintImage: userPic at: (self cursorBounds topRight + (0@24)) ]. ]. ! ! !HeadingMorph methodsFor: '! events' stamp: 'jcg 7/1/2001 23:18'! mouseMove: evt | v | self changed. v _ evt cursorPoint - self center. degrees _ v theta radiansToDegrees. magnitude _ (v r asFloat / (self width asFloat / 2.0)) min: 1.0. ! ! !ImageMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:24'! drawOn: aCanvas self isOpaque ifTrue:[aCanvas drawImage: image at: self position] ifFalse:[aCanvas paintImage: image at: self position]! ! !ImageMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:24'! drawPostscriptOn: aCanvas | top f2 c2 clrs | clrs _ image colorsUsed. (clrs includes: Color transparent) ifFalse: [^super drawPostscriptOn: aCanvas]. "no need for this, then" top _ aCanvas topLevelMorph. f2 _ Form extent: self extent depth: image depth. c2 _ f2 getCanvas. c2 fillColor: Color white. c2 translateBy: self position negated clippingTo: f2 boundingBox during: [ :c | top fullDrawOn: c ]. aCanvas paintImage: f2 at: self position! ! !InterimSoundMorph methodsF! or: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:19'! addGraphic graphic _ SketchMorph withForm: self speakerGraphic. graphic position: self center - (graphic extent // 2). self addMorph: graphic. ! ! !InternalThreadNavigationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:24'! positionAppropriately | others otherRects overlaps | (self ownerThatIsA: HandMorph) ifNotNil: [^self]. others _ self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]]. otherRects _ others collect: [ :each | each bounds]. self align: self fullBounds bottomRight with: self world bottomRight. self setProperty: #previousWorldBounds toValue: self world bounds. [ overlaps _ false. otherRects do: [ :r | (r intersects: self bounds) ifTrue: [overlaps _ true. self bottom: r top]. ]. self top < self world top ifTrue: [ self bottom: self world bottom. self right: self left - 1. ]. overlaps ] whileTrue.! ! !InterpolatingImageMo! rph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:41'! extent: extentPoint self extent = extentPoint ifFalse: [ cachedImage _ nil. self changed. self privateBounds: (self topLeft extent: extentPoint). self layoutChanged. self changed]. ! ! !MPEGDisplayMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:28'! drawOn: aCanvas "Draw the current frame image, if there is one. Otherwise, fill screen with gray." frameBuffer ifNil: [aCanvas fillRectangle: self bounds color: (Color gray: 0.75)] ifNotNil: [ self extent = frameBuffer extent ifTrue: [aCanvas drawImage: frameBuffer at: self position] ifFalse: [self drawScaledOn: aCanvas]]. ! ! !MPEGDisplayMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 16:07'! drawScaledOn: aCanvas "Draw the current frame image scaled to my bounds." | outForm destPoint warpBlt | ((aCanvas isKindOf: FormCanvas) and: [aCanvas form = Display]) ifTrue: [ "optimization: when canvas is the Display, Warpblt directly t! o it" outForm _ Display. destPoint _ self position + aCanvas origin] ifFalse: [ outForm _ Form extent: self extent depth: aCanvas form depth. destPoint _ 0@0]. warpBlt _ (WarpBlt current toForm: outForm) sourceForm: frameBuffer; colorMap: (frameBuffer colormapIfNeededForDepth: outForm depth); cellSize: 1; "installs a new colormap if cellSize > 1" combinationRule: Form over. outForm == Display ifTrue: [warpBlt clipRect: aCanvas clipRect]. warpBlt copyQuad: frameBuffer boundingBox innerCorners toRect: (destPoint extent: self extent). outForm == Display ifFalse: [ aCanvas drawImage: outForm at: self position]. ! ! !MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 12:12'! computeBounds | subBounds box | (submorphs isNil or:[submorphs isEmpty]) ifTrue:[^self]. box _ nil. submorphs do:[:m| subBounds _ self transform localBoundsToGlobal: m bounds. box ifNil:[box _ subBounds] ifNotNil:[box _ box quickMerge: subBounds! ]. ]. box ifNil:[box _ 0@0 corner: 20@20]. fullBounds _ self privateBounds: box! ! !MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:35'! containsPoint: aPoint self visible ifFalse:[^false]. (self bounds containsPoint: aPoint) ifFalse: [^ false]. self hasSubmorphs ifTrue: [self submorphsDo: [:m | (m fullContainsPoint: (self transform globalPointToLocal: aPoint)) ifTrue: [^ true]]. ^ false] ifFalse: [^ true]! ! !MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:36'! handleBoundsChange: aBlock | oldBounds newBounds | oldBounds _ self bounds. aBlock value. newBounds _ self bounds. self boundsChangedFrom: oldBounds to: newBounds.! ! !MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:29'! rotationCenter | pt | pt _ self transform localPointToGlobal: super rotationCenter. ^ pt - self position / self extent asFloatPoint! ! !MatrixTransformMorph methodsFor: 'geometry' stamp: 'jcg 12/31/20! 01 15:30'! rotationCenter: aPoint super rotationCenter: (self transform globalPointToLocal: self position + (self extent * aPoint))! ! !FlashShapeMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:08'! computeBounds self privateBounds: (self transform localBoundsToGlobal: (shape bounds)).! ! !FlashSpriteMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 22:09'! stepToFrame: frame "Step to the given frame" | fullRect postDamage lastVisible resortNeeded | frame = frameNumber ifTrue:[^self]. frame > loadedFrames ifTrue:[^self]. postDamage _ damageRecorder isNil. postDamage ifTrue:[damageRecorder _ FlashDamageRecorder new]. lastVisible _ nil. resortNeeded _ false. submorphs do:[:m| (m isFlashMorph and:[m isFlashCharacter]) ifTrue:[ m stepToFrame: frame. m visible ifTrue:[ (lastVisible notNil and:[lastVisible depth < m depth]) ifTrue:[resortNeeded _ true]. lastVisible _ m. (self bounds containsRect: m bounds) ifFalse: [ self privateB! ounds: (self bounds merge: m bounds)]. ]. ]. ]. resortNeeded ifTrue:[submorphs _ submorphs sortBy:[:m1 :m2| m1 depth > m2 depth]]. frameNumber _ frame. playing ifTrue:[ self playSoundsAt: frame. self executeActionsAt: frame. ]. (postDamage and:[owner notNil]) ifTrue:[ damageRecorder updateIsNeeded ifTrue:[ "fullRect _ damageRecorder fullDamageRect. fullRect _ (self transform localBoundsToGlobal: fullRect)." fullRect _ self bounds. owner invalidRect: (fullRect insetBy: -1) from: self. ]. ]. postDamage ifTrue:[ damageRecorder _ nil].! ! !FlashPlayerMorph methodsFor: 'initialize' stamp: 'jcg 9/4/2001 10:02'! initialize super initialize. color _ Color white. self loopFrames: true. localBounds _ self bounds. activationKeys _ #(). activeMorphs _ SortedCollection new: 50. activeMorphs sortBlock:[:m1 :m2| m1 depth > m2 depth]. progressValue _ ValueHolder new. progressValue contents: 0.0. self defaultAALevel: 2. self deferred: true.! ! ! !FlashPlayerMorph methodsFor: 'initialize' stamp: 'jcg 7/1/2001 22:36'! openInMVC | window extent | self localBounds: localBounds. extent _ self extent. window _ FlashPlayerWindow labelled:'Flash Player'. window model: (FlashPlayerModel player: self). window addMorph: self frame:(0@0 corner: 1@1). window openInMVCExtent: extent! ! !FlashPlayerMorph methodsFor: 'initialize' stamp: 'jcg 7/1/2001 22:37'! openInWorld | window extent | self localBounds: localBounds. extent _ self extent. window _ FlashPlayerWindow labelled:'Flash Player'. window model: (FlashPlayerModel player: self). window addMorph: self frame:(0@0 corner: 1@1). window openInWorldExtent: extent! ! !FlashPlayerMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:38'! localBounds: newBounds localBounds _ newBounds. self privateBounds: (self position extent: newBounds extent // 20). transform _ MatrixTransform2x3 transformFromLocal: newBounds toGlobal: self bounds! ! !FlashPlayer! Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:38'! fullBounds "The player clips its children" ^ self bounds! ! !FlashPlayerMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:38'! fullContainsPoint: pt "The player clips its children" (self bounds containsPoint: pt) ifFalse:[^false]. ^super fullContainsPoint: pt! ! !MenuLineMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:49'! drawOn: aCanvas | pref | aCanvas fillRectangle: (self topLeft corner: self bounds rightCenter) color: ((pref _ Preferences menuColorFromWorld) ifTrue: [owner color darker] ifFalse: [Preferences menuLineUpperColor]). aCanvas fillRectangle: (self bounds leftCenter corner: self bottomRight) color: (pref ifTrue: [owner color lighter] ifFalse: [Preferences menuLineLowerColor])! ! !Morph class methodsFor: 'instance creation' stamp: 'jcg 7/1/2001 12:47'! newBounds: bounds | newMorph | "Changed because 'privateBounds:' now returns 'b! ounds' rather than 'self'" (newMorph _ self new) privateBounds: bounds. ^ newMorph ! ! !Morph class methodsFor: 'instance creation' stamp: 'jcg 7/1/2001 12:06'! newBounds: bounds color: color "Changed to allow 'privateBounds:' to return the new value of 'bounds' rather than 'self'" ^ (self newBounds: bounds) privateColor: color ! ! !MorphicModel methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:16'! recomputeBounds | bnds | bnds _ submorphs first bounds. self privateBounds: (bnds origin corner: bnds corner). "copy it!!" self privateBounds: (self fullBounds). ! ! !MorphicModel methodsFor: 'printing' stamp: 'jcg 7/1/2001 23:05'! initString ^ String streamContents: [:s | s nextPutAll: self class name; nextPutAll: ' newBounds: ('; print: self bounds; nextPutAll: ') model: self slotName: '; print: slotName]! ! !NetworkTerminalMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:22'! initialize super initialize. backgroundForm _ ( (StringMor! ph contents: '......' font: (TextStyle default fontOfSize: 24)) color: Color white ) imageForm. self privateBounds: backgroundForm boundingBox. ! ! !NetworkTerminalMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:32'! drawOn: aCanvas backgroundForm ifNotNil: [ aCanvas clipBy: self bounds during: [ :c | c drawImage: backgroundForm at: self topLeft ]. ]. ! ! !NetworkTerminalMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:32'! forceToFront: aRegion | highQuality | "force the given region from the drawing form onto the background form" highQuality _ false. "highQuality is slower" self updateBackgroundForm. backgroundForm copy: aRegion from: aRegion topLeft in: decoder drawingForm rule: Form over. self invalidRect: ( highQuality ifTrue: [ self bounds ] ifFalse: [ (aRegion expandBy: 4) translateBy: self topLeft "try to remove gribblys" ] ) ! ! !NetworkTerminalMorph methodsFor: 'event handling' stamp: 'jcg 7/1/2001 23:32'! send! Event: evt self sendEventAsIs: (evt translatedBy: self topLeft negated).! ! !NullTerminalMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:34'! extent: newExtent | aPoint | aPoint _ 50@50. self extent = aPoint ifFalse: [ self changed. self privateBounds: (self position extent: aPoint). self layoutChanged. self changed ]. eventEncoder sendViewExtent: newExtent! ! !PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:41'! init3 "Just a record of how we loaded in the latest paintbox button images" | bb rect lay pic16Bit aa blt on thin | self loadoffImage: 'etoy_default.gif'. self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [button offImage: nil] ifFalse: [button position: button position + (100@0)]]. (bb _ self submorphNamed: #keep:) position: bb position + (100@0). (bb _ self submorphNamed: #toss:) position: bb position + (100@0). (bb _ self submorphNamed: #undo:) position: bb position + (100! @0). "Transparent is (Color r: 1.0 g: 0 b: 1.0)" self moveButtons. self loadOnImage: 'etoy_in.gif'. AllOnImage _ nil. 'save space'. self loadPressedImage: 'etoy_in.gif'. AllPressedImage _ nil. 'save space'. self loadCursors. "position the stamp buttons" stampHolder stampButtons owner last delete. stampHolder pickupButtons last delete. stampHolder stampButtons: (stampHolder stampButtons copyFrom: 1 to: 3). stampHolder pickupButtons: (stampHolder pickupButtons copyFrom: 1 to: 3). "| rect |" stampHolder pickupButtons do: [:button | "PopUpMenu notify: 'Rectangle for ',sel." rect _ Rectangle fromUser. button bounds: rect. "image is nil" ]. "| rect lay |" stampHolder clear. stampHolder stampButtons do: [:button | button offImage: nil; pressedImage: nil. lay _ button owner. "PopUpMenu notify: 'Rectangle for ',sel." rect _ Rectangle fromUser. button image: (Form fromDisplay: (rect insetBy: 2)). lay borderWidth: 2. lay bounds: rect. "image is nil" ]. "| pic! 16Bit blt aa on |" pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: 'etoy_in.gif'. aa _ Form extent: OriginalBounds extent depth: 8. blt _ BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. "Collect all the images for the buttons in the on state" stampHolder pickupButtons do: [:button | on _ ColorForm extent: button extent depth: 8. on colors: pic16Bit colors. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button image: on; pressedImage: on; offImage: nil. ]. self invalidRect: self bounds. ((self submorphNamed: #erase:) arguments at: 3) offset: (12@35). ((self submorphNamed: #eyedropper:) arguments at: 3) offset: (0@0). ((self submorphNamed: #fill:) arguments at: 3) offset: (10@44). ((self submorphNamed: #paint:) arguments at: 3) offset: (3@3). "unused" ((self submorphNamed: #rect:) arguments at: 3) off! set: (6@17). ((self submorphNamed: #ellipse:) arguments at: 3) offset: (5@4). ((self submorphNamed: #polygon:) arguments at: 3) offset: (5@4). ((self submorphNamed: #line:) arguments at: 3) offset: (5@17). ((self submorphNamed: #star:) arguments at: 3) offset: (2@5). thumbnail delete. thumbnail _ nil. (submorphs select: [:e | e class == RectangleMorph]) first bounds: Rectangle fromUser. (submorphs select: [:e | e class == RectangleMorph]) first borderWidth: 1; borderColor: Color black. "| thin |" submorphs do: [:ss | ss class == ImageMorph ifTrue: [thin _ ss "first"]]. colorMemoryThin _ thin. ! ! !PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:43'! init4 "Just a record of how Ted loaded in the paintbox button images, Feb 98" | bb im pp newImage pic24Bit picNewBit blt | "self loadoffImage: 'roundedPalette3.bmp'." pic24Bit _ GIFReadWriter formFromServerFile: 'updates/137roundedPalette3.bmp'. picNewBit _ Form extent: pic24Bit extent depth: 16. pic24Bit! displayOn: picNewBit. OriginalBounds _ picNewBit boundingBox. AllOffImage _ Form extent: OriginalBounds extent depth: 16. blt _ BitBlt current toForm: AllOffImage. blt sourceForm: picNewBit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. AllOffImage mapColor: Color transparent to: Color black. self image: AllOffImage. self invalidRect: self bounds. self submorphsDo: [:button | button position: button position + (10@10)]. (im _ submorphs at: 28) class == ImageMorph ifTrue: [ im position: im position + (2@0)]. "color picker" "exercise it once" (bb _ self submorphNamed: #keep:) position: bb position + (0@25). (bb _ self submorphNamed: #toss:) position: bb position + (0@25). (bb _ self submorphNamed: #undo:) position: bb position + (0@-25). (bb _ self submorphNamed: #clear:) position: bb position + (0@-25). (bb _ self submorphNamed: #undo:) position: bb position + (0@-69). (bb _ self submorphNamed: #clear:) position: bb position + (0@-6! 9). self submorphsDo: [:button | button class == AlignmentMorph ifTrue: [ button position: button position + (0@25)]. (button printString includesSubString: 'stamp:') ifTrue: [ button position: button position + (0@25)]]. (bb _ self submorphNamed: #prevStamp:) position: bb position + (0@25). (bb _ self submorphNamed: #nextStamp:) position: bb position + (0@25). bb _ self submorphNamed: #keep:. newImage _ bb pressedImage copy: (0@4 corner: (bb pressedImage boundingBox extent)). bb onImage: newImage. bb pressedImage: newImage. bb extent: newImage extent. bb position: bb position + (4@1). pp _ (bb _ self submorphNamed: #toss:) pressedImage. newImage _ pp copy: (0@4 corner: (bb pressedImage extent - (3@0))). bb onImage: newImage. bb pressedImage: newImage. bb extent: newImage extent. bb position: bb position + (3@1). pp _ (bb _ self submorphNamed: #undo:) pressedImage. newImage _ pp copy: (0@0 corner: (bb pressedImage extent - (3@5))). bb onImage: newImage. bb pr! essedImage: newImage. bb extent: newImage extent. bb position: bb position + (3@-1). pp _ (bb _ self submorphNamed: #clear:) pressedImage. newImage _ pp copy: (0@0 corner: (bb pressedImage extent - (0@5))). bb onImage: newImage. bb pressedImage: newImage. bb extent: newImage extent. bb position: bb position + (3@-1). pic24Bit _ GIFReadWriter formFromServerFile: 'updates/137pencil.bmp'. picNewBit _ Form extent: pic24Bit extent depth: 16. pic24Bit displayOn: picNewBit. newImage _ picNewBit as8BitColorForm. newImage transparentColor: (Color r: 0 g: 0 b: 0). (bb _ self submorphNamed: #erase:) pressedImage: newImage; onImage: newImage; extent: newImage extent. bb position: bb position + (-11@-1). ! ! !PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:42'! loadOnImage: fileName "Read in and convert the image for the paintBox with the buttons on. A .bmp 24-bit image. For each button, cut that chunk out and save it." " self loadOnImage: 'NoSh_on.bmp'. ! AllOnImage _ nil. 'save space'. " | pic16Bit blt aa on type | type _ 'gif'. " gif or bmp " type = 'gif' ifTrue: [ pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: fileName. pic16Bit display. aa _ AllOnImage _ Form extent: OriginalBounds extent depth: 8. blt _ BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. ]. type = 'bmp' ifTrue: [ pic16Bit _ (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. pic16Bit display. aa _ AllOnImage _ Form extent: OriginalBounds extent depth: 16. blt _ BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. aa mapColor: Color transparent to: Color black. ]. "Collect all the images for the buttons in the on state" self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ type = 'gif' ifTrue: [on _ ColorForm extent: button ! extent depth: 8. on colors: pic16Bit colors] ifFalse: [on _ Form extent: button extent depth: 16]. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button onImage: on]]. self invalidRect: self bounds. ! ! !PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:43'! loadPressedImage: fileName "Read in and convert the image for the paintBox with the buttons on. A .bmp 24-bit image. For each button, cut that chunk out and save it." " self loadPressedImage: 'NoSh_on.bmp'. AllPressedImage _ nil. 'save space'. " | pic16Bit blt aa on type | type _ 'gif'. " gif or bmp " type = 'gif' ifTrue: [ pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: fileName. pic16Bit display. aa _ AllPressedImage _ Form extent: OriginalBounds extent depth: 8. blt _ BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits! . ]. type = 'bmp' ifTrue: [ pic16Bit _ (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. pic16Bit display. aa _ AllPressedImage _ Form extent: OriginalBounds extent depth: 16. blt _ BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. aa mapColor: Color transparent to: Color black. ]. "Collect all the images for the buttons in the on state" self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ type = 'gif' ifTrue: [on _ ColorForm extent: button extent depth: 8. on colors: pic16Bit colors] ifFalse: [on _ Form extent: button extent depth: 16]. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button pressedImage: on]]. self invalidRect: self bounds. ! ! !PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:42'! loadoffImage: fileName "Read in and convert the back! ground image for the paintBox. All buttons off. A .bmp 24-bit image." " Prototype loadoffImage: 'roundedPalette3.bmp' " | pic16Bit blt type getBounds | type _ 'bmp'. " gif or bmp " getBounds _ 'fromPic'. "fromUser = draw out rect of paintbox on image" "fromOB = just read in new bits, keep same size and place as last time." "fromPic = picture is just the PaintBox, use its bounds" type = 'gif' ifTrue: [ pic16Bit "really 8" _ GIFReadWriter formFromFileNamed: fileName. getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds" pic16Bit display. OriginalBounds _ Rectangle fromUser]. getBounds = 'fromPic' ifTrue: [OriginalBounds _ pic16Bit boundingBox]. ]. "Use OriginalBounds as it was last time". type = 'bmp' ifTrue: [ pic16Bit _ (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds" pic16Bit display. OriginalBounds _ Rectangle fromUser]. "Use OriginalBounds as it was! last time". (getBounds = 'fromPic') ifTrue: [OriginalBounds _ pic16Bit boundingBox]. AllOffImage _ Form extent: OriginalBounds extent depth: 16. ]. type = 'gif' ifTrue: [ AllOffImage _ ColorForm extent: OriginalBounds extent depth: 8. AllOffImage colors: pic16Bit colors]. blt _ BitBlt current toForm: AllOffImage. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. type = 'bmp' ifTrue: [AllOffImage mapColor: Color transparent to: Color black]. self image: AllOffImage. self invalidRect: self bounds. ! ! !PaintBoxMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:42'! noVeneer "For a palette with a background (off) image, clear that image. But first, for each button, cut that chunk out and save it in the offImage part." " self noVeneer. AllOffImage _ nil. 'save space. irreversible'. " | aa on | AllOffImage ifNil: [AllOffImage _ image]. aa _ AllOffImage. "Collect all the images for the b! uttons in the on state" self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ on _ Form extent: button extent depth: 16. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button offImage: on]]. self image: (Form extent: AllOffImage extent depth: 1). self invalidRect: self bounds. ! ! !PaintBoxMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 22:41'! maxBounds | rr | "fullBounds if all flop-out parts of the paintBox were showing." rr _ self bounds merge: colorMemory bounds. rr _ rr merge: (self submorphNamed: 'stamps') bounds. rr _ rr origin corner: rr corner + (0@ (self submorphNamed: 'shapes') height + 10 "what is showing of (self submorphNamed: #toggleShapes) height"). ^ rr! ! !PaintBoxMorph methodsFor: 'recent colors' stamp: 'jcg 12/31/2001 15:38'! fixUpRecentColors | inner outer border box form newImage canvas morph | self fixUpColorPicker. recentColors _ WriteSt! ream on: Array new. form _ image. newImage _ Form extent: form extent + (0@41) depth: form depth. form displayOn: newImage. newImage copy: ((0@(form height-10)) extent: form width @ (newImage height - form height + 10)) from: 0 @ (form height - (newImage height - form height + 10)) in: form rule: Form over. canvas _ newImage getCanvas. canvas line: 12@(form height-10) to: 92@(form height-10) width: 1 color: Color black. canvas _ canvas copyOffset: 12@(form height-9). inner _ (Color r: 0.677 g: 0.71 b: 0.968). outer _ inner darker darker. border _ (Color r: 0.194 g: 0.258 b: 0.194). 0 to: 1 do:[:y| 0 to: 3 do:[:x| box _ (x*20) @ (y*20) extent: 20@20. morph _ BorderedMorph new bounds: ((box insetBy: 1) translateBy: canvas origin + self position). morph borderWidth: 1; borderColor: border; color: Color white; on: #mouseDown send: #mouseDownRecent:with: to: self; on: #mouseMove send: #mouseStillDownRecent:with: to:! self; on: #mouseUp send: #mouseUpRecent:with: to: self. self addMorphFront: morph. recentColors nextPut: morph. canvas fillRectangle: box color: Color white. canvas frameRectangle: (box insetBy: 1) color: border. canvas frameRectangle: (box) color: inner. box _ box insetBy: 1. canvas line: box topRight to: box bottomRight width: 1 color: outer. canvas line: box bottomLeft to: box bottomRight width: 1 color: outer. ]]. recentColors _ recentColors contents. (RecentColors == nil or:[RecentColors size ~= recentColors size]) ifTrue:[ RecentColors _ recentColors collect:[:each| each color]. ] ifFalse:[ RecentColors keysAndValuesDo:[:idx :aColor| (recentColors at: idx) color: aColor]. ]. self image: newImage. self toggleStamps. self toggleStamps.! ! !PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'jcg 7/1/2001 23:29'! positionNear: aPoint forExtent: anExtent adjustmentSuggestion: adjustmentPoint "Compute a plausible positioning for a! dding a subpart of size anExtent, somewhere near aPoint, using adjustmentPoint as the unit of adjustment" | adjustedPosition | adjustedPosition _ aPoint. [((self morphsAt: (adjustedPosition + (anExtent // 2))) size > 1) and: "that 1 is self here" [self bounds containsPoint: adjustedPosition]] whileTrue: [adjustedPosition _ adjustedPosition + adjustmentPoint]. ^ adjustedPosition! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'jcg 7/1/2001 23:29'! showApplicationView self transformToShow: (self valueOfProperty: #applicationViewBounds ifAbsent: [self bounds]) ! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'jcg 7/1/2001 23:29'! showFactoryView self transformToShow: (self valueOfProperty: #factoryViewBounds ifAbsent: [self bounds]) ! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'jcg 7/1/2001 23:29'! showFullView self transformToShow: self bounds ! ! !PasteUpMorph methodsFor: 'project state' stamp: 'jcg 12/31/2001 15:41'! viewBox: newViewBox ! "I am now displayed within newViewBox; react." (self viewBox == nil or: [self viewBox extent ~= newViewBox extent]) ifTrue: [ worldState canvas: nil]. worldState viewBox: newViewBox. super position: newViewBox topLeft. fullBounds _ (self privateBounds: newViewBox). "Paragraph problem workaround; clear selections to avoid screen droppings." self flag: #arNote. "Probably unnecessary" worldState handsDo: [:hand | hand releaseKeyboardFocus]. self fullRepaintNeeded! ! !PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:27'! addMorph: aMorph centeredNear: aPoint "Add the given morph to this world, attempting to keep its center as close to the given point possible while also keeping the it entirely within the bounds of this world." | trialRect delta | trialRect _ Rectangle center: aPoint extent: aMorph fullBounds extent. delta _ trialRect amountToTranslateWithin: self bounds. aMorph position: trialRect origin + delta. self addMorph: aMo! rph. ! ! !PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'! extent: aPoint super extent: aPoint. worldState ifNotNil: [ worldState viewBox ifNotNil: [ worldState canvas: nil. worldState viewBox: self bounds ]. ].! ! !PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'! fullContainsPoint: pt "The world clips its children" worldState ifNil: [^super fullContainsPoint: pt]. ^ self bounds containsPoint: pt ! ! !PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'! installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString | window howToOpen tm boundsForWorld | howToOpen _ self embeddedProjectDisplayMode. "#scaled may be the only one that works at the moment" submorphs do: [:ss | ss owner == nil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." boundsForWorld _ howToOpen == #naked ifTrue: [newBounds] ifFalse: [self bounds]. worldState canva! s: nil. worldState viewBox: boundsForWorld. self bounds: boundsForWorld. "self viewBox: Display boundingBox." "worldState handsDo: [:h | h initForEvents]." self installFlaps. "SystemWindow noteTopWindowIn: self." "self displayWorldSafely." howToOpen == #naked ifTrue: [ enclosingWorld addMorphFront: self. ]. howToOpen == #window ifTrue: [ window _ (NewWorldWindow labelled: aString) model: self. window addMorph: self frame: (0@0 extent: 1.0@1.0). window openInWorld: enclosingWorld. ]. howToOpen == #frame ifTrue: [ window _ AlignmentMorphBob1 new minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. window addMorph: self. window openInWorld: enclosingWorld. ]. howToOpen == #scaled ifTrue: [ self position: 0@0. window _ EmbeddedWorldBorderMorph new minWidth: 100; minHeight: 100; borderWidth: 8; borderColor: Color green; bounds: newBounds. tm _ BOBTransformationMorph new. ! window addMorph: tm. tm addMorph: self. window openInWorld: enclosingWorld. tm changeWorldBoundsToShow: self bounds. self arrangeToStartSteppingIn: enclosingWorld. "tm scale: (tm width / self width min: tm height / self height) asFloat." ]. ! ! !PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:29'! optimumExtentFromAuthor | opt | ^self valueOfProperty: #optimumExtentFromAuthor ifAbsent: [ opt _ self extent. self setProperty: #optimumExtentFromAuthor toValue: opt. ^opt ] ! ! !PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:30'! paintArea "What rectangle should the user be allowed to create a new painting in?? An area beside the paintBox. Allow playArea to override with its own bounds!! " | playfield paintBoxBounds | playfield _ self submorphNamed: 'playfield' ifNone: [nil]. playfield ifNotNil: [^ playfield bounds]. paintBoxBounds _ self paintBox bounds. self firstHand targetOffset x < paintBoxBounds cen! ter x ifTrue: [^ self topLeft corner: paintBoxBounds left@self bottom] "paint on left side" ifFalse: [^ paintBoxBounds right@self top corner: self bottomRight]. "paint on right side" ! ! !PasteUpMorph methodsFor: 'world state' stamp: 'jcg 7/1/2001 23:30'! privateMoveBy: delta super privateMoveBy: delta. worldState ifNotNil: [ worldState viewBox ifNotNil: [ worldState viewBox: self bounds ]. ].! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'jcg 7/1/2001 23:30'! bringWindowsFullOnscreen "Make ever SystemWindow on the desktop be totally on-screen, whenever possible." (SystemWindow windowsIn: self satisfying: [:w | true]) do: [:aWindow | aWindow right: (aWindow right min: self right). aWindow bottom: (aWindow bottom min: self bottom). aWindow left: (aWindow left max: self left). aWindow top: (aWindow top max: self top)]! ! !GeeBookPageMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:31'! fullDrawOn: aCanvas aCanvas ! translateTo: self topLeft + aCanvas origin - geeMailRectangle origin clippingTo: (self bounds translateBy: aCanvas origin) during: [ :c | geeMail disablePageBreaksWhile: [geeMail fullDrawOn: c]. ]. ! ! !PianoRollNoteMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:35'! fullBounds selected ifTrue: [^ self bounds expandBy: 1] ifFalse: [^ self bounds]! ! !PianoRollNoteMorph methodsFor: 'selecting' stamp: 'jcg 12/31/2001 15:43'! selectNotes: evt | lastMorph oldEnd saveOwner | saveOwner _ owner. (owner autoScrollForX: evt cursorPoint x) ifTrue: ["If scroll talkes place I will be deleted and my x-pos will become invalid." owner _ saveOwner. self privateBounds: (self bounds withLeft: (owner xForTime: self noteInScore time))]. oldEnd _ owner selection last. (owner notesInRect: (evt cursorPoint x @ owner top corner: owner bottomRight)) do: [:m | m trackIndex = trackIndex ifTrue: [m deselect]]. self select. lastMorph _ self. (owner notesInRect:! (self left @ owner top corner: evt cursorPoint x @ owner bottom)) do: [:m | m trackIndex = trackIndex ifTrue: [m select. lastMorph _ m]]. owner selection: (Array with: trackIndex with: indexInTrack with: lastMorph indexInTrack). lastMorph indexInTrack ~= oldEnd ifTrue: ["Play last note as selection grows or shrinks" owner ifNotNil: [lastMorph playSound]] ! ! !PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'! fullBounds "Overridden to clip submorph hit detection to my bounds." fullBounds ifNil: [fullBounds _ self bounds]. ^ fullBounds ! ! !PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'! layoutChanged "Override this to avoid propagating 'layoutChanged' when just adding/removing note objects." fullBounds = self bounds ifTrue: [^ self]. super layoutChanged. ! ! !PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'! midiKeyForY: y ^ lowestNote - ((y - (self bottom - borderWidth - 4)) // 3) ! !! !PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'! timeForX: aNumber ^ ((aNumber - self left - borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! ! !PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'! xForTime: aNumber ^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + self left + borderWidth ! ! !PianoRollScoreMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:22'! yForMidiKey: midiKey ^ (self bottom - borderWidth - 4) - (3 * (midiKey - lowestNote)) ! ! !PinMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:40'! updateImage "pinForm was made for right side. Rotate/flip for other sides" self left < owner left ifTrue: "left side" [^ self image: (pinForm flipBy: #horizontal centerAt: 0@0)]. self bottom > owner bottom ifTrue: "bottom" [^ self image: ((pinForm rotateBy: #left centerAt: 0@0) flipBy: #vertical centerAt: 0@0)]. self right > owner right ifTrue: "right side" [^ self im! age: pinForm]. self top < owner top ifTrue: "top" [^ self image: (pinForm rotateBy: #left centerAt: 0@0)]. self halt: 'uncaught pin geometry case'! ! !PinMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:40'! wiringEndPoint | side | side _ owner bounds sideNearestTo: self center. side = #left ifTrue: [^ self position + (0@4)]. side = #bottom ifTrue: [^ self position + (4@7)]. side = #right ifTrue: [^ self position + (7@4)]. side = #top ifTrue: [^ self position + (4@0)]! ! !PolygonMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'! containsPoint: aPoint (super containsPoint: aPoint) ifFalse: [^ false]. closed & color isTransparent not ifTrue: [^ (self filledForm pixelValueAt: aPoint - self topLeft + 1) > 0]. self lineSegmentsDo: [:p1 :p2 | (aPoint onLineFrom: p1 to: p2 within: (3 max: borderWidth+1//2) asFloat) ifTrue: [^ true]]. self arrowForms do: [:f | (f pixelValueAt: aPoint - f offset) > 0 ifTrue: [^ true]]. ^ false! ! !Polygon! Morph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'! extent: newExtent "Not really advisable, but we can preserve most of the geometry if we don't shrink things too small." | safeExtent center | center _ self referencePosition. safeExtent _ newExtent max: 20@20. self setVertices: (vertices collect: [:p | p - center * (safeExtent asFloatPoint / (self extent max: 1@1)) + center])! ! !PolygonMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'! flipHAroundX: centerX "Flip me horizontally around the center. If centerX is nil, compute my center of gravity." | cent | cent _ centerX ifNil: [self center x "cent _ 0. vertices do: [:each | cent _ cent + each x]. cent asFloat / vertices size"] "average is the center" ifNotNil: [centerX]. self setVertices: (vertices collect: [:vv | (vv x - cent) * -1 + cent @ vv y]) reversed.! ! !PolygonMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:26'! flipVAroundY: centerY "Flip me vertically around ! the center. If centerY is nil, compute my center of gravity." | cent | cent _ centerY ifNil: [self center y "cent _ 0. vertices do: [:each | cent _ cent + each y]. cent asFloat / vertices size"] "average is the center" ifNotNil: [centerY]. self setVertices: (vertices collect: [:vv | vv x @ ((vv y - cent) * -1 + cent)]) reversed.! ! !PolygonMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:26'! drawOnFormCanvas: aCanvas "Display the receiver, a spline curve, approximated by straight line segments." | | vertices size < 1 ifTrue: [self error: 'a polygon must have at least one point']. closed & color isTransparent not ifTrue: [aCanvas stencil: self filledForm at: self topLeft - 1 color: color]. (borderColor isColor and: [borderColor isTranslucentColor]) ifTrue: [aCanvas stencil: self borderForm at: self topLeft color: borderColor] ifFalse: [self drawBorderOn: aCanvas]. self arrowForms do: [:f | aCanvas stencil: f at: f offset co! lor: (borderColor isColor ifTrue: [borderColor] ifFalse: [color])]! ! !PolygonMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:26'! borderForm "A form must be created for drawing the border whenever the borderColor is translucent." | borderCanvas | borderForm ifNotNil: [^ borderForm]. borderCanvas _ (Display defaultCanvasClass extent: self extent depth: 1) shadowColor: Color black. borderCanvas translateBy: self topLeft negated during:[:tempCanvas| self drawBorderOn: tempCanvas]. borderForm _ borderCanvas form. self arrowForms do: [:f | "Eliminate overlap between line and arrowheads if transparent." borderForm copy: f boundingBox from: f to: f offset - self position rule: Form erase]. ^ borderForm! ! !PolygonMorph methodsFor: 'private' stamp: 'jcg 12/31/2001 15:44'! computeBounds | oldBounds delta excludeHandles | vertices ifNil: [^ self]. self changed. oldBounds _ self bounds. self releaseCachedState. self privateBounds: (self curveBounds). se! lf arrowForms do: [:f | self privateBounds: (self bounds merge: (f offset extent: f extent))]. handles ifNotNil: [self updateHandles]. "since we are directly updating bounds, see if any ordinary submorphs exist and move them accordingly" (oldBounds notNil and: [(delta _ self position - oldBounds origin) ~= (0@0)]) ifTrue: [ excludeHandles _ IdentitySet new. handles ifNotNil: [excludeHandles addAll: handles]. self submorphsDo: [ :each | (excludeHandles includes: each) ifFalse: [ each position: each position + delta ]. ]. ]. self layoutChanged. self changed. ! ! !PolygonMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:26'! filledForm "Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1@1 in the form. This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside. Computation of the filled form is done only on de! mand." | bb origin | closed ifFalse: [^ filledForm _ nil]. filledForm ifNotNil: [^ filledForm]. filledForm _ Form extent: self extent+2. "Draw the border..." bb _ (BitBlt current toForm: filledForm) sourceForm: nil; fillColor: Color black; combinationRule: Form over; width: 1; height: 1. origin _ self topLeft asIntegerPoint-1. self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin to: p2 asIntegerPoint-origin]. "Fill it in..." filledForm convexShapeFill: Color black. (borderColor isColor and: [borderColor isTranslucentColor]) ifTrue: ["If border is stored as a form, then erase any overlap now." filledForm copy: self borderForm boundingBox from: self borderForm to: 1@1 rule: Form erase]. ^ filledForm! ! !BlobMorph methodsFor: 'stepping' stamp: 'jcg 7/1/2001 23:27'! adjustColors "Bob Arning " "Color mixing - Sean McGrath " | nearbyColors center r degrees | center _ self center. ! nearbyColors _ vertices collect: [:each | degrees _ (each - center) degrees. r _ (each - center) r. Display colorAt: (Point r: r + 6 degrees: degrees) + center]. self color: ((self color alphaMixed: 0.95 with: (Color r: (nearbyColors collect: [:each | each red]) average g: (nearbyColors collect: [:each | each green]) average b: (nearbyColors collect: [:each | each blue]) average)) alpha: self color alpha). sneaky ifFalse: [self color: color negated]! ! !PoohTestMorph methodsFor: 'event handling' stamp: 'jcg 7/1/2001 23:31'! mouseMove: evt (lastPoint notNil and:[(lastPoint dist: evt position) < 5]) ifTrue:[^self]. lastPoint _ evt position. points ifNil:[points _ WriteStream on: (Array new: 100)]. points nextPut: (evt position - self position). self changed.! ! !PoohTestMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:31'! drawOn: aCanvas | ptList last | super drawOn: aCanvas. aCanvas translateBy: self topLeft clippingTo: self inn! erBounds during:[:cc| points ifNotNil:[ points class == Array ifTrue:[ptList _ points] ifFalse:[ptList _ points contents]. last _ ptList last. ptList do:[:next| cc line: last to: next width: 5 color: (Color gray: 0.9). last _ next]]. self drawSubdivisionTrianglesOn: cc. self drawSubdivisionEdgesOn: cc. self drawSubdivisionSpineOn: cc. ]. time ifNotNil:[ aCanvas text: time printString,' msecs' bounds: self innerBounds font: nil color: Color black. ].! ! !ProjectViewMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:44'! fullDrawPostscriptOn: aCanvas | f | "handle the fact that we have the squished text within" f _ self imageForm. f offset: 0@0. aCanvas paintImage: f at: self topLeft. ! ! !ProjectViewMorph methodsFor: 'events' stamp: 'jcg 7/1/2001 22:44'! extent: aPoint "Set my image form to the given extent." | newExtent scaleP scale | ((self extent = aPoint) and: [image depth = Display depth]) ifFalse: [ lastProject! Thumbnail ifNil: [ lastProjectThumbnail _ image ]. scaleP _ aPoint / lastProjectThumbnail extent. scale _ scaleP "scaleP x asFloat max: scaleP y asFloat". newExtent _ (lastProjectThumbnail extent * scale) rounded. self image: (Form extent: newExtent depth: Display depth). self updateImageFrom: lastProjectThumbnail. ]. self updateNamePosition.! ! !RulerMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:18'! drawOn: aCanvas | s | super drawOn: aCanvas. s _ self width printString, 'x', self height printString. aCanvas text: s bounds: (self bounds insetBy: borderWidth + 5) font: nil color: Color red. ! ! !ScreeningMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:11'! layoutChanged screenForm _ nil. submorphs size >= 2 ifTrue: [self disableDragNDrop] ifFalse: [self enableDragNDrop]. submorphs size = 2 ifTrue: [ self privateBounds: ((self sourceMorph bounds merge: self screenMorph bounds) expandBy: 4)]. ^ super layoutChanged! ! ! !ScriptEditorMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:23'! addNewRow | row | row _ AlignmentMorph newRow vResizing: #spaceFill; layoutInset: 0; borderWidth: 0; extent: (self width)@(TileMorph defaultH); color: Color transparent. self addMorphBack: row. ^ row ! ! !ScriptEditorMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:23'! insertTileRow: tileList after: index "Return a row to be used to insert an entire row of tiles." | row | row _ AlignmentMorph newRow vResizing: #spaceFill; layoutInset: 0; extent: (self width)@(TileMorph defaultH); color: Color transparent. row addAllMorphs: tileList. self privateAddMorph: row atIndex: index + 1. ! ! !ScrollPane methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:48'! leftoverScrollRange "Return the entire scrolling range minus the currently viewed area." scroller submorphBounds ifNil: [^ 0]. ^ (self totalScrollRange - self height roundTo: self scrollDeltaHeight) max: 0 ! ! !ScrollPane ! methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:06'! resizeScrollBar | w topLeft | w _ self scrollbarWidth. topLeft _ scrollBarOnLeft ifTrue: [retractableScrollBar ifTrue: [self topLeft - (w-borderWidth@0)] ifFalse: [self topLeft + (borderWidth-1@0)]] ifFalse: [retractableScrollBar ifTrue: [self topRight - (borderWidth@0)] ifFalse: [self topRight - (w+borderWidth-1@0)]]. scrollBar bounds: (topLeft extent: w @ self height)! ! !AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 16:00'! extraScrollRange ^ self height ! ! !AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:08'! scrollSelectionIntoView: event alignTop: alignTop inTextMorph: tm "Scroll my text into view if necessary and return true, else return false" | selRects delta selRect rectToTest transform cpHere | selRects _ tm paragraph selectionRects. selRects isEmpty ifTrue: [^ false]. rectToTest _ selRects first merge: selRects last! . transform _ scroller transformFrom: self. (event notNil and: [event isMouse and: [event anyButtonPressed]]) ifTrue: "Check for autoscroll" [cpHere _ transform localPointToGlobal: event cursorPoint. cpHere y <= self top ifTrue: [rectToTest _ selRects first topLeft extent: 2@2] ifFalse: [cpHere y >= self bottom ifTrue: [rectToTest _ selRects last bottomRight extent: 2@2] ifFalse: [^ false]]]. selRect _ transform localBoundsToGlobal: rectToTest. selRect height > self height ifTrue: [^ false]. "Would not fit, even if we tried to scroll" alignTop ifTrue: [ self scrollBy: 0@(self top - selRect top). ^ true ]. selRect bottom > self bottom ifTrue: [ self scrollBy: 0@(self bottom - selRect bottom - 30). ^ true ]. (delta _ selRect amountToTranslateWithin: self bounds) y ~= 0 ifTrue: [ "Scroll end of selection into view if necessary" self scrollBy: 0@delta y. ^ true]. ^ false! ! !AlansTextPlusMorph methodsFor: 'as yet unclassified' st! amp: 'jcg 7/1/2001 23:08'! scrollToYAbsolute: yValue | transform transformedPoint | transform _ scroller transformFrom: self. transformedPoint _ transform localPointToGlobal: 0@yValue. self scrollBy: 0@(self top - transformedPoint y). ! ! !PluggableListMorph methodsFor: 'selection' stamp: 'jcg 7/1/2001 23:07'! selectionIndex: index "Called internally to select the index-th item." | theMorph range | (index isNil or: [index > scroller submorphs size]) ifTrue: [^ self]. (theMorph _ index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index]) ifNotNil: [((theMorph top - scroller offset y) >= 0 and: [(theMorph bottom - scroller offset y) <= self height]) ifFalse: ["Scroll into view -- should be elsewhere" range _ self leftoverScrollRange. scrollBar value: (range > 0 ifTrue: [((index-1 * theMorph height) / self leftoverScrollRange) truncateTo: scrollBar scrollDelta] ifFalse: [0]). scroller offset: -3 @ (range * scrollBar value! )]]. self selectedMorph: theMorph! ! !PluggableMultiColumnListMorph methodsFor: 'selection' stamp: 'jcg 7/1/2001 23:07'! selectionIndex: index "Called internally to select the index-th item." | theMorph range | (index isNil or: [index > scroller submorphs size]) ifTrue: [^ self]. (theMorph _ index = 0 ifFalse: [scroller submorphs at: index]) ifNotNil: [(theMorph top - scroller offset y >= 0 and: [theMorph bottom - scroller offset y <= self height]) ifFalse: ["Scroll into view -- should be elsewhere" range _ self leftoverScrollRange. scrollBar value: (range > 0 ifTrue: [index - 1 * theMorph height / self leftoverScrollRange truncateTo: scrollBar scrollDelta] ifFalse: [0]). scroller offset: -3 @ (range * scrollBar value)]]. "Save the selection index to make it easy to do the highlighting work later." selectedIndex _ index. self selectedMorph: theMorph! ! !PluggableTextMorph methodsFor: 'editor access' sta! mp: 'jcg 7/1/2001 23:06'! scrollSelectionIntoView: event "Scroll my text into view if necessary and return true, else return false" | selRects delta selRect rectToTest transform cpHere | selectionInterval _ textMorph editor selectionInterval. selRects _ textMorph paragraph selectionRects. selRects isEmpty ifTrue: [^ false]. rectToTest _ selRects first merge: selRects last. transform _ scroller transformFrom: self. (event notNil and: [event anyButtonPressed]) ifTrue: "Check for autoscroll" [cpHere _ transform localPointToGlobal: event cursorPoint. cpHere y <= self top ifTrue: [rectToTest _ selRects first topLeft extent: 2@2] ifFalse: [cpHere y >= self bottom ifTrue: [rectToTest _ selRects last bottomRight extent: 2@2] ifFalse: [^ false]]]. selRect _ transform localBoundsToGlobal: rectToTest. selRect height > self height ifTrue: [^ false]. "Would not fit, even if we tried to scroll" (delta _ selRect amountToTranslateWithin: self bounds) y ~=! 0 ifTrue: ["Scroll end of selection into view if necessary" self scrollBy: 0@delta y. ^ true]. ^ false! ! !SelectionMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:27'! selectSubmorphsOf: aMorph | newItems removals | newItems _ aMorph submorphs select: [:m | (self bounds containsRect: m fullBounds) and: [m~~self and: [(m isKindOf: HaloMorph) not]]]. otherSelection ifNil: [^ selectedItems _ newItems]. removals _ newItems intersection: itemsAlreadySelected. otherSelection setSelectedItems: (itemsAlreadySelected copyWithoutAll: removals). selectedItems _ (newItems copyWithoutAll: removals). ! ! !SimpleButtonMorph methodsFor: 'fileIn/Out' stamp: 'jcg 7/1/2001 23:20'! objectForDataStream: refStrm "I am about to be written on an object file. If I send a message to a BookMorph, it would be bad to write that object out. Create and write out a URLMorph instead." | bb thatPage um stem ind sqPg | (actionSelector == #goToPageMorph:fromBookmark:! ) | (actionSelector == #goToPageMorph:) ifFalse: [ ^ super objectForDataStream: refStrm]. "normal case" target url ifNil: ["Later force target book to get a url." bb _ SimpleButtonMorph new. "write out a dummy" bb label: self label. bb bounds: self bounds. refStrm replace: self with: bb. ^ bb]. (thatPage _ arguments first) url ifNil: [ "Need to assign a url to a page that will be written later. It might have bookmarks too. Don't want to recurse deeply. Have that page write out a dummy morph to save its url on the server." stem _ target getStemUrl. "know it has one" ind _ target pages identityIndexOf: thatPage. thatPage reserveUrl: stem,(ind printString),'.sp']. um _ URLMorph newForURL: thatPage url. sqPg _ thatPage sqkPage clone. sqPg contentsMorph: nil. um setURL: thatPage url page: sqPg. (SqueakPage stemUrl: target url) = (SqueakPage stemUrl: thatPage url) ifTrue: [um book: true] ifFalse: [um book: target url]. "remember wh! ich book" um privateOwner: owner. um bounds: self bounds. um isBookmark: true; label: self label. um borderWidth: borderWidth; borderColor: borderColor. um color: color. refStrm replace: self with: um. ^ um! ! !MinesTile methodsFor: 'accessing' stamp: 'jcg 12/31/2001 16:08'! drawOn: aCanvas "Draw a rectangle with a solid, inset, or raised border. Note: the raised border color *and* the inset border color are generated from the receiver's own color, instead of having the inset border color generated from the owner's color, as in BorderedMorph." | font rct | borderWidth = 0 ifTrue: [ "no border" aCanvas fillRectangle: self bounds color: color. ^ self]. borderColor == #raised ifTrue: [ ^ aCanvas frameAndFillRectangle: self bounds fillColor: color borderWidth: borderWidth topLeftColor: color lighter lighter bottomRightColor: color darker darker darker]. borderColor == #inset ifTrue: [ aCanvas frameAndFillRectangle: self bounds ! fillColor: color borderWidth: 1 " borderWidth" topLeftColor: (color darker darker darker) bottomRightColor: color lighter. self isMine ifTrue: [ font _ StrikeFont familyName: 'Atlanta' size: 22 emphasized: 1. rct _ self bounds insetBy: ((self width) - (font widthOfString: '*'))/2@0. rct _ rct top: rct top + 1. aCanvas text: '*' bounds: (rct translateBy: 1@1) font: font color: Color black. ^ aCanvas text: '*' bounds: rct font: font color: Color red .]. self nearMines > 0 ifTrue: [ font _ StrikeFont familyName: 'ComicBold' size: 22 emphasized: 1. rct _ self bounds insetBy: ((self width) - (font widthOfString: nearMines asString))/2@0. rct _ rct top: rct top + 1. aCanvas text: nearMines asString bounds: (rct translateBy: 1@1) font: font color: Color black. ^ aCanvas text: nearMines asString bounds: rct font: font color: ((palette at: nearMines) ) .]. ^self. ]. "solid color border" aCanvas frameAndFillRectangle: self! bounds fillColor: color borderWidth: borderWidth borderColor: borderColor.! ! !SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'jcg 7/1/2001 23:07'! selectionIndex: index "Called internally to select the index-th item." | theMorph range | index ifNil: [^ self]. (theMorph _ index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index]) ifNotNil: [((theMorph top - scroller offset y) >= 0 and: [(theMorph bottom - scroller offset y) <= self height]) ifFalse: ["Scroll into view -- should be elsewhere" range _ self totalScrollRange. scrollBar value: (range > 0 ifTrue: [((index-1 * theMorph height) / self totalScrollRange) truncateTo: scrollBar scrollDelta] ifFalse: [0]). scroller offset: -3 @ (range * scrollBar value)]]. self selectedMorph: theMorph! ! !SketchEditorMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 23:34'! initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosi! tion: aPosition "NB: if aPosition is nil, then it's assumed that the paintbox is obtained from a flap or some such, so do nothing special regarding a palette in this case. The palette needs already to be in the world for this to work." | w | (w _ aPasteUpMorph world) addMorphFront: self. enclosingPasteUpMorph _ aPasteUpMorph. hostView _ aSketchMorph. "may be ownerless" self bounds: boundsToUse. palette _ w paintBox focusMorph: self. palette beStatic. "give Nebraska whatever help we can" palette fixupButtons. palette addWeakDependent: self. aPosition ifNotNil: [w addMorphFront: palette. "bring to front" palette position: aPosition]. paintingForm _ Form extent: self extent depth: w assuredCanvas depth. self dimTheWindow. self addRotationScaleHandles. aSketchMorph ifNotNil: [ aSketchMorph form displayOn: paintingForm at: (hostView boundsInWorld origin - self position - hostView form offset) clippingBox: (0@0 extent: paintingForm extent) r! ule: Form over fillColor: nil. "assume they are the same depth" rotationCenter _ aSketchMorph rotationCenter]! ! !SketchEditorMorph methodsFor: 'morphic' stamp: 'jcg 7/1/2001 23:33'! drawOn: aCanvas "Put the painting on the display" color isTransparent ifFalse: [ aCanvas fillRectangle: self bounds color: color ]. paintingForm ifNotNil: [ aCanvas paintImage: paintingForm at: self position]. ! ! !SketchEditorMorph methodsFor: 'morphic' stamp: 'jcg 7/1/2001 23:35'! mouseDown: evt "Start a new stroke. Check if any palette setting have changed. 6/11/97 20:30 tk" | cur pfPen myAction | "verify that we are in a good state" self verifyState: evt. "includes prepareToPaint and #scalingOrRotate" pfPen _ self get: #paintingFormPen for: evt. undoBuffer _ paintingForm deepCopy. "know we will draw something" pfPen place: (evt cursorPoint - self position). myAction _ self getActionFor: evt. myAction == #paint: ifTrue:[ palette recentColor: (self getColorFor:! evt)]. self set: #strokeOrigin for: evt to: evt cursorPoint. "origin point for pickup: rect: ellispe: polygon: line: star:. Always take it." myAction == #pickup: ifTrue: [ cur _ Cursor corner clone. cur offset: 0@0 "cur offset abs". evt hand showTemporaryCursor: cur]. myAction == #polygon: ifTrue: [self polyNew: evt]. "a mode lets you drag vertices" self mouseMove: evt.! ! !SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:34'! addRotationScaleHandles "Rotation and scaling handles" rotationButton _ SketchMorph withForm: (palette rotationTabForm). rotationButton position: self bounds topCenter - (6@0). rotationButton on: #mouseDown send: #rotateScalePrep: to: self. rotationButton on: #mouseMove send: #rotateBy: to: self. rotationButton on: #mouseUp send: #rotateDone: to: self. rotationButton on: #mouseEnter send: #mouseLeave: to: self. "Put cursor back" rotationButton on: #mouseLeave send: #mouseEnter: to: self. self addMorph: ! rotationButton. rotationButton setBalloonText: 'Drag me sideways to\rotate your picture.' withCRs. scaleButton _ SketchMorph withForm: (palette scaleTabForm). scaleButton position: self bounds rightCenter - ((scaleButton width)@6). scaleButton on: #mouseDown send: #rotateScalePrep: to: self. scaleButton on: #mouseMove send: #scaleBy: to: self. scaleButton on: #mouseEnter send: #mouseLeave: to: self. "Put cursor back" scaleButton on: #mouseLeave send: #mouseEnter: to: self. self addMorph: scaleButton. scaleButton setBalloonText: 'Drag me up and down to change\the size of your picture.' withCRs. "REMOVED: fwdButton _ PolygonMorph new. pt _ self bounds topCenter. fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor: (Color r: 0 g: 0.8 b: 0). fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with: pt+(0@22)). fwdButton on: #mouseMove send: #forward:direction: to: self. fwdButton on: #mouseEnter send: #mouseLeave: to: self. fwdButton on: #m! ouseLeave send: #mouseEnter: to: self. self setProperty: #fwdButton toValue: fwdButton. self addMorph: fwdButton. fwdButton setBalloonText: 'Drag me around to point\in the direction I go forward.' withCRs. toggle _ EllipseMorph newBounds: (Rectangle center: fwdButton vertices last + (-4@4) extent: 8@8) color: Color gray. toggle on: #mouseUp send: #toggleDirType:in: to: self. toggle on: #mouseEnter send: #mouseLeave: to: self. toggle on: #mouseLeave send: #mouseEnter: to: self. self setProperty: #fwdToggle toValue: toggle. fwdButton addMorph: toggle. toggle setBalloonText: 'When your object turns,\how should its picture change?\It can rotate, face left or right,\face up or down, or not change.' withCRs. " self setProperty: #rotationStyle toValue: hostView rotationStyle. " self forward: hostView setupAngle direction: fwdButton. " "Set to its current value" ! ! !SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:35'! deliverPainting: resu! lt evt: evt "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk" | newBox newForm ans | palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" "rot _ palette getRotations." "rotate with heading, or turn to and fro" "palette setRotation: #normal." result == #cancel ifTrue: [ ans _ PopUpMenu withCaption: 'Do you really want to throw away what you just painted?' chooseFrom: 'throw it away\keep painting it'. ^ ans = 1 ifTrue: [self cancelOutOfPainting] ifFalse: [nil]]. "for Morphic" "hostView rotationStyle: rot." "rotate with heading, or turn to and fro" newBox _ paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. registrationPoint ifNotNil: [registrationPoint _ registrationPoint - newBox origin]. "relative to newForm origin" newForm _ Form extent: newBox extent depth: paintingForm depth! . newForm copyBits: newBox from: paintingForm at: 0@0 clippingBox: newForm boundingBox rule: Form over fillColor: nil. newForm isAllWhite ifTrue: [ (self valueOfProperty: #background) == true ifFalse: [^ self cancelOutOfPainting]]. self delete. "so won't find me again" dimForm ifNotNil: [dimForm delete]. newPicBlock value: newForm value: (newBox copy translateBy: self position). ! ! !SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:34'! prepareToPaint: evt "Figure out what the current brush, fill, etc is. Return an action to take every mouseMove. Set up instance variable and pens. Prep for normal painting is inlined here. tk 6/14/97 21:11" | specialMode pfPen cColor cNib myBrush | "Install the brush, color, (replace mode), and cursor." specialMode _ self getActionFor: evt. cColor _ self getColorFor: evt. cNib _ self getNibFor: evt. self set: #brush for: evt to: (myBrush _ cNib). self set: #paintingFormPen for: evt to: (pf! Pen _ Pen newOnForm: paintingForm). self set: #stampForm for: evt to: nil. "let go of stamp" formCanvas _ paintingForm getCanvas. "remember to change when undo" formCanvas _ formCanvas copyOrigin: self topLeft negated clipRect: (0@0 extent: self extent). specialMode == #paint: ifTrue: [ "get it to one bit depth. For speed, instead of going through a colorMap every time ." self set: #brush for: evt to: (myBrush _ Form extent: myBrush extent depth: 1). myBrush offset: (0@0) - (myBrush extent // 2). cNib displayOn: myBrush at: (0@0 - cNib offset). pfPen sourceForm: myBrush. pfPen combinationRule: Form paint. pfPen color: cColor. cColor isTransparent ifTrue: [ pfPen combinationRule: Form erase1bitShape. pfPen color: Color black]. ^ #paint:]. specialMode == #erase: ifTrue: [ self erasePrep: evt. ^ #erase:]. specialMode == #stamp: ifTrue: [ self set: #stampForm for: evt to: palette stampForm. "keep it" ^ #stamp:]. (self respondsTo: s! pecialMode) ifTrue: [^ specialMode] "fill: areaFill: pickup: (in mouseUp:) rect: ellipse: line: polygon: star:" ifFalse: ["Don't recognise the command" palette setAction: #paint: evt: evt. "set it to Paint" ^ self prepareToPaint: evt].! ! !SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:35'! undo: evt "revert to a previous state. " | temp poly | self flag: #bob. "what is undo in multihand environment?" undoBuffer ifNil: [^ self beep]. "nothing to go back to" (poly _ self valueOfProperty: #polygon) ifNotNil: [poly delete. self setProperty: #polygon toValue: nil. ^ self]. temp _ paintingForm. paintingForm _ undoBuffer. undoBuffer _ temp. "can get back to what you had by undoing again" (self get: #paintingFormPen for: evt) setDestForm: paintingForm. formCanvas _ paintingForm getCanvas. "used for lines, ovals, etc." formCanvas _ formCanvas copyOrigin: self topLeft negated clipRect: (0@0 extent: self extent). self! render: self bounds.! ! !SketchEditorMorph methodsFor: 'start & finish' stamp: 'jcg 7/1/2001 23:36'! verifyState: evt | myAction | "We are sure we will make a mark now. Make sure the palette has not changed state while we were away. If so, end this action and start another one. 6/11/97 19:52 tk action, currentColor, brush" "Install the brush, color, (replace mode), and cursor." palette isInWorld ifFalse: [self world addMorphFront: palette]. "It happens. might want to position it also" myAction _ self getActionFor: evt. (self get: #changed for: evt) == false ifFalse: [ self set: #changed for: evt to: false. self invalidRect: rotationButton bounds. "snap these back" rotationButton position: self bounds topCenter - (6@0). "later adjust by button width?" self invalidRect: rotationButton bounds. self invalidRect: scaleButton bounds. scaleButton position: self bounds rightCenter - ((scaleButton width)@6). self invalidRect: scaleButton bounds. myAc! tion == #polygon: ifFalse: [self polyFreeze]. "end polygon mode" ^ self set: #action for: evt to: (self prepareToPaint: evt)]. ! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:33'! clear "wipe out all the paint" self polyFreeze. "end polygon mode" paintingForm fillWithColor: Color transparent. self invalidRect: self bounds.! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:36'! fill: evt "Find the area that is the same color as where you clicked. Fill it with the current paint color." | box | evt isMouseUp ifFalse: [^ self]. "Only fill upon mouseUp" "would like to only invalidate the area changed, but can't find out what it is." Cursor execute showWhile: [ box _ paintingForm floodFill: (self getColorFor: evt) at: evt cursorPoint - self position. self render: (box translateBy: self position)]! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:34'! flipHoriz: ! evt "Flip the image" | temp myBuff | myBuff _ self get: #buff for: evt. temp _ myBuff deepCopy flipBy: #horizontal centerAt: myBuff center. temp offset: 0 @ 0. paintingForm fillWithColor: Color transparent. temp displayOn: paintingForm at: paintingForm center - myBuff center + myBuff offset. rotationButton position: evt cursorPoint x - 6 @ rotationButton position y. self render: self bounds! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:36'! flipVert: evt "Flip the image" | temp myBuff | myBuff _ self get: #buff for: evt. temp _ myBuff deepCopy flipBy: #vertical centerAt: myBuff center. temp offset: 0 @ 0. paintingForm fillWithColor: Color transparent. temp displayOn: paintingForm at: paintingForm center - myBuff center + myBuff offset. rotationButton position: evt cursorPoint x - 6 @ rotationButton position y. self render: self bounds! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:34'! forward! : evt direction: button "Move the forward direction arrow of this painting. When the user says forward:, the object moves in the direction of the arrow. evt may be an Event (from the user moving the arrow), or an initial number ofdegrees." | center dir ww ff | center _ self center "+ (rotationButton width - 6 @ 0)". evt isNumber ifTrue: [dir _ Point r: 100 degrees: evt - 90.0 "convert to 0 on X axis"] ifFalse: [dir _ evt cursorPoint - center]. ww _ (self height min: self width)//2 - 7. button setVertices: (Array with: (center + (Point r: ww degrees: dir degrees)) with: (center + (Point r: ww-15 degrees: dir degrees))). (ff _ self valueOfProperty: #fwdToggle) position: (center + (Point r: ww-7 degrees: dir degrees + 6.5)) - (ff extent // 2). self showDirType. ! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:36'! paint: evt "While the mouse is down, lay down paint, but only within window bounds. 11/28/96 sw: no longer stop pai! nting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up" | mousePoint startRect endRect startToEnd pfPen myBrush | pfPen _ self get: #paintingFormPen for: evt. myBrush _ self getBrushFor: evt. mousePoint _ evt cursorPoint. startRect _ pfPen location + myBrush offset extent: myBrush extent. pfPen goto: mousePoint - self position. endRect _ pfPen location + myBrush offset extent: myBrush extent. "self render: (startRect merge: endRect). Show the user what happened" startToEnd _ startRect merge: endRect. self invalidRect: (startToEnd translateBy: self position). ! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:33'! pickupMouseUp: evt "Grab a part of the picture (or screen) and store it in a known place. Like Copy on the Mac menu. Then switch to the stamp tool." | rr pForm ii oldRect sOrigin priorEvt | sOrigin _ self get: #strokeOrigin for: evt. (priorEvt _ self get: #lastEvent! for: evt) == nil ifFalse: [ "Last draw will stick out, must erase the area" oldRect _ sOrigin rect: priorEvt cursorPoint + (14@14). self restoreRect: (oldRect insetBy: -2)]. self primaryHand showTemporaryCursor: nil. "later get rid of this" rr _ sOrigin rect: evt cursorPoint + (14@14). ii _ rr translateBy: self position negated. (rr intersects: self bounds) ifTrue: [ pForm _ paintingForm copy: ii. pForm isAllWhite "means transparent" ifFalse: [] "normal case. Can be transparent in parts" ifTrue: [pForm _ nil. "Get an un-dimmed picture of other objects on the playfield" "don't know how yet"]]. pForm ifNil: [pForm _ Form fromDisplay: rr]. "Anywhere on the screen" palette pickupForm: pForm evt: evt. evt hand showTemporaryCursor: (self getCursorFor: evt). ! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:35'! rotateBy: evt "Left-right is rotation. 3/26/97 tk Slider at top of window. 4/3/97 tk" | pt temp amt smoo! th myBuff | myBuff _ self get: #buff for: evt. evt cursorPoint x - self left < 20 ifTrue: [^ self flipHoriz: evt]. "at left end flip horizontal" evt cursorPoint x - self right > -20 ifTrue: [^ self flipVert: evt]. "at right end flip vertical" pt _ evt cursorPoint - self center. smooth _ 2. "paintingForm depth > 8 ifTrue: [2] ifFalse: [1]." "Could go back to 1 for speed" amt _ pt x abs < 12 ifTrue: ["detent" 0] ifFalse: [pt x - (12 * pt x abs // pt x)]. amt _ amt * 1.8. temp _ myBuff rotateBy: amt magnify: cumMag smoothing: smooth. temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset. rotationButton position: evt cursorPoint x - 6 @ rotationButton position y. self render: self bounds. cumRot _ amt! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:33'! scaleBy: evt "up-down is scale. 3/26/97 tk Now a slider on the right." | pt temp cy oldRect amt myBuff | myBuff _ self g! et: #buff for: evt. pt _ evt cursorPoint - self center. cy _ self height * 0.5. oldRect _ myBuff boundingBox expandBy: myBuff extent * cumMag / 2. amt _ pt y abs < 12 ifTrue: ["detent" 1.0] ifFalse: [pt y - (12 * pt y abs // pt x)]. amt _ amt asFloat / cy + 1.0. temp _ myBuff rotateBy: cumRot magnify: amt smoothing: 2. cumMag > amt ifTrue: ["shrinking" oldRect _ oldRect translateBy: paintingForm center - oldRect center + myBuff offset. paintingForm fill: (oldRect expandBy: 1 @ 1) rule: Form over fillColor: Color transparent]. temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset. scaleButton position: scaleButton position x @ (evt cursorPoint y - 6). self render: self bounds. cumMag _ amt! ! !SketchEditorMorph methodsFor: 'actions & preps' stamp: 'jcg 7/1/2001 23:35'! stamp: evt "plop one copy of the user's chosen Form down." "Check depths" | pt sForm | sForm _ self get: #stampForm fo! r: evt. pt _ evt cursorPoint - (sForm extent // 2). sForm displayOn: paintingForm at: pt - self position clippingBox: paintingForm boundingBox rule: Form paint fillColor: nil. self render: (pt extent: sForm extent). ! ! !SketchMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:36'! drawOn: aCanvas aCanvas paintImage: self rotatedForm at: self position ! ! !SketchMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:37'! drawPostscriptOn: aCanvas | top f2 c2 tfx clrs | tfx _ self transformFrom: self world. tfx angle = 0.0 ifFalse: [^super drawPostscriptOn: aCanvas]. "can't do rotated yet" clrs _ self rotatedForm colorsUsed. (clrs includes: Color transparent) ifFalse: [^super drawPostscriptOn: aCanvas]. "no need for this, then" "Smalltalk at: #Q put: OrderedCollection new" "Q add: {self. tfx. clrs}." "(self hasProperty: #BOB) ifTrue: [self halt]." top _ aCanvas topLevelMorph. f2 _ Form extent: self extent depth: self rotatedForm depth. c2 _ f2 ge! tCanvas. c2 fillColor: Color white. c2 translateBy: self position negated clippingTo: f2 boundingBox during: [ :c | top fullDrawOn: c ]. aCanvas paintImage: f2 at: self position ! ! !SketchMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:36'! containsPoint: aPoint ^ (self bounds containsPoint: aPoint) and: [(self rotatedForm isTransparentAt: aPoint - self position) not] ! ! !SketchMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:22'! layoutChanged "Update rotatedForm and compute new bounds." self changed. self generateRotatedForm. self privateBounds: (self bounds origin extent: rotatedForm extent). super layoutChanged. self changed. ! ! !BookPageThumbnailMorph methodsFor: 'fileIn/Out' stamp: 'jcg 7/1/2001 23:38'! objectForDataStream: refStrm "I am about to be written on an object file. It would be bad to write a whole BookMorph out. Store a string that is the url of the book or page in my inst var." | clone bookUrl bb stem ind | (b! ookMorph class == String) & (page class == String) ifTrue: [ ^ super objectForDataStream: refStrm]. (bookMorph == nil) & (page class == String) ifTrue: [ ^ super objectForDataStream: refStrm]. (bookMorph == nil) & (page url ~~ nil) ifTrue: [ ^ super objectForDataStream: refStrm]. (bookMorph == nil) & (page url == nil) ifTrue: [ self error: 'page should already have a url'. "find page's book, and remember it" "bookMorph _ "]. clone _ self clone. (bookUrl _ bookMorph url) ifNil: [bookUrl _ self valueOfProperty: #futureUrl]. bookUrl ifNil: [ bb _ RectangleMorph new. "write out a dummy" bb bounds: self bounds. refStrm replace: self with: bb. ^ bb] ifNotNil: [clone instVarNamed: 'bookMorph' put: bookUrl]. page url ifNil: [ "Need to assign a url to a page that will be written later. It might have bookmarks too. Don't want to recurse deeply. Have that page write out a dummy morph to save its url on the server." stem _ SqueakPage s! temUrl: bookUrl. ind _ bookMorph pages identityIndexOf: page. page reserveUrl: stem,(ind printString),'.sp']. clone instVarNamed: 'page' put: page url. refStrm replace: self with: clone. ^ clone! ! !FatBitsPaint methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:38'! drawOn: aCanvas | f | f _ self rotatedForm. backgroundColor ifNotNil: [aCanvas fillRectangle: self bounds fillStyle: backgroundColor]. aCanvas translucentImage: f at: self position.! ! !MPEGImageMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:38'! drawOn: aCanvas aCanvas drawImage: self rotatedForm at: self position! ! !MultiuserTinyPaint methodsFor: 'events' stamp: 'jcg 7/1/2001 23:37'! mouseMove: evt | state lastP p pen | state _ drawState at: evt hand ifAbsent: [^ self]. lastP _ state at: LastMouseIndex. p _ evt cursorPoint. p = lastP ifTrue: [^ self]. pen _ state at: PenIndex. pen drawFrom: lastP - self position to: p - self position. self invalidRect: ( ((lastP min: p) - pen sou! rceForm extent) corner: ((lastP max: p) + pen sourceForm extent)). state at: LastMouseIndex put: p. ! ! !Slider methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:08'! computeSlider | r | r _ self roomToMove. self descending ifFalse: [slider position: (self bounds isWide ifTrue: [r topLeft + ((r width * value) asInteger @ 0)] ifFalse: [r topLeft + (0 @ (r height * value) asInteger)])] ifTrue: [slider position: (self bounds isWide ifTrue: [r bottomRight - ((r width * value) asInteger @ 0)] ifFalse: [r bottomRight - ((0 @ (r height * value) asInteger))])]. slider extent: self sliderExtent! ! !Slider methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:08'! extent: newExtent newExtent = self extent ifTrue: [^ self]. self bounds isWide ifTrue: [super extent: (newExtent x max: self sliderThickness * 2) @ newExtent y] ifFalse: [super extent: newExtent x @ (newExtent y max: self sliderThickness * 2)]. self removeAllMorphs; initializeSlider! ! !Sli! der methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:08'! sliderExtent ^ self bounds isWide ifTrue: [self sliderThickness @ self innerBounds height] ifFalse: [self innerBounds width @ self sliderThickness]! ! !Slider methodsFor: 'scrolling' stamp: 'jcg 7/1/2001 23:09'! scrollAbsolute: event | r p | r _ self roomToMove. self bounds isWide ifTrue: [r width = 0 ifTrue: [^ self]] ifFalse: [r height = 0 ifTrue: [^ self]]. p _ event targetPoint adhereTo: r. self descending ifFalse: [self setValue: (self bounds isWide ifTrue: [(p x - r left) asFloat / r width] ifFalse: [(p y - r top) asFloat / r height])] ifTrue: [self setValue: (self bounds isWide ifTrue: [(r right - p x) asFloat / r width] ifFalse: [(r bottom - p y) asFloat / r height])]! ! !ScrollBar methodsFor: 'initialize' stamp: 'jcg 7/1/2001 23:11'! initializeDownButton downButton := RectangleMorph newBounds: (self innerBounds bottomRight - self buttonExtent extent: self buttonExt! ent) color: Color lightGray. downButton on: #mouseDown send: #scrollDownInit to: self. downButton on: #mouseUp send: #finishedScrolling to: self. downButton addMorphCentered: (ImageMorph new image: (self cachedImageAt: (self bounds isWide ifTrue: ['right'] ifFalse: ['down']) ifAbsentPut: [ self upArrow8Bit rotateBy: (self bounds isWide ifTrue: [#right] ifFalse: [#pi]) centerAt: 0@0 ] ) ). downButton setBorderWidth: 1 borderColor: #raised. self addMorph: downButton! ! !ScrollBar methodsFor: 'initialize' stamp: 'jcg 7/1/2001 23:09'! initializeUpButton upButton := RectangleMorph newBounds: ((menuButton ifNil: [self innerBounds topLeft] ifNotNil: [self bounds isWide ifTrue: [menuButton topRight] ifFalse: [menuButton bottomLeft]]) extent: self buttonExtent) color: Color lightGray. upButton on: #mouseDown send: #scrollUpInit to: self. upButton on: #mouseUp send: #finishedScrolling to: self. upButton addMorphCentered:! (ImageMorph new image: (self cachedImageAt: (self bounds isWide ifTrue: ['left'] ifFalse: ['up']) ifAbsentPut: [ self bounds isWide ifTrue: [ self upArrow8Bit rotateBy: #left centerAt: 0@0 ] ifFalse: [ self upArrow8Bit ] ] ) ). upButton setBorderWidth: 1 borderColor: #raised. self addMorph: upButton! ! !ScrollBar methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:10'! buttonExtent ^ self bounds isWide ifTrue: [11 @ self innerBounds height] ifFalse: [self innerBounds width @ 11]! ! !ScrollBar methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:10'! expandSlider "Compute the new size of the slider (use the old sliderThickness as a minimum)." | r | r _ self totalSliderArea. slider extent: (self bounds isWide ifTrue: [((r width * interval) asInteger max: self sliderThickness) @ slider height] ifFalse: [slider width @ ((r height * interval) asInteger max: self sliderThickness)])! ! !ScrollBar methodsFor: 'geometry' stamp: 'jcg 7/1/20! 01 23:10'! totalSliderArea ^ self bounds isWide ifTrue: [upButton topRight corner: downButton bottomLeft] ifFalse: [upButton bottomLeft corner: downButton topRight]! ! !ScrollBar methodsFor: 'scrolling' stamp: 'jcg 7/1/2001 23:10'! setNextDirectionFromEvent: event nextPageDirection _ self bounds isWide ifTrue: [ event cursorPoint x >= slider center x ] ifFalse: [ event cursorPoint y >= slider center y ] ! ! !SpeakerMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 23:02'! addGraphic | graphic | graphic _ SketchMorph withForm: self speakerGraphic. graphic position: self center - (graphic extent // 2). self addMorph: graphic. ! ! !StarSqueakMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:40'! display "Display this world on the Display. Used for debugging." | c | c _ FormCanvas extent: (dimensions * pixelsPerPatch) depth: 32. c _ c copyOffset: self position negated. self drawOn: c. c form display. ! ! !StarSqueakMorph methodsFor: 'dra! wing' stamp: 'jcg 7/1/2001 23:40'! drawOn: aCanvas "Display this StarSqueak world." | tmpForm bitBlt t | "copy the patches form" tmpForm _ patchForm deepCopy. "draw patchVariableToDisplay on top of tmpForm as translucent color" self displayPatchVariableOn: tmpForm color: Color yellow shift: logPatchVariableScale. "draw turtles on top of tmpForm" bitBlt _ (BitBlt toForm: tmpForm) clipRect: tmpForm boundingBox; combinationRule: Form over. 1 to: turtles size do: [:i | t _ turtles at: i. bitBlt destX: (pixelsPerPatch * t x truncated) destY: (pixelsPerPatch * t y truncated) width: pixelsPerPatch height: pixelsPerPatch. bitBlt fillColor: t color; copyBits]. "display tmpForm" aCanvas paintImage: tmpForm at: self position. ! ! !StretchyImageMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:24'! drawOn: aCanvas | t | " Smalltalk at: #Q4 put: OrderedCollection new. " form ifNil: [form _ (Form extent: 32@32 depth: 8) fillColo! r: Color green]. (cache isNil or: [cache extent ~= self extent]) ifTrue: [ t _ [cache _ Form extent: self extent depth: aCanvas depth. form displayInterpolatedIn: cache boundingBox on: cache] timeToRun. "Q4 add: {t. form. cache}." ]. aCanvas paintImage: cache at: self position. ! ! !StringMorph methodsFor: 'accessing' stamp: 'jcg 12/31/2001 15:59'! fitContents | scanner newBounds boundsChanged | scanner _ DisplayScanner quickPrintOn: Display box: Display boundingBox font: self fontToUse. newBounds _ (((scanner stringWidth: contents) max: self minimumWidth) @ scanner lineHeight). boundsChanged _ self extent ~= newBounds. self extent: newBounds. "default short-circuits if bounds not changed" boundsChanged ifFalse: [self changed]! ! !StringMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:50'! drawOn: aCanvas aCanvas text: contents bounds: self bounds font: self fontToUse color: color.! ! !DropDownChoiceMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001! 22:51'! drawOn: aCanvas aCanvas text: contents bounds: (self bounds insetBy: 2) font: self fontToUse color: color. border ifNotNil: [aCanvas frameAndFillRectangle: self bounds fillColor: Color transparent borderWidth: 1 borderColor: Color black]. aCanvas paintImage: SubMenuMarker at: (self right - 8 @ ((self top + self bottom - SubMenuMarker height) // 2))! ! !IndentingListItemMorph methodsFor: 'drawing' stamp: 'jcg 12/31/2001 15:28'! drawOn: aCanvas | tRect sRect columnRect columnScanner columnData columnLeft colorToUse | tRect := self toggleRectangle. sRect := self bounds withLeft: tRect right + 3. self drawToggleOn: aCanvas in: tRect. colorToUse _ complexContents preferredColor ifNil: [color]. (container columns isNil or: [(contents asString indexOf: Character tab) = 0]) ifTrue: [ aCanvas text: contents asString bounds: sRect font: self fontToUse color: colorToUse] ifFalse: [ columnLeft _ sRect left. colum! nScanner _ ReadStream on: contents asString. container columns do: [:width | columnRect _ columnLeft @ sRect top extent: width @ sRect height. columnData _ columnScanner upTo: Character tab. columnData isEmpty ifFalse: [ aCanvas text: columnData bounds: columnRect font: self fontToUse color: colorToUse]. columnLeft _ columnRect right + 5]]! ! !IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:51'! toggleRectangle | h | h _ self height. ^(self left + (12 * indentLevel)) @ self top extent: 12@h! ! !IndentingListParagraphMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:52'! drawToggleOn: aCanvas in: aRectangle | aForm | aCanvas fillRectangle: (self bounds withRight: aRectangle right) color: container color. complexContents hasContents ifFalse: [^self]. aForm _ isExpanded ifTrue: [container expandedForm] ifFalse: [container notExpandedForm]. ^aCanvas paintI! mage: aForm at: aRectangle topLeft ! ! !IndentingListParagraphMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:52'! textMorphBounds ^(self bounds withRight: self right - 4) withLeft: self textMorphLeft. ! ! !PDAChoiceMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:51'! drawOn: aCanvas | offset | offset _ 4@(self height - self fontToUse height // 2). aCanvas frameAndFillRectangle: self bounds fillColor: backgroundColor borderWidth: 1 borderColor: Color black. aCanvas text: contents bounds: ((self bounds translateBy: offset) intersect: self bounds) font: self fontToUse color: Color black. ! ! !SystemWindow methodsFor: 'initialization' stamp: 'jcg 12/31/2001 16:00'! addLabel "Add a label latterly. Does not yet get layouts right" | aFont | label _ StringMorph contents: (labelString ifNil: ['Untitled']) font: Preferences windowTitleFont emphasis: 1. "Add collapse box so #labelHeight will work" aFont _ Prefere! nces standardButtonFont. collapseBox _ SimpleButtonMorph new borderWidth: 0; label: 'O' font: aFont; color: Color transparent; actionSelector: #collapseOrExpand; target: self; extent: 14@14; setBalloonText: 'collapse this window'. stripes _ Array with: (RectangleMorph newBounds: self bounds) "see extent:" with: (RectangleMorph newBounds: self bounds). self addLabelArea. labelArea addMorph: (stripes first borderWidth: 1). labelArea addMorph: (stripes second borderWidth: 2). self setLabelWidgetAllowance. self addCloseBox. self addMenuControl. labelArea addMorph: label. labelArea addMorph: collapseBox. self setFramesForLabelArea. label on: #mouseDown send: #relabelEvent: to: self. Preferences noviceMode ifTrue: [closeBox ifNotNil: [closeBox setBalloonText: 'close window']. menuBox ifNotNil: [menuBox setBalloonText: 'window menu']. collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']]! ! !SystemWindo! w methodsFor: 'initialization' stamp: 'jcg 12/31/2001 16:02'! initialize "Initialize a system window. Add label, stripes, etc., if desired" | aFont | super initialize. allowReframeHandles := true. labelString ifNil: [labelString _ 'Untitled Window']. isCollapsed _ false. activeOnlyOnTop _ true. paneMorphs _ Array new. Preferences alternativeWindowLook ifFalse:[ borderColor _ Color black. borderWidth _ 1. color _ Color black. ] ifTrue:[ borderColor _ #raised. borderWidth _ 2. color _ Color white. ]. self layoutPolicy: ProportionalLayout new. self wantsLabel ifTrue: [label _ StringMorph new contents: labelString; font: Preferences windowTitleFont emphasis: 1. "Add collapse box so #labelHeight will work" aFont _ Preferences standardButtonFont. collapseBox _ SimpleButtonMorph new borderWidth: 0; label: 'O' font: aFont; color: Color transparent; actionSelector: #collapseOrExpand; target: self; extent: 14@14; setBalloonText: 'co! llapse this window'. stripes _ Array with: (RectangleMorph newBounds: self bounds) "see extent:" with: (RectangleMorph newBounds: self bounds). self addLabelArea. labelArea addMorph: (stripes first borderWidth: 1). labelArea addMorph: (stripes second borderWidth: 2). self setLabelWidgetAllowance. self addCloseBox. self addMenuControl. labelArea addMorph: label. self wantsExpandBox ifTrue: [self addExpandBox]. labelArea addMorph: collapseBox. self setFramesForLabelArea. Preferences clickOnLabelToEdit ifTrue: [label on: #mouseDown send: #relabel to: self]. Preferences noviceMode ifTrue: [closeBox ifNotNil: [closeBox setBalloonText: 'close window']. menuBox ifNotNil: [menuBox setBalloonText: 'window menu']. collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']]]. self on: #mouseEnter send: #spawnReframeHandle: to: self. self on: #mouseLeave send: #spawnReframeHandle: to: self. self extent: 300@200. must! NotClose _ false. updatablePanes _ Array new.! ! !SystemWindow methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:50'! extent: aPoint "Set the receiver's extent to value provided. Respect my minimumExtent." | newExtent | newExtent _ self isCollapsed ifTrue: [aPoint] ifFalse: [aPoint max: self minimumExtent]. newExtent = self extent ifTrue: [^ self]. isCollapsed ifTrue: [super extent: newExtent x @ (self labelHeight + 2)] ifFalse: [super extent: newExtent]. labelArea ifNotNil: [self setStripeColorsFrom: self paneColorToUse. label fitContents; setWidth: (label width min: self width - self labelWidgetAllowance). label layoutFrame leftOffset: label width negated // 2]. isCollapsed ifTrue: [collapsedFrame _ self bounds] ifFalse: [fullFrame _ self bounds]! ! !SystemWindow methodsFor: 'label' stamp: 'jcg 7/1/2001 23:14'! setLabel: aString | frame | labelString _ aString. label ifNil: [^ self]. label contents: aString. self labelWidgetAllowance. "S! ets it if not already" self isCollapsed ifTrue: [self extent: (label width + labelWidgetAllowance) @ (self labelHeight + 2)] ifFalse: [label fitContents; setWidth: (label width min: self width - labelWidgetAllowance). label align: label bounds topCenter with: self bounds topCenter + (0@borderWidth). collapsedFrame ifNotNil: [collapsedFrame _ collapsedFrame withWidth: label width + labelWidgetAllowance]]. frame _ LayoutFrame new. frame leftFraction: 0.5; topFraction: 0; leftOffset: label width negated // 2. label layoutFrame: frame. ! ! !SystemWindow methodsFor: 'resize/collapse' stamp: 'jcg 7/1/2001 23:11'! getBoundsWithFlex "Return the lastest bounds rectangle with origin forced to global coordinates" self isFlexed ifTrue: [^ ((owner transform localPointToGlobal: self topLeft) extent: self extent)] ifFalse: [^ self bounds]. ! ! !SystemWindow methodsFor: 'top window' stamp: 'jcg 7/1/2001 23:14'! activateAndForceLabelToShow self activa! te. self top < 0 ifTrue: [self position: (self position x @ 0)]! ! !SystemWindow methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:11'! areasRemainingToFill: aRectangle | areas | (areas _ super areasRemainingToFill: aRectangle) isEmpty ifTrue: [^ areas "good news -- complete occlusion"]. "Check for special case that this is scrollbar damage" ((self topLeft - (14@0) corner: self bottomRight) containsRect: aRectangle) ifTrue: [paneMorphs do: [:p | ((p isKindOf: ScrollPane) and: [p scrollBarFills: aRectangle]) ifTrue: [^ Array new]]]. ^ areas! ! !TTSampleFontMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:15'! drawOn: aCanvas | origin extent offset | (font isNil) ifTrue:[^aCanvas frameRectangle: self bounds color: Color black]. origin _ self position asIntegerPoint. extent _ self extent asIntegerPoint. 0 to: 16 do:[:i| offset _ (extent x * i // 16) @ (extent y * i // 16). aCanvas line: origin x @ (origin y + offset y) to: (origin x + exten! t x) @ (origin y + offset y) width: borderWidth color: borderColor. aCanvas line: (origin x + offset x) @ origin y to: (origin x + offset x) @ (origin y + extent y) width: borderWidth color: borderColor. ]. aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas| balloonCanvas transformBy: self transform. balloonCanvas aaLevel: self smoothing. self drawCharactersOn: balloonCanvas. ].! ! !TTSampleStringMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:15'! drawOn: aCanvas | xStart glyph | (font isNil or:[string isNil or:[string isEmpty]]) ifTrue:[^aCanvas frameRectangle: self bounds color: Color black]. xStart _ 0. aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas| balloonCanvas transformBy: self transform. balloonCanvas aaLevel: self smoothing. string do:[:char| glyph _ font at: char. balloonCanvas preserveStateDuring:[:subCanvas| subCanvas transformBy: (MatrixTransform2x3 withOffset: xStart@0). subCanvas ! drawGeneralBezierShape: glyph contours color: color borderWidth: borderWidth borderColor: borderColor]. xStart _ xStart + glyph advanceWidth. ]. ].! ! !TTSampleStringMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:16'! computeTransform | cy | cy _ self top + self bottom * 0.5. transform _ MatrixTransform2x3 transformFromLocal: (ttBounds insetBy: borderWidth negated) toGlobal: self bounds. transform _ transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0@cy negated). transform _ transform composedWithGlobal:(MatrixTransform2x3 withScale: 1.0@-1.0). transform _ transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0@cy). ^transform! ! !TextMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:39'! drawNullTextOn: aCanvas "make null text frame visible" aCanvas fillRectangle: self bounds color: ((Color black) alpha: 0.1). ! ! !TextMorph methodsFor: 'drawing' stamp: 'jcg 9/4/2001 10:10'! drawOn: aCanvas | faux! Bounds | self setDefaultContentsIfNil. super drawOn: aCanvas. "Border and background if any" false ifTrue: [self debugDrawLineRectsOn: aCanvas]. "show line rects for debugging" self startingIndex > text size ifTrue: [self drawNullTextOn: aCanvas] ifFalse: ["Hack here: The canvas expects bounds to carry the location of the text, but we also need to communicate clipping." fauxBounds _ self topLeft corner: self innerBounds bottomRight. aCanvas paragraph: self paragraph bounds: fauxBounds color: color]. ! ! !TextMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:39'! bounds container ifNil: [^ super bounds]. ^ container bounds ifNil: [super bounds]! ! !TextMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:39'! textBounds ^ self bounds! ! !TextMorph methodsFor: 'private' stamp: 'jcg 9/4/2001 10:10'! fit "Adjust my bounds to fit the text. Should be a no-op if autoFit is not specified. Required after the text changes, or if wrapFlag is true and! the user attempts to change the extent." | newExtent para cBounds lastOfLines heightOfLast | self isAutoFit ifTrue: [newExtent _ (self paragraph extent max: 9@textStyle lineGrid) + (0@2). newExtent _ newExtent + (2*borderWidth). margins ifNotNil: [newExtent _ ((0@0 extent: newExtent) expandBy: margins) extent]. newExtent ~= self extent ifTrue: [(container == nil and: [successor == nil]) ifTrue: [para _ paragraph. "Save para (layoutChanged smashes it)" super extent: newExtent. paragraph _ para]]. container notNil & successor isNil ifTrue: [cBounds _ container bounds truncated. "23 sept 2000 - try to allow vertical growth" lastOfLines _ self paragraph lines last. heightOfLast _ lastOfLines bottom - lastOfLines top. (lastOfLines last < text size and: [lastOfLines bottom + heightOfLast >= self bottom]) ifTrue: [container releaseCachedState. cBounds _ cBounds origin corner: cBounds corner + (0@heightOfLast)]. self priva! teBounds: cBounds]]. "These statements should be pushed back into senders" self paragraph positionWhenComposed: self position. successor ifNotNil: [successor predecessorChanged]. self changed. "Too conservative: only paragraph composition should cause invalidation." ! ! !ShowEmptyTextMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:40'! drawOn: aCanvas self setDefaultContentsIfNil. aCanvas paragraph: self paragraph bounds: self bounds color: color. ! ! !TextMorphForEditView methodsFor: 'miscellaneous' stamp: 'jcg 7/1/2001 23:40'! drawNullTextOn: aCanvas "Just run the normal code to show selection in a window" aCanvas paragraph: self paragraph bounds: self bounds color: color ! ! !ThreePhaseButtonMorph methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:38'! state: newState "Change the image and invalidate the rect." newState == state ifTrue: [^ self]. state _ newState. self invalidRect: self bounds. "All three images must be the same siz! e"! ! !ThreePhaseButtonMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:39'! drawOn: aCanvas state == #off ifTrue: [ offImage ifNotNil: [aCanvas paintImage: offImage at: self bounds origin]]. state == #pressed ifTrue: [ pressedImage ifNotNil: [aCanvas paintImage: pressedImage at: self bounds origin]]. state == #on ifTrue: [ image ifNotNil: [aCanvas paintImage: image at: self bounds origin]].! ! !ThreePhaseButtonMorph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:50'! extent: aPoint "Do it normally" self changed. self privateBounds: (self position extent: aPoint). self layoutChanged. self changed. ! ! !TickIndicatorMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:17'! drawOn: aCanvas | r center cc deg | super drawOn: aCanvas. corners ifNil:[ r _ (self bounds topCenter - self center) r - 2. corners _ Array new: 32. 1 to: corners size do:[:i| deg _ 360.0 / corners size * (i-1). corners at: i put: (Point r: r degrees: deg-90) asIntege! rPoint]]. index _ index \\ corners size. cc _ color darker. center _ self center. 1 to: corners size by: 4 do:[:i| aCanvas fillRectangle: (center + (corners at: i)-2 extent: 4@4) color: cc. ]. cc _ cc darker. aCanvas line: center to: center + (corners at: index + 1) width: 2 color: cc.! ! !TileMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 23:25'! line1: line1 line2: line2 | m1 m2 desiredW | self removeAllMorphs. m1 _ StringMorph contents: line1 font: ScriptingSystem fontForTiles. m2 _ StringMorph contents: line2 font: ScriptingSystem fontForTiles. desiredW _ (m1 width max: m2 width) + 6. self extent: (desiredW max: self minimumWidth) @ self class defaultH. m1 position: (self center x - (m1 width // 2) + 1)@(self top + 1). m2 position: (self center x - (m2 width // 2) + 1)@(m1 bottom - 2). self addMorph: m1; addMorph: m2. ! ! !TileMorph methodsFor: 'private' stamp: 'jcg 12/31/2001 15:52'! test | pos hh | "Set the position of all my submorphs. Comp! ute my bounds. Caller must call layoutChanged or set fullBounds to nil." fullBounds ifNil: [ pos _ self position. self submorphsDo: [:sub | hh _ (self class defaultH - sub height) // 2. "center in Y" sub privateBounds: (pos + (2@hh) extent: sub extent). pos x: (sub right min: 1200)]. "2 pixels spacing on left" self privateBounds: (self position corner: pos + (2 @ self class defaultH)). fullBounds _ self bounds. ]. owner class == TilePadMorph ifTrue: [owner bounds: self bounds]. ^ fullBounds! ! !ColorTileMorph methodsFor: 'other' stamp: 'jcg 7/1/2001 23:25'! addColorSwatch | m1 m2 desiredW | m1 _ StringMorph contents: 'color' font: (StrikeFont familyName: #NewYork size: 12). m2 _ Morph new extent: 12@8; color: (Color r: 0.8 g: 0 b: 0). desiredW _ m1 width + 6. self extent: (desiredW max: self basicWidth) @ self class defaultH. m1 position: (self center x - (m1 width // 2)) @ (self top + 1). m2 position: (self center x - (m2 width // 2)) @ (m! 1 bottom - 1). self addMorph: m1; addMorph: m2. colorSwatch _ m2! ! !ColorSeerTile methodsFor: 'initialization' stamp: 'jcg 12/31/2001 15:20'! initialize | m1 m2 desiredW wording | super initialize. self removeAllMorphs. "get rid of the parts of a regular Color tile" type _ #operator. operatorOrExpression _ #color:sees:. wording _ (Vocabulary eToyVocabulary methodInterfaceAt: operatorOrExpression ifAbsent: []) elementWording. m1 _ StringMorph contents: wording font: ScriptingSystem fontForTiles. m2 _ Morph new extent: 12@8; color: (Color r: 0.8 g: 0 b: 0). desiredW _ m1 width + 6. self extent: (desiredW max: self basicWidth) @ self class defaultH. m1 position: (self center x - (m1 width // 2)) @ (self top + 5). m2 position: (self center x - (m2 width // 2) + 3) @ (self top + 8). self addMorph: m1; addMorphFront: m2. colorSwatch _ m2. ! ! !TinyPaint methodsFor: 'events' stamp: 'jcg 7/1/2001 23:37'! mouseDown: evt lastMouse _ evt cursorPoint. brush dra! wFrom: lastMouse - self position to: lastMouse - self position. self invalidRect: ((lastMouse - brush sourceForm extent) corner: (lastMouse + brush sourceForm extent)). ! ! !TinyPaint methodsFor: 'events' stamp: 'jcg 7/1/2001 23:37'! mouseMove: evt | p | p _ evt cursorPoint. p = lastMouse ifTrue: [^ self]. brush drawFrom: lastMouse - self position to: p - self position. self invalidRect: ( ((lastMouse min: p) - brush sourceForm extent) corner: ((lastMouse max: p) + brush sourceForm extent)). lastMouse _ p. ! ! !TransformMorph methodsFor: 'geometry' stamp: 'jcg 12/31/2001 15:52'! containsPoint: aPoint (self bounds containsPoint: aPoint) ifFalse: [^ false]. self hasSubmorphs ifTrue: [self submorphsDo: [:m | (m containsPoint: (transform globalPointToLocal: aPoint)) ifTrue: [^ true]]. ^ false] ifFalse: [^ true]! ! !TransformMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:50'! fullBounds "Overridden to clip submorph hit detection ! to my bounds." "It might be better to override doLayoutIn:, and remove this method" fullBounds ifNotNil:[^ fullBounds]. fullBounds _ self bounds. submorphs do: [:m| m ownerChanged]. ^ fullBounds! ! !TransformMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:49'! invalidRect: damageRect from: aMorph "Translate damage reports from submorphs by the scrollOffset." aMorph == self ifTrue:[super invalidRect: damageRect from: self] ifFalse:[super invalidRect: (((transform localBoundsToGlobal: damageRect) intersect: self bounds) expandBy: 1) from: self].! ! !TransformationMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:50'! adjustAfter: changeBlock "Cause this morph to remain cetered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | oldRefPos | oldRefPos _ self referencePosition. changeBlock value. self chooseSmoothing. self penUpWhile: [self position: self position + (oldRefPos - self referencePositio! n)]. self layoutChanged. owner ifNotNil: [owner invalidRect: self bounds] ! ! !TransformationMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:12'! replaceSubmorph: oldMorph by: newMorph | t b | t _ transform. b _ self bounds. super replaceSubmorph: oldMorph by: newMorph. transform _ t. self privateBounds: b. self layoutChanged! ! !TransformationMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 22:50'! computeBounds self hasSubmorphs ifTrue: [ self privateBounds: ((transform localBoundsToGlobal: (Rectangle merging: (self submorphs collect: [:m | m fullBounds]))) truncated expandBy: 1)]. fullBounds _ self bounds.! ! !BOBTransformationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:50'! adjustAfter: changeBlock "Cause this morph to remain cetered where it was before, and choose appropriate smoothing, after a change of scale or rotation." | | "oldRefPos _ self referencePosition." changeBlock value. self chooseSmoothin! g. "self penUpWhile: [self position: self position + (oldRefPos - self referencePosition)]." self layoutChanged. owner ifNotNil: [owner invalidRect: self bounds] ! ! !BOBTransformationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:18'! extent: aPoint | newExtent | newExtent _ aPoint truncated. self extent = newExtent ifTrue: [^self]. self privateBounds: (self position extent: newExtent). self recomputeExtent. ! ! !BOBTransformationMorph methodsFor: 'as yet unclassified' stamp: 'jcg 12/31/2001 15:19'! extentFromParent: aPoint | newExtent | submorphs isEmpty ifTrue: [^self extent: aPoint]. newExtent _ aPoint truncated. self privateBounds: (self position extent: newExtent). newExtent _ self recomputeExtent. newExtent ifNil: [^self]. self privateBounds: (self position extent: newExtent). ! ! !TransformationB2Morph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:50'! adjustAfter: changeBlock "same as super, but without ref! erence position stuff" changeBlock value. self chooseSmoothing. self layoutChanged. owner ifNotNil: [owner invalidRect: self bounds] ! ! !TransformationB2Morph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:50'! extent: aPoint | newExtent | newExtent _ aPoint truncated. self extent = newExtent ifTrue: [^self]. self privateBounds: (self topLeft extent: newExtent). "self recomputeExtent." ! ! !TransitionMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:53'! initiateReplacement | n | startForm _ effect = #dissolve ifTrue: [(startMorph imageForm: 16 forRectangle: self bounds) offset: 0@0] ifFalse: [(startMorph imageFormForRectangle: self bounds) offset: 0@0]. endForm _ (endMorph imageFormForRectangle: self bounds) offset: 0@0. nSteps == nil ifTrue: [self nSteps: 30 stepTime: 10. (#(zoom pageForward pageBack) includes: effect) ifTrue: [n _ 20 * 100000 // self bounds area min: 20 max: 4. self nSteps: n stepTime: 10]. (#disso! lve = effect) ifTrue: [n _ 20 * 50000 // self bounds area min: 20 max: 4. self nSteps: n stepTime: 10]]. startBlock value. "with forms in place there should b no further delay." self arrangeToStartStepping. ! ! !TransitionMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:53'! drawPageBackOn: aCanvas "endForm grows in the given direction, overlaying endForm." | offset growRect scale | aCanvas drawImage: startForm at: self position. offset _ self stepFrom: self extent * direction negated to: 0@0. growRect _ (self bounds translateBy: offset) intersect: self bounds. scale _ growRect extent asFloatPoint / self extent. aCanvas drawImage: (endForm magnify: endForm boundingBox by: scale smoothing: 1) at: growRect topLeft. ((growRect translateBy: direction) areasOutside: growRect) do: [:r | aCanvas fillRectangle: r color: Color black]. ! ! !TransitionMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:52'! drawPageForwardOn: aCanvas "startForm shrinks in ! the given direction, revealing endForm." | offset shrinkRect scale | aCanvas drawImage: endForm at: self position. offset _ self stepFrom: 0@0 to: self extent * direction. shrinkRect _ (self bounds translateBy: offset) intersect: self bounds. scale _ shrinkRect extent asFloatPoint / self extent. aCanvas drawImage: (startForm magnify: startForm boundingBox by: scale smoothing: 1) at: shrinkRect topLeft. ((shrinkRect translateBy: direction negated) areasOutside: shrinkRect) do: [:r | aCanvas fillRectangle: r color: Color black]. ! ! !TransitionMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:53'! drawZoomOn: aCanvas "Zoom in: endForm expands overlaying startForm. Zoom out: startForm contracts revealing endForm." | box innerForm outerForm boxExtent scale | direction = #in ifTrue: [innerForm _ endForm. outerForm _ startForm. boxExtent _ self stepFrom: 0@0 to: self extent] ifFalse: [innerForm _ startForm. outerForm _ endForm. boxExtent _ self st! epFrom: self extent to: 0@0]. aCanvas drawImage: outerForm at: self position. box _ Rectangle center: self center extent: boxExtent. scale _ box extent asFloatPoint / self extent. aCanvas drawImage: (innerForm magnify: innerForm boundingBox by: scale smoothing: 1) at: box topLeft. ((box expandBy: 1) areasOutside: box) do: [:r | aCanvas fillRectangle: r color: Color black]. ! ! !TransitionMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:53'! changed "The default (super) method is, generally much slower than need be, since many transitions only change part of the screen on any given step of the animation. The purpose of this method is to effect some of those savings." | loc box boxPrev h w | (stepNumber between: 1 and: nSteps) ifFalse: [^ super changed]. effect = #slideBoth ifTrue: [^ super changed]. effect = #slideOver ifTrue: [loc _ self stepFrom: self position - (self extent * direction) to: self position. ^ self invalidRect: (((loc extent! : self extent) expandBy: 1) intersect: self bounds)]. effect = #slideAway ifTrue: [loc _ self prevStepFrom: self position to: self position + (self extent * direction). ^ self invalidRect: (((loc extent: self extent) expandBy: 1) intersect: self bounds)]. effect = #slideBorder ifTrue: [box _ endForm boundingBox translateBy: (self stepFrom: self topLeft - (self extent * direction) to: self topLeft). boxPrev _ endForm boundingBox translateBy: (self prevStepFrom: self topLeft - (self extent * direction) to: self topLeft). ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. effect = #pageForward ifTrue: [loc _ self prevStepFrom: 0@0 to: self extent * direction. ^ self invalidRect: (((self bounds translateBy: loc) expandBy: 1) intersect: self bounds)]. effect = #pageBack ifTrue: [loc _ self stepFrom: self extent * direction negated to: 0@0. ^ self invalidRect: (((self bounds translateBy: loc) expandBy: 1) intersect: self bounds)]. effect = ! #frenchDoor ifTrue: [h _ self height. w _ self width. direction = #in ifTrue: [box _ Rectangle center: self center extent: (self stepFrom: 0@h to: self extent). boxPrev _ Rectangle center: self center extent: (self prevStepFrom: 0@h to: self extent). ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. direction = #out ifTrue: [box _ Rectangle center: self center extent: (self stepFrom: self extent to: 0@h). boxPrev _ Rectangle center: self center extent: (self prevStepFrom: self extent to: 0@h). ^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]. direction = #inH ifTrue: [box _ Rectangle center: self center extent: (self stepFrom: w@0 to: self extent). boxPrev _ Rectangle center: self center extent: (self prevStepFrom: w@0 to: self extent). ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. direction = #outH ifTrue: [box _ Rectangle center: self center extent:! (self stepFrom: self extent to: w@0). boxPrev _ Rectangle center: self center extent: (self prevStepFrom: self extent to: w@0). ^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]]. effect = #zoomFrame ifTrue: [direction = #in ifTrue: [box _ Rectangle center: self center extent: (self stepFrom: 0@0 to: self extent). boxPrev _ Rectangle center: self center extent: (self prevStepFrom: 0@0 to: self extent). ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. direction = #out ifTrue: [box _ Rectangle center: self center extent: (self stepFrom: self extent to: 0@0). boxPrev _ Rectangle center: self center extent: (self prevStepFrom: self extent to: 0@0). ^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]]. effect = #zoom ifTrue: [box _ Rectangle center: self center extent: (direction = #in ifTrue: [self stepFrom: 0@0 to: self extent] ifFalse: [self prevStepFrom: self extent to! : 0@0]). ^ self invalidRect: ((box expandBy: 1) intersect: self bounds)]. ^ super changed ! ! !TransitionMorph methodsFor: 'change reporting' stamp: 'jcg 7/1/2001 22:54'! invalidate: box1 areasOutside: box2 ((box1 intersect: self bounds) areasOutside: (box2 intersect: self bounds)) do: [:r | self invalidRect: r]! ! !TranslucentProgessMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:32'! drawOn: aCanvas | revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining scanner stringToDraw where fontToUse innerBounds | innerBounds _ self bounds. opaqueBackgroundColor ifNotNil: [ aCanvas frameAndFillRectangle: self bounds fillColor: opaqueBackgroundColor borderWidth: 8 borderColor: Color blue. innerBounds _ innerBounds insetBy: 8. ]. revealTimes _ (self valueOfProperty: #revealTimes) ifNil: [^self]. revealPercentage _ (revealTimes first / revealTimes second) asFloat. reveali! ngStyle _ self revealingStyle. x _ self valueOfProperty: #progressStageNumber ifAbsent: [1]. baseColor _ Color perform: (#(red blue green magenta cyan yellow) atPin: x). revealingColor _ baseColor alpha: 0.2. revealingStyle = 3 ifTrue: [ "wrap and change color" revealPercentage > 1.0 ifTrue: [ revealingColor _ baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5). ]. revealPercentage _ revealPercentage fractionPart. ]. revealingStyle = 2 ifTrue: [ "peg at 75 and blink" revealPercentage > 0.75 ifTrue: [ revealToggle _ self valueOfProperty: #revealToggle ifAbsent: [true]. self setProperty: #revealToggle toValue: revealToggle not. revealToggle ifTrue: [revealingColor _ baseColor alpha: 0.8.]. ]. revealPercentage _ revealPercentage min: 0.75. ]. revealingBounds _ innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated. aCanvas fillRectangle: revealingBounds color: revealingColor. secondsRemaining _ (revea! lTimes second - revealTimes first / 1000) rounded. secondsRemaining > 0 ifTrue: [ fontToUse _ StrikeFont familyName: 'ComicBold' size: 24. scanner _ DisplayScanner quickPrintOn: aCanvas form box: innerBounds font: fontToUse color: Color black. stringToDraw _ secondsRemaining printString. where _ innerBounds corner - ((scanner stringWidth: stringToDraw) @ scanner lineHeight). scanner drawString: stringToDraw at: where. scanner _ DisplayScanner quickPrintOn: aCanvas form box: innerBounds font: fontToUse color: Color white. scanner drawString: stringToDraw at: where - (1@1). ]. ! ! !TwoWayScrollPane methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:06'! resizeScrollBar "used to handle left vs right scrollbar" yScrollBar bounds: (self topLeft extent: 16 @ (self height - 16)). xScrollBar bounds: ((self left + 16) @ (self bottom - 16) extent: (self width - 16) @ 16). ! ! !URLMorph methodsFor: 'drawing' stamp: 'j! cg 12/31/2001 15:56'! drawOn: aCanvas "Draw thumbnail for my page, if it is available. Otherwise, just draw a rectangle." | thumbnail oldExt | color == Color transparent ifTrue: ["show thumbnail" thumbnail _ self thumbnailOrNil. thumbnail ifNil: [ aCanvas frameRectangle: self bounds width: borderWidth color: borderColor. aCanvas fillRectangle: (self bounds insetBy: borderWidth) color: color] ifNotNil: [ oldExt _ self extent. self privateBounds: (self position extent: thumbnail extent + (2@2)). aCanvas frameRectangle: self bounds width: borderWidth color: borderColor. aCanvas paintImage: thumbnail at: self position + borderWidth. oldExt = thumbnail extent ifFalse: [self layoutChanged]]] ifFalse: ["show labeled button" ^ super drawOn: aCanvas] ! ! !UpdatingBooleanStringMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 22:52'! mouseUp: evt (self bo! unds containsPoint: evt cursorPoint) ifTrue: [self contentsClipped: (target perform: getSelector) not asString. self informTarget] ifFalse: [self beep]. self color: Color black! ! !VeryPickyMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:31'! drawOn: aCanvas aCanvas frameRectangle: self bounds width: 1 color: Color red! ! !WatchMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:17'! drawOn: aCanvas | pHour pMin pSec time | time _ Time now. pHour _ self radius: 0.6 hourAngle: time hours + (time minutes/60.0). pMin _ self radius: 0.72 hourAngle: (time minutes / 5.0). pSec _ self radius: 0.8 hourAngle: (time seconds / 5.0). time hours < 12 ifTrue: [self centerColor: Color veryLightGray] ifFalse: [self centerColor: Color darkGray]. antialias ifTrue: [ aCanvas asBalloonCanvas aaLevel: 4; drawOval: (self bounds insetBy: borderWidth // 2 + 1) color: self fillStyle borderWidth: borderWidth borderColor: borderColor; draw! Oval: (self bounds insetBy: self extent*0.35) color: cColor borderWidth: 0 borderColor: Color black; drawPolygon: {self center. pHour} color: Color transparent borderWidth: 3 borderColor: handsColor; drawPolygon: {self center. pMin} color: Color transparent borderWidth: 2 borderColor: handsColor; drawPolygon: {self center. pSec} color: Color transparent borderWidth: 1 borderColor: handsColor] ifFalse: [ super drawOn: aCanvas. aCanvas fillOval: (self bounds insetBy: self extent*0.35) color: cColor; line: self center to: pHour width: 3 color: handsColor; line: self center to: pMin width: 2 color: handsColor; line: self center to: pSec width: 1 color: handsColor.] ! ! !PDAClockMorph methodsFor: 'as yet unclassified' stamp: 'jcg 7/1/2001 23:17'! drawOn: aCanvas aCanvas frameAndFillRectangle: self bounds fillColor: backgroundColor borderWidth: 1 borderColor: borderColor. super drawOn: aCanvas. ! ! !WebPageMorph methodsFo! r: 'drawing' stamp: 'jcg 7/1/2001 23:06'! drawOn: aCanvas super drawOn: aCanvas. image = nil ifFalse:[aCanvas image: image at: self topLeft].! ! !WheelMorph methodsFor: 'properties' stamp: 'jcg 7/1/2001 23:26'! isHorizontal ^ self bounds isWide! ! !WiWPasteUpMorph methodsFor: 'initialization' stamp: 'jcg 7/1/2001 22:21'! viewBox: newViewBox | vb | worldState resetDamageRecorder. "since we may have moved, old data no longer valid" ((vb _ self viewBox) == nil or: [vb ~= newViewBox]) ifTrue: [worldState canvas: nil]. worldState viewBox: newViewBox. self privateBounds: newViewBox. worldState assuredCanvas. "Paragraph problem workaround; clear selections to avoid screen droppings:" self flag: #arNote. "Probably unnecessary" worldState handsDo: [:h | h releaseKeyboardFocus]. self fullRepaintNeeded. ! ! !MVCWiWPasteUpMorph methodsFor: 'geometry' stamp: 'jcg 7/1/2001 23:30'! position: aPoint "Change the position of this morph and and all of its submorp! hs." | delta | delta _ aPoint - self topLeft. (delta x = 0 and: [delta y = 0]) ifTrue: [^ self]. "Null change" self changed. self privateFullMoveBy: delta. self changed. ! ! !WonderlandCameraControls methodsFor: 'accessing' stamp: 'jcg 7/1/2001 22:41'! extent: aPoint self extent = aPoint ifFalse: [ self changed. self privateBounds: (self topLeft extent: aPoint). self layoutChanged. self changed].! ! !WonderlandCameraMorph methodsFor: 'debug' stamp: 'jcg 7/1/2001 22:44'! debugDraw Display deferUpdates: false. self fullDrawOn: (Display getCanvas). Display deferUpdates: false. Display forceToScreen: self bounds.! ! !WonderlandCameraMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:45'! drawAcceleratedOn: aCanvas | myRect | myRect _ (self bounds: self bounds in: nil) intersect: (0@0 extent: DisplayScreen actualScreenSize). (myRenderer notNil and:[myRenderer isAccelerated]) ifFalse:[ myRenderer ifNotNil:[myRenderer destroy]. myRenderer _ nil. ! ]. myRenderer ifNotNil:[ myRenderer _ myRenderer bufferRect: myRect. ]. myRenderer ifNil:[ myRenderer _ B3DHardwareEngine newIn: myRect. myRenderer ifNil:[^self drawSimulatedOn: aCanvas]. ] ifNotNil:[ myRenderer reset. ]. myRenderer viewportOffset: aCanvas origin. myRenderer clipRect: aCanvas clipRect. myCamera drawSceneBackground ifFalse:[ myRenderer restoreMorphicBackground: myRect under: self. ]. self renderOn: myRenderer. outline ifNotNil:[ self drawAcceleratedOutlineOn: myRenderer. ]. myRenderer restoreMorphicForeground: myRect above: self. Display addExtraRegion: myRect for: self.! ! !WonderlandCameraMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 22:48'! drawAcceleratedOutlineOn: aRenderer "Draw a pooh outline on an accelerated renderer." | vtxList scale out pt vtx offset z | "NOTE: The test below captures two distinct cases. #1: The software renderer (which does not support lines) #2: The D3D renderer (which does not support line at! tributes)." myRenderer hasFrameBufferAccess ifTrue:[ ^myRenderer provideOverlayCanvasDuring:[:cc| self sketchOn: cc]. ]. z _ 0.5. vtxList _ self outline contents. vtxList size < 2 ifTrue:[^self]. out _ WriteStream on: (B3DVector3Array new: vtxList size * 2). out nextPut: vtxList first @ z. 2 to: vtxList size-1 do:[:i| pt _ vtxList at: i. vtx _ B3DVector3 x: pt x y: pt y z: z. out nextPut: vtx; nextPut: vtx]. out nextPut: vtxList last @ z. out _ out contents. offset _ self topLeft + self bottomRight * 0.5 @ 0. scale _ (2.0 / self width) @ (-2.0 / self height) @ 1. myRenderer reset. "get rid of everything" myRenderer material: (B3DMaterial new emission: Color red). myRenderer scaleBy: scale. myRenderer translateBy: offset negated. myRenderer lineWidth: 5. myRenderer drawLines: out normals: nil colors: nil texCoords: nil. ! ! !WonderlandCameraMorph methodsFor: 'picking points' stamp: 'jcg 7/1/2001 22:45'! pickPointInBounds: boundary "Chooses a rand! om point so that this morph lies within the specified bounds" | xpos ypos | xpos _ (boundary left) + (0 to: ((boundary width) - (self width))) atRandom. ypos _ (boundary top) + (0 to: ((boundary height) - (self height))) atRandom. ^ xpos@ypos. ! ! !WonderlandCameraMorph methodsFor: 'picking points' stamp: 'jcg 7/1/2001 22:45'! pickPointOnBounds: boundary "Chooses a random point so that an edge of this morph lies on the specified bounds" | side pos | "First choose which side to move the morph to" side _ (1 to: 4) atRandom. "Now choose where on that side to move to" ((side = 1) or: [ side = 3 ]) ifTrue: [ pos _ (0 to: ((boundary height) - (self height))) atRandom] ifFalse: [ pos _ (0 to: ((boundary width) - (self width))) atRandom ]. "Now assemble the point)" "left" (side = 1) ifTrue: [ ^ (boundary left)@((boundary top) + pos) ]. "top" (side = 2) ifTrue: [ ^ ((boundary left) + pos) @ (boundary top) ]. "right" (side = 3) ifTrue: [ ^ ((boundary ! right) - (self width)) @ ((boundary top) + pos) ]. "bottom" ^ ((boundary left) + pos) @ ((boundary bottom) - (self height)). ! ! !WonderlandCameraMorph methodsFor: 'pooh' stamp: 'jcg 12/31/2001 15:59'! 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 _ self top * 0.5. scale _ 1.0 / (scale @ scale negated). center _ box origin + box corner * 0.5. pointList _ pointList collect: [:each | each - center * scale]. subdivision _ PoohSubdivision constraintOutline: pointList. mesh _ subdivision build3DObject. mesh ifNil:[ errorSound play. ] ifNotNil:[ actor _ self getWonderland makeActorNamed: 'sketch'. actor setPrope! rty: #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: 90) asMatrix4x4. actor rotateByMatrix: (B3DRotation axis: 0@1@0 angle:-90) asMatrix4x4. ]. self clearStroke. self mode: nil. Cursor normal show. ! ! !WonderlandEditor methodsFor: 'resizing' stamp: 'jcg 7/1/2001 22:44'! extent: aPoint | newPoint aMorph | self extent = aPoint ifFalse: [ self changed. newPoint _ aPoint. (aPoint x < 370) ifTrue: [ newPoint _ 370@(aPoint y) ]. (aPoint y < 130) ifTrue: [ newPoint _ (newPoint x)@130 ]. aMorph _ myActorBrowser getMorph! . aMorph extent: 140@((newPoint y) - 52). aMorph position: (self position + (0@50)). myTabs extent: (newPoint x - 142)@(newPoint y - 4). myTabs position: (self position + (142@0)). self privateBounds: (self topLeft extent: newPoint). self layoutChanged. self changed. ]. ! ! !WonderlandEditorTabs methodsFor: 'accessing' stamp: 'jcg 7/1/2001 23:23'! extent: aPoint | newPoint | self extent = aPoint ifFalse: [ self changed. newPoint _ (aPoint x)@(aPoint y - 20). myScriptEditor getMorph extent: newPoint. myActorViewer extent: newPoint. myQuickReference getMorph extent: newPoint. self privateBounds: (self topLeft extent: aPoint). self layoutChanged. self changed ]. ! ! !WonderlandWrapperMorph methodsFor: 'drawing' stamp: 'jcg 7/1/2001 23:32'! drawOn: aCanvas | morph | morph _ self getCameraMorph. morph == nil ifTrue:[super drawOn: aCanvas] ifFalse:[self computeBounds: morph. "Update bounds from camera" ! false ifTrue:["Show a rectangle for the wrappers" aCanvas frameRectangle: self bounds color: Color white]]! ! !WonderlandWrapperMorph methodsFor: 'handles' stamp: 'jcg 7/1/2001 23:31'! growMoveFromHalo: evt with: handle | newExtent scale | newExtent _ (self pointFromWorld: (evt cursorPoint - self growPositionOffset)) - self topLeft. newExtent _ newExtent max: 1@1. scale _ newExtent r / self extent r. evt shiftPressed ifTrue:[scale _ B3DVector3 x: scale y: scale z: 1.0] ifFalse:[scale _ B3DVector3 x: scale y: scale z: scale]. myActor resizeRightNow: scale undoable: false. handle position: evt cursorPoint - (handle extent // 2).! ! !WonderlandWrapperMorph methodsFor: 'private' stamp: 'jcg 7/1/2001 22:21'! computeBounds: morph | box | box _ myActor getFullBoundsFor: morph getCamera. box == nil ifFalse:[self privateBounds: box].! ! ThreePhaseButtonMorph removeSelector: #extent!