path: root/Занимательное программирование/7/3_sokoban/Unit1.pas

unit Unit1;

{$MODE objfpc}{$H+}

interface

uses
  LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ImgList;

type
  TForm1 = class(TForm)
    MainMenu: TMainMenu;
    FileMenu: TMenuItem;
    ItemOpen: TMenuItem;
    ItemExit: TMenuItem;
    Screen: TImage;
    ImageList: TImageList;
    OpenDialog: TOpenDialog;
    BackBuffer: TImage;
    procedure ItemExitClick(Sender: TObject);
    procedure ItemOpenClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
    WALL = 11; SPACE = 10;
    SL = 14; SR = 15; SU = 12; SD = 13; { Индексы спрайтов. }
    BOULDER_SET = ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i'];
    PLACE_SET = ['1', '2', '3', '4', '5', '6', '7', '8', '9'];
var
    Form1: TForm1;
    Field: array[1..20, 1..12] of Integer;   { Игровое поле. }
    Places: array[1..20, 1..12] of Integer;   { Положение мест. }
    PlaceCount: Integer;                    { Общее число мест на уровне. }
    CurX, CurY: Integer;                     { Текущее положение Сокобана. }
    Positioned: Integer;                     { Количество размещенных камней. }
    Busy: Boolean = false;                   { Статус обработчика клавиш. }

implementation

{$R *.lfm}

{ Перевод символа в порядковый номер картинки. }
function SymbolToCode(c: Char): Integer;
begin
    case c of
        'x': SymbolToCode := WALL;          { 'x' - стена }
        ' ': SymbolToCode := SPACE;         { ' ' - пустое пространство }
        's': SymbolToCode := SL;            { 's' - стартовая локация }
    else
        SymbolToCode := -1                 { Неизвестный символ. }
    end;
end;

{ Загрузить уровень из файла. }
procedure LoadLevel(FileName: String);
var f: File of Char;
    i, j : Integer;
    c: Char;
begin
    AssignFile(f, FileName);                { Открыть файл. }
    Reset(f);

    PlaceCount := 0;                       { Подсчет количества мест. }
    for j := 1 to 12 do                     { Цикл по строкам. }
    begin
        for i := 1 to 20 do                 { Цикл по элементам строки. }
        begin
            Read(f, c);                     { Считаем текущий эелемент }
            if c in PLACE_SET then                 { если это "место" }
            begin
                Field[i, j] := SPACE; { в поле равнозначно пустому элементу }
                VAL(c, Places[i, j]);            { True в массиве Places }
                Inc(PlaceCount)
            end
            else if c in BOULDER_SET then
            begin
                 Places[i, j] := 0;
                 Field[i, j] := ORD(c) - ORD('`')
            end
            else
            begin
                Places[i, j] := 0;           { иначе НЕ "место" }
                Field[i, j] := SymbolToCode(c);  { определяем код элемента }

                if c = 's' then                  { если текущая локация - }
                begin                            { стартовая, запоминаем }
                    CurX := i;                   { ее координаты }
                    CurY := j
                end
            end
        end;
        Read(f, c);  { считываем и пропускаем возврат каретки }
        Read(f, c)  { считываем и пропускаем перевод строки }
    end;

    CloseFile(f) { закрыть файл }
end;

{ Перерисовка уровня. }
procedure RedrawField;
var
    i, j: Integer;
    code: Integer;
    bitmap: TBitmap;
    ScreenRect: TRect;
