(* file: maze.pas *)
(* a transliteration of Greg Nelson's maze drawing program into Pascal/PasMesa *)
program maze(input,output);
const
n = 72;
m = 53;
num←walls = 7507; (* = n*(m-1) + m*(n-1) *)
num�lls = 3816; (* = n*m *)
type
cell = record x: 1..m; y: 1..n end;
cell𡤌ount = 0..num�lls;
wall = record ns: boolean; ew: boolean; x: 1..m; y: 1..n end;
wall←index = 0..7506; (* = num←walls-1 *)
var
start�ll: cell;
end�ll: cell;
r: array [1..m, 1..n] of cell;
q: array [1..m, 1..n] of cell;
size: array [1..m, 1..n] of cell𡤌ount;
w: array [wall←index] of wall;
first←grey: integer;
first𡤋lack: integer;
junk: integer;
starting𡤌lock: integer;
procedure make�ll(var c: cell; x: 1..m; y: 1..n);
begin
c.x := x;
c.y := y;
end;
procedure make←wall(var w: wall; ns, ew: boolean; x: 1..m; y: 1..n);
begin
w.ns := ns;
w.ew := ew;
w.x := x;
w.y := y;
end;
procedure divides(w: wall; var c,d: cell);
begin
if w.ns then begin make�ll(c, w.x, w.y); make�ll(d, w.x+1, w.y) end
else begin make�ll(c, w.x, w.y); make�ll(d, w.x, w.y+1) end;
end;
procedure init𡤌onsts;
begin
make�ll(start�ll, m,1);
make�ll(end�ll, 1,n);
end;
procedure init←rq;
var x: 1..m; y: 1..n;
begin
for x := 1 to m do for y := 1 to n do
begin make�ll( r[x,y], x,y); make�ll(q[x,y], x,y); size[x,y] := 1 end;
end;
function connected(c, d: cell): boolean;
begin
c := r[c.x, c.y]; d := r[d.x, d.y];
connected := (c.x=d.x) and (c.y=d.y);
end;
procedure connect(c, d: cell);
var t, cp: cell;
begin
if not connected(c,d) then
begin
c := r[c.x, c.y]; d := r[d.x, d.y];
if size[c.x, c.y] > size[d.x, d.y] then begin t:=c; c:=d; d:=t end;
cp := q[c.x, c.y]; r[cp.x, cp.y] := d;
while (cp.x<>c.x) or (cp.y<>c.y) do begin cp := q[cp.x, cp.y]; r[cp.x, cp.y] := d end;
t := q[c.x, c.y]; q[c.x, c.y] := q[d.x, d.y]; q[d.x, d.y] := t;
size[d.x, d.y] := size[d.x, d.y] + size[c.x, c.y];
end;
end;
procedure init←w;
var x: 1..m; y: 1..n; i: integer;
begin
i := 0;
for x := 1 to m-1 do for y := 1 to n do
begin make←wall(w[i], true, false, x, y); i := i+1 end;
for x := 1 to m do for y := 1 to n-1 do
begin make←wall(w[i], false, true, x, y); i := i+1 end;
if i<>num←walls then writeln('bug');
first←grey := 0;
first𡤋lack := num←walls;
end;
procedure swap(i,j: wall←index);
var t: wall;
begin
t := w[i]; w[i] := w[j]; w[j] := t;
end;
procedure build←maze;
var i: wall←index; c,d: cell;
begin
while first←grey < first𡤋lack do
begin
i := choose(first←grey, first𡤋lack-1);
divides(w[i], c, d);
if connected(c,d) then
begin first𡤋lack := first𡤋lack - 1; swap(i, first𡤋lack); end
else begin swap(i, first←grey); first←grey := first←grey + 1; connect(c,d) end;
end;
end;
procedure draw←maze; external;
begin
starting𡤌lock := clock;
writeln('starting to build maze; elapsed user time:',(clock - starting𡤌lock)/1000:9:3);
init←rq; init←w; junk := init(0, -1); build←maze;
writeln('finished building maze; elapsed user time:',(clock - starting𡤌lock)/1000:9:3);
writeln('starting to draw maze; elapsed user time:',(clock - starting𡤌lock)/1000:9:3);
draw←maze;
writeln('finished drawing maze; elapsed user time:',(clock - starting𡤌lock)/1000:9:3);
end.