belka/book-exercises
1
0
Fork 0
Code Activity

Мигрирован sokoban проект с дельфи в lazarus

Browse Source
This commit is contained in:
Eugen Wissner
2026-03-19 18:45:31 +01:00
parent 4438e2e921
commit cdc4d52b08
11 changed files with 743 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
Занимательное программирование/7/3_sokoban/1.slv Normal file
View File

@@ -0,0 +1,12 @@
xxxxxxxxxxxxxxxxxxxx
x x
x x
x a x x
x x x
x s x x
x x x
x 1 xx xxxx
x ax x
x x 1 x
x x x
xxxxxxxxxxxxxxxxxxxx

12
Занимательное программирование/7/3_sokoban/2.slv Normal file
View File

@@ -0,0 +1,12 @@
xxxxxxxxxxxxxxxxxxxx
x 1 1x
x x
x a x
x a x
x a s x
x a x
x 1 x
x a x
x 1 x
x1 x
xxxxxxxxxxxxxxxxxxxx

12
Занимательное программирование/7/3_sokoban/3.slv Normal file
View File

@@ -0,0 +1,12 @@
xxxxxxxxxxxxxxxxxxxx
x1x x
x1x 1 x x
x x a x x
x x x
x x s a x x
x x x x
x x x x
x x a x x
x a x x
x x1x
xxxxxxxxxxxxxxxxxxxx

77
Занимательное программирование/7/3_sokoban/Sokoban.lpi Normal file
View File

@@ -0,0 +1,77 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="Sokoban"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="Sokoban.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="Unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

15
Занимательное программирование/7/3_sokoban/Sokoban.lpr Normal file
View File

@@ -0,0 +1,15 @@
program Sokoban;
{$MODE objfpc}{$H+}
uses
Forms, Interfaces,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

180
Занимательное программирование/7/3_sokoban/Sokoban.lps Normal file
View File

@@ -0,0 +1,180 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="12"/>
<BuildModes Active="Default"/>
<Units>
<Unit>
<Filename Value="Sokoban.lpr"/>
<IsPartOfProject Value="True"/>
<CursorPos X="20" Y="3"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
</Unit>
<Unit>
<Filename Value="Unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="57"/>
<CursorPos X="39" Y="33"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
<Unit>
<Filename Value="1.slv"/>
<EditorIndex Value="2"/>
<CursorPos X="21" Y="12"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
<Unit>
<Filename Value="3.slv"/>
<EditorIndex Value="3"/>
<CursorPos X="20" Y="11"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
<Unit>
<Filename Value="2.slv"/>
<EditorIndex Value="4"/>
<CursorPos X="5" Y="4"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
</Units>
<JumpHistory HistoryIndex="29">
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="33" Column="65" TopLine="16"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="135" Column="38" TopLine="85"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="33" Column="65" TopLine="4"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="130" Column="18" TopLine="101"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="131" Column="26" TopLine="85"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="141" Column="17" TopLine="104"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="128" Column="54" TopLine="87"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="132" Column="54" TopLine="91"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="131" Column="54" TopLine="90"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="36" Column="60" TopLine="18"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="41" Column="15" TopLine="12"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="40" Column="43"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="81" Column="24" TopLine="57"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="86" Column="34" TopLine="57"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="130" Column="59" TopLine="101"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="86" Column="50" TopLine="45"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="87" Column="16" TopLine="58"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="147" Column="42" TopLine="119"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="132" Column="40" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="149" Column="40" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="155" Column="36" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="162" Column="69" TopLine="124"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="136" Column="44" TopLine="115"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="246" Column="18" TopLine="215"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="254" Column="59" TopLine="215"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="200" Column="20" TopLine="171"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="246" Column="18" TopLine="195"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="254" Column="59" TopLine="203"/>
</Position>
<Position>
<Filename Value="Unit1.pas"/>
<Caret Line="204" Column="8" TopLine="171"/>
</Position>
<Position>
<Filename Value="1.slv"/>
<Caret Line="4" Column="5"/>
</Position>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

160
Занимательное программирование/7/3_sokoban/Unit1.lfm Normal file
View File

