ewsdr/DXSpotOverlay.pas

unit DXSpotOverlay;

{
  Оверлей DX-спотов на спектре: позывной в «чипе» + вертикальный штрих к своей
  частоте. Пересекающиеся подписи раскладываются лесенкой по рядам сверху вниз.

  Производительность — ровно модель BandPlanOverlay/VfoOverlay, ничего нового:

   • Кэшируется ТОЛЬКО полоса подписей (W × FBandH, вверху спектра) в key-color
     битмап; пересборка идёт исключительно по dirty-ключу (версия стора / вид /
     ширина / тема / фильтры / тик затухания), а каждый кадр — один композит
     W × FBandH с постоянной альфой (BlendBitmapKey, тот же дворд-блендинг).
     Полноэкранный кэш W × H на кадр стоил бы в разы дороже — поэтому штрихи
     ниже полосы в кэш НЕ входят.
   • Штрихи от полосы до низа спектра рисует вызывающая сторона теми же
     примитивами, что и все прочие маркеры: CPU — RawVLine внутри RawBegin/
     RawEnd (никакого Canvas на битмапе кадра), GL — DrawLine. Оверлей отдаёт
     только готовый список X/цвет (TickCount/Tick), посчитанный при пересборке
     кэша, — на кадр никакой арифметики по спотам.
   • GL-путь берёт ТОТ ЖЕ битмап текстурой (DrawOverlayBitmap + UploadBitmap с
     color-key), заливка — только при dirty. Вид CPU и GL совпадает.

  Домен частот — display-Гц, как их видит спектр (GetViewWindow). Частота спота
  кладётся как есть: на QO-100 кластеры постят downlink 10489.xxx, что совпадает
  со шкалой панадаптера само собой.
}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, Types, Math, Forms,
  VfoOverlay,    // BlendBitmapKey — общий keyed-композит (одна копия на проект)
  DXSpotStore;

const
  DXSPOT_ALPHA      = 225;   // альфа композита полосы подписей
  DXSPOT_ROW_BASE_H = 15;    // базовая высота ряда @96dpi
  DXSPOT_MAX_ROWS   = 6;     // потолок рядов лесенки (настройка кладётся сюда)

