📄 path.pas
字号:
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
end;
end else if (y2 < rh.y) then begin
if CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x, rh.y-1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y-1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y+1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
end;
end else if (y2 = rh.y) then begin
if CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y-1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y+1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
end;
end;
end else if (x2 < rh.x) then begin
if (y2 > rh.y) then begin
if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y+1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y-1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y+1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
end;
end else if (y2 < rh.y) then begin
if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y) or CanAttack (tm, rh.x, rh.y, rh.x, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
end;
end else if (y2 = rh.y) then begin
if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
end;
end;
end else if (x2 = rh.x) then begin
if (y2 > rh.y) then begin
if CanAttack (tm, rh.x, rh.y, rh.x, rh.y+1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y+1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
end;
end else if (y2 < rh.y) then begin
if CanAttack (tm, rh.x, rh.y, rh.x, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y-1) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y-1) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
end else if CanAttack (tm, rh.x, rh.y, rh.x-1, rh.y) or CanAttack (tm, rh.x, rh.y, rh.x+1, rh.y) then begin
AddPath2 (aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
end;
end;
end;
// AlexKreuz SearchPath v.2.0
{// AlexKreuz new searchpath logic -> Less Calculations = Better performance.
if (x2 > x1) then begin
if (y2 > y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y ) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
if CanAttack(tm, rh.x, rh.y, rh.x , rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
end else if (y2 < y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x , rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y ) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
end else if (y2 = y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y ) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, 0, 6, 10);
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
end;
end else if (x2 < x1) then begin
if (y2 > y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x , rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y ) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
end else if (y2 < y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y ) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
if CanAttack(tm, rh.x, rh.y, rh.x , rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
end else if (y2 = y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y ) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, 0, 2, 10);
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
end;
end else if (x2 = x1) then begin
if (y2 > y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
if CanAttack(tm, rh.x, rh.y, rh.x , rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 0, 1, 0, 10);
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y+1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, 1, 1, 14);
end else if (y2 < y1) then begin
if CanAttack(tm, rh.x, rh.y, rh.x+1, rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 1, -1, 5, 14);
if CanAttack(tm, rh.x, rh.y, rh.x-1, rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, -1, -1, 3, 14);
if CanAttack(tm, rh.x, rh.y, rh.x , rh.y-1) then
AddPath2(aa, n, rh, x1, y1, x2, y2, 0, -1, 4, 10);
end;
end;}
end;
if n = 0 then begin
Result := 0;
exit;
end;
x := aa[1].mx;
y := aa[1].my;
if mm[x][y].cost <> 0 then begin
CopyMemory(@path, @mm[x][y].path, mm[x][y].pcnt);
Result := mm[x][y].pcnt;
end else begin
Result := 0;
end;
end;
//==============================================================================
function DirMove(tm:TMap; var xy:TPoint; Dir:byte; bb:array of byte):boolean;
var
i:integer;
xy1:TPoint;
begin
Result := false;
for i := 0 to Length(bb) - 1 do begin
xy1 := xy;
case (bb[i] + Dir) mod 8 of
0: begin Inc(xy.Y); end;
1: begin Dec(xy.X);Inc(xy.Y); end;
2: begin Dec(xy.X); end;
3: begin Dec(xy.X);Dec(xy.Y); end;
4: begin Dec(xy.Y); end;
5: begin Inc(xy.X);Dec(xy.Y); end;
6: begin Inc(xy.X); end;
7: begin Inc(xy.X);Inc(xy.Y); end;
end;
if ((tm.gat[xy.X][xy.Y] = 1) or (tm.gat[xy.X][xy.Y] = 5)) then begin
xy := xy1;
exit;
end;
end;
end;
//------------------------------------------------------------------------------
function CanMove(tm:TMap; x0, y0, x1, y1:integer):boolean;
var
b1 :byte;
b2 :byte;
begin
Result := false;
if (x0 - x1 < -1) or (x0 - x1 > 1) or (y0 - y1 < -1) or (y0 - y1 > 1) then exit;
if (x1 < 0) or (y1 < 0) or (x1 >= tm.Size.X) or (y1 >= tm.Size.Y) then exit;
b1 := tm.gat[x0][y0];
if (b1 = 1) or (b1 = 5) then exit;
b2 := tm.gat[x1][y1];
if (b2 = 1) or (b2 = 5) then exit;
if (x0 = x1) or (y0 = y1) then begin
Result := true;
exit;
end;
b1 := tm.gat[x0][y1];
b2 := tm.gat[x1][y0];
if (b1 = 1) or (b1 = 5) or (b2 = 1) or (b2 = 5) then exit;
Result := true;
end;
{ Result := false;
if (x0 - x1 < -1) or (x0 - x1 > 1) or (y0 - y1 < -1) or (y0 - y1 > 1) then exit;
if (x1 < 0) or (y1 < 0) or (x1 >= tm.Size.X) or (y1 >= tm.Size.Y) then exit;
b1 := tm.gat[x0][y0];
if (b1 and 1) = 0 then exit;
b1 := tm.gat[x1][y1];
if (b1 and 1) = 0 then exit;
if (x0 = x1) or (y0 = y1) then begin
Result := true;
exit;
end;
b1 := tm.gat[x0][y1];
b2 := tm.gat[x1][y0];
if ((b1 and 1) = 0) or ((b2 and 1) = 0) then exit;
Result := true; }
//------------------------------------------------------------------------------
procedure AddPath2(var aa:array of rHeap; var n:byte; rh:rHeap; x1, y1, x2, y2, dx, dy, dir, dist:integer);
var
x, y:integer;
rh1 :rHeap;
cost:word;
begin
x := rh.mx + dx;
if (x < 0) or (x > 60) then exit;
y := rh.my + dy;
if (y < 0) or (y > 60) then exit;
cost := rh.cost2 + dist + (abs(x2 - (rh.x + dx)) + abs(y2 - (rh.y + dy))) * 10;
if mm[x][y].cost <> 0 then begin
//崱傑偱偵摨偠揰偑偁偭偨側傜cost傪斾妑偟彫偝偄側傜怴偟偄path偱偦偺揰傪嵞搊榐
if mm[x][y].cost > cost then begin
rh1.x := rh.x + dx;
rh1.y := rh.y + dy;
rh1.mx := x;
rh1.my := y;
rh1.cost2 := rh.cost2 + dist;
rh1.cost1 := cost;
//rh1.dir := dir;
CopyMemory(@rh1.path, @rh.path, rh.pcnt);
rh1.pcnt := rh.pcnt + 1;
rh1.path[rh.pcnt] := dir;
mm[x][y].cost := cost;
mm[x][y].pcnt := rh1.pcnt;
CopyMemory(@mm[x][y].path, @rh1.path, rh1.pcnt);
if mm[x][y].addr <> 0 then begin
aa[mm[x][y].addr] := rh1;
UpHeap(mm[x][y].addr, aa, n);
end else begin
mm[x][y].addr := n;
PushHeap(rh1, aa, n);
end;
end;
end else begin
//摨偠揰偑側偗傟偽偦偺揰傪搊榐
rh1.x := rh.x + dx;
rh1.y := rh.y + dy;
rh1.mx := x;
rh1.my := y;
rh1.cost2 := rh.cost2 + dist;
rh1.cost1 := cost;
//rh1.dir := dir;
CopyMemory(@rh1.path, @rh.path, rh.pcnt);
rh1.pcnt := rh.pcnt + 1;
rh1.path[rh.pcnt] := dir;
mm[x][y].cost := cost;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -