unit DXSpotOverlay; { Оверлей DX-спотов на спектре: позывной в «чипе» + вертикальный штрих к своей частоте. Пересекающиеся подписи раскладываются лесенкой по рядам сверху вниз. Производительность — ровно модель BandPlanOverlay/VfoOverlay, ничего нового: • Кэшируется ТОЛЬКО полоса подписей (W × FBandH, вверху спектра) в key-color битмап; пересборка идёт исключительно по dirty-ключу (версия стора / вид / ширина / тема / фильтры / тик затухания), а каждый кадр — один композит W × FBandH с постоянной альфой (BlendBitmapKey, тот же дворд-блендинг). Полноэкранный кэш W × H на кадр стоил бы в разы дороже — поэтому штрихи ниже полосы в кэш НЕ входят. • Версия стора глобальна, а окно у каждого пана своё, поэтому на смену версии сначала берётся снимок окна и сверяется его ПОДПИСЬ: спот, севший на чужой диапазон, до полосы подписей этого пана не доходит. Без этого каждый пан пересобирал бы кэш (и перезаливал GL-текстуру) на любой спот откуда угодно — цена, которая множится на число панов. • Штрихи от полосы до низа спектра рисует вызывающая сторона теми же примитивами, что и все прочие маркеры: 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; FKeyStamp: Int64; // подпись набора, по которому собран кэш FAgeTick: Int64; // бампается таймером UI — обновить затухание FRenderVer: Int64; // ++ на каждую пересборку кэша — ключ GL-текстуры FLayoutTTL: Integer; // горизонт затухания, снят один раз на раскладку // Снимок окна: берётся при смене вида/версии стора, живёт до пересборки — // подпись считается по нему же, второй раз стор не дёргаем. FArr: TDXSpotArray; FArrN: Integer; FArrStamp: Int64; FItems: array of TDXSpotItem; FItemCount: Integer; FHidden: Integer; // сколько спотов не влезло в лесенку function FreqToX(FreqHz: Double; W: Integer): Integer; function AgeColor(const S: TDXSpot): TColor; procedure TakeSnapshot; procedure Layout(C: TCanvas; W: Integer); procedure DrawSelf(C: TCanvas; W: Integer); procedure RebuildCache(W: Integer; Ver: Int64); function ViewKeysChanged(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; // минимальный зазор между чипами в одном ряду // Подпись видимого набора (FNV-1a 64). Базис — канонический $CBF29CE4…, // сложенный из половин: цельным литералом он не влезает в Int64, а // сравниваем мы подпись только сама с собой, так что важна лишь стабильность. FNV_BASIS_HI = QWord($CBF29CE4); FNV_BASIS_LO = QWord($84222325); FNV_PRIME: QWord = $00000100000001B3; 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; FKeyStamp := 0; FArrN := 0; FArrStamp := 0; 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.TakeSnapshot; // Снимок видимого окна + его подпись. Подпись складывает всё, от чего зависит // картинка полосы: позывной, частоту, моду и метку времени (она правит цвет // затухания и обновляется при пере-споте). Совпала с прошлой — пересобирать // нечего, какой бы ни стала версия стора. var i, k: Integer; H: QWord; LoHz, HiHz: Double; begin FArrN := 0; SetLength(FArr, 0); FArrStamp := 0; if (FStore = nil) or (FSpanHz <= 0) then Exit; // Горизонт затухания: явный фильтр по возрасту, иначе TTL стора (чтение // под локом — поэтому один раз на снимок, а не на каждый спот). FLayoutTTL := FMaxAgeMin; if FLayoutTTL <= 0 then FLayoutTTL := FStore.TTLMinutes; LoHz := FCenterFreq - FSpanHz / 2; HiHz := FCenterFreq + FSpanHz / 2; FArrN := FStore.SnapshotRange(LoHz, HiHz, FModes, FMaxAgeMin, FArr); H := (FNV_BASIS_HI shl 32) or FNV_BASIS_LO; // FNV-1a 64 for i := 0 to FArrN - 1 do begin for k := 1 to Length(FArr[i].Call) do H := (H xor QWord(Ord(FArr[i].Call[k]))) * FNV_PRIME; H := (H xor QWord(Round(FArr[i].FreqHz))) * FNV_PRIME; H := (H xor QWord(Ord(FArr[i].Mode))) * FNV_PRIME; H := (H xor QWord(Round(FArr[i].Stamp * 86400))) * FNV_PRIME; end; FArrStamp := Int64(H); end; procedure TDXSpotOverlay.Layout(C: TCanvas; W: Integer); // Споты приходят из стора отсортированными по частоте; каждому даём ПЕРВЫЙ // ряд сверху, где подпись не наезжает на предыдущую. Не нашлось ряда — // спот скрыт (считаем в FHidden), в лесенке дырок не оставляем. Работаем по // снимку FArr — его взял TakeSnapshot перед пересборкой. var N, i, r, TW, ChipW, ChipX, Row: Integer; RowRight: array[0..DXSPOT_MAX_ROWS-1] of Integer; begin FItemCount := 0; FHidden := 0; if (FStore = nil) or (FSpanHz <= 0) or (W <= 0) then Exit; N := FArrN; 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(FArr[i].Call); ChipW := TW + CHIP_PAD_X * 2; ChipX := FreqToX(FArr[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(FArr[i].FreqHz, W); FItems[FItemCount].Chip := Rect(ChipX, Row * FRowH + 2, ChipX + ChipW, Row * FRowH + FRowH); FItems[FItemCount].Color := AgeColor(FArr[i]); FItems[FItemCount].Spot := FArr[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.ViewKeysChanged(W: Integer): Boolean; // Всё, что делает картинку заведомо другой, КРОМЕ версии стора: её разбирает // EnsureRendered отдельно (версия глобальна, окно — наше). 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 (FKeyLight <> FLightTheme) or (FKeyRows <> FMaxRows) or (FKeyAgeTick <> FAgeTick) or (Abs(FKeyCenter - FCenterFreq) >= HalfPxHz) or (Abs(FKeySpan - FSpanHz) >= HalfPxHz); end; procedure TDXSpotOverlay.RebuildCache(W: Integer; Ver: Int64); // Снимок (TakeSnapshot) к этому моменту уже взят вызывающим — здесь только // рисование и запись ключей. 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 := Ver; FKeyStamp := FArrStamp; FKeyLight := FLightTheme; FKeyRows := FMaxRows; FKeyAgeTick := FAgeTick; FCacheDirty := False; end; { ── Рисование ────────────────────────────────────────────────────────────── } procedure TDXSpotOverlay.EnsureRendered(W: Integer); var Ver: Int64; begin if (not Active) or (W <= 0) then Exit; Ver := FStore.Version; if ViewKeysChanged(W) then begin TakeSnapshot; RebuildCache(W, Ver); Exit; end; if FKeyVersion = Ver then Exit; // в сторе с прошлого кадра ничего // Стор правили — но, может, не в нашем окне: снимок с подписью дешевле // пересборки полосы (и, в GL, перезаливки текстуры). Версию запоминаем в // любом случае: этот вопрос уже разобран. FKeyVersion := Ver; TakeSnapshot; if FArrStamp = FKeyStamp then Exit; RebuildCache(W, Ver); 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.