unit
PathFinder;
interface
type
TPoint =
record
X :
longint
;
Y :
longint
;
end
;
TTile =
record
TerrType :
byte
;
Status :
byte
;
value :
real
;
gval :
real
;
hval :
real
;
fval :
real
;
Prev : TPoint;
end
;
const
ttWall =
0
;
ttType1 =
1
;
ttType2 =
2
;
ttType3 =
3
;
ttType4 =
4
;
ttType5 =
5
;
ttClear =
6
;
tsPath =
1
;
tsUnvisited =
2
;
tsBound =
3
;
tsPassed =
4
;
tsStart =
5
;
tsFinish =
6
;
MaxX =
56
;
MaxY =
56
;
Courses :
array
[
1..8
]
of
TPoint=((X:
0
;Y:-
1
),(X:
1
;Y:-
1
),(X:
1
;Y:
0
),(X:
1
;Y:
1
),
(X:
0
;Y:
1
),(X:-
1
;Y:
1
),(X:-
1
;Y:
0
),(X:-
1
;Y:-
1
));
Marks :
Set
of
byte
= [tsPath, tsBound, tsPassed];
MaxBoundSize =
500
;
type
TMap =
array
[
0..101
,
0..101
]
of
TTile;
TBound =
array
[
1..
MaxBoundSize]
of
TPoint;
function
FindPath(Src,Dst: TPoint;
var
Map: TMap):
boolean
;
function
EqualPoints(a,b:TPoint):
boolean
;
implementation
function
EqualPoints(a,b:TPoint):
boolean
;
begin
Result:=(A
.
X=B
.
X)
and
(A
.
Y=B
.
Y);
end
;
function
Point(AX , AY :
integer
): TPoint;
begin
Result
.
X:=AX;
Result
.
Y:=AY;
end
;
function
Max(x,y:
real
):
real
;
begin
if
x>y
then
Result:=x
else
Result:=y;
end
;
function
Min(x,y:
real
):
real
;
begin
if
x>y
then
Result:=y
else
Result:=x;
end
;
function
HEst(A,B: TPoint; dx2,dy2:
real
):
real
;
var
dx,dy,cross :
real
;
begin
dx:= A
.
X - B
.
X;
dy:= A
.
Y - B
.
Y;
cross:= dx*dy2 - dx2*dy;
if
( cross<
0
)
then
cross:=-cross;
Result:= max(
abs
(dx),
abs
(dy))+cross*
0.001
;
end
;
function
FindPath(Src,Dst: TPoint;
var
Map: TMap):
boolean
;
var
A : TPoint;
i,j,k :
byte
;
dx,dy :
real
;
Bound : TBound;
BSize :
integer
;
const
kk :
array
[
0..1
]
of
real
=(
1.42
,
1
);
function
FindMin:
integer
;
var
i,n:
integer
;
begin
n:=
1
;
for
i:=
1
to
BSize
do
if
Map[bound[n].X,bound[n].Y].fval>Map[bound[i].X,bound[i].Y].fval
then
n:=i;
result:=n;
end
;
procedure
AddToBound(Point:TPoint);
begin
if
BSize>=MaxBoundSize
then
exit;
BSize:=BSize+
1
;
Bound[BSize]:=Point;
end
;
begin
dx:=Src
.
X-Dst
.
X;
dy:=Src
.
Y-Dst
.
Y;
Map[Src
.
X,Src
.
Y].Status:=tsBound;
Map[Dst
.
X,Dst
.
Y].Status:=tsFinish;
BSize:=
1
;
Map[Src
.
x,Src
.
y].gval:=
0
;
Map[Src
.
x,Src
.
y].hval:=HEst(Src,Dst,dx,dy);
Map[Src
.
x,Src
.
y].fval:=Map[Src
.
x,Src
.
y].gval+Map[Src
.
x,Src
.
y].hval;
Bound[
1
]:=Src;
Result:=
False
;
while
BSize>
0
do
begin
k:=FindMin;
i:=Bound[k].x;
j:=Bound[k].y;
Map[bound[k].X,bound[k].Y].Status:=tsPassed;
bound[k]:=bound[BSize];
BSize:=BSize-
1
;
for
k:=
1
to
8
do
begin
A
.
X:=i+Courses[k].X;
A
.
Y:=j+Courses[k].Y;
if
Map[A
.
x,A
.
y].TerrType<>ttWall
then
case
Map[A
.
x,A
.
y].Status
of
tsUnvisited:
begin
Map[A
.
X,A
.
Y].gval:=Map[i,j].gval+Map[A
.
X,A
.
Y].value*kk[k
mod
2
];
Map[A
.
X,A
.
Y].fval:=Map[A
.
X,A
.
Y].gval+HEst(A,Dst,dx,dy);
Map[A
.
X,A
.
Y].Prev:=Point(i,j);
Map[A
.
X,A
.
Y].Status:=tsBound;
AddToBound(A);
end
;
tsFinish :
begin
Map[A
.
X,A
.
Y].Prev:=Point(i,j);
Map[Src
.
X,Src
.
Y].Status:=tsStart;
Result:=
True
;
exit;
end
;
end
;
end
;
end
;
Map[Src
.
X,Src
.
Y].Status:=tSStart;
end
;
end
.