From 9064a9de55326a9c4a224758d0f689c8cb98d4a4 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 15 May 2026 10:34:47 +0200 Subject: =?UTF-8?q?=D0=97=D0=B0=D0=BA=D0=BE=D0=BD=D1=87=D0=B8=D0=BB=20?= =?UTF-8?q?=D1=81=D0=BE=D0=BA=D0=BE=D0=B1=D0=B0=D0=BD=20=D0=B8=D0=B7=207-?= =?UTF-8?q?=D0=B9=20=D0=B3=D0=BB=D0=B0=D0=B2=D1=8B,=20=D1=87=D0=B5=D1=82?= =?UTF-8?q?=D0=B2=D0=B5=D1=80=D1=82=D0=BE=D0=B3=D0=BE=20=D1=83=D0=BF=D1=80?= =?UTF-8?q?=D0=B0=D0=B6=D0=BD=D0=B5=D0=BD=D0=B8=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../7/4_solver/unit1.pas" | 177 +++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 "\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/4_solver/unit1.pas" (limited to 'Занимательное программирование/7/4_solver/unit1.pas') diff --git "a/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/4_solver/unit1.pas" "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/4_solver/unit1.pas" new file mode 100644 index 0000000..af58196 --- /dev/null +++ "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/4_solver/unit1.pas" @@ -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. + -- cgit v1.2.3