Stealth Client Forum

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;

Code: Select all

procedure _move(1234, 1234, 0); 

Code: Select all

procedure _move(1234, 1234, 0);

Code: Select all

move(1234,1234,0)

Code: Select all

_move(1234,1234,0)

Code: Select all

_move(CoordX,CoordY,1/0)