Мигрирован sokoban проект с дельфи в lazarus
This commit is contained in:
271
Занимательное программирование/7/3_sokoban/Unit1.pas
Normal file
271
Занимательное программирование/7/3_sokoban/Unit1.pas
Normal file
@@ -0,0 +1,271 @@
|
||||
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; BOULDER = 1;
|
||||
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 камней }
|
||||
|
||||
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; { Текущий номер его спрайта. }
|
||||
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;
|
||||
|
||||
if PositionBy(dx, dy) = SPACE then { если целевая клетка пуста }
|
||||
begin
|
||||
Field[CurX + dx, CurY + dy] := SprIdx; { переходим в нее }
|
||||
Field[CurX, CurY] := SPACE; { на старой позиции теперь ничего нет }
|
||||
CurX := CurX + dx;
|
||||
CurY := CurY + dy;
|
||||
end
|
||||
{ если целевая клетка содержит камень, а клетка, следующая за ней, пуста }
|
||||
else if (PositionBy(dx, dy) = BOULDER) and (PositionBy(dx, dy, 2) = SPACE) then
|
||||
begin { двигаем камень: }
|
||||
Field[CurX + dx, CurY + dy] := SprIdx; { новая позиция Сокобана }
|
||||
Field[CurX + 2 * dx, CurY + 2 * dy] := BOULDER; { новая позиция камня }
|
||||
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.
|
||||
Reference in New Issue
Block a user