Закончил сокобан из 7-й главы, четвертого упражнения
This commit is contained in:
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user