ewsdr/DXSpotStore.pas

unit DXSpotStore;

{
  DXSpotStore.pas — потокобезопасное хранилище DX-спотов.

  Единственная точка обмена между сетевым потоком кластера (TDXClusterClient,
  пишет) и UI (оверлей спектра + окно списка, читают). Поэтому здесь НЕТ ни
  Synchronize, ни очередей в главный поток: поток кластера кладёт спот прямо
  сюда под критической секцией, а UI замечает изменение по монотонному
  счётчику Version — ровно так же, как оверлеи замечают смену вида по своим
  ключам кэша. Никаких LCL-зависимостей (юнит компилируется и в headless).

  Дедуп: спот с тем же позывным в пределах DEDUP_HZ считается тем же самым —
  обновляем частоту/время/комментарий, а не плодим строки. Тот же позывной на
  другом диапазоне — отдельная запись.

  TTL: споты старше FTTLMinutes выбрасываются при каждой правке/снимке.
}

{$IFDEF FPC}
  {$MODE Delphi}
  {$LONGSTRINGS ON}
{$ENDIF}

interface

uses
  SysUtils, Classes, SyncObjs, DateUtils, StrUtils;   // StrUtils — PosEx

const
  DX_DEDUP_HZ      = 5000.0;   // тот же позывной в этом окне = тот же спот
  DX_DEFAULT_TTL   = 30;       // мин
  DX_DEFAULT_MAX   = 500;      // потолок записей

type
  // Мода спота. Определяется по комментарию кластера (FT8/CW/…), при неудаче —
  // остаётся dxmUnknown: гадать по частоте не пытаемся, бэндпланы разные.
  TDXMode = (dxmUnknown, dxmCW, dxmSSB, dxmDigi, dxmFT8, dxmFT4, dxmRTTY,
             dxmPSK, dxmFM, dxmSSTV);

  TDXModeSet = set of TDXMode;

  TDXSpot = record
    FreqHz:  Double;     // частота DX-станции, Гц (кластер отдаёт кГц)
    Call:    string;     // позывной DX
    Spotter: string;     // кто заспотил
    Comment: string;     // комментарий кластера (уже без времени)
    TimeUTC: string;     // 'HHMM' как пришло от кластера
    Stamp:   TDateTime;  // локальное время приёма — для TTL и затухания
    Mode:    TDXMode;
    ModeGuessed: Boolean; // мода не из комментария, а из бэндплана (см. ниже)
  end;

  TDXSpotArray = array of TDXSpot;

  TDXSpotStore = class
  private
    FLock:       TCriticalSection;
    FSpots:      TDXSpotArray;
    FCount:      Integer;
    FVersion:    Int64;
    FTTLMinutes: Integer;
    FMaxSpots:   Integer;
    procedure PurgeLocked;
    procedure DropOldestLocked;
    function  GetTTLMinutes: Integer;
    procedure SetTTLMinutes(V: Integer);
    function  GetMaxSpots: Integer;
    procedure SetMaxSpots(V: Integer);
  public
    constructor Create;
    destructor  Destroy; override;

    // Добавить/обновить спот (вызывается из потока кластера).
    procedure Add(const S: TDXSpot);
    procedure Clear;
    // Выбросить просроченное прямо сейчас. Нужен тому, кто следит за временем
    // снаружи: сам стор чистится только на Add и снимках, а когда споты никто
    // не берёт и не приходит новых, устаревать им иначе негде.
    procedure Purge;

    // Снимок всех спотов, отсортированный по частоте.
    function Snapshot(out Arr: TDXSpotArray): Integer;
    // Снимок окна [LoHz..HiHz] с фильтром по моде (Modes = [] — без фильтра)
    // и по возрасту (MaxAgeMin <= 0 — только общий TTL). Для оверлея.
    function SnapshotRange(LoHz, HiHz: Double; Modes: TDXModeSet;
      MaxAgeMin: Integer; out Arr: TDXSpotArray): Integer;

    // Монотонный счётчик правок — ключ инвалидации кэша оверлея/списка.
    function Version: Int64;
    function Count: Integer;

    // Читаются сетевым потоком (PurgeLocked/Add), пишутся из UI — только через
    // критическую секцию, как и всё остальное состояние стора.
    property TTLMinutes: Integer read GetTTLMinutes write SetTTLMinutes;
    property MaxSpots:   Integer read GetMaxSpots   write SetMaxSpots;
  end;

