Skip to content

make KM_HandLogistics compile on Unix with FPC-3.2.2 and Lazarus-3.0 #213

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
dpronin wants to merge 1 commit into
base: master
Choose a base branch
from
Open

make KM_HandLogistics compile on Unix with FPC-3.2.2 and Lazarus-3.0 #213

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 60 additions & 6 deletions src/hands/KM_HandLogistics.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,15 +2,20 @@
{$I KaM_Remake.inc}
interface
uses
{$IF Defined(FPC) or Defined(VER230)}
{$IF (Defined(FPC) and not Defined(Unix)) or Defined(VER230)}
{$ELSE}
{$DEFINE USE_HASH}
{$IFEND}

{$IFDEF USE_VIRTUAL_TREEVIEW}VirtualTrees, {$ENDIF}

{$IFDEF USE_HASH}
Generics.Collections, Generics.Defaults, System.Hash,
Generics.Collections, Generics.Defaults,
{$IFNDEF Unix}
System.Hash,
{$ELSE}
KM_Sort,
{$ENDIF}
{$ENDIF}
Math,
KM_Units, KM_Houses, KM_ResHouses,
Expand Down Expand Up @@ -115,16 +120,20 @@ TKMDeliveryRouteBidKey = record
function GetHashCode: Integer;
end;

{$IFDEF WDC}
//Custom key comparator. Probably TDictionary can handle it himself, but lets try our custom comparator
TKMDeliveryRouteBidKeyEqualityComparer = class(TEqualityComparer<TKMDeliveryRouteBidKey>)
function Equals(const Left, Right: TKMDeliveryRouteBidKey): Boolean; override;
function GetHashCode(const Value: TKMDeliveryRouteBidKey): Integer; override;
end;
{$ENDIF}

{$IFNDEF Unix}
//Comparer just to make some order by keys
TKMDeliveryRouteBidKeyComparer = class(TComparer<TKMDeliveryRouteBidKey>)
function Compare(const Left, Right: TKMDeliveryRouteBidKey): Integer; override;
end;
{$ENDIF}

TKMDeliveryRouteBid = record
Value: Single;
Expand Down Expand Up @@ -2589,12 +2598,14 @@ procedure TKMDeliveries.ExportToFile(const aFileName: UnicodeString);
{$IFDEF USE_HASH}
{ TKMDeliveryBidKeyComparer }

{$IFDEF WDC}
function TKMDeliveryRouteBidKeyEqualityComparer.Equals(const Left, Right: TKMDeliveryRouteBidKey): Boolean;
begin
// path keys are equal if they have same ends
Result := ((Left.FromP = Right.FromP) and (Left.ToP = Right.ToP))
or ((Left.FromP = Right.ToP) and (Left.ToP = Right.FromP));
end;
{$ENDIF}


//example taken from https://stackoverflow.com/questions/18068977/use-objects-as-keys-in-tobjectdictionary
Expand All @@ -2616,17 +2627,18 @@ function CombinedHash(const Values: array of Integer): Integer;
{$ENDIF}


{$IFDEF WDC}
// Hash function should be match to equals function, so
// if A equals B, then Hash(A) = Hash(B)
// For our task we need that From / To end could be swapped, since we don't care where is the starting point of the path
function TKMDeliveryRouteBidKeyEqualityComparer.GetHashCode(const Value: TKMDeliveryRouteBidKey): Integer;
begin
Result := Value.GetHashCode;
end;
{$ENDIF}


