VBounce:
CEDAR MONITOR
LOCKS data
USING data: MyData
IMPORTS BasicTime, CedarProcess, Imager, ImagerBackdoor, ImagerColor, Process, Random, TIPUser, Terminal, ViewerOps
= BEGIN
HalfDim: NAT = 200;
FullDim: NAT = HalfDim * 2;
factor: NAT ← 8; -- in {1,2,4,5,8,10,20,25,50,100} (factors of HalfDim)
MyData: TYPE = REF MyDataRec;
MyDataRec:
TYPE =
MONITORED
RECORD [
live: BOOL ← TRUE,
paintLock, objectLock: BOOL ← FALSE,
swapped: BOOL ← FALSE,
cond: CONDITION,
bitmap1,bitmap2: ImagerBackdoor.Bitmap ← NIL,
context1,context2: Imager.Context ← NIL,
line: NAT ← 0, -- scan line to wait for
nwaits: NAT ← 2, -- number of waits for that line
w,h: NAT ← FullDim, -- width & height of the bitmaps
pause: NAT ← 0, -- milliseconds to pause
mark: BasicTime.Pulses ← 0,
areaColor: Imager.Color ← Imager.white,
backColor: Imager.Color ← ImagerColor.ColorFromRGB[[R: 0.25, G: 0.05, B: 0.25]],
selectColor: Imager.Color ← ImagerColor.ColorFromRGB[[R: 0.75, G: 0.05, B: 0.05]],
changingSize: BOOL ← TRUE,
first,last: Object ← NIL,
reqx,reqy: INTEGER ← 0, -- last request for change
change: REF ← $CenterDown -- kind of change
];
rs: Random.RandomStream ← Random.Create[];
InitObjectSize: REAL = 8.0;
myPriority: CedarProcess.Priority ← excited;
MinObjectSize: REAL ← 1.0;
MaxObjectSize: REAL ← InitObjectSize + InitObjectSize;
SizeChangeScale: REAL ← 0.1;
Object: TYPE = REF ObjectRep;
ObjectRep:
TYPE =
RECORD [
next: Object ← NIL,
xs,ys: REAL ← InitObjectSize, -- (half of) size of moving box
xvs,yvs: REAL ← 0.0, -- velocity of size change
x,y: REAL ← HalfDim, -- position
vx,vy: REAL ← 0.0, -- velocity
color: Imager.Color ← Imager.black];
AcquirePaintLock:
ENTRY
PROC [data: MyData]
RETURNS [MyData] = {
acquire the lock on the viewer
ERROR ABORTED occurs if the viewer is not live
normal return implies data.paintLock = TRUE at exit
ENABLE UNWIND => NULL;
DO
IF
NOT data.live
THEN
RETURN WITH ERROR ABORTED;
IF NOT data.paintLock THEN EXIT;
WAIT data.cond;
ENDLOOP;
data.paintLock ← TRUE;
RETURN [data];
};
ReleasePaintLock:
ENTRY
PROC [data: MyData] = {
release the viewer lock and broadcast the change
normal return implies data.paintLock = FALSE at exit
ENABLE UNWIND => NULL;
data.paintLock ← FALSE;
BROADCAST data.cond;
};
AcquireObjectLock:
ENTRY
PROC [data: MyData]
RETURNS [MyData] = {
acquire the lock on the viewer
ERROR ABORTED occurs if the viewer is not live
normal return implies data.objectLock = TRUE at exit
ENABLE UNWIND => NULL;
DO
IF
NOT data.live
THEN
RETURN WITH ERROR ABORTED;
IF NOT data.objectLock THEN EXIT;
WAIT data.cond;
ENDLOOP;
data.objectLock ← TRUE;
RETURN [data];
};
ReleaseObjectLock:
ENTRY
PROC [data: MyData] = {
release the viewer objectLock and broadcast the change
normal return implies data.objectLock = FALSE at exit
ENABLE UNWIND => NULL;
data.objectLock ← FALSE;
BROADCAST data.cond;
};
WaitForSwapped:
ENTRY
PROC [data: MyData] = {
this proc just waits around for the swapped flag to go true
or for the viewer to be destroyed (causes ABORTED)
normal return implies data.swapped
this had better be called while not holding the lock!
ENABLE UNWIND => NULL;
DO
IF data.swapped THEN RETURN;
IF NOT data.live THEN RETURN WITH ERROR ABORTED;
WAIT data.cond;
ENDLOOP;
};
WaitForNotSwapped:
ENTRY
PROC [data: MyData] = {
this proc just waits around for the swapped flag to go false
or for the viewer to be destroyed (causes ABORTED)
normal return implies NOT data.swapped
this had better be called while not holding the lock!
ENABLE UNWIND => NULL;
DO
IF NOT data.swapped THEN RETURN;
IF NOT data.live THEN RETURN WITH ERROR ABORTED;
WAIT data.cond;
ENDLOOP;
};
PaintMe: ViewerClasses.PaintProc = {
self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL
data: MyData ← AcquirePaintLock[NARROW[self.data]];
IF
NOT self.iconic
THEN {
cx: INTEGER ← (self.cw-data.w)/2;
cy: INTEGER ← (self.ch+data.h)/2;
SELECT
TRUE
FROM
(whatChanged = NIL OR clear) => InitContext[context, data.backColor];
ENDCASE;
DrawBitmap[context, data.bitmap1, data.w, data.h, cx, cy];
};
data.swapped ← FALSE;
ReleasePaintLock[data];
};
DrawBitmap:
PROC [context: Imager.Context, bitmap: ImagerBackdoor.Bitmap,
w,h:
INTEGER, cx, cy:
INTEGER] = {
ImagerBackdoor.DrawBits[context, bitmap.base, bitmap.wordsPerLine,
0, 0, h, w, cx, cy];
};
DestroyMe: ViewerClasses.DestroyProc = {
the Destroy button just closes up shop for this viewer
forked processes eventually go away when they try to
acquire the lock on the viewer
data: MyData ← NARROW[self.data];
data.live ← FALSE;
};
SaveMe: ViewerClasses.SaveProc = {
the Save button rotates the object list
data: MyData ← AcquireObjectLock[NARROW[self.data]];
IF data.first #
NIL
AND data.last #
NIL
AND data.first # data.last
THEN {
data.last.next ← data.first;
data.last ← data.first;
data.first ← data.first.next;
data.last.next ← NIL};
ReleaseObjectLock[data];
};
xoff: INTEGER ← 1;
yoff: INTEGER ← 1;
TipMe: ViewerClasses.NotifyProc = {
[self: Viewer, input: LIST OF REF ANY]
N.B. Called at Process.priorityForeground!
we have conspired to make the leading item in the list
an atom that tells us what to do with the rest of the list
first: REF ← IF input = NIL THEN NIL ELSE input.first;
rest: LIST OF REF ANY ← IF input = NIL THEN NIL ELSE input.rest;
second: REF ← IF rest = NIL THEN NIL ELSE rest.first;
data: MyData ← NIL;
coord: TIPTables.TIPScreenCoords ← NIL;
x,y: INTEGER ← 0;
SELECT first
FROM
$LeftDown, $RightDown, $CenterDown => {};
ENDCASE => RETURN;
data ← NARROW[self.data];
coord ← NARROW[second, TIPTables.TIPScreenCoords];
adjust to our coordinates, and let the world know
there is a small chance of race, but not too much
data.reqx ← coord.mouseX - (self.cw-data.w)/2 + xoff;
data.reqy ← coord.mouseY - (self.ch-data.h)/2 + yoff;
data.change ← first;
};
SwapBitmaps:
PROC [arg: MyData] = {
this internal proc swaps the bitmaps for the viewer
everything is properly locked at the time, of course
we depend on ReleasePaintLock to broadcast the change
data: MyData ← AcquirePaintLock[arg];
bm: ImagerBackdoor.Bitmap ← data.bitmap1;
ctx: Imager.Context ← data.context1;
data.bitmap1 ← data.bitmap2;
data.bitmap2 ← bm;
data.context1 ← data.context2;
data.context2 ← ctx;
data.swapped ← TRUE;
ReleasePaintLock[arg];
};
InitContext:
PROC [context: Imager.Context, color: Imager.Color] = {
init the context to a solid color
Imager.SetColor[context, color];
Imager.MaskRectangle[context, ImagerBackdoor.GetBounds[context]];
};
lastdt: REAL ← 0.0;
OneStep:
PROC [data: MyData] = {
calculate one step of this kinetic thrill
we are allowed to write without locking into data.context2
since no one else is allowed to touch it
ctx: Imager.Context ← data.context2;
newMark: BasicTime.Pulses ← BasicTime.GetClockPulses[];
box: Imager.Rectangle ← ImagerBackdoor.GetBounds[ctx];
xMax: REAL ← box.x+box.w;
yMax: REAL ← box.y+box.h;
dt: REAL ← 1e-6;
reqx: INTEGER ← data.reqx;
reqy: INTEGER ← data.reqy;
cx: INTEGER ← data.w/2;
cy: INTEGER ← data.h/2;
change: REF ← data.change;
data.change ← NIL;
InitContext[ctx, data.areaColor];
IF newMark = data.mark THEN RETURN;
dt ← BasicTime.PulsesToSeconds[newMark-data.mark];
lastdt ← dt;
IF change = $CenterDown
THEN {
data.changingSize ← NOT data.changingSize;
};
FOR object: Object ← data.first, object.next
UNTIL object =
NIL
DO
thisx, nextx: REAL ← object.x;
thisy, nexty: REAL ← object.y;
vx: REAL ← object.vx;
vy: REAL ← object.vy;
nextx ← thisx + vx * dt;
nexty ← thisy + vy * dt;
IF vx < 0.0
AND nextx < box.x
THEN {
reflect off of the left
dx: REAL ← box.x - nextx;
nextx ← box.x + dx;
vx ← - vx};
IF vx > 0.0
AND nextx > xMax
THEN {
reflect off of the right
dx: REAL ← nextx - xMax;
nextx ← xMax - dx;
vx ← - vx};
IF vy < 0.0
AND nexty < box.y
THEN {
reflect off of the bottom
dy: REAL ← box.y - nexty;
nexty ← box.y + dy;
vy ← - vy};
IF vy > 0.0
AND nexty > yMax
THEN {
reflect off of the top
dy: REAL ← nexty - yMax;
nexty ← yMax - dy;
vy ← - vy};
IF change #
NIL
THEN {
SELECT change
FROM
$LeftDown => {
nextx ← reqx; nexty ← reqy; change ← NIL};
$RightDown => {
vx ← reqx - cx; vy ← reqy - cy; change ← NIL};
$CenterDown => {
nextx ← cx; nexty ← cy;
object.xs ← object.ys ← InitObjectSize;
IF data.changingSize
THEN {
Randomize the velocity changes
nxvs: INT ← Random.ChooseInt[rs, 0, cx+cx];
nyvs: INT ← Random.ChooseInt[rs, 0, cy+cy];
object.xvs ← nxvs * SizeChangeScale;
object.yvs ← nyvs * SizeChangeScale;
};
DO
nvx: INT ← Random.ChooseInt[rs, 0, cx+cx];
nvy: INT ← Random.ChooseInt[rs, 0, cy+cy];
vx ← (nvx / factor) * factor - cx;
vy ← (nvy / factor) * factor - cy;
IF vx # 0 AND vy # 0 THEN EXIT;
ENDLOOP;
IF object = data.first THEN vx ← vy ← 0};
ENDCASE;
};
Imager.SetColor [
ctx,
IF object = data.first
THEN data.selectColor
ELSE object.color];
Imager.MaskBox [
ctx,
[thisx - object.xs, thisy - object.ys, thisx + object.xs, thisy + object.ys]];
object.x ← nextx;
object.y ← nexty;
object.vx ← vx;
object.vy ← vy;
IF data.changingSize
THEN {
object.xs ← object.xs + object.xvs * dt;
object.ys ← object.ys + object.yvs * dt;
SELECT object.xs
FROM
< MinObjectSize => {object.xs ← MinObjectSize; object.xvs ← -object.xvs};
> MaxObjectSize => {object.xs ← MaxObjectSize; object.xvs ← -object.xvs};
ENDCASE;
SELECT object.ys
FROM
< MinObjectSize => {object.ys ← MinObjectSize; object.yvs ← -object.yvs};
> MaxObjectSize => {object.ys ← MaxObjectSize; object.yvs ← -object.yvs};
ENDCASE;
};
ENDLOOP;
data.mark ← newMark;
};
MakeVBounceClass:
PROC = {
tipTable: TIPUser.TIPTable ← TIPUser.InstantiateNewTIPTable["VBounce.tip"];
viewerClass: ViewerClasses.ViewerClass ←
NEW [
ViewerClasses.ViewerClassRec ← [
paint: PaintMe, -- called whenever the Viewer should repaint
notify: TipMe, -- TIP input events
modify: NIL, -- InputFocus changes reported through here
destroy: DestroyMe, -- called before Viewer structures freed on destroy op
copy: NIL, -- copy data to new Viewer
set: NIL, -- set the viewer contents
get: NIL, -- get the viewer contents
init: NIL, -- called on creation or reset to init data
save: SaveMe, -- requests client to write contents to disk
scroll: NIL, -- document scrolling
icon: document, -- picture to display when small
tipTable: tipTable, -- could be moved into Viewer instance if needed
cursor: crossHairsCircle -- standard cursor when mouse is in viewer
]];
ViewerOps.RegisterViewerClass[$VBounce, viewerClass];
};
Rest:
PROC [amount:
NAT] = {
IF amount > 0 THEN Process.Pause[Process.MsecToTicks[amount]]};
Mother:
PROC [data: MyData, viewer: ViewerClasses.Viewer] = {
WHILE data.live
DO
ENABLE ABORTED => EXIT;
CedarProcess.SetPriority[myPriority];
OneStep[data];
WaitForNotSwapped[data];
SwapBitmaps[data];
IF
NOT viewer.iconic
THEN Rest[data.pause]
ELSE Rest[1000];
ENDLOOP;
};
Father:
PROC [data: MyData, viewer: ViewerClasses.Viewer] =
TRUSTED {
WHILE data.live
DO
ENABLE ABORTED => EXIT;
CedarProcess.SetPriority[myPriority];
IF viewer.iconic THEN Rest[1000];
FOR i:
NAT
IN [0..data.nwaits)
DO
Terminal.WaitForBWVerticalRetrace[Terminal.Current[]];
ENDLOOP;
IF data.swapped
THEN
ViewerOps.PaintViewer[viewer, client, FALSE, $Update];
ENDLOOP;
};
Test:
PROC [n:
NAT ← 1]
RETURNS [viewer: ViewerClasses.Viewer] =
TRUSTED {
data: MyData ← NEW[MyDataRec ← []];
viewer ← NIL;
IF n = 0 THEN RETURN;
data.bitmap1 ← ImagerBackdoor.NewBitmap[data.w, data.h];
data.bitmap2 ← ImagerBackdoor.NewBitmap[data.w, data.h];
data.context1 ← ImagerBackdoor.BitmapContext[data.bitmap1];
data.context2 ← ImagerBackdoor.BitmapContext[data.bitmap2];
data.mark ← BasicTime.GetClockPulses[];
WHILE n > 0
DO
AddObject[data];
n ← n - 1;
ENDLOOP;
viewer ← ViewerOps.CreateViewer
[flavor: $VBounce, info: [name: "VBounce", column: left, data: data]];
viewer.openHeight ← FullDim + FullDim/10;
Process.Detach[FORK Mother[data, viewer]];
Process.Detach[FORK Father[data, viewer]];
};
AddObject:
PROC [data: MyData] = {
object: Object ← NEW[ObjectRep];
object.next ← data.first;
IF data.last = NIL THEN data.last ← object;
data.first ← object;
};
d: MyData ← NIL;
MakeVBounceClass[];
d ← NARROW[Test[32].data];
END.