// Мода по комментарию кластера ('FT8 -12 dB' → dxmFT8). Пусто/непонятно —
// dxmUnknown.
function DXModeFromComment(const Comment: string): TDXMode;
// Мода по участку бэндплана — запасной путь, когда комментарий молчит (в CW и
// SSB его сплошь и рядом просто не пишут). dxmUnknown = участок спорный или
// вне таблицы; см. DX_BAND_PLAN о том, где мы намеренно не гадаем.
function DXModeFromFreq(FreqHz: Double): TDXMode;
function DXModeName(M: TDXMode): string;

implementation

const
  MODE_NAMES: array[TDXMode] of string =
    ('', 'CW', 'SSB', 'DIGI', 'FT8', 'FT4', 'RTTY', 'PSK', 'FM', 'SSTV');

function DXModeName(M: TDXMode): string;
begin
  Result := MODE_NAMES[M];
end;

function DXModeFromComment(const Comment: string): TDXMode;
// Ищем маркер моды как ОТДЕЛЬНОЕ слово: 'CW' внутри 'CWOPS' или позывного
// модой не является. Порядок проверки — от длинных/специфичных к общим.
var
  U: string;

  function HasWord(const W: string): Boolean;
  var P, L, N: Integer; OkL, OkR: Boolean;
  begin
    Result := False;
    L := Length(W); N := Length(U);
    P := Pos(W, U);
    while P > 0 do
    begin
      OkL := (P = 1) or not (U[P-1] in ['A'..'Z', '0'..'9', '/', '-']);
      OkR := (P + L > N) or not (U[P+L] in ['A'..'Z', '0'..'9', '/', '-']);
      if OkL and OkR then Exit(True);
      P := PosEx(W, U, P + 1);
    end;
  end;

begin
  Result := dxmUnknown;
  if Comment = '' then Exit;
  U := UpperCase(Comment);
  if      HasWord('FT8')  then Result := dxmFT8
  else if HasWord('FT4')  then Result := dxmFT4
  else if HasWord('RTTY') then Result := dxmRTTY
  else if HasWord('PSK') or HasWord('PSK31') or HasWord('BPSK') then Result := dxmPSK
  else if HasWord('SSTV') then Result := dxmSSTV
  else if HasWord('CW')   then Result := dxmCW
  else if HasWord('SSB') or HasWord('USB') or HasWord('LSB') then Result := dxmSSB
  else if HasWord('FM')   then Result := dxmFM
  else if HasWord('JT65') or HasWord('JT9') or HasWord('JS8') or
          HasWord('MSK144') or HasWord('OLIVIA') or HasWord('DIGI') then
    Result := dxmDigi;
end;

{ ── Мода по бэндплану ────────────────────────────────────────────────────── }

type
  TDXBandSeg = record
    LoKHz, HiKHz: Double;   // [Lo; Hi)
    Mode:         TDXMode;
  end;