//Compare keys to make some order to make save consistent. We don't care about the order, it just should be consistent
function TKMDeliveryRouteBidKeyComparer.Compare(const Left, Right: TKMDeliveryRouteBidKey): Integer;
function TKMDeliveryRouteBidKeyComparator(constref Left, Right: TKMDeliveryRouteBidKey): Integer;
begin
if Left.Pass = Right.Pass then
begin
Expand All @@ -2640,6 +2652,15 @@ function TKMDeliveryRouteBidKeyComparer.Compare(const Left, Right: TKMDeliveryRo
end;


{$IFNDEF Unix}
//Compare keys to make some order to make save consistent. We don't care about the order, it just should be consistent
function TKMDeliveryRouteBidKeyComparer.Compare(const Left, Right: TKMDeliveryRouteBidKey): Integer;
begin
Result := TKMDeliveryRouteBidKeyComparator(Left, Right);
end;
{$ENDIF}


{ TKMDeliveryCache }
procedure TKMDeliveryRouteCache.Add(const aKey: TKMDeliveryRouteBidKey; const aValue: Single; const aRouteStep: TKMDeliveryRouteStep); //; const aTimeToLive: Word);
var
Expand Down Expand Up @@ -2707,12 +2728,16 @@ function TKMDeliveryRouteBidKey.GetHashCode: Integer;
Int64Rec(total).Words[2] := FromP.Y + ToP.Y; // (0..512)
Int64Rec(total).Words[3] := (Byte(Pass) shl 8) // (0..13 actually)
or Abs(FromP.Y - ToP.Y); // (0..256)
{$IFNDEF Unix}
//GetHashValue(Integer/Cardinal) is even faster, but we can't fit our 34 bits there
Result := THashBobJenkins.GetHashValue(total, SizeOf(Int64), 0);
{$ELSE}
Result := BobJenkinsHash(total, SizeOf(Int64), 0);
{$ENDIF}
end;


{ TKMDeliveryBid }
{ TKMDeliveryRouteBid }
function TKMDeliveryRouteBid.GetTTL: Integer;
begin
Result := 0;
Expand All @@ -2734,14 +2759,17 @@ constructor TKMDeliveryRouteEvaluator.Create;
begin
inherited;

{$IFDEF USE_HASH}

fUpdatesCnt := 0;

{$IFDEF USE_HASH}
{$IFDEF WDC}
if CACHE_DELIVERY_BIDS then
begin
fBidsRoutesCache := TKMDeliveryRouteCache.Create(TKMDeliveryRouteBidKeyEqualityComparer.Create);
fRemoveKeysList := TList<TKMDeliveryRouteBidKey>.Create;
end;
{$ENDIF}

if DELIVERY_BID_CALC_USE_PATHFINDING then
fNodeList := TKMPointList.Create;
Expand All @@ -2752,14 +2780,18 @@ constructor TKMDeliveryRouteEvaluator.Create;
destructor TKMDeliveryRouteEvaluator.Destroy;
begin
{$IFDEF USE_HASH}

{$IFDEF WDC}
if CACHE_DELIVERY_BIDS then
begin
fBidsRoutesCache.Free;
fRemoveKeysList.Free;
end;
{$ENDIF}

if DELIVERY_BID_CALC_USE_PATHFINDING then
fNodeList.Free;

{$ENDIF}

inherited;
Expand Down Expand Up @@ -2806,6 +2838,8 @@ function TKMDeliveryRouteEvaluator.TryEvaluateAccurate(const aFromPos, aToPos: T
bid: TKMDeliveryRouteBid;
begin
{$IFDEF USE_HASH}

{$IFDEF WDC}
if CACHE_DELIVERY_BIDS then
begin
bidKey.FromP := aFromPos;
Expand All @@ -2821,14 +2855,20 @@ function TKMDeliveryRouteEvaluator.TryEvaluateAccurate(const aFromPos, aToPos: T
end;
{$ENDIF}

{$ENDIF}

// Calc value if it was not found in the cache
Result := DoTryEvaluate(aFromPos, aToPos, aPass, aRouteCost);

{$IFDEF USE_HASH}

{$IFDEF WDC}
if CACHE_DELIVERY_BIDS then
//Add calculated cost to the cache, even if there was no route. TTL for cache records is quite low, couple seconds
fBidsRoutesCache.Add(bidKey, aRouteCost, aRouteStep);
{$ENDIF}

{$ENDIF}
end;


Expand Down Expand Up @@ -2863,9 +2903,13 @@ procedure TKMDeliveryRouteEvaluator.UpdateState;
begin
{$IFDEF USE_HASH}
Inc(fUpdatesCnt);

{$IFDEF WDC}
if CACHE_DELIVERY_BIDS and ((fUpdatesCnt mod CACHE_CLEAN_FREQ) = 0) then
CleanCache;
{$ENDIF}

{$ENDIF}
end;


Expand All @@ -2874,7 +2918,9 @@ procedure TKMDeliveryRouteEvaluator.Save(SaveStream: TKMemoryStream);
var
cacheKeyArray : TArray<TKMDeliveryRouteBidKey>;
key: TKMDeliveryRouteBidKey;
{$IFNDEF Unix}
comparer: TKMDeliveryRouteBidKeyComparer;
{$ENDIF}
bid: TKMDeliveryRouteBid;
{$ENDIF}
begin
Expand All @@ -2891,10 +2937,16 @@ procedure TKMDeliveryRouteEvaluator.Save(SaveStream: TKMemoryStream);

if fBidsRoutesCache.Count > 0 then
begin
{$IFNDEF Unix}
comparer := TKMDeliveryRouteBidKeyComparer.Create;
{$ENDIF}
try
cacheKeyArray := fBidsRoutesCache.Keys.ToArray;
{$IFNDEF Unix}
TArray.Sort<TKMDeliveryRouteBidKey>(cacheKeyArray, comparer);
{$ELSE}
SortCustom(cacheKeyArray, Low(cacheKeyArray), High(cacheKeyArray), SizeOf(cacheKeyArray[0]), @TKMDeliveryRouteBidKeyComparator);
{$ENDIF}

for key in cacheKeyArray do
begin
Expand All @@ -2909,7 +2961,9 @@ procedure TKMDeliveryRouteEvaluator.Save(SaveStream: TKMemoryStream);
SaveStream.Write(bid.CreatedAt);
end;
finally
{$IFNDEF Unix}
comparer.Free;
{$ENDIF}
end;
end;
{$ENDIF}
Expand Down