ewsdr/BandPlanOverlay.pas

unit BandPlanOverlay;

{
  Оверлей бэндплана QO-100 (узкополосный транспондер) — тонкая цветная полоска
  вдоль оси частот ВНИЗУ спектра (над ruler) с подписями сегментов.

  Производительность — модель VfoOverlay: контент рендерится в кэш-битмап ОДИН раз
  и пересобирается только при смене вида (center/span/размер/тема/enabled), а каждый
  кадр идёт лишь композит полоски (W × STRIP_H) с постоянной альфой. Дорогих
  попиксельных проходов на кадр нет. GL-путь берёт тот же битмап текстурой
  (DrawOverlayBitmap) и заливает её только при dirty — одинаковый вид в CPU и GL,
  т.к. GL-UploadBitmap поддерживает color-key + постоянную альфу (как у VfoOverlay).

  Сегменты заданы таблицей в DOWNLINK-Гц (QO100_NB). Границы — по плану AMSAT-DL
  NB-транспондера; правятся в одном месте.
}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Controls, Graphics, Types, Math, Forms;

const
  BANDPLAN_STRIP_BASE_H = 20; // базовая высота полоски @96dpi (чуть больше ruler=18);
                              // фактическая FStripH масштабируется по DPI экрана
  BANDPLAN_ALPHA   = 188;    // глобальная альфа композита (0..255)

