1
0

Закончил сокобан из 7-й главы, четвертого упражнения

This commit is contained in:
2026-05-15 10:34:47 +02:00
parent ee8f910cb0
commit 9064a9de55
12 changed files with 1236 additions and 2 deletions
@@ -0,0 +1,6 @@
xxxxxxxxxxx
x x
x b x
x p sbxx x
x x px
xxxxxxxxxxx
@@ -0,0 +1,9 @@
xxxxxxxxx
x x x
xx x xx
x x
x p x x
x x x
x b x x
x s x
xxxxxxxxx
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.0 KiB

@@ -0,0 +1,218 @@
unit Problems;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, States;
function GetNeighbours(AState: TState): TStates;
function Search(InitialState: TState): TStates;
{ Можно ли передвинуть камень в указанном направлении. }
function CanPush(Element, Delta: TPosition; Walls, Boulders: TPositions): Boolean;
function IsGoal(ANode: TNode): Boolean;
function AtSomePosition(Needle: TPosition; Heap: TPositions): Boolean;
{ Дистанция между двумя позициями не учитывая стен. }
function ManhattanDistance(A, B: TPosition): Integer;
function CalculateHeuristic(AState: TState): Integer;
function ReconstructPath(CameFrom: TNode): TStates;
implementation
function GetNeighbours(AState: TState): TStates;
const
{ Вниз, вверх, вправо, влево. }
Moves: array[1..4] of TPosition = (
(X: 0; Y: 1),
(X: 0; Y: -1),
(X: 1; Y: 0),
(X: -1; Y: 0)
);
var
NewState: TState;
NewPosition, Move, Boulder: TPosition;
begin
Result := TStates.Create;
for Move in Moves do
begin
NewPosition.X := AState.Agent.X + Move.X;
NewPosition.Y := AState.Agent.Y + Move.Y;
if IsFree(NewPosition, AState.Walls) then
begin
NewState := TState.Create(AState, NewPosition);
{ Если можно передвинуть камень, добавляем новую позицию камня.
Иначе, оставляем камень на месте. }
for Boulder in AState.Boulders do
if Boulder = NewPosition then
if CanPush(Boulder, Move, AState.Walls, AState.Boulders) then
NewState.AddBoulder(Boulder.X + Move.X, Boulder.Y + Move.Y)
else
begin
FreeAndNil(NewState);
break
end
else
NewState.AddBoulder(Boulder.X, Boulder.Y);
if NewState <> nil then
begin
SetLength(Result, Length(Result) + 1);
Result[High(Result)] := NewState
end
end
end
end;
function CanPush(Element, Delta: TPosition; Walls, Boulders: TPositions): Boolean;
var
NewPosition: TPosition;
begin
NewPosition.X := Element.X + Delta.X;
NewPosition.Y := Element.Y + Delta.Y;
Result := IsFree(NewPosition, Walls) and IsFree(NewPosition, Boulders)
end;
function IsGoal(ANode: TNode): Boolean;
var
CurrentPlace: TPosition;
begin
Result := true;
for CurrentPlace in ANode.State.Places do
begin
Result := AtSomePosition(CurrentPlace, ANode.State.Boulders);
if not Result then
Exit
end
end;
function Search(InitialState: TState): TStates;
var
Frontier: TPriorityQueue;
Heuristics, i: Integer;
NextState, CurrentState: TState;
NextNode, CurrentNode: TNode;
Neighbours: TStates;
Visited: TStates;
begin
Visited := TStates.Create;
Result := TStates.Create;
Frontier := TPriorityQueue.Create;
try
Heuristics := CalculateHeuristic(initialState);
{ Создаем начало графа. }
NextState := TState.Create(InitialState);
NextNode := TNode.Create(NextState, nil, 0, Heuristics);
Frontier.Add(NextNode);
while not Frontier.IsEmpty do
begin
Heuristics := Frontier.Count;
CurrentNode := Frontier.Poll;
SetLength(Visited, Length(Visited) + 1);
Visited[High(Visited)] := CurrentNode.State;
if IsGoal(CurrentNode) then
begin
Result := ReconstructPath(CurrentNode);
Exit
end;
Neighbours := GetNeighbours(CurrentNode.State);
for i := 0 to High(Neighbours) do
begin
NextState := Neighbours[i];
for CurrentState in Visited do
if CurrentState.Compare(NextState) then
begin
FreeAndNil(NextState);
break
end;
if NextState <> nil then
begin
Heuristics := CalculateHeuristic(NextState);
NextNode := TNode.Create(NextState, CurrentNode, CurrentNode.Cost + 1, Heuristics);
Frontier.Add(NextNode)
end
end
end
finally
FreeAndNil(Frontier)
end;
end;
function AtSomePosition(Needle: TPosition; Heap: TPositions): Boolean;
var
CurrentPosition: TPosition;
begin
Result := false;
for CurrentPosition in Heap do
if CurrentPosition = Needle then
begin
Result := true;
Exit
end
end;
function ManhattanDistance(A, B: TPosition): Integer;
begin
Result := Abs(A.X - B.X) + Abs(A.Y - B.Y)
end;
function CalculateHeuristic(AState: TState): Integer;
var
CurrentPlace, CurrentBoulder: TPosition;
Distance, MinimalDistance: Integer;
begin
Result := 0;
for CurrentBoulder in AState.Boulders do
begin
MinimalDistance := Integer.MaxValue;
for CurrentPlace in AState.Places do
begin
Distance := ManhattanDistance(CurrentBoulder, CurrentPlace);
if (not AtSomePosition(CurrentPlace, AState.Boulders)) and (Distance < MinimalDistance) then
MinimalDistance := Distance
end;
Inc(Result, MinimalDistance)
end
end;
function ReconstructPath(CameFrom: TNode): TStates;
var
Temporary: TState;
CurrentLength, CurrentSegment: Integer;
begin
Result := TStates.Create;
CurrentLength := 0;
while CameFrom <> nil do
begin
SetLength(Result, CurrentLength + 1);
Result[CurrentLength] := TState.Create(CameFrom.State);
CameFrom := CameFrom.Node;
Inc(CurrentLength)
end;
Dec(CurrentLength);
CurrentSegment := 0;
while CurrentSegment < CurrentLength do
begin
Temporary := Result[CurrentSegment];
Result[CurrentSegment] := Result[CurrentLength];
Result[CurrentLength] := Temporary;
Dec(CurrentLength);
Inc(CurrentSegment)
end
end;
end.
@@ -0,0 +1,93 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="solver"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</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="solver.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit>
<Unit>
<Filename Value="state.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="State"/>
</Unit>
<Unit>
<Filename Value="assets/problems.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Problems"/>
</Unit>
<Unit>
<Filename Value="assets/4.slv"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="solver"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>
@@ -0,0 +1,28 @@
program solver;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, States, Problems
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
{$PUSH}{$WARN 5044 OFF}
Application.MainFormOnTaskbar:=True;
{$POP}
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
@@ -0,0 +1,241 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="12"/>
<BuildModes Active="Default"/>
<Units>
<Unit>
<Filename Value="solver.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos Y="27"/>
<UsageCount Value="80"/>
</Unit>
<Unit>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<TopLine Value="60"/>
<CursorPos Y="73"/>
<UsageCount Value="80"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
<Unit>
<Filename Value="state.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="State"/>
<EditorIndex Value="-1"/>
<CursorPos X="8"/>
<UsageCount Value="76"/>
</Unit>
<Unit>
<Filename Value="assets/problems.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Problems"/>
<EditorIndex Value="-1"/>
<CursorPos X="14"/>
<UsageCount Value="51"/>
</Unit>
<Unit>
<Filename Value="assets/1.slv"/>
<EditorIndex Value="3"/>
<CursorPos X="8" Y="6"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
<Unit>
<Filename Value="states.pas"/>
<UnitName Value="States"/>
<EditorIndex Value="4"/>
<TopLine Value="219"/>
<CursorPos X="13" Y="168"/>
<UsageCount Value="38"/>
<Loaded Value="True"/>
</Unit>
<Unit>
<Filename Value="unit1.lfm"/>
<EditorIndex Value="-1"/>
<UsageCount Value="5"/>
<DefaultSyntaxHighlighter Value="LFM"/>
</Unit>
<Unit>
<Filename Value="assets/2.slv"/>
<EditorIndex Value="-1"/>
<CursorPos X="14" Y="9"/>
<UsageCount Value="20"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
<Unit>
<Filename Value="assets/3.slv"/>
<EditorIndex Value="-1"/>
<UsageCount Value="21"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
<Unit>
<Filename Value="../../../../opt/lazarus/fpc/3.2.2/source/rtl/objpas/fgl.pp"/>
<EditorIndex Value="1"/>
<TopLine Value="891"/>
<CursorPos X="5" Y="905"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit>
<Unit>
<Filename Value="problems.pas"/>
<UnitName Value="Problems"/>
<EditorIndex Value="2"/>
<TopLine Value="118"/>
<CursorPos X="63" Y="129"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit>
<Unit>
<Filename Value="assets/4.slv"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="5"/>
<CursorPos Y="3"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit>
</Units>
<JumpHistory HistoryIndex="29">
<Position>
<Filename Value="problems.pas"/>
<Caret Line="138" TopLine="116"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="130" Column="30" TopLine="116"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="163" Column="11" TopLine="156"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="191" Column="14" TopLine="170"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="196" Column="16" TopLine="175"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="44" Column="18" TopLine="29"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="48" Column="25" TopLine="29"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="52" Column="11" TopLine="29"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="70" Column="11" TopLine="46"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="194" Column="7" TopLine="170"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="210" Column="3" TopLine="184"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="201" Column="25" TopLine="188"/>
</Position>
<Position>
<Filename Value="states.pas"/>
<Caret Line="37" Column="22" TopLine="23"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="114" Column="11" TopLine="107"/>
</Position>
<Position>
<Filename Value="assets/1.slv"/>
<Caret Line="3" Column="12"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="42" Column="17" TopLine="35"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="55" Column="24" TopLine="35"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="68" Column="17" TopLine="59"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="13" Column="17"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="53" Column="76" TopLine="40"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="14" Column="20"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="90" Column="42" TopLine="74"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="13" Column="17"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="53" Column="21" TopLine="30"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="13" Column="45"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="56" Column="35" TopLine="29"/>
</Position>
<Position>
<Filename Value="assets/1.slv"/>
<Caret Line="10" Column="17"/>
</Position>
<Position>
<Filename Value="problems.pas"/>
<Caret Line="120" TopLine="118"/>
</Position>
<Position>
<Filename Value="assets/1.slv"/>
<Caret Line="9" Column="9"/>
</Position>
<Position>
<Filename Value="assets/1.slv"/>
<Caret Column="9"/>
</Position>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes ActiveMode=""/>
</RunParams>
<HistoryLists>
<List Name="WorkingDirectory" Type="File" Count="1"/>
<List Name="LaunchingApplication" Type="File" Count="1">
<Item1 Value="C:\WINDOWS\system32\cmd.exe /C ${TargetCmdLine}"/>
</List>
<List Name="CommandLineParameters" Count="1"/>
</HistoryLists>
</ProjectSession>
</CONFIG>
@@ -0,0 +1,277 @@
unit States;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fgl;
type
TPosition = record
X, Y: Integer
end;
TPositions = array of TPosition;
TState = class
private
PAgent: TPosition;
PWalls, PPlaces, PBoulders: TPositions;
procedure CopyArrays(AState: TState);
public
constructor Create;
constructor Create(ASTate: TState; AAgent: TPosition);
constructor Create(ASTate: TState);
property Walls: TPositions read PWalls;
property Places: TPositions read PPlaces;
property Boulders: TPositions read PBoulders;
property Agent: TPosition read PAgent write PAgent;
procedure AddWall(AX, AY: Integer);
procedure AddPlace(AX, AY: Integer);
procedure AddBoulder(AX, AY: Integer);
procedure SetAgent(AX, AY: Integer);
function Compare(AState: TState): Boolean;
end;
TStates = array of TState;
TBoard = class
private
PWidth, PHeight: Integer;
PInitialState: TState;
public
property Width: Integer read PWidth;
property Height: Integer read PHeight;
property InitialState: TState read PInitialState;
constructor Create(AWidth, AHeight: Integer; AInitialState: TState);
destructor Destroy; override;
end;
INode = interface
function GetTotalCost: Integer;
end;
TNode = class(TInterfacedObject, INode)
private
PState: TState;
PNode: TNode;
PCost, Heuristic: Integer;
public
property State: TState read PState;
property Node: TNode read PNode;
property Cost: Integer read PCost;
constructor Create(AState: TState; ANode: TNode; ACost, AHeuristic: Integer);
destructor Destroy;
function GetTotalCost: Integer;
end;
TNodes = array of TNode;
TNodeList = specialize TFPGList<TNode>;
TPriorityQueue = class
private
Nodes: TNodeList;
public
constructor Create;
procedure Add(ANode: TNode);
function Poll: TNode;
function IsEmpty: Boolean;
function Count: Integer;
end;
operator = (P1, P2: TPosition) B: Boolean;
function IsFree(NewPosition: TPosition; Walls: TPositions): Boolean;
implementation
procedure TSTate.CopyArrays(AState: TState);
begin
PWalls := Copy(AState.Walls, 0, Length(ASTate.Walls));
PPlaces := Copy(AState.Places, 0, Length(ASTate.Places))
end;
constructor TState.Create;
begin
end;
constructor TState.Create(ASTate: TState; AAgent: TPosition);
begin
PAgent := AAgent;
CopyArrays(AState);
PBoulders := TPositions.Create
end;
constructor TState.Create(ASTate: TState);
begin
PAgent := AState.Agent;
CopyArrays(AState);
PBoulders := Copy(AState.Boulders, 0, Length(AState.Boulders))
end;
procedure TState.AddWall(AX, AY: Integer);
var
CurrentLength: Integer;
begin
CurrentLength := Length(PWalls);
SetLength(PWalls, CurrentLength + 1);
PWalls[CurrentLength].X := AX;
PWalls[CurrentLength].Y := AY
end;
procedure TState.AddPlace(AX, AY: Integer);
var
CurrentLength: Integer;
begin
CurrentLength := Length(PPlaces);
SetLength(PPlaces, CurrentLength + 1);
PPlaces[CurrentLength].X := AX;
PPlaces[CurrentLength].Y := AY
end;
procedure TState.AddBoulder(AX, AY: Integer);
var
CurrentLength: Integer;
begin
CurrentLength := Length(PBoulders);
SetLength(PBoulders, CurrentLength + 1);
PBoulders[CurrentLength].X := AX;
PBoulders[CurrentLength].Y := AY
end;
procedure TState.SetAgent(AX, AY: Integer);
begin
PAgent.X := AX;
PAgent.Y := AY
end;
function TState.Compare(AState: TState): Boolean;
var
i: Integer;
begin
Result := (Agent = AState.Agent)
and (Length(Walls) = Length(AState.Walls))
and (Length(Boulders) = Length(AState.Boulders))
and (Length(Places) = Length(AState.Places));
if not Result then
Exit;
for i := 0 to High(Walls) do
if Walls[i] <> AState.Walls[i] then
begin
Result := false;
Exit
end;
for i := 0 to High(Boulders) do
if Boulders[i] <> AState.Boulders[i] then
begin
Result := false;
Exit
end;
for i := 0 to High(Places) do
if Places[i] <> AState.Places[i] then
begin
Result := false;
Exit
end
end;
constructor TBoard.Create(AWidth, AHeight: Integer; AInitialState: TState);
begin
PWidth := AWidth;
PHeight := AHeight;
PInitialState := AInitialState
end;
destructor TBoard.Destroy;
begin
PInitialState.Destroy;
inherited
end;
constructor TNode.Create(AState: TState; ANode: TNode; ACost, AHeuristic: Integer);
begin
PState := AState;
PNode := ANode;
PCost := ACost;
Heuristic := AHeuristic
end;
destructor TNode.Destroy;
begin
PState.Free;
inherited
end;
function TNode.GetTotalCost: Integer;
begin
Result := Cost + Heuristic
end;
constructor TPriorityQueue.Create;
begin
Nodes := TNodeList.Create
end;
procedure TPriorityQueue.Add(ANode: TNode);
var
Index, TotalCost: Integer;
CurrentNode: TNode;
begin
Index := 0;
TotalCost := ANode.GetTotalCost;
for CurrentNode in Nodes do
begin
if CurrentNode.getTotalCost >= TotalCost then
break;
Inc(Index)
end;
Nodes.Insert(Index, ANode)
end;
function TPriorityQueue.Poll: TNode;
begin
Result := Nodes.Extract(Nodes.First)
end;
function TPriorityQueue.IsEmpty: Boolean;
begin
Result := Count = 0
end;
function TPriorityQueue.Count: Integer;
begin
Result := Nodes.Count
end;
operator = (P1, P2: TPosition) B: Boolean;
begin
B := (P1.X = P2.X) and (P1.Y = P2.Y)
end;
function IsFree(NewPosition: TPosition; Walls: TPositions): Boolean;
var
Wall: TPosition;
begin
for Wall in Walls do
if NewPosition = Wall then
begin
Result := false;
Exit
end;
Result := true
end;
end.
@@ -0,0 +1,185 @@
object Form1: TForm1
Left = 284
Height = 771
Top = 158
Width = 695
Caption = 'Form1'
ClientHeight = 771
ClientWidth = 695
DesignTimePPI = 120
LCLVersion = '4.6.0.0'
OnCreate = FormCreate
OnDestroy = FormDestroy
object OpenLevel: TButton
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrCenter
Left = 259
Height = 40
Top = 25
Width = 176
BorderSpacing.Top = 25
Caption = 'Открыть уровень'
TabOrder = 0
OnClick = OpenLevelClick
end
object BackBuffer: TImage
AnchorSideLeft.Control = Screen
AnchorSideTop.Control = Screen
AnchorSideRight.Control = Screen
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Screen
AnchorSideBottom.Side = asrBottom
Left = 25
Height = 384
Top = 90
Width = 640
Anchors = [akTop, akLeft, akRight, akBottom]
Visible = False
end
object Screen: TImage
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = OpenLevel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 25
Height = 384
Top = 90
Width = 640
BorderSpacing.Left = 25
BorderSpacing.Top = 25
end
object MoveList: TListBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Screen
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Screen
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 25
Height = 247
Top = 499
Width = 640
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 25
BorderSpacing.Top = 25
BorderSpacing.Bottom = 25
ItemHeight = 0
TabOrder = 1
end
object OpenDialog: TOpenDialog
Left = 40
Top = 8
end
object ImageList: TImageList
Height = 32
Width = 32
Left = 552
Top = 16
Bitmap = {
4C7A120000002000000020000000FD0B00000000000078DAED5D69AC5E4519BE
585A0A29B2191590450A01B4D4564CD8A4501428A48845C2160C06221A8DA450
68841A7BCAF2035340220911454C6A950006642948C05E68590C150B365A4591
96BD589142955EB09F33F80C9D3B7766CECC39F3CE9CDEFB3EC99BF69EF9BE79
E6CCFA3EB37D7D7D0C0683C16030180C0683C16030180C46D750F5EC968BB3E7
30AAB4F8387D69A1E176217D1AAA205E7F3A9AA6A19E3B24AC791A2A67FCAE32
777F2E1D7F5DBD4BC3DF8C3B5D1AC2F8EB9EA7E40F2F6BD7F7366FFED2F99FB7
FE956E7FDDEA7FCAF4BFA5C79F2E8CBF5DF03FBAE07F75C1FF643018EFB7C0EA
FF6D4EFEEB320ACE4D710FFED70CDB149E96D78CDFF6DC96B6D2FC316918FA79
5F19D73F8B2D0BDF7B0DCE53775EB8F229A66E9B79D9678BBF26EF43CBC2FABE
81E5EECB8B21EFD0E7E6AF4BBF2DFF7DE55DD747B8F2BBAE5C43CD5A86D636E9
E70C7D3F57FEB8FEDF157E7778FBFCF7C563F62F7D55BB72AFAB9F43EB82D9DF
F9F330455EF8CA3F2ABEC0B4D9DAAFADFC43F22F24AF43FBA490F69FAADD87D6
7FBDDFADEBBF43CBDA9F67764D5315E00F2BAF747D43ECFBB7ED975C75BFCEEF
886DD3E1F5B1DEF7F0F93F756D3374ECADD3D721EF1DDD7745EA0BDFFBFB7C9D
363E709DD6F1F9A3A9F5500A7E4A0DE4F65BF2694F9E0B62FDCFFA3F9FFEF7E9
356AFD1F3E079D58FF379A836FAFFFDBAF41B4D3FF29D6609AEAFFB46B5071FA
3FF51A5CACFE4FBD0619A3FFA9D66043F53FDD1A7498FEA75A830FD5FF747B00
C2F43F55FEC7E87FAAFA17AAFFD3EF0188D3FFE9F700C4E9FFD4FD6F53FD9F66
0F4073FD9F62FC4DA3FFE3FD8F94FA3FD4FFCAA5FF437C50D6FFACFF198190FD
570EDB8CE73CFAFBFB9DFAC915C6FCF1FD8BCD3FD1396CFEAB2D2C24EEC004F6
A22CF1FBBF176768FB4AF8FEEF7F3EB28DC7F2C8B2334D7F1ECB6F8BC38CBB4B
FC75F9D286BF4DFE3BCBDFF4FB3CE5DF26FFAD6393CBF7748C3149F9EBF46F43
FEE0B1D9A1877CFC6DCA7F107F9F5F0B0D4A0345FE7BB44769FE21F590A2FC1B
F253977F8AF74FC38FF084FC43FA3F6F1AAAC6FD5F70FFEFD4E0D520FE54FDBF
75FC7169EF9CE3AF873BE5F83B68BF5584FFD5D4CFEA9AFFD7C80726F0FF53CE
5D506AA4CD59DB763EFF4BD6BFD2FA8BB8FF89EF7FFDFE3F69FF1FE0FF93E9AF
40FF9F4C7F05FAFF24FA6B18FBFFEC7F8F6CFF3F4E7FD7FBFF24E51FE1FF93CD
7F04FAFF64FA2BD0FF27D35F99E7DF46FAFC67AEF9E7CEEBAFC2EB0FC5D75F78
FDAD383FAF3F3372CE47E8FFBAC69398BF6DF16EF22D999FF90BF67B01FDBEB2
983D7441DFEB207FA5FB32A9FA7D976F047EEB19EBA0F124603DDAE31F2AFE21
3E721D7FE83ED040FEA8F7F7E870EB5ED8007E6BF93BB9ABC8FDD771FC5E9F3F
622FAE756D3E097F83FDC0C9F3BF8A3B0B95BCFE451849FB6BC09DEAFD63E763
9AB6BF8CFD2F8F7FDDF13FD8FF1C41FCA5F51783B5FE48ABEB5A9B67FEB2FC5D
D2FCE4BE4697F989FCCDA0F2F76A8D487DEFD88B3368ED2384BFA9BE37F8AD6B
6F75FC6DF47DDBF76FABEF2DFC51E5DF56DFFBB456307F0B7D9F8CBFA1BE6F9B
FF6DF57DB2F6D792BB4DFB6BA3EF9BBC7FE9FE97C7BF62FE07FB9FCCCF5ABF58
332C0EDBFEAC1093E51AF37D932FE4FBFAF8A9C613DBF72BE3734DD26FC6DFF4
FD555A5C71E969EE0ABF397E85A423B6FCBBFAFD367718A7F87ED7DABEAB8D51
9591AFAE9975B4B2F9D32DBFEF6B7FB6F4BBF8F4EFBBDA78E8F773F25799F2BF
8B7D44AE36DED5F6DFF5FE5BAF5B6DFD87D8F1BF6E0C6C3A7E878EFF39F9AB00
2ECABE9DC7FF6EB6FD2E8FFFA69F6B7B27D7F7FB1CE358E8F85B79BE5FD747A5
18FF53F2B76DA3A9FCAF9138FEF30C0883B159CEDB9D2FEC1D0C39FB65E4DD56
D8ADC630BE5F26EE4F0A5B29EC5DBCFFDB99F96F17F69AB0A3F0776EFEB9C2F6
D0FE7E3B77F91BE9617EE6677EE61FF6FC8263BCB065866D04FF0AE3F97802FE
0911B27A027B480C0683C1600C2BDD3F49D80261CF0B1B10F686B0DF420F8F26
E6FEB236E7F04F618F097B46F33B96081B4BE87F297FEF7BC2B6D2C28E12B61E
611711F15F81F81F75845F8EF0A544FC5350C6473BC2BF04FEBF15AA97E752BE
7F0DF716C21E01FFF905F86783FBCF54F5DFC37D1174C85A61FB67E41D25EC7A
BCF7CBC22666E4FEA0B0FB34EDB54746EEED843D09EE5FCBB464E4DE46ABE70B
A9FB7B0BFF4270CB79D05199B9A7817BB5B07105DAF8FDE05F63990730ED6304
FCCB22F4FFDEEC2931180C068331ACF4FF11C27E099FFB1DE8FFC785CDA2D61E
22FE399A8FF1127CD1BF6ACF7E27F70710711F069DF35F61E748CD6768E37548
C33C22FE9F22FE1F39C2E721FC3122FEA9C2BEE65ADB11CFCFA6E40F48DFCDE0
FF7E464EB91765B2B09F80FB2FC276CAC0BBA7E16FCB3670492E5D22787681EE
7D0E7D806C17BF17764A81721F2DEC2C61AF222F2E2ED82F4AFC47D8F685D2F0
3AD2309560AE45CE2FDE28ECE39ECFA8F9D12309DE4DF5F3731CE1876BEDE1A3
04FC17206EF98EA719FDFF24B47D897B89CA7614C65D855731EFFEACB60FE059
0AED6FA4E314618BC02FDBFE9B1877BF9B732E8AC16030180C46D1F98029D0C4
122767E61E079FA75788FF06F0BE989B5F701D0FCE3B85DD96935FF0EC88F917
B9E6BB73017EA5F54FC5DFD9F82527B87EA13DCBC28FBC5E8BFAB64301FE7BC0
33CD784ECE2FE2FE2A38AEB78491F24BCD0B9DF347B9065E807F56E4B1E69F25
E63F01EFE8B217D4DC1FFE3E2F733F7C5B89FE9FF9BBC1CF6030180C06836C8C
1F1BE87B7E8550FBF4B0E6E0DBFB389D887F7FF03F5728FF0F01FFF242FCC7A9
EB850AF19F0EFE3B0AF17F03FC72EEE1DBB21C84FD1BE73EE4FF2F16B63521FF
25463B93EB8D8BB106AF20F7856F47C4FF1D61AF609DFF1023EC686DFD7D41A1
F23909FC722EF24305F84761ED5FE2984279F03CF86710C4FD01ECFB18ED08DF
4A9B073E94807F35E23EC711AECEFFACD3CF6625E457E7AF5E37F75760EFC75A
845F4A38FEF66B6D5D9E7BFB8DB03F69CFA40EDF92B88ECBBD0F0FA03CE4F9BF
7FE01CCAA03D110C0683C1603086DD5CC00C610FE20CBE5C177B1A9A685C06EE
F9F0753662DFE1A39ADFBD845883A9B55FB9DE35497BBE0BD606256611716FA1
ED819D6A093F02FBD04F27E23FA8F0FC833AE37E55217E75FE429E81F8845CFF
871EDE20EF3C40BDDC91905F9D379F8F39875538072DE700DED234C18789F897
68FAFA4A5D67E03CC20A735F4462FE8710FF1FA416B5844F41F8BB14732022CE
BB10FF0F3DED53F5438711F05F8BB87FECF9CC2AAAF90711E799BEFB35A00D07
F099C904FC3B68E70B265BC2BF88B037A9EE25D0C61E39DFB7ABF67CBCB60F6D
3E611F3016ED5D9D33598C33702ADF97528E7F48C396B807E649F43BEBF1FF0B
29E65D180C0683C16014D5FC4B4BDEFF23FDDE807B8FD4FAD3EE05F2E7544AFD
13E01B4B2DFA2F8AB3AF01FCEA1EB69905B80F80E65B49B9F6E5E1BF17EF7E62
01EE83C1BDAC509F7027F8CF28C0BD27DAFB6B257487FC4923BCFB0F0AE5BD9A
6F39B600F7AEE0DE5028EF555FFB54A1BCBF0CFC3F2FC4BF00FCD7166EF797B1
67C46030180CC6889807F89CDC836DDCFF27CF7DCE143686987B9EB6F6BF18F7
51DD8E34483C4175079188F733DAF983238DB09D70F7BAC49544FC7311FF7D8E
F06F22FC6962BDB3D011AEF6E7AF20E23F46FDBE80AD9E8967D720FC860C7EAF
AC7313B11E27F77E9C8735B89729E79E70D7DD6CCCF398B8917ADE0BBF73F10C
DADFC3D86F7217F644CB75C0ABA9EE65C71D6B03E0F9ACA5FDF553DEFFA8DDBD
5639C2F741F800C51D90DA398F633D9F51FDE0E104FC6B10F7173C9F51F5F2F3
04FC6AFFC91535F92FB11B01BFBADF74BD79BE01BFC9B008E10F10D53FB9BFE4
266DFC53EDEF0ECC81F55047A8FB00B9F7EF6EEDFEBF7558FF9F4B75F688C160
30180C4671FD2FD71C6FC1FD6F03F0036E15F6E90CDC5FD7D6F857E3FCE32A4D
97CF20E49EA0FDF6E04CE3FEE70BB4BDA71F21E2BFAE46FF2F223E7FFA84DAFF
EE089F4EB926A7FDCEE37447F8BE5A3D1843C0BFACE6FDF7D2F4C75E04FC6A8F
C53D8EF06F69FC9F22E03F50BB67FC5C236C1AB4E706841F483C07D6C3799B5F
E13C400F6BB2EA0CF6BE84FDC0C9D80BF516DEF921DC3D3006FB507A25EEFFC7
7CD47BBF8B52685C98ED9B1F4C10FFA1D80336C712B6B5B0BF83FF78C2FCDD88
3A7E9CF67C1B8C87120F13E7F1D55AFD5FAE9DC153BF01B27386723E0D757E0D
CE20ACC4DD08DBF631180C4604FE071237534E
}
end
end
@@ -0,0 +1,177 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
States, Problems;
const
CELL_SIZE = 32;
type
{ TForm1 }
TForm1 = class(TForm)
BackBuffer: TImage;
ImageList: TImageList;
MoveList: TListBox;
Screen: TImage;
OpenLevel: TButton;
OpenDialog: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure OpenLevelClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
Board: TBoard; { Игровое поле. }
implementation
{$R *.lfm}
{ Загрузить уровень из файла. }
procedure LoadLevel(FileName: String);
var
f: File of Char;
i, j, ColumnCount, CurrentColumn: Integer;
c: Char;
InitialState: TState;
begin
AssignFile(f, FileName); { Открыть файл. }
Reset(f);
FreeAndNil(Board);
InitialState := TState.Create;
{ Читаем первую строку, чтобы найти количество столбцов. }
ColumnCount := 0;
repeat
Read(f, c);
if c = 'x' then
InitialState.AddWall(ColumnCount, 0);
Inc(ColumnCount)
until c <> 'x';
Dec(ColumnCount);
Read(f, c); { Считываем и пропускаем перевод строки. }
j := 1;
repeat { Цикл по строкам. }
CurrentColumn := 0;
for i := 0 to ColumnCount - 1 do { Цикл по элементам строки. }
begin
Read(f, c); { Считаем текущий эелемент }
case c of
'x':
begin
InitialState.AddWall(i, j);
Inc(CurrentColumn)
end;
's':
InitialState.SetAgent(i, j);
'p': { Если это "место". }
InitialState.AddPlace(i, j);
'b': { Если это "камень". }
InitialState.AddBoulder(i, j)
end
end;
Inc(j);
Read(f, c); { считываем и пропускаем возврат каретки }
Read(f, c) { Считываем и пропускаем перевод строки. }
until CurrentColumn = ColumnCount;
Board := TBoard.Create(ColumnCount, j, InitialState);
CloseFile(f) { закрыть файл }
end;
procedure DrawCell(APosition: TPosition; Bitmap: TBitmap);
begin
Form1.BackBuffer.Canvas.Draw(APosition.X * CELL_SIZE,
APosition.Y * CELL_SIZE,
Bitmap)
end;
procedure RedrawField;
var
Bitmap: TBitmap;
ScreenRect: TRect;
CurrentPosition: TPosition;
begin
Bitmap := TBitmap.Create; { Объект для временного хранения рисунка. }
Form1.BackBuffer.Canvas.Brush.Color := clBlack;
Form1.BackBuffer.Canvas.Clear;
{ Рисуем стены. }
Form1.ImageList.GetBitmap(8, bitmap);
for CurrentPosition in Board.InitialState.Walls do
DrawCell(CurrentPosition, bitmap);
{ Рисуем агента. }
Form1.ImageList.GetBitmap(4, bitmap);
DrawCell(Board.InitialState.Agent, Bitmap);
{ Рисуем камни. }
Form1.ImageList.GetBitmap(2, bitmap);
for CurrentPosition in Board.InitialState.Boulders do
DrawCell(CurrentPosition, bitmap);
{ Рисуем объекты. }
Form1.ImageList.GetBitmap(1, bitmap);
For CurrentPosition in Board.InitialState.Places do
DrawCell(CurrentPosition, bitmap);
Bitmap.Free;
{ Копируем содержимое виртуального экрана на основной. }
ScreenRect := Rect(0, 0, Screen.Width, Screen.Height);
Form1.Screen.Canvas.CopyRect(ScreenRect, Form1.BackBuffer.Canvas, ScreenRect)
end;
{ TForm1 }
procedure TForm1.OpenLevelClick(Sender: TObject);
var
i: Integer;
Solution: TStates;
SolutionLine: String;
begin
if OpenDialog.Execute then
begin
LoadLevel(OpenDialog.FileName);
RedrawField;
Solution := Search(Board.InitialState);
for i := 0 to High(Solution) do
begin
SolutionLine := 'Agent: (' + IntToStr(Solution[i].Agent.X)
+ ', ' + IntToStr(Solution[i].Agent.Y) + ')';
FreeAndNil(Solution[i]);
MoveList.AddItem(SolutionLine, nil)
end
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Board := nil
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(Board)
end;
end.
@@ -20,5 +20,5 @@ Lazarus.
только теоретические задания. только теоретические задания.
Седьмая глава "Простые компьютерные игры" применяет Lazarus. Изображения Седьмая глава "Простые компьютерные игры" применяет Lazarus. Изображения
для частично сделаны заново, частично скопированы из приложения книги частично сделаны заново, частично скопированы из приложения книги и
и отредактированы. отредактированы.