//DJXPathFinder v1.0
//  Author: Dan
//  url - http://dan.mirgames.ru
//  email - dan.soft.studio@gmail.com
//
//Instructions:
//
//  Globals:
//    var
//      PathFinder: TDJXPathFinder;
//      Map: TDJXPathMap;
//      WayPoints: TDJXPathWayPoints
//
//  Initialization:
//    PathFinder := TDJXPathFinder.Create;
//    Map := PathFinder.CreateMap(VarWidth, VarHeight);
//
//  Finalization:
//    PathFinder.FreeMap(Map);
//    PathFinder.Free;
//
//  Path Finding:
//    PathFinder.FindPath(
//      Map,
//      VarStartPosX, VarStartPosY,
//      VarFinishPosX, VarFinishPosY,
//      @WayPoints
//    );
//
//  Properties:
//    TDJXPathFinder.Heuristic:
//      Heuristic calculation algorithm
//      phManhattan
//      phDiagonal
//      phDistance
//      phWave (no Heuristic)
//
//    TDJXPathFinder.HAmp:
//      An amplifier of heuristic effect
//
//    TDJXPathFinder.MoveDiag:
//      Allow the path to go through diagonally
//      located nodes.
//      Example:
//        X - wall
//        S - start
//        F - finish
//        * - waypoints
//
//        MoveDiag = true
//         __________
//        |S*        |
//        |XX*    XXX|
//        |   *   X F|
//        |    ***X* |
//        | XXXXXX*  |
//        |          |
//        |__________|
//
//        MoveDiag = false
//         __________
//        |S**       |
//        |XX*    XXX|
//        |  *    X F|
//        |***    X**|
//        |*XXXXXX** |
//        |********  |
//        |__________|
//
//    TDJXPathFinder.WallBend:
//      Works in combination with MoveDiag = true
//      Example:
//
//        MoveDiag = true and WallBend = true
//         __________
//        |S**       |
//        |XX*    XXX|
//        |  *    X F|
//        |**     X *|
//        |*XXXXXX * |
//        |********  |
//        |__________|
//
//
//    TDJXMathNode
//      Can be accessed through Map.Nodes[X, Y]
//      TDJXMathNode.Cost
//        The cost of travelling through this node,
//        the higher the cost the less likely it is
//        that the path with go through this node,
//        an exception is the cost of 0 which means
//        the node is a solid wall
//
unit DJXPathFinder;

interface

uses
  Types, Classes, Math;

type
  TDJXPathFinder = class;

  TDJXPathHeuristic = (
    phManhattan,
    phDiagonal,
    phDistance,
    phWave
  );

  PDJXPathNode = ^TDJXPathNode;
  TDJXPathNode = record
    X: DWORD;
    Y: DWORD;
    Cost: DWORD;
    H: DWORD;
    F: DWORD;
    Parent: PDJXPathNode;
    Open: boolean;
  end;

  TDJXPathWayPoint = record
    X, Y: DWORD;
  end;

  PDJXPathWayPoints = ^TDJXPathWayPoints;
  TDJXPathWayPoints = array of TDJXPathWayPoint;

  PDJXPath = ^TDJXPath;
  TDJXPath = record
    Nodes: array of PDJXPathNode;
  end;

  PDJXPathMap = ^TDJXPathMap;
  TDJXPathMap = record
    Nodes: array of array of TDJXPathNode;
    CostH: WORD;
    CostV: WORD;
    CostD: WORD;
    BaseCost: WORD;
  end;

  TDJXPathFinder = class
  private
    m_LastPath: PDJXPath;
    m_HeuristicType: TDJXPathHeuristic;
    m_HAmp: single;
    m_MoveDiag: boolean;
    m_WallBend: boolean;
  public
    property Path: PDJXPath read m_LastPath write m_LastPath;
    property Heuristic: TDJXPathHeuristic read m_HeuristicType write m_HeuristicType;
    property HAmp: single read m_HAmp write m_HAmp;
    property MoveDiag: boolean read m_MoveDiag write m_MoveDiag;
    property WallBend: boolean read m_WallBend write m_WallBend;
    constructor Create;
    destructor Destroy; override;
    function CreateMap(
      Width, Height: DWORD;
      BaseCost: WORD = 20;
      CostH: WORD = 10;
      CostV: WORD = 10;
      CostD: WORD = 14
    ): PDJXPathMap;
    procedure FreeMap(Map: PDJXPathMap);
    function FindPath(
      Map: PDJXPathMap;
      StartX, StartY,
      FinishX, FinishY: DWORD;
      WayPoints: PDJXPathWayPoints = nil
    ): PDJXPath;
  end;
  
