{-------------------------------------------------------------------------
 Module:    Async Tile Downloader (Shared)

 Comment:   Background HTTP download pipeline for slippy-map tiles.
            Tiles are fetched in a worker thread, written atomically to
            disk (tmp + rename), and completion callbacks are posted back
            to the main thread via TThread.Queue.

            Extracted from TGlobe4 TGTileDownloader for reuse across
            TGlobe4, TGlobe5, and other consumers.

 Classes:   TGTileDownloadQueue     - thread-safe FIFO tile request queue
            TTileDownloadThread     - background TThread that performs HTTP GET
            TGTileFetcher           - main-thread coordinator and public API
-------------------------------------------------------------------------}
{$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
{$J+}
{$WEAKPACKAGEUNIT ON}
unit uCICTileDownloader;

interface

uses
  Classes, SysUtils, SyncObjs,
  {$IFDEF FPC}
  uCICOpenSSL3, fphttpclient, opensslsockets;
  {$ELSE}
  System.Net.HttpClient, Winapi.Windows;
  {$ENDIF}

{------------------------------------------------------------------------------
  TTileKey — tile coordinate triple
------------------------------------------------------------------------------}
type
  TTileKey = record
    Z, X, Y: Integer;
  end;

  TTileKeyArray = array of TTileKey;
  TInt64Array   = array of Int64;

{------------------------------------------------------------------------------
  TTileDownloadResult — result record posted from thread to main thread
------------------------------------------------------------------------------}
  TTileDownloadResult = record
    Key:     TTileKey;
    Success: Boolean;
  end;

  TTileDownloadResultArray = array of TTileDownloadResult;

{------------------------------------------------------------------------------
  TGTileDownloadQueue — thread-safe FIFO queue
------------------------------------------------------------------------------}
  TGTileDownloadQueue = class
  private
    FLock:  TCriticalSection;
    FItems: TTileKeyArray;
    FHead:  Integer;
    FCount: Integer;
    FCapacity: Integer;
    procedure Grow;
  public
    constructor Create;
    destructor  Destroy; override;
    procedure Enqueue(Z, X, Y: Integer);
    function  Dequeue(out Key: TTileKey): Boolean;
    procedure Clear;
    function  Count: Integer;
  end;

{------------------------------------------------------------------------------
  Forward declarations
------------------------------------------------------------------------------}
  TGTileFetcher = class;

{------------------------------------------------------------------------------
  TTileDownloadThread — background worker thread
------------------------------------------------------------------------------}
  TTileDownloadThread = class(TThread)
  private
    FQueue:       TGTileDownloadQueue;
    FWakeEvent:   TEvent;
    FOwner:       TGTileFetcher;
    FURLTemplate: string;
    FBaseDir:     string;
    FUserAgent:   string;
    function  BuildURL(Z, X, Y: Integer): string;
    function  DoHttpGet(const URL: string; Stream: TStream): Integer;
    procedure SaveTile(Z, X, Y: Integer; Stream: TMemoryStream; out FilePath: string);
    procedure PostResult(const Key: TTileKey; Success: Boolean);
  protected
    procedure Execute; override;
  public
    constructor Create(Queue: TGTileDownloadQueue; WakeEvent: TEvent;
      Owner: TGTileFetcher);
  end;

{------------------------------------------------------------------------------
  TGTileFetcher — main-thread coordinator
------------------------------------------------------------------------------}
  TGTileFetcher = class
  private
    FQueue:       TGTileDownloadQueue;
    FWakeEvent:   TEvent;
    FThread:      TTileDownloadThread;

    FPendingKeys:     TInt64Array;
    FPendingHashMask: Integer;
    FPendingCount:    Integer;

    FBlacklistKeys:     TInt64Array;
    FBlacklistHashMask: Integer;
    FBlacklistCount:    Integer;

    FResultLock:  TCriticalSection;
    FResults:     TTileDownloadResultArray;
    FResultCount: Integer;

    FURLTemplate: string;
    FBaseDir:     string;
    FUserAgent:   string;
    FEnabled:     Boolean;
    FOnTileDownloaded: TNotifyEvent;

    procedure SetURLTemplate(const Value: string);
    procedure SetBaseDir(const Value: string);
    procedure SetUserAgent(const Value: string);

    function  PackKey(Z, X, Y: Integer): Int64; {$IFNDEF FPC}inline;{$ENDIF}
    function  HashSetContains(const Keys: array of Int64; Mask: Integer;
      PackedKey: Int64): Boolean;
    procedure HashSetAdd(var Keys: array of Int64; Mask: Integer;
      var Count: Integer; PackedKey: Int64);
    procedure HashSetClear(var Keys: array of Int64; var Count: Integer);
    procedure RebuildPendingHash(NewMask: Integer);
    procedure RebuildBlacklistHash(NewMask: Integer);

    procedure EnsureThread;
    procedure StopThread;
    procedure AddResult(const Key: TTileKey; Success: Boolean);
    procedure ProcessCompletions;

  public
    constructor Create;
    destructor  Destroy; override;

    procedure RequestTile(Z, X, Y: Integer);
    procedure ClearPending;
    procedure ClearBlacklist;
    function  IsActive: Boolean;

    property Enabled:     Boolean read FEnabled       write FEnabled;
    property URLTemplate: string  read FURLTemplate  write SetURLTemplate;
    property BaseDir:     string  read FBaseDir       write SetBaseDir;
    property UserAgent:   string  read FUserAgent     write SetUserAgent;
    property OnTileDownloaded: TNotifyEvent read FOnTileDownloaded write FOnTileDownloaded;
  end;

function URLTemplateToSubDir(const Template: string): string;

implementation

{==============================================================================
  TGTileDownloadQueue
==============================================================================}

const
  QUEUE_INITIAL_CAPACITY = 64;

constructor TGTileDownloadQueue.Create;
begin
  inherited Create;
  FLock := TCriticalSection.Create;
  FCapacity := QUEUE_INITIAL_CAPACITY;
  SetLength(FItems, FCapacity);
  FHead := 0;
  FCount := 0;
end;

destructor TGTileDownloadQueue.Destroy;
begin
  FLock.Free;
  inherited Destroy;
end;

procedure TGTileDownloadQueue.Grow;
var
  NewCap: Integer;
  NewItems: TTileKeyArray;
  i: Integer;
begin
  NewCap := FCapacity * 2;
  NewItems := nil;
  SetLength(NewItems, NewCap);
  for i := 0 to FCount - 1 do
    NewItems[i] := FItems[(FHead + i) mod FCapacity];
  FItems := NewItems;
  FCapacity := NewCap;
  FHead := 0;
end;

procedure TGTileDownloadQueue.Enqueue(Z, X, Y: Integer);
var
  Tail: Integer;
begin
  FLock.Enter;
  try
    if FCount = FCapacity then
      Grow;
    Tail := (FHead + FCount) mod FCapacity;
    FItems[Tail].Z := Z;
    FItems[Tail].X := X;
    FItems[Tail].Y := Y;
    Inc(FCount);
  finally
    FLock.Leave;
  end;
end;

function TGTileDownloadQueue.Dequeue(out Key: TTileKey): Boolean;
begin
  FLock.Enter;
  try
    if FCount = 0 then
    begin
      Result := False;
      Exit;
    end;
    Key := FItems[FHead];
    FHead := (FHead + 1) mod FCapacity;
    Dec(FCount);
    Result := True;
  finally
    FLock.Leave;
  end;
end;

procedure TGTileDownloadQueue.Clear;
begin
  FLock.Enter;
  try
    FHead := 0;
    FCount := 0;
  finally
    FLock.Leave;
  end;
end;

function TGTileDownloadQueue.Count: Integer;
begin
  FLock.Enter;
  try
    Result := FCount;
  finally
    FLock.Leave;
  end;
end;

{==============================================================================
  TTileDownloadThread
==============================================================================}

constructor TTileDownloadThread.Create(Queue: TGTileDownloadQueue;
  WakeEvent: TEvent; Owner: TGTileFetcher);
begin
  FQueue     := Queue;
  FWakeEvent := WakeEvent;
  FOwner     := Owner;
  FURLTemplate := Owner.URLTemplate;
  FBaseDir     := Owner.BaseDir;
  FUserAgent   := Owner.UserAgent;
  FreeOnTerminate := False;
  inherited Create(False);
end;

function TTileDownloadThread.BuildURL(Z, X, Y: Integer): string;
begin
  Result := StringReplace(FURLTemplate, '{z}', IntToStr(Z),  [rfReplaceAll]);
  Result := StringReplace(Result,       '{x}', IntToStr(X),  [rfReplaceAll]);
  Result := StringReplace(Result,       '{y}', IntToStr(Y),  [rfReplaceAll]);
end;

function TTileDownloadThread.DoHttpGet(const URL: string; Stream: TStream): Integer;
{$IFDEF FPC}
var
  Client: TFPHTTPClient;
begin
  Result := 0;
  Client := TFPHTTPClient.Create(nil);
  try
    Client.AddHeader('User-Agent', FUserAgent);
    Client.AllowRedirect := True;
    try
      Client.Get(URL, Stream);
      Result := Client.ResponseStatusCode;
    except
      on E: Exception do
        Result := 0;
    end;
  finally
    Client.Free;
  end;
end;
{$ELSE}
var
  Client:   THTTPClient;
  Response: IHTTPResponse;
begin
  Client := THTTPClient.Create;
  try
    Client.UserAgent := FUserAgent;
    try
      Response := Client.Get(URL, Stream);
      Result := Response.StatusCode;
    except
      on E: Exception do
        Result := 0;
    end;
  finally
    Client.Free;
  end;
end;
{$ENDIF}

procedure TTileDownloadThread.SaveTile(Z, X, Y: Integer;
  Stream: TMemoryStream; out FilePath: string);
var
  Dir, TmpPath: string;
begin
  FilePath := '';
  Dir     := FBaseDir + PathDelim + IntToStr(Z) + PathDelim + IntToStr(X);
  TmpPath := Dir + PathDelim + IntToStr(Y) + '.png.tmp';

  if not ForceDirectories(Dir) then
    Exit;

  FilePath := Dir + PathDelim + IntToStr(Y) + '.png';

  try
    Stream.Position := 0;
    with TFileStream.Create(TmpPath, fmCreate) do
    try
      CopyFrom(Stream, Stream.Size);
    finally
      Free;
    end;
  except
    FilePath := '';
    Exit;
  end;

  if not SysUtils.RenameFile(TmpPath, FilePath) then
  begin
    SysUtils.DeleteFile(TmpPath);
  end;
end;

procedure TTileDownloadThread.PostResult(const Key: TTileKey; Success: Boolean);
begin
  FOwner.AddResult(Key, Success);
  TThread.Queue(nil, FOwner.ProcessCompletions);
end;

procedure TTileDownloadThread.Execute;
var
  Key:    TTileKey;
  URL:    string;
  Stream: TMemoryStream;
  Status: Integer;
  OK:     Boolean;
  FilePath: string;
begin
  while not Terminated do
  begin
    FWakeEvent.WaitFor(1000);
    FWakeEvent.ResetEvent;

    while (not Terminated) and FQueue.Dequeue(Key) do
    begin
      URL    := BuildURL(Key.Z, Key.X, Key.Y);
      Stream := TMemoryStream.Create;
      try
        Status := DoHttpGet(URL, Stream);
        OK := (Status = 200) and (Stream.Size > 0);
        if OK then
        begin
          SaveTile(Key.Z, Key.X, Key.Y, Stream, FilePath);
          OK := (FilePath <> '') and FileExists(FilePath);
        end;
        PostResult(Key, OK);
      finally
        Stream.Free;
      end;
    end;
  end;
end;

{==============================================================================
  TGTileFetcher
==============================================================================}

const
  HASH_INITIAL_SIZE = 256;

constructor TGTileFetcher.Create;
begin
  inherited Create;
  FQueue      := TGTileDownloadQueue.Create;
  FWakeEvent  := TEvent.Create(nil, True, False, '');
  FResultLock := TCriticalSection.Create;
  FThread     := nil;

  FPendingHashMask    := HASH_INITIAL_SIZE - 1;
  FBlacklistHashMask  := HASH_INITIAL_SIZE - 1;
  SetLength(FPendingKeys,   HASH_INITIAL_SIZE);
  SetLength(FBlacklistKeys, HASH_INITIAL_SIZE);
  FillChar(FPendingKeys[0],   HASH_INITIAL_SIZE * SizeOf(Int64), 0);
  FillChar(FBlacklistKeys[0], HASH_INITIAL_SIZE * SizeOf(Int64), 0);
  FPendingCount   := 0;
  FBlacklistCount := 0;

  FURLTemplate := '';
  FBaseDir     := '';
  FUserAgent   := '';
  FEnabled     := False;

  SetLength(FResults, 32);
  FResultCount := 0;
end;

destructor TGTileFetcher.Destroy;
begin
  StopThread;
  FResultLock.Free;
  FWakeEvent.Free;
  FQueue.Free;
  inherited Destroy;
end;

procedure TGTileFetcher.SetURLTemplate(const Value: string);
begin
  FURLTemplate := Value;
end;

procedure TGTileFetcher.SetBaseDir(const Value: string);
begin
  FBaseDir := Value;
end;

procedure TGTileFetcher.SetUserAgent(const Value: string);
begin
  FUserAgent := Value;
end;

function TGTileFetcher.PackKey(Z, X, Y: Integer): Int64;
begin
  Result := (Int64(Z) shl 40) or (Int64(X) shl 20) or Int64(Y);
  Inc(Result);
end;

function TGTileFetcher.HashSetContains(const Keys: array of Int64;
  Mask: Integer; PackedKey: Int64): Boolean;
var
  h: Integer;
begin
  h := Integer(NativeUInt(PackedKey) and NativeUInt(Mask));
  while Keys[h] <> 0 do
  begin
    if Keys[h] = PackedKey then
    begin
      Result := True;
      Exit;
    end;
    h := (h + 1) and Mask;
  end;
  Result := False;
end;

procedure TGTileFetcher.HashSetAdd(var Keys: array of Int64; Mask: Integer;
  var Count: Integer; PackedKey: Int64);
var
  h: Integer;
begin
  h := Integer(NativeUInt(PackedKey) and NativeUInt(Mask));
  while Keys[h] <> 0 do
    h := (h + 1) and Mask;
  Keys[h] := PackedKey;
  Inc(Count);
end;

procedure TGTileFetcher.HashSetClear(var Keys: array of Int64;
  var Count: Integer);
begin
  FillChar(Keys[0], (Length(Keys)) * SizeOf(Int64), 0);
  Count := 0;
end;

procedure TGTileFetcher.RebuildPendingHash(NewMask: Integer);
var
  OldKeys: TInt64Array;
  i, h: Integer;
begin
  OldKeys := FPendingKeys;
  SetLength(FPendingKeys, NewMask + 1);
  FillChar(FPendingKeys[0], (NewMask + 1) * SizeOf(Int64), 0);
  FPendingHashMask := NewMask;
  for i := 0 to Length(OldKeys) - 1 do
    if OldKeys[i] <> 0 then
    begin
      h := Integer(NativeUInt(OldKeys[i]) and NativeUInt(FPendingHashMask));
      while FPendingKeys[h] <> 0 do
        h := (h + 1) and FPendingHashMask;
      FPendingKeys[h] := OldKeys[i];
    end;
end;

procedure TGTileFetcher.RebuildBlacklistHash(NewMask: Integer);
var
  OldKeys: TInt64Array;
  i, h: Integer;
begin
  OldKeys := FBlacklistKeys;
  SetLength(FBlacklistKeys, NewMask + 1);
  FillChar(FBlacklistKeys[0], (NewMask + 1) * SizeOf(Int64), 0);
  FBlacklistHashMask := NewMask;
  for i := 0 to Length(OldKeys) - 1 do
    if OldKeys[i] <> 0 then
    begin
      h := Integer(NativeUInt(OldKeys[i]) and NativeUInt(FBlacklistHashMask));
      while FBlacklistKeys[h] <> 0 do
        h := (h + 1) and FBlacklistHashMask;
      FBlacklistKeys[h] := OldKeys[i];
    end;
end;

procedure TGTileFetcher.EnsureThread;
begin
  if FThread = nil then
  begin
    FThread := TTileDownloadThread.Create(FQueue, FWakeEvent, Self);
  end;
end;

procedure TGTileFetcher.StopThread;
begin
  if FThread <> nil then
  begin
    FThread.Terminate;
    FWakeEvent.SetEvent;
    FThread.WaitFor;
    FreeAndNil(FThread);
  end;
end;

procedure TGTileFetcher.AddResult(const Key: TTileKey; Success: Boolean);
begin
  FResultLock.Enter;
  try
    if FResultCount >= Length(FResults) then
      SetLength(FResults, Length(FResults) * 2);
    FResults[FResultCount].Key     := Key;
    FResults[FResultCount].Success := Success;
    Inc(FResultCount);
  finally
    FResultLock.Leave;
  end;
end;

procedure TGTileFetcher.ProcessCompletions;
var
  Local:    TTileDownloadResultArray;
  LocalCnt: Integer;
  i, h:     Integer;
  PK:       Int64;
  AnyOK:    Boolean;
begin
  FResultLock.Enter;
  try
    LocalCnt := FResultCount;
    if LocalCnt = 0 then
      Exit;
    Local := nil;
    SetLength(Local, LocalCnt);
    Move(FResults[0], Local[0], LocalCnt * SizeOf(TTileDownloadResult));
    FResultCount := 0;
  finally
    FResultLock.Leave;
  end;

  AnyOK := False;

  for i := 0 to LocalCnt - 1 do
  begin
    PK := PackKey(Local[i].Key.Z, Local[i].Key.X, Local[i].Key.Y);

    h := Integer(NativeUInt(PK) and NativeUInt(FPendingHashMask));
    while FPendingKeys[h] <> 0 do
    begin
      if FPendingKeys[h] = PK then
      begin
        FPendingKeys[h] := 0;
        Dec(FPendingCount);
        h := (h + 1) and FPendingHashMask;
        while FPendingKeys[h] <> 0 do
        begin
          PK := FPendingKeys[h];
          FPendingKeys[h] := 0;
          Dec(FPendingCount);
          HashSetAdd(FPendingKeys, FPendingHashMask, FPendingCount, PK);
          h := (h + 1) and FPendingHashMask;
        end;
        PK := PackKey(Local[i].Key.Z, Local[i].Key.X, Local[i].Key.Y);
        Break;
      end;
      h := (h + 1) and FPendingHashMask;
    end;

    if Local[i].Success then
      AnyOK := True
    else
    begin
      if not HashSetContains(FBlacklistKeys, FBlacklistHashMask, PK) then
      begin
        if FBlacklistCount * 4 >= (FBlacklistHashMask + 1) * 3 then
          RebuildBlacklistHash((FBlacklistHashMask + 1) * 2 - 1);
        HashSetAdd(FBlacklistKeys, FBlacklistHashMask, FBlacklistCount, PK);
      end;
    end;
  end;

  if AnyOK and Assigned(FOnTileDownloaded) then
    FOnTileDownloaded(Self);
end;

function TGTileFetcher.IsActive: Boolean;
begin
  Result := (FURLTemplate <> '') and (FBaseDir <> '');
end;

procedure TGTileFetcher.RequestTile(Z, X, Y: Integer);
var
  PK: Int64;
begin
  if not FEnabled then
    Exit;
  if not IsActive then
    Exit;

  PK := PackKey(Z, X, Y);

  if HashSetContains(FPendingKeys,   FPendingHashMask,   PK) then Exit;
  if HashSetContains(FBlacklistKeys, FBlacklistHashMask, PK) then Exit;

  if FPendingCount * 4 >= (FPendingHashMask + 1) * 3 then
    RebuildPendingHash((FPendingHashMask + 1) * 2 - 1);

  HashSetAdd(FPendingKeys, FPendingHashMask, FPendingCount, PK);

  FQueue.Enqueue(Z, X, Y);

  EnsureThread;

  FWakeEvent.SetEvent;
end;

procedure TGTileFetcher.ClearPending;
begin
  FQueue.Clear;
  HashSetClear(FPendingKeys, FPendingCount);
end;

procedure TGTileFetcher.ClearBlacklist;
begin
  HashSetClear(FBlacklistKeys, FBlacklistCount);
end;

//==============================================================================
// URLTemplateToSubDir - derive a filesystem sub-directory from a URL template
//
// Examples:
//   https://tile.openstreetmap.org/{z}/{x}/{y}.png
//     -> tile.openstreetmap.org
//   https://tiles.example.com/bluemarble/night/{z}/{x}/{y}.png
//     -> tiles.example.com\bluemarble\night
//==============================================================================
function URLTemplateToSubDir(const Template: string): string;
var
  S: string;
  P: Integer;
begin
  S := Template;

  // Strip scheme
  P := Pos('://', S);
  if P > 0 then
    Delete(S, 1, P + 2);

  // Take everything before '{z}'
  P := Pos('{z}', S);
  if P > 0 then
    S := Copy(S, 1, P - 1);

  // Trim trailing slashes
  while (Length(S) > 0) and ((S[Length(S)] = '/') or (S[Length(S)] = '\')) do
    Delete(S, Length(S), 1);

  // Replace forward slashes with PathDelim
  {$IFDEF MSWINDOWS}
  S := StringReplace(S, '/', '\', [rfReplaceAll]);
  {$ENDIF}

  Result := S;
end;

end.