sync: restore source from Google Drive

vendor/kam_remake/src/pathfinding/KM_PathFinding.pas

@@ -0,0 +1,565 @@
+unit KM_PathFinding;
+{$I KaM_Remake.inc}
+interface
+uses
+  SysUtils, Math, KromUtils,
+  KM_CommonClasses, KM_Defaults, KM_Houses, KM_Terrain, KM_Points;
+
+
+const
+  PATH_CACHE_MAX = 12; //How many paths to cache
+  PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX = 24; //Size of avoid routes cache
+  PATH_CACHE_INIT_WEIGHT = 5; //New path weight
+  PATH_CACHE_NODES_MIN_CNT = 30; //Min number of noder to put route in cache
+  // Minimum distance on the map to start using PathCache. Otherwise we could get some odd paths
+  // F.e. we want to get just to the next tile and use PFCache, because some of its routes goes through our start and dest
+  PATH_CACHE_MIN_DIST_TO_USE: Integer = 3;
+  PATH_CACHE_NO_ROUTES_AVOID_LOCKED_TTL = 100; //AvoidLockedCache item Time to live
+
+type
+  TKMPathDestination = (
+    pdLocation,     // Walk to location
+    pdPassability,  // Walk to desired passability
+    pdHouse         // Approach house from any side (workers and warriors)
+  );
+
+  TKMPathAvoidLocked = (
+    palNoAvoid,             // Don't avoid any tiles
+    palAvoidByMovementCost, // Avoid locekd tiles by increasing their movement cost
+    palAvoidAsUnwalkable    // Avoid locked tiles as mark them unwalkable (no route will be made through them)
+  );
+
+  TKMPathRouteKind = (rkRoute, rkAvoid, rkReturnToWalkable);
+
+  // This is a helper class for TKMTerrain
+  // Here should be pathfinding and all associated stuff
+  // I think we should refactor this unit and move some TKMTerrain methods here
+  TKMPathFinding = class
+  private
+    fCache: array [0 .. PATH_CACHE_MAX - 1] of record
+      Weight: Word;
+      Pass: TKMTerrainPassabilitySet;
+      Route: TKMPointList;
+    end;
+
+    fCacheAvoidLocked: array [0 .. PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX] of record
+      Pass: TKMTerrainPassabilitySet;
+      LocA: TKMPoint;
+      LocB: TKMPoint;
+      TimeToLive: Word;
+    end;
+  protected
+    fPass: TKMTerrainPassabilitySet;
+    fPassBest: TKMTerrainPassability; // Best passability, used by RouteAvoid
+    fTargetWalkConnect: TKMWalkConnect;
+    fTargetNetwork: Byte;
+    fDistance: Single;
+    fAvoidLocked: TKMPathAvoidLocked;
+    fRouteKind: TKMPathRouteKind;
+    fTargetHouse: TKMHouse;
+    procedure AddToCache(NodeList: TKMPointList);
+    function TryRouteFromCache(NodeList: TKMPointList): Boolean;
+    procedure AddNoRouteAvoidLockedToCache;
+    function CacheHasNoRouteAvoidLocked: Boolean;
+  protected
+    fLocA: TKMPoint;
+    fLocB: TKMPoint;
+    fDestination: TKMPathDestination;
+    function CanWalkTo(const aFrom: TKMPoint; bX, bY: SmallInt): Boolean; virtual;
+    function DestinationReached(aX, aY: Word): Boolean; virtual;
+    function IsWalkableTile(aX, aY: Word): Boolean; virtual;
+    function MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal; virtual;
+    function EstimateToFinish(aX, aY: Word): Cardinal; virtual;
+    function MakeRoute: Boolean; virtual; abstract;
+    procedure ReturnRoute(NodeList: TKMPointList); virtual; abstract;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    function Route_Make(const aLocA, aLocB: TKMPoint; aPass: TKMTerrainPassabilitySet; aDistance: Single;
+                        aTargetHouse: TKMHouse; NodeList: TKMPointList; aAvoidLocked: TKMPathAvoidLocked = palNoAvoid): Boolean;
+    function Route_MakeAvoid(const aLocA, aLocB: TKMPoint; aPassBest, aPassAlt: TKMTerrainPassability; aDistance: Single; aTargetHouse: TKMHouse; NodeList: TKMPointList): Boolean;
+    function Route_ReturnToWalkable(const aLocA, aLocB: TKMPoint; aTargetWalkConnect: TKMWalkConnect; aTargetNetwork: Byte;
+                                    aPass: TKMTerrainPassabilitySet; NodeList: TKMPointList): Boolean;
+
+    procedure Save(SaveStream: TKMemoryStream); virtual;
+    procedure Load(LoadStream: TKMemoryStream); virtual;
+    procedure UpdateState;
+  end;
+
+
+implementation
+uses
+  KM_Units, KM_DevPerfLog, KM_DevPerfLogTypes;
+
+
+{ TKMPathFinding }
+constructor TKMPathFinding.Create;
+var
+  I: Integer;
+begin
+  inherited;
+
+  if CACHE_PATHFINDING then
+    for I := 0 to PATH_CACHE_MAX - 1 do
+      fCache[I].Route := TKMPointList.Create;
+
+  if CACHE_PATHFINDING_AVOID_LOCKED then
+    for I := 0 to PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX - 1 do
+      fCacheAvoidLocked[I].TimeToLive := 0;
+end;
+
+
+destructor TKMPathFinding.Destroy;
+var
+  I: Integer;
+begin
+  if CACHE_PATHFINDING then
+    for I := 0 to PATH_CACHE_MAX - 1 do
+      FreeAndNil(fCache[I].Route);
+
+  inherited;
+end;
+
+
+//Find a route from A to B which meets aPass Passability
+//Results should be written as NodeCount of waypoint nodes to Nodes
+function TKMPathFinding.Route_Make(const aLocA, aLocB: TKMPoint; aPass: TKMTerrainPassabilitySet; aDistance: Single;
+                                 aTargetHouse: TKMHouse; NodeList: TKMPointList; aAvoidLocked: TKMPathAvoidLocked = palNoAvoid): Boolean;
+begin
+  {$IFDEF DBG_PERFLOG}
+  gPerfLogs.SectionEnter(psPathfinding);
+  {$ENDIF}
+  try
+    Result := False;
+
+    fRouteKind := rkRoute;
+    fLocA := aLocA;
+    fLocB := aLocB;
+    fPass := aPass;
+    fTargetNetwork := 0;
+    fTargetWalkConnect := wcWalk;
+    fDistance := aDistance;
+    fAvoidLocked := aAvoidLocked;
+    fTargetHouse := aTargetHouse;
+
+    if fTargetHouse = nil then
+      fDestination := pdLocation
+    else
+      fDestination := pdHouse;
+
+    //Check
+    if CACHE_PATHFINDING_AVOID_LOCKED
+      and (aAvoidLocked = palAvoidAsUnwalkable)
+      and CacheHasNoRouteAvoidLocked then
+    begin
+      NodeList.Clear; //No route available
+      Exit;
+    end;
+
+    //Try to find similar route in cache and reuse it
+    if CACHE_PATHFINDING
+      and (KMLengthDiag(fLocA, fLocB) - fDistance > PATH_CACHE_MIN_DIST_TO_USE) // Don't use PF_Cache for very close destinations
+      and TryRouteFromCache(NodeList) then
+      Result := True
+    else
+    if MakeRoute then
+    begin
+      ReturnRoute(NodeList);
+      Result := True;
+    end else begin
+      NodeList.Clear;
+      if CACHE_PATHFINDING_AVOID_LOCKED
+        and (aAvoidLocked = palAvoidAsUnwalkable) then
+        AddNoRouteAvoidLockedToCache;
+    end;
+  finally
+    {$IFDEF DBG_PERFLOG}
+    gPerfLogs.SectionLeave(psPathfinding);
+    {$ENDIF}
+  end;
+end;
+
+
+//We are using Interaction Avoid mode (go around busy units)
+function TKMPathFinding.Route_MakeAvoid(const aLocA, aLocB: TKMPoint; aPassBest, aPassAlt: TKMTerrainPassability; aDistance: Single; aTargetHouse: TKMHouse; NodeList: TKMPointList): Boolean;
+begin
+  {$IFDEF DBG_PERFLOG}
+  gPerfLogs.SectionEnter(psPathfinding);
+  {$ENDIF}
+  try
+    Result := False;
+
+    fRouteKind := rkAvoid;
+
+    fLocA := aLocA;
+    fLocB := aLocB;
+    fPass := [aPassBest] + [aPassAlt] - [tpNone];
+    fPassBest := aPassBest;
+    fTargetNetwork := 0;
+    fTargetWalkConnect := wcWalk;
+    fDistance := aDistance;
+    fAvoidLocked := palAvoidByMovementCost;
+    fTargetHouse := aTargetHouse;
+    if fTargetHouse = nil then
+      fDestination := pdLocation
+    else
+      fDestination := pdHouse;
+
+    if MakeRoute then
+    begin
+      ReturnRoute(NodeList);
+      Result := True;
+    end;
+  finally
+    {$IFDEF DBG_PERFLOG}
+    gPerfLogs.SectionLeave(psPathfinding);
+    {$ENDIF}
+  end;
+end;
+
+
+//Even though we are only going to a road network it is useful to know where our target is so we start off in the right direction (makes algorithm faster/work over long distances)
+function TKMPathFinding.Route_ReturnToWalkable(const aLocA, aLocB: TKMPoint; aTargetWalkConnect: TKMWalkConnect;
+                                             aTargetNetwork: Byte; aPass: TKMTerrainPassabilitySet; NodeList: TKMPointList): Boolean;
+begin
+  {$IFDEF DBG_PERFLOG}
+  gPerfLogs.SectionEnter(psPathfinding);
+  {$ENDIF}
+  try
+    Result := False;
+
+    fRouteKind := rkReturnToWalkable;
+
+    fLocA := aLocA;
+    fLocB := aLocB;
+    fPass := aPass; //Should be unused here
+    fTargetNetwork := aTargetNetwork;
+    fTargetWalkConnect := aTargetWalkConnect;
+    fDistance := 0;
+    fAvoidLocked := palNoAvoid;
+    fTargetHouse := nil;
+    fDestination := pdPassability;
+
+    if MakeRoute then
+    begin
+      ReturnRoute(NodeList);
+      Result := True;
+    end else
+      NodeList.Clear;
+  finally
+    {$IFDEF DBG_PERFLOG}
+    gPerfLogs.SectionLeave(psPathfinding);
+    {$ENDIF}
+  end;
+end;
+
+
+function TKMPathFinding.CanWalkTo(const aFrom: TKMPoint; bX, bY: SmallInt): Boolean;
+begin
+  Result := gTerrain.CanWalkDiagonally(aFrom, bX, bY);
+end;
+
+
+function TKMPathFinding.IsWalkableTile(aX, aY: Word): Boolean;
+begin
+  //If cell meets Passability then estimate it
+  Result := ((fPass * gTerrain.Land^[aY,aX].Passability) <> [])
+            and ((fAvoidLocked <> palAvoidAsUnwalkable) or not gTerrain.TileIsLocked(TKMPoint.New(aX,aY)));
+end;
+
+
+//How much it costs to move From -> To
+function TKMPathFinding.MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal;
+const
+  AVOID_ROAD_PENALTY = 25; // 2.5 tiles
+  AVOID_LOCKED_PENALTY = 200; // 20 tiles
+  AVOID_UNIT_PENALTY = 15; // 1.5 tiles
+var
+  DX, DY: Word;
+  U: TKMUnit;
+begin
+  DX := Abs(aFromX - aToX);
+  DY := Abs(aFromY - aToY);
+  if DX > DY then
+    Result := DX * 10 + DY * 4
+  else
+    Result := DY * 10 + DX * 4;
+
+  //Do not add extra cost if the tile is the target, as it can cause a longer route to be chosen
+  if (aToX <> fLocB.X) or (aToY <> fLocB.Y) then
+  begin
+    U := gTerrain.Land^[aToY,aToX].IsUnit;
+
+    // Goind offroad, when unit has to walk on road is possible to avoid locked tiles,
+    // but unit has to get bakc to the road
+    if (fRouteKind = rkAvoid) and not gTerrain.CheckPassability(aToX, aToY, fPassBest) then
+      Inc(Result, AVOID_ROAD_PENALTY);
+
+    // Avoid congested areas on roads
+    if FEAT_AVOID_UNITS_IN_PATH and (U <> nil) and ((tpWalkRoad in fPass) or U.PathfindingShouldAvoid) then
+      Inc(Result, AVOID_UNIT_PENALTY); //Unit = 1.5 extra tiles
+
+    if (fAvoidLocked = palAvoidByMovementCost) and gTerrain.TileIsLocked(TKMPoint.New(aToX,aToY)) then
+      Inc(Result, AVOID_LOCKED_PENALTY); //In interaction avoid mode, working unit (or warrior attacking house) = 20 tiles
+  end;
+end;
+
+
+function TKMPathFinding.EstimateToFinish(aX, aY: Word): Cardinal;
+var
+  DX, DY: Word;
+begin
+  //Use Estim even if destination is Passability, as it will make it faster.
+  //Target should be in the right direction even though it's not our destination.
+  DX := Abs(fLocB.X - aX);
+  DY := Abs(fLocB.Y - aY);
+  if DX > DY then
+    Result := DX * 10 + DY * 4
+  else
+    Result := DY * 10 + DX * 4;
+end;
+
+
+function TKMPathFinding.DestinationReached(aX, aY: Word): Boolean;
+begin
+  case fDestination of
+    pdLocation:    Result := KMLengthDiag(aX, aY, fLocB) <= fDistance;
+    pdPassability: Result := gTerrain.GetConnectID(fTargetWalkConnect, TKMPoint.New(aX, aY)) = fTargetNetwork;
+    pdHouse:       Result := fTargetHouse.InReach(TKMPoint.New(aX, aY), fDistance);
+    else           Result := True;
+  end;
+end;
+
+
+//Cache the route incase it is needed soon
+procedure TKMPathFinding.AddToCache(NodeList: TKMPointList);
+var
+  I: Integer;
+  Best: Integer;
+begin
+  //Find cached route with least weight and replace it
+  Best := 0;
+  for I := 1 to PATH_CACHE_MAX - 1 do
+    if fCache[I].Weight < fCache[Best].Weight then
+      Best := I;
+
+  fCache[Best].Weight := PATH_CACHE_INIT_WEIGHT;
+  fCache[Best].Pass := fPass;
+  fCache[Best].Route.Copy(NodeList);
+end;
+
+
+procedure TKMPathFinding.AddNoRouteAvoidLockedToCache;
+var
+  I: Integer;
+  Best: Integer;
+begin
+  //Find cached route with least weight and replace it
+  Best := 0;
+  for I := 1 to PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX - 1 do
+    if fCacheAvoidLocked[I].TimeToLive < fCacheAvoidLocked[Best].TimeToLive then
+      Best := I;
+
+  fCacheAvoidLocked[Best].TimeToLive := PATH_CACHE_NO_ROUTES_AVOID_LOCKED_TTL;
+  fCacheAvoidLocked[Best].Pass := fPass;
+  fCacheAvoidLocked[Best].LocA := fLocA;
+  fCacheAvoidLocked[Best].LocB := fLocB;
+end;
+
+
+function TKMPathFinding.CacheHasNoRouteAvoidLocked: Boolean;
+var
+  I: Integer;
+  Len: Single;
+  P: TKMPoint;
+begin
+  Result := False;
+
+  for I := 0 to PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX - 1 do
+    if (fCacheAvoidLocked[I].TimeToLive > 0)
+    and (fCacheAvoidLocked[I].Pass = fPass)
+    and (fCacheAvoidLocked[I].LocB = fLocB) then //Destination should be the same in cache and our path
+    begin
+      //But starting point in cache could be near our path starting point
+      P := fCacheAvoidLocked[I].LocA;
+      Len := KMLengthDiag(fLocA, P);
+      if (Len <= 1)
+      or ((Len < 2) and gTerrain.CanWalkDiagonally(fLocB, P.X, P.Y)) then // Check if we can walk diagonally
+        Exit(True);
+    end;
+end;
+
+
+function TKMPathFinding.TryRouteFromCache(NodeList: TKMPointList): Boolean;
+const
+  MIN_POINTS_TO_CHECK_START = 10;
+var
+  I,K: Integer;
+  BestStart, BestEnd: Integer;
+  NewL, BestL: Single;
+  P: TKMPoint;
+  IsWalkable: Boolean;
+begin
+  //Makes compiler happy
+  Result := False;
+
+  for I := 0 to PATH_CACHE_MAX - 1 do
+  begin
+    BestStart := -1;
+    BestEnd := -1;
+    if (fCache[I].Route.Count > 0)
+      and (fCache[I].Pass = fPass) then
+    begin
+      //Check if route goes through out position
+      //We could check almost all points
+      for K := 0 to Max(MIN_POINTS_TO_CHECK_START, fCache[I].Route.Count - 1 - PATH_CACHE_NODES_MIN_CNT) do
+      begin
+        //Restrict cache to go through our starting point,
+        //otherwise some bad-looking behaviour possible
+        //F.e. units going in a row could make side step occasionaly,
+        //cause 1st one change route
+        if KMLengthDiag(fLocA, fCache[I].Route[K]) = 0 then
+        begin
+          BestStart := K;
+          Break;
+        end;
+      end;
+
+      if BestStart = -1 then Continue;
+
+      //Check if route ends within reach
+      BestL := MaxSingle;
+      for K := fCache[I].Route.Count - 1 downto BestStart + 1 do
+      begin
+        P := fCache[I].Route[K];
+        NewL := KMLengthDiag(fLocB, P);
+        if (NewL <= 1)
+        or ((NewL < 2) and gTerrain.CanWalkDiagonally(fLocB, P.X, P.Y)) then
+        begin
+          BestEnd := K;
+          BestL := NewL;
+          if NewL = 0 then //Path goes through our Destination
+            Break;
+        end;
+      end;
+
+      if BestL >= 2 then Continue;
+
+      //Check if cached path is still walkable
+      IsWalkable := True;
+      for K := BestStart to BestEnd do
+      begin
+        P := fCache[I].Route[K];
+        if not IsWalkableTile(P.X, P.Y) then
+        begin
+          IsWalkable := False;
+          Break;
+        end;
+      end;
+
+      //If not walkable anymore, then mark it as unused
+      //and continue
+      if not IsWalkable then
+      begin
+        fCache[I].Weight := 0;
+        fCache[I].Pass := [];
+        Continue;
+      end;
+
+      //Assemble the route
+      NodeList.Clear;
+      //No need to add fLocA, since its equal to BestStart point from Cached Route
+      for K := BestStart to BestEnd do
+        NodeList.Add(fCache[I].Route[K]);
+
+      if fLocB <> fCache[I].Route[BestEnd] then //No need to duplicate fLocB
+        NodeList.Add(fLocB);
+
+      //Mark the cached route as more useful
+      //TEMP do not mark route as more usefull, force recalc route after some stime
+//      Inc(fCache[I].Weight);
+
+      Result := True;
+      Exit;
+    end;
+  end;
+end;
+
+
+procedure TKMPathFinding.Save(SaveStream: TKMemoryStream);
+var
+  I: Integer;
+begin
+  SaveStream.PlaceMarker('PathFinding');
+
+  if CACHE_PATHFINDING then
+    for I := 0 to PATH_CACHE_MAX - 1 do
+    begin
+      SaveStream.Write(fCache[I].Weight);
+      SaveStream.Write(fCache[I].Pass, SizeOf(fCache[I].Pass));
+      fCache[I].Route.SaveToStream(SaveStream);
+    end;
+
+  SaveStream.PlaceMarker('PathFinding_CacheAvoidLocked');
+  if CACHE_PATHFINDING_AVOID_LOCKED then
+    for I := 0 to PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX - 1 do
+    begin
+      SaveStream.Write(fCacheAvoidLocked[I].Pass, SizeOf(fCacheAvoidLocked[I].Pass));
+      SaveStream.Write(fCacheAvoidLocked[I].LocA, SizeOf(fCacheAvoidLocked[I].LocA));
+      SaveStream.Write(fCacheAvoidLocked[I].LocB, SizeOf(fCacheAvoidLocked[I].LocB));
+      SaveStream.Write(fCacheAvoidLocked[I].TimeToLive);
+    end;
+end;
+
+
+procedure TKMPathFinding.Load(LoadStream: TKMemoryStream);
+var
+  I: Integer;
+begin
+  LoadStream.CheckMarker('PathFinding');
+
+  if CACHE_PATHFINDING then
+    for I := 0 to PATH_CACHE_MAX - 1 do
+    begin
+      LoadStream.Read(fCache[I].Weight);
+      LoadStream.Read(fCache[I].Pass, SizeOf(fCache[I].Pass));
+      fCache[I].Route.LoadFromStream(LoadStream);
+    end;
+
+  LoadStream.CheckMarker('PathFinding_CacheAvoidLocked');
+  if CACHE_PATHFINDING_AVOID_LOCKED then
+    for I := 0 to PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX - 1 do
+    begin
+      LoadStream.Read(fCacheAvoidLocked[I].Pass, SizeOf(fCacheAvoidLocked[I].Pass));
+      LoadStream.Read(fCacheAvoidLocked[I].LocA, SizeOf(fCacheAvoidLocked[I].LocA));
+      LoadStream.Read(fCacheAvoidLocked[I].LocB, SizeOf(fCacheAvoidLocked[I].LocB));
+      LoadStream.Read(fCacheAvoidLocked[I].TimeToLive);
+    end;
+end;
+
+
+procedure TKMPathFinding.UpdateState;
+var
+  I: Integer;
+begin
+  {$IFDEF DBG_PERFLOG}
+  gPerfLogs.SectionEnter(psPathfinding);
+  {$ENDIF}
+  try
+    if CACHE_PATHFINDING then
+      for I := 0 to PATH_CACHE_MAX - 1 do
+        fCache[I].Weight := Max(fCache[I].Weight - 1, 0);
+
+    if CACHE_PATHFINDING_AVOID_LOCKED then
+      for I := 0 to PATH_CACHE_NO_ROUTES_AVOID_LOCKED_MAX - 1 do
+        fCacheAvoidLocked[I].TimeToLive := Max(fCacheAvoidLocked[I].TimeToLive - 1, 0);
+  finally
+    {$IFDEF DBG_PERFLOG}
+    gPerfLogs.SectionLeave(psPathfinding);
+    {$ENDIF}
+  end;
+end;
+
+
+end.