type
  // Один разложенный спот: где чип, где штрих, каким цветом.
  TDXSpotItem = record
    X:      Integer;      // X штриха (пиксель частоты)
    Chip:   TRect;        // прямоугольник подписи (для хит-теста)
    Color:  TColor;       // цвет с учётом возраста/своего позывного
    Spot:   TDXSpot;
  end;

  TDXSpotOverlay = class(TComponent)
  private
    FStore:      TDXSpotStore;   // не владеет
    FCenterFreq: Double;
    FSpanHz:     Double;
    FEnabled:    Boolean;
    FLightTheme: Boolean;
    FOwnCall:    string;

    // фильтры
    FModes:      TDXModeSet;
    FMaxAgeMin:  Integer;
    FMaxRows:    Integer;

    FCache:      TBitmap;
    FCacheW:     Integer;
    FCacheDirty: Boolean;
    FBandH:      Integer;        // высота полосы подписей (px, масштаб по DPI)
    FRowH:       Integer;

    // ключ кэша
    FKeyCenter:  Double;
    FKeySpan:    Double;
    FKeyW:       Integer;
    FKeyEnabled: Boolean;
    FKeyVersion: Int64;
    FKeyLight:   Boolean;
    FKeyRows:    Integer;
    FKeyAgeTick: Int64;
    FAgeTick:    Int64;          // бампается таймером UI — обновить затухание

    FRenderVer:  Int64;          // ++ на каждую пересборку кэша — ключ GL-текстуры
  FLayoutTTL:  Integer;        // горизонт затухания, снят один раз на раскладку
    FItems:      array of TDXSpotItem;
    FItemCount:  Integer;
    FHidden:     Integer;        // сколько спотов не влезло в лесенку

    function  FreqToX(FreqHz: Double; W: Integer): Integer;
    function  AgeColor(const S: TDXSpot): TColor;
    procedure Layout(C: TCanvas; W: Integer);
    procedure DrawSelf(C: TCanvas; W: Integer);
    procedure RebuildCache(W: Integer);
    function  NeedsRebuild(W: Integer): Boolean;
    procedure SetMaxRows(V: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Attach(AStore: TDXSpotStore);
    procedure SetView(ACenterHz, ASpanHz: Double);
    procedure SetEnabled(En: Boolean);
    procedure SetLightTheme(Light: Boolean);
    procedure SetOwnCall(const ACall: string);
    procedure SetFilters(AModes: TDXModeSet; AMaxAgeMin: Integer);
    // Тик затухания: дёргается редко (раз в десятки секунд) — только чтобы
    // старые споты потускнели и ушедшие по TTL исчезли.
    procedure TickAge;
    procedure Invalidate;

    function  Active: Boolean;

    // Пересобрать кэш+раскладку, если протух ключ. Вызывается В НАЧАЛЕ кадра:
    // штрихи рисуются РАНЬШЕ композита полосы, а список штрихов рождается
    // именно при пересборке — иначе первый кадр после нового спота рисовал бы
    // старую раскладку.
    procedure EnsureRendered(W: Integer);

    // CPU-путь: композит полосы подписей вверху Target.
    procedure DrawOverlay(Target: TBitmap; W, H: Integer);
    // GL-путь: полоса подписей в Target-битмап (W × BandHeight) под текстуру.
    procedure DrawOverlayBitmap(Target: TBitmap; W: Integer);

    // Штрихи ниже полосы — рисует вызывающая сторона (RawVLine / GL DrawLine).
    function  TickCount: Integer;
    procedure Tick(Idx: Integer; out X: Integer; out Color: TColor);

    // Хит-тест по подписи (клик = настроиться на спот).
    function  SpotAtPixel(X, Y: Integer; out Spot: TDXSpot): Boolean;

    property BandHeight: Integer read FBandH;
    property CenterFreq: Double  read FCenterFreq;   // для GL-инвалидизации
    property SpanHz:     Double  read FSpanHz;
    property MaxRows:    Integer read FMaxRows write SetMaxRows;
    property Hidden:     Integer read FHidden;
    property CacheDirty: Boolean read FCacheDirty;
    // Меняется ровно тогда, когда картинка полосы стала другой. GL-путь по нему
    // решает, перезаливать ли текстуру: он не зависит от того, кто первым
    // дёрнул пересборку в этом кадре (штрихи или композит).
    property RenderVersion: Int64 read FRenderVer;
  end;

implementation

const
  KEY_COLOR   = TColor($00FF00FF);   // тот же ключ прозрачности, что у VfoOverlay

  // Палитра (TColor = $00BBGGRR). Своя пара на тему: на тёмном спектре чип
  // тёмный со светлой подписью, на светлом — наоборот, иначе подписи спотов
  // на светлой теме сливались бы в грязное пятно.
  //                                   тёмная тема        светлая тема
  CLR_CHIP_BG:   array[Boolean] of TColor = ($00202018, $00F2F2EC);
  CLR_CHIP_TEXT: array[Boolean] of TColor = ($00F0F0F0, $00181818);
  CLR_FRESH:     array[Boolean] of TColor = ($00E0C040, $00A05800);  // свежий
  CLR_STALE:     array[Boolean] of TColor = ($00706850, $00B0A898);  // на исходе TTL
  CLR_OWN:       array[Boolean] of TColor = ($0040D0FF, $000060C8);  // свой позывной

  CHIP_PAD_X = 3;
  CHIP_GAP   = 3;    // минимальный зазор между чипами в одном ряду

function Mix(A, B: TColor; Num, Den: Integer): TColor;
// A→B на Num/Den (0 = A, Den = B).
var ra, ga, ba, rb, gb, bb: Integer;
begin
  if Den <= 0 then Exit(A);
  ra := A and $FF; ga := (A shr 8) and $FF; ba := (A shr 16) and $FF;
  rb := B and $FF; gb := (B shr 8) and $FF; bb := (B shr 16) and $FF;
  ra := ra + (rb - ra) * Num div Den;
  ga := ga + (gb - ga) * Num div Den;
  ba := ba + (bb - ba) * Num div Den;
  Result := TColor((ba shl 16) or (ga shl 8) or ra);
end;

{ ── Создание / параметры ─────────────────────────────────────────────────── }

constructor TDXSpotOverlay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRowH := Round(DXSPOT_ROW_BASE_H * Screen.PixelsPerInch / 96);
  if FRowH < DXSPOT_ROW_BASE_H then FRowH := DXSPOT_ROW_BASE_H;
  FMaxRows := 4;
  FBandH   := FRowH * FMaxRows + 4;
  FCenterFreq := 0;
  FSpanHz     := 0;
  FEnabled    := False;
  FModes      := [];
  FMaxAgeMin  := 0;
  FCache      := TBitmap.Create;
  FCache.PixelFormat := pf32bit;
  FCacheW     := 0;
  FCacheDirty := True;
  FKeyCenter  := -1; FKeySpan := -1; FKeyW := -1; FKeyVersion := -1;
  FKeyEnabled := False; FKeyLight := False; FKeyRows := -1; FKeyAgeTick := -1;
  FAgeTick    := 0;
  FRenderVer  := 0;
end;

destructor TDXSpotOverlay.Destroy;
begin
  FCache.Free;
  inherited Destroy;
end;

procedure TDXSpotOverlay.Attach(AStore: TDXSpotStore);
begin
  FStore := AStore;
  FCacheDirty := True;
end;

procedure TDXSpotOverlay.SetView(ACenterHz, ASpanHz: Double);
begin
  if (Abs(ACenterHz - FCenterFreq) < 1.0) and (Abs(ASpanHz - FSpanHz) < 1.0) then Exit;
  FCenterFreq := ACenterHz;
  FSpanHz     := ASpanHz;
  FCacheDirty := True;
end;

procedure TDXSpotOverlay.SetEnabled(En: Boolean);
begin
  if FEnabled = En then Exit;
  FEnabled := En;
  FCacheDirty := True;
end;

procedure TDXSpotOverlay.SetLightTheme(Light: Boolean);
begin
  if FLightTheme = Light then Exit;
  FLightTheme := Light;
  FCacheDirty := True;
end;

procedure TDXSpotOverlay.SetOwnCall(const ACall: string);
begin
  if SameText(FOwnCall, ACall) then Exit;
  FOwnCall := UpperCase(Trim(ACall));
  FCacheDirty := True;
end;

procedure TDXSpotOverlay.SetFilters(AModes: TDXModeSet; AMaxAgeMin: Integer);
begin
  if (FModes = AModes) and (FMaxAgeMin = AMaxAgeMin) then Exit;
  FModes     := AModes;
  FMaxAgeMin := AMaxAgeMin;
  FCacheDirty := True;
end;

procedure TDXSpotOverlay.SetMaxRows(V: Integer);
begin
  V := EnsureRange(V, 1, DXSPOT_MAX_ROWS);
  if V = FMaxRows then Exit;
  FMaxRows := V;
  FBandH   := FRowH * FMaxRows + 4;
  FCacheDirty := True;
end;

procedure TDXSpotOverlay.TickAge;
begin
  Inc(FAgeTick);
end;

procedure TDXSpotOverlay.Invalidate;
begin
  FCacheDirty := True;
end;

function TDXSpotOverlay.Active: Boolean;
begin
  Result := FEnabled and (FStore <> nil);
end;

function TDXSpotOverlay.FreqToX(FreqHz: Double; W: Integer): Integer;
begin
  if FSpanHz <= 0 then Result := -1
  else Result := Round((FreqHz - (FCenterFreq - FSpanHz / 2)) / FSpanHz * W);
end;

function TDXSpotOverlay.AgeColor(const S: TDXSpot): TColor;
// Свежий → CLR_FRESH, к концу окна TTL плавно уходит в CLR_STALE. Свой
// позывной выделен цветом (и тоже гаснет — иначе старый спот кричал бы
// громче свежих). TTL берётся из FLayoutTTL: он посчитан один раз на
// раскладку, чтобы не дёргать лок стора на каждый спот.
var
  AgeMin, K: Integer;
  Base: TColor;
begin
  Base := CLR_FRESH[FLightTheme];
  if (FOwnCall <> '') and SameText(S.Call, FOwnCall) then
    Base := CLR_OWN[FLightTheme];
  if FLayoutTTL <= 0 then Exit(Base);
  AgeMin := Round((Now - S.Stamp) * 24 * 60);
  K := EnsureRange(AgeMin * 100 div Max(FLayoutTTL, 1), 0, 100);
  Result := Mix(Base, CLR_STALE[FLightTheme], K, 100);
end;

{ ── Раскладка лесенки ────────────────────────────────────────────────────── }

procedure TDXSpotOverlay.Layout(C: TCanvas; W: Integer);
// Споты приходят из стора отсортированными по частоте; каждому даём ПЕРВЫЙ
// ряд сверху, где подпись не наезжает на предыдущую. Не нашлось ряда —
// спот скрыт (считаем в FHidden), в лесенке дырок не оставляем.
var
  Arr: TDXSpotArray;
  N, i, r, TW, ChipW, ChipX, Row: Integer;
  RowRight: array[0..DXSPOT_MAX_ROWS-1] of Integer;
  LoHz, HiHz: Double;
begin
  FItemCount := 0;
  FHidden    := 0;
  if (FStore = nil) or (FSpanHz <= 0) or (W <= 0) then Exit;

  // Горизонт затухания: явный фильтр по возрасту, иначе TTL стора (чтение
  // под локом — поэтому один раз на раскладку, а не на каждый спот).
  FLayoutTTL := FMaxAgeMin;
  if FLayoutTTL <= 0 then FLayoutTTL := FStore.TTLMinutes;

  LoHz := FCenterFreq - FSpanHz / 2;
  HiHz := FCenterFreq + FSpanHz / 2;
  N := FStore.SnapshotRange(LoHz, HiHz, FModes, FMaxAgeMin, Arr);
  if N = 0 then Exit;

  for r := 0 to FMaxRows - 1 do RowRight[r] := -CHIP_GAP - 1;
  SetLength(FItems, N);

  for i := 0 to N - 1 do
  begin
    TW    := C.TextWidth(Arr[i].Call);
    ChipW := TW + CHIP_PAD_X * 2;
    ChipX := FreqToX(Arr[i].FreqHz, W) - ChipW div 2;
    if ChipX < 0 then ChipX := 0;
    if ChipX + ChipW > W then ChipX := W - ChipW;
    if ChipX < 0 then Continue;               // подпись шире окна — не рисуем

    Row := -1;
    for r := 0 to FMaxRows - 1 do
      if ChipX > RowRight[r] + CHIP_GAP then
      begin
        Row := r;
        Break;
      end;
    if Row < 0 then
    begin
      Inc(FHidden);
      Continue;
    end;
    RowRight[Row] := ChipX + ChipW;

    FItems[FItemCount].X     := FreqToX(Arr[i].FreqHz, W);
    FItems[FItemCount].Chip  := Rect(ChipX, Row * FRowH + 2,
                                     ChipX + ChipW, Row * FRowH + FRowH);
    FItems[FItemCount].Color := AgeColor(Arr[i]);
    FItems[FItemCount].Spot  := Arr[i];
    Inc(FItemCount);
  end;
  SetLength(FItems, FItemCount);
end;

procedure TDXSpotOverlay.DrawSelf(C: TCanvas; W: Integer);
// Рендер полосы подписей в канвас W × FBandH. Фон — KEY_COLOR (прозрачный
// при композите и в GL-текстуре).
var
  i: Integer;
  R: TRect;
  Col: TColor;
begin
  C.Brush.Color := KEY_COLOR;
  C.Brush.Style := bsSolid;
  C.Pen.Style   := psClear;
  C.FillRect(Rect(0, 0, W, FBandH));

  // Шрифт привязан к высоте ряда (а не к point-size) — подпись влезает при
  // любом DPI-масштабе, как в бэндплане.
  C.Font.Name   := 'Courier New';
  C.Font.Style  := [fsBold];
  C.Font.Height := -Max(8, Round(FRowH * 0.62));

  Layout(C, W);

  for i := 0 to FItemCount - 1 do
  begin
    R   := FItems[i].Chip;
    Col := FItems[i].Color;

    // Штрих от низа чипа до низа полосы (дальше его продолжает вызывающая
    // сторона по TickCount/Tick — уже прямо в кадре).
    if (FItems[i].X >= 0) and (FItems[i].X < W) then
    begin
      C.Pen.Style := psSolid; C.Pen.Color := Col; C.Pen.Width := 1;
      C.MoveTo(FItems[i].X, R.Bottom);
      C.LineTo(FItems[i].X, FBandH);
    end;

    // Чип: тёмная подложка + кромка цветом спота + позывной.
    C.Brush.Color := CLR_CHIP_BG[FLightTheme]; C.Brush.Style := bsSolid;
    C.Pen.Style := psSolid; C.Pen.Color := Col; C.Pen.Width := 1;
    C.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

    C.Brush.Style := bsClear;
    C.Font.Color  := CLR_CHIP_TEXT[FLightTheme];
    C.TextOut(R.Left + CHIP_PAD_X,
              R.Top + (R.Bottom - R.Top - C.TextHeight('W')) div 2,
              FItems[i].Spot.Call);
  end;
  C.Pen.Style := psSolid;
end;

{ ── Кэш ──────────────────────────────────────────────────────────────────── }

function TDXSpotOverlay.NeedsRebuild(W: Integer): Boolean;
var HalfPxHz: Double;
begin
  if FStore = nil then Exit(False);
  // Порог по центру/спану — полпикселя (как в бэндплане): суб-пиксельный
  // дрейф центра при QO-100 decoder-lock не должен гонять полную пересборку.
  HalfPxHz := 0.5 * FSpanHz / Max(W, 1);
  if HalfPxHz < 1.0 then HalfPxHz := 1.0;
  Result := FCacheDirty or (FCacheW <> W) or (FKeyW <> W)
            or (FKeyEnabled <> FEnabled)
            or (FKeyVersion <> FStore.Version)
            or (FKeyLight <> FLightTheme)
            or (FKeyRows <> FMaxRows)
            or (FKeyAgeTick <> FAgeTick)
            or (Abs(FKeyCenter - FCenterFreq) >= HalfPxHz)
            or (Abs(FKeySpan - FSpanHz) >= HalfPxHz);
end;

procedure TDXSpotOverlay.RebuildCache(W: Integer);
begin
  if (W <= 0) or (FStore = nil) then
  begin
    FCacheW := 0; FCacheDirty := False; FItemCount := 0;
    Inc(FRenderVer);
    Exit;
  end;
  if (FCache.Width <> W) or (FCache.Height <> FBandH) then
    FCache.SetSize(W, FBandH);
  DrawSelf(FCache.Canvas, W);
  Inc(FRenderVer);
  FCacheW     := W;
  FKeyCenter  := FCenterFreq;
  FKeySpan    := FSpanHz;
  FKeyW       := W;
  FKeyEnabled := FEnabled;
  FKeyVersion := FStore.Version;
  FKeyLight   := FLightTheme;
  FKeyRows    := FMaxRows;
  FKeyAgeTick := FAgeTick;
  FCacheDirty := False;
end;

{ ── Рисование ────────────────────────────────────────────────────────────── }

procedure TDXSpotOverlay.EnsureRendered(W: Integer);
begin
  if (not Active) or (W <= 0) then Exit;
  if NeedsRebuild(W) then RebuildCache(W);
end;

procedure TDXSpotOverlay.DrawOverlay(Target: TBitmap; W, H: Integer);
begin
  if (not Active) or (Target = nil) or (W <= 0) or (H <= FBandH) then Exit;
  EnsureRendered(W);
  if FCacheW <= 0 then Exit;
  BlendBitmapKey(Target, FCache, 0, 0, DXSPOT_ALPHA);
end;

procedure TDXSpotOverlay.DrawOverlayBitmap(Target: TBitmap; W: Integer);
begin
  if (Target = nil) or (W <= 0) then Exit;
  // Раскладка/список штрихов должны быть свежими и в GL-пути.
  EnsureRendered(W);
  Target.PixelFormat := pf32bit;
  Target.SetSize(W, FBandH);
  Target.Canvas.Draw(0, 0, FCache);
end;

function TDXSpotOverlay.TickCount: Integer;
begin
  if not Active then Result := 0 else Result := FItemCount;
end;

procedure TDXSpotOverlay.Tick(Idx: Integer; out X: Integer; out Color: TColor);
begin
  if (Idx < 0) or (Idx >= FItemCount) then
  begin
    X := -1; Color := clNone;
    Exit;
  end;
  X     := FItems[Idx].X;
  Color := FItems[Idx].Color;
end;

function TDXSpotOverlay.SpotAtPixel(X, Y: Integer; out Spot: TDXSpot): Boolean;
// Хит только по полосе подписей: ниже неё живут тюнинг/маркеры/слайсы, и
// перехватывать там клик было бы поперёк привычного поведения спектра.
var i: Integer;
begin
  Result := False;
  if (not Active) or (Y < 0) or (Y > FBandH) then Exit;
  for i := 0 to FItemCount - 1 do
    if (X >= FItems[i].Chip.Left - 2) and (X <= FItems[i].Chip.Right + 2) and
       (Y >= FItems[i].Chip.Top - 2)  and (Y <= FItems[i].Chip.Bottom + 2) then
    begin
      Spot := FItems[i].Spot;
      Exit(True);
    end;
end;

end.