implementation

//TDJXPathFinder BEGIN
constructor TDJXPathFinder.Create;
begin
  inherited Create;
  New(m_LastPath);
  m_HeuristicType := phManhattan;
  m_HAmp := 1;
  m_MoveDiag := true;
  m_WallBend := false;
end;
destructor TDJXPathFinder.Destroy;
begin
  SetLength(m_LastPath.Nodes, 0);
  Dispose(m_LastPath);
  inherited Destroy;
end;

function TDJXPathFinder.CreateMap(
      Width, Height: DWORD;
      BaseCost: WORD = 20;
      CostH: WORD = 10;
      CostV: WORD = 10;
      CostD: WORD = 14
    ): PDJXPathMap;
var
  i, j: integer;
begin
  New(Result);
  SetLength(Result^.Nodes, Width, Height);
  Result^.CostH := CostH;
  Result^.CostV := CostV;
  Result^.CostD := CostD;
  Result^.BaseCost := BaseCost;
  for j := 0 to Height - 1 do
  for i := 0 to Width - 1 do
  begin
    Result^.Nodes[i,j].X := i;
    Result^.Nodes[i,j].Y := j;
    Result^.Nodes[i,j].Cost := BaseCost;
    Result^.Nodes[i,j].H := 0;
    Result^.Nodes[i,j].F := 0;
    Result^.Nodes[i,j].Parent := nil;
    Result^.Nodes[i,j].Open := false;
  end;
end;
procedure TDJXPathFinder.FreeMap(Map: PDJXPathMap);
begin
  SetLength(Map^.Nodes, 0);
  Dispose(Map);
end;
function TDJXPathFinder.FindPath(
      Map: PDJXPathMap;
      StartX, StartY,
      FinishX, FinishY: DWORD;
      WayPoints: PDJXPathWayPoints = nil
    ): PDJXPath;
  function GetHeuristic(X, Y: DWORD): DWORD;
  var
    DX, DY, sMin, sMax: DWORD;
  begin
    case m_HeuristicType of
      phManhattan:
      Result := Abs(X - FinishX) * Map^.CostH + Abs(Y - FinishY) * Map^.CostV;
      phDiagonal:
      begin
        DX := Abs(X - FinishX);
        DY := Abs(Y - FinishY);
        sMin := Min(DX, DY);
        sMax := Max(DX, DY);
        if DX < DY then
        Result := sMin * Map^.CostD + (sMax - sMin) * Map^.CostV
        else
        Result := sMin * Map^.CostD + (sMax - sMin) * Map^.CostH;
      end;
      phDistance:
      begin
        DX := Abs(X - FinishX) * Map^.CostH;
        DY := Abs(Y - FinishY) * Map^.CostV;
        Result := Round(Sqrt((DX * DX) + (DY * DY)));
      end;
    end;
    if m_HAmp <> 1 then
    Result := Round(Result * m_HAmp);
  end;
var
  i, j: integer;
  CurNode: PDJXPathNode;
  TestNode: PDJXPathNode;
  MoveDir: array of TPoint;
  MoveCosts: array[0..7] of WORD;
  OpenNodes: TList;
  PathFound: boolean;
  PathLength: DWORD;
  NewCost: DWORD;
  NewPos: TPoint;
  AllowNode: boolean;
  procedure AddOpenNode(Node: PDJXPathNode);
  var
    l, h, dif, m: integer;
  begin
    l := 0;
    h := OpenNodes.Count - 1;
    while l <= h do
    begin
      m := (l + h) div 2;
      dif := PDJXPathNode(OpenNodes.Items[m])^.F - Node^.F;
      if dif < 0 then l := m + 1
      else h := m - 1;
    end;
    OpenNodes.Insert(l, Node);
    Node^.Open := true;
  end;
  procedure RemoveOpenNode(Node: PDJXPathNode);
  begin
    OpenNodes.Remove(Node);
    Node^.Open := false;
  end;
const
  DiagonalMoveDir: array [0..7] of TPoint = (
    (X: -1; Y: -1), (X: 0; Y: -1), (X: 1; Y: -1), (X: 1; Y: 0),
    (X: 1; Y: 1), (X: 0; Y: 1), (X: -1; Y: 1), (X: -1; Y: 0)
  );
  LinearMoveDir: array [0..3] of TPoint = (
    (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1), (X: -1; Y: 0)
  );
