- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
Function TMainForm.PrimGenerateMaze(Width, Height: Integer): Maze;
Type Point = record
x, y: Integer;
end;
Var
TehMaze: Maze;
Todo: array of Point;
todonum: integer;
x,y,n,d: integer;
Const
dx: array [0..3] of Integer = (0, 0, -1, 1);
dy: array [0..3] of Integer = (-1, 1, 0, 0);
BEGIN
SetLength(TehMaze, Width, Height);
SetLength(Todo, (Width * Height) - 1);
For x:=0 to Width-1 do
For y:=0 to Height-1 do
If (x = 0) or (x = Width-1) or (y = 0) or (y = Height-1) then
TehMaze[x][y]:=32
Else TehMaze[x][y]:=63;
Randomize;
x := Random(Width-2)+1;
y := Random(Height-2)+1;
todonum := 0;
TehMaze[x][y]:= TehMaze[x][y] and not 48; // Пометить клетку как принадлежащую лабиринту
// Пока не обработаны все клетки
Repeat
Begin
// Занести в список todo все ближайшие необработанные клетки
For d:=0 to 3 do
if (TehMaze[x + dx[d]][y + dy[d]] and 16) <> 0 then
Begin
todo[todonum].x := x + dx[d];
todo[todonum].y := y + dy[d];
Inc(todonum);
TehMaze[x + dx[d]][y + dy[d]] := TehMaze[x + dx[d]][y + dy[d]] and not 16;
End;
// Выбрать из списка todo произвольную клетку
n:= Random(todoNum);
x:= ToDo[n].x;
y:= ToDo[n].y;
// Удалить из списка обработанную клетку
Dec(todonum);
ToDo[n]:= todo[todonum];
// Выбрать направление, которое ведет к лабиринту
Repeat
d:=Random(4);
Until ((TehMaze[x + dx[d]][y + dy[d]] and 32) = 0);
// Присоединить выбранную клетку к лабиринту
TehMaze[x][y] := TehMaze[x][y] and not ((1 shl d) or 32);
TehMaze[x + dx[d]][y + dy[d]] := TehMaze[x + dx[d]][y + dy[d]] and not (1 shl (d xor 1));
End;
Until (todonum = 0);
TehMaze[1][1] := TehMaze[1][1] and -2; // начало лабиринта - в левом верхнем углу
TehMaze[Width-2][Height-2] := TehMaze[Width-2][Height-2] and not 2; // конец лабиринта - в правом нижнем углу
Result := TehMaze;
END;