vendor/kam_remake/src/pathfinding/KM_PathFindingAStarNew.pas

@@ -0,0 +1,197 @@
+unit KM_PathFindingAStarNew;
+{$I KaM_Remake.inc}
+interface
+uses
+  SysUtils, Math, KM_PathFinding,
+  KM_CommonClasses, KM_Defaults, KM_Terrain, KM_Points, BinaryHeap;
+
+
+type
+  PANodeRec = ^TANodeRec; // Delphi allows forward declaration for record pointers
+  TANodeRec = record
+    RouteID: Cardinal;
+    X,Y: SmallInt;
+    CostTo: Cardinal;
+    Estim: Cardinal;
+    Parent: PANodeRec;
+  end;
+
+  // This is a helper class for TKMTerrain
+  // Here should be pathfinding and all associated stuff
+  // I think we should refactor this unit and move some TKMTerrain methods here
+  TKMPathFindingAStarNew = class(TKMPathFinding)
+  private
+    fHeap: TBinaryHeap;
+    fMinN: PANodeRec;
+    fOpenRef: array [0..MAX_MAP_SIZE, 0..MAX_MAP_SIZE] of TANodeRec; //References to OpenList, Sized as map
+    fRouteID: Cardinal;
+    function HeapCmp(A,B: Pointer): Boolean;
+  protected
+    function GetNodeAt(X,Y: SmallInt): PANodeRec;
+    function MakeRoute: Boolean; override;
+    procedure ReturnRoute(NodeList: TKMPointList); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
+implementation
+
+
+{ TKMPathFindingAStarNew }
+constructor TKMPathFindingAStarNew.Create;
+var
+  X, Y: Integer;
+begin
+  inherited;
+
+  fHeap := TBinaryHeap.Create(High(Word));
+  fHeap.Cmp := HeapCmp;
+
+  for Y := 0 to MAX_MAP_SIZE do
+    for X := 0 to MAX_MAP_SIZE do
+    begin
+      fOpenRef[Y, X].X := X;
+      fOpenRef[Y, X].Y := Y;
+    end;
+end;
+
+
+destructor TKMPathFindingAStarNew.Destroy;
+begin
+  fHeap.Free;
+
+  inherited;
+end;
+
+
+function TKMPathFindingAStarNew.GetNodeAt(X, Y: SmallInt): PANodeRec;
+begin
+  Result := @fOpenRef[Y, X];
+  if Result.RouteID <> fRouteID then
+    Result := nil;
+end;
+
+
+function TKMPathFindingAStarNew.HeapCmp(A, B: Pointer): Boolean;
+begin
+  Result := (A = nil) or (B = nil) or (PANodeRec(A).Estim + PANodeRec(A).CostTo < PANodeRec(B).Estim + PANodeRec(B).CostTo);
+end;
+
+
+function TKMPathFindingAStarNew.MakeRoute: Boolean;
+const
+  C_CLOSED = High(Cardinal);
+var
+  N: PANodeRec;
+  X, Y: Word;
+  newCost: Cardinal;
+begin
+  // Do not build the route in case destination is not walkable
+  if not IsWalkableTile(fLocA.X, fLocA.Y) then Exit(False);
+
+  //Use a unique RouteID each run to track whether nodes are valid
+  //Before it overflows we need to reset, which is still very fast (<1ms)
+  //and only needs doing once every 4.2 billion paths
+  if fRouteID = High(fRouteID) then
+  begin
+    fRouteID := 0;
+    for Y := 0 to MAX_MAP_SIZE do
+      for X := 0 to MAX_MAP_SIZE do
+        fOpenRef[Y, X].RouteID := 0;
+  end;
+  Inc(fRouteID);
+
+  //Initialize first element
+  N := @fOpenRef[fLocA.Y, fLocA.X];
+  N.RouteID := fRouteID;
+  N.CostTo := 0;
+  N.Estim := EstimateToFinish(fLocA.X, fLocA.Y);
+  N.Parent := nil;
+
+  //Seed
+  fMinN := N;
+
+  while (fMinN <> nil) and not DestinationReached(fMinN.X, fMinN.Y) do
+  begin
+    fMinN.Estim := C_CLOSED;
+
+    //Check all surrounding cells and issue costs to them
+    for Y := Max(fMinN.Y-1,1) to Min(fMinN.Y+1, gTerrain.MapY-1) do
+    for X := Max(fMinN.X-1,1) to Min(fMinN.X+1, gTerrain.MapX-1) do
+    begin
+      N := @fOpenRef[Y,X];
+      if N.RouteID <> fRouteID then //Cell is new
+      begin
+        if CanWalkTo(TKMPoint.New(fMinN.X, fMinN.Y), X, Y) then
+        begin
+          N.RouteID := fRouteID;
+          N.Parent := fMinN;
+
+          if IsWalkableTile(X, Y) then
+          begin
+            N.CostTo := fMinN.CostTo + MovementCost(fMinN.X, fMinN.Y, X, Y);
+            N.Estim := EstimateToFinish(X,Y);
+            fHeap.Push(N);
+          end
+          else //If cell doesn't meets Passability then mark it as Closed
+            N.Estim := C_CLOSED;
+        end;
+      end
+      else //Else cell is old
+      begin
+        //Node N is valid. If route through new cell is shorter than previous
+        if N.Estim <> C_CLOSED then
+        if CanWalkTo(TKMPoint.New(fMinN.X, fMinN.Y), X, Y) then
+        begin
+          newCost := MovementCost(fMinN.X, fMinN.Y, X, Y);
+          if fMinN.CostTo + newCost < N.CostTo then
+          begin
+            N.Parent := fMinN;
+            N.CostTo := fMinN.CostTo + newCost;
+            //todo -cPractical: Cost has changed and the location in the queue needs to change too
+            //fHeap.UpdateItem(N);
+          end;
+        end;
+      end;
+    end;
+
+    //Find next cell with least (Estim+CostTo)
+    if fHeap.IsEmpty then
+      Break;
+
+    fMinN := fHeap.Pop;
+  end;
+
+  //Route found, no longer need the lookups
+  fHeap.Clear;
+
+  Result := DestinationReached(fMinN.X, fMinN.Y);
+end;
+
+
+procedure TKMPathFindingAStarNew.ReturnRoute(NodeList: TKMPointList);
+var
+  N: PANodeRec;
+begin
+  NodeList.Clear;
+
+  //Assemble the route
+  N := fMinN;
+  while N <> nil do
+  begin
+    NodeList.Add(TKMPoint.New(N.X, N.Y));
+    N := N.Parent;
+  end;
+
+  //Reverse the list, since path is assembled LocB > LocA
+  NodeList.Inverse;
+
+  //Cache long paths
+  if CACHE_PATHFINDING and (NodeList.Count > PATH_CACHE_NODES_MIN_CNT) then
+    AddToCache(NodeList);
+end;
+
+
+end.

