(* 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_cells    =    3816;   (* = n*m  *)

type
cell =    record x: 1..m; y: 1..n end;
cell_count =    0..num_cells;
wall =    record ns: boolean; ew: boolean; x: 1..m; y: 1..n end;
wall_index =    0..7506;  (* = num_walls-1 *)

var
start_cell: cell;
end_cell: 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_count;
w:    array [wall_index] of wall;
first_grey: integer;
first_black: integer;
junk: integer;
starting_clock: integer;

procedure make_cell(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_cell(c, w.x, w.y);  make_cell(d, w.x+1, w.y) end
else begin make_cell(c, w.x, w.y);  make_cell(d, w.x, w.y+1) end;
end; 

procedure init_consts;
begin
make_cell(start_cell, m,1);
make_cell(end_cell, 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_cell( r[x,y], x,y); make_cell(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_black := 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_black do
begin
i := choose(first_grey, first_black-1);
divides(w[i], c, d);
if connected(c,d) then 
begin first_black := first_black - 1; swap(i, first_black); end
else begin swap(i, first_grey); first_grey := first_grey + 1; connect(c,d) end;
end;
end;

procedure draw_maze; external;

begin
starting_clock := clock;
writeln('starting to build maze;  elapsed user time:',(clock - starting_clock)/1000:9:3);
init_rq; init_w; junk := init(0, -1); build_maze;
writeln('finished building maze; elapsed user time:',(clock - starting_clock)/1000:9:3);
writeln('starting to draw maze; elapsed user time:',(clock - starting_clock)/1000:9:3);
draw_maze;
writeln('finished  drawing maze; elapsed user time:',(clock - starting_clock)/1000:9:3);   
end.