277 lines
10 KiB
ObjectPascal
277 lines
10 KiB
ObjectPascal
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.
|