const
  // Участки бэндплана для запасного определения моды. Читается СВЕРХУ ВНИЗ,
  // первое попадание выигрывает — поэтому узкие «водопои» цифры стоят раньше
  // широких сегментов, внутрь которых они попадают (FT8 на 7074 живёт посреди
  // телефонного участка R1, FT4 на 21140 — посреди 15-метрового).
  //
  // ★ Границы — по плану IARU Region 1 (наш регион): у R2/R3 они другие, и
  // спорные куски мы НАМЕРЕННО оставляем пустыми, а не гадаем — пропуск честнее
  // ошибки. Отсюда дырки: 1843-1850 (R1 SSB против R2 CW), 7053-7125 у R2 —
  // данные, а не телефон, и т.п. Мода из комментария всегда важнее этой
  // таблицы, сюда попадают только споты, где комментарий промолчал.
  DX_BAND_PLAN: array[0..47] of TDXBandSeg = (
    // ── узкие окна FT8/FT4 (перекрывают широкие сегменты ниже) ──
    (LoKHz: 1840.0;   HiKHz: 1843.0;   Mode: dxmFT8),
    (LoKHz: 3573.0;   HiKHz: 3576.0;   Mode: dxmFT8),
    (LoKHz: 7047.0;   HiKHz: 7049.0;   Mode: dxmFT4),
    (LoKHz: 7074.0;   HiKHz: 7078.0;   Mode: dxmFT8),
    (LoKHz: 10136.0;  HiKHz: 10139.0;  Mode: dxmFT8),
    (LoKHz: 10140.0;  HiKHz: 10142.0;  Mode: dxmFT4),
    (LoKHz: 14074.0;  HiKHz: 14078.0;  Mode: dxmFT8),
    (LoKHz: 14080.0;  HiKHz: 14082.0;  Mode: dxmFT4),
    (LoKHz: 18100.0;  HiKHz: 18102.0;  Mode: dxmFT8),
    (LoKHz: 18104.0;  HiKHz: 18106.0;  Mode: dxmFT4),
    (LoKHz: 21074.0;  HiKHz: 21078.0;  Mode: dxmFT8),
    (LoKHz: 21140.0;  HiKHz: 21142.0;  Mode: dxmFT4),
    (LoKHz: 24915.0;  HiKHz: 24917.0;  Mode: dxmFT8),
    (LoKHz: 24919.0;  HiKHz: 24921.0;  Mode: dxmFT4),
    (LoKHz: 28074.0;  HiKHz: 28078.0;  Mode: dxmFT8),
    (LoKHz: 28180.0;  HiKHz: 28182.0;  Mode: dxmFT4),
    (LoKHz: 50313.0;  HiKHz: 50323.0;  Mode: dxmFT8),
    (LoKHz: 144174.0; HiKHz: 144180.0; Mode: dxmFT8),
    (LoKHz: 432174.0; HiKHz: 432180.0; Mode: dxmFT8),

    // ── КВ, широкие сегменты ──
    (LoKHz: 1800.0;   HiKHz: 1838.0;   Mode: dxmCW),
    (LoKHz: 1838.0;   HiKHz: 1843.0;   Mode: dxmDigi),
    (LoKHz: 1850.0;   HiKHz: 2000.0;   Mode: dxmSSB),

    (LoKHz: 3500.0;   HiKHz: 3570.0;   Mode: dxmCW),
    (LoKHz: 3570.0;   HiKHz: 3600.0;   Mode: dxmDigi),
    (LoKHz: 3600.0;   HiKHz: 4000.0;   Mode: dxmSSB),

    (LoKHz: 7000.0;   HiKHz: 7040.0;   Mode: dxmCW),
    (LoKHz: 7040.0;   HiKHz: 7053.0;   Mode: dxmDigi),
    (LoKHz: 7053.0;   HiKHz: 7300.0;   Mode: dxmSSB),

    (LoKHz: 10100.0;  HiKHz: 10130.0;  Mode: dxmCW),
    (LoKHz: 10130.0;  HiKHz: 10150.0;  Mode: dxmDigi),

    (LoKHz: 14000.0;  HiKHz: 14070.0;  Mode: dxmCW),
    (LoKHz: 14070.0;  HiKHz: 14099.0;  Mode: dxmDigi),
    (LoKHz: 14101.0;  HiKHz: 14350.0;  Mode: dxmSSB),

    (LoKHz: 18068.0;  HiKHz: 18095.0;  Mode: dxmCW),
    (LoKHz: 18095.0;  HiKHz: 18109.0;  Mode: dxmDigi),
    (LoKHz: 18111.0;  HiKHz: 18168.0;  Mode: dxmSSB),

    (LoKHz: 21000.0;  HiKHz: 21070.0;  Mode: dxmCW),
    (LoKHz: 21070.0;  HiKHz: 21120.0;  Mode: dxmDigi),
    (LoKHz: 21151.0;  HiKHz: 21450.0;  Mode: dxmSSB),

    (LoKHz: 24890.0;  HiKHz: 24915.0;  Mode: dxmCW),
    (LoKHz: 24915.0;  HiKHz: 24929.0;  Mode: dxmDigi),
    (LoKHz: 24931.0;  HiKHz: 24990.0;  Mode: dxmSSB),

    (LoKHz: 28000.0;  HiKHz: 28070.0;  Mode: dxmCW),
    (LoKHz: 28070.0;  HiKHz: 28190.0;  Mode: dxmDigi),
    (LoKHz: 28300.0;  HiKHz: 29100.0;  Mode: dxmSSB),
    (LoKHz: 29100.0;  HiKHz: 29700.0;  Mode: dxmFM),

    // ── УКВ (минимум, где регионы согласны) ──
    (LoKHz: 50000.0;  HiKHz: 50100.0;  Mode: dxmCW),
    (LoKHz: 50100.0;  HiKHz: 50500.0;  Mode: dxmSSB));

