Files
ewsdr/WidebandView.pas
T
ew8bakandClaude Fable 5 0b4d126dac perf: zone CPU profiler (PerfLog) + phase-restructured CPU spectrum render
Инструментация (ВРЕМЕННАЯ, не мержить в main):
- PerfLog.pas: зонные таймеры, отчёт раз в 5с в stderr (core% = доля ядра),
  EWSDR_PERF=0 выкл, EWSDR_PERF_FILE=путь — дублировать в файл
- Замеры // PERF: сеть (DDC IQ/wideband), Pluto (rx_conv/tx_resamp/tx_fill),
  DSP (push_iq/fexchange/slices/tx), аудио, UI (тики/draw/paint/gl_swap,
  разбивка draw_spectrum по фазам)
- doc/PERF_PROFILING.md: карта зон, методика, выводы

Оптимизация CPU-рендера спектра (по результатам замеров на эфире):
диагноз — дорога не пиксельная работа, а чередование raw(ScanLine)/
canvas(QPainter) доступа к битмапу на Qt6 (~6 переходов за кадр, каждый
синкает весь битмап; полоса фильтра в тысячи пикселей стоила 4x дороже
полного memcpy кадра). DrawSpectrum перестроен в фазы calc->raw->canvas->raw
(2 перехода): FillBandRaw вместо Canvas.FillRect, DrawSliceFilterMarkers
разделён на raw-полосы + canvas-линии, композиты флагов и альфа-OR в
финальной raw-фазе. Кадр 8.3мс -> 6.1мс; spec_bands 1.87мс -> 0.03мс.
Альфа-OR проход на Qt6 подтверждён нужным (без него canvas-пиксели теряют
альфу и пропадают при блите), сам цикл ~0.08мс — оставлен; тумблер
EWSDR_ALPHA_FIX=0 только для экспериментов. Кисть перед AGC-подписями
теперь ставится явно (была остаточной после перестройки фаз).

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-02 22:07:36 +03:00

1148 lines
33 KiB
ObjectPascal

