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;
  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;

    // Снимок всех спотов, отсортированный по частоте.
    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;
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;

{ ── 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.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.