Files
ewsdr/SpectrumViewOpengl.pas
T
ew8bakandClaude Fable 5 092a202f5f feat(waterfall): палитры Inferno/Turbo + gamma, разрешение до 4096, HiDPI
- SPECTRUM_PIXELS 1024→4096 + настройка display_pixels (лимит точек
  анализатора, SetDisplayResLimit); web-зеркало остаётся 1024 —
  max-децимация в SnapshotPixels
- палитры водопада Classic/Inferno/Turbo + регулятор gamma (в LUT),
  настройки wf_palette/wf_gamma, страница Waterfall → группа Rendering
- GL-водопад переведён на общий LUT/AGC-уровни базового класса
  (убраны дубли ColorForDB/UpdateLevels)
- явные glViewport в GL-вьюхах умножаются на PixelScale (HiDPI),
  текстура водопада — в физической ширине

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-04 16:11:58 +03:00

981 lines
31 KiB
ObjectPascal

unit SpectrumViewOpengl;
{
OpenGL renderer for the spectrum pane.
The class keeps the public TSpectrumView contract so MainForm can switch it
with --opengl without changing DSP/web data flow. Waterfall, ruler and S-meter
remain delegated to the base sub-views; only the spectrum paint path uses GL.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Graphics, Controls, Math, Types,
OpenGLContextEx, GL,
AppTheme, SpectrumView, VfoOverlay, BandPlanOverlay,
WaterfallView, WaterfallViewOpengl;
type
TGLTextureCache = record
Tex: GLuint;
W: Integer;
H: Integer;
Dirty: Boolean;
end;
TSpectrumViewOpenGL = class(TSpectrumView)
private
FGLControl: TOpenGLControl;
FGridDirty: Boolean;
FOverlayDirty: Boolean;
FSampleOverlayDirty: Boolean;
FVfoOverlayDirty: Boolean;
FBandOverlayDirty: Boolean;
FGridLabelTex: TGLTextureCache;
FAGCLabelTex: TGLTextureCache;
FAGCHangLabelTex: TGLTextureCache;
FMarkerLabelTex: TGLTextureCache;
FADCOverlayTex: TGLTextureCache;
FSampleOverlayTex: TGLTextureCache;
FVfoOverlayTex: TGLTextureCache;
FBandOverlayTex: TGLTextureCache;
// Текстуры флагов слайсов (B+), привязка по указателю оверлея.
FSliceTex: array of record
Overlay: TVfoOverlay;
Tex: TGLTextureCache;
LastX, LastY, LastW, LastH: Integer;
end;
// Кэш текстур букв A..H для меток на полосе фильтра (грузятся лениво).
FLetterTex: array[0..7] of TGLTextureCache;
FLastAGCText: string;
FLastAGCY: Integer;
FLastAGCHangY: Integer;
FLastMarkerText: string;
FLastMarkerX: Integer;
FLastADCVisible: Boolean;
FLastSampleX: Integer;
FLastSampleY: Integer;
FLastSampleW: Integer;
FLastSampleH: Integer;
FLastVfoX: Integer;
FLastVfoY: Integer;
FLastVfoW: Integer;
FLastVfoH: Integer;
FLastBandW: Integer;
FLastBandCenter: Double;
FLastBandSpan: Double;
FGLSpectrumW: Integer;
FGLSpectrumH: Integer;
FSpY: array of Integer;
procedure DeleteTexture(var T: TGLTextureCache);
procedure UploadBitmap(var T: TGLTextureCache; B: TBitmap; Keyed: Boolean;
FixedAlpha: Byte);
procedure UploadAlphaMask(var T: TGLTextureCache; B: TBitmap; AColor: TColor);
procedure UploadText(var T: TGLTextureCache; const S: string; AColor: TColor;
FontSize: Integer; Bold: Boolean);
procedure DrawTexture(const T: TGLTextureCache; X, Y: Integer);
procedure DrawRect(X1, Y1, X2, Y2: Integer; C: TColor; Alpha: Single);
procedure DrawLine(X1, Y1, X2, Y2: Integer; C: TColor; Width: Single;
Stipple: Boolean);
procedure DrawVerticalGradient(W, H: Integer);
procedure DrawGrid(W, H: Integer; DBmax, DBmin, InvRange: Double);
procedure DrawFilterAndCursors(W, H: Integer);
procedure DrawAGCLines(W, H: Integer; DBmax, InvRange: Double);
procedure DrawSpectrumCurve(W, H: Integer; DBmax, InvRange: Double);
procedure DrawMarker(W, H: Integer);
procedure DrawBeaconMarkersGL(W, H: Integer);
procedure DrawADCOverlay(W, H: Integer);
procedure DrawCachedOverlays(W, H: Integer);
procedure DrawSliceOverlays(W, H: Integer);
procedure DrawSliceFilterMarkers(W, H: Integer);
procedure DrawBandLetterGL(X1, X2: Integer; L: Char);
function SliceTexIndex(O: TVfoOverlay): Integer; // индекс в FSliceTex, -1 если нет
function FormatFreqGL(Hz: Double): string;
function ActiveVfoFrequency: Double;
public
constructor Create;
destructor Destroy; override;
procedure AttachControl(C: TOpenGLControl);
procedure AttachWaterfallControl(C: TOpenGLControl);
procedure SetSpectrumBitmapSize(W, H: Integer); override;
function SpectrumBitmapWidth: Integer; override;
procedure DrawSpectrum; override;
procedure PaintSpectrum(Sender: TObject); override;
procedure InvalidateGridCache; override;
procedure InvalidateOverlayCache; override;
procedure InvalidateVfoOverlay; override;
procedure SetTheme(const T: TAppTheme); override;
end;
implementation
const
KEY_COLOR = TColor($00FF00FF);
function ClampI(V, Lo, Hi: Integer): Integer;
begin
if V < Lo then Result := Lo
else if V > Hi then Result := Hi
else Result := V;
end;
procedure ColorToRGB(C: TColor; out R, G, B: GLFloat);
begin
R := (C and $FF) / 255.0;
G := ((C shr 8) and $FF) / 255.0;
B := ((C shr 16) and $FF) / 255.0;
end;
constructor TSpectrumViewOpenGL.Create;
begin
inherited Create;
FWaterfall.Free;
FWaterfall := TWaterfallViewOpenGL.Create;
FWaterfall.WfFrameInterval := 1;
FGridDirty := True;
FOverlayDirty := True;
FSampleOverlayDirty := True;
FVfoOverlayDirty := True;
FBandOverlayDirty := True;
FLastBandW := -MaxInt;
FLastBandCenter := -1; FLastBandSpan := -1;
FLastAGCY := -MaxInt;
FLastAGCHangY := -MaxInt;
FLastMarkerX := -MaxInt;
FLastADCVisible := False;
end;
destructor TSpectrumViewOpenGL.Destroy;
var i: Integer;
begin
if Assigned(FGLControl) and FGLControl.MakeCurrent then
begin
DeleteTexture(FGridLabelTex);
DeleteTexture(FAGCLabelTex);
DeleteTexture(FAGCHangLabelTex);
DeleteTexture(FMarkerLabelTex);
DeleteTexture(FADCOverlayTex);
DeleteTexture(FSampleOverlayTex);
DeleteTexture(FVfoOverlayTex);
DeleteTexture(FBandOverlayTex);
for i := 0 to High(FSliceTex) do DeleteTexture(FSliceTex[i].Tex);
for i := 0 to High(FLetterTex) do DeleteTexture(FLetterTex[i]);
end;
SetLength(FSliceTex, 0);
inherited Destroy;
end;
procedure TSpectrumViewOpenGL.AttachControl(C: TOpenGLControl);
begin
FGLControl := C;
end;
procedure TSpectrumViewOpenGL.AttachWaterfallControl(C: TOpenGLControl);
begin
if FWaterfall is TWaterfallViewOpenGL then
TWaterfallViewOpenGL(FWaterfall).AttachControl(C);
end;
procedure TSpectrumViewOpenGL.DeleteTexture(var T: TGLTextureCache);
begin
if T.Tex <> 0 then
glDeleteTextures(1, @T.Tex);
T.Tex := 0;
T.W := 0;
T.H := 0;
T.Dirty := True;
end;
procedure TSpectrumViewOpenGL.UploadBitmap(var T: TGLTextureCache; B: TBitmap;
Keyed: Boolean; FixedAlpha: Byte);
var
X, Y, I: Integer;
Src: PByte;
Buf: array of Byte;
IsKey: Boolean;
begin
if (B = nil) or (B.Width <= 0) or (B.Height <= 0) then Exit;
if T.Tex = 0 then glGenTextures(1, @T.Tex);
T.W := B.Width;
T.H := B.Height;
SetLength(Buf, T.W * T.H * 4);
B.BeginUpdate(False);
try
I := 0;
for Y := 0 to T.H - 1 do
begin
Src := PByte(B.ScanLine[Y]);
for X := 0 to T.W - 1 do
begin
{$IFDEF DARWIN}
// ARGB: byte0=A, byte1=R, byte2=G, byte3=B
IsKey := Keyed and (Src[1] = $FF) and (Src[2] = $00) and (Src[3] = $FF);
Buf[I] := Src[1]; Buf[I+1] := Src[2]; Buf[I+2] := Src[3];
{$ELSE}
// BGRA: byte0=B, byte1=G, byte2=R
IsKey := Keyed and (Src[0] = $FF) and (Src[1] = $00) and (Src[2] = $FF);
Buf[I] := Src[2]; Buf[I+1] := Src[1]; Buf[I+2] := Src[0];
{$ENDIF}
if IsKey then Buf[I + 3] := 0 else Buf[I + 3] := FixedAlpha;
Inc(Src, 4);
Inc(I, 4);
end;
end;
finally
B.EndUpdate(False);
end;
glBindTexture(GL_TEXTURE_2D, T.Tex);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, T.W, T.H, 0, GL_RGBA,
GL_UNSIGNED_BYTE, @Buf[0]);
glBindTexture(GL_TEXTURE_2D, 0);
T.Dirty := False;
end;
procedure TSpectrumViewOpenGL.UploadAlphaMask(var T: TGLTextureCache; B: TBitmap;
AColor: TColor);
var
X, Y, I: Integer;
Src: PByte;
Buf: array of Byte;
R, G, BB, A: Byte;
begin
if (B = nil) or (B.Width <= 0) or (B.Height <= 0) then Exit;
if T.Tex = 0 then glGenTextures(1, @T.Tex);
T.W := B.Width;
T.H := B.Height;
R := AColor and $FF;
G := (AColor shr 8) and $FF;
BB := (AColor shr 16) and $FF;
SetLength(Buf, T.W * T.H * 4);
B.BeginUpdate(False);
try
I := 0;
for Y := 0 to T.H - 1 do
begin
Src := PByte(B.ScanLine[Y]);
for X := 0 to T.W - 1 do
begin
{$IFDEF DARWIN}
A := Max(Src[1], Max(Src[2], Src[3])); // ARGB: R,G,B at bytes 1,2,3
{$ELSE}
A := Max(Src[0], Max(Src[1], Src[2])); // BGRA: B,G,R at bytes 0,1,2
{$ENDIF}
Buf[I] := R;
Buf[I + 1] := G;
Buf[I + 2] := BB;
Buf[I + 3] := A;
Inc(Src, 4);
Inc(I, 4);
end;
end;
finally
B.EndUpdate(False);
end;
glBindTexture(GL_TEXTURE_2D, T.Tex);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, T.W, T.H, 0, GL_RGBA,
GL_UNSIGNED_BYTE, @Buf[0]);
glBindTexture(GL_TEXTURE_2D, 0);
T.Dirty := False;
end;
procedure TSpectrumViewOpenGL.UploadText(var T: TGLTextureCache; const S: string;
AColor: TColor; FontSize: Integer; Bold: Boolean);
var
B: TBitmap;
TW, TH: Integer;
begin
if S = '' then
begin
DeleteTexture(T);
Exit;
end;
B := TBitmap.Create;
try
B.PixelFormat := pf32bit;
B.SetSize(8, 8);
B.Canvas.Font.Name := 'Courier New';
B.Canvas.Font.Size := FontSize;
if Bold then B.Canvas.Font.Style := [fsBold] else B.Canvas.Font.Style := [];
TW := Max(1, B.Canvas.TextWidth(S) + 4);
TH := Max(1, B.Canvas.TextHeight(S) + 2);
B.SetSize(TW, TH);
B.Canvas.Brush.Color := clBlack;
B.Canvas.Brush.Style := bsSolid;
B.Canvas.Pen.Style := psClear;
B.Canvas.FillRect(Rect(0, 0, TW, TH));
B.Canvas.Brush.Style := bsClear;
B.Canvas.Font.Name := 'Courier New';
B.Canvas.Font.Size := FontSize;
if Bold then B.Canvas.Font.Style := [fsBold] else B.Canvas.Font.Style := [];
B.Canvas.Font.Color := clWhite;
B.Canvas.TextOut(2, 1, S);
UploadAlphaMask(T, B, AColor);
finally
B.Free;
end;
end;
procedure TSpectrumViewOpenGL.DrawTexture(const T: TGLTextureCache; X, Y: Integer);
begin
if (T.Tex = 0) or (T.W <= 0) or (T.H <= 0) then Exit;
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, T.Tex);
glColor4f(1, 1, 1, 1);
glBegin(GL_QUADS);
glTexCoord2f(0, 0); glVertex2f(X, Y);
glTexCoord2f(1, 0); glVertex2f(X + T.W, Y);
glTexCoord2f(1, 1); glVertex2f(X + T.W, Y + T.H);
glTexCoord2f(0, 1); glVertex2f(X, Y + T.H);
glEnd;
glBindTexture(GL_TEXTURE_2D, 0);
glDisable(GL_TEXTURE_2D);
end;
procedure TSpectrumViewOpenGL.DrawRect(X1, Y1, X2, Y2: Integer; C: TColor;
Alpha: Single);
var R, G, B: GLFloat;
begin
ColorToRGB(C, R, G, B);
glColor4f(R, G, B, Alpha);
glBegin(GL_QUADS);
glVertex2f(X1, Y1); glVertex2f(X2, Y1);
glVertex2f(X2, Y2); glVertex2f(X1, Y2);
glEnd;
end;
procedure TSpectrumViewOpenGL.DrawLine(X1, Y1, X2, Y2: Integer; C: TColor;
Width: Single; Stipple: Boolean);
var R, G, B: GLFloat;
begin
ColorToRGB(C, R, G, B);
glColor4f(R, G, B, 1);
glLineWidth(Width);
if Stipple then
begin
glEnable(GL_LINE_STIPPLE);
glLineStipple(1, $0F0F);
end;
glBegin(GL_LINES);
glVertex2f(X1 + 0.5, Y1 + 0.5);
glVertex2f(X2 + 0.5, Y2 + 0.5);
glEnd;
if Stipple then glDisable(GL_LINE_STIPPLE);
glLineWidth(1);
end;
procedure TSpectrumViewOpenGL.SetSpectrumBitmapSize(W, H: Integer);
begin
if (W <= 0) or (H <= 0) then Exit;
FGLSpectrumW := W;
FGLSpectrumH := H;
FGridDirty := True;
FOverlayDirty := True;
FSpectrumDirty := True;
if Assigned(FGLControl) then FGLControl.Invalidate;
end;
function TSpectrumViewOpenGL.SpectrumBitmapWidth: Integer;
begin
Result := FGLSpectrumW;
end;
procedure TSpectrumViewOpenGL.DrawSpectrum;
begin
FSpectrumDirty := False;
if Assigned(FGLControl) then FGLControl.Invalidate;
end;
procedure TSpectrumViewOpenGL.InvalidateGridCache;
begin
inherited InvalidateGridCache;
FGridDirty := True;
FOverlayDirty := True;
end;
procedure TSpectrumViewOpenGL.InvalidateOverlayCache;
begin
inherited InvalidateOverlayCache;
FOverlayDirty := True;
FSampleOverlayDirty := True;
FVfoOverlayDirty := True;
end;
procedure TSpectrumViewOpenGL.InvalidateVfoOverlay;
begin
// Только текстура главного флага — НЕ трогаем FOverlayDirty, иначе band/
// samplerate/слайсы зря перезаливались бы на каждый тик S-метра главного.
FVfoOverlayDirty := True;
end;
procedure TSpectrumViewOpenGL.SetTheme(const T: TAppTheme);
begin
inherited SetTheme(T);
FGridDirty := True;
FOverlayDirty := True;
end;
function TSpectrumViewOpenGL.FormatFreqGL(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;
function TSpectrumViewOpenGL.ActiveVfoFrequency: Double;
begin
if FActiveVfo = 0 then Result := FVfoA else Result := FVfoB;
end;
procedure TSpectrumViewOpenGL.DrawVerticalGradient(W, H: Integer);
var
R1, G1, B1, R2, G2, B2: GLFloat;
begin
ColorToRGB(FTheme.SpecGradTop, R1, G1, B1);
ColorToRGB(FTheme.SpecGradBot, R2, G2, B2);
glBegin(GL_QUADS);
glColor4f(R1, G1, B1, 1); glVertex2f(0, 0); glVertex2f(W, 0);
glColor4f(R2, G2, B2, 1); glVertex2f(W, H); glVertex2f(0, H);
glEnd;
DrawRect(0, 0, 28, H, FTheme.SpecLabelBand, 1);
end;
procedure TSpectrumViewOpenGL.DrawGrid(W, H: Integer; DBmax, DBmin,
InvRange: Double);
var
I, Yp, GX, N, GridMult: Integer;
DB, GridFreqS, GridLine, PixPerStep: Double;
B: TBitmap;
begin
DB := DBmax - FSpecGridStep;
while DB >= DBmin do
begin
Yp := Round((DBmax - DB) * InvRange * H);
DrawLine(0, Yp, W - 1, Yp, FTheme.SpecGrid, 1, False);
DB := DB - FSpecGridStep;
end;
if FFMGridStepHz > 0 then
begin
GridFreqS := FCenterFreq - FSpanHz / 2;
PixPerStep := W * FFMGridStepHz / FSpanHz;
if PixPerStep >= 1.0 then GridMult := Max(1, Ceil(4.0 / PixPerStep))
else GridMult := 0;
if GridMult > 0 then
begin
N := Ceil(GridFreqS / FFMGridStepHz);
GridLine := N * FFMGridStepHz;
while GridLine <= FCenterFreq + FSpanHz / 2 + 0.5 do
begin
if (N mod GridMult) = 0 then
begin
GX := Round((GridLine - GridFreqS) / FSpanHz * W);
if (GX >= 0) and (GX < W) then DrawLine(GX, 0, GX, H, FTheme.SpecGrid, 1, False);
end;
Inc(N);
GridLine := GridLine + FFMGridStepHz;
end;
end;
end
else
for I := 0 to 8 do
begin
GX := Round(I / 8 * W);
DrawLine(GX, 0, GX, H, FTheme.SpecGrid, 1, False);
end;
if FGridDirty or FGridLabelTex.Dirty or (FGridLabelTex.H <> H) then
begin
B := TBitmap.Create;
try
B.PixelFormat := pf32bit;
B.SetSize(28, H);
B.Canvas.Brush.Color := clBlack;
B.Canvas.Brush.Style := bsSolid;
B.Canvas.Pen.Style := psClear;
B.Canvas.FillRect(Rect(0, 0, 28, H));
B.Canvas.Font.Name := 'Courier New';
B.Canvas.Font.Size := 7;
B.Canvas.Font.Color := clWhite;
B.Canvas.Brush.Style := bsClear;
DB := DBmax - FSpecGridStep;
while DB >= DBmin do
begin
Yp := Round((DBmax - DB) * InvRange * H);
B.Canvas.TextOut(1, Yp - 9, Format('%4.0f', [DB]));
DB := DB - FSpecGridStep;
end;
UploadAlphaMask(FGridLabelTex, B, FTheme.SpecLabelText);
finally
B.Free;
end;
FGridDirty := False;
end;
DrawTexture(FGridLabelTex, 0, 0);
end;
procedure TSpectrumViewOpenGL.DrawFilterAndCursors(W, H: Integer);
var
X1, X2, VfoX, TXX1, TXX2, TXVfoX: Integer;
begin
TXX1 := 0;
TXX2 := 0;
TXVfoX := 0;
if FActiveVfo = 0 then CalcFilterBandX(FVfoA, W, X1, X2, VfoX)
else CalcFilterBandX(FVfoB, W, X1, X2, VfoX);
if FTXOverlay then
begin
if FTXVfoIndex <> FActiveVfo then
begin
if X2 > X1 then DrawRect(X1, 0, X2, H, TColor($0030C030), 100 / 255);
if FTXVfoIndex = 0 then CalcFilterBandX(FVfoA, W, TXX1, TXX2, TXVfoX)
else CalcFilterBandX(FVfoB, W, TXX1, TXX2, TXVfoX);
if TXX2 > TXX1 then DrawRect(TXX1, 0, TXX2, H, TColor($00E03030), 100 / 255);
end
else if X2 > X1 then DrawRect(X1, 0, X2, H, TColor($00E03030), 100 / 255);
end
else if X2 > X1 then
DrawRect(X1, 0, X2, H, FTheme.SpecFilter, 1);
DrawLine(X1, 0, X1, H, FTheme.SpecFilterEdge, 1, False);
DrawLine(X2, 0, X2, H, FTheme.SpecFilterEdge, 1, False);
DrawLine(VfoX, 0, VfoX, H - 12, FTheme.SpecVfoCursor, 2, False);
DrawRect(VfoX - 5, 0, VfoX + 5, 8, FTheme.SpecVfoCursor, 1);
if FTXOverlay and (FTXVfoIndex <> FActiveVfo) then
begin
DrawLine(TXX1, 0, TXX1, H, TColor($002030E0), 1, False);
DrawLine(TXX2, 0, TXX2, H, TColor($002030E0), 1, False);
DrawLine(TXVfoX, 0, TXVfoX, H - 12, TColor($002030E0), 2, False);
DrawRect(TXVfoX - 5, 0, TXVfoX + 5, 8, TColor($002030E0), 1);
end;
// Буква главного флага (A) на его полосе — только когда есть слайсы.
if (SliceOverlayCount > 0) and (FActiveVfo = 0) and Assigned(FVfoOverlay) then
DrawBandLetterGL(X1, X2, FVfoOverlay.SliceLetter);
DrawSliceFilterMarkers(W, H);
end;
// Маркер фильтра каждого слайса (B+) на спектре: полупрозрачная полоса
// пропускания + центральная несущая. Цвет янтарный — отличить от главного.
procedure TSpectrumViewOpenGL.DrawSliceFilterMarkers(W, H: Integer);
const
SLICE_CLR = TColor($0010A8F0); // янтарный (BGR), как акцент TX-select флага
var
i, SX1, SX2, SVfoX: Integer;
O: TVfoOverlay;
begin
for i := 0 to SliceOverlayCount - 1 do
begin
O := SliceOverlayAt(i);
if (O = nil) or (not O.Visible) then Continue;
CalcFilterBandXFor(O.DisplayVfoHz, O.DisplayMode, O.DisplayBW, W, SX1, SX2, SVfoX);
if SX2 > SX1 then DrawRect(SX1, 0, SX2, H, SLICE_CLR, 60 / 255);
DrawLine(SX1, 0, SX1, H, SLICE_CLR, 1, False);
DrawLine(SX2, 0, SX2, H, SLICE_CLR, 1, False);
DrawLine(SVfoX, 0, SVfoX, H - 12, SLICE_CLR, 2, False);
DrawBandLetterGL(SX1, SX2, O.SliceLetter);
end;
end;
// Буква слайса по центру полосы фильтра сверху (аналог CPU DrawBandLetter).
procedure TSpectrumViewOpenGL.DrawBandLetterGL(X1, X2: Integer; L: Char);
var
idx, cx: Integer;
begin
if (L < 'A') or (L > 'H') then Exit;
if X2 <= X1 then Exit;
idx := Ord(L) - Ord('A');
if FLetterTex[idx].Tex = 0 then
UploadText(FLetterTex[idx], L, SliceColor(L), 8, True); // цвет слайса
cx := (X1 + X2) div 2;
DrawTexture(FLetterTex[idx], cx - FLetterTex[idx].W div 2, 0);
end;
procedure TSpectrumViewOpenGL.DrawAGCLines(W, H: Integer; DBmax,
InvRange: Double);
var
AGCY, AGCHangY: Integer;
Text: string;
begin
if FWDSPReady then
begin
AGCY := Round((DBmax - FAGCThresh) * InvRange * H);
Text := 'AGC T';
if (AGCY >= 0) and (AGCY < H) then
begin
DrawLine(0, AGCY, W, AGCY, FTheme.SpecAgcColor, 1, True);
if (Text <> FLastAGCText) or (AGCY <> FLastAGCY) or FAGCLabelTex.Dirty then
begin
UploadText(FAGCLabelTex, Text, FTheme.SpecAgcColor, 6, False);
FLastAGCText := Text;
FLastAGCY := AGCY;
end;
DrawTexture(FAGCLabelTex, 4, AGCY - 9);
end;
AGCHangY := Round((DBmax - FAGCHangLevel) * InvRange * H);
if (AGCHangY >= 0) and (AGCHangY < H) and (Abs(AGCHangY - AGCY) > 4) then
begin
DrawLine(0, AGCHangY, W, AGCHangY, FTheme.SpecAgcHangColor, 1, True);
if (AGCHangY <> FLastAGCHangY) or FAGCHangLabelTex.Dirty then
begin
UploadText(FAGCHangLabelTex, 'AGC H', FTheme.SpecAgcHangColor, 6, False);
FLastAGCHangY := AGCHangY;
end;
DrawTexture(FAGCHangLabelTex, 4, AGCHangY + 2);
end;
end
else
begin
AGCY := Round((DBmax - (-FAGCTop)) * InvRange * H);
Text := Format('AGC -%ddB', [FAGCTop]);
if (AGCY >= 0) and (AGCY < H) then
begin
DrawLine(0, AGCY, W, AGCY, FTheme.SpecAgcColor, 1, True);
if (Text <> FLastAGCText) or (AGCY <> FLastAGCY) or FAGCLabelTex.Dirty then
begin
UploadText(FAGCLabelTex, Text, FTheme.SpecAgcColor, 6, False);
FLastAGCText := Text;
FLastAGCY := AGCY;
end;
DrawTexture(FAGCLabelTex, 4, AGCY - 9);
end;
end;
end;
procedure TSpectrumViewOpenGL.DrawSpectrumCurve(W, H: Integer; DBmax,
InvRange: Double);
var
I, SrcCount, S0, S1: Integer;
SrcF, Frac, DBV: Double;
R, G, B: GLFloat;
begin
if Length(FSpY) <> W then SetLength(FSpY, W);
SrcCount := ClampI(FSpectrumBufCount, 2, WF_MAX_PIXELS);
for I := 0 to W - 1 do
begin
if FTXMode and (FTXSpanHz > 0) and (FSpanHz > 0) then
begin
SrcF := FCenterFreq - FSpanHz * 0.5 + I * FSpanHz / Max(1, W - 1);
Frac := SrcF - FTXFreq;
if (Frac < -FTXSpanHz * 0.5) or (Frac > FTXSpanHz * 0.5) then DBV := -200.0
else
begin
SrcF := (Frac + FTXSpanHz * 0.5) / FTXSpanHz * (SrcCount - 1);
S0 := Min(Trunc(SrcF), SrcCount - 1);
S1 := Min(S0 + 1, SrcCount - 1);
Frac := SrcF - S0;
DBV := FSpectrumBuf[S0] * (1.0 - Frac) + FSpectrumBuf[S1] * Frac;
end;
end
else
begin
SrcF := I * (SrcCount - 1.0) / Max(1, W - 1);
S0 := Min(Trunc(SrcF), SrcCount - 1);
S1 := Min(S0 + 1, SrcCount - 1);
Frac := SrcF - S0;
DBV := FSpectrumBuf[S0] * (1.0 - Frac) + FSpectrumBuf[S1] * Frac;
end;
FSpY[I] := ClampI(Round((DBmax - DBV) * InvRange * H), 0, H - 1);
end;
ColorToRGB(TColor((FTheme.SpecGradB shl 16) or
(FTheme.SpecGradG shl 8) or FTheme.SpecGradR), R, G, B);
glBegin(GL_TRIANGLE_STRIP);
for I := 0 to W - 1 do
begin
glColor4f(R, G, B, 200 / 255);
glVertex2f(I + 0.5, FSpY[I] + 0.5);
glColor4f(R, G, B, 0);
glVertex2f(I + 0.5, H);
end;
glEnd;
ColorToRGB(FTheme.SpecLine, R, G, B);
glColor4f(R, G, B, 1);
glBegin(GL_LINE_STRIP);
for I := 0 to W - 1 do glVertex2f(I + 0.5, FSpY[I] + 0.5);
glEnd;
end;
procedure TSpectrumViewOpenGL.DrawMarker(W, H: Integer);
var
MX: Integer;
MarkerFreq: Double;
MarkerText: string;
begin
if not FMarkerActive then Exit;
MX := Round(FMarkerX / 1000.0 * W);
if (MX < 0) or (MX >= W) then Exit;
DrawLine(MX, 0, MX, H, TColor($004444FF), 1, False);
MarkerFreq := (FCenterFreq - FSpanHz / 2) + FMarkerX / 1000.0 * FSpanHz;
MarkerText := FormatFreqGL(Round(MarkerFreq));
if (MarkerText <> FLastMarkerText) or (MX <> FLastMarkerX) or FMarkerLabelTex.Dirty then
begin
UploadText(FMarkerLabelTex, MarkerText, TColor($004444FF), 7, False);
FLastMarkerText := MarkerText;
FLastMarkerX := MX;
end;
if MX + 4 + FMarkerLabelTex.W < W then DrawTexture(FMarkerLabelTex, MX + 4, 4)
else DrawTexture(FMarkerLabelTex, MX - 4 - FMarkerLabelTex.W, 4);
end;
procedure TSpectrumViewOpenGL.DrawBeaconMarkersGL(W, H: Integer);
// QO-100 beacon-маркеры: опорная частота (зелёная) + отслеживаемый центроид (оранж).
procedure Vline(FreqHz: Double; Col: TColor);
var x: Integer;
begin
if FSpanHz <= 0 then Exit;
x := Round((FreqHz - (FCenterFreq - FSpanHz / 2)) / FSpanHz * W);
if (x < 0) or (x >= W) then Exit;
DrawLine(x, 0, x, H, Col, 1, False);
end;
begin
if FBeaconMarkActive then
begin
Vline(FBeaconRefFreq, clLime); // где маяк ДОЛЖЕН быть
Vline(FBeaconTrkFreq, TColor($000AA5FF)); // отслеживаемый центроид (оранж)
end;
if FBeaconDecActive then
begin
Vline(FBeaconDecFreq - FBeaconDecHalf, TColor($0020D0FF)); // грань фильтра
Vline(FBeaconDecFreq + FBeaconDecHalf, TColor($0020D0FF));
Vline(FBeaconDecFreq, TColor($0020D0FF)); // центр наведения
end;
end;
procedure TSpectrumViewOpenGL.DrawADCOverlay(W, H: Integer);
var
B: TBitmap;
begin
if not FADCOverloadVisible then Exit;
if (not FLastADCVisible) or FADCOverlayTex.Dirty then
begin
B := TBitmap.Create;
try
B.PixelFormat := pf32bit;
B.SetSize(210, 38);
B.Canvas.Brush.Color := TColor($00202020);
B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
B.Canvas.Pen.Color := TColor($000030C0);
B.Canvas.Brush.Style := bsClear;
B.Canvas.Rectangle(0, 0, B.Width, B.Height);
B.Canvas.Font.Name := 'Courier New';
B.Canvas.Font.Size := 10;
B.Canvas.Font.Style := [fsBold];
B.Canvas.Font.Color := TColor($000030C0);
B.Canvas.TextOut(12, 5, 'ADC OVERLOAD');
B.Canvas.Font.Size := 7;
B.Canvas.Font.Style := [];
B.Canvas.Font.Color := TColor($00D0D0D0);
B.Canvas.TextOut(12, 21, 'Input clipping detected');
UploadBitmap(FADCOverlayTex, B, False, 232);
finally
B.Free;
end;
end;
FLastADCVisible := True;
DrawTexture(FADCOverlayTex, (W - FADCOverlayTex.W) div 2, 8);
end;
procedure TSpectrumViewOpenGL.DrawCachedOverlays(W, H: Integer);
var
B: TBitmap;
OW, OH: Integer;
begin
// Бэндплан QO-100 — полоска внизу спектра (над ruler), под панелями оверлеев.
if Assigned(BandPlanOverlay) and BandPlanOverlay.Active then
begin
if FOverlayDirty or FBandOverlayDirty or FBandOverlayTex.Dirty or
(FLastBandW <> W) or
(Abs(FLastBandCenter - BandPlanOverlay.CenterFreq) >= 1.0) or
(Abs(FLastBandSpan - BandPlanOverlay.SpanHz) >= 1.0) then
begin
B := TBitmap.Create;
try
BandPlanOverlay.DrawOverlayBitmap(B, W);
UploadBitmap(FBandOverlayTex, B, False, BANDPLAN_ALPHA);
finally
B.Free;
end;
FLastBandW := W;
FLastBandCenter := BandPlanOverlay.CenterFreq;
FLastBandSpan := BandPlanOverlay.SpanHz;
FBandOverlayDirty := False;
end;
DrawTexture(FBandOverlayTex, 0, H - FBandOverlayTex.H);
end;
if Assigned(FSampleRateOverlay) then
begin
OW := Min(FSampleRateOverlay.Width, W - FSampleRateOverlay.Left);
OH := Min(FSampleRateOverlay.Height, H - FSampleRateOverlay.Top);
if (OW > 0) and (OH > 0) then
begin
if FOverlayDirty or FSampleOverlayDirty or FSampleOverlayTex.Dirty or
(FLastSampleX <> FSampleRateOverlay.Left) or
(FLastSampleY <> FSampleRateOverlay.Top) or
(FLastSampleH <> OH) then
begin
B := TBitmap.Create;
try
FSampleRateOverlay.DrawOverlayBitmap(B, OW, OH);
UploadBitmap(FSampleOverlayTex, B, False, 255);
finally
B.Free;
end;
FLastSampleX := FSampleRateOverlay.Left;
FLastSampleY := FSampleRateOverlay.Top;
FLastSampleW := FSampleOverlayTex.W;
FLastSampleH := OH;
FSampleOverlayDirty := False;
end;
DrawTexture(FSampleOverlayTex, FSampleRateOverlay.Left, FSampleRateOverlay.Top);
end;
end;
if Assigned(FVfoOverlay) and FVfoOverlay.Visible then
begin
if FOverlayDirty or FVfoOverlayDirty or FVfoOverlayTex.Dirty or
FVfoOverlay.CacheDirty or FVfoOverlay.MeterDirty or
(FLastVfoX <> FVfoOverlay.Left) or (FLastVfoY <> FVfoOverlay.Top) or
(FLastVfoW <> FVfoOverlay.Width) or (FLastVfoH <> FVfoOverlay.Height) then
begin
UploadBitmap(FVfoOverlayTex, FVfoOverlay.EnsureRendered, True, VFO_OVERLAY_ALPHA);
FLastVfoX := FVfoOverlay.Left;
FLastVfoY := FVfoOverlay.Top;
FLastVfoW := FVfoOverlay.Width;
FLastVfoH := FVfoOverlay.Height;
FVfoOverlayDirty := False;
end;
DrawTexture(FVfoOverlayTex, FVfoOverlay.Left, FVfoOverlay.Top);
end;
DrawSliceOverlays(W, H);
FOverlayDirty := False;
end;
function TSpectrumViewOpenGL.SliceTexIndex(O: TVfoOverlay): Integer;
var i: Integer;
begin
Result := -1;
for i := 0 to High(FSliceTex) do
if FSliceTex[i].Overlay = O then Exit(i);
end;
// Флаги слайсов (B+): своя GL-текстура на флаг (привязка по указателю оверлея).
// Текстуры «сирот» (флаг удалён) вычищаются здесь же.
procedure TSpectrumViewOpenGL.DrawSliceOverlays(W, H: Integer);
var
n, i, ti, j: Integer;
O: TVfoOverlay;
Alive: Boolean;
begin
// 1. Убрать текстуры флагов, которых уже нет в списке.
i := 0;
while i <= High(FSliceTex) do
begin
Alive := False;
for j := 0 to SliceOverlayCount - 1 do
if SliceOverlayAt(j) = FSliceTex[i].Overlay then begin Alive := True; Break; end;
if not Alive then
begin
DeleteTexture(FSliceTex[i].Tex);
for j := i to High(FSliceTex) - 1 do FSliceTex[j] := FSliceTex[j + 1];
SetLength(FSliceTex, Length(FSliceTex) - 1);
end
else
Inc(i);
end;
// 2. Нарисовать каждый видимый флаг, при нужде (пере)залив текстуру.
n := SliceOverlayCount;
for i := 0 to n - 1 do
begin
O := SliceOverlayAt(i);
if (O = nil) or (not O.Visible) then Continue;
ti := SliceTexIndex(O);
if ti < 0 then
begin
SetLength(FSliceTex, Length(FSliceTex) + 1);
ti := High(FSliceTex);
FSliceTex[ti].Overlay := O;
FSliceTex[ti].Tex.Dirty := True;
FSliceTex[ti].LastX := MaxInt; // форсируем первую заливку
end;
// Перезаливаем текстуру слайса ТОЛЬКО когда изменился он сам (CacheDirty:
// режим/громкость, MeterDirty: S-метр) или его позиция — не по глобальному
// FOverlayDirty. При MeterDirty EnsureRendered перерисует лишь полоску метра.
if O.CacheDirty or O.MeterDirty or FSliceTex[ti].Tex.Dirty or
(FSliceTex[ti].LastX <> O.Left) or (FSliceTex[ti].LastY <> O.Top) or
(FSliceTex[ti].LastW <> O.Width) or (FSliceTex[ti].LastH <> O.Height) then
begin
UploadBitmap(FSliceTex[ti].Tex, O.EnsureRendered, True, VFO_OVERLAY_ALPHA);
FSliceTex[ti].LastX := O.Left;
FSliceTex[ti].LastY := O.Top;
FSliceTex[ti].LastW := O.Width;
FSliceTex[ti].LastH := O.Height;
end;
DrawTexture(FSliceTex[ti].Tex, O.Left, O.Top);
end;
end;
procedure TSpectrumViewOpenGL.PaintSpectrum(Sender: TObject);
var
W, H: Integer;
DBmax, DBmin, InvRange: Double;
begin
if Sender is TOpenGLControl then
FGLControl := TOpenGLControl(Sender);
if (FGLControl = nil) or (not FGLControl.MakeCurrent) then Exit;
W := FGLControl.Width;
H := FGLControl.Height;
if (W <= 0) or (H <= 0) then Exit;
// HiDPI: viewport в физических пикселях FBO, координаты — логические
glViewport(0, 0, Round(W * FGLControl.PixelScale),
Round(H * FGLControl.PixelScale));
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0, W, H, 0, -1, 1);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glDisable(GL_DEPTH_TEST);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glClearColor(0, 0, 0, 1);
glClear(GL_COLOR_BUFFER_BIT);
DBmax := FSpecRefLevel;
DBmin := FSpecRefLevel - FSpecRange;
InvRange := 1.0 / (DBmax - DBmin);
DrawVerticalGradient(W, H);
DrawGrid(W, H, DBmax, DBmin, InvRange);
DrawFilterAndCursors(W, H);
DrawAGCLines(W, H, DBmax, InvRange);
DrawSpectrumCurve(W, H, DBmax, InvRange);
DrawMarker(W, H);
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersGL(W, H);
DrawADCOverlay(W, H);
DrawCachedOverlays(W, H);
FLastADCVisible := FADCOverloadVisible;
FGLControl.SwapBuffers;
end;
end.