Maze generation: Difference between revisions

Content added Content deleted
(Updated to work with Nim 1.4: added missing parameter type, import "random" instead of "math", changed "random" to "rand", changed ".. <" to "..<".)
(Changed to handle solutions from other page)
Line 2,047: Line 2,047:
{$APPTYPE CONSOLE}
{$APPTYPE CONSOLE}


uses System.SysUtils, System.Types, System.Generics.Collections;
uses System.SysUtils, System.Types, System.Generics.Collections, System.IOUtils;


type
type
Line 2,055: Line 2,055:
PassLeft : Boolean;
PassLeft : Boolean;
end;
end;
TMaze = array of array of TMCell;
⚫
TRoute = TStack<TPoint>;


const
const
mwidth = 32;
mwidth = 24;
mheight = 12;
mheight = 14;


procedure ClearVisited(var AMaze: TMaze);
var
var
x, y: Integer;
Maze : array[0..mwidth - 1, 0..mheight - 1] of TMCell;
begin
for y := 0 to mheight - 1 do
for x := 0 to mwidth - 1 do
AMaze[x, y].Visited := False;
end;


procedure PrepareMaze;
procedure PrepareMaze(var AMaze: TMaze);
var
var
Position: TPoint;
Route : TRoute;
d : Integer;
Position : TPoint;
d : Integer;
Pool : array of TPoint; // Pool of directions to pick randomly from
Pool : array of TPoint; // Pool of directions to pick randomly from
⚫
Route : TStack<TPoint>;
begin
begin
SetLength(AMaze, mwidth, mheight);
ClearVisited(AMaze);
Position := Point(Random(mwidth), Random(mheight));
Position := Point(Random(mwidth), Random(mheight));
Route := TStack<TPoint>.Create;
Route := TStack<TPoint>.Create;
Line 2,078: Line 2,088:
repeat
repeat
SetLength(Pool, 0);
SetLength(Pool, 0);
if (y > 0) and not Maze[x, y-1].Visited then Pool := Pool + [Point(0, -1)];
if (y > 0) and not AMaze[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 (x < mwidth-1) and not AMaze[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 (y < mheight-1) and not AMaze[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 (x > 0) and not AMaze[x-1, y].Visited then Pool := Pool + [Point(-1, 0)];


if Length(Pool) = 0 then // no direction to draw from
if Length(Pool) = 0 then // no direction to draw from
Line 2,093: Line 2,103:
Offset(Pool[d]);
Offset(Pool[d]);


Maze[x, y].Visited := True;
AMaze[x, y].Visited := True;
if Pool[d].y = -1 then Maze[x, y+1].PassTop := True; // comes from down to up ( ^ )
if Pool[d].y = -1 then AMaze[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].x = 1 then AMaze[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].y = 1 then AMaze[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 ( <-- )
if Pool[d].x = -1 then AMaze[x+1, y].PassLeft := True; // comes from right to left ( <-- )
Route.Push(Position);
Route.Push(Position);
end;
end;
Line 2,105: Line 2,115:
end;
end;


function MazeToString(const AMaze: TMaze; const S, E: TPoint): String; overload;
⚫
procedure ShowMaze;
var
var
x, y: Integer;
x, y: Integer;
v : Char;
begin
begin
Result := '';
for y := 0 to mheight - 1 do
for y := 0 to mheight - 1 do
begin
begin
for x := 0 to mwidth - 1 do
for x := 0 to mwidth - 1 do
if Maze[x, y].PassTop then Write('+ ') else Write('+---');
if AMaze[x, y].PassTop then Result := Result + '+'#32#32#32 else Result := Result + '+---';
Result := Result + '+' + sLineBreak;
Writeln('+');
for x := 0 to mwidth - 1 do
for x := 0 to mwidth - 1 do
begin
if Maze[x, y].PassLeft then Write(' ') else Write('| ');
if S = Point(x, y) then v := 'S' else
Writeln('|');
if E = Point(x, y) then v := 'E' else
v := #32'*'[Ord(AMaze[x, y].Visited) + 1];

Result := Result + '|'#32[Ord(AMaze[x, y].PassLeft) + 1] + #32 + v + #32;
end;
Result := Result + '|' + sLineBreak;
end;
end;
for x := 0 to mwidth - 1 do Write('+---');
for x := 0 to mwidth - 1 do Result := Result + '+---';
Result := Result + '+' + sLineBreak;
Writeln('+');
end;
end;


⚫
procedure Main;
var
Maze: TMaze;
begin
begin
Randomize;
Randomize;
PrepareMaze;
PrepareMaze(Maze);
ClearVisited(Maze); // show no route
ShowMaze;
Write(MazeToString(Maze, Point(-1, -1), Point(-1, -1)));
Readln;
ReadLn;
end;

begin
Main;

end.</lang>
end.</lang>
{{out}}
{{out}}
Retrieved from "https://rosettacode.org/wiki/Maze_generation"