HourGlassImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
edited by McGregor, October 25, 1982 10:17 am
Last Edited by: Maxwell, January 3, 1983 12:51 pm
Doug Wyatt, April 14, 1985 11:47:58 pm PST
DIRECTORY
ViewerPrivate USING [],
Interminal USING [SetCursorPattern];
HourGlassImpl: CEDAR PROGRAM
IMPORTS Interminal
EXPORTS ViewerPrivate
= TRUSTED BEGIN
See HourGlass.mesa for instructions on how to use these procedures.
Here's how to modify the cursor: change the initialHourglass array below to anything
you like for an initial cursor. Count the number of bits (of sand) contained in the top
and change the constant grains to this number. sandArray will also need to be changed
in InitializeHourglass. The first seven numbers tell how many grains there are to start in
the top rows of the hourglass (not counting the sides). The last seven numbers tell how
many empty places (slots for sand grains) there are in the bottom rows of the hourglass.
The algorithm that moves the grains will carefully skip over any grains you initially put
in the bottom. Other fun things to play with are the constants that control how steep
(slope) the sand piles up in the bottom, or drains from the top. Happy hacking, /Scott.
X: BOOL = TRUE;
O: BOOL = FALSE;
theHGBits: PACKED ARRAY [0..16*16) OF BOOL;
theHG: POINTER TO PACKED ARRAY [0..16*16) OF BOOL ← @theHGBits;
initialHourglass: PACKED ARRAY [0..16*16) OF BOOL = [
X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X,
X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X,
O, X, X, X, X, X, X, X, X, X, X, X, X, X, X, O,
O, O, X, X, X, X, X, X, X, X, X, X, X, X, O, O,
O, O, O, X, X, X, X, X, X, X, X, X, X, O, O, O,
O, O, O, O, X, X, X, X, X, X, X, X, O, O, O, O,
O, O, O, O, O, X, X, X, X, X, X, O, O, O, O, O,
O, O, O, O, O, O, X, X, X, X, O, O, O, O, O, O,
O, O, O, O, O, O, X, O, O, X, O, O, O, O, O, O,
O, O, O, O, O, X, O, O, O, O, X, O, O, O, O, O,
O, O, O, O, X, O, O, O, O, O, O, X, O, O, O, O,
O, O, O, X, O, O, O, O, O, O, O, O, X, O, O, O,
O, O, X, O, O, O, O, O, O, O, O, O, O, X, O, O,
O, X, O, O, O, O, O, O, O, O, O, O, O, O, X, O,
X, O, O, O, O, O, O, O, O, O, O, O, O, O, O, X,
X, X, X, X, X, X, X, X, X, X, X, X, X, X, X, X
];
grains: CARDINAL = 56;
initGrains: CARDINAL = 3;
invertSand: BOOL ← TRUE;
sand: BOOL ← TRUE;
sandArray: ARRAY [1..15) OF CARDINAL;
sandUsed, tick, totalTicks, savedTicks: CARDINAL;
InitializeHourglass: PUBLIC PROC [ticks: CARDINAL] = TRUSTED {
savedTicks ← ticks;
sandUsed ← tick ← 0;
totalTicks ← ticks;
theHG^ ← initialHourglass;
sandArray ← [14, 12, 10, 8, 6, 4, 2, 2, 3, 6, 7, 10, 11, 14];
sand ← TRUE;
};
TickHourglass: PUBLIC PROC = TRUSTED {
incr: INTEGER;
n, m: CARDINAL;
topSlope: CARDINAL = 3;
bottomSlope: CARDINAL = 2;
IF (tick←tick+1) > totalTicks THEN { -- wrap around
IF invertSand THEN sand ← ~sand ELSE theHG^ ← initialHourglass;
sandUsed ← tick ← 0;
totalTicks ← savedTicks;
sandArray ← [14, 12, 10, 8, 6, 4, 2, 2, 3, 6, 7, 10, 11, 14];
RETURN;
}
ELSE THROUGH [sandUsed..MIN[tick*grains/totalTicks, grains]) DO
take a grain out of the top non-empty row of sand, favoring the middle.
FOR n DECREASING IN [2..8) DO
IF sandArray[n] >= sandArray[n-1]+topSlope THEN EXIT;
REPEAT FINISHED => FOR n IN [1..8) DO
IF sandArray[n]#0 THEN EXIT;
ENDLOOP;
ENDLOOP;
sandArray[n] ← sandArray[n]-1;
m ← (n*16)+7;
incr ← 1;
UNTIL theHG[m]=sand DO
m ← m+incr;
incr ← -incr + (IF incr<0 THEN 1 ELSE -1);
ENDLOOP;
theHG[m] ← ~sand;
put a grain in one of the top non-empty rows of sand, favoring the middle,
and using the slope as a determinant of the sand stacking angle.
IF sandUsed < initGrains THEN theHG[SELECT sandUsed FROM
0 => (9*16)+7,
1 => (11*16)+7,
ENDCASE => (13*16)+7] ← sand
ELSE {
FOR n IN [8..14) DO
IF sandArray[n] >= sandArray[n+1]+bottomSlope THEN EXIT;
REPEAT FINISHED => FOR n DECREASING IN [8..15) DO
IF sandArray[n]#0 THEN EXIT;
ENDLOOP;
ENDLOOP;
sandArray[n] ← sandArray[n]-1;
m ← (n*16)+7;
incr ← 1;
WHILE theHG[m]=sand DO
m ← m+incr;
incr ← -incr + (IF incr<0 THEN 1 ELSE -1);
ENDLOOP;
theHG[m] ← sand;
};
sandUsed ← sandUsed+1;
ENDLOOP;
Interminal.SetCursorPattern[LOOPHOLE[theHGBits]]; -- update displayed cursor
};
END.