kentb@argosy.UUCP (Kent Beck) (05/31/91)
Here is an old chestnut in a new fire. For my first r.4 application I ported a rope simulation. Try it by executing "RopeSegment example". Some interesting experiments to try are changing the color and size for different segments, changing the simulation to make it more rope-like, and making it go faster. Thanks to Dave Liebs for his help. Kent Beck -------------snicker snack------------- Wrapper subclass: #BufferedWrapper instanceVariableNames: 'pixmap ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Rope'! BufferedWrapper comment: 'I buffer my component to avoid flashing. I cache a Pixmap in pixmap so one doesn''t need to be created every time I display.'! !BufferedWrapper methodsFor: 'initialize-release'! flushCaches pixmap := nil super flushCaches! ! !BufferedWrapper methodsFor: 'displaying'! bufferContextFrom: aGraphicsContext | context | self checkPixmap. context := pixmap graphicsContext. context paint: self backgroundColor. context displayRectangle: pixmap bounds. context capStyle: aGraphicsContext capStyle. context clientData: aGraphicsContext clientData. context clippingRectangle: aGraphicsContext clippingRectangleOrNil. context font: aGraphicsContext font. context joinStyle: aGraphicsContext joinStyle. context lineWidth: aGraphicsContext lineWidth. context paintPolicy: aGraphicsContext paintPolicy. context paint: aGraphicsContext paint. ^context! displayOn: aGraphicsContext | context | context := self bufferContextFrom: aGraphicsContext. component displayOn: context. "Side effects pixmap" pixmap displayOn: aGraphicsContext! ! !BufferedWrapper methodsFor: 'private'! checkPixmap (pixmap isNil or: [pixmap extent ~= self bounds extent or: [pixmap isOpen not]]) ifTrue: [pixmap := Pixmap extent: self bounds extent]! invalidateRectangle: aRectangle repairNow: aBoolean forComponent: aVisualComponent "Propagate damage up the hierarchy after translating and clipping. Overridden to avoid flashing caused by blanking aRectangle before display." | gc | gc := self graphicsContext. gc clippingRectangle: (gc clippingBounds intersect: aRectangle). self displayOn: gc! ! Object subclass: #RopeSegment instanceVariableNames: 'previous next location ' classVariableNames: 'FacadeForm ' poolDictionaries: '' category: 'Graphics-Rope'! RopeSegment comment: 'I am a member of a double linked list of segments, terminated by a RopeStart at one end and a RopeEnd at the other. My location is a Point, which determines where I display and where I can be found for interaction. I display using the toothpaste algorithm, which blackens circles along the rope and, trailing a ways behind, displays a white ball. I simulate by moving to within a certain distance (cf. stretch) of my moving neighbor.'! !RopeSegment methodsFor: 'accessing'! extent ^self facadeForm extent! next: aRopeSegment next := aRopeSegment! previous: aRopeSegment previous := aRopeSegment! segmentAt: aPoint "Display is back to front, so search has to go backwards." | segment | (segment := next segmentAt: aPoint) notNil ifTrue: [^segment]. ^(self containsPoint: aPoint) ifTrue: [self] ifFalse: [nil]! ! !RopeSegment methodsFor: 'simulating'! moveNextTowards: aPoint self moveTowards: aPoint. next moveNextTowards: location! movePreviousTowards: aPoint self moveTowards: aPoint. previous movePreviousTowards: location! moveTo: aPoint "Be sure to propogate forwards first, because display will change when change hits the RopeStart." location := aPoint rounded. next moveNextTowards: location. previous movePreviousTowards: location.! moveTowards: aPoint "Change the y calculation to (aPoint y + (delta y * self stretch // r) + 2) to get a gravity effect." | delta r | delta := location - aPoint. (r := delta x abs max: delta y abs) < self stretch ifTrue: [^self]. location := aPoint x + (delta x * self stretch // r) @ (aPoint y + (delta y * self stretch // r)) "This is the simpler, slower, all Float solution: | r theta | r := self stretch min: (location dist: aPoint). theta := (location - aPoint) theta. location := aPoint + (Point r: r theta: theta)"! stretch "Make this 5 to get the rope effect, 10 to get a caterpillar, and 16 to get a string of beads." ^5! ! !RopeSegment methodsFor: 'displaying'! displayBackgroundOn: aGraphicsContext aGraphicsContext displayWedgeBoundedBy: (location extent: self extent) startAngle: 0 sweepAngle: 360! displayFacadeOn: aGraphicsContext self facadeForm displayOn: aGraphicsContext at: location! displayOn: backgroundContext | queue foregroundContext | queue := OrderedCollection new. 20 timesRepeat: [queue addLast: self]. foregroundContext := backgroundContext copy. foregroundContext paint: ColorValue white. self displayOn: backgroundContext thenOn: foregroundContext queue: queue! displayOn: backgroundContext thenOn: foregroundContext queue: aCollection self displayBackgroundOn: backgroundContext. aCollection removeFirst displayFacadeOn: foregroundContext. aCollection addLast: self. next displayOn: backgroundContext thenOn: foregroundContext queue: aCollection! facadeForm (FacadeForm notNil and: [FacadeForm isOpen]) ifTrue: [^FacadeForm]. ^FacadeForm := (Image extent: 24@24 depth: 1 palette: CoveragePalette monoMaskPalette bits: #[0 0 0 0 0 0 0 0 0 16 0 0 2 74 0 0 0 209 0 0 7 228 128 0 9 253 32 0 3 250 0 0 11 246 160 0 17 251 0 0 10 200 128 0 0 86 32 0 11 72 128 0 16 42 0 0 2 160 0 0 0 4 128 0 4 72 0 0 0 32 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] pad: 16) asRetainedMedium! ! !RopeSegment methodsFor: 'testing'! containsPoint: aPoint "Offset because the segment is displayed with its top left corner at location." ^(location + (self extent // 2) dist: aPoint) < (self extent // 2)! ! !RopeSegment methodsFor: 'private'! initialize location := 0@0! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! RopeSegment class instanceVariableNames: ''! !RopeSegment class methodsFor: 'instance creation'! new ^super new initialize! new: anInteger | start | start := RopeStart new. start segment: (RopeEnd new). anInteger timesRepeat: [start insert: self new]. ^start! ! !RopeSegment class methodsFor: 'examples'! example "RopeSegment example" (self new: 50) open! ! Model subclass: #RopeStart instanceVariableNames: 'segment ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Rope'! RopeStart comment: 'I am the model for a rope. I act as the base case for the recursive simulation methods by notifying my dependents. My segment is a RopeSegment which is (potentially) one of many in a doubly linked list.'! !RopeStart methodsFor: 'accessing'! insert: aRopeSegment | oldSegment | oldSegment := segment. segment := aRopeSegment. oldSegment previous: aRopeSegment. aRopeSegment next: oldSegment. aRopeSegment previous: self! segment: aRopeSegment segment := aRopeSegment! segmentAt: aPoint ^segment segmentAt: aPoint! ! !RopeStart methodsFor: 'simulating'! movePreviousTowards: aPoint self changed! ! !RopeStart methodsFor: 'displaying'! displayOn: aGraphicsContext segment displayOn: aGraphicsContext! ! !RopeStart methodsFor: 'user interface'! open | topWindow topView | topWindow := ScheduledWindow new. topWindow model: self. topWindow label: 'Rope'. topView := CompositePart new. topWindow component: topView. topView add: (BorderedWrapper on: (BufferedWrapper on: (RopeView new model: self))). topWindow open! ! Model subclass: #RopeEnd instanceVariableNames: 'segment ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Rope'! RopeEnd comment: 'I am the base case for the recursive methods in RopeSegment.'! !RopeEnd methodsFor: 'accessing'! previous: aRopeSegment! segmentAt: aPoint ^nil! ! !RopeEnd methodsFor: 'simulating'! moveNextTowards: aPoint! ! !RopeEnd methodsFor: 'displaying'! displayOn: backgroundContext thenOn: foregroundContext queue: aCollection [aCollection isEmpty] whileFalse: [aCollection removeFirst displayFacadeOn: foregroundContext]! ! ControllerWithMenu subclass: #RopeController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Rope'! RopeController comment: 'I allow the user to grab a portion of the rope and drag it around.'! !RopeController methodsFor: 'control defaults'! redButtonActivity | segment previous next | segment := view segmentAt: sensor cursorPoint. segment isNil ifTrue: [^self]. previous := self sensor cursorPoint. [sensor redButtonPressed] whileTrue: [next := self sensor cursorPoint. previous ~= next ifTrue: [segment moveTo: next. previous := next]. self poll]! ! View subclass: #RopeView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Rope'! RopeView comment: 'I display a rope and find the selected segment.'! !RopeView methodsFor: 'accessing'! segmentAt: aPoint ^model segmentAt: aPoint! ! !RopeView methodsFor: 'displaying'! displayOn: aGraphicsContext model displayOn: aGraphicsContext! ! !RopeView methodsFor: 'controller accessing'! defaultControllerClass ^RopeController! !