function DXModeFromFreq(FreqHz: Double): TDXMode;
var
  K: Double;
  i: Integer;
begin
  Result := dxmUnknown;
  if FreqHz <= 0 then Exit;

  // QO-100 (узкополосный транспондер, DOWNLINK). Отдельно от КВ-таблицы: план
  // AMSAT-DL, границы те же, что рисует BandPlanOverlay. Маяки (…500-505 и
  // …745-755) и «mixed modes» (…850-990) — не гадаем.
  K := FreqHz / 1000.0;
  if (K >= 10489500.0) and (K < 10490000.0) then
  begin
    if      (K >= 10489505.0) and (K < 10489540.0) then Result := dxmCW
    else if (K >= 10489540.0) and (K < 10489650.0) then Result := dxmDigi
    else if (K >= 10489650.0) and (K < 10489745.0) then Result := dxmSSB
    else if (K >= 10489755.0) and (K < 10489850.0) then Result := dxmSSB;
    Exit;
  end;

  for i := Low(DX_BAND_PLAN) to High(DX_BAND_PLAN) do
    if (K >= DX_BAND_PLAN[i].LoKHz) and (K < DX_BAND_PLAN[i].HiKHz) then
      Exit(DX_BAND_PLAN[i].Mode);
end;

{ ── TDXSpotStore ─────────────────────────────────────────────────────────── }

constructor TDXSpotStore.Create;
begin
  inherited Create;
  FLock       := TCriticalSection.Create;
  FCount      := 0;
  FVersion    := 0;
  FTTLMinutes := DX_DEFAULT_TTL;
  FMaxSpots   := DX_DEFAULT_MAX;
  SetLength(FSpots, DX_DEFAULT_MAX);
end;

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

procedure TDXSpotStore.PurgeLocked;
// Выбрасывает споты старше TTL, уплотняя массив на месте.
var
  i, Dst: Integer;
  Cutoff: TDateTime;
begin
  if FTTLMinutes <= 0 then Exit;
  Cutoff := IncMinute(Now, -FTTLMinutes);
  Dst := 0;
  for i := 0 to FCount - 1 do
    if FSpots[i].Stamp >= Cutoff then
    begin
      if Dst <> i then FSpots[Dst] := FSpots[i];
      Inc(Dst);
    end;
  if Dst <> FCount then
  begin
    FCount := Dst;
    Inc(FVersion);
  end;
end;

procedure TDXSpotStore.DropOldestLocked;
var i, Oldest: Integer;
begin
  if FCount <= 0 then Exit;
  Oldest := 0;
  for i := 1 to FCount - 1 do
    if FSpots[i].Stamp < FSpots[Oldest].Stamp then Oldest := i;
  for i := Oldest to FCount - 2 do FSpots[i] := FSpots[i + 1];
  Dec(FCount);
end;

procedure TDXSpotStore.Add(const S: TDXSpot);
var
  i: Integer;
  UCall: string;
begin
  if S.Call = '' then Exit;
  FLock.Enter;
  try
    PurgeLocked;
    UCall := UpperCase(S.Call);
    for i := 0 to FCount - 1 do
      if (UpperCase(FSpots[i].Call) = UCall) and
         (Abs(FSpots[i].FreqHz - S.FreqHz) <= DX_DEDUP_HZ) then
      begin
        FSpots[i] := S;              // тот же спот — обновляем целиком
        Inc(FVersion);
        Exit;
      end;
    if Length(FSpots) < FMaxSpots then SetLength(FSpots, FMaxSpots);
    while FCount >= FMaxSpots do DropOldestLocked;
    FSpots[FCount] := S;
    Inc(FCount);
    Inc(FVersion);
  finally
    FLock.Leave;
  end;