unit WidebandView;
{
WidebandView.pas - raw ADC wideband spectrum pane.
The network layer feeds 16-bit ADC samples collected from Protocol V4
wideband packets. This view feeds them to a dedicated WDSP analyzer and
renders a compact Thetis-style wideband panadapter. CPU paint uses a bitmap;
when MainForm creates a TOpenGLControl the same spectrum is rendered as GL
primitives.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, Graphics, Controls, ExtCtrls,
OpenGLContext, GL, AppTheme, WDSP,
PerfLog; // ВРЕМЕННО (perf/cpu-profiling): зонные CPU-таймеры
type
TWidebandView = class
private
FBitmap: TBitmap;
FLabelBitmap: TBitmap;
FRulerBitmap: TBitmap;
FTheme: TAppTheme;
FData: array of Single;
FPoints: array of TPoint;
FGLTex: GLuint;
FDirty: Boolean;
FGLBackgroundDirty: Boolean;
FSampleRateHz: Double;
FRefLevel: Double;
FRange: Double;
FCalOffset: Double;
FViewStartHz: Double;
FViewEndHz: Double;
FSourceStartHz: Double;
FSourceEndHz: Double;
FMarkerHz: Double;
FFillSpectrum: Boolean;
FWDSPAnalyzerOpen: Boolean;
FWDSPAnalyzerConfigured: Boolean;
FWDSPAnalyzerID: Integer;
FWDSPFlp: array[0..0] of Integer;
FWDSPIn: array of Double;
FWDSPPixels: array of Single;
procedure EnsureBitmap(W, H: Integer);
function EnsureWDSPAnalyzer: Boolean;
function ComputeSpectrumWDSP(const Samples: array of SmallInt;
Count: Integer): Boolean;
procedure CloseWDSPAnalyzer;
function BuildSpectrumPoints(PlotW, H: Integer): Boolean;
procedure DrawCPU(W, H: Integer; IncludeSpectrum: Boolean = True);
procedure PaintCPU(C: TCanvas);
procedure PaintGL(C: TOpenGLControl);
procedure ColorToGL(AColor: TColor; out R, G, B: GLFloat);
procedure DrawBackgroundGL(W, H, PlotW: Integer);
procedure DrawGridGL(W, H, PlotW: Integer);
procedure DrawSpectrumGL(PlotW, H: Integer);
procedure DrawHamBandGL(PlotW, H: Integer; F1, F2: Double; AColor: TColor);
procedure DrawHamBandsGL(PlotW, H: Integer);
function SourceFreqToBin(FreqHz: Double; BinCount: Integer): Integer;
function FreqToX(FreqHz: Double; W: Integer): Integer;
function GridStepHz(W: Integer): Double;
function RulerGridStepHz(C: TCanvas; PlotW: Integer): Double;
procedure PaintVerticalGradient(C: TCanvas; W, H: Integer; TopColor, BottomColor: TColor);
procedure AlphaFillRect(const R: TRect; AColor: TColor; Alpha: Byte);
procedure DrawHamBands(C: TCanvas; PlotW, H: Integer);
procedure DrawHamBand(C: TCanvas; PlotW, H: Integer; F1, F2: Double;
const Name: string; AColor: TColor);
procedure DrawFrequencyMarker(C: TCanvas; PlotW, H: Integer);
procedure DrawSpectrumGradient(const SpPts: array of TPoint; PlotW, H: Integer);
procedure DrawGLLabels(W, H, PlotW: Integer);
procedure UploadLabelTextureToGL;
procedure DrawLabelTextureGL(W, H: Integer);
public
constructor Create;
destructor Destroy; override;
procedure SetTheme(const T: TAppTheme);
procedure SetSampleRateHz(AHz: Double);
function SetFrequencyView(ViewStartHz, ViewEndHz, SourceStartHz,
SourceEndHz: Double): Boolean;
function SetMarkerHz(AHz: Double): Boolean;
procedure SetFillSpectrum(AFill: Boolean);
function TryPixelToFrequency(PixelX, PanelWidth: Integer;
out FreqHz: Double): Boolean;
procedure SetSamples(const Samples: array of SmallInt; Count: Integer);
procedure SetBitmapSize(W, H: Integer);
procedure SetRulerSize(W, H: Integer);
procedure Draw;
procedure DrawRuler;
procedure Paint(Sender: TObject);
procedure PaintRuler(Sender: TObject);
property Dirty: Boolean read FDirty write FDirty;
end;
implementation
const
WB_DB_SCALE_W = 34;
WB_WDSP_ID = 32;
WB_WDSP_FFT = 16384;
WB_WDSP_BLOCK = 512;
WB_WDSP_PIXELS = 4096;
constructor TWidebandView.Create;
begin
inherited Create;
FBitmap := TBitmap.Create;
FBitmap.PixelFormat := pf32bit;
FLabelBitmap := TBitmap.Create;
FLabelBitmap.PixelFormat := pf32bit;
FRulerBitmap := TBitmap.Create;
FRulerBitmap.PixelFormat := pf32bit;
FTheme := DarkTheme;
FSampleRateHz := 122880000.0;
FRefLevel := -50.0;
FRange := 120.0;
FCalOffset := -40.1;
FViewStartHz := 0.0;
FViewEndHz := FSampleRateHz * 0.5;
FSourceStartHz := 0.0;
FSourceEndHz := FSampleRateHz * 0.5;
FMarkerHz := 0.0;
FFillSpectrum := False;
FWDSPAnalyzerOpen := False;
FWDSPAnalyzerConfigured := False;
FWDSPAnalyzerID := WB_WDSP_ID;
FWDSPFlp[0] := 0;
SetLength(FWDSPIn, WB_WDSP_BLOCK * 2);
SetLength(FWDSPPixels, WB_WDSP_PIXELS);
FGLTex := 0;
FDirty := True;
FGLBackgroundDirty := True;
end;
destructor TWidebandView.Destroy;
begin
CloseWDSPAnalyzer;
if FGLTex <> 0 then
glDeleteTextures(1, @FGLTex);
FRulerBitmap.Free;
FLabelBitmap.Free;
FBitmap.Free;
inherited Destroy;
end;
procedure TWidebandView.SetTheme(const T: TAppTheme);
begin
FTheme := T;
FDirty := True;
FGLBackgroundDirty := True;
end;
procedure TWidebandView.SetSampleRateHz(AHz: Double);
begin
if AHz > 0 then
begin
FSampleRateHz := AHz;
FWDSPAnalyzerConfigured := False;
SetFrequencyView(0.0, FSampleRateHz * 0.5, 0.0, FSampleRateHz * 0.5);
end;
end;
function TWidebandView.SetFrequencyView(ViewStartHz, ViewEndHz, SourceStartHz,
SourceEndHz: Double): Boolean;
var
Nyq: Double;
T: Double;
begin
Result := False;
Nyq := FSampleRateHz * 0.5;
if Nyq <= 0.0 then Nyq := 61440000.0;
if ViewEndHz <= ViewStartHz then
begin
ViewStartHz := 0.0;
ViewEndHz := Nyq;
end;
if SourceEndHz < SourceStartHz then
begin
T := SourceStartHz;
SourceStartHz := SourceEndHz;
SourceEndHz := T;
end;
if (Abs(FViewStartHz - ViewStartHz) < 0.5) and
(Abs(FViewEndHz - ViewEndHz) < 0.5) and
(Abs(FSourceStartHz - SourceStartHz) < 0.5) and
(Abs(FSourceEndHz - SourceEndHz) < 0.5) then Exit;
FViewStartHz := ViewStartHz;
FViewEndHz := ViewEndHz;
FSourceStartHz := SourceStartHz;
FSourceEndHz := SourceEndHz;
FDirty := True;
FGLBackgroundDirty := True;
Result := True;
end;
function TWidebandView.SetMarkerHz(AHz: Double): Boolean;
begin
Result := False;
if Abs(FMarkerHz - AHz) < 0.5 then Exit;
FMarkerHz := AHz;
Result := True;
end;
procedure TWidebandView.SetFillSpectrum(AFill: Boolean);
begin
if FFillSpectrum = AFill then Exit;
FFillSpectrum := AFill;
FDirty := True;
end;
function TWidebandView.TryPixelToFrequency(PixelX, PanelWidth: Integer;
out FreqHz: Double): Boolean;
var
PlotW: Integer;
begin
Result := False;
FreqHz := 0.0;
PlotW := Max(1, PanelWidth - WB_DB_SCALE_W);
if (PanelWidth <= 0) or (PixelX < 0) or (PixelX >= PlotW) then Exit;
if FViewEndHz <= FViewStartHz then Exit;
FreqHz := FViewStartHz +
PixelX / Max(1, PlotW - 1) * (FViewEndHz - FViewStartHz);
Result := True;
end;
procedure TWidebandView.EnsureBitmap(W, H: Integer);
begin
W := Max(1, W);
H := Max(1, H);
if (FBitmap.Width <> W) or (FBitmap.Height <> H) then
begin
FBitmap.SetSize(W, H);
FGLBackgroundDirty := True;
end;
if (FLabelBitmap.Width <> W) or (FLabelBitmap.Height <> H) then
begin
FLabelBitmap.SetSize(W, H);
FGLBackgroundDirty := True;
end;
end;
procedure TWidebandView.SetBitmapSize(W, H: Integer);
begin
EnsureBitmap(W, H);
FDirty := True;
end;
procedure TWidebandView.SetRulerSize(W, H: Integer);
begin
W := Max(1, W);
H := Max(1, H);
if (FRulerBitmap.Width <> W) or (FRulerBitmap.Height <> H) then
FRulerBitmap.SetSize(W, H);
end;
procedure TWidebandView.CloseWDSPAnalyzer;
begin
if FWDSPAnalyzerOpen and Assigned(@DestroyAnalyzer) then
DestroyAnalyzer(FWDSPAnalyzerID);
FWDSPAnalyzerOpen := False;
FWDSPAnalyzerConfigured := False;
end;
function TWidebandView.EnsureWDSPAnalyzer: Boolean;
var
Success: Integer;
SampleRate: Integer;
AvBackmult: Double;
begin
Result := False;
if (not Assigned(@XCreateAnalyzer)) or (not Assigned(@SetAnalyzer)) or
(not Assigned(@Spectrum0)) or (not Assigned(@GetPixels)) then Exit;
if not FWDSPAnalyzerOpen then
begin
Success := -1;
XCreateAnalyzer(FWDSPAnalyzerID, @Success, WB_WDSP_FFT, 1, 1, nil);
if Success <> 0 then Exit;
FWDSPAnalyzerOpen := True;
FWDSPAnalyzerConfigured := False;
end;
if not FWDSPAnalyzerConfigured then
begin
SampleRate := Max(1, Round(FSampleRateHz));
AvBackmult := Exp(-1.0 / (15.0 * 0.120)); // Thetis wideband default.
SetAnalyzer(
FWDSPAnalyzerID,
2,
1,
1, // Feed like piHPSDR: interleaved I/Q via Spectrum0.
@FWDSPFlp[0],
WB_WDSP_FFT,
WB_WDSP_BLOCK,
6, // Thetis wideband default window.
14.0,
0, // no overlap for discontinuous WB packets.
0,
0.0,
0.0,
WB_WDSP_PIXELS,
1,
0,
0.0,
0.0,
2 * WB_WDSP_FFT);
SetDisplayAverageMode(FWDSPAnalyzerID, 0, AVERAGE_MODE_LOG_RECURSIVE);
SetDisplayAvBackmult(FWDSPAnalyzerID, 0, AvBackmult);
SetDisplaySampleRate(FWDSPAnalyzerID, SampleRate);
ResetPixelBuffers(FWDSPAnalyzerID);
FWDSPAnalyzerConfigured := True;
end;
Result := True;
end;
function TWidebandView.ComputeSpectrumWDSP(const Samples: array of SmallInt;
Count: Integer): Boolean;
var
Offset, I, Flag: Integer;
MaxPix: Single;
begin
Result := False;
if Count < WB_WDSP_BLOCK then Exit;
if not EnsureWDSPAnalyzer then Exit;
Offset := 0;
while Offset + WB_WDSP_BLOCK <= Count do
begin
for I := 0 to WB_WDSP_BLOCK - 1 do
begin
FWDSPIn[I * 2] := Samples[Offset + I] / 32768.0;
FWDSPIn[I * 2 + 1] := 0.0;
end;
Spectrum0(1, FWDSPAnalyzerID, 0, 0, @FWDSPIn[0]);
Inc(Offset, WB_WDSP_BLOCK);
end;
Flag := 0;
GetPixels(FWDSPAnalyzerID, 0, @FWDSPPixels[0], @Flag);
if Flag = 0 then Exit;
MaxPix := -1.0E30;
for I := 0 to WB_WDSP_PIXELS - 1 do
if FWDSPPixels[I] > MaxPix then
MaxPix := FWDSPPixels[I];
if MaxPix < -250.0 then Exit;
SetLength(FData, WB_WDSP_PIXELS);
for I := 0 to WB_WDSP_PIXELS - 1 do
FData[I] := FWDSPPixels[I] + FCalOffset;
Result := True;
end;
procedure TWidebandView.SetSamples(const Samples: array of SmallInt; Count: Integer);
begin
if ComputeSpectrumWDSP(Samples, Count) then
FDirty := True;
end;
function TWidebandView.FreqToX(FreqHz: Double; W: Integer): Integer;
var
SpanHz: Double;
begin
SpanHz := FViewEndHz - FViewStartHz;
if SpanHz <= 0.0 then SpanHz := Max(1.0, FSampleRateHz * 0.5);
Result := Round((FreqHz - FViewStartHz) / SpanHz * Max(1, W - 1));
end;
function TWidebandView.SourceFreqToBin(FreqHz: Double; BinCount: Integer): Integer;
var
Fs: Double;
begin
if BinCount <= 1 then Exit(0);
Fs := FSampleRateHz;
if Fs <= 0.0 then Fs := 122880000.0;
// We feed WDSP through Spectrum0 as a complex stream with Q=0. GetPixels is
// then laid out as -Fs/2..+Fs/2, so raw ADC frequencies 0..Fs/2 live in the
// right half of the pixel array. Do not map 0..Nyquist across the whole array.
Result := EnsureRange(Round((0.5 + FreqHz / Fs) * (BinCount - 1)), 0, BinCount - 1);
end;
function TWidebandView.GridStepHz(W: Integer): Double;
var
PixPerMHz, SpanMHz: Double;
begin
SpanMHz := Max(0.001, (FViewEndHz - FViewStartHz) / 1000000.0);
PixPerMHz := W / SpanMHz;
if PixPerMHz >= 44.0 then
Result := 500000.0
else if PixPerMHz >= 18.0 then
Result := 1000000.0
else if PixPerMHz >= 10.0 then
Result := 2000000.0
else if PixPerMHz >= 5.0 then
Result := 5000000.0
else
Result := 10000000.0;
end;
function TWidebandView.RulerGridStepHz(C: TCanvas; PlotW: Integer): Double;
var
BaseStep, PixPerStep: Double;
LabelMult: Integer;
begin
BaseStep := GridStepHz(PlotW);
PixPerStep := PlotW * BaseStep / Max(1.0, FViewEndHz - FViewStartHz);
if PixPerStep >= 1.0 then
LabelMult := Max(1, Ceil((C.TextWidth('000.0') + 8) / PixPerStep))
else
LabelMult := MaxInt;
Result := BaseStep * LabelMult;
end;
procedure TWidebandView.PaintVerticalGradient(C: TCanvas; W, H: Integer;
TopColor, BottomColor: TColor);
var
Y, B1, G1, R1, B2, G2, R2, B, G, R: Integer;
T: Double;
begin
if (W <= 0) or (H <= 0) then Exit;
B1 := (TopColor shr 16) and $FF;
G1 := (TopColor shr 8) and $FF;
R1 := TopColor and $FF;
B2 := (BottomColor shr 16) and $FF;
G2 := (BottomColor shr 8) and $FF;
R2 := BottomColor and $FF;
C.Pen.Style := psClear;
C.Brush.Style := bsSolid;
for Y := 0 to H - 1 do
begin
T := Y / Max(1, H - 1);
B := Round(B1 + (B2 - B1) * T);
G := Round(G1 + (G2 - G1) * T);
R := Round(R1 + (R2 - R1) * T);
C.Brush.Color := TColor((B shl 16) or (G shl 8) or R);
C.FillRect(Rect(0, Y, W, Y + 1));
end;
C.Pen.Style := psSolid;
end;
procedure TWidebandView.AlphaFillRect(const R: TRect; AColor: TColor; Alpha: Byte);
var
X, Y: Integer;
Row: PByte;
BR, BG, BB: Integer;
SR, SG, SB: Integer;
RR: TRect;
begin
if Alpha = 0 then Exit;
RR := Rect(
EnsureRange(R.Left, 0, FBitmap.Width),
EnsureRange(R.Top, 0, FBitmap.Height),
EnsureRange(R.Right, 0, FBitmap.Width),
EnsureRange(R.Bottom, 0, FBitmap.Height));
if (RR.Right <= RR.Left) or (RR.Bottom <= RR.Top) then Exit;
SR := AColor and $FF;
SG := (AColor shr 8) and $FF;
SB := (AColor shr 16) and $FF;
FBitmap.BeginUpdate(False);
try
for Y := RR.Top to RR.Bottom - 1 do
begin
Row := PByte(FBitmap.ScanLine[Y]);
Inc(Row, RR.Left * 4);
for X := RR.Left to RR.Right - 1 do
begin
{$IFDEF DARWIN}
BB := Row[3]; BG := Row[2]; BR := Row[1];
Row[1] := Byte((SR * Alpha + BR * (255 - Alpha)) div 255);
Row[2] := Byte((SG * Alpha + BG * (255 - Alpha)) div 255);
Row[3] := Byte((SB * Alpha + BB * (255 - Alpha)) div 255);
{$ELSE}
BB := Row[0]; BG := Row[1]; BR := Row[2];
Row[0] := Byte((SB * Alpha + BB * (255 - Alpha)) div 255);
Row[1] := Byte((SG * Alpha + BG * (255 - Alpha)) div 255);
Row[2] := Byte((SR * Alpha + BR * (255 - Alpha)) div 255);
{$ENDIF}
Inc(Row, 4);
end;
end;
finally
FBitmap.EndUpdate(False);
end;
end;
procedure TWidebandView.DrawHamBand(C: TCanvas; PlotW, H: Integer;
F1, F2: Double; const Name: string; AColor: TColor);
var
X1, X2, LabelX, LabelY, TW, TH: Integer;
R: TRect;
begin
X1 := FreqToX(F1, PlotW);
X2 := FreqToX(F2, PlotW);
if (X2 <= 0) or (X1 >= PlotW) then Exit;
X1 := EnsureRange(X1, 0, PlotW - 1);
X2 := EnsureRange(X2, 0, PlotW - 1);
if X2 <= X1 then Exit;
R := Rect(X1, 0, X2 + 1, H);
AlphaFillRect(R, AColor, 86);
AlphaFillRect(Rect(X1, 0, X2 + 1, Min(H, 15)), AColor, 118);
C.Font.Name := 'Sans';
C.Font.Size := 7;
TW := C.TextWidth(Name);
TH := C.TextHeight(Name);
if X2 - X1 >= 2 then
begin
LabelX := EnsureRange(((X1 + X2) div 2) - TW div 2, 2, Max(2, PlotW - TW - 5));
LabelY := Max(1, Min(H - TH - 1, 2));
C.Font.Color := TColor($00EAF7D7);
C.TextOut(LabelX, LabelY, Name);
end;
end;
procedure TWidebandView.DrawHamBands(C: TCanvas; PlotW, H: Integer);
begin
DrawHamBand(C, PlotW, H, 1810000, 2000000, '160m', TColor($003B8F5A));
DrawHamBand(C, PlotW, H, 3500000, 3800000, '80m', TColor($004D8F3B));
DrawHamBand(C, PlotW, H, 5258500, 5403500, '60m', TColor($00688F3B));
DrawHamBand(C, PlotW, H, 7000000, 7300000, '40m', TColor($00808D34));
DrawHamBand(C, PlotW, H, 10100000, 10150000, '30m', TColor($008F7834));
DrawHamBand(C, PlotW, H, 14000000, 14350000, '20m', TColor($008F5D34));
DrawHamBand(C, PlotW, H, 18068000, 18168000, '17m', TColor($008F4934));
DrawHamBand(C, PlotW, H, 21000000, 21450000, '15m', TColor($008C3E58));
DrawHamBand(C, PlotW, H, 24890000, 24990000, '12m', TColor($007A3E8C));
DrawHamBand(C, PlotW, H, 28000000, 29700000, '10m', TColor($005B4B9A));
DrawHamBand(C, PlotW, H, 50000000, 51990000, '6m', TColor($003C729A));
end;
procedure TWidebandView.DrawFrequencyMarker(C: TCanvas; PlotW, H: Integer);
var
X: Integer;
begin
if (FMarkerHz < FViewStartHz) or (FMarkerHz > FViewEndHz) then Exit;
X := EnsureRange(FreqToX(FMarkerHz, PlotW), 0, PlotW - 1);
C.Pen.Width := 1;
C.Pen.Color := TColor($006DA6FF);
C.MoveTo(Max(0, X - 2), 0);
C.LineTo(Min(PlotW - 1, X + 2), 0);
C.Pen.Color := TColor($00FFF3C0);
C.MoveTo(X, 0);
C.LineTo(X, H);
end;
procedure TWidebandView.DrawSpectrumGradient(const SpPts: array of TPoint;
PlotW, H: Integer);
var
Row, Col, Alpha, YMin, Off: Integer;
RowPtr: PByte;
GradB, GradG, GradR: Byte;
begin
if (PlotW <= 0) or (H <= 0) or (Length(SpPts) < PlotW) then Exit;
YMin := H;
for Col := 0 to PlotW - 1 do
if SpPts[Col].Y < YMin then YMin := SpPts[Col].Y;
if YMin >= H then Exit;
FBitmap.BeginUpdate(False);
try
for Row := YMin to H - 1 do
begin
Alpha := Round((1.0 - Sqr((Row - YMin) / Max(1.0, H - YMin - 1.0))) * 200);
if Alpha <= 0 then Continue;
if Alpha > 200 then Alpha := 200;
GradB := Byte(FTheme.SpecGradB * Alpha div 200);
GradG := Byte(FTheme.SpecGradG * Alpha div 200);
GradR := Byte(FTheme.SpecGradR * Alpha div 200);
RowPtr := PByte(FBitmap.ScanLine[Row]);
for Col := 0 to PlotW - 1 do
if SpPts[Col].Y <= Row then
begin
Off := Col * 4;
{$IFDEF DARWIN}
RowPtr[Off+1] := (GradR * Alpha + RowPtr[Off+1] * (200 - Alpha)) div 200;
RowPtr[Off+2] := (GradG * Alpha + RowPtr[Off+2] * (200 - Alpha)) div 200;
RowPtr[Off+3] := (GradB * Alpha + RowPtr[Off+3] * (200 - Alpha)) div 200;
{$ELSE}
RowPtr[Off] := (GradB * Alpha + RowPtr[Off] * (200 - Alpha)) div 200;
RowPtr[Off+1] := (GradG * Alpha + RowPtr[Off+1] * (200 - Alpha)) div 200;
RowPtr[Off+2] := (GradR * Alpha + RowPtr[Off+2] * (200 - Alpha)) div 200;
{$ENDIF}
end;
end;
finally
FBitmap.EndUpdate(False);
end;
end;
function TWidebandView.BuildSpectrumPoints(PlotW, H: Integer): Boolean;
var
X, Y, Bin, N, TopH: Integer;
DB, InvRange, SrcHz, Nyq: Double;
begin
Result := False;
N := Length(FData);
if (N <= 1) or (PlotW <= 0) or (H <= 0) then Exit;
TopH := Max(1, H - 1);
InvRange := 1.0 / Max(1.0, FRange);
SetLength(FPoints, PlotW);
Nyq := FSampleRateHz * 0.5;
if Nyq <= 0.0 then Nyq := 61440000.0;
for X := 0 to PlotW - 1 do
begin
SrcHz := FSourceStartHz +
X / Max(1, PlotW - 1) * (FSourceEndHz - FSourceStartHz);
if (SrcHz < 0.0) or (SrcHz > Nyq) then
DB := -200.0
else
begin
Bin := SourceFreqToBin(SrcHz, N);
DB := FData[Bin];
end;
Y := Round((FRefLevel - DB) * InvRange * TopH);
Y := EnsureRange(Y, 1, TopH);
FPoints[X] := Point(X, Y);
end;
Result := True;
end;
procedure TWidebandView.DrawCPU(W, H: Integer; IncludeSpectrum: Boolean);
var
C: TCanvas;
X, Y, TopH, PlotW, ScaleX: Integer;
DB, DBMin, InvRange, StepHz, FreqHz: Double;
begin
EnsureBitmap(W, H);
C := FBitmap.Canvas;
C.Brush.Color := FTheme.BG;
C.FillRect(0, 0, W, H);
PlotW := Max(1, W - WB_DB_SCALE_W);
ScaleX := PlotW;
DBMin := FRefLevel - FRange;
InvRange := 1.0 / Max(1.0, FRange);
C.Pen.Color := FTheme.SpecGrid;
C.Font.Color := FTheme.TextDim;
C.Font.Size := 8;
StepHz := RulerGridStepHz(C, PlotW);
FreqHz := Ceil(FViewStartHz / StepHz) * StepHz;
while FreqHz <= FViewEndHz + 0.5 do
begin
X := FreqToX(FreqHz, PlotW);
C.Line(X, 0, X, H);
FreqHz := FreqHz + StepHz;
end;
TopH := Max(1, H - 1);
DB := FRefLevel - 20.0;
while DB >= DBMin do
begin
Y := Round((FRefLevel - DB) * InvRange * TopH);
C.Line(0, Y, W, Y);
DB := DB - 20.0;
end;
C.Pen.Style := psClear;
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.SpecLabelBand;
C.FillRect(Rect(ScaleX, 0, W, H));
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.SpecGrid;
C.MoveTo(ScaleX, 0); C.LineTo(ScaleX, H);
C.Font.Name := 'Courier New';
C.Font.Size := 7;
C.Font.Color := FTheme.SpecLabelText;
C.Brush.Style := bsClear;
DB := FRefLevel - 20.0;
while DB >= DBMin do
begin
Y := Round((FRefLevel - DB) * InvRange * TopH);
C.TextOut(ScaleX + 2, Y - 9, Format('%4.0f', [DB]));
DB := DB - 20.0;
end;
if IncludeSpectrum and BuildSpectrumPoints(PlotW, H) then
begin
if FFillSpectrum then
DrawSpectrumGradient(FPoints, PlotW, H);
C.Pen.Color := TColor($0040FF80);
C.Polyline(FPoints);
end;
DrawHamBands(C, PlotW, H);
if IncludeSpectrum then
FDirty := False
else
FGLBackgroundDirty := False;
end;
procedure TWidebandView.DrawRuler;
var
C: TCanvas;
W, H, X, TW, PlotW: Integer;
StepHz, FreqHz: Double;
Lbl: string;
begin
W := FRulerBitmap.Width;
H := FRulerBitmap.Height;
if (W <= 0) or (H <= 0) then Exit;
C := FRulerBitmap.Canvas;
PaintVerticalGradient(C, W, H, FTheme.RulerGradTop, FTheme.RulerGradBot);
C.Pen.Color := FTheme.RulerBorder;
C.Pen.Width := 1;
C.MoveTo(0, 0); C.LineTo(W, 0);
C.MoveTo(0, H - 1); C.LineTo(W, H - 1);
C.Font.Name := 'Courier New';
C.Font.Size := 7;
C.Brush.Style := bsClear;
C.Font.Color := FTheme.RulerText;
PlotW := Max(1, W - WB_DB_SCALE_W);
StepHz := RulerGridStepHz(C, PlotW);
FreqHz := Ceil(FViewStartHz / StepHz) * StepHz;
while FreqHz <= FViewEndHz + 0.5 do
begin
X := FreqToX(FreqHz, PlotW);
C.Pen.Color := FTheme.RulerBorder;
C.MoveTo(X, 0); C.LineTo(X, H div 2);
if FreqHz >= 100000000.0 then
Lbl := FormatFloat('0.###', FreqHz / 1000000.0)
else
Lbl := FormatFloat('0.#', FreqHz / 1000000.0);
TW := C.TextWidth(Lbl);
C.TextOut(EnsureRange(X - TW div 2, 2, Max(2, PlotW - TW - 2)), H div 2 - 1, Lbl);
FreqHz := FreqHz + StepHz;
end;
C.Pen.Color := FTheme.RulerBorder;
C.MoveTo(PlotW, 0); C.LineTo(PlotW, H);
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.SpecLabelBand;
C.FillRect(Rect(PlotW + 1, 1, W, H - 1));
C.Brush.Style := bsClear;
C.Font.Color := FTheme.TextDim;
Lbl := 'MHz';
C.TextOut(Max(2, PlotW - C.TextWidth(Lbl) - 4), H div 2 - 1, Lbl);
end;
procedure TWidebandView.Draw;
begin
DrawCPU(FBitmap.Width, FBitmap.Height);
end;
procedure TWidebandView.PaintCPU(C: TCanvas);
begin
if FDirty then DrawCPU(FBitmap.Width, FBitmap.Height);
C.Draw(0, 0, FBitmap);
DrawFrequencyMarker(C, Max(1, FBitmap.Width - WB_DB_SCALE_W), FBitmap.Height);
end;
procedure TWidebandView.ColorToGL(AColor: TColor; out R, G, B: GLFloat);
begin
R := (AColor and $FF) / 255.0;
G := ((AColor shr 8) and $FF) / 255.0;
B := ((AColor shr 16) and $FF) / 255.0;
end;
procedure TWidebandView.DrawBackgroundGL(W, H, PlotW: Integer);
var
R1, G1, B1, R2, G2, B2: GLFloat;
begin
ColorToGL(FTheme.SpecGradTop, R1, G1, B1);
ColorToGL(FTheme.SpecGradBot, R2, G2, B2);
glBegin(GL_QUADS);
glColor3f(R1, G1, B1); glVertex2f(0, H);
glColor3f(R1, G1, B1); glVertex2f(W, H);
glColor3f(R2, G2, B2); glVertex2f(W, 0);
glColor3f(R2, G2, B2); glVertex2f(0, 0);
glEnd;
ColorToGL(FTheme.SpecLabelBand, R1, G1, B1);
glColor3f(R1, G1, B1);
glBegin(GL_QUADS);
glVertex2f(PlotW, 0);
glVertex2f(W, 0);
glVertex2f(W, H);
glVertex2f(PlotW, H);
glEnd;
end;
procedure TWidebandView.DrawGridGL(W, H, PlotW: Integer);
var
X, Y, TopH: Integer;
DB, DBMin, InvRange, StepHz, FreqHz: Double;
R, G, B: GLFloat;
begin
DBMin := FRefLevel - FRange;
InvRange := 1.0 / Max(1.0, FRange);
TopH := Max(1, H - 1);
ColorToGL(FTheme.SpecGrid, R, G, B);
glColor4f(R, G, B, 0.78);
glBegin(GL_LINES);
FLabelBitmap.Canvas.Font.Name := 'Courier New';
FLabelBitmap.Canvas.Font.Size := 7;
StepHz := RulerGridStepHz(FLabelBitmap.Canvas, PlotW);
FreqHz := Ceil(FViewStartHz / StepHz) * StepHz;
while FreqHz <= FViewEndHz + 0.5 do
begin
X := FreqToX(FreqHz, PlotW);
glVertex2f(X, 0);
glVertex2f(X, H);
FreqHz := FreqHz + StepHz;
end;
DB := FRefLevel - 20.0;
while DB >= DBMin do
begin
Y := Round((FRefLevel - DB) * InvRange * TopH);
glVertex2f(0, H - Y);
glVertex2f(W, H - Y);
DB := DB - 20.0;
end;
glVertex2f(PlotW, 0);
glVertex2f(PlotW, H);
glEnd;
end;
procedure TWidebandView.DrawSpectrumGL(PlotW, H: Integer);
var
I: Integer;
R, G, B: GLFloat;
ATop, ABot: GLFloat;
begin
if not BuildSpectrumPoints(PlotW, H) then Exit;
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
if FFillSpectrum then
begin
R := FTheme.SpecGradR / 255.0;
G := FTheme.SpecGradG / 255.0;
B := FTheme.SpecGradB / 255.0;
glBegin(GL_TRIANGLE_STRIP);
for I := 0 to PlotW - 1 do
begin
ATop := 0.44;
ABot := 0.02;
glColor4f(R, G, B, ATop);
glVertex2f(FPoints[I].X, H - FPoints[I].Y);
glColor4f(R, G, B, ABot);
glVertex2f(FPoints[I].X, 0);
end;
glEnd;
end;
glColor4f(0.25, 1.0, 0.50, 1.0);
glBegin(GL_LINE_STRIP);
for I := 0 to PlotW - 1 do
glVertex2f(FPoints[I].X, H - FPoints[I].Y);
glEnd;
glDisable(GL_BLEND);
end;
procedure TWidebandView.DrawHamBandGL(PlotW, H: Integer; F1, F2: Double;
AColor: TColor);
var
X1, X2: Integer;
R, G, B: GLFloat;
begin
X1 := FreqToX(F1, PlotW);
X2 := FreqToX(F2, PlotW);
if (X2 <= 0) or (X1 >= PlotW) then Exit;
X1 := EnsureRange(X1, 0, PlotW - 1);
X2 := EnsureRange(X2, 0, PlotW - 1);
if X2 <= X1 then Exit;
ColorToGL(AColor, R, G, B);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glColor4f(R, G, B, 0.34);
glBegin(GL_QUADS);
glVertex2f(X1, 0);
glVertex2f(X2 + 1, 0);
glVertex2f(X2 + 1, H);
glVertex2f(X1, H);
glEnd;
glColor4f(R, G, B, 0.46);
glBegin(GL_QUADS);
glVertex2f(X1, H - Min(H, 15));
glVertex2f(X2 + 1, H - Min(H, 15));
glVertex2f(X2 + 1, H);
glVertex2f(X1, H);
glEnd;
glDisable(GL_BLEND);
end;
procedure TWidebandView.DrawHamBandsGL(PlotW, H: Integer);
begin
DrawHamBandGL(PlotW, H, 1810000, 2000000, TColor($003B8F5A));
DrawHamBandGL(PlotW, H, 3500000, 3800000, TColor($004D8F3B));
DrawHamBandGL(PlotW, H, 5258500, 5403500, TColor($00688F3B));
DrawHamBandGL(PlotW, H, 7000000, 7300000, TColor($00808D34));
DrawHamBandGL(PlotW, H, 10100000, 10150000, TColor($008F7834));
DrawHamBandGL(PlotW, H, 14000000, 14350000, TColor($008F5D34));
DrawHamBandGL(PlotW, H, 18068000, 18168000, TColor($008F4934));
DrawHamBandGL(PlotW, H, 21000000, 21450000, TColor($008C3E58));
DrawHamBandGL(PlotW, H, 24890000, 24990000, TColor($007A3E8C));
DrawHamBandGL(PlotW, H, 28000000, 29700000, TColor($005B4B9A));
DrawHamBandGL(PlotW, H, 50000000, 51990000, TColor($003C729A));
end;
procedure TWidebandView.DrawGLLabels(W, H, PlotW: Integer);
var
C: TCanvas;
X1, X2, LabelX, LabelY, TW, TH, Y, TopH, ScaleX: Integer;
DB, DBMin, InvRange: Double;
procedure BandLabel(F1, F2: Double; const Name: string);
begin
X1 := FreqToX(F1, PlotW);
X2 := FreqToX(F2, PlotW);
if (X2 <= 0) or (X1 >= PlotW) then Exit;
X1 := EnsureRange(X1, 0, PlotW - 1);
X2 := EnsureRange(X2, 0, PlotW - 1);
if X2 <= X1 then Exit;
TW := C.TextWidth(Name);
TH := C.TextHeight(Name);
LabelX := EnsureRange(((X1 + X2) div 2) - TW div 2, 2, Max(2, PlotW - TW - 5));
LabelY := Max(1, Min(H - TH - 1, 2));
C.TextOut(LabelX, LabelY, Name);
end;
begin
if (W <= 0) or (H <= 0) then Exit;
if (FLabelBitmap.Width <> W) or (FLabelBitmap.Height <> H) then
FLabelBitmap.SetSize(W, H);
C := FLabelBitmap.Canvas;
C.Brush.Style := bsSolid;
C.Brush.Color := clBlack;
C.FillRect(Rect(0, 0, W, H));
C.Brush.Style := bsClear;
DBMin := FRefLevel - FRange;
InvRange := 1.0 / Max(1.0, FRange);
TopH := Max(1, H - 1);
ScaleX := PlotW;
C.Font.Name := 'Courier New';
C.Font.Quality := fqDefault;
C.Font.Size := 7;
C.Font.Color := FTheme.SpecLabelText;
DB := FRefLevel - 20.0;
while DB >= DBMin do
begin
Y := Round((FRefLevel - DB) * InvRange * TopH);
C.TextOut(ScaleX + 2, Y - 9, Format('%4.0f', [DB]));
DB := DB - 20.0;
end;
C.Font.Name := 'Sans';
C.Font.Quality := fqDefault;
C.Font.Size := 7;
C.Font.Color := TColor($00EAF7D7);
BandLabel(1810000, 2000000, '160m');
BandLabel(3500000, 3800000, '80m');
BandLabel(5258500, 5403500, '60m');
BandLabel(7000000, 7300000, '40m');
BandLabel(10100000, 10150000, '30m');
BandLabel(14000000, 14350000, '20m');
BandLabel(18068000, 18168000, '17m');
BandLabel(21000000, 21450000, '15m');
BandLabel(24890000, 24990000, '12m');
BandLabel(28000000, 29700000, '10m');
BandLabel(50000000, 51990000, '6m');
end;
procedure TWidebandView.UploadLabelTextureToGL;
var
X, Y, I: Integer;
Src: PByte;
Buf: array of Byte;
A: Byte;
begin
if (FLabelBitmap.Width <= 0) or (FLabelBitmap.Height <= 0) then Exit;
if FGLTex = 0 then
glGenTextures(1, @FGLTex);
SetLength(Buf, FLabelBitmap.Width * FLabelBitmap.Height * 4);
FLabelBitmap.BeginUpdate(False);
try
I := 0;
for Y := 0 to FLabelBitmap.Height - 1 do
begin
Src := PByte(FLabelBitmap.ScanLine[Y]);
for X := 0 to FLabelBitmap.Width - 1 do
begin
{$IFDEF DARWIN}
// ARGB: byte0=A, byte1=R, byte2=G, byte3=B
A := Max(Src[1], Max(Src[2], Src[3]));
if A < 6 then A := 0;
if A > 0 then
begin
Buf[I] := Byte(Min(255, Src[1] * 255 div A)); // R
Buf[I + 1] := Byte(Min(255, Src[2] * 255 div A)); // G
Buf[I + 2] := Byte(Min(255, Src[3] * 255 div A)); // B
A := Byte(Min(255, A + (255 - A) div 3));
end
else
begin
Buf[I] := 0; Buf[I + 1] := 0; Buf[I + 2] := 0;
end;
{$ELSE}
// BGRA: byte0=B, byte1=G, byte2=R
A := Max(Src[0], Max(Src[1], Src[2]));
if A < 6 then A := 0;
if A > 0 then
begin
Buf[I] := Byte(Min(255, Src[2] * 255 div A)); // R
Buf[I + 1] := Byte(Min(255, Src[1] * 255 div A)); // G
Buf[I + 2] := Byte(Min(255, Src[0] * 255 div A)); // B
A := Byte(Min(255, A + (255 - A) div 3));
end
else
begin
Buf[I] := 0; Buf[I + 1] := 0; Buf[I + 2] := 0;
end;
{$ENDIF}
Buf[I + 3] := A;
Inc(Src, 4);
Inc(I, 4);
end;
end;
finally
FLabelBitmap.EndUpdate(False);
end;
glBindTexture(GL_TEXTURE_2D, FGLTex);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, FLabelBitmap.Width, FLabelBitmap.Height, 0,
GL_RGBA, GL_UNSIGNED_BYTE, @Buf[0]);
end;
procedure TWidebandView.DrawLabelTextureGL(W, H: Integer);
begin
if FGLTex = 0 then Exit;
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, FGLTex);
glColor4f(1, 1, 1, 1);
glBegin(GL_QUADS);
glTexCoord2f(0, 1); glVertex2f(0, 0);
glTexCoord2f(1, 1); glVertex2f(W, 0);
glTexCoord2f(1, 0); glVertex2f(W, H);
glTexCoord2f(0, 0); glVertex2f(0, H);
glEnd;
glBindTexture(GL_TEXTURE_2D, 0);
glDisable(GL_TEXTURE_2D);
glDisable(GL_BLEND);
end;
procedure TWidebandView.PaintGL(C: TOpenGLControl);
var
W, H, PlotW, X: Integer;
begin
if C = nil then Exit;
W := Max(1, C.Width);
H := Max(1, C.Height);
if not C.MakeCurrent then Exit;
if (FBitmap.Width <> W) or (FBitmap.Height <> H) then
SetBitmapSize(W, H);
if FGLBackgroundDirty then
begin
PlotW := Max(1, W - WB_DB_SCALE_W);
DrawGLLabels(W, H, PlotW);
UploadLabelTextureToGL;
FGLBackgroundDirty := False;
end;
glViewport(0, 0, W, H);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0, W, 0, H, -1, 1);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glDisable(GL_DEPTH_TEST);
glClearColor(0, 0, 0, 1.0);
glClear(GL_COLOR_BUFFER_BIT);
PlotW := Max(1, W - WB_DB_SCALE_W);
DrawBackgroundGL(W, H, PlotW);
DrawGridGL(W, H, PlotW);
DrawSpectrumGL(PlotW, H);
DrawHamBandsGL(PlotW, H);
DrawLabelTextureGL(W, H);
FDirty := False;
if (FMarkerHz >= FViewStartHz) and (FMarkerHz <= FViewEndHz) then
begin
X := EnsureRange(FreqToX(FMarkerHz, PlotW), 0, PlotW - 1);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glColor4f(1.0, 0.64, 0.36, 0.32);
glBegin(GL_QUADS);
glVertex2f(Max(0, X - 2), 0);
glVertex2f(Min(PlotW - 1, X + 2), 0);
glVertex2f(Min(PlotW - 1, X + 2), H);
glVertex2f(Max(0, X - 2), H);
glEnd;
glColor4f(1.0, 0.95, 0.75, 0.90);
glBegin(GL_LINES);
glVertex2f(X, 0);
glVertex2f(X, H);
glEnd;
glDisable(GL_BLEND);
end;
C.SwapBuffers;
FDirty := False;
end;
procedure TWidebandView.Paint(Sender: TObject);
var T0: Int64; // PERF
begin
T0 := PerfNow; // PERF
if Sender is TOpenGLControl then
PaintGL(TOpenGLControl(Sender))
else if Sender is TPaintBox then
PaintCPU(TPaintBox(Sender).Canvas);
PerfAdd(pzUiWidebandPaint, T0); // PERF: кадр wideband-панорамы (CPU или GL)
end;
procedure TWidebandView.PaintRuler(Sender: TObject);
var
PB: TPaintBox;
begin
if not (Sender is TPaintBox) then Exit;
PB := TPaintBox(Sender);
if (FRulerBitmap.Width <> PB.Width) or (FRulerBitmap.Height <> PB.Height) then
SetRulerSize(PB.Width, PB.Height);
DrawRuler;
if (FRulerBitmap.Width > 0) and (FRulerBitmap.Height > 0) then
PB.Canvas.Draw(0, 0, FRulerBitmap);
end;
end.