vendor/kam_remake/src/pathfinding/KM_PathFindingAStarOld.pas

@@ -0,0 +1,149 @@
+unit KM_PathFindingAStarOld;
+{$I KaM_Remake.inc}
+interface
+uses
+  SysUtils, Math, KM_PathFinding,
+  KM_CommonClasses, KM_Defaults, KM_Terrain, KM_Points;
+
+
+type
+  // This is a helper class for TKMTerrain
+  // Here should be pathfinding and all associated stuff
+  // I think we should refactor this unit and move some TKMTerrain methods here
+  TKMPathFindingAStarOld = class(TKMPathFinding)
+  private
+    fNewCost: Integer;
+    fMinCost: record
+      Cost: Integer;
+      ID: Word;
+      Pos: TKMPoint;
+    end;
+    ORef: array of array of Word; //References to OpenList, Sized as map
+    OCount: Word;
+    OList: array of record //List of checked cells
+      Pos: TKMPoint;
+      CostTo: Word;
+      Estim: Word;
+      Parent: Word;//Reference to parent
+    end;
+  protected
+    function MakeRoute: Boolean; override;
+    procedure ReturnRoute(NodeList: TKMPointList); override;
+  end;
+
+
+implementation
+
+
+{ TKMPathFindingAStarOld }
+function TKMPathFindingAStarOld.MakeRoute: Boolean;
+const
+  C_CLOSED = 65535;
+var
+  I, X, Y: Integer;
+begin
+  //Erase previous values
+  SetLength(ORef, 0);
+  SetLength(ORef, gTerrain.MapY+1, gTerrain.MapX+1);
+
+  //Initialize first element
+  OCount := 1;
+  ORef[fLocA.Y, fLocA.X] := OCount;
+  SetLength(OList, OCount + 1);
+  OList[OCount].Pos     := fLocA;
+  OList[OCount].CostTo  := 0;
+  OList[OCount].Estim   := (abs(fLocB.X-fLocA.X) + abs(fLocB.Y-fLocA.Y)) * 10;
+  OList[OCount].Parent  := 0;
+
+  //Seed
+  fMinCost.Cost := 0;
+  fMinCost.ID := 1;
+  fMinCost.Pos := fLocA;
+
+  while not DestinationReached(fMinCost.Pos.X, fMinCost.Pos.Y) and (fMinCost.Cost <> 65535) do
+  begin
+
+    OList[fMinCost.ID].Estim := C_CLOSED;
+
+    //Check all surrounding cells and issue costs to them
+    for y := Math.max(fMinCost.Pos.Y-1,1) to Math.min(fMinCost.Pos.Y+1, gTerrain.MapY-1) do
+    for x := Math.max(fMinCost.Pos.X-1,1) to Math.min(fMinCost.Pos.X+1, gTerrain.MapX-1) do
+    if ORef[y,x] = 0 then //Cell is new
+    begin
+      if CanWalkTo(fMinCost.Pos, x, y) then
+      begin
+        inc(OCount);
+        if OCount >= Length(OList) then
+          SetLength(OList, OCount + 128); //Allocate slightly more space
+
+        OList[OCount].Pos := TKMPoint.New(x,y);
+
+        if IsWalkableTile(X, Y) then
+        begin
+          ORef[y,x] := OCount;
+          OList[OCount].Parent := ORef[fMinCost.Pos.Y, fMinCost.Pos.X];
+          OList[OCount].CostTo := OList[OList[OCount].Parent].CostTo + MovementCost(fMinCost.Pos.X, fMinCost.Pos.Y, X, Y);
+          OList[OCount].Estim := (abs(x-fLocB.X) + abs(y-fLocB.Y)) * 10; //Use Estim even if destination is Passability, as it will make it faster. Target should be in the right direction even though it's not our destination.
+        end
+        else //If cell doen't meets Passability then mark it as Closed
+          OList[OCount].Estim := C_CLOSED;
+      end;
+
+    end
+    else //Else cell is old
+    begin
+
+      //If route through new cell is shorter than ORef[y,x] then
+      if OList[ORef[y,x]].Estim <> C_CLOSED then
+      if CanWalkTo(fMinCost.Pos, x, y) then
+      begin
+        fNewCost := MovementCost(fMinCost.Pos.X, fMinCost.Pos.Y, X, Y);
+        if OList[fMinCost.ID].CostTo + fNewCost < OList[ORef[y,x]].CostTo then
+        begin
+          OList[ORef[y,x]].Parent := ORef[fMinCost.Pos.Y,fMinCost.Pos.X];
+          OList[ORef[y,x]].CostTo := OList[fMinCost.ID].CostTo + fNewCost;
+          //OList[ORef[y,x]].Estim:=(abs(x-fLocB.X) + abs(y-fLocB.Y))*10;
+        end;
+      end;
+    end;
+
+    //Find next cell with least (Estim+CostTo)
+    fMinCost.Cost := 65535;
+    for i := OCount downto 1 do //'downto' works faster here
+      if OList[i].Estim <> C_CLOSED then
+        if (OList[i].Estim + OList[i].CostTo) < fMinCost.Cost then
+        begin
+          fMinCost.Cost := OList[i].Estim + OList[i].CostTo;
+          fMinCost.ID := i;
+          fMinCost.Pos := OList[i].Pos;
+        end;
+  end;
+
+  Result := DestinationReached(fMinCost.Pos.X, fMinCost.Pos.Y);
+  //Assert(fMinCost.Cost<>65535, 'FloodFill test failed and there''s no possible route A-B');
+end;
+
+
+procedure TKMPathFindingAStarOld.ReturnRoute(NodeList: TKMPointList);
+var
+  I: Integer;
+begin
+  NodeList.Clear;
+
+  //Assemble the route
+  I := fMinCost.ID;
+  repeat
+    NodeList.Add(OList[I].Pos);
+    I := OList[I].Parent;
+  until I = 0;
+
+  //Reverse the list, since path is assembled LocB > LocA
+  NodeList.Inverse;
+
+  //Cache long paths
+  if CACHE_PATHFINDING and (NodeList.Count > 20) then
+    AddToCache(NodeList);
+end;
+
+
+end.

