Maze generation: Difference between revisions

Added Delphi Code
(Added Delphi Code)
Line 2,042:
| | | |
+---+---+---+---+---+---+---+---+---+---+---+---+---+---+</pre>
=={{header|Delphi}}==
<lang Pascal>program MazeGen_Rosetta;
 
{$APPTYPE CONSOLE}
 
uses System.SysUtils, System.Types, System.Generics.Collections;
 
type
TMCell = record
Visited : Boolean;
PassTop : Boolean;
PassLeft : Boolean;
end;
 
const
mwidth = 32;
mheight = 12;
 
var
Maze : array[0..mwidth - 1, 0..mheight - 1] of TMCell;
Route : TStack<TPoint>;
 
procedure PrepareMaze;
var
Position: TPoint;
d : Integer;
Pool : array of TPoint; // Pool of directions to pick randomly from
begin
Position := Point(Random(mwidth), Random(mheight));
Route := TStack<TPoint>.Create;
 
with Position do
while True do
begin
repeat
SetLength(Pool, 0);
if (y > 0) and not Maze[x, y-1].Visited then Pool := Pool + [Point(0, -1)];
if (x < mwidth-1) and not Maze[x+1, y].Visited then Pool := Pool + [Point(1, 0)];
if (y < mheight-1) and not Maze[x, y+1].Visited then Pool := Pool + [Point(0, 1)];
if (x > 0) and not Maze[x-1, y].Visited then Pool := Pool + [Point(-1, 0)];
 
if Length(Pool) = 0 then // no direction to draw from
begin
if Route.Count = 0 then Exit; // and we are back at start so this is the end
Position := Route.Pop;
end;
until Length(Pool) > 0;
 
d := Random(Length(Pool));
Offset(Pool[d]);
 
if Maze[x, y].Visited then Continue;
Maze[x, y].Visited := True;
 
if Pool[d].y = -1 then Maze[x, y+1].PassTop := True; // comes from down to up ( ^ )
if Pool[d].x = 1 then Maze[x, y].PassLeft := True; // comes from left to right ( --> )
if Pool[d].y = 1 then Maze[x, y].PassTop := True; // comes from left to right ( v )
if Pool[d].x = -1 then Maze[x+1, y].PassLeft := True; // comes from right to left ( <-- )
Route.Push(Position);
end;
Route.Free;
end;
 
procedure ShowMaze;
var
x, y: Integer;
begin
for y := 0 to mheight - 1 do
begin
for x := 0 to mwidth - 1 do
if Maze[x, y].PassTop then Write('+ ') else Write('+--');
Writeln('+');
for x := 0 to mwidth - 1 do
if Maze[x, y].PassLeft then Write(' ') else Write('| ');
Writeln('|');
end;
for x := 0 to mwidth - 1 do Write('+--');
Writeln('+');
end;
 
begin
Randomize;
PrepareMaze;
ShowMaze;
Readln;
end.</lang>
{{out}}
<pre>+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
| | | | |
+ + +---+---+ + +---+ + +---+---+---+ + +
| | | | | | | |
+---+---+---+---+---+---+---+ +---+ +---+ + +---+
| | | | | |
+ +---+---+---+ + + +---+ +---+---+ +---+---+
| | | | | | | | |
+---+ + + + + +---+---+---+ + +---+ + +
| | | | | | | | |
+ +---+ + +---+---+ + +---+---+---+ +---+ +
| | | | | |
+ +---+---+ + +---+---+---+---+---+ +---+---+ +
| | | | | | | |
+---+ + +---+---+ + +---+ + + +---+---+ +
| | | | | | | |
+ +---+---+---+ + +---+ +---+ + + +---+---+
| | | | | | | | |
+ + +---+---+---+---+ +---+ + +---+---+ + +
| | | |
+---+---+---+---+---+---+---+---+---+---+---+---+---+---+</pre>
=={{header|EasyLang}}==
 
Anonymous user