[Back to MISC SWAG index] [Back to Main SWAG index] [Original]
{
From: Matthew.Mastracci@matrix.cambo.cuug.ab.ca (Matthew Mastracci)
l> This is just cool enough that I'm going to post publicly too.
l> LOU'S MAZE ALGORITHM
Great algorithm! I read your posting, pondered it, sat down for an hour
and wrote this:
}
{$r-} { Increases speed a marginal amount }
{
Maze Generator - PD 1995, by Matthew Mastracci
rayban@matrix.cambo.cuug.ab.ca
This program generates a maze using a plant-like approach. It starts by
sowing "seeds" about every four units around the edge, and two in the
middle. These then grow out in a random order in three directions. This
prevents seeds from sprouting if they would grow into another.
The original algorithm for generating mazes was written by Lou Duchez and
posted in comp.lang.pascal. Here's a small excerpt from the part which
describes how to work with the seeds:
---
Keep executing this loop until you run out of seeds:
- Randomly select a seed. Extend the wall in some valid direction from
this seed point, by turning into walls the grid locations one unit and
two units away from the seed. To prevent the maze from closing off at
any point, DO NOT EXTEND A WALL TO ANY POINT THAT IS ALREADY MARKED AS A
WALL! (With this rule, you never close off the maze; you simply
complicate the path from beginning to end.)
- Remove this seed. It's done its job.
- Add three seed points at this new location. (The assumption is that the
wall could grow in three directions from this new point; if you want to
be more exacting, you can add as many seeds as there are directions that
the wall could extend from that point. It really doesn't matter much,
except for the possibility of running out of seed point array elements if
you always add 3.)
- Seed maintenance: go through your list of seeds and eliminate any
seeds that cannot extend in any valid direction.
---
Feel free to use this source anywhere you want in anyway you want. I
recommend you use it to generate mazes for games, however... :)
}
program
MazeGenerator;
uses
Crt;
const
xMax = 79;
yMax = 49;
sMax = (xMax - 3) * (yMax - 3) div 2;
type
tMap = record
Data : array[1..xMax, 1..yMax] of Boolean;
xEntrance, yEntrance : Byte;
xExit, yExit : Byte;
end;
tSeed = record
x, y, Dir : Byte;
Valid : Boolean;
end;
var
Map : tMap;
{ Draws the map }
procedure DrawMap(Map : tMap);
var
x, y : Byte;
begin
for x := 1 to xMax do begin
for y := 1 to yMax do begin
if Map.Data[x, y] then Mem[$b800 : y * 160 + x * 2] := 219;
end;
end;
end;
{ Generates the map }
procedure GenerateMap(var Map : tMap);
var
Seeds : array[1..sMax] of tSeed;
{ Reports TRUE if any seeds are "unsprouted" }
function NoSeeds : Boolean;
var
i : Word;
FoundSeeds : Boolean;
begin
FoundSeeds := False;
for i := 1 to sMax do begin
if Seeds[i].Valid then FoundSeeds := True;
end;
NoSeeds := not FoundSeeds;
end;
{ "Plant" a seed }
procedure AddSeed(x, y, Dir : Byte);
var
i : Word;
begin
i := 0;
repeat
Inc(i);
until (i = sMax) or not Seeds[i].Valid;
if Seeds[i].Valid then begin
WriteLn('Error: Out of seed space!');
Halt;
end else begin
Seeds[i].x := x;
Seeds[i].y := y;
Seeds[i].Dir := Dir;
Seeds[i].Valid := True;
end;
end;
{ "Sprout" a seed }
procedure Sprout;
var
i : Word;
begin
repeat
i := Random(sMax) + 1;
until Seeds[i].Valid;
with Seeds[i] do begin
case Dir of
0: begin { up }
if not Map.Data[x, y - 2] then begin
AddSeed(x, y - 2, 1);
AddSeed(x, y - 2, 2);
AddSeed(x, y - 2, 3);
Map.Data[x, y - 1] := True;
Map.Data[x, y - 2] := True;
end;
end;
1: begin { down }
if not Map.Data[x, y + 2] then begin
AddSeed(x, y + 2, 0);
AddSeed(x, y + 2, 2);
AddSeed(x, y + 2, 3);
Map.Data[x, y + 1] := True;
Map.Data[x, y + 2] := True;
end;
end;
2: begin { left }
if not Map.Data[x - 2, y] then begin
AddSeed(x - 2, y, 0);
AddSeed(x - 2, y, 1);
AddSeed(x - 2, y, 3);
Map.Data[x - 1, y] := True;
Map.Data[x - 2, y] := True;
end;
end;
3: begin { right }
if not Map.Data[x + 2, y] then begin
AddSeed(x + 2, y, 0);
AddSeed(x + 2, y, 1);
AddSeed(x + 2, y, 2);
Map.Data[x + 1, y] := True;
Map.Data[x + 2, y] := True;
end;
end;
end;
end;
Seeds[i].Valid := False;
end;
var
x, y : Byte;
DrawCount : Byte;
begin
FillChar(Map, SizeOf(Map), 0); { Zero out map }
FillChar(Seeds, SizeOf(Seeds), 0); { Erase seeds }
{ Draw border }
with Map do begin
for x := 1 to xMax do begin
Data[x, 1] := True;
Data[x, yMax] := True;
end;
for y := 1 to yMax do begin
Data[1, y] := True;
Data[xMax, y] := True;
end;
{ Map entrance }
yEntrance := 1;
xEntrance := (Random(yMax div 2) + 1) * 2;
Data[xEntrance, yEntrance] := False;
{ Map exit }
yExit := yMax;
xExit := (Random(yMax div 2) + 1) * 2;
Data[xExit, yExit] := False;
{ Add a couple of seeds in the middle (islands) }
AddSeed((Random(xMax div 2) + 1) * 2 + 1, (Random(yMax div 2) + 1) * 2 + 1,
Random(4));
AddSeed((Random(xMax div 2) + 1) * 2 + 1, (Random(yMax div 2) + 1) * 2 + 1,
Random(4));
{ Add seeds around the edges, about every 4 units }
for DrawCount := 1 to (2 * xMax + 2 * yMax) div 4 do begin
case Random(4) of
0: AddSeed((Random(xMax div 2) + 1) * 2 + 1, 1, 1); { top, going down }
1: AddSeed((Random(xMax div 2) + 1) * 2 + 1, yMax, 0); { bottom, going
up }
2: AddSeed(1, (Random(yMax div 2) + 1) * 2 + 1, 3); { left, going right
}
3: AddSeed(xMax, (Random(yMax div 2) + 1) * 2 + 1, 2); { right, going
left }
end;
end;
end;
DrawCount := 0;
repeat
Inc(DrawCount);
if DrawCount = 100 then begin
DrawCount := 0;
DrawMap(Map);
end;
if KeyPressed then begin
while KeyPressed do ReadKey;
DrawMap(Map);
end;
Sprout;
until NoSeeds;
DrawMap(Map);
end;
begin
Randomize;
TextMode(CO80 + Font8x8);
GenerateMap(Map);
end.
[Back to MISC SWAG index] [Back to Main SWAG index] [Original]