@@ -0,0 +1,160 @@
object Form1: TForm1
Left = 774
Height = 576
Top = 526
Width = 960
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Сокобан'
ClientHeight = 576
ClientWidth = 960
Color = clBtnFace
DesignTimePPI = 144
Font.Color = clWindowText
Font.Height = -17
Font.Name = 'MS Sans Serif'
Menu = MainMenu
LCLVersion = '4.6.0.0'
OnKeyDown = FormKeyDown
OnShow = FormShow
object Screen: TImage
Left = 0
Height = 576
Top = 0
Width = 960
Align = alClient
end
object BackBuffer: TImage
Left = 36
Height = 576
Top = 36
Width = 960
Visible = False
end
object MainMenu: TMainMenu
object FileMenu: TMenuItem
Caption = 'Файл'
object ItemOpen: TMenuItem
Caption = 'Открыть'
OnClick = ItemOpenClick
end
object ItemExit: TMenuItem
Caption = 'Выход'
OnClick = ItemExitClick
end
end
end
object ImageList: TImageList
Height = 32
Width = 32
Left = 84
Top = 12
Bitmap = {
4C7A120000002000000020000000540C00000000000078DAED5D79AC5F4515FE
416929A4C866444005A906D08A2D90B049A1205048150B84C568341291402085
420394D85B903F301521981051D0A4568D60D8A4A041FBA0153454446CA0C822
2D7BA12C852A7D409F33E59B3A6FDECCDC997BE7CCDCBE774E72D2BE3BF7CE37
EB99F3CDF6EBF57A033D5656565656565656565656565656565656D64E69E5D0
5C98030EA54A8B0FD397161A6C97A44F431584EB4F4745861D12D63C0D95337E
579DBBDF4B875FD7EED2E037C34E978630FCBAE729F1C3EBDAF5DDA68D5FBAFC
F3B6BFD2FDAF5BF6A78CFD2D3DFE7461FCED82FFD105FFAB0BFE272B2BABD2BE
BEBE8DFFBA940253A914571A94A44A832F7E5DABAADAA0B6F2C981AFDE9769B0
954D2C9ECA8BAF9E6DE9309FC5D6852D5F322D66BE7571A52DA60C54FDE97977
95A5994F332D66FB34D3E8CBB39E8E90E7BEB2E8C161A9EB1766FCB67FCDB49A
79B5958BAFEDD8B0F57277E53554F57663E299FD45D7D0F6EC6A0375EFE9F6A1
0BF8663D9975DF545DEDC365AF4CFC2678B63CDBDABFB20D66BE75FB9DA20C42
EBBF6E2C75955FE83BA6D8FA83D9FE7CEDC0AC37D778A4F73F5FFBD3ED8BAD4D
C4968B2F7D2EFC3AFB178A5F67A36D6340697C57FBD7E333DF6DDB27EAC65F13
A78D5D32FD8750BF23B44FFBD2646B8F757EB5996F57FBB0A531A49C42FC30D7
F7B6B4B5A9F73A7EA1DB485FFBAB6B3FB17EB82D3ED3378E298B26BE7F2AFC36
FCC3E59398BE2135FFF3D5873E9EB332FF67FEDF9EFFDB7CC40F9ED9E75F53D8
7DB71D899B7F6ECBFF87E6377EFEDDD747EAF2ECC38E5D7F08E917B6F123D5FA
4B13FE9F7AFD2996FFA75E7FF3F19F18FCA6EB8F75FC6B70B9D0ACBF86F27FAA
F5E770FE4FB3FE1ECAFFA9F043F93F55F987F37FDAF617C2FF29FA5F0CFFA7B0
3F31FC9FC2FEC6F07F8AF12796FF9B7DA1C9F8DB84FFDB7D9F78FFA32917B5CD
4134F1BF52F002B73F365429F8BF692BCC30E6FFCCFF878DCA32CCA19B68F9D8
D64243C2183FBC6F0FE581F6BEAF87FBC242E20E52F94D8C26CEFF863843FB57
C2FC6F7C3FB28FC7E2D4AD6FC6E2D7ADE1740DBFAE5CDAE0B7297F67FD9BBE9F
A7FEDB94BF756C72F99F8E3126297E1D076E881F3C363B38910FBF4DFD0FC2EF
F9F9D0A0345094BF877F94C61FD20E29EABF213E75FDA7C87F1A7C8427C41F62
FFBC69A81ADBBF60FBEFE4E1D520FC54F6DF3AFEB8F6DFE71C7F3DD829C7DF8D
F518E97F35F5B3BAE6FF35F28109FCFF14F30614710F17DD24CABF64FB2BCDBF
88ED4FBCFDF5FBFFA4F63FC0FF27E35F81FE3F19FF0AF4FF49F8D730F6FFD9FF
1ED9FE7F1CFFAEF7FF49EA3FC2FF279BFF08F4FFC9F857A0FF4FC6BF32CFBF8D
F4F9CF5CF3CF9DE75F85D71F8AAFBFF0FA5B717C5E7F66CD391F61DF1BD9F39E
D1F2FD6D8BF7FFBE25E3337E41BB17B1FF2AD4C6077FD741FC4AF76552D97D97
6F04FC213E4A2876C87AB4C73FEC59CEA96C68AF75F8A17B4103F1A3F2EFE1E1
D6FDB001F8D6FA7762D7E33BD31080EFF5F923F6E35AD7E693E037D8139CBCFC
63D25011B4BF0825E97F0DB053E53F763EA669FFCB687F79FCEB8EFFC1FEE708
C22FCDBF5899EB8FB4B6AEF579C62F8BDF25CE4FEE6B74199FC8DF0CAA7F2FD7
88E4F78EBD3883D63E42F09BF27B03DFBAF65687DF86DFB7CD7F5B7E6FC18FAA
FFB6FCDEC7B582F15BF0FB64F80DF97DDBF26FCBEF93F5BF96D86DFA5F1B7EDF
24FFA5ED2F8F7FC5FC0FF63F199FB97E19ED8234BDBFD576B76FCCFDCC21DFEB
E3A71A4F6CDF57C67B4DD26FC6DF34FF1BEFF0F1DCC3DB35FC21F7A404A423B6
FEBBFABD6D7F5AA8A6F8BE6B7DDFD5C7A8EAC8D7D6CC366ABD0FA8E5F7BEFE67
BDBFDC75C78EF6BDAB8F877E9F13BFCA54FE5DB411B9FA7857FB7FD7ED77AFAA
92F90FB1E37FDD18D874FC0E1DFF73E257015894B69DC7FF6EF6FD2E8FFFA69F
6BCB93EBFB9E631C0B1D7F2BCFF775362AC5F89F12BF6D1F4DE57F8DC4F1BFC7
C2C2B2C989E8D2E7097D1743CE5E1971B7117A93318CEF9509FBB342970B7D0F
F97F2733FE2D425F117A04FECE8D3F47E86EDADFEFE4AE7F233D8CCFF88CCFF8
C31E5F608C17BAD4D0F5C05F663C1F4F803F2182564F600F8985858585856558
F1FE8942E70B7D5668BFD03785FE157C783431F6D7B53987D7843E20F409CDEF
582C742CA1FFA5FCBDEF0BDD520B3B42E85A845D48847F05E2BFDF11FE3D842F
21C29F8C3A3ECA117E22F09F2AD42ECFA0CC7F0DF66642FF0CFCF30AE0CF02F6
E354EDDF837D2178C86AA17B67C41D25F43AE4FB45A1FB64C4FE90D0BB35EEB5
5B46EC6D853E04ECDFCBB464C4DE5A6BE70BA8EDBD057F01B0E53CE8A8CCD853
81BD52E8B8027DFC0FC05F65990730F56304F84B23F8FFA7D853626161616161
1956FCFF30A1BF85CFFD2EF8FF5F84CEA4E61E22FED99A8FF1027CD127B5677F
93FB0388B00F01CF795FE8E992F319DC780DD2309708FFE788FF278EF0B9087F
80087F8AD0EFB8D676C4F36F51E207A4EFD7C0BF3A23A6DC8B3249E88DC0FE97
D01D33E0EE6EF8DBB20F5C928B97089C5DC07B9F810D90FDE2EF424F2E50EFA3
857E43E8CB288B8B0BDA4529FF15BA5DA134BC8E344C21986B91F38B3708FDA4
E71D353F7A3841DE949D9FED083F54EB0F1F25C03F1F71CB3C9E6AD8FF89E8FB
52EE22AADB51187795BC8C79F7A7B57D004F53707F231D270B5D087CD9F7DFC2
B8FBDD9C73512C2C2C2C2C2C2C45E7032683134B392933F638F83C0385F0AF07
EEF3B9F105D671C0BC5DE8CD39F105CE0E987F916BBE3B17C0575CFF14FC9D0D
5F6202EB57DAB32CF828EBD5686FDB17C0BF1338538DE7E4F822EE6F03E33A4B
1829BEE4BCE0398FCA35F002F833238F35FF2231FE979047973EA7E6FEF0F7B9
99EDF0CD25EC3FE377039F858585858585856C8C1F1BE87B7E9390FB0C60CDC1
B7F7711A11FEDEC07FA650F91F04FC870BE11FABAE172A847F1AF06F2D847F16
F0E5DCC345B21E84FE07E73EE4FF2F16BA1521FE25463F93EB8D8BB006AF44EE
0BDF9608FF52A12F619DFF2023EC286DFD7D7EA1FA3901F8722EF2C305F04761
ED5FCAD185CAE059E04F27887B73ECFB18ED08DF529B073E98007F25E23EDD11
AECEFFACD1CF6625C457E7AF5E37F75760EFC76A845F4638FEF6697D5D9E7BFB
93D0C7B46792876F41DCC6E5DE877B501FF2FCDFAB388732684F040B0B0B0B0B
0BCBB09B0B982EF48F38832FD7C51E01271A97017B1E7C9DF5D87778BFE6772F
26E6606AED57AE774DD49EEF82B541293389B037D3F6C04EB1841F867DE8A711
E11F5078FE419D71FF41217C75FE429E81F88C5CFF071F5E27EF3C40BBDC8110
5F9D379F8739871538072DE700DED638C14788F0176BFCFA4A9D67E03CC23273
5F4462FC7B11FF3F2517B5844F46F87B14732022CE3B10FF8F3DFD53D9A14308
F0AF41DC3FF5BCB3826AFE41C4F935DFFD1AE086FD78671201FEF6DAF9824996
F0AF20EC2DAA7B09B4B147CEF7EDAA3D1FAFED439B476803C6A2BFAB73268B70
064E95FB12CAF10F69D802F7C03C04BBB316FFBF8062DE85858585858585A528
E75F52F2FE1FE9F706DC7BA4D69F3E51A07C4EA1E43F01BEB1E4A26F509C7D0D
C057F7B0CD2880FD3970BEE5946B5F1EFCBB90F7E30B601F08ECA5856CC2EDC0
FF6A01ECDDD1DF5F29C13BE44F1A21EFD7162A7B35DF724C01EC5D81BDAE50D9
2B5BFB8F42657F39F07F59087F3EF0AF29DCEF2F67CF8885858585856544CC03
1C29F7601BF7FFC9739F33848E21C69EABADFD2FC27D54B7200D521EA4BA8348
C4BBBF76FEE070236C47DCBD2EE54A22FC3988FF6E47F8D9087F8498EF2C7084
ABFDF9CB88F08F56BF2F606B67E2D90F117E7D06BF57B6B97DB01E27F77E9C8B
35B81729E79E70D7DD2CCCF3987203F5BC177EE7E209F4BFFBB0DFE40EEC8996
EB805751DDCB8E3BD6FA81F3054BFFEBA3BCFF51BB7BAD72847F1AE1FD147740
6AE73C8EF1BCA3ECE0A104F8AB10F7973DEFA876F945027CB5FFE48A9AF297F2
71027C75BFE95AF37C037E936121C2EF216A7F727FC9CFB4F14FF5BF5B310736
8036426D03E4DEBFDF69F7FFADC1FAFF1CAAB3472C2C2C2C2C2C2CC5F9BF5C73
FC0DEE7FEB871F7093D07D33609FA9ADF1AFC4F9C7151A2F9F4E883D41FBEDC1
19C6FDCFE76B7B4F7722C2FF510DFF5F487CFEF441B5FFDD113E8D724D4EFB9D
C7698EF03DB5763086007F694DFEF7D0F8C71E04F86A8FC59D8EF07334FCCF13
E0EFA7DD337E86113615DC731DC2F7239E031BC0799BDB701E60006BB2EA0CF6
9E8476E024EC857A1B79BE17770F8CC13E948112F7FF633E6AC3EFA2141A1766
F9E60713C47F30F680CDB6846D25F4DFC03F8EB07CD7A38D1FAB3DDF1AE3A194
FB88CBF82AADFD3FAC9DC153BF01B273867A3E156D7E15CE202CC7DD08DBF458
58585822E47F110951EA
}
end
object OpenDialog: TOpenDialog
Filter = 'Уровни Сокобана (*.slv)|*.slv'
Left = 144
Top = 12
end
end

271
Занимательное программирование/7/3_sokoban/Unit1.pas Normal file
View 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.

BIN
Занимательное программирование/7/3_sokoban/graphics--numbers.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.0 KiB

BIN
Занимательное программирование/7/3_sokoban/graphics.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.7 KiB

4
Занимательное программирование/README.txt
View File

@@ -18,3 +18,7 @@ Lazarus.
Шестая глава "Алгоритмы на графах" отсутствует, поскольку содержит
только теоретические задания.
Седьмая глава "Простые компьютерные игры" применяет Lazarus. Изображения
для частично сделаны заново, частично скопированы из приложения книги
и отредактированы.