begin
    bitmap := TBitmap.Create;     { объект для временного хранения рисунка }
    Positioned := 0;              { считаем, что размещено 0 камней }

    Form1.BackBuffer.Canvas.Brush.Color := clBlack;
    Form1.BackBuffer.Canvas.Clear;

    for j := 1 to 12 do
        for i := 1 to 20 do
        begin
            code := Field[i, j]; { код текущего элемента }

            { Пара "пустое пространство" / "место" означает "место" }
            if Field[i, j] = WALL then
                 code := 8
            else if Field[i, j] = SU then
                 code := 4
            else if Field[i, j] = SD then
                 code := 5
            else if Field[i, j] = SL then
                 code := 6
            else if Field[i, j] = SR then
                 code := 7
            else if (Field[i, j] = SPACE) and (Places[i, j] <> 0) then
            begin
                Form1.ImageList.GetBitmap(0, bitmap);
                Form1.BackBuffer.Canvas.Draw((i - 1) * 32, (j - 1) * 32, bitmap);
                code := 8 + Places[i, j]
            end
            else if Field[i, j] = SPACE then
                code := 0
            { а пара "камень" / "место" - "камень на месте" }
            else if Field[i, j] = Places[i, j] then
            begin
                code := 3;
                { При этом увеличиваем счетчик размещенных камней. }
                Inc(Positioned)
            end
            else if Field[i, j] > 0 then
            begin
                Form1.ImageList.GetBitmap(2, bitmap);
                Form1.BackBuffer.Canvas.Draw((i - 1) * 32, (j - 1) * 32, bitmap);
                code := 8 + Field[i, j]
            end;

            Form1.ImageList.GetBitmap(code, bitmap);  { Достаем картинку }
            { и рисуем ее на соответствующем месте виртуального экрана. }
            Form1.BackBuffer.Canvas.Draw((i - 1) * 32, (j - 1) * 32, bitmap)
        end;

    bitmap.Free;

    { Копируем содержимое виртуального экрана на основной. }
    ScreenRect := Rect(0, 0, 640, 384);
    Form1.Screen.Canvas.CopyRect(ScreenRect, Form1.BackBuffer.Canvas, ScreenRect)
end;

{--------------------------------------------------------------------------}

procedure TForm1.ItemExitClick(Sender: TObject);
begin
    Application.Terminate
end;

{--------------------------------------------------------------------------}

procedure TForm1.ItemOpenClick(Sender: TObject);
begin
    if OpenDialog.Execute then
    begin
        LoadLevel(OpenDialog.FileName);
        RedrawField
    end;
end;

{--------------------------------------------------------------------------}

procedure TForm1.FormShow(Sender: TObject);
begin
    while not OpenDialog.Execute do
        ;

    LoadLevel(OpenDialog.FileName);
    RedrawField
end;

{--------------------------------------------------------------------------}

function PositionBy(x, y: Integer; scale: Integer = 1): Integer;
begin
    Result := Field[CurX + x * scale, CurY + y * scale]
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
    dx, dy: Integer;           { Смещения Сокобана (куда идем). }
    SprIdx: Integer;           { Текущий номер его спрайта. }
    TargetCell: Integer;
begin
    if Busy then Exit;        { Если обработчик занят, выходим. }

    Busy := true;             { статус = занято }
    case Key of
        VK_LEFT:
          begin { идем влево }
              dx := -1;
              dy := 0;
              SprIdx := SL
          end;
        VK_RIGHT:
          begin { вправо }
              dx := 1;
              dy := 0;
              SprIdx := SR
          end;
        VK_UP:
          begin { вверх }
              dx := 0;
              dy := -1;
              SprIdx := SU
          end;
        VK_DOWN:
          begin { вниз }
              dx := 0;
              dy := 1;
              SprIdx := SD
          end;
    else
        { никуда не идем }
        dx := 0;
        dy := 0;
        SprIdx := Field[CurX, CurY]
    end;
    TargetCell := PositionBy(dx, dy);

    if TargetCell = SPACE then  { если целевая клетка пуста }
    begin
        Field[CurX + dx, CurY + dy] := SprIdx;   { переходим в нее }
        Field[CurX, CurY] := SPACE;    { на старой позиции теперь ничего нет }
        CurX := CurX + dx;
        CurY := CurY + dy;
    end
    { если целевая клетка содержит камень, а клетка, следующая за ней, пуста }
    else if (TargetCell > 0) and (TargetCell < SPACE) and (PositionBy(dx, dy, 2) = SPACE) then
    begin                                             { двигаем камень: }
        Field[CurX + dx, CurY + dy] := SprIdx;      { новая позиция Сокобана }
        Field[CurX + 2 * dx, CurY + 2 * dy] := TargetCell; { новая позиция камня }
        Field[CurX, CurY] := SPACE;              { на старой позиции - пусто }
        CurX := CurX + dx;
        CurY := CurY + dy;
    end;

    RedrawField;                                 { перерисовываем уровень }
    { Если все камни размещены }
    if Positioned = PlaceCount then
        Application.MessageBox('Уровень пройден!', 'Sokoban', MB_ICONEXCLAMATION);

    Application.ProcessMessages;
    Busy := false;            { статус = свободно }
end;

end.