book-exercises/Занимательное программирование/7/4_solver/unit1.pas

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.