type
  // Тип сегмента → цвет. Правится таблицей SEG_COLOR ниже.
  TSegKind = (skBeacon, skCW, skSSB, skDigi, skNBDigi, skDV, skMixed);

  TBandSeg = record
    Lo, Hi: Double;     // downlink-Гц
    Name:   string;
    Kind:   TSegKind;
  end;

  TBandPlanOverlay = class(TComponent)
  private
    FCenterFreq: Double;
    FSpanHz:     Double;
    FEnabled:    Boolean;

    FCache:      TBitmap;     // W × STRIP_H, непрозрачный; альфа применяется при композите
    FCacheW:     Integer;
    FCacheDirty: Boolean;
    // ключ кэша — пересборка только при изменении
    FKeyCenter:  Double;
    FKeySpan:    Double;
    FKeyW:       Integer;
    FKeyEnabled: Boolean;
    FStripH:     Integer;    // фактическая высота полоски (px), масштаб по DPI

    function  FreqToX(FreqHz: Double; W: Integer): Integer;
    procedure DrawSelf(C: TCanvas; W: Integer);
    procedure RebuildCache(W: Integer);
    function  NeedsRebuild(W: Integer): Boolean;
    procedure CompositeStrip(Target: TBitmap; DstY: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    // Текущий вид спектра (downlink-домен). Дёргается при тюнинге/смене span.
    procedure SetView(ACenterHz, ASpanHz: Double);
    procedure SetEnabled(En: Boolean);
    function  Active: Boolean;
    // CPU-путь: композит полоски внизу Target (над ruler).
    procedure DrawOverlay(Target: TBitmap; W, H: Integer);
    // GL-путь: рендер полоски в Target-битмап (W × STRIP_H) для заливки текстурой.
    procedure DrawOverlayBitmap(Target: TBitmap; W: Integer);
    property Enabled: Boolean read FEnabled;
    property CenterFreq: Double read FCenterFreq;   // для GL-инвалидизации текстуры
    property SpanHz: Double read FSpanHz;
  end;

implementation

const
  // Палитра по типу сегмента (TColor = $00BBGGRR).
  SEG_COLOR: array[TSegKind] of TColor = (
    $005258C8,   // skBeacon — приглушённый красный (с прохладным оттенком палитры)
    $00C07820,   // skCW     — синий
    $002F9A3A,   // skSSB    — зелёный
    $00B0479E,   // skDigi   — фиолетовый (яркий)
    $00794A6E,   // skNBDigi — приглушённый фиолетовый (NB DIGI, тусклее DIGI)
    $009A9A20,   // skDV     — бирюзовый
    $00606060);  // skMixed  — серый

  CLR_STRIP_BG  = TColor($00181818);   // фон полоски вне транспондера
  CLR_STRIP_TOP = TColor($00585858);   // верхняя кромка (отделить от спектра)
  CLR_SEP       = TColor($000C0C0C);   // разделители сегментов
  CLR_LBL       = TColor($00F0F0F0);   // подписи

  // ── Бэндплан QO-100 NB-транспондера (DOWNLINK Гц) ────────────────────────────
  // Транспондер 10489.500–10490.000 (500 кГц). Mode-заливки между маяками; маяки —
  // отдельными ярко-янтарными ячейками на своих диапазонах. Границы правятся ЗДЕСЬ.
  QO100_NB: array[0..5] of TBandSeg = (
    (Lo: 10489505000.0; Hi: 10489540000.0; Name: 'CW ONLY';     Kind: skCW),
    (Lo: 10489540000.0; Hi: 10489580000.0; Name: 'NB DIGI';     Kind: skNBDigi),
    (Lo: 10489580000.0; Hi: 10489650000.0; Name: 'DIGI';        Kind: skDigi),
    (Lo: 10489650000.0; Hi: 10489745000.0; Name: 'SSB';         Kind: skSSB),
    (Lo: 10489755000.0; Hi: 10489850000.0; Name: 'SSB';         Kind: skSSB),
    (Lo: 10489850000.0; Hi: 10489990000.0; Name: 'MIXED MODES'; Kind: skDV));

  // Маяки QO-100 (диапазоны): нижний CW, средний PSK, верхний. Ярко-янтарные ячейки.
  QO100_BEACONS: array[0..2] of TBandSeg = (
    (Lo: 10489500000.0; Hi: 10489505000.0; Name: 'CW';  Kind: skBeacon),  // нижний CW-маяк
    (Lo: 10489745000.0; Hi: 10489755000.0; Name: 'PSK'; Kind: skBeacon),  // средний PSK-маяк
    (Lo: 10489990000.0; Hi: 10490000000.0; Name: 'EXP'; Kind: skBeacon)); // верхний эксп. маяк

function Darken(C: TColor; Num, Den: Integer): TColor;
var r, g, b: Integer;
begin
  r := (C and $FF) * Num div Den;
  g := ((C shr 8) and $FF) * Num div Den;
  b := ((C shr 16) and $FF) * Num div Den;
  Result := TColor((b shl 16) or (g shl 8) or r);
end;

constructor TBandPlanOverlay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // Высота полоски масштабируется по DPI экрана (как RULER_H в MainForm), иначе на
  // Windows-масштабе 125/150/200% полоска осталась бы фиксированно тонкой.
  FStripH := Round(BANDPLAN_STRIP_BASE_H * Screen.PixelsPerInch / 96);
  if FStripH < BANDPLAN_STRIP_BASE_H then FStripH := BANDPLAN_STRIP_BASE_H;
  FCenterFreq := 10489750000.0;
  FSpanHz     := 500000.0;
  FEnabled    := False;
  FCache      := TBitmap.Create;
  FCache.PixelFormat := pf32bit;
  FCacheW     := 0;
  FCacheDirty := True;
  FKeyCenter  := -1; FKeySpan := -1; FKeyW := -1; FKeyEnabled := False;
end;

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

procedure TBandPlanOverlay.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 TBandPlanOverlay.SetEnabled(En: Boolean);
begin
  if FEnabled = En then Exit;
  FEnabled := En;
  FCacheDirty := True;
end;

function TBandPlanOverlay.Active: Boolean;
begin
  Result := FEnabled;
end;

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

procedure TBandPlanOverlay.DrawSelf(C: TCanvas; W: Integer);
// Рендерит полоску в канвас битмапа W × FStripH, начало (0,0), НЕПРОЗРАЧНО.
// Прозрачность накладывается позже (CompositeStrip / GL FixedAlpha).
var
  i, ty, th, SH: Integer;

  // Единый стиль для всех ячеек (mode-сегменты И маяки): приглушённая заливка +
  // яркая кромка цвета сверху + разделитель слева + подпись по центру если влезает.
  procedure DrawSeg(const seg: TBandSeg);
  var x1, x2, cx, tw: Integer; col: TColor;
  begin
    x1 := FreqToX(seg.Lo, W);
    x2 := FreqToX(seg.Hi, W);
    if (x2 <= 0) or (x1 >= W) then Exit;       // вне экрана
    if x1 < 0 then x1 := 0;
    if x2 > W then x2 := W;
    if x2 <= x1 then x2 := x1 + 1;             // минимум 1px видимости (узкие маяки)

    col := SEG_COLOR[seg.Kind];
    C.Brush.Color := Darken(col, 3, 5); C.Brush.Style := bsSolid; C.Pen.Style := psClear;
    C.FillRect(Rect(x1, 1, x2, SH));
    C.Brush.Color := col;                      // яркая кромка-«легенда» сверху
    C.FillRect(Rect(x1, 1, x2, 3));

    C.Pen.Style := psSolid; C.Pen.Color := CLR_SEP; C.Pen.Width := 1;
    C.MoveTo(x1, 1); C.LineTo(x1, SH);

    tw := C.TextWidth(seg.Name);
    if (x2 - x1) >= tw + 6 then
    begin
      cx := x1 + ((x2 - x1) - tw) div 2;
      C.Brush.Style := bsClear; C.Font.Color := CLR_LBL;
      C.TextOut(cx, ty, seg.Name);
    end;
  end;

begin
  SH := FStripH;

  // Фон всей полоски (зона вне транспондера остаётся этим тёмным фоном).
  C.Brush.Color := CLR_STRIP_BG; C.Brush.Style := bsSolid; C.Pen.Style := psClear;
  C.FillRect(Rect(0, 0, W, SH));

  // Высота шрифта привязана к высоте полоски (а не point-size), поэтому текст
  // всегда влезает при любом DPI-масштабе Windows. Отриц. Height = glyph-px.
  C.Font.Name := 'Courier New'; C.Font.Style := [];
  C.Font.Height := -Max(8, Round(SH * 0.5));
  th := C.TextHeight('BCN');
  // Вертикальный центр под caps: +1 компенсирует пустой descent у заглавных.
  ty := (SH - th) div 2 + 1;
  if ty < 1 then ty := 1;

  // Mode-сегменты, затем маяки (поверх) — одинаковый стиль.
  for i := Low(QO100_NB) to High(QO100_NB) do DrawSeg(QO100_NB[i]);
  for i := Low(QO100_BEACONS) to High(QO100_BEACONS) do DrawSeg(QO100_BEACONS[i]);

  // Верхняя кромка полоски — отделить от спектра.
  C.Pen.Style := psSolid; C.Pen.Color := CLR_STRIP_TOP; C.Pen.Width := 1;
  C.MoveTo(0, 0); C.LineTo(W, 0);
  C.Pen.Style := psSolid;
end;

function TBandPlanOverlay.NeedsRebuild(W: Integer): Boolean;
var HalfPxHz: Double;
begin
  // Порог перестройки — ПОЛПИКСЕЛЯ, а не 1 Гц: суб-пиксельный сдвиг центра
  // не меняет картинку, а на QO-100 с decoder-lock центр подтюнивается
  // непрерывно — порог 1 Гц заставлял полный canvas-ребилд полоски (и
  // canvas<->raw флип её кэша) на каждом кадре (~1.2 мс/кадр впустую).
  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 (Abs(FKeyCenter - FCenterFreq) >= HalfPxHz)
            or (Abs(FKeySpan - FSpanHz) >= HalfPxHz);
end;

procedure TBandPlanOverlay.RebuildCache(W: Integer);
begin
  if W <= 0 then begin FCacheW := 0; FCacheDirty := False; Exit; end;
  if (FCache.Width <> W) or (FCache.Height <> FStripH) then
    FCache.SetSize(W, FStripH);
  DrawSelf(FCache.Canvas, W);
  FCacheW     := W;
  FKeyCenter  := FCenterFreq; FKeySpan := FSpanHz; FKeyW := W;
  FKeyEnabled := FEnabled;
  FCacheDirty := False;
end;

procedure TBandPlanOverlay.CompositeStrip(Target: TBitmap; DstY: Integer);
// Альфа-композит FCache поверх Target в (0, DstY) с постоянной BANDPLAN_ALPHA.
// Один проход по W × STRIP_H пикселей за кадр. Дворд-блендинг: два 16-битных
// лейна на умножение, деление /256 вместо /255 (расхождение <0.4%, глазом не
// видно) — побайтовый вариант с div 255 стоил ~1мс/кадр на полной ширине.
var
  X, Y, ty, N: Integer;
  A256, I256, S, D: LongWord;
  RS, RD: PLongWord;
begin
  if (Target = nil) or (FCacheW <= 0) then Exit;
  A256 := BANDPLAN_ALPHA + (BANDPLAN_ALPHA shr 7);   // 0..256
  I256 := 256 - A256;
  N := Min(FCacheW, Target.Width);
  Target.BeginUpdate(False);
  FCache.BeginUpdate(False);
  try
    for Y := 0 to FStripH - 1 do
    begin
      ty := DstY + Y;
      if (ty < 0) or (ty >= Target.Height) then Continue;
      RS := PLongWord(FCache.ScanLine[Y]);
      RD := PLongWord(Target.ScanLine[ty]);
      if (RS = nil) or (RD = nil) then Continue;
      for X := 0 to N - 1 do
      begin
        S := RS^; D := RD^;
        RD^ := ((((S and $00FF00FF) * A256 + (D and $00FF00FF) * I256) shr 8)
                 and $00FF00FF)
            or ((((S shr 8) and $00FF00FF) * A256 +
                 ((D shr 8) and $00FF00FF) * I256) and $FF00FF00)
{$IFDEF DARWIN}
            or $000000FF;   // ARGB: альфа в байте 0
{$ELSE}
            or $FF000000;   // BGRA: альфа в байте 3
{$ENDIF}
        Inc(RS); Inc(RD);
      end;
    end;
  finally
    FCache.EndUpdate(False);
    Target.EndUpdate(False);
  end;
end;

procedure TBandPlanOverlay.DrawOverlay(Target: TBitmap; W, H: Integer);
begin
  if (not FEnabled) or (Target = nil) or (W <= 0) or (H <= FStripH) then Exit;
  if NeedsRebuild(W) then RebuildCache(W);
  CompositeStrip(Target, H - FStripH);
end;

procedure TBandPlanOverlay.DrawOverlayBitmap(Target: TBitmap; W: Integer);
begin
  if (Target = nil) or (W <= 0) then Exit;
  Target.PixelFormat := pf32bit;
  Target.SetSize(W, FStripH);
  DrawSelf(Target.Canvas, W);
end;

end.