vendor/kam_remake/src/pathfinding/KM_PathFindingJPS.pas

@@ -0,0 +1,414 @@
+unit KM_PathFindingJPS;
+{$I KaM_Remake.inc}
+interface
+uses
+  Types, Math, SysUtils, KM_PathFinding, BinaryHeap, KM_Points, KM_CommonClasses, KM_Terrain;
+
+
+type
+  TJPSPoint = class
+    x,y: Word;
+    Estim: Word; //Estimated distance to End
+    g, f: Single; //G - CostTo, F - CostTo + Estim
+    opened, closed: Boolean;
+    parent: TJPSPoint;
+  end;
+
+  TPointArray = array of TPoint;
+
+  // Jump-Point-Search pathfinder
+  // based on JavaScript implementation by aniero / https://github.com/aniero
+  TKMPathFindingJPS = class(TKMPathFinding)
+  private
+    Nodes: array of array of TJPSPoint;
+    startNode, endNode: TJPSPoint;
+    openList: TBinaryHeap;
+
+    function HeapCmp(A,B: Pointer): Boolean;
+    procedure Reset;
+    function getNodeAt(x, y: SmallInt): TJPSPoint;
+    procedure identifySuccessors(node: TJPSPoint);
+    function findNeighbors(const node: TJPSPoint): TPointArray;
+    function jump(x, y, px, py: SmallInt): TPoint;
+  protected
+    function IsWalkableTile(aX, aY: SmallInt): Boolean; reintroduce;
+    function MakeRoute: Boolean; override;
+    procedure ReturnRoute(NodeList: TKMPointList); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
+implementation
+
+
+{ TKMPathFindingJPS }
+constructor TKMPathFindingJPS.Create;
+begin
+  inherited;
+
+  openList := TBinaryHeap.Create(High(Word));
+  openList.Cmp := HeapCmp;
+end;
+
+
+destructor TKMPathFindingJPS.Destroy;
+begin
+  openList.Free;
+
+  inherited;
+end;
+
+
+function TKMPathFindingJPS.HeapCmp(A, B: Pointer): Boolean;
+begin
+  if A = nil then
+    Result := True
+  else
+    Result := (B = nil) or (TJPSPoint(A).f < TJPSPoint(B).f);
+end;
+
+
+procedure TKMPathFindingJPS.Reset;
+var
+  I, K: Integer;
+begin
+  openList.Clear;
+
+  for I := 0 to High(Nodes) do
+    for K := 0 to High(Nodes[I]) do
+      FreeAndNil(Nodes[I,K]);
+end;
+
+
+function TKMPathFindingJPS.getNodeAt(x, y: SmallInt): TJPSPoint;
+begin
+  if Nodes[y,x] = nil then
+  begin
+    Nodes[y,x] := TJPSPoint.Create;
+    Nodes[y,x].x := x;
+    Nodes[y,x].y := y;
+  end;
+
+  Result := Nodes[y,x];
+end;
+
+
+//Find and return the the path.
+function TKMPathFindingJPS.MakeRoute: Boolean;
+var
+  node: TJPSPoint;
+begin
+  SetLength(Nodes, gTerrain.MapY+1, gTerrain.MapX+1);
+
+  startNode := getNodeAt(fLocA.X, fLocA.Y);
+  endNode := getNodeAt(fLocB.X, fLocB.Y);
+
+  // set the `g` and `f` value of the start node to be 0
+  startNode.g := 0;
+  startNode.f := 0;
+
+  openList.Push(startNode);
+  startNode.opened := True;
+
+  while not openList.IsEmpty do
+  begin
+    // pop the position of node which has the minimum `f` value.
+    node := openList.Pop;
+    node.closed := True;
+
+    if node = endNode then
+    begin
+      Result := True;
+      Exit;
+    end;
+
+    identifySuccessors(node);
+  end;
+
+  // fail to find the path
+  Reset;
+  Result := False;
+end;
+
+
+procedure TKMPathFindingJPS.ReturnRoute(NodeList: TKMPointList);
+var
+  node: TJPSPoint;
+begin
+  NodeList.Clear;
+
+  node := endNode;
+
+  while node <> nil do
+  begin
+    NodeList.Add(TKMPoint.New(node.X, node.Y));
+    node := node.parent;
+  end;
+
+  //Reverse the array
+  NodeList.Inverse;
+  NodeList.SparseToDense;
+
+  Reset;
+end;
+
+
+{**
+ * Identify successors for the given node. Runs a jump point search in the
+ * direction of each available neighbor, adding any points found to the open
+ * list.
+ * @protected
+ *}
+procedure TKMPathFindingJPS.identifySuccessors(node: TJPSPoint);
+var
+  I: Integer;
+  endX, endY: SmallInt;
+  x, y, jx, jy: SmallInt;
+  neighbors: TPointArray;
+  neighbor, jumpPoint: TPoint;
+  jumpNode: TJPSPoint;
+  d, ng: Single;
+begin
+    endX := endNode.X;
+    endY := endNode.Y;
+    x := node.X;
+    y := node.Y;
+
+    neighbors := findNeighbors(node);
+    for I := 0 to High(neighbors) do
+    begin
+        neighbor := neighbors[i];
+        jumpPoint := jump(neighbor.X, neighbor.Y, x, y);
+        if (jumpPoint.X <> -1) then
+        begin
+
+            jx := jumpPoint.X;
+            jy := jumpPoint.Y;
+            jumpNode := getNodeAt(jx, jy);
+
+            if (jumpNode.closed) then
+                Continue;
+
+            // include distance, as parent may not be immediately adjacent:
+            d := Sqrt(Sqr(jx - x) + Sqr(jy - y));
+            ng := node.g + d; // next `g` value
+
+            if (not jumpNode.opened) or (ng < jumpNode.g) then
+            begin
+                jumpNode.g := ng;
+                if jumpNode.Estim = 0 then
+                  jumpNode.Estim := (Abs(jx - endX) + Abs(jy - endY));
+                jumpNode.f := jumpNode.g + jumpNode.Estim;
+                jumpNode.parent := node;
+
+                if not jumpNode.opened then
+                begin
+                    openList.Push(jumpNode);
+                    jumpNode.opened := True;
+                end
+                else
+                begin
+                    openList.UpdateItem(jumpNode);
+                end;
+            end;
+        end;
+    end;
+end;
+
+
+function TKMPathFindingJPS.IsWalkableTile(aX, aY: SmallInt): Boolean;
+begin
+  Result := gTerrain.TileInMapCoords(aX, aY) and (inherited IsWalkableTile(aX, aY));
+end;
+
+
+{**
+ Search recursively in the direction (parent -> child), stopping only when a
+ * jump point is found.
+ * @protected
+ * @return Array.<[number, number]> The x, y coordinate of the jump point
+ *     found, or null if not found
+ *}
+function TKMPathFindingJPS.jump(x, y, px, py: SmallInt): TPoint;
+var
+  dx, dy: SmallInt;
+  jx, jy: TPoint;
+begin
+  if not IsWalkableTile(x, y) then
+  begin
+    Result := Point(-1, -1);
+    Exit;
+  end
+  else
+  if (getNodeAt(x,y) = endNode) then
+  begin
+    Result := Point(x, y);
+    Exit;
+  end;
+
+  dx := x - px;
+  dy := y - py;
+
+  // check for forced neighbors
+  // along the diagonal
+  if (dx <> 0) and (dy <> 0) then
+  begin
+    if ((IsWalkableTile(x - dx, y + dy) and not IsWalkableTile(x - dx, y)) or
+        (IsWalkableTile(x + dx, y - dy) and not IsWalkableTile(x, y - dy))) then
+    begin
+      Result := Point(x, y);
+      Exit;
+    end;
+  end
+  // horizontally/vertically
+  else
+  begin
+    if( dx <> 0 ) then // moving along x
+    begin
+      if((IsWalkableTile(x + dx, y + 1) and not IsWalkableTile(x, y + 1)) or
+         (IsWalkableTile(x + dx, y - 1) and not IsWalkableTile(x, y - 1))) then
+      begin
+        Result := Point(x, y);
+        Exit;
+      end;
+    end
+    else
+    begin
+      if((IsWalkableTile(x + 1, y + dy) and not IsWalkableTile(x + 1, y)) or
+         (IsWalkableTile(x - 1, y + dy) and not IsWalkableTile(x - 1, y))) then
+      begin
+        Result := Point(x, y);
+        Exit;
+      end;
+    end;
+  end;
+
+  // when moving diagonally, must check for vertical/horizontal jump points
+  if (dx <> 0) and (dy <> 0) then
+  begin
+    jx := jump(x + dx, y, x, y);
+    jy := jump(x, y + dy, x, y);
+    if (jx.x <> -1) or (jy.x <> -1) then
+    begin
+      Result := Point(x, y);
+      Exit;
+    end;
+  end;
+
+  // moving diagonally, must make sure one of the vertical/horizontal
+  // neighbors is open to allow the path
+  if (IsWalkableTile(x + dx, y) or IsWalkableTile(x, y + dy)) then
+    Result := jump(x + dx, y + dy, x, y)
+  else
+    Result := Point(-1, -1);
+end;
+
+
+//Find the neighbors for the given node. If the node has a parent,
+//prune the neighbors based on the jump point search algorithm, otherwise
+//return all available neighbors.
+//@return {Array.<[number, number]>} The neighbors found.
+function TKMPathFindingJPS.findNeighbors(const node: TJPSPoint): TPointArray;
+var
+  count: SmallInt;
+
+  procedure Push(ax,ay: SmallInt);
+  begin
+    Result[count].X := ax;
+    Result[count].Y := ay;
+    Inc(count);
+  end;
+
+var
+  parent: TJPSPoint;
+  x, y: SmallInt;
+  px, py, dx, dy: SmallInt;
+begin
+  count := 0;
+  SetLength(Result, 8);
+
+  parent := node.parent;
+  x := node.x;
+  y := node.y;
+
+    // directed pruning: can ignore most neighbors, unless forced.
+    if (parent <> nil) then
+    begin
+        px := parent.x;
+        py := parent.y;
+        // get the normalized direction of travel
+        dx := Round((x - px) / max(abs(x - px), 1));
+        dy := Round((y - py) / max(abs(y - py), 1));
+
+        // search diagonally
+        if (dx <> 0) and (dy <> 0) then
+        begin
+            if IsWalkableTile(x, y + dy) then
+              Push(x, y + dy);
+            if IsWalkableTile(x + dx, y) then
+              Push(x + dx, y);
+            if IsWalkableTile(x, y + dy) or IsWalkableTile(x + dx, y) then
+              Push(x + dx, y + dy);
+            if (not IsWalkableTile(x - dx, y)) and IsWalkableTile(x, y + dy) then
+              Push(x - dx, y + dy);
+            if (not IsWalkableTile(x, y - dy)) and IsWalkableTile(x + dx, y) then
+              Push(x + dx, y - dy);
+        end
+        // search horizontally/vertically
+        else
+        begin
+            if (dx = 0) then
+            begin
+                if IsWalkableTile(x, y + dy) then
+                begin
+                    if IsWalkableTile(x, y + dy) then
+                      Push(x, y + dy);
+                    if not IsWalkableTile(x + 1, y) then
+                      Push(x + 1, y + dy);
+                    if not IsWalkableTile(x - 1, y) then
+                      Push(x - 1, y + dy);
+                end;
+            end
+            else
+            begin
+                if IsWalkableTile(x + dx, y) then
+                begin
+                    if IsWalkableTile(x + dx, y) then
+                      Push(x + dx, y);
+                    if not IsWalkableTile(x, y + 1) then
+                      Push(x + dx, y + 1);
+                    if not IsWalkableTile(x, y - 1) then
+                      Push(x + dx, y - 1);
+                end;
+            end;
+        end;
+    end
+    // return all neighbors (if parent = nil)
+    else
+    begin
+      if IsWalkableTile(x, y-1) then
+        Push(x, y-1);
+      if IsWalkableTile(x+1, y) then
+        Push(x+1, y);
+      if IsWalkableTile(x, y+1) then
+        Push(x, y+1);
+      if IsWalkableTile(x-1, y) then
+        Push(x-1, y);
+
+      if IsWalkableTile(x-1, y-1) then
+        Push(x-1, y-1);
+      if IsWalkableTile(x+1, y-1) then
+        Push(x+1, y-1);
+      if IsWalkableTile(x+1, y+1) then
+        Push(x+1, y+1);
+      if IsWalkableTile(x-1, y+1) then
+        Push(x-1, y+1);
+    end;
+
+  SetLength(Result, count);
+end;
+
+
+end.

