unit WaterfallView; { WaterfallView.pas — рендеринг водопада. TWaterfallView — изолированный класс, не зависит от SpectrumView. } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, LCLIntf, LCLType, AppTheme; const // Максимум точек строки водопада; держать в синхроне с // WDSPEngine.SPECTRUM_PIXELS. WF_MAX_PIXELS = 4096; // Палитры водопада (индексы совпадают с настройкой wf_palette) WF_PAL_CLASSIC = 0; // Thetis enhanced (тёмная) / пастельная (светлая тема) WF_PAL_INFERNO = 1; WF_PAL_TURBO = 2; type TWaterfallView = class protected FWaterfallBitmap: TBitmap; FWfBitmap: TBitmap; FWfBitmapW: Integer; FWfBitmapH: Integer; FWfRowBuf: array of LongWord; // одна строка (новейшая), нативный порядок FWfHead: Integer; // физ. строка bitmap с новейшей линией FWfLut: array[0..511] of LongWord; // нативный порядок байт (CPU bitmap) FWfLutARGB: array[0..511] of LongWord; // логический $AARRGGBB (GL-путь) FWfLutLow: Double; FWfLutHigh: Double; FWfLutLight: Boolean; FWfLutPalette: Integer; FWfLutGamma: Double; FWfPalette: Integer; FWfGamma: Double; FWaterfallBuf: array[0..WF_MAX_PIXELS-1] of Single; FWaterfallBufCount: Integer; FWaterfallDirty: Boolean; FWfFrameCounter: Integer; FWfFrameInterval: Integer; FWfAGCEnabled: Boolean; FWfNFEnabled: Boolean; FWfManualHigh: Double; FWfManualLow: Double; FWfAGCOffset: Double; FWfHigh: Double; FWfLow: Double; FCenterFreq: Double; FSpanHz: Double; FTXMode: Boolean; FTXFreq: Double; FTXSpanHz: Double; FMarkerActive: Boolean; FMarkerX: Integer; FTheme: TAppTheme; FLightTheme: Boolean; FPbWaterfall: TControl; procedure DrawMarkerLine(C: TCanvas; W, H: Integer); procedure BuildWfLut(WfLow, WfHigh: Double); function LutNeedsRebuild(WfLow, WfHigh: Double): Boolean; function PaletteColor(T: Double): LongWord; // t∈[0..1] → $AARRGGBB procedure SetWfPalette(V: Integer); procedure SetWfGamma(V: Double); procedure UpdateAutoLevels; // гистограммный AGC → FWfLow/FWfHigh procedure GetEffectiveLevels(out Lo, Hi: Double); public constructor Create; destructor Destroy; override; property CenterFreq: Double read FCenterFreq write FCenterFreq; property SpanHz: Double read FSpanHz write FSpanHz; property TXMode: Boolean read FTXMode write FTXMode; property TXFreq: Double read FTXFreq write FTXFreq; property TXSpanHz: Double read FTXSpanHz write FTXSpanHz; property WfAGCEnabled: Boolean read FWfAGCEnabled write FWfAGCEnabled; property WfNFEnabled: Boolean read FWfNFEnabled write FWfNFEnabled; property WfManualHigh: Double read FWfManualHigh write FWfManualHigh; property WfManualLow: Double read FWfManualLow write FWfManualLow; property WfAGCOffset: Double read FWfAGCOffset write FWfAGCOffset; property WaterfallDirty: Boolean read FWaterfallDirty write FWaterfallDirty; property WfFrameInterval: Integer read FWfFrameInterval write FWfFrameInterval; property MarkerActive: Boolean read FMarkerActive write FMarkerActive; property MarkerX: Integer read FMarkerX write FMarkerX; property PbWaterfall: TControl write FPbWaterfall; property WfPalette: Integer read FWfPalette write SetWfPalette; property WfGamma: Double read FWfGamma write SetWfGamma; procedure SetWaterfallData(const Pixels: array of Single; Count: Integer); virtual; procedure DrawWaterfall; virtual; procedure PaintWaterfall(Sender: TObject); virtual; procedure SetWaterfallBitmapSize(W, H: Integer); virtual; procedure ResetWfAvgBuf; virtual; procedure ResetWfBuf; virtual; procedure SetTheme(const T: TAppTheme); virtual; end; implementation // ════════════════════════════════════════════════════════════════════════════ // Вспомогательные функции // ════════════════════════════════════════════════════════════════════════════ function FormatFreqWF(Hz: Double): string; var Mhz: Int64; KHz, Rest: Integer; begin Mhz := Trunc(Hz / 1000000); KHz := Trunc((Hz - Mhz * 1000000) / 1000); Rest := Trunc(Hz) mod 1000; Result := Format('%d.%3.3d.%3.3d', [Mhz, KHz, Rest]); end; // Классическая тёмная палитра (Thetis enhanced), T∈[0..1] function ClassicDarkColor(T: Double): LongWord; var Local: Double; R, G, B: Integer; begin if T <= 0.0 then begin Result := $FF000000; Exit; end; if T >= 1.0 then begin Result := ($FF shl 24) or (255 shl 16) or (124 shl 8) or 192; Exit; end; if T < (2.0 / 9.0) then begin Local := T / (2.0/9.0); R := 0; G := 0; B := Round(Local * 255.0); end else if T < (3.0 / 9.0) then begin Local := (T - 2.0/9.0) / (1.0/9.0); R := 0; G := Round(Local*255.0); B := 255; end else if T < (4.0 / 9.0) then begin Local := (T - 3.0/9.0) / (1.0/9.0); R := 0; G := 255; B := Round((1.0-Local)*255.0); end else if T < (5.0 / 9.0) then begin Local := (T - 4.0/9.0) / (1.0/9.0); R := Round(Local*255.0); G := 255; B := 0; end else if T < (7.0 / 9.0) then begin Local := (T - 5.0/9.0) / (2.0/9.0); R := 255; G := Round((1.0-Local)*255.0); B := 0; end else if T < (8.0 / 9.0) then begin Local := (T - 7.0/9.0) / (1.0/9.0); R := 255; G := 0; B := Round(Local*255.0); end else begin Local := (T - 8.0/9.0) / (1.0/9.0); R := Round((0.75 + 0.25 * (1.0 - Local)) * 255.0); G := Round(Local * 255.0 * 0.5); B := 255; end; R := EnsureRange(R, 0, 255); G := EnsureRange(G, 0, 255); B := EnsureRange(B, 0, 255); Result := ($FF shl 24) or (R shl 16) or (G shl 8) or B; end; // Линейная интерполяция по таблице стопов, T∈[0..1] function GradientColor(const SR, SG, SB: array of Integer; T: Double): LongWord; var F: Double; Seg, N, R, G, B: Integer; begin N := Length(SR); if T <= 0.0 then begin Result := ($FF shl 24) or (SR[0] shl 16) or (SG[0] shl 8) or SB[0]; Exit; end; if T >= 1.0 then begin Result := ($FF shl 24) or (SR[N-1] shl 16) or (SG[N-1] shl 8) or SB[N-1]; Exit; end; F := T * (N - 1); Seg := Min(N - 2, Trunc(F)); F := F - Seg; R := EnsureRange(Round(SR[Seg] * (1.0 - F) + SR[Seg+1] * F), 0, 255); G := EnsureRange(Round(SG[Seg] * (1.0 - F) + SG[Seg+1] * F), 0, 255); B := EnsureRange(Round(SB[Seg] * (1.0 - F) + SB[Seg+1] * F), 0, 255); Result := ($FF shl 24) or (R shl 16) or (G shl 8) or B; end; const // Классическая палитра светлой темы (пастель, фон E0E6E8) LIGHT_R: array[0..7] of Integer = (224, 160, 20, 0, 0, 220, 255, 255); LIGHT_G: array[0..7] of Integer = (230, 185, 80, 185, 200, 210, 90, 20); LIGHT_B: array[0..7] of Integer = (232, 210, 200, 210, 80, 0, 0, 20); // Inferno (matplotlib), перцептуально-равномерная, 11 опорных точек INF_R: array[0..10] of Integer = ( 0, 22, 66, 106, 147, 188, 221, 243, 252, 246, 252); INF_G: array[0..10] of Integer = ( 0, 11, 10, 23, 38, 55, 81, 120, 165, 215, 255); INF_B: array[0..10] of Integer = ( 4, 57, 104, 110, 103, 84, 58, 25, 10, 70, 164); // Turbo (Google), улучшенный jet без артефактов яркости, 9 опорных точек TRB_R: array[0..8] of Integer = ( 48, 70, 24, 97, 164, 249, 247, 202, 122); TRB_G: array[0..8] of Integer = ( 18, 118, 221, 252, 252, 163, 94, 33, 4); TRB_B: array[0..8] of Integer = ( 59, 232, 194, 108, 60, 63, 33, 6, 3); // Преобразует логический $AARRGGBB в нативный для ScanLine порядок байт. // DARWIN (Cocoa): в памяти [A,R,G,B]; прочие (Qt6/Win32): [B,G,R,A]. // Платформы little-endian, поэтому байт 0 — младший байт LongWord. function NativePixel(ARGB: LongWord): LongWord; inline; {$IFDEF DARWIN} begin Result := (ARGB shr 24) // A → байт 0 or (((ARGB shr 16) and $FF) shl 8) // R → байт 1 or (((ARGB shr 8) and $FF) shl 16) // G → байт 2 or ((ARGB and $FF) shl 24); // B → байт 3 end; {$ELSE} begin Result := ARGB; // $AARRGGBB на LE уже даёт в памяти [B,G,R,A] end; {$ENDIF} // ════════════════════════════════════════════════════════════════════════════ // TWaterfallView // ════════════════════════════════════════════════════════════════════════════ constructor TWaterfallView.Create; begin inherited Create; FWaterfallBitmap := TBitmap.Create; FWfBitmap := TBitmap.Create; FWfBitmap.PixelFormat := pf32bit; FWfBitmapW := 0; FWfBitmapH := 0; FWfManualHigh := -80.0; FWfManualLow := -130.0; FWfAGCOffset := 0.0; FWfHigh := -80.0; FWfLow := -130.0; FWfAGCEnabled := True; FWfNFEnabled := False; FWaterfallBufCount := 1024; FWfFrameInterval := 2; FWfFrameCounter := 0; FWaterfallDirty := True; FTheme := DarkTheme; FLightTheme := False; FSpanHz := 192000; FWfPalette := WF_PAL_CLASSIC; FWfGamma := 1.0; FWfLutLow := 1.0; // невалидно → LUT перестроится при первом кадре FWfLutHigh := 0.0; FWfLutLight := False; FWfLutPalette := -1; FWfLutGamma := 0.0; ResetWfBuf; end; destructor TWaterfallView.Destroy; begin FWaterfallBitmap.Free; FWfBitmap.Free; inherited; end; procedure TWaterfallView.SetTheme(const T: TAppTheme); begin FTheme := T; FLightTheme := T.BG > TColor($00808080); FWaterfallDirty := True; // Сброс размера — чтобы следующий кадр перезаполнил фон новой темой FWfBitmapW := 0; FWfBitmapH := 0; FWfLutLow := 1.0; // невалидно → LUT перестроится FWfLutHigh := 0.0; SetLength(FWfRowBuf, 0); FWfHead := 0; end; procedure TWaterfallView.ResetWfAvgBuf; begin FWfHigh := FWfManualHigh; FWfLow := FWfManualLow; FWaterfallDirty := True; end; procedure TWaterfallView.ResetWfBuf; var i: Integer; begin for i := 0 to High(FWaterfallBuf) do FWaterfallBuf[i] := -130.0; FWfHigh := FWfManualHigh; FWfLow := FWfManualLow; FWaterfallDirty := True; end; procedure TWaterfallView.SetWfPalette(V: Integer); begin V := EnsureRange(V, WF_PAL_CLASSIC, WF_PAL_TURBO); if V = FWfPalette then Exit; FWfPalette := V; FWfLutPalette := -1; // LUT перестроится на следующем кадре FWaterfallDirty := True; end; procedure TWaterfallView.SetWfGamma(V: Double); begin V := EnsureRange(V, 0.3, 3.0); if Abs(V - FWfGamma) < 1E-6 then Exit; FWfGamma := V; FWfLutGamma := 0.0; // LUT перестроится на следующем кадре FWaterfallDirty := True; end; procedure TWaterfallView.SetWaterfallData(const Pixels: array of Single; Count: Integer); var i, N: Integer; begin N := Min(Count, WF_MAX_PIXELS); // Замедление (WfFrameInterval>1) накапливает кадры max-hold'ом, а не // выбрасывает их — короткие посылки (CW) не выпадают из строки. if (FWfFrameCounter = 0) or (N <> FWaterfallBufCount) then for i := 0 to N - 1 do FWaterfallBuf[i] := Pixels[i] else for i := 0 to N - 1 do if Pixels[i] > FWaterfallBuf[i] then FWaterfallBuf[i] := Pixels[i]; FWaterfallBufCount := N; Inc(FWfFrameCounter); if FWfFrameCounter >= Max(1, FWfFrameInterval) then begin FWfFrameCounter := 0; FWaterfallDirty := True; end; end; procedure TWaterfallView.SetWaterfallBitmapSize(W, H: Integer); begin FWaterfallBitmap.SetSize(W, H); FWfBitmapW := 0; FWfBitmapH := 0; SetLength(FWfRowBuf, 0); FWfHead := 0; end; procedure TWaterfallView.DrawMarkerLine(C: TCanvas; W, H: Integer); var MX: Integer; MarkerFreq: Double; MarkerLbl: string; begin MX := Round(FMarkerX / 1000.0 * W); if (MX < 0) or (MX >= W) then Exit; MarkerFreq := (FCenterFreq - FSpanHz / 2) + FMarkerX / 1000.0 * FSpanHz; MarkerLbl := FormatFreqWF(Round(MarkerFreq)); C.Pen.Color := TColor($004444FF); C.Pen.Width := 1; C.Pen.Style := psSolid; C.MoveTo(MX, 0); C.LineTo(MX, H); C.Font.Color := TColor($004444FF); C.Font.Size := 7; C.Font.Name := 'Courier New'; if MX + 4 + C.TextWidth(MarkerLbl) < W then C.TextOut(MX + 4, 4, MarkerLbl) else C.TextOut(MX - 4 - C.TextWidth(MarkerLbl), 4, MarkerLbl); end; // Цвет палитры для нормированного уровня T∈[0..1] (без гаммы — она в LUT) function TWaterfallView.PaletteColor(T: Double): LongWord; begin case FWfPalette of WF_PAL_INFERNO: Result := GradientColor(INF_R, INF_G, INF_B, T); WF_PAL_TURBO: Result := GradientColor(TRB_R, TRB_G, TRB_B, T); else if FLightTheme then Result := GradientColor(LIGHT_R, LIGHT_G, LIGHT_B, T) else Result := ClassicDarkColor(T); end; end; function TWaterfallView.LutNeedsRebuild(WfLow, WfHigh: Double): Boolean; begin Result := (FWfLutLight <> FLightTheme) or (FWfLutPalette <> FWfPalette) or (Abs(FWfLutGamma - FWfGamma) > 1E-6) or (Abs(WfLow - FWfLutLow) > 0.05) or (Abs(WfHigh - FWfLutHigh) > 0.05); end; // Перестраивает палитру dB→цвет (512 точек) один раз на кадр вместо // вычисления цвета с плавающей точкой на каждый пиксель. procedure TWaterfallView.BuildWfLut(WfLow, WfHigh: Double); var i: Integer; T: Double; C: LongWord; begin for i := 0 to High(FWfLut) do begin T := i / High(FWfLut); // Гамма <1 вытягивает слабые сигналы из шума, >1 притемняет if Abs(FWfGamma - 1.0) > 1E-6 then T := Power(T, FWfGamma); C := PaletteColor(T); FWfLutARGB[i] := C; FWfLut[i] := NativePixel(C); end; FWfLutLow := WfLow; FWfLutHigh := WfHigh; FWfLutLight := FLightTheme; FWfLutPalette := FWfPalette; FWfLutGamma := FWfGamma; end; // Гистограммный AGC: оценивает шумовой пол (30-й перцентиль) и верх сигналов // (98-й), плавно подтягивает FWfLow/FWfHigh. Общий для CPU- и GL-пути. procedure TWaterfallView.UpdateAutoLevels; var X, SrcCount, LowTargetCount, HighTargetCount, CumCount, HistIdx: Integer; Hist: array[0..191] of Integer; HistMinDB, HistStepDB, NoiseFloorDB, SignalTopDB: Double; TargetLow, TargetHigh: Double; const ALPHA_HIGH = 0.10; ALPHA_LOW = 0.08; WF_AUTO_OFFSET = -4.0; WF_MIN_RANGE = 48.0; WF_MAX_RANGE = 62.0; HIST_MAX_DB = 22.0; begin if not FWfAGCEnabled then Exit; SrcCount := EnsureRange(FWaterfallBufCount, 2, WF_MAX_PIXELS); FillChar(Hist, SizeOf(Hist), 0); HistMinDB := -170.0; HistStepDB := (HIST_MAX_DB - HistMinDB) / Length(Hist); for X := 0 to SrcCount - 1 do begin HistIdx := EnsureRange(Trunc((FWaterfallBuf[X] - HistMinDB) / HistStepDB), 0, High(Hist)); Inc(Hist[HistIdx]); end; LowTargetCount := Round(SrcCount * 0.30); HighTargetCount := Round(SrcCount * 0.98); CumCount := 0; NoiseFloorDB := FWfLow; SignalTopDB := FWfHigh; for HistIdx := 0 to High(Hist) do begin Inc(CumCount, Hist[HistIdx]); if CumCount >= LowTargetCount then begin NoiseFloorDB := HistMinDB + (HistIdx + 0.5) * HistStepDB; Break; end; end; CumCount := 0; for HistIdx := 0 to High(Hist) do begin Inc(CumCount, Hist[HistIdx]); if CumCount >= HighTargetCount then begin SignalTopDB := HistMinDB + (HistIdx + 0.5) * HistStepDB; Break; end; end; TargetLow := NoiseFloorDB + WF_AUTO_OFFSET + FWfAGCOffset; if FWfNFEnabled then TargetHigh := Max(TargetLow + WF_MIN_RANGE, SignalTopDB + 6.0) else TargetHigh := TargetLow + 52.0; if TargetHigh > TargetLow + WF_MAX_RANGE then TargetHigh := TargetLow + WF_MAX_RANGE; FWfLow := FWfLow + ALPHA_LOW * (TargetLow - FWfLow); FWfHigh := FWfHigh + ALPHA_HIGH * (TargetHigh - FWfHigh); end; procedure TWaterfallView.GetEffectiveLevels(out Lo, Hi: Double); begin if FWfAGCEnabled then begin Lo := FWfLow; Hi := FWfHigh; end else begin Lo := FWfManualLow; Hi := FWfManualHigh; end; if Hi < Lo + 40.0 then Hi := Lo + 40.0; if Hi > 0.0 then Hi := 0.0; if Lo < -160 then Lo := -160; end; // ──────────────────────────────────────────────────────────────────────────── // DrawWaterfall // ──────────────────────────────────────────────────────────────────────────── procedure TWaterfallView.DrawWaterfall; var W, H, X: Integer; dB, frac, WatSrcF: Double; WatS0, WatS1: Integer; WfHigh, WfLow, LutScale, Step: Double; Row, Idx: Integer; RowPtr: PByte; Pal: LongWord; SrcCount: Integer; begin if FWaterfallBitmap = nil then Exit; W := FWaterfallBitmap.Width; H := FWaterfallBitmap.Height; if (W <= 0) or (H <= 0) then Exit; SrcCount := EnsureRange(FWaterfallBufCount, 2, WF_MAX_PIXELS); UpdateAutoLevels; GetEffectiveLevels(WfLow, WfHigh); LutScale := High(FWfLut) / (WfHigh - WfLow); // Палитра зависит только от WfLow/WfHigh/темы/палитры/гаммы — перестраиваем // лишь при ощутимом изменении (AGC сдвигает границы медленно). if LutNeedsRebuild(WfLow, WfHigh) then BuildWfLut(WfLow, WfHigh); if (FWfBitmapW <> W) or (FWfBitmapH <> H) then begin FWfBitmapW := W; FWfBitmapH := H; SetLength(FWfRowBuf, W); Pal := NativePixel($FF000000 or ((LongWord(FTheme.Panel) and $FF) shl 16) or (LongWord(FTheme.Panel) and $FF00) or ((LongWord(FTheme.Panel) shr 16) and $FF)); FillDWord(FWfRowBuf[0], W, Pal); FWfBitmap.SetSize(W, H); FWfHead := 0; // Заливаем всё кольцо фоном FWfBitmap.BeginUpdate(False); try for Row := 0 to H - 1 do begin RowPtr := PByte(FWfBitmap.ScanLine[Row]); if RowPtr <> nil then FillDWord(RowPtr^, W, Pal); end; finally FWfBitmap.EndUpdate(False); end; end; // Строим только новейшую строку в FWfRowBuf. В TX-режиме столбцы вне TX-полосы // НЕ трогаем — FWfRowBuf хранит предыдущую верхнюю строку, поэтому // «замороженные» участки остаются вертикально непрерывными, как и раньше. Step := (SrcCount - 1.0) / Max(1, W - 1); WatSrcF := 0.0; for X := 0 to W - 1 do begin if FTXMode and (FTXSpanHz > 0) and (FSpanHz > 0) then begin dB := FCenterFreq - FSpanHz * 0.5 + X * FSpanHz / Max(1, W - 1) - FTXFreq; if (dB < -FTXSpanHz * 0.5) or (dB > FTXSpanHz * 0.5) then begin WatSrcF := WatSrcF + Step; Continue; // оставляем FWfRowBuf[X] без изменений end; frac := (dB + FTXSpanHz * 0.5) / FTXSpanHz * (SrcCount - 1); WatS0 := Trunc(frac); if WatS0 > SrcCount - 2 then WatS0 := SrcCount - 2; WatS1 := WatS0 + 1; frac := frac - WatS0; dB := FWaterfallBuf[WatS0] * (1.0 - frac) + FWaterfallBuf[WatS1] * frac; end else begin WatS0 := Trunc(WatSrcF); if WatS0 > SrcCount - 2 then WatS0 := SrcCount - 2; WatS1 := WatS0 + 1; frac := WatSrcF - WatS0; dB := FWaterfallBuf[WatS0] * (1.0 - frac) + FWaterfallBuf[WatS1] * frac; end; Idx := Round((dB - WfLow) * LutScale); if Idx < 0 then Idx := 0 else if Idx > High(FWfLut) then Idx := High(FWfLut); FWfRowBuf[X] := FWfLut[Idx]; WatSrcF := WatSrcF + Step; end; // Кольцевой сдвиг: новая верхняя строка занимает слот выше предыдущей. // Полнокадровый Move изображения и полная перезаливка bitmap больше не нужны — // пишем единственную строку, а прокрутка делается в PaintWaterfall (CopyRect). FWfHead := (FWfHead - 1 + H) mod H; FWfBitmap.BeginUpdate(False); try RowPtr := PByte(FWfBitmap.ScanLine[FWfHead]); if RowPtr <> nil then Move(FWfRowBuf[0], RowPtr^, W * 4); finally FWfBitmap.EndUpdate(False); end; // Строка потреблена — иначе фронтенд (OnWaterfallReady) считал бы кадр // «несобранным» и дёргал перерисовку на каждый кадр анализатора. FWaterfallDirty := False; end; // ──────────────────────────────────────────────────────────────────────────── // PaintWaterfall // ──────────────────────────────────────────────────────────────────────────── procedure TWaterfallView.PaintWaterfall(Sender: TObject); var PB: TPaintBox; W, H, Top: Integer; begin PB := TPaintBox(Sender); W := PB.Width; H := PB.Height; if (W <= 0) or (H <= 0) then Exit; if (FWfBitmap <> nil) and (FWfBitmap.Width = W) and (FWfBitmap.Height = H) and (Length(FWfRowBuf) = W) then begin // Кольцевой буфер: дисплейная строка 0 = физ. строка FWfHead. // Верхний сегмент — строки FWfHead..H-1, нижний — 0..FWfHead-1. Top := H - FWfHead; PB.Canvas.CopyRect(Rect(0, 0, W, Top), FWfBitmap.Canvas, Rect(0, FWfHead, W, H)); if FWfHead > 0 then PB.Canvas.CopyRect(Rect(0, Top, W, H), FWfBitmap.Canvas, Rect(0, 0, W, FWfHead)); end else begin PB.Canvas.Brush.Color := FTheme.Panel; PB.Canvas.FillRect(Rect(0, 0, W, H)); end; if FMarkerActive then DrawMarkerLine(PB.Canvas, W, H); end; end.