path.pas

RO模拟器!!适合玩仙境传说的玩家们呦~

			mm[x][y].pcnt := rh1.pcnt;
			CopyMemory(@mm[x][y].path, @rh1.path, rh1.pcnt);
			mm[x][y].addr := n + 1;
			PushHeap(rh1, aa, n);
	end;
end;
//------------------------------------------------------------------------------
function SearchPath2(var path:array of byte; tm:TMap; x1, y1, x2, y2:cardinal):byte;
var
	aa	:array[0..255] of rHeap;
	x, y:integer;
	rh	:rHeap;
	n		:byte;
	//cost:word;
	//str:string;
	i, j:integer;
begin
	ZeroMemory(@aa, sizeof(aa));
	aa[1].x := x1;
	aa[1].y := y1;
	aa[1].mx := 15;
	aa[1].my := 15;
	aa[1].cost2 := 0;
	aa[1].cost1 := 1;
	//aa[1].dir := 0;
	aa[1].pcnt := 0;
	n := 1;
	ZeroMemory(@mm, sizeof(mm));
	mm[15][15].cost := 1;
	mm[15][15].addr := 1;
	
	while (n <> 0) and ((aa[1].x <> x2) or (aa[1].y <> y2)) do begin
		rh := aa[1];
		PopHeap(aa, n);

        // AlexKreuz SearchPath v.2.0
        if (x2 > rh.x) then begin
            if (y2 > rh.y) then begin
                if CanMove (tm, rh.x, rh.y, rh.x+1, rh.y+1) then begin
                    AddPath2 (aa, n, rh, x1, y1, x2, y2, 1, 1, 7, 14);
                end else if CanMove (tm, rh.x, rh.y, rh.x, rh.y+1) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanMove (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 CanMove (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 CanMove (tm, rh.x, rh.y, rh.x, rh.y-1) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y-1) or CanMove (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 CanMove (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 CanMove (tm, rh.x, rh.y, rh.x+1, rh.y-1) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x, rh.y+1) or CanMove (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 CanMove (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 CanMove (tm, rh.x, rh.y, rh.x, rh.y+1) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y-1) or CanMove (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 CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanMove (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 CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x, rh.y+1) or CanMove (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 CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y+1) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y) or CanMove (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 CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y-1) or CanMove (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 CanMove (tm, rh.x, rh.y, rh.x-1, rh.y) or CanMove (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

        // Old Search Path calculations.
		{if CanMove(tm, rh.x, rh.y, rh.x+1, rh.y  ) then
			AddPath2(aa, n, rh, x1, y1, x2, y2,  1,  0, 6, 10);
		if CanMove(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 CanMove(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 CanMove(tm, rh.x, rh.y, rh.x  , rh.y+1) then
			AddPath2(aa, n, rh, x1, y1, x2, y2,  0,  1, 0, 10);
		if CanMove(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 CanMove(tm, rh.x, rh.y, rh.x-1, rh.y  ) then
			AddPath2(aa, n, rh, x1, y1, x2, y2, -1,  0, 2, 10);
		if CanMove(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 CanMove(tm, rh.x, rh.y, rh.x  , rh.y-1) then
			AddPath2(aa, n, rh, x1, y1, x2, y2,  0, -1, 4, 10); }
        // Old Search Path calculations.

	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;
//------------------------------------------------------------------------------
// 僸乕僾偐傜嵟彫偺梫慺傪嶍彍偡傞
procedure PopHeap(var aa:array of rHeap;var n:byte);
var
	i, j	:cardinal;
begin
	// 僸乕僾偑嬻偱側偄偙偲傪妋擣偡傞
	if n < 1 then exit;

	// 僸乕僾偺嵟彫偺梫慺傪嶍彍偡傞
	mm[aa[1].mx][aa[1].my].addr := 0;

	// 崻偐傜弶傔偰丆愡倝偑巕傪傕偭偰偄傞尷傝孞傝曉偡
	i := 1;
	while i <= (n div 2) do begin // 梩傪帩偮愡偼 1..n/2
		// 愡倝偺巕偺偆偪丄彫偝偄曽傪倞偲偡傞
		j := i * 2;
		if (j+1 <= n) and (aa[j].cost1 >= aa[j+1].cost1) then Inc(j);
		// 愡倝偵愡倞偺抣傪擖傟偰丆愡倞偵拲栚偡傞
		aa[i] := aa[j];
		mm[aa[i].mx][aa[i].my].addr := i;
		i := j;
	end;

	// 僸乕僾偺嵟屻偺梫慺傪愡i偵堏摦偡傞
	if i <> n then begin
		aa[i] := aa[n];
		mm[aa[i].mx][aa[i].my].addr := i;
		Dec(n);
		UpHeap(i, aa, n);
	end else begin
		Dec(n);
	end;
end;
{
procedure PopHeap(var aa:array of rHeap;var n:byte);
var
	i, j	:cardinal;
	val		:cardinal;
	rh		:rHeap;
begin
	// 僸乕僾偑嬻偱側偄偙偲傪妋擣偡傞
	if n < 1 then exit;

	// 僸乕僾偺嵟屻偺梫慺傪愭摢偵堏摦偡傞
	mm[aa[1].mx][aa[1].my].addr := 0;
	aa[1] := aa[n];
	Dec(n);

	// 捑傔傜傟傞梫慺偺抣傪 val 偵僙僢僩偟偰偍偔
	rh := aa[1];
	val := rh.cost1;

	// 崻偐傜弶傔偰丆愡倝偑巕傪傕偭偰偄傞尷傝孞傝曉偡
	i := 1;
	while i <= (n div 2) do begin // 梩傪帩偮愡偼 1..n/2
		// 愡倝偺巕偺偆偪丄彫偝偄曽傪倞偲偡傞
		j := i * 2;
		if (j+1 <= n) and (aa[j].cost1 >= aa[j+1].cost1) then Inc(j);
		// 傕偟丆恊偑巕傛傝戝偒偔側偄偲偄偆娭學偑惉傝棫偰偽丆
		// 偙傟埲忋捑傔傞昁梫偼側偄
		if val <= aa[j].cost1 then break;
		// 愡倝偵愡倞偺抣傪擖傟偰丆愡倞偵拲栚偡傞
		aa[i] := aa[j];
		mm[aa[i].mx][aa[i].my].addr := i;
		i := j;
	end;

	//愭摢偵偁偭偨梫慺傪愡倝偵擖傟傞
	aa[i] := rh;
	mm[aa[i].mx][aa[i].my].addr := i;
end;
}
//------------------------------------------------------------------------------
// 僸乕僾偵梫慺傪搊榐偡傞
procedure PushHeap(var d:rHeap; var aa:array of rHeap;var n:byte);
var
	i		:cardinal;
	val	:cardinal;
	rh		:rHeap;
begin
	Inc(n);
	aa[n] := d;

	// 晜偐傃忋偑傜偣傞梫慺偺抣傪 val 偵擖傟偰偍偔
	rh := aa[n];
	val := rh.cost1;
	// 梫慺偑崻傑偱晜偐傃忋偑偭偰偄側偄丆偐偮
	// 乽恊偑巕傛傝戝偒偄乿偁偄偩孞傝曉偡
	i := n;
	while (i > 1) and (aa[i div 2].cost1 > val) do begin
		// 恊偺抣傪巕偵堏偡
		aa[i] := aa[i div 2];
		mm[aa[i].mx][aa[i].my].addr := i;
		i := i div 2;
	end;

	// 嵟廔揑側棊偪拝偒愭偑寛傑偭偨
	aa[i] := rh;
	mm[aa[i].mx][aa[i].my].addr := i;
end;
//------------------------------------------------------------------------------
// 僸乕僾拞偺 x 斣栚偺梫慺傪昁梫側応強傑偱晜偐傃忋偑傜偣傞
procedure UpHeap(x:byte; var aa:array of rHeap;var n:byte);
var
	i		:cardinal;
	val	:cardinal;
	rh		:rHeap;
begin
	// 晜偐傃忋偑傜偣傞梫慺偺抣傪 val 偵擖傟偰偍偔
	rh := aa[x];
	val := rh.cost1;
	// 梫慺偑崻傑偱晜偐傃忋偑偭偰偄側偄丆偐偮
	// 乽恊偑巕傛傝戝偒偄乿偁偄偩孞傝曉偡
	i := x;
	while (i > 1) and (aa[i div 2].cost1 > val) do begin
		// 恊偺抣傪巕偵堏偡
		aa[i] := aa[i div 2];
		mm[aa[i].mx][aa[i].my].addr := i;
		i := i div 2;
	end;

	// 嵟廔揑側棊偪拝偒愭偑寛傑偭偨
	aa[i] := rh;
	mm[aa[i].mx][aa[i].my].addr := i;
end;
//==============================================================================
end.