[comp.lang.smalltalk] Silly interactive goodie

trevor@mucs.UX.CS.MAN.AC.UK (Trevor Hopkins) (01/03/88)

References:


Here's a little goodie that has kept a few people here entertained from
time to time.  It's a hierachy of classes of objects (rooted at class
Bouncer) which know how to `bounce' around the display screen.  These
include lines, boxes and rectangles, curves and circles, and parallelograms
(yes, really).

The concrete subclasses know how to display themselves directly on the
screen, so that they can be used, for example, as something on the screen
while a `LockScreen' is running (I find this very useful).  Alternatively,
they can be used in conjuction with BouncerView and BouncerController to
provide an interactive interface.

Look at the class comments, and the examples in the Bouncer class protocol
`examples' and BouncerView class protocol `instance creation' for further
information.

This goodie is know to work with VI2.2 images, and could probably be made
to work with earlier images by replacing class Model with class Object.

Have fun,
		Trevor.
------------------------------------------------------------------
Trevor P. Hopkins, Room 2.81, Department of Computer Science,
University of Manchester, Oxford Road, Manchester, M13 9PL, U.K.
Tel: (+44) 61-273 7121 ext: 5553 (old), (+44) 61-275 6170 (new)
JANET: trevor@uk.ac.man.cs.ux    USENET: ..mcvax!ukc!man.cs.ux!trevor
------------------------------------------------------------------
Model subclass: #Bouncer
	instanceVariableNames: 'positions firstStep secondStep boundingBox numberOfLines '
	classVariableNames: 'DefaultFirstStep DefaultNumberOfLines DefaultSecondStep NumberOfLines '
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
Bouncer comment:
'I represent an abstract superclass of things which are able to
bounce around in a closed (2D) space, and can be represented
by two points.  I can display directly onto the Display, or I can
be used in conjuction with BouncerView and BouncerController.
My instance variables are:

positions		An OrderedCollection of Array, each containing two Points.
				Points are removed from one end of this OrderedCollection
				and generated anew at the other.

firstStep		These two instance variables are Points representing
secondStep		delta changes for new endPoint generation.

boundingBox	A Rectangle indicating the region within which things can
				be displayed.

numberOfLines	The number of Arrays in <positions>.  This can be changed
				on the fly, if desired.

I have a number of default values (as Class variables) which may be used
by my concrete subclasses.
'!


!Bouncer methodsFor: 'initialize-release'!

initialize
	"Initialize instance variables.  Set up the initiali positions for each
	 element."

	boundingBox _ Display boundingBox	.
	self initializeLinesAndSteps.
	self setStartLocations.! !

!Bouncer methodsFor: 'accessing'!

boundingBox
	"Answer with the rectangle in which the lines are displayed."

	^boundingBox!

boundingBox: aRectangle
	"Set the rectangle in which the lines are displayed to aRectangle."

	boundingBox _ aRectangle!

firstStep
	"Answer with the first step value."

	^firstStep!

firstStep: aPoint
	"Set the first step value to aPoint."

	firstStep _ aPoint.!

numberOfLines
	"Answer with the number of lines."

	^numberOfLines!

numberOfLines: aNumber
	"Set the number of lines to be aNumber."

	numberOfLines _ aNumber!

positions
	"Answer with the orderedCollection of end-points."

	^positions!

secondStep
	"Answer with the second step value."

	^secondStep!

secondStep: aPoint
	"Set the second step value to aPoint."

	secondStep _ aPoint.! !

!Bouncer methodsFor: 'moving'!

move
	"Update the positions of the receiver."

	| length |
	length _ positions size.
	length > numberOfLines ifTrue: [self display: positions removeLast].
	length >= numberOfLines ifTrue: [self display: positions removeLast].
	self display:
		(positions addFirst:
			(Array with: self newStart with: self newEnd))! !

!Bouncer methodsFor: 'displaying'!

display: anArray
	"Display the receiver in a manner represented by the two points in anArray"

	self subclassResponsibility! !

!Bouncer methodsFor: 'private'!

initializeLinesAndSteps
	"Set the the default number of lines, and the default step values."

	numberOfLines _ DefaultNumberOfLines.
	firstStep _ DefaultFirstStep copy.
	secondStep _ DefaultSecondStep copy!

