adkpathfinder.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit ADKPathFinder;

{
 PathFinder (A*) pour le projet ADK-ISO (c)2002 Paul TOTH <[e-mail]>

 http://www.web-synergy.net/naug-land/

}

{
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
interface
}

interface

uses
 Types;

type
// Interface n閏essaire au PathFinder
 IMap=Interface
  function Width :integer;
  function Height:integer;
  function CanWalk(const Pos:TPoint):boolean;
 end;

// La classe qui cherche le chemin entre deux points d'une carte
 TADKPathFinder=class
 private
  Map  :IMap;
  Step :array of array of integer;
  Dist :array of array of integer;
  Moves:array of TPoint;
  MoveCount:integer;
  CurPos  :TPoint;
  EndPoint:TPoint;
  Path    :array of integer;
  procedure Explore(const Pos:TPoint);
  function BestMove:TPoint;
  function DirectPath(Pos:TPoint):boolean;
  function OneStep(const Pos:TPoint):TPoint;
 public
  constructor Create(AMap:IMap);
  function FindPath(const ASource,ATarget:TPoint):boolean;
  function NextPoint:TPoint;
  function EndOfPath:boolean;
  function PathLen:integer;
  function PathDir(Index:integer):integer;
  property Target:TPoint read EndPoint;
 end;

implementation

// D閜lacement en X et Y suivant une des 8 directions possibles
const
 Delta:array[0..7,0..1] of integer=(
  (+0,-1),(+1,-1),(+1,+0),(+1,+1),
  (+0,+1),(-1,+1),(-1,+0),(-1,-1)
 );

// Renvoie la distance entre deux points
function Distance(const A,B:TPoint):integer;
var
 dx,dy:integer;
begin
 dx:=A.x-B.x;
 dy:=A.y-B.y;
 result:=(dx*dx)+(dy*dy);
end;

constructor TADKPathFinder.Create(AMap:IMap);
begin
 Map:=AMap;
end;

// Explore les points imm閐iatement autour (calcul des distances)
procedure TADKPathFinder.Explore(const Pos:TPoint);
var
 stp:integer;
 dir:integer;
 Test:TPoint;
begin
 stp:=Step[Pos.x,Pos.y]+1;
 for dir:=0 to 7 do begin
  Test.x:=Pos.x+Delta[dir,0]; if (Test.x<0)or(Test.x>=Map.Width) then continue;
  Test.y:=Pos.y+Delta[dir,1]; if (Test.y<0)or(Test.y>=Map.Height) then continue;
  if (Step[Test.x,Test.y]=0) and Map.CanWalk(Test) then begin
   Step[Test.x,Test.y]:=stp;
   Moves[MoveCount]:=Test;
   inc(MoveCount);
   Dist[Test.x,Test.y]:=Distance(Test,EndPoint);
  end;
 end;
end;

// Retourne le point le plus proche de la cible parmis tous les points explor閟
function TADKPathFinder.BestMove:TPoint;
var
 i,best:integer;
 Dst:integer;
 Index:integer;
begin
 Index:=0;
 with Moves[0] do best:=Dist[x,y];
 for i:=1 to MoveCount-1 do begin
  with Moves[i] do Dst:=Dist[x,y];
  if Dst<best then begin
   Index:=i;
   best:=Dst;
  end;
 end;
 Result:=Moves[Index];
 dec(MoveCount);
 Moves[Index]:=Moves[MoveCount];
end;

// Recherche un chemin entre deux points
function TADKPathFinder.FindPath(const ASource,ATarget:TPoint):boolean;
var
 Pos:TPoint;
begin
 Result:=false;
 if (ASource.X<0)or(ASource.X>=Map.Width)
  or(ASource.Y<0)or(ASource.Y>=Map.Height)
  or(ATarget.X<0)or(ATarget.X>=Map.Width)
  or(ATarget.Y<0)or(ATarget.Y>=Map.Height) then exit;
 CurPos  :=ASource;
 EndPoint:=ATarget;
 Step:=nil; // pour 阾re certain d'avoir des valeurs