diff --git a/Занимательное программирование/4/4_prim/labyrinth.ico b/Занимательное программирование/4/4_prim/labyrinth.ico
new file mode 100644
index 0000000..86b1038
Binary files /dev/null and b/Занимательное программирование/4/4_prim/labyrinth.ico differ
diff --git a/Занимательное программирование/4/4_prim/labyrinth.lpi b/Занимательное программирование/4/4_prim/labyrinth.lpi
new file mode 100644
index 0000000..2edb9a2
--- /dev/null
+++ b/Занимательное программирование/4/4_prim/labyrinth.lpi
@@ -0,0 +1,90 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+ -
+
+
+
+
+
diff --git a/Занимательное программирование/4/4_prim/labyrinth.lpr b/Занимательное программирование/4/4_prim/labyrinth.lpr
new file mode 100644
index 0000000..6cb02f1
--- /dev/null
+++ b/Занимательное программирование/4/4_prim/labyrinth.lpr
@@ -0,0 +1,28 @@
+program labyrinth;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF HASAMIGA}
+ athreads,
+ {$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, Unit1, MazeUnit
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ Application.Scaled:=True;
+ {$PUSH}{$WARN 5044 OFF}
+ Application.MainFormOnTaskbar:=True;
+ {$POP}
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/Занимательное программирование/4/4_prim/labyrinth.lps b/Занимательное программирование/4/4_prim/labyrinth.lps
new file mode 100644
index 0000000..26829bd
--- /dev/null
+++ b/Занимательное программирование/4/4_prim/labyrinth.lps
@@ -0,0 +1,189 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Занимательное программирование/4/4_prim/mazeunit.pas b/Занимательное программирование/4/4_prim/mazeunit.pas
new file mode 100644
index 0000000..1c24dbb
--- /dev/null
+++ b/Занимательное программирование/4/4_prim/mazeunit.pas
@@ -0,0 +1,85 @@
+unit MazeUnit;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+ Location = record
+ left_wall, up_wall: Boolean;
+ end;
+ Maze = array of array of Location;
+
+(* Загрузить лабиринт. *)
+procedure LoadMaze(var TheMaze: Maze; FileName: string);
+(* Сохранить лабиринт *)
+procedure SaveMaze(TheMaze: Maze; FileName: string);
+
+function CanGo(TheMaze: Maze; x, y, dx, dy: Integer): Boolean;
+
+implementation
+
+procedure LoadMaze(var TheMaze: Maze; FileName: string);
+var f: TextFile; (* Файл с описанием лабиринта *)
+ Height, Width: Integer; (* высота и ширина лабиринта *)
+ x, y: Integer; (* текущая локация *)
+ lw, uw: Integer; (* временные переменные *)
+begin
+ AssignFile(f, FileName); (* открыть файл *)
+ Reset(f);
+
+ ReadLn(f, Width, Height); (* прочитать высоту и ширину *)
+ SetLength(TheMaze, Width + 1, Height + 1); (* изменить размер лабиринта *)
+
+ for y := 0 to Height do (* Цикл по всем локациям *)
+ for x := 0 to Width do
+ if (y = Height) or (x = Width) then (* если локация - служебная *)
+ begin
+ TheMaze[x, y].left_wall := true; (* обе стены существуют *)
+ TheMaze[x, y].up_wall := true
+ end
+ else
+ begin (* иначе считываем *)
+ ReadLn(f, uw, lw); (* из файла *)
+ TheMaze[x, y].left_wall := Boolean(lw); (* прочитанное целое *)
+ TheMaze[x, y].up_wall := Boolean(uw); (* число надо привести *)
+ end; (* к типу Boolean *)
+ CloseFile(f); (* Закрыть файл *)
+end;
+
+procedure SaveMaze(TheMaze: Maze; FileName: string);
+var f: TextFile; (* файл с описанием лабиринта *)
+ Height, Width: Integer; (* высота и ширина *)
+ x, y: Integer; (* координаты текущей локации *)
+begin
+ AssignFile(f, FileName); (* открыать файл *)
+ Rewrite(f); (* для записи *)
+
+ Height := High(TheMaze[0]); (* определяем высоту *)
+ Width := High(TheMaze); (* и ширину лабиринта *)
+
+ WriteLn(f, Width, ' ', Height); (* запись в файл высоты и ширины *)
+
+ for y := 0 to Height - 1 do
+ for x := 0 to Width - 1 do
+ WriteLn(f, Integer(TheMaze[x, y].up_wall), ' ',
+ Integer(TheMaze[x, y].left_wall));
+
+ CloseFile(f); (* закрыть файл *)
+end;
+
+(* служебная функция: определяет, можно ли пройти из локации
+(x, y) в локацию (x + dx, y + dy), то есть нет ли между ними стены *)
+function CanGo(TheMaze: Maze; x, y, dx, dy: Integer): Boolean;
+begin
+ if dx = -1 then CanGo := not TheMaze[x, y].left_wall
+ else if dx = 1 then CanGo := not TheMaze[x + 1, y].left_wall
+ else if dy = -1 then CanGo := not TheMaze[x, y].up_wall
+ else CanGo := not TheMaze[x, y + 1].up_wall;
+end;
+
+end.
+
diff --git a/Занимательное программирование/4/4_prim/sample.txt b/Занимательное программирование/4/4_prim/sample.txt
new file mode 100644
index 0000000..7ce0c40
--- /dev/null
+++ b/Занимательное программирование/4/4_prim/sample.txt
@@ -0,0 +1,21 @@
+5 4
+1 1
+1 1
+1 0
+1 1
+1 0
+0 1
+1 0
+0 1
+0 0
+1 1
+0 1
+1 0
+1 0
+0 0
+0 0
+1 1
+0 0
+0 1
+0 1
+0 1
diff --git a/Занимательное программирование/4/4_prim/unit1.lfm b/Занимательное программирование/4/4_prim/unit1.lfm
new file mode 100644
index 0000000..d7f553d
--- /dev/null
+++ b/Занимательное программирование/4/4_prim/unit1.lfm
@@ -0,0 +1,69 @@
+object Form1: TForm1
+ Left = 322
+ Height = 620
+ Top = 32
+ Width = 856
+ Caption = 'Form1'
+ ClientHeight = 620
+ ClientWidth = 856
+ DesignTimePPI = 120
+ LCLVersion = '4.2.0.0'
+ object BackBuffer: TImage
+ Left = 16
+ Height = 400
+ Top = 8
+ Width = 824
+ Visible = False
+ end
+ object Screen: TImage
+ Left = 16
+ Height = 400
+ Top = 8
+ Width = 824
+ end
+ object Button1: TButton
+ Left = 16
+ Height = 56
+ Top = 440
+ Width = 176
+ Caption = 'Загрузка/сохранение'
+ TabOrder = 0
+ OnClick = Button1Click
+ end
+ object Button2: TButton
+ Left = 192
+ Height = 56
+ Top = 440
+ Width = 166
+ Caption = 'Рекурсивный обход'
+ TabOrder = 1
+ OnClick = Button2Click
+ end
+ object Button3: TButton
+ Left = 360
+ Height = 56
+ Top = 440
+ Width = 176
+ Caption = 'Волновая трассировка'
+ TabOrder = 2
+ OnClick = Button3Click
+ end
+ object Button4: TButton
+ Left = 536
+ Height = 56
+ Top = 440
+ Width = 144
+ Caption = 'Алгоритм Прима'
+ TabOrder = 3
+ OnClick = Button4Click
+ end
+ object Button5: TButton
+ Left = 680
+ Height = 56
+ Top = 440
+ Width = 160
+ Caption = 'Алгоритм Краскала'
+ TabOrder = 4
+ OnClick = Button5Click
+ end
+end
diff --git a/Занимательное программирование/4/4_prim/unit1.pas b/Занимательное программирование/4/4_prim/unit1.pas
new file mode 100644
index 0000000..e43eb9c
--- /dev/null
+++ b/Занимательное программирование/4/4_prim/unit1.pas
@@ -0,0 +1,513 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+ MazeUnit;
+
+const
+ CellSize = 50;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ BackBuffer: TImage;
+ Button1: TButton;
+ Button2: TButton;
+ Button3: TButton;
+ Button4: TButton;
+ Button5: TButton;
+ Screen: TImage;
+ procedure Button1Click(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure Button3Click(Sender: TObject);
+ procedure Button4Click(Sender: TObject);
+ procedure Button5Click(Sender: TObject);
+ private
+ TheMaze: Maze;
+ public
+
+ end;
+
+procedure ShowMaze(TheMaze: Maze); (* нарисовать лабиринт *)
+procedure RecursiveSolve(TheMaze: Maze; xs, ys, xf, yf: Integer);
+procedure WaveTracingSolve(TheMaze: Maze; xs, ys, xf, yf: Integer);
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+procedure ShowMaze(TheMaze: Maze); (* нарисовать лабиринт *)
+var x, y: Integer;
+ Height, Width: Integer; (* высота и ширина лабиринта *)
+begin
+ Width := High(TheMaze); (* определить высоту и ширину *)
+ Height := High(TheMaze[0]);
+
+ Form1.BackBuffer.Canvas.FillRect(Rect(0, 0, Form1.BackBuffer.Width, Form1.BackBuffer.Height));
+ for x := 0 to Width - 1 do
+ for y := 0 to Height - 1 do
+ begin
+ (* если в локации есть верхняя стена *)
+ if TheMaze[x, y].up_wall then
+ begin
+ (* рисуем ее *)
+ Form1.BackBuffer.Canvas.MoveTo(x * CellSize, y * CellSize);
+ Form1.BackBuffer.Canvas.LineTo((x + 1) * CellSize, y * CellSize)
+ end;
+
+ (* если в локации есть левая стена *)
+ if TheMaze[x, y].left_wall then
+ begin
+ (* рисуем и ее *)
+ Form1.BackBuffer.Canvas.MoveTo(x * CellSize, y * CellSize);
+ Form1.BackBuffer.Canvas.LineTo(x * CellSize, (y + 1) * CellSize)
+ end
+ end;
+ (* рисуем стену снизу и *)
+ Form1.BackBuffer.Canvas.MoveTo(0, Height * CellSize);
+ (* справа от лабиринта *)
+ Form1.BackBuffer.Canvas.LineTo(Width * CellSize, Height * CellSize);
+ Form1.BackBuffer.Canvas.LineTo(Width * CellSize, 0);
+
+ (* отобразить результат на основном экране *)
+ Form1.Screen.Canvas.CopyRect(
+ Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height),
+ Form1.BackBuffer.Canvas,
+ Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height));
+end;
+
+procedure RecursiveSolve(TheMaze: Maze; xs, ys, xf, yf: Integer);
+var visited: array of array of Boolean; (* карта посещений локаций *)
+ x, y, xc, yc: Integer;
+ i: Integer;
+ Path: array of TPoint; (* Результирующий маршрут *)
+ Height, Width: Integer;
+const dx: array[1..4] of Integer = (1, 0, -1, 0); (* смещения *)
+ dy: array[1..4] of Integer = (0, -1, 0, 1);
+
+(* поиск финишной локации из точки (x, y) *)
+function Solve(x, y, depth: Integer): Boolean;
+var i: Integer;
+begin
+ Visited[x, y] := true; (* пометить локцию как посещенную *)
+ Path[depth] := Point(x, y); (* добавить ее в описание маршрута *)
+ Path[depth + 1] := Point(-1, -1); (* добавить признак конца маршрута *)
+
+ if (x = xf) and (y = yf) then (* если финишная локация найдена *)
+ begin
+ Solve := true; (* Конец алгоритма *)
+ Exit;
+ end;
+
+ for i := 1 to 4 do
+ (* если дорожка свободна, идем по ней *)
+ if CanGo(TheMaze, x, y, dx[i], dy[i]) and not Visited[x + dx[i], y + dy[i]] then
+ if Solve(x + dx[i], y + dy[i], depth + 1) then
+ begin
+ Solve := true; (* если решение найдено *)
+ Exit; (* конец алгоритма *)
+ end;
+
+ Visited[x, y] := false; (* пометить локацию как непосещенную *)
+ Solve := false; (* решение найдено *)
+end;
+
+begin (* главная процедура *)
+ Width := High(TheMaze);
+ Height := High(TheMaze[0]);
+ SetLength(Path, Height * Width + 1); (* выделяем память для маршрута *)
+ SetLength(Visited, Width, Height); (* и для списка посещенных локаций *)
+
+ for x := 0 to Width - 1 do
+ for y := 0 to Height - 1 do
+ Visited[x, y] := false; (* изначально ни одна не посещена *)
+
+ if Solve(xs, ys, 0) then (* если найдено решение, рисуем его *)
+ begin
+ i := 0;
+ while not ((Path[i].x = -1) and (Path[i].y = -1)) do
+ begin
+ xc := CellSize * (2 * Path[i].x + 1) div 2;
+ yc := CellSize * (2 * Path[i].y + 1) div 2;
+ Form1.Screen.Canvas.Ellipse(xc - 5, yc - 5, xc + 5, yc + 5);
+ i := i + 1
+ end;
+ end;
+
+end;
+
+procedure WaveTracingSolve(TheMaze: Maze; xs, ys, xf, yf: Integer);
+var Mark: array of array of Integer; (* метки локаций *)
+ x, y, xc, yc: Integer;
+ N, i: Integer;
+ Height, Width: Integer;
+const dx: array[1..4] of Integer = (1, 0, -1, 0); (* смещений *)
+ dy: array[1..4] of Integer = (0, -1, 0, 1);
+
+function Solve: Boolean; (* поиск решения *)
+var i, N, x, y: Integer;
+ NoSolution: Boolean;
+begin
+ N := 1; (* начинаем с итерации номер 1 *)
+
+ repeat
+ NoSolution := true; (* пессимистично полагаем, что решения нет *)
+ for x := 0 to Width - 1 do
+ for y := 0 to Height - 1 do
+ if Mark[x, y] = N then (* найти локации, помеченные числом N *)
+ for i := 1 to 4 do (* просмотр соседних локаций *)
+ if CanGo(TheMaze, x, y, dx[i], dy[i]) and (Mark[x + dx[i], y + dy[i]] = 0) then
+ begin (* локация доступна и помечена нулем *)
+ NoSolution := false; (* есть шанс найти решение *)
+ (* помечаем соседнюю локацию числом N + 1 *)
+ Mark[x + dx[i], y + dy[i]] := N + 1;
+ if (x + dx[i] = xf) and (y + dy[i] = yf) then
+ begin
+ Solve := true; (* дошло до финишной локации *)
+ Exit; (* конец алгоритма *)
+ end;
+ end;
+ N := N + 1; (* переход к следующей итерации *)
+ until NoSolution; (* повторять, если есть надежда найти решение *)
+
+ Solve := false; (* нет, решение не найдено *)
+end;
+
+begin
+ Width := High(TheMaze);
+ Height := High(TheMaze[0]);
+ SetLength(Mark, Width, Height); (* выделение памяти для пометок *)
+
+ for x := 0 to Width - 1 do (* изначально все заполняется нулями *)
+ for y := 0 to Height - 1 do
+ Mark[x, y] := 0;
+
+ Mark[xs, ys] := 1; (* стартовой локции соответствует единица *)
+ if Solve then (* если найдено решение, рисуем его *)
+ begin
+ x := xf;
+ y := yf;
+ for N := Mark[xf, yf] downto 1 do
+ begin
+ (* рисуем окружность на очередной локции маршрута *)
+ xc := CellSize * (2 * x + 1) div 2;
+ yc := CellSize * (2 * y + 1) div 2;
+ Form1.Screen.Canvas.Ellipse(xc - 5, yc - 5, xc + 5, yc + 5);
+
+ for i := 1 to 4 do
+ if CanGo(TheMaze, x, y, dx[i], dy[i]) and (Mark[x + dx[i], y + dy[i]] = N - 1) then
+ begin
+ x := x + dx[i]; (* ищем следующую локацию маршрута *)
+ y := y + dy[i];
+ Break;
+ end;
+ end;
+ end;
+end;
+
+(* Генерация лабиринта по алгоритму Прима *)
+function PrimGenerateMaze(Width, Height : Integer) : Maze;
+type AttrType = (Inside, Outside, Border); (* тип "атрибут локации" *)
+var
+ TheMaze: Maze; (* сам лабиринта *)
+ x, y, i: Integer;
+ xc, yc: Integer;
+ Attribute: array of array of AttrType; (* карта атрибутов *)
+ IsEnd: Boolean;
+ counter: Integer;
+ borders: array of TPoint;
+ borderToInside: TPoint;
+const
+ dx: array[1..4] of Integer = (1, 0, -1, 0); (* смещения *)
+ dy : array[1..4] of Integer = (0, -1, 0, 1);
+
+label ExitFor; (* используемые метки *)
+
+procedure BreakWall(x, y, dx, dy : Integer); (* разрушить стену *)
+begin (* между локациями *)
+ if dx = -1 then TheMaze[x, y].left_wall := false
+ else if dx = 1 then TheMaze[x + 1, y].left_wall := false
+ else if dy = -1 then TheMaze[x, y].up_wall := false
+ else TheMaze[x, y + 1].up_wall := false;
+end;
+
+begin
+ borders := nil;
+ SetLength(Attribute, Width, Height); (* выделение памяти для атрибутов *)
+ SetLength(TheMaze, Width + 1, Height + 1); (* изменить размер лабиринта *)
+
+ for x := 0 to Width - 1 do (* изначально все атрибуты *)
+ for y := 0 to Height - 1 do (* равны Outside *)
+ Attribute[x, y] := Outside;
+
+ for y := 0 to Height do (* все стены изначально *)
+ for x := 0 to Width do (* существуют *)
+ begin
+ TheMaze[x, y].left_wall := true;
+ TheMaze[x, y].up_wall := true;
+ end;
+
+ Randomize;
+ x := Random(Width); (* выбираем начальную локацию *)
+ y := Random(Height);
+ Attribute[x, y] := Inside; (* и присваиваем ей атрибут Inside *)
+
+ for i := 1 to 4 do (* всем ее соседям присваиваем *)
+ begin (* атрибут Border *)
+ xc := x + dx[i];
+ yc := y + dy[i];
+ if (xc >= 0) and (yc >= 0) and (xc < Width) and (yc < Height) then
+ begin
+ SetLength(borders, Length(borders) + 1);
+ borders[Length(borders) - 1].X := xc;
+ borders[Length(borders) - 1].Y := yc;
+ Attribute[xc, yc] := Border
+ end
+ end;
+
+ repeat (* главный цикл *)
+ IsEnd := true;
+ counter := Length(borders);
+
+ (* Выбираем из них одну случайную. *)
+ counter := Random(counter);
+ borderToInside := borders[counter];
+
+ (* Удаляем локацию с атрибутом Border из списка. *)
+ Move(borders[counter + 1], borders[counter], SizeOf(TPoint) * (Length(borders) - counter - 1));
+ SetLength(borders, Length(borders) - 1);
+
+ (* Присвоить ей атрибут Inside. *)
+ Attribute[borderToInside.X, borderToInside.Y] := Inside;
+
+ counter := 0;
+ for i := 1 to 4 do
+ begin
+ xc := borderToInside.X + dx[i];
+ yc := borderToInside.Y + dy[i];
+ if (xc >= 0) and (yc >= 0) and (xc < Width) and (yc < Height) then
+ begin (* подсчитать количество локаций с атрибутом Inside *)
+ if Attribute[xc, yc] = Inside then counter := counter + 1;
+ if Attribute[xc, yc] = Outside then
+ begin
+ (* Заменить атрибуты с Outside на Border. *)
+ SetLength(borders, Length(borders) + 1);
+ borders[Length(borders) - 1].X := xc;
+ borders[Length(borders) - 1].Y := yc;
+ Attribute[xc, yc] := Border;
+ end
+ end;
+ end;
+
+ counter := Random(counter) + 1; (* выбрать случайную Inside-локацию *)
+ for i := 1 to 4 do
+ begin
+ xc := borderToInside.X + dx[i];
+ yc := borderToInside.Y + dy[i];
+ if (xc >= 0) and (yc >= 0) and (xc < Width) and (yc < Height)
+ and (Attribute[xc, yc] = Inside) then
+ begin
+ counter := counter - 1;
+ if counter = 0 then (* разрушить стену между ней и *)
+ begin (* текущей локацией *)
+ BreakWall(borderToInside.X, borderToInside.y, dx[i], dy[i]);
+ goto ExitFor
+ end;
+ end;
+ end;
+
+ExitFor:
+ (* Определить, есть ли хоть одна локация с атрибутом Border. *)
+ if Length(borders) > 0 then
+ begin
+ (* Если да, продолжаем выполнять алгоритм. *)
+ IsEnd := false
+ end;
+
+ ShowMaze(TheMaze); (* отобразить процесс генерации *)
+ Application.ProcessMessages;
+ until IsEnd;
+ PrimGenerateMaze := TheMaze;
+end;
+
+(* Генерация лабиринта по алгоритму Краскала *)
+function KruskalGenerateMaze(Width, Height : Integer) : Maze;
+type Wall = record (* тип "стена" *)
+ x, y, dx, dy : Integer;
+end;
+var TheMaze: Maze; (* сам лабиринт *)
+ Walls: array of Wall; (* массив стен *)
+ Temp: array of Real; (* временный массив для сортироваки стен *)
+ i, j: Integer;
+ tempw: Wall;
+ tempr: Real;
+ CurWall: Wall;
+ locations: Integer;
+ counter: Integer;
+
+procedure BreakWall(x, y, dx, dy : Integer); (* разрушить стену *)
+begin (* между локациями *)
+ if dx = -1 then TheMaze[x, y].left_wall := false
+ else if dx = 1 then TheMaze[x + 1, y].left_wall := false
+ else if dy = -1 then TheMaze[x, y].up_wall := false
+ else TheMaze[x, y + 1].up_wall := false;
+end;
+
+function IsConnected(xs, ys, xf, yf : Integer) : Boolean;
+(* используем алгоритм волновой трассировки *)
+var Mark: array of array of Integer;
+ x, y: Integer;
+ Height, Width: Integer;
+const dx : array[1..4] of Integer = (1, 0, -1, 0);
+ dy : array[1..4] of Integer = (0, -1, 0, 1);
+
+function CanGo(x, y, dx, dy : Integer) : Boolean;
+begin
+ if dx = -1 then CanGo := not TheMaze[x, y].left_wall
+ else if dx = 1 then CanGo := not TheMaze[x + 1, y].left_wall
+ else if dy = -1 then CanGo := not TheMaze[x, y].up_wall
+ else CanGo := not TheMaze[x, y + 1].up_wall;
+end;
+
+function Solve : Boolean;
+var i, N, x, y : Integer;
+ NoSolution : Boolean;
+begin
+ N := 1;
+
+ repeat
+ NoSolution := true;
+ for x := 0 to Width - 1 do
+ for y := 0 to Height - 1 do
+ if Mark[x, y] = N then
+ for i := 1 to 4 do
+ if CanGo(x, y, dx[i], dy[i]) and (Mark[x + dx[i], y + dy[i]] = 0) then
+ begin
+ NoSolution := false;
+
+ Mark[x + dx[i], y + dy[i]] := N + 1;
+ if (x + dx[i] = xf) and (y + dy[i] = yf) then
+ begin
+ Solve := true;
+ Exit;
+ end;
+ end;
+ N := N + 1;
+ until NoSolution;
+
+ Solve := false;
+end;
+
+begin
+ Width := High(TheMaze);
+ Height := High(TheMaze[0]);
+ SetLength(Mark, Width, Height);
+
+ for x := 0 to Width - 1 do
+ for y := 0 to Height - 1 do
+ Mark[x, y] := 0;
+
+ Mark[xs, ys] := 1;
+ IsConnected := Solve;
+end;
+
+begin
+ (* выделение памяти для массива стен
+ в лабиринте Width * Height изначально
+ (Width - 1) * Height + (Height - 1) * Width стен *)
+ SetLength(Walls, (Width - 1) * Height + (Height - 1) * Width);
+ SetLength(Temp, (Width - 1) * Height + (Height - 1) * Width);
+ SetLength(TheMaze, Width + 1, Height + 1); (* указать размер лабиринта *)
+
+ for i := 0 to Width do (* все стены изначально *)
+ for j := 0 to Height do (* существуют *)
+ begin
+ TheMaze[i, j].left_wall := true;
+ TheMaze[i, j].up_wall := true;
+ end;
+
+ Randomize;
+ for i := 0 to (Width - 1) * Height + (Height - 1) * Width - 1 do
+ Temp[i] := Random; (* заполнение массива Temp случайными числами *)
+
+ counter := 0; (* заполнение массива стен *)
+ for i := 1 to Width - 1 do
+ for j := 0 to Height - 1 do
+ begin (* сначала все горизонтальные *)
+ Walls[counter].x := i; Walls[counter].y := j;
+ Walls[counter].dx := -1; Walls[counter].dy := 0;
+ counter := counter + 1;
+ end;
+ for i := 0 to Width - 1 do
+ for j := 1 to Height - 1 do
+ begin (* затем все вертикальные *)
+ Walls[counter].x := i; Walls[counter].y := j;
+ Walls[counter].dx := 0; Walls[counter].dy := -1;
+ counter := counter + 1;
+ end;
+
+ for i := 0 to (Width - 1) * Height + (Height - 1) * Width - 1 do
+ for j := i to (Width - 1) * Height + (Height - 1) * Width - 1 do
+ if Temp[i] > Temp[j] then (* перемешиваем массив стен *)
+ begin
+ tempr := Temp[i]; Temp[i] := Temp[j]; Temp[j] := tempr;
+ tempw := Walls[i]; Walls[i] := Walls[j]; Walls[j] := tempw;
+ end;
+
+ locations := Width * Height;
+ i := 0;
+ while locations > 1 do (* прямолинейная реализация *)
+ begin (* алгоритма Краскала *)
+ CurWall := Walls[i];
+ i := i + 1;
+ if not IsConnected(CurWall.x, CurWall.y, CurWall.x + CurWall.dx, CurWall.y + CurWall.dy) then
+ begin
+ BreakWall(CurWall.x, CurWall.y, CurWall.dx, CurWall.dy);
+ locations := locations - 1;
+ ShowMaze(TheMaze);
+ Application.ProcessMessages;
+ end;
+ end;
+
+ KruskalGenerateMaze := TheMaze;
+end;
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ LoadMaze(TheMaze, 'sample.txt');
+ ShowMaze(TheMaze)
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+ RecursiveSolve(TheMaze, 0, 0, 4, 0)
+end;
+
+procedure TForm1.Button3Click(Sender: TObject);
+begin
+ WaveTracingSolve(TheMaze, 0, 0, 4, 0)
+end;
+
+procedure TForm1.Button4Click(Sender: TObject);
+begin
+ PrimGenerateMaze(30, 18)
+end;
+
+procedure TForm1.Button5Click(Sender: TObject);
+begin
+ KruskalGenerateMaze(30, 18)
+end;
+
+end.
+
diff --git a/Занимательное программирование/README.txt b/Занимательное программирование/README.txt
index a6a1e19..2b03ec7 100644
--- a/Занимательное программирование/README.txt
+++ b/Занимательное программирование/README.txt
@@ -5,5 +5,7 @@ Pascal или Delphi, в моем случае это Free Pascal и Lazarus.
В первой главе ("Компьютерное моделирование") есть один С файл (для
рисования применяется Cairo).
-Вторая ("Анимация и графические эффекты") и четвертая ("Трехмерная
-графика") главы основывается на Java и игровом движке libGDX.
+Вторая глава ("Анимация и графические эффекты") основывается на Java и
+игровом движке libGDX.
+
+Четвертая глава ("Трехмерная графика") сделана с Pascal и libGDX.