newEnd
	"Answer with the new value of the end point, updating
	 the step value if a bounce has occured."

	| end |
	end _ (positions first at: 2) + secondStep.
	(end x >= boundingBox corner x or:
		[end x <= boundingBox origin x]) ifTrue: [
			secondStep x: secondStep x negated.
			end x: end x + (2 * secondStep x)].
	(end y >= boundingBox corner y or:
		[end y <= boundingBox origin y]) ifTrue: [
			secondStep y: secondStep y negated.
			end y: end y + (2 * secondStep y)].
	^end!

newStart
	"Answer with the new value of the start point, updating
	 the step value if a bounce has occured."

	| start |
	start _ (positions first at: 1) + firstStep.
	(start x >= boundingBox corner x or:
		[start x <= boundingBox origin x]) ifTrue: [
			firstStep x: firstStep x negated.
			start x: start x + (2 * firstStep x)].
	(start y >= boundingBox corner y or:
		[start y <= boundingBox origin y]) ifTrue: [
			firstStep y: firstStep y negated.
			start y: start y + (2 * firstStep y)].
	^start!

setStartLocations
	"Set the start locations to be in the centre of the bounding box."

	self startAt: boundingBox center and: boundingBox center + (4@0)!

startAt: firstPoint and: secondPoint
	"The receiver is initially drawn between firstPoint and secondPoint."

	positions _ OrderedCollection new.
	numberOfLines timesRepeat: [
		positions addLast: (Array with: firstPoint with: secondPoint)].! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Bouncer class
	instanceVariableNames: ''!


!Bouncer class methodsFor: 'instance creation'!

new
	"Answer with an initialized instance of the receiver."

	^super new initialize! !

!Bouncer class methodsFor: 'class initialization'!

initialize
	"Initialize class variables."
	"Bouncer initialize."

	DefaultNumberOfLines _ 50.
	DefaultFirstStep _ 3@4.
	DefaultSecondStep _ 5@2! !

!Bouncer class methodsFor: 'examples'!

example1
	"BouncerRectangle example1"
	"BouncerLine example1."
	"BouncerBox example1."
	"BouncerParallelogram example1."
	"BouncerCurve example1."
	"BouncerCircle example1."

	| bouncer |
	Display white.
	bouncer _ self new.
	[Sensor redButtonPressed not] whileTrue: [bouncer move].
	ScheduledControllers restore!

example2
	"BouncerLine example2"
	"BouncerRectangle example2."
	"BouncerBox example2."
	"BouncerParallelogram example2."
	"BouncerCurve example2."
	"BouncerCircle example2."

	| bouncer box |
	box _ Rectangle origin: 50@50 extent: 400@300.
	Display white: box.
	bouncer _ self new boundingBox: box.
	bouncer setStartLocations.
	[Sensor redButtonPressed not] whileTrue: [bouncer move].
	ScheduledControllers restore! !

Bouncer initialize!


Bouncer subclass: #BouncerCurve
	instanceVariableNames: 'curve '
	classVariableNames: 'CurveDefaultFirstStep CurveDefaultNumberOfLines CurveDefaultSecondStep '
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerCurve comment:
'I am a concrete Bouncer subclass which represents each element as
a closed curve constructed from four Curves (conic sections).  The
closed curve so formed just fits into a rectangle with origin and
corner given by the two points representing each element.
'!


!BouncerCurve methodsFor: 'initialize-release'!

initialize
	"Initialize additional instance variables."

	| form |
	super initialize.
	form _ Form new extent: 1@1.
	form black.
	curve _ Curve new form: form.! !

!BouncerCurve methodsFor: 'displaying'!

display: anArray
	"Display the receiver as a closed curve represented by the
	 two points in anArray"

	self displayCurve: anArray!

displayBottomLeft: rect 
	"Display the bottom left part of a closed curve in the rectangle rect."

	curve firstPoint: rect bottomCenter.
	curve secondPoint: rect bottomLeft.
	curve thirdPoint: rect leftCenter.
	curve
		displayOn: Display
		at: 0 @ 0
		clippingBox: self boundingBox
		rule: Form reverse
		mask: Form black!