vendor/kam_remake/src/pathfinding/KM_PathFindingRoad.pas

@@ -0,0 +1,181 @@
+unit KM_PathFindingRoad;
+{$I KaM_Remake.inc}
+interface
+uses
+  SysUtils,
+  KM_CommonClasses, KM_Defaults, KM_PathFinding, KM_PathFindingAStarNew, KM_Points;
+
+
+type
+  // Pathfinding that finds a route for a road to be built
+  //todo -cComplicated: Maybe it is worth trying to make Roadfinder a house-aware algo,
+  // to prefer connecting to supply/demand houses
+  TKMPathFindingRoad = class(TKMPathFindingAStarNew)
+  private
+    fRoadConnectID: Byte;
+  protected
+    fOwner: TKMHandID; // fOwner MUST BE VISIBLE for child-classes
+    function CanWalkTo(const aFrom: TKMPoint; aToX, aToY: SmallInt): Boolean; override;
+    function DestinationReached(aX, aY: Word): Boolean; override;
+    function IsWalkableTile(aX, aY: Word): Boolean; override;
+    function MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal; override;
+    function EstimateToFinish(aX, aY: Word): Cardinal; override;
+  public
+    constructor Create(aOwner: TKMHandID);
+
+    procedure OwnerUpdate(aPlayer: TKMHandID);
+    function Route_Make(const aLocA, aLocB: TKMPoint; NodeList: TKMPointList): Boolean; reintroduce;
+    function Route_ReturnToWalkable(const aLocA, aLocB: TKMPoint; aRoadConnectID: Byte; NodeList: TKMPointList): Boolean; reintroduce;
+    procedure Save(SaveStream: TKMemoryStream); override;
+    procedure Load(LoadStream: TKMemoryStream); override;
+  end;
+
+  // Minor variation on class above for creating shortcuts in AI road network
+  TKMPathFindingRoadShortcuts = class(TKMPathFindingRoad)
+  protected
+    function DestinationReached(aX, aY: Word): Boolean; override;
+    function MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal; override;
+  end;
+
+
+implementation
+uses
+  KM_HandsCollection, KM_TerrainTypes, KM_Terrain, KM_Hand;
+
+
+{ TKMPathFindingRoad }
+constructor TKMPathFindingRoad.Create(aOwner: TKMHandID);
+begin
+  inherited Create;
+  fOwner := aOwner;
+end;
+
+
+procedure TKMPathFindingRoad.OwnerUpdate(aPlayer: TKMHandID);
+begin
+  fOwner := aPlayer;
+end;
+
+
+procedure TKMPathFindingRoad.Save(SaveStream: TKMemoryStream);
+begin
+  inherited;
+  SaveStream.PlaceMarker('PathFindingRoad');
+  SaveStream.Write(fOwner);
+  SaveStream.Write(fRoadConnectID);
+end;
+
+
+procedure TKMPathFindingRoad.Load(LoadStream: TKMemoryStream);
+begin
+  inherited;
+  LoadStream.CheckMarker('PathFindingRoad');
+  LoadStream.Read(fOwner);
+  LoadStream.Read(fRoadConnectID);
+end;
+
+
+function TKMPathFindingRoad.CanWalkTo(const aFrom: TKMPoint; aToX, aToY: SmallInt): Boolean;
+begin
+  //Roads can't go diagonally, only in 90 turns
+  Result := (aToX = aFrom.X) or (aToY = aFrom.Y);
+end;
+
+
+function TKMPathFindingRoad.MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal;
+var
+  isRoad: Boolean;
+begin
+  isRoad := (tpWalkRoad in gTerrain.Land^[aToY, aToX].Passability)
+            or (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(aToX, aToY)) = ftRoad)
+            or (gTerrain.Land^[aToY, aToX].TileLock = tlRoadWork);
+
+  //Since we don't allow roads to be built diagonally we can assume
+  //path is always 1 tile = 1 point
+  if isRoad then
+    Result := 0
+  else
+    Result := 1;
+
+  //Building roads over fields is discouraged unless unavoidable
+  if gTerrain.TileIsCornField(KMPoint(aToX, aToY))
+  or gTerrain.TileIsWineField(KMPoint(aToX, aToY)) then
+    Inc(Result, 6); //6 tiles penalty
+end;
+
+
+function TKMPathFindingRoad.EstimateToFinish(aX, aY: Word): Cardinal;
+begin
+  case fDestination of
+    pdLocation:    //Rough estimation
+                    Result := (Abs(aX - fLocB.X) + Abs(aY - fLocB.Y));
+
+    pdPassability: //Every direction is equaly good
+                    Result := 0;
+    else            Result := 0;
+  end;
+end;
+
+
+function TKMPathFindingRoad.IsWalkableTile(aX, aY: Word): Boolean;
+begin
+  Result := ( ([tpMakeRoads, tpWalkRoad] * gTerrain.Land^[aY,aX].Passability <> []) OR (gTerrain.Land^[aY, aX].TileLock = tlRoadWork) )
+            and (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(aX, aY)) in [ftNone, ftRoad])
+            and not gHands[fOwner].Constructions.HousePlanList.HasPlan(KMPoint(aX, aY)); // This will ignore allied plans but I guess that it will not cause trouble
+end;
+
+
+function TKMPathFindingRoad.DestinationReached(aX, aY: Word): Boolean;
+begin
+  Result := ((aX = fLocB.X) and (aY = fLocB.Y)) //We reached destination point
+            or ((gTerrain.Land^[aY, aX].TileOverlay = toRoad) //We reached destination road network
+               and (fRoadConnectID <> 0) //No network
+               and (gTerrain.GetRoadConnectID(KMPoint(aX, aY)) = fRoadConnectID));
+end;
+
+
+function TKMPathFindingRoad.Route_Make(const aLocA, aLocB: TKMPoint; NodeList: TKMPointList): Boolean;
+begin
+  Result := inherited Route_Make(aLocA, aLocB, [tpMakeRoads, tpWalkRoad], 0, nil, NodeList);
+end;
+
+
+//Even though we are only going to a road network it is useful to know where our target is so we start off in the right direction (makes algorithm faster/work over long distances)
+function TKMPathFindingRoad.Route_ReturnToWalkable(const aLocA, aLocB: TKMPoint; aRoadConnectID: Byte; NodeList: TKMPointList): Boolean;
+begin
+  fRoadConnectID := aRoadConnectID;
+  Result := inherited Route_ReturnToWalkable(aLocA, aLocB, wcRoad, 0, [tpMakeRoads, tpWalkRoad], NodeList);
+end;
+
+
+{ TKMPathFindingRoadShortcuts }
+function TKMPathFindingRoadShortcuts.MovementCost(aFromX, aFromY, aToX, aToY: Word): Cardinal;
+var
+  isRoad: Boolean;
+begin
+  //Since we don't allow roads to be built diagonally we can assume
+  //path is always 1 tile
+  Result := 1;
+
+  //Off road costs extra
+  isRoad := (tpWalkRoad in gTerrain.Land^[aToY, aToX].Passability)
+            or (gHands[fOwner].Constructions.FieldworksList.HasField(KMPoint(aToX, aToY)) = ftRoad)
+            or (gTerrain.Land^[aToY, aToX].TileLock = tlRoadWork);
+
+  if not isRoad then
+    Inc(Result, 3);
+
+  //Building roads over fields is discouraged unless unavoidable
+  if gTerrain.TileIsCornField(KMPoint(aToX, aToY))
+  or gTerrain.TileIsWineField(KMPoint(aToX, aToY)) then
+    Inc(Result, 4);
+end;
+
+
+function TKMPathFindingRoadShortcuts.DestinationReached(aX, aY: Word): Boolean;
+begin
+  Result := ((aX = fLocB.X) and (aY = fLocB.Y)); //We reached destination point
+end;
+
+
+end.