'From Squeak2.8alpha of 19 January 2000 [latest update: #1899] on 17 March 2000 at 3:50:32 pm'! RectangleMorph subclass: #PathRectangleMorph instanceVariableNames: 'beginPoint finishRectangle counter increment path ' classVariableNames: '' poolDictionaries: '' category: 'Morphic Documentation example'! !PathRectangleMorph commentStamp: 'jlb 3/15/2000 11:35' prior: 0! I am a path following Morph. Given two rectangles, I calculate a path and then follow it.! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/15/2000 12:29'! beginPoint: thePoint finishRectangle: theRectangle beginPoint _ thePoint. finishRectangle _ theRectangle. self calculatePath.! ! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/16/2000 15:13'! calculatePath | pathRect pt1 pt2 pt3 pa pb k | pathRect _ beginPoint corner: ( finishRectangle topLeft ). pt1 _ beginPoint. pt2 _ pathRect topRight. pt3 _ finishRectangle topLeft. path _ Path new. path add: pt1. pa _ pt2 - pt1. pb _ pt3 - pt2. k _ 5 max: pa x abs + pa y abs + pb x abs + pb y abs // 20. "k is a guess as to how many line segments to use to approximate the curve." k _ k/3. 1 to: k do: [:i | path add: pa * i // k + pt1 * (k - i) + (pb * (i - 1) // k + pt2 * (i - 1)) // (k - 1)]. path add: pt3. " Now calculate the amount to increment the rectangle when we grow" increment _ ( finishRectangle extent - (8 @ 8) ) / ( path size * 2 ). increment _ increment max: ( 1 @ 1 ). increment _ increment rounded. self position: ( path at: 1 ). ! ! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/15/2000 12:57'! initialize super initialize. self color: ( Color darkGray ). counter _ 1. self borderWidth: 0. self extent: ( 8 @ 8).! ! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/16/2000 17:13'! reset " go back to where I started the animation at " counter _ 1. self extent: ( 8 @ 8). self position: beginPoint. ! ! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/15/2000 12:43'! startStepping " add me to the world " World addMorphFront: self. super startStepping.! ! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/15/2000 16:06'! step | rect1 | self position: ( path at: counter ). rect1 _ self bounds expandBy: increment. self bounds: (rect1 origin extent: ( rect1 extent min: ( finishRectangle extent ))). counter _ counter + 1. counter > ((path size) - 1) ifTrue: [ self stopStepping ]. ! ! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/17/2000 15:49'! stepTime " Everything, all the time " ^ 200.! ! !PathRectangleMorph methodsFor: 'as yet unclassified' stamp: 'jlb 3/16/2000 17:14'! stopStepping | sender | " delete removes me from the world that I entered when I started stepping " self delete. super stopStepping. self reset. " and tell my sender that I am done " sender _ self valueOfProperty: #sender. sender ifNotNil: [ sender doneAnimation].! ! !PathRectangleMorph class methodsFor: 'as yet unclassified' stamp: 'jlb 3/15/2000 12:29'! beginPoint: thePoint finishRectangle: theRectangle ^ self new beginPoint: thePoint finishRectangle: theRectangle.! !