displayBottomRight: rect
	"Display the bottom right part of a curve in the rectangle rect."

	curve firstPoint: rect bottomCenter.
	curve secondPoint: rect bottomRight.
	curve thirdPoint: rect rightCenter.
	curve
		displayOn: Display
		at: 0 @ 0
		clippingBox: self boundingBox
		rule: Form reverse
		mask: Form black!

displayCurve: anArray
	"Display a closed curve represented by two points."

	| rect |
	rect _ Rectangle origin: (anArray at: 1) corner: (anArray at: 2).
	self displayTopRight: rect.
	self displayBottomRight: rect.
	self displayBottomLeft: rect.
	self displayTopLeft: rect!

displayTopLeft: rect
	"Display the top left part of a curve in the rectangle rect."

	curve firstPoint: rect topCenter.
	curve secondPoint: rect topLeft.
	curve thirdPoint: rect leftCenter.
	curve
		displayOn: Display
		at: 0 @ 0
		clippingBox: self boundingBox
		rule: Form reverse
		mask: Form black!

displayTopRight: rect
	"Display the top right part of a curve in the rectangle rect."

	curve firstPoint: rect topCenter.
	curve secondPoint: rect topRight.
	curve thirdPoint: rect rightCenter.
	curve
		displayOn: Display
		at: 0 @ 0
		clippingBox: self boundingBox
		rule: Form reverse
		mask: Form black! !

!BouncerCurve methodsFor: 'private'!

initializeLinesAndSteps
	"Set the the default number of lines, and the default step
	 values.  Different defaults are required for closed curves."

	numberOfLines _ CurveDefaultNumberOfLines.
	firstStep _ CurveDefaultFirstStep copy.
	secondStep _ CurveDefaultSecondStep copy! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BouncerCurve class
	instanceVariableNames: ''!


!BouncerCurve class methodsFor: 'class initialization'!

initialize
	"Different defaults are required for curves."
	"BouncerCurve initialize."

	CurveDefaultNumberOfLines _ 15.
	CurveDefaultFirstStep _ -7@-6.
	CurveDefaultSecondStep _ 5@8.! !

BouncerCurve initialize!


Bouncer subclass: #BouncerRectangle
	instanceVariableNames: ''
	classVariableNames: 'RectangleDefaultFirstStep RectangleDefaultNumberOfLines RectangleDefaultSecondStep '
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerRectangle comment:
'I am a concrete Bouncer class, which displays each element as a
rectangle, with origin and corner given by the two points representing
each element.  I simply reverse the screen color within my rectangle.'!


!BouncerRectangle methodsFor: 'displaying'!

display: anArray
	"Display the receiver as a rectangle represented by the
	 two points in anArray"

	self displayRectangle: anArray!

displayRectangle: anArray
	"Display a rectangle given by the two points in anArray"

	Display reverse:
			(Rectangle
				origin: ((anArray at: 1) min: (anArray at: 2))
				corner: ((anArray at: 1) max: (anArray at: 2)))! !

!BouncerRectangle methodsFor: 'private'!

initializeLinesAndSteps
	"Set the the default number of lines, and the default step
	 values.  Different defaults are required for rectangles."

	numberOfLines _ RectangleDefaultNumberOfLines.
	firstStep _ RectangleDefaultFirstStep copy.
	secondStep _ RectangleDefaultSecondStep copy! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BouncerRectangle class
	instanceVariableNames: ''!


!BouncerRectangle class methodsFor: 'class initialization'!

initialize
	"Different defaults are required for rectangles."
	"BouncerRectangle initialize."

	RectangleDefaultNumberOfLines _ 200.
	RectangleDefaultFirstStep _ -2@-2.
	RectangleDefaultSecondStep _ 2@2.! !

BouncerRectangle initialize!


Bouncer subclass: #BouncerCircle
	instanceVariableNames: 'circle '
	classVariableNames: 'CircleDefaultFirstStep CircleDefaultNumberOfLines CircleDefaultSecondStep '
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerCircle comment:
'I am a concrete Bouncer subclass which represents each element as
a circle which just fits into a rectangle with origin and corner given
by the two points representing each element.
'!


