Закончил сокобан из 7-й главы, четвертого упражнения

2026-05-15 10:34:47 +02:00
parent ee8f910cb0
commit 9064a9de55
12 changed files with 1236 additions and 2 deletions
@@ -0,0 +1,177 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
+  States, Problems;
+
+const
+  CELL_SIZE = 32;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BackBuffer: TImage;
+    ImageList: TImageList;
+    MoveList: TListBox;
+    Screen: TImage;
+    OpenLevel: TButton;
+    OpenDialog: TOpenDialog;
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure OpenLevelClick(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+  Board: TBoard; { Игровое поле. }
+
+implementation
+
+{$R *.lfm}
+
+{ Загрузить уровень из файла. }
+procedure LoadLevel(FileName: String);
+var
+  f: File of Char;
+  i, j, ColumnCount, CurrentColumn: Integer;
+  c: Char;
+  InitialState: TState;
+begin
+  AssignFile(f, FileName); { Открыть файл. }
+  Reset(f);
+
+  FreeAndNil(Board);
+  InitialState := TState.Create;
+
+  { Читаем первую строку, чтобы найти количество столбцов. }
+  ColumnCount := 0;
+  repeat
+    Read(f, c);
+    if c = 'x' then
+      InitialState.AddWall(ColumnCount, 0);
+    Inc(ColumnCount)
+  until c <> 'x';
+  Dec(ColumnCount);
+  Read(f, c); { Считываем и пропускаем перевод строки. }
+  j := 1;
+
+  repeat { Цикл по строкам. }
+    CurrentColumn := 0;
+
+    for i := 0 to ColumnCount - 1 do { Цикл по элементам строки. }
+    begin
+      Read(f, c); { Считаем текущий эелемент }
+
+      case c of
+        'x':
+        begin
+          InitialState.AddWall(i, j);
+          Inc(CurrentColumn)
+        end;
+        's':
+          InitialState.SetAgent(i, j);
+        'p': { Если это "место". }
+          InitialState.AddPlace(i, j);
+        'b': { Если это "камень". }
+          InitialState.AddBoulder(i, j)
+      end
+    end;
+    Inc(j);
+    Read(f, c); { считываем и пропускаем возврат каретки }
+    Read(f, c) { Считываем и пропускаем перевод строки. }
+  until CurrentColumn = ColumnCount;
+
+  Board := TBoard.Create(ColumnCount, j, InitialState);
+
+  CloseFile(f) { закрыть файл }
+end;
+
+procedure DrawCell(APosition: TPosition; Bitmap: TBitmap);
+begin
+  Form1.BackBuffer.Canvas.Draw(APosition.X * CELL_SIZE,
+      APosition.Y * CELL_SIZE,
+      Bitmap)
+end;
+
+procedure RedrawField;
+var
+  Bitmap: TBitmap;
+  ScreenRect: TRect;
+  CurrentPosition: TPosition;
+begin
+  Bitmap := TBitmap.Create; { Объект для временного хранения рисунка. }
+
+  Form1.BackBuffer.Canvas.Brush.Color := clBlack;
+  Form1.BackBuffer.Canvas.Clear;
+
+  { Рисуем стены. }
+  Form1.ImageList.GetBitmap(8, bitmap);
+  for CurrentPosition in Board.InitialState.Walls do
+    DrawCell(CurrentPosition, bitmap);
+  { Рисуем агента. }
+  Form1.ImageList.GetBitmap(4, bitmap);
+  DrawCell(Board.InitialState.Agent, Bitmap);
+
+  { Рисуем камни. }
+  Form1.ImageList.GetBitmap(2, bitmap);
+  for CurrentPosition in Board.InitialState.Boulders do
+    DrawCell(CurrentPosition, bitmap);
+
+  { Рисуем объекты. }
+  Form1.ImageList.GetBitmap(1, bitmap);
+  For CurrentPosition in Board.InitialState.Places do
+    DrawCell(CurrentPosition, bitmap);
+
+  Bitmap.Free;
+
+  { Копируем содержимое виртуального экрана на основной. }
+  ScreenRect := Rect(0, 0, Screen.Width, Screen.Height);
+  Form1.Screen.Canvas.CopyRect(ScreenRect, Form1.BackBuffer.Canvas, ScreenRect)
+end;
+
+{ TForm1 }
+
+procedure TForm1.OpenLevelClick(Sender: TObject);
+var
+  i: Integer;
+  Solution: TStates;
+  SolutionLine: String;
+begin
+  if OpenDialog.Execute then
+  begin
+    LoadLevel(OpenDialog.FileName);
+    RedrawField;
+
+    Solution := Search(Board.InitialState);
+    for i := 0 to High(Solution)  do
+    begin
+      SolutionLine := 'Agent: (' + IntToStr(Solution[i].Agent.X)
+          + ', ' + IntToStr(Solution[i].Agent.Y) + ')';
+      FreeAndNil(Solution[i]);
+      MoveList.AddItem(SolutionLine, nil)
+    end
+  end;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Board := nil
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(Board)
+end;
+
+end.
+