begin
  PathFound := false;
  if m_MoveDiag then
  begin
    SetLength(MoveDir, 8);
    Move(DiagonalMoveDir[0], MoveDir[0], sizeof(TPoint) * 8);
    MoveCosts[0] := Map^.CostD;
    MoveCosts[1] := Map^.CostV;
    MoveCosts[2] := Map^.CostD;
    MoveCosts[3] := Map^.CostH;
    MoveCosts[4] := Map^.CostD;
    MoveCosts[5] := Map^.CostV;
    MoveCosts[6] := Map^.CostD;
    MoveCosts[7] := Map^.CostH;
  end
  else
  begin
    SetLength(MoveDir, 4);
    Move(LinearMoveDir[0], MoveDir[0], sizeof(TPoint) * 4);
    MoveCosts[0] := Map^.CostV;
    MoveCosts[1] := Map^.CostH;
    MoveCosts[2] := Map^.CostV;
    MoveCosts[3] := Map^.CostH;
  end;
  for j := 0 to High(Map^.Nodes[0]) do
  for i := 0 to High(Map^.Nodes) do
  begin
    Map^.Nodes[i, j].H := 0;
    Map^.Nodes[i, j].F := 0;
    Map^.Nodes[i, j].Parent := nil;
    Map^.Nodes[i, j].Open := false;
  end;
  OpenNodes := TList.Create;
  AddOpenNode(@Map^.Nodes[StartX, StartY]);
  Map^.Nodes[StartX, StartY].H := GetHeuristic(StartX, StartY);
  while (OpenNodes.Count > 0) and not PathFound do
  begin
    CurNode := OpenNodes.Items[0];
    if (CurNode^.X = FinishX) and (CurNode^.Y = FinishY) then
    PathFound := true
    else
    begin
      for i := 0 to High(MoveDir) do
      begin
        NewPos.X := CurNode^.X + MoveDir[i].X;
        NewPos.Y := CurNode^.Y + MoveDir[i].Y;
        if (NewPos.X < 0) or (NewPos.X > High(Map^.Nodes))
        or (NewPos.Y < 0) or (NewPos.Y > High(Map^.Nodes[0])) then
        Continue;
        TestNode := @Map^.Nodes[NewPos.X, NewPos.Y];
        if not m_MoveDiag or not m_WallBend then
        AllowNode := true
        else
        AllowNode := (
          Odd(i)
          or
          (
            not Odd(i)
            and
            (
              (Map^.Nodes[NewPos.X, CurNode^.Y].Cost > 0)
              and
              (Map^.Nodes[CurNode^.X, NewPos.Y].Cost > 0)
            )
          )
        );
        if (TestNode^.Cost > 0) and AllowNode then
        begin
          if (m_HeuristicType <> phWave) and (TestNode^.H = 0) then
          TestNode^.H := GetHeuristic(TestNode^.X, TestNode^.Y);
          NewCost := CurNode^.F  + TestNode^.H + TestNode^.Cost + MoveCosts[i];
          if (TestNode^.F = 0) or (NewCost < TestNode^.F) then
          begin
            TestNode^.F := NewCost;
            TestNode^.Parent := CurNode;
            if not TestNode^.Open then AddOpenNode(TestNode);
          end;
        end;
      end;
    end;
    RemoveOpenNode(CurNode);
  end;
  if PathFound then
  begin
    SetLength(m_LastPath^.Nodes, Length(Map^.Nodes[0]) * Length(Map^.Nodes));
    PathLength := 0;
    while CurNode <> @Map^.Nodes[StartX, StartY] do
    begin
      m_LastPath.Nodes[high(m_LastPath^.Nodes) - PathLength] := CurNode;
      PathLength := PathLength + 1;
      CurNode := CurNode.Parent;
    end;
    if PathLength > 0 then
    move(
      m_LastPath^.Nodes[high(m_LastPath^.Nodes) - (PathLength - 1)],
      m_LastPath^.Nodes[0],
      PathLength * sizeof(PDJXPathNode)
    );
    SetLength(m_LastPath^.Nodes, PathLength);
    if WayPoints <> nil then
    begin
      SetLength(WayPoints^, PathLength);
      for i := 0 to High(m_LastPath^.Nodes) do
      Move(m_LastPath^.Nodes[i]^, WayPoints^[i], sizeof(DWORD) * 2);
    end;
  end
  else
  begin
    SetLength(m_LastPath.Nodes, 0);
    if WayPoints <> nil then
    SetLength(WayPoints^, 0);
  end;
  Result := m_LastPath;
  OpenNodes.Free;
end;
//TDJXPathFinder END

end.