HourGlassImpl.mesa;
edited by McGregor, October 25, 1982 10:17 am
Last Edited by: Maxwell, January 3, 1983 12:51 pm
Last Edited by: Pausch, August 12, 1983 4:31 pm
DIRECTORY
HourGlass,
Interminal USING [SetCursorPattern];
HourGlassImpl: CEDAR PROGRAM IMPORTS Interminal EXPORTS HourGlass = 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 BEGIN
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;
END;
TickHourglass: PUBLIC PROC = TRUSTED BEGIN
incr: INTEGER;
n, m: CARDINAL;
topSlope: CARDINAL = 3;
bottomSlope: CARDINAL = 2;
IF (tick←tick+1) > totalTicks THEN BEGIN -- 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;
END
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 BEGIN
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;
END;
sandUsed ← sandUsed+1;
ENDLOOP;
Interminal.SetCursorPattern[LOOPHOLE[theHGBits]]; -- update displayed cursor
END;
END.