-- MakeMaze.mesa
-- Edited by Sweet, February 4, 1981 11:43 PM
DIRECTORY
Ascii,
Inline,
IODefs,
PressDefs,
PressUtilities,
Random,
Storage,
StreamDefs,
String;
MakeMaze: PROGRAM
IMPORTS Inline, IODefs, PressDefs, PressUtilities, Random, Storage, StreamDefs, String =
BEGIN OPEN PressDefs;
pfdBody: PressFileDescriptor;
pfd: POINTER TO PressFileDescriptor = @pfdBody;
Mica: TYPE = CARDINAL;
MBox: TYPE = RECORD [x,y,w,h: Mica];
LineWidth: Mica ← 50;
AnswerWidth: Mica ← 100;
fudge: Mica;
serial: CARDINAL;
serialNumber: STRING = [10];
PointsToMicas: PROC [points: CARDINAL] RETURNS [Mica] =
{RETURN [Inline.LongDiv[Inline.LongMult[points, MicasPerInch],72]]};
DrawLine: PROC [x, y, w, h: Mica] =
BEGIN
IF w > h THEN w ← w + h;
PutRectangle[p: pfd, xstart: x, ystart: y, xlen: w, ylen: h];
END;
P2: Mica = PointsToMicas[2];
M1: Mica = MicasPerInch;
M12: Mica = MicasPerInch/2;
M14: Mica = MicasPerInch/4;
M34: Mica = (3*MicasPerInch)/4;
M38: Mica = (3*MicasPerInch)/8;
answers: BOOLEAN;
Sort: PUBLIC PROCEDURE [
a: DESCRIPTOR FOR ARRAY OF UNSPECIFIED,
Greater: PROC[UNSPECIFIED, UNSPECIFIED] RETURNS [BOOLEAN]] =
BEGIN
n: CARDINAL = LENGTH[a];
i: CARDINAL;
temp: CARDINAL;
SiftUp: PROC [l, u: CARDINAL] =
BEGIN
s: CARDINAL;
key: CARDINAL ← a[l-1];
DO
s ← l*2;
IF s > u THEN EXIT;
IF s < u AND Greater[a[s+1-1], a[s-1]] THEN s ← s+1;
IF Greater[key, a[s-1]] THEN EXIT;
a[l-1] ← a[s-1];
l ← s;
ENDLOOP;
a[l-1] ← key;
END;
FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;
FOR i DECREASING IN [2..n] DO
SiftUp[1, i];
temp ← a[1-1];
a[1-1] ← a[i-1];
a[i-1] ← temp;
ENDLOOP;
END;
iRandom: ARRAY [0..128) OF CARDINAL;
jRandom: ARRAY [0..64) OF CARDINAL;
RandomizeRows: PROC =
BEGIN
r: ARRAY [0..128) OF CARDINAL;
rGreater: PROC [x, y: CARDINAL] RETURNS [BOOLEAN] =
{RETURN [r[x] > r[y]]};
i: CARDINAL;
FOR i IN [0..nRows) DO
r[i] ← Random.InRange[0, 1000];
iRandom[i] ← i;
ENDLOOP;
Sort[DESCRIPTOR[@iRandom, nRows], rGreater ];
END;
RandomizeColumns: PROC =
BEGIN
r: ARRAY [0..64) OF CARDINAL;
rGreater: PROC [x, y: CARDINAL] RETURNS [BOOLEAN] =
{RETURN [r[x] > r[y]]};
i: CARDINAL;
FOR i IN [0..nCols) DO
r[i] ← Random.InRange[0, 1000];
jRandom[i] ← nCols-1-i;
ENDLOOP;
-- Sort[DESCRIPTOR[@jRandom, nCols], rGreater ];
END;
nRows, nCols: CARDINAL ← 20;
start, stop: CARDINAL;
Direction: TYPE = {n, e, s, w};
PathRec: TYPE = RECORD [i, j: [0..256), link: POINTER TO PathRec];
thisPath: POINTER TO PathRec ← NIL;
Step: PROC [dir: Direction] =
BEGIN
node[i][j].path ← first;
IF ~node[i][j].this THEN {
tn: POINTER TO PathRec ← Storage.Node[SIZE[PathRec]];
tn↑ ← [i: i, j: j, link: thisPath];
thisPath ← tn;
node[i][j].this ← TRUE;
IF i < nRows/2 THEN upperHalf ← upperHalf + 1
ELSE lowerHalf ← lowerHalf + 1};
SELECT dir FROM
n => {
node[i][j].n ← TRUE;
node[i-1][j].s ← TRUE;
i ← i-1};
e => {
node[i][j].e ← TRUE;
IF j # nCols - 1 THEN node[i][j+1].w ← TRUE;
j ← j+1};
s => {
node[i][j].s ← TRUE;
node[i+1][j].n ← TRUE;
i ← i+1};
w => {
node[i][j].w ← TRUE;
node[i][j-1].e ← TRUE;
j ← j-1};
ENDCASE;
END;
SolveStep: PROC =
BEGIN
dir: Direction;
node[i][j].dead ← TRUE;
SELECT TRUE FROM
node[i][j].n AND ~node[i-1][j].dead AND node[i-1][j].path => {
dir ← n; i ← i-1};
node[i][j].e AND
(j = nCols-1 OR (~node[i][j+1].dead AND node[i][j+1].path)) => {
dir ← e; j ← j+1};
node[i][j].s AND ~node[i+1][j].dead AND node[i+1][j].path => {
dir ← s; i ← i+1};
node[i][j].w AND ~node[i][j-1].dead AND node[i][j-1].path => {
dir ← w; j ← j-1};
ENDCASE;
SolveDraw[dir];
END;
SolveDraw: PROC [dir: Direction] =
BEGIN
x, y: Mica;
x ← j * boxMicas + leftMargin + fudge;
y ← (nRows - 1 - i) * boxMicas + bottomMargin + fudge;
SELECT dir FROM
n => DrawLine[x: x, y: y- boxMicas, w: AnswerWidth, h: boxMicas];
s => DrawLine[x: x, y: y, w: AnswerWidth, h: boxMicas];
e => DrawLine[x: x- boxMicas, y: y, w: boxMicas, h: AnswerWidth];
w => DrawLine[x: x, y: y, w: boxMicas, h: AnswerWidth];
ENDCASE;
END;
Decide: PROC RETURNS [dir: Direction] =
BEGIN
choice: ARRAY [0..12] OF Direction;
nC: CARDINAL ← 0;
AddC: PROC [d: Direction] = {choice[nC] ← d; nC ← nC + 1};
canE, canW, canN, canS, mtE, mtW, mtN, mtS: BOOLEAN ← FALSE;
IF first AND Right[] THEN AddC[e];
IF ~Left[] AND
~(first AND (Top[] OR Bottom[])) AND
~node[i][j-1].this THEN {
canW ← TRUE;
IF ~first AND ~node[i][j-1].done THEN mtW ← TRUE};
IF ~Right[] AND
~(~first AND (Top[] OR Bottom[])) AND
~node[i][j+1].this THEN {
canE ← TRUE;
IF ~first AND ~node[i][j+1].done THEN mtE ← TRUE};
IF ~Top[] AND
~(first AND Left[] AND start < i) AND
~(~first AND ((Left[] AND start > i) OR (Right[] AND stop > i))) AND
~node[i-1][j].this THEN {
canN ← TRUE;
IF ~first AND ~node[i-1][j].done THEN mtN ← TRUE};
IF ~Bottom[] AND
~(first AND Left[] AND start > i) AND
~(~first AND ((Left[] AND start < i) OR (Right[] AND stop < i))) AND
~node[i+1][j].this THEN {
canS ← TRUE;
IF ~first AND ~node[i+1][j].done THEN mtS ← TRUE};
IF canN THEN AddC[n];
IF canE THEN AddC[e];
IF canS THEN AddC[s];
IF canW THEN AddC[w];
IF first THEN {
IF canN AND 10*lowerHalf > 12*upperHalf THEN AddC[n];
IF canS AND 10*upperHalf > 12*lowerHalf THEN AddC[s]}
ELSE {
IF mtN THEN AddC[n];
IF mtS THEN AddC[s];
IF mtE AND ~mtW THEN AddC[e];
IF mtW THEN AddC[w]};
IF nC = 0 THEN {
node[i][j].dead ← TRUE;
SELECT TRUE FROM
node[i][j].w AND ~node[i][j-1].dead => {
Step[w]; RETURN [Decide[]]};
node[i][j].n AND ~node[i-1][j].dead => {
Step[n]; RETURN [Decide[]]};
node[i][j].s AND ~node[i+1][j].dead => {
Step[s]; RETURN [Decide[]]};
node[i][j].e AND ~node[i][j+1].dead => {
Step[e]; RETURN [Decide[]]};
ENDCASE;
SIGNAL Trapped};
RETURN [choice[Random.InRange[0,nC-1]]];
END;
upperHalf, lowerHalf: CARDINAL;
Walk: PROC =
BEGIN
dir: Direction;
thisPath ← NIL;
DO
dir ← Decide[];
IF first AND dir = e AND Right[] THEN {
Step[e]; stop ← i; EXIT};
Step[dir];
IF node[i][j].done THEN EXIT;
ENDLOOP;
WHILE thisPath # NIL DO
next: POINTER TO PathRec = thisPath.link;
node[thisPath.i][thisPath.j].done ← TRUE;
node[thisPath.i][thisPath.j].this ← FALSE;
Storage.Free[thisPath];
thisPath ← next;
ENDLOOP;
END;
GenerateMaze: PROC =
BEGIN
DO
GenMaze[
!Trapped => {
IODefs.WriteLine[IF first THEN "no path" ELSE "no fill"];
LOOP}];
EXIT;
ENDLOOP;
IF answers THEN
FOR r: CARDINAL IN [0..nRows) DO
FOR c: CARDINAL IN [0..nCols) DO
astream.put[astream, node[r][c]];
ENDLOOP;
ENDLOOP;
END;
ComputeMargins: PROC =
BEGIN
rMax, cMax: Mica;
cMax ← (13*M1)/2*nCols;
rMax ← regionSize/nRows;
boxMicas ← MIN [rMax, cMax, M38];
fudge ← (boxMicas + LineWidth - AnswerWidth)/2;
bottomMargin ← (regionSize - nRows*boxMicas)/2 + regionStart;
leftMargin ← ((17*M1)/2 - nCols * boxMicas)/2;
END;
GenMaze: PROC =
BEGIN
ComputeMargins[];
FOR r: CARDINAL IN [0..nRows) DO
FOR c: CARDINAL IN [0..nCols) DO
node[r][c] ← [];
ENDLOOP;
ENDLOOP;
i ← start ← Random.InRange[0,nRows-1];
j ← 0; upperHalf ← lowerHalf ← 0;
first ← TRUE;
node[i][j].w ← TRUE;
Walk[];
IODefs.WriteLine["path"];
RandomizeRows[];
RandomizeColumns[];
first ← FALSE;
FOR r: CARDINAL IN [0..nRows) DO
FOR c: CARDINAL IN [0..nCols) DO
i ← iRandom[r]; j ← jRandom[c];
IF ~node[i][j].done THEN Walk[];
ENDLOOP;
ENDLOOP;
END;
boxMicas, leftMargin, bottomMargin: Mica;
WriteMaze: PROC =
BEGIN
r, c: CARDINAL;
runStart, runStop: CARDINAL;
BoxX: PROC [r, c: CARDINAL] RETURNS [Mica] = INLINE {
RETURN[c * boxMicas + leftMargin]};
BoxY: PROC [r, c: CARDINAL] RETURNS [Mica] = INLINE {
RETURN[(nRows - 1 - r) * boxMicas + bottomMargin]};
IODefs.WriteLine["pressing"];
serialNumber.length ← 0;
String.AppendDecimal[serialNumber, serial];
PutText[pfd, serialNumber, leftMargin, bottomMargin + nRows*boxMicas + P2];
-- draw outside
DrawLine[
x: BoxX[0,0], y: BoxY[0,0] + boxMicas,
w: nCols*boxMicas, h: LineWidth];
DrawLine[
x: BoxX[nRows-1,0], y: BoxY[nRows-1,0],
w: nCols*boxMicas, h: LineWidth];
IF start # 0 THEN DrawLine[
x: BoxX[start,0], y: BoxY[start,0]+boxMicas,
w: LineWidth, h: start*boxMicas];
IF start # nRows-1 THEN DrawLine[
x: BoxX[nRows-1,0], y: BoxY[nRows-1,0],
w: LineWidth, h: (nRows-1-start)*boxMicas];
IF stop # 0 THEN DrawLine[
x: BoxX[stop,nCols-1] + boxMicas, y: BoxY[stop,nCols-1]+boxMicas,
w: LineWidth, h: stop*boxMicas];
IF stop # nRows-1 THEN DrawLine[
x: BoxX[nRows-1,nCols-1] + boxMicas, y: BoxY[nRows-1,nCols-1],
w: LineWidth, h: (nRows-1-stop)*boxMicas];
-- do horizontals
FOR r IN [0..nRows-1) DO
c ← 0;
WHILE c < nCols DO
WHILE c < nCols AND node[r][c].s DO c ← c + 1 ENDLOOP;
runStart ← c;
WHILE c < nCols AND ~node[r][c].s DO c ← c + 1 ENDLOOP;
runStop ← c;
IF runStart = nCols THEN EXIT;
DrawLine[
x: BoxX[r, runStart], y: BoxY[r, runStart],
w: (runStop-runStart)*boxMicas, h: LineWidth];
ENDLOOP;
ENDLOOP;
-- do verticals
FOR c IN (0..nCols) DO
r ← 0;
WHILE r < nRows DO
WHILE r < nRows AND node[r][c].w DO r ← r + 1 ENDLOOP;
runStart ← r;
WHILE r < nRows AND ~node[r][c].w DO r ← r + 1 ENDLOOP;
runStop ← r;
IF runStart = nRows THEN EXIT;
DrawLine[
x: BoxX[runStop-1, c], y: BoxY[runStop-1, c],
w: LineWidth, h: (runStop-runStart)*boxMicas];
ENDLOOP;
ENDLOOP;
serial ← serial + 1;
END;
Top: PROC RETURNS [BOOLEAN] = INLINE {RETURN [i = 0]};
Bottom: PROC RETURNS [BOOLEAN] = INLINE {RETURN [i = nRows-1]};
Left: PROC RETURNS [BOOLEAN] = INLINE {RETURN [j = 0]};
Right: PROC RETURNS [BOOLEAN] = INLINE {RETURN [j = nCols - 1]};
i, j, nPages: CARDINAL;
first: BOOLEAN;
Trapped: SIGNAL = CODE;
regionStart, regionSize: Mica;
twoPer: BOOLEAN;
Node: TYPE = RECORD [n, e, s, w, this, done, dead, path: BOOLEAN ← FALSE];
node: POINTER TO ARRAY [0..128) OF PACKED ARRAY [0..64) OF Node;
Yes: PROC RETURNS [BOOLEAN] =
BEGIN OPEN IODefs;
SELECT ReadChar[] FROM
'y, 'Y, CR => {WriteLine["yes"]; RETURN[TRUE]};
ENDCASE => {WriteLine["no"]; RETURN[FALSE]};
END;
Input: TYPE = RECORD [rows, cols, pages: CARDINAL, twoPer: BOOLEAN, link: POINTER TO Input ← NIL];
firstInput, lastInput: POINTER TO Input ← NIL;
Solve: PROC =
BEGIN
i ← start; j ← 0;
SolveDraw[e];
UNTIL j = nCols DO SolveStep[] ENDLOOP;
END;
CharHeight: Mica;
CharWidth: POINTER TO ARRAY CHARACTER OF Mica;
HCharWidth: ARRAY CHARACTER OF Mica;
TRCharWidth: ARRAY CHARACTER OF Mica;
Helvetica: PROC =
BEGIN
SetFont[p: pfd, Name: "Helvetica", PointSize: 18, Face: 2];
CharWidth ← @HCharWidth;
END;
TimesRoman: PROC =
BEGIN
SetFont[p: pfd, Name: "TimesRoman", PointSize: 18, Face: 2];
CharWidth ← @TRCharWidth;
END;
DigestFonts: PROC =
BEGIN
[] ← PressUtilities.FindFontWidths[
family: "Helvetica"L,
points: 18,
weight: bold,
slope: regular,
widths: LOOPHOLE[@HCharWidth]];
[] ← PressUtilities.FindFontWidths[
family: "TimesRoman"L,
points: 18,
weight: bold,
slope: regular,
widths: LOOPHOLE[@TRCharWidth]];
CharHeight ← PointsToMicas[18];
END;
astream: StreamDefs.StreamHandle;
Driver: PROC =
BEGIN OPEN IODefs, StreamDefs;
firstSerial: CARDINAL;
state: Random.State;
newInput: POINTER TO Input;
sh: StreamHandle;
node ← Storage.Words[SIZE[Node, 128*64]];
DigestFonts[];
InitPressFileDescriptor[pfd, "Maze.press"L];
Helvetica[];
WriteString["new randoms? "];
IF Yes[] THEN {
Random.ReadState[@state];
sh ← NewWordStream["Random.state",ReadWriteAppend];
[] ← WriteBlock[sh, @state, SIZE[Random.State]];
sh.destroy[sh]};
sh ← NewWordStream["Random.state", Read];
[] ← ReadBlock[sh, @state, SIZE[Random.State]];
sh.destroy[sh];
Random.WriteState[@state];
WriteString["answers? "];
answers ← Yes[];
IF answers THEN astream ← NewByteStream["Maze.temp$", ReadWriteAppend];
WriteString["first serial number: "L];
serial ← 1;
serial ← ReadNumber[nRows , 10! String.InvalidNumber => CONTINUE];
firstSerial ← serial;
WriteChar[CR];
DO
DO
WriteString["rows: "L];
nRows ← ReadNumber[nRows , 10! String.InvalidNumber => GO TO done];
IF nRows > 128 THEN {WriteLine[" at most 128"]; LOOP};
EXIT;
ENDLOOP;
WriteChar[CR];
IF nRows = 0 THEN EXIT;
DO
WriteString["cols: "L];
nCols ← ReadNumber[nCols, 10];
IF nCols > 64 THEN {WriteLine[" at most 64"]; LOOP};
EXIT;
ENDLOOP;
WriteChar[CR];
WriteString["pages: "L];
nPages ← ReadNumber[nPages , 10! String.InvalidNumber =>
{nPages ← 1; CONTINUE}];
WriteChar[CR];
WriteString["two per page? "];
twoPer ← Yes[];
IF twoPer THEN regionSize ← 4*M1+M12 ELSE regionSize ← 9*M1;
newInput ← Storage.Node[SIZE[Input]];
newInput↑ ←
[rows: nRows, cols: nCols, pages: nPages, twoPer: twoPer];
IF lastInput = NIL THEN firstInput ← newInput
ELSE lastInput.link ← newInput;
lastInput ← newInput;
THROUGH [0..nPages) DO
regionStart ← IF twoPer THEN 5*M1 + M34 ELSE M1;
GenerateMaze[];
WriteMaze[];
IF twoPer THEN {
regionStart ← M34;
GenerateMaze[];
WriteMaze[]};
WritePage[pfd];
ENDLOOP;
REPEAT
done => NULL;
ENDLOOP;
ClosePressFile[pfd];
IF answers THEN
BEGIN
next: POINTER TO Input;
serial ← firstSerial;
astream.reset[astream];
WriteChar[CR]; WriteLine["Pressing answers"];
Random.WriteState[@state];
InitPressFileDescriptor[pfd, "Maze-solutions.press"L];
Helvetica[];
FOR in: POINTER TO Input ← firstInput, next UNTIL in = NIL DO
next ← in.link;
nRows ← in.rows; nCols ← in.cols; nPages ← in.pages;
twoPer ← in.twoPer;
THROUGH [0..nPages) DO
regionStart ← IF twoPer THEN 5*M1 + M34 ELSE M1;
RereadMaze[];
Solve[];
WriteMaze[];
IF twoPer THEN {
regionStart ← M34;
RereadMaze[];
Solve[];
WriteMaze[]};
WritePage[pfd];
ENDLOOP;
Storage.Free[in];
ENDLOOP;
ClosePressFile[pfd];
astream.destroy[astream];
END;
Storage.FreeWords[node];
END;
RereadMaze: PROC =
BEGIN
FOR r: CARDINAL IN [0..nRows) DO
FOR c: CARDINAL IN [0..nCols) DO
node[r][c] ← astream.get[astream];
ENDLOOP;
ENDLOOP;
start ← 0;
UNTIL node[start][0].w DO start ← start + 1 ENDLOOP;
stop ← 0;
UNTIL node[stop][nCols-1].e DO stop ← stop + 1 ENDLOOP;
ComputeMargins[];
END;
Driver[];
END.