diff options
Diffstat (limited to 'Занимательное программирование/7/3_sokoban/Unit1.pas')
| -rw-r--r-- | Занимательное программирование/7/3_sokoban/Unit1.pas | 271 |
1 files changed, 271 insertions, 0 deletions
diff --git a/Занимательное программирование/7/3_sokoban/Unit1.pas b/Занимательное программирование/7/3_sokoban/Unit1.pas new file mode 100644 index 0000000..bdb2a92 --- /dev/null +++ b/Занимательное программирование/7/3_sokoban/Unit1.pas @@ -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.
|