!BouncerCircle methodsFor: 'initialize-release'!

initialize
	"Initialize additional instance variables."

	| form |
	super initialize.
	form _ Form new extent: 1@1.
	form black.
	circle _ Circle new form: form.! !

!BouncerCircle methodsFor: 'displaying'!

display: anArray
	"Display the receiver as a circle represented by the
	 two points in anArray"

	self displayCircle: anArray!

displayCircle: anArray
	"Display a circle in the centre of a rectangle represented by
	 the two points in anArray"

	| rect |
	rect _ Rectangle origin: (anArray at: 1) corner: (anArray at: 2).
	circle center: rect center.
	circle radius: ((rect width abs min: rect height abs) // 2 max: 18).
	circle
		displayOn: Display
		at: 0 @ 0
		clippingBox: self boundingBox
		rule: Form reverse
		mask: Form black! !

!BouncerCircle methodsFor: 'private'!

initializeLinesAndSteps
	"Set the the default number of lines, and the default step
	 values.  Different defaults are required for circles."

	numberOfLines _ CircleDefaultNumberOfLines.
	firstStep _ CircleDefaultFirstStep copy.
	secondStep _ CircleDefaultSecondStep copy! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BouncerCircle class
	instanceVariableNames: ''!


!BouncerCircle class methodsFor: 'class initialization'!

initialize
	"Different defaults are required for circles."
	"BouncerCircle initialize."

	CircleDefaultNumberOfLines _ 20.
	CircleDefaultFirstStep _ -7@-3.
	CircleDefaultSecondStep _ 5@4.! !

BouncerCircle initialize!


Bouncer subclass: #BouncerLineTypes
	instanceVariableNames: 'pen '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerLineTypes comment:
'I am an abstract superclass representing bouncers which display
themselves using lines.  I add an instance variable, pen, which is
used to draw the lines (for efficiency reasons, the same pen is used
throughout.)

'!


!BouncerLineTypes methodsFor: 'initialize-release'!

initialize
	"Initialize instance variables."

	super initialize.
	pen _ Pen new.
	pen combinationRule: Form reverse.
	pen destForm: Display.
	pen frame: Display boundingBox! !

!BouncerLineTypes methodsFor: 'accessing'!

boundingBox: aRectangle
	"Override this message to permit the frame of the pen to be changed."

	super boundingBox: aRectangle.
	pen frame: aRectangle! !

!BouncerLineTypes methodsFor: 'displaying'!

display: anArray
	"Display the receiver as a line represented by the two points in anArray"

	self displayLine: anArray! !

View subclass: #BouncerView
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerView comment:
'I am a view capable of displaying any concrete Bouncer subclass.
I should be used together with instances of BouncerController.'!


!BouncerView methodsFor: 'displaying'!

displayView
	"Re-display the entire contents of the model."

	model boundingBox = self insetDisplayBox ifFalse: [
		self controller updateBoundingBox].
	model positions reverseDo: [:eachPair |
		model display: eachPair].! !

!BouncerView methodsFor: 'controller access'!

defaultControllerClass
	^BouncerController! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BouncerView class
	instanceVariableNames: ''!


!BouncerView class methodsFor: 'instance creation'!

openOn: aBouncer
	"Open a new view on a Bouncer."

	"BouncerView openOn: BouncerLine new."
	"BouncerView openOn: BouncerRectangle new."
	"BouncerView openOn: BouncerBox new."
	"BouncerView openOn: BouncerParallelogram new."
	"BouncerView openOn: BouncerCircle new."
	"BouncerView openOn: BouncerCurve new."

	| topView bouncerView |
	topView _ StandardSystemView
					model: nil
					label: aBouncer class printString,' Demo'
					minimumSize: 221@200.
	bouncerView _ self new borderWidth: 1.
	bouncerView model: aBouncer.
	bouncerView insideColor: Form white.
	topView addSubView: bouncerView.
	topView controller open! !

BouncerLineTypes subclass: #BouncerBox
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerBox comment:
'I am a concrete Bouncer subclass which displays myself by drawing
a 1-pixel wide box at the edge of a rectangle formed by the two
points representing each element.'!


!BouncerBox methodsFor: 'displaying'!

displayLine: anArray
	"Display a box given the two points contains in anArray."

	pen place: (anArray at: 1).
	pen goto: (anArray at: 1) x @ (anArray at: 2) y.
	pen goto: (anArray at: 2).
	pen goto: (anArray at: 2) x @ (anArray at: 1) y.
	pen goto: (anArray at: 1)! !

BouncerLineTypes subclass: #BouncerParallelogram
	instanceVariableNames: 'ratio oneMinusRatio '
	classVariableNames: 'ParallelogramDefaultFirstStep ParallelogramDefaultNumberOfLines ParallelogramDefaultSecondStep ParallelogramFormFactor '
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerParallelogram comment:
'I am a concrete Bouncer subclass which displays a parallelogram
with major axis given by the two points representing each element.
The ratio of the major to the minor axis is given by an instance
variable, ratio.  For efficiency reasons, a second instance variable,
oneMinusRatio, is used to avoid re-computing this value unnecessarily.'!


!BouncerParallelogram methodsFor: 'initialize-release'!

initialize
	"Initialize the form factor ratio."

	super initialize.
	ratio _ ParallelogramFormFactor.
	oneMinusRatio _ (1 - ParallelogramFormFactor)! !

!BouncerParallelogram methodsFor: 'displaying'!

displayLine: anArray 
	"Display a parallelogram defined by the two points in anArray."

	| first second third fourth |
	first _ anArray at: 1.
	third _ anArray at: 2.
	second _ first +
		((third x - first x * (1 - ratio)) @ (third y - first y * ratio)) rounded.
	fourth _ first +
		((third x - first x * ratio) @ (third y - first y * (1 - ratio))) rounded.
	pen place: first.
	pen goto: second.
	pen goto: third.
	pen goto: fourth.
	pen goto: first! !

!BouncerParallelogram methodsFor: 'private'!

initializeLinesAndSteps
	"Set the the default number of lines, and the default step
	 values.  Different defaults are required for parallelograms."

	numberOfLines _ ParallelogramDefaultNumberOfLines.
	firstStep _ ParallelogramDefaultFirstStep copy.
	secondStep _ ParallelogramDefaultSecondStep copy! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BouncerParallelogram class
	instanceVariableNames: ''!


!BouncerParallelogram class methodsFor: 'class initialization'!

initialize
	"Different defaults are required for Parallelograms."
	"BouncerParallelogram initialize."

	ParallelogramDefaultNumberOfLines _ 35.
	ParallelogramDefaultFirstStep _ 7@9.
	ParallelogramDefaultSecondStep _ 5@8.
		"Should be between 0 and 1."
	ParallelogramFormFactor _ (2 / 7) asFloat	"for efficiency."! !

BouncerParallelogram initialize!


BouncerLineTypes subclass: #BouncerLine
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerLine comment:
'I am a concrete bouncer class.  I display myself as a simple straight
line between the two points representing each element.'!


!BouncerLine methodsFor: 'displaying'!

displayLine: anArray
	"Display a line between the two points contains in anArray."

	pen place: (anArray at: 1).
	pen goto: (anArray at: 2).! !

MouseMenuController subclass: #BouncerController
	instanceVariableNames: ''
	classVariableNames: 'BouncerYellowButtonMenu BouncerYellowButtonMessages '
	poolDictionaries: ''
	category: 'Graphics-Bouncer'!
BouncerController comment:
'I am a controller suitable for use with BouncerView instances, and
any concrete subclass of Bouncer.  I allow the user to modify
various parameters associated with Bouncers.'!


!BouncerController methodsFor: 'initialize-release'!

initialize
	"Initialize the yellow button menu."

	super initialize.
	self
		yellowButtonMenu: BouncerYellowButtonMenu
		yellowButtonMessages: BouncerYellowButtonMessages! !

!BouncerController methodsFor: 'menu messages'!

changeNumberOfLines
	"Prompt the user for a new number of lines to be displayed."

	| anAnswer |
	anAnswer _ FillInTheBlank request: 'Number of lines to be displayed?'
		initialAnswer: self model numberOfLines printString.
	anAnswer isEmpty ifFalse: [
		self model numberOfLines:
			((Number readFrom: (ReadStream on: anAnswer)) max: 2)].!

changeSteps
	"Prompt the user for new values for each step size."

	| firstX firstY secondX secondY |
	firstX _ FillInTheBlank request: 'First X step value?'
		initialAnswer: self model firstStep x printString.
	firstX isEmpty ifFalse: [
		self model firstStep x:
			((Number readFrom: (ReadStream on: firstX)))].
	firstY _ FillInTheBlank request: 'First Y step value?'
		initialAnswer: self model firstStep y printString.
	firstY isEmpty ifFalse: [
		self model firstStep y:
			((Number readFrom: (ReadStream on: firstY)))].
	secondX _ FillInTheBlank request: 'First X step value?'
		initialAnswer: self model secondStep x printString.
	secondX isEmpty ifFalse: [
		self model secondStep x:
			((Number readFrom: (ReadStream on: secondX)))].
	secondY _ FillInTheBlank request: 'First Y step value?'
		initialAnswer: self model secondStep y printString.
	secondY isEmpty ifFalse: [
		self model secondStep y:
			((Number readFrom: (ReadStream on: secondY)))].!

reset
	"Restart the model, with the default values."

	view clearInside.
	model initializeLinesAndSteps.
	model setStartLocations.!

restart
	"Restart the model, with the default values."

	view clearInside.
	model setStartLocations.! !

!BouncerController methodsFor: 'model control'!

changeModel
	"Modify the model."

	model boundingBox == view insetDisplayBox ifFalse: [self updateBoundingBox].
	8 timesRepeat: [model move]!

updateBoundingBox
	"The boundingBox has changed, so fix up the model to stay inside."

	model boundingBox = Display boundingBox ifTrue: [
		^self initializeBoundingBox].
	model boundingBox extent <= view insetDisplayBox extent
		ifTrue: [self makeBoundingBoxLarger]
		ifFalse: [self makeBoundingBoxSmaller].
	model boundingBox: view insetDisplayBox! !

!BouncerController methodsFor: 'control defaults'!

controlActivity
	"Only interested in yellow button activities, apart from
	 the changes to the model."

	sensor yellowButtonPressed & self viewHasCursor 
		ifTrue: [^self yellowButtonActivity].
	self changeModel.
	super controlActivity!

isControlActive
	^(view containsPoint: sensor cursorPoint) & sensor blueButtonPressed not! !

!BouncerController methodsFor: 'private'!

initializeBoundingBox
	"First time round, fix the model's boundingBox so that it fits
	 within the view's boundingBox."

	model boundingBox: self view insetDisplayBox.
	model initializeLinesAndSteps.
	model setStartLocations!

makeBoundingBoxLarger
	"Modify the model's positions so that they fix into the new
	 display boundingBox."

	| offset |
	offset _ model boundingBox origin - view insetDisplayBox origin.
	model positions do: [:eachPair |
		eachPair at: 1 put: (eachPair at: 1) - offset.
		eachPair at: 2 put: (eachPair at: 2) - offset]!

makeBoundingBoxSmaller
	"Scale and translate the model's positions so that they fix into the new
	 display boundingBox."

	| scale mOrigin vOrigin |
	scale _ view insetDisplayBox extent / model boundingBox extent.
	mOrigin _ model boundingBox origin.
	vOrigin _ view insetDisplayBox origin.
	model positions do: [:eachPair |
		eachPair at: 1 put:
			((eachPair at: 1) - vOrigin * scale) truncated + mOrigin.
		eachPair at: 2 put:
			((eachPair at: 2) - vOrigin * scale) truncated + mOrigin].! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BouncerController class
	instanceVariableNames: ''!


!BouncerController class methodsFor: 'class initialization'!

initialize
	"BouncerController initialize."

	BouncerYellowButtonMenu _ PopUpMenu
		labels: 'number of lines\x/y steps\restart\reset' withCRs
		lines: #(2).
	BouncerYellowButtonMessages _ #(changeNumberOfLines changeSteps restart reset).! !

BouncerController initialize!