Code: Select all
// написал Somebody. ICQ: 475728522 e-mail: [email protected]
// Реализация алгоритма "надёжной трассировки"
// http://pmg.org.ru/ai/stout.htm#robust_trace
const
FMoveArrMax = 300; // ставь здесь больше, если твой чар ходит на дистанции больше 13 тайлов или вокруг чара очень много препятствий. Если препятствий на пути мало, то можно оставить как есть.
var
PrognosisX, PrognosisY, FMoveArrCount : integer;
FMoveArr : array [1..FMoveArrMax] of array [1..2] of smallint;
Function Abs(A: integer): integer;
Begin
If A>=0 then result:=A
Else result:=0-A;
End;
function SetDirection(x, y : integer) : integer;
var
MyX,MyY,DiffX,DiffY,GoDir: integer;
Begin
MyX:=GetX(self);
MyY:=GetY(self);
DiffX:=Abs(MyX-x);
DiffY:=Abs(MyY-y);
if (DiffX/(DiffY+0.1))>=2 then
begin
if (MyX>X) then
GoDir:=6
else
GoDir:=2;
end
else
if (DiffY/(DiffX+0.1))>=2 then
begin
if (MyY>Y) then
GoDir:=0
else
GoDir:=4;
end
else
if (MyX>X) and (MyY>Y) then GoDir:=7
else
if (MyX>X) and (MyY<Y) then GoDir:=5
else
if (MyX<X) and (MyY>Y) then GoDir:=1
else
if (MyX<X) and (MyY<Y) then GoDir:=3;
result:=GoDir;
end;
procedure CalcPrognosis(Dir : integer);
begin
if (Dir = 1) or (Dir = 2) or (Dir = 3) then PrognosisX := GetX(self) + 1;
if (Dir = 5) or (Dir = 6) or (Dir = 7) then PrognosisX := GetX(self) - 1;
if (Dir = 0) or (Dir = 4) then PrognosisX := GetX(self);
if (Dir = 3) or (Dir = 4) or (Dir = 5) then PrognosisY := GetY(self) + 1;
if (Dir = 7) or (Dir = 0) or (Dir = 1) then PrognosisY := GetY(self) - 1;
if (Dir = 2) or (Dir = 6) then PrognosisY := GetY(self);
end;
function TryToMove(Direction : integer; RunFlag : boolean) : boolean;
begin
if GetDirection(self) <> Direction then Raw_Move(Direction, RunFlag);
result := Raw_Move(Direction, RunFlag);
end;
function WrongMove(x, y : integer) : boolean;
var
i : integer;
begin
result := false;
if FMoveArrCount = 0 then exit;
for i := 1 to FMoveArrCount do
begin
if (x = FMoveArr[i][1]) and (y = FMoveArr[i][2]) then
begin
result := true;
exit;
end;
end;
end;
function Min(x,y: integer): integer;
begin
if x>y then Result:=y else Result:=x;
end;
function HEst(x,y: integer): integer;
var dx,dy,Ddx : integer;
begin
dx:= GetX(self)-x;
dy:= GetY(self)-y;
Ddx:= dx-dy;
If dx<0 then dx:=0-dx;
If dy<0 then dy:=0-dy;
If Ddx<0 then Ddx:=0-Ddx;
Result:= min(dx,dy)+Ddx;
end;
procedure SetWrongMove(x, y : integer);
begin
FMoveArrCount := FMoveArrCount + 1;
FMoveArr[FMoveArrCount][1] := x;
FMoveArr[FMoveArrCount][2] := y;
end;
function RewindDir(Dir, c : integer) : integer;
begin
result := Dir + c;
if result < 0 then result := result + 8;
if result > 7 then result := result - 8;
end;
function Move(x, y, tolerance : integer) : boolean;
var
Dir, Dist, lastX, lastY, t, i, timeout : integer;
begin
FMoveArrCount := 0;
Dist := HEst(x, y);
timeout := Dist * 13000; // 13 секунд времени на шаг
t := timer;
while true do
begin
Dist := HEst(x, y);
if Dist <= tolerance then // пришёл
begin
result := true;
exit;
end;
if timer - t > timeout then // провал по таймауту
begin
AddToSystemJournal('Move: Time moved out!');
result := false;
exit;
end;
Dir := SetDirection(x, y);
CalcPrognosis(Dir);
if WrongMove(PrognosisX, PrognosisY) then
begin
for i := 1 to 7 do
begin
Dir := RewindDir(Dir, 1);
CalcPrognosis(Dir);
if not WrongMove(PrognosisX, PrognosisY) then break;
end;
if i = 8 then
begin
AddToSystemJournal('Move: Cannot move');
result := false;
exit;
end;
end;
timeout := timeout + CheckFlow;
lastX := GetX(self); lastY := GetY(self);
if TryToMove(Dir, false) then SetWrongMove(lastX, lastY) // отсюда чар пришёл
else SetWrongMove(PrognosisX, PrognosisY);
end;
end;
procedure _move(x, y, tolerance : integer);
begin
while not Move(x, y, tolerance) do wait(100);
end;
зачастую в буквальном смысле слова!