end;

procedure TDXSpotStore.Purge;
begin
  FLock.Enter;
  try
    PurgeLocked;      // сам поднимет Version, если что-то выбросил
  finally
    FLock.Leave;
  end;
end;

procedure TDXSpotStore.Clear;
begin
  FLock.Enter;
  try
    if FCount = 0 then Exit;
    FCount := 0;
    Inc(FVersion);
  finally
    FLock.Leave;
  end;
end;

function CompareSpotFreq(const A, B: TDXSpot): Integer;
begin
  if      A.FreqHz < B.FreqHz then Result := -1
  else if A.FreqHz > B.FreqHz then Result :=  1
  else Result := 0;
end;

procedure SortByFreq(var Arr: TDXSpotArray; N: Integer);
// Вставками: N здесь десятки-сотни и массив почти всегда уже почти
// отсортирован (споты приходят вперемешку, но окно узкое).
var i, j: Integer; T: TDXSpot;
begin
  for i := 1 to N - 1 do
  begin
    T := Arr[i];
    j := i - 1;
    while (j >= 0) and (CompareSpotFreq(Arr[j], T) > 0) do
    begin
      Arr[j + 1] := Arr[j];
      Dec(j);
    end;
    Arr[j + 1] := T;
  end;
end;

function TDXSpotStore.Snapshot(out Arr: TDXSpotArray): Integer;
var i: Integer;
begin
  FLock.Enter;
  try
    PurgeLocked;
    SetLength(Arr, FCount);
    for i := 0 to FCount - 1 do Arr[i] := FSpots[i];
    Result := FCount;
  finally
    FLock.Leave;
  end;
  SortByFreq(Arr, Result);
end;

function TDXSpotStore.SnapshotRange(LoHz, HiHz: Double; Modes: TDXModeSet;
  MaxAgeMin: Integer; out Arr: TDXSpotArray): Integer;
var
  i, N: Integer;
  Cutoff: TDateTime;
  UseAge: Boolean;
begin
  N := 0;
  UseAge := MaxAgeMin > 0;
  Cutoff := 0;
  if UseAge then Cutoff := IncMinute(Now, -MaxAgeMin);
  FLock.Enter;
  try
    PurgeLocked;
    SetLength(Arr, FCount);
    for i := 0 to FCount - 1 do
    begin
      if (FSpots[i].FreqHz < LoHz) or (FSpots[i].FreqHz > HiHz) then Continue;
      if (Modes <> []) and not (FSpots[i].Mode in Modes) then Continue;
      if UseAge and (FSpots[i].Stamp < Cutoff) then Continue;
      Arr[N] := FSpots[i];
      Inc(N);
    end;
    SetLength(Arr, N);
    Result := N;
  finally
    FLock.Leave;
  end;
  SortByFreq(Arr, Result);
end;

function TDXSpotStore.GetTTLMinutes: Integer;
begin
  FLock.Enter;
  try
    Result := FTTLMinutes;
  finally
    FLock.Leave;
  end;
end;

procedure TDXSpotStore.SetTTLMinutes(V: Integer);
begin
  if V < 1 then V := 1;
  FLock.Enter;
  try
    if FTTLMinutes = V then Exit;
    FTTLMinutes := V;
    PurgeLocked;          // укоротили TTL — лишнее выбрасываем сразу
  finally
    FLock.Leave;
  end;
end;

function TDXSpotStore.GetMaxSpots: Integer;
begin
  FLock.Enter;
  try
    Result := FMaxSpots;
  finally
    FLock.Leave;
  end;
end;

procedure TDXSpotStore.SetMaxSpots(V: Integer);
begin
  if V < 16 then V := 16;
  FLock.Enter;
  try
    if FMaxSpots = V then Exit;
    FMaxSpots := V;
    if Length(FSpots) < FMaxSpots then SetLength(FSpots, FMaxSpots);
    while FCount > FMaxSpots do
    begin
      DropOldestLocked;
      Inc(FVersion);
    end;
  finally
    FLock.Leave;
  end;
end;

function TDXSpotStore.Version: Int64;
begin
  FLock.Enter;
  try
    Result := FVersion;
  finally
    FLock.Leave;
  end;
end;

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

end.