**[**Back to MISC SWAG index**]** **[**Back to Main SWAG index**]** **[**Original**]**

*{
In the meantime the readers might want to play around with the following
code, that I think I originally picked up in this invaluable conference some
years ago (or it may have been the SWAG -- don't remember really). I've
altered the original code so it can be compiled without any other special
units but my cursorUnit, that comes next.
}
***program **MazeSolver;
**uses **Crt, cursorUnit;
*{$R-,S-,M 16384, 16384, 16384
Program draws and solves a 23x78 maze.
The algorithm used by Maze is adapted from one given in Chapter 4 of
"The Elements of Programming Style" by B. Kernighan and P.J. Plauger
(McGraw-Hill, 1978)
This version for the IBM PC: Wilbert van Leijen
Written: 16 Sept. 1987
Revised: 19 March 1989
Revised: Jan 15th 1995 by Bj”rn Felten @ 2:203/208
}
***const
**Title : **string**[6] = ' Maze ';
Usage : **string**[38] = ' F1ÄFull speed F2ÄDelay move EscÄQuit ';
MazeX = 77;
MazeY = 22;
**type
**MazeSquare = (Wall, Path);
MazeArray = **array**[0..MazeX, 0..MazeY] **of **MazeSquare;
Direction = (GoUp, GoDown, GoLeft, GoRight);
ScrBuffer = **array **[0..1999] **of **word; *(* Screen Buffer *)
***var
**FullSpeed : boolean;
ImageBuffer : pointer;
Maze : MazeArray;
X, Y : integer;
Screen : **array **[0..7] **of **ScrBuffer **absolute **$B800: 0000;
**procedure **WriteXY (Page, Attrib, X, Y: word; N: **String**);
**function **x80p(Y, X: word): word; **assembler**;
**asm
**MOV AX,Y
MOV BX,AX
MOV CL,4
SHL BX,CL
MOV CL,6
SHL AX,CL
ADD AX,BX
ADD AX,X
**end**;
**var **I: byte;
**begin
if **N[0] <> #0 **then for **I := 1 **to **length(N) **do
**Screen[Page][X80p(Y,X+pred(I))]:=(Attrib **shl **8) + ord(N[I]);
**end**;
*{ Set up a frame around the activities }
***procedure **Frame;
**begin
**WriteXY(0, $1F, 37, 0, Title);
WriteXY(0, $17, 41, 24, Usage);
WriteXY(0, $31, 42, 24, 'F1');
WriteXY(0, $31, 56, 24, 'F2');
WriteXY(0, $31, 70, 24, 'Esc')
**end**;
**procedure **ShowMaze(X, Y: integer; Show: char);
**begin
**WriteXY(0, $1B, X+2, Y+1, Show)
**end**; *{ ShowMaze }
{ Set up maze }
***procedure **CreateMaze;
**var
**X, Y : integer;
MazeAction : Direction;
*{ Set a given maze element to be Path or Wall }
***procedure **SetSquare(X, Y: integer; Val: MazeSquare);
**begin
**Maze[X, Y] := Val;
**case **Val **of
**Path : ShowMaze(X, Y, ' ');
Wall : WriteXY(0, $0F, X+2, Y+1, 'Û')
**end
end**; *{ SetSquare }
{ Return a random value of direction }
***function **RandomDirection : Direction;
**begin
case **Random(4) **of
**0 : RandomDirection := GoUp;
1 : RandomDirection := GoDown;
2 : RandomDirection := GoLeft;
3 : RandomDirection := GoRight;
**end**;
**end**; *{ RandomDirection }
{ Return a random element in the maze }
***function **RandomDig(max : integer) : integer;
**begin
**RandomDig := 2 * Random(max **shr **1-1)+1
**end**; *{ RandomDig }
{ Check wether a legal path can be built }
***Function **LegalPath(x, y : integer;
MazeAction : Direction) : Boolean;
**begin
**LegalPath := False;
**case **MazeAction **of
**GoUp : **if **y > 2 **then
**LegalPath := (Maze[x, y-2] = Wall);
GoDown : **if **y < MazeY-2 **then
**LegalPath := (Maze[x, y+2] = Wall);
GoLeft : **if **x > 2 **then
**LegalPath := (Maze[x-2, y] = Wall);
GoRight : **if **x < MazeX-2 **then
**LegalPath := (Maze[x+2, y] = Wall);
**end**;
**end**; *{ LegalPath }
{ Extend path in given direction }
***Procedure **Buildpath(X, Y : integer;
MazeAction : Direction);
**var
**Unused : **set of **Direction;
**begin
case **MazeAction **of
**GoUp : **begin
**SetSquare(X, Y-1, Path);
SetSquare(X, Y-2, Path);
dec(Y, 2)
**end**;
GoDown : **begin
**SetSquare(X, Y+1, Path);
SetSquare(X, Y+2, Path);
inc(Y, 2)
**end**;
GoLeft : **begin
**SetSquare(X-1, Y, Path);
SetSquare(X-2, Y, Path);
dec(X, 2)
**end**;
GoRight : **begin
**SetSquare(X+1, Y, Path);
SetSquare(X+2, Y, Path);
inc(X, 2)
**end
end**;
Unused := [GoUp..GoRight];
**repeat ***{ Check direction for legality }
*MazeAction := RandomDirection;
**if **MazeAction **in **Unused **then ***{ If so, extend in that direction }
***begin
**Unused := Unused-[MazeAction];
**if **LegalPath(x, y, MazeAction) **then
**BuildPath(x, y, MazeAction)
**end
until **Unused = [] *{ All legal moves are exhausted }
***end**; *{ BuildPath }
{ CreateMaze initially draws a maze that is 'solid rock'.
Then the maze will be 'excavated' by setting the elements of
the maze to path. It keeps digging until all legal paths are
exhausted and, finally, it digs an 'entrance' and 'exit' path
on the boundaries of the maze }
***begin
for **y := 0 **to **MazeY **do ***{ Setup 'solid rock' }
***for **x := 0 **to **MazeX **do
**SetSquare(x, y, Wall);
y := RandomDig(MazeY); *{ Starting point }
*x := RandomDig(MazeX);
SetSquare(x, y, Path);
**repeat ***{ Dig path in maze }
*MazeAction := RandomDirection
**until **LegalPath(x, y, MazeAction);
BuildPath(x, y, MazeAction);
x := RandomDig(MazeX);
SetSquare(x, 0, Path); *{ Dig entrance }
*ShowMaze(x, 0, #25);
x := RandomDig(MazeX);
SetSquare(x, MazeY, Path) *{ Dig exit }
***end**; *{ CreateMaze }
{ Solve the maze }
***procedure **SolveMaze;
**var
**Solved : boolean;
x, y : integer;
Tried : **array**[0..MazeX, 0..MazeY] **of **boolean;
*{ Attempt Maze solution from point in given direction }
***function Try**(x, y : integer;
MazeAction : Direction) : boolean;
**var
**Ok : boolean;
*{ Draw attempted move on screen }
***procedure **MoveMaze(MazeAction : Direction);
**begin
if not **FullSpeed **then
**Delay(80);
**case **MazeAction **of
**GoUp : ShowMaze(x, y, #24);
GoDown : ShowMaze(x, y, #25);
GoLeft : ShowMaze(x, y, #27);
GoRight : ShowMaze(x, y, #26);
**end
end**; *{ MoveMaze }
{ Check whether there is a path to the boundary from a given
point in a given direction. It returns True if there exists
a path; otherwise, the Try is False }
***begin
**Ok := (Maze[x, y] = Path); *{ If Wall, no solution exist }
***if **Ok **then begin
**Tried[x, y] := True; *{ Set Tried flag }
***case **MazeAction **of
**GoUp : Dec(y);
GoDown : Inc(y);
GoLeft : Dec(x);
GoRight : Inc(x);
**end**;
Ok := (Maze[x, y] = Path) **and not **Tried[x, y];
**if **Ok **then begin ***{ Consider neighbouring square }
*MoveMaze(MazeAction);
Ok := (y <= 0) **or **(y >= MazeY) **or **(x <= 0) **or **(x >= MazeX);
**if not **Ok **then
**Ok := **Try**(x, y, GoLeft);
**if not **Ok **then
**Ok := **Try**(x, y, GoDown);
**if not **Ok **then
**Ok := **Try**(x, y, GoRight);
**if not **Ok **then
**Ok := **Try**(x, y, GoUp);
**if not **Ok **then
**ShowMaze(x, y, ' ');
**end**;
**end**;
**Try **:= Ok;
**end**; *{ Try }
{ SolveMaze looks for a continuous sequence of Path squares from one
point on the boundary of the maze to another }
***begin
**FillChar(Tried, SizeOf(Tried), False);
Solved := False;
x := 0;
y := 1;
**while not **Solved **and **(y < MazeY) **do begin
**Solved := **Try**(x, y, GoRight);
inc(y)
**end**;
x := MazeX;
y := 1;
**while not **Solved **and **(y < MazeY) **do begin
**Solved := **Try**(x, y, GoLeft);
inc(y)
**end**;
x := 1;
y := 0;
**while not **Solved **and **(x < MazeX) **do begin
**Solved := **Try**(x, y, GoDown);
Inc(x)
**end**;
x := 1;
y := MazeY;
**while not **Solved **and **(x < MazeX) **do begin
**Solved := **Try**(x, y, GoUp);
Inc(x)
**end**;
Solved := True;
**repeat until **KeyPressed
**end**; *{ SolveMaze }
***procedure **Mainline;
**const
**F1 = #59;
F2 = #60;
**var
**Ch : char;
**begin
repeat
**Ch := ReadKey;
**if **Ch = #0 **then **Ch := ReadKey;
**case **Ch **of
**F1 : **begin
**CreateMaze;
FullSpeed := True;
SolveMaze
**end**;
F2 : **begin
**CreateMaze;
FullSpeed := False;
SolveMaze
**end**;
**end
until **Ch = #27
**end**; *{ Mainline }
***begin
**ClrScr;
Frame;
cursorOff;
Randomize;
Mainline;
cursorOn
**end**. *{ MazeSolver }
{
From: Lou Duchez Read: Yes Replied: No
Very nice! My algorithm grows walls, but your algorithm digs corridors.
Your algorithm also seems to generate more complicated mazes than mine.
My only concern is that it relies so heavily on recursion; you risk
running out of stack space. Of course, with my algorithm, you allocate
lots of arrays that take up data segment ...
Thanks for posting it!
As I comprehend it, the maze-generating algorithm is like this:
- Draw a field composed entirely of walls.
- Select a random spot in the field to be your very first corridor spot.
- Here is the maze-digging routine:
- (This routine takes two value parameters: the X and Y coordinates of
your current location.)
- If you can randomly select a valid location two units away from those
X / Y coordinates (where "valid locations" are those that currently
are walls and not corridors):
- "Dig a corridor" from the X / Y location to that randomly-
selected location.
- Recursively call this routine; as parameters, pass the X and Y
coordinates of that randomly-selected location. (On the first
pass, use that randomly-selected first corridor spot as the X and
Y coordinates.)
- When the recursion ends, the maze is done.
}
*

**[**Back to MISC SWAG index**]** **[**Back to Main SWAG index**]** **[**Original**]**