Files
ewsdr/SpectrumViewOpengl.pas
T

1231 lines
43 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
{
Copyright (C)
2026 - Uladzimir Karpenka, EW8BAK
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
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, AlertOverlay, SpectrumView, VfoOverlay, BandPlanOverlay,
DXSpotOverlay,
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;
FDXOverlayDirty: Boolean;
FGridLabelTex: TGLTextureCache;
FAGCLabelTex: TGLTextureCache;
FAGCHangLabelTex: TGLTextureCache;
FMarkerLabelTex: TGLTextureCache;
FADCOverlayTex: TGLTextureCache;
FSampleOverlayTex: TGLTextureCache;
FVfoOverlayTex: TGLTextureCache;
FBandOverlayTex: TGLTextureCache;
FDXOverlayTex: 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;
// 2TON/IMD: текстуры подписей маркеров (0..3 = кружки, 4 = сводка IMD3)
FIMDLabelTex: array[0..4] of TGLTextureCache;
FIMDLastText: array[0..4] of string;
FLastADCVisible: Boolean;
FLastSampleX: Integer;
FLastSampleY: Integer;
FLastSampleW: Integer;
FLastSampleH: Integer;
FLastVfoX: Integer;
FLastVfoY: Integer;
FLastVfoW: Integer;
FLastVfoH: Integer;
FLastBandW: Integer;
FLastBandCenter: Double;
FLastBandSpan: Double;
FLastDXW: Integer;
FLastDXRender: Int64;
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 DrawDXSpotTicksGL(W, H: Integer);
procedure DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
procedure DrawIMDMarkersGL(W, H: Integer; DBmax, InvRange: Double);
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);
// Y начала вертикали несущей, чтобы она не легла на букву (двойник
// CPU-CarrierTopY; метрику берём из той же текстуры буквы).
function CarrierTopYGL(X1, X2, CarrierX: Integer; L: Char): Integer;
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 ResetGLCache;
procedure SetTheme(const T: TAppTheme); override;
end;
implementation
const
KEY_COLOR = TColor($00FF00FF);
// Полоса фильтра передающего тракта (главный VFO или TX-слайс): красная.
// TColor = $00BBGGRR (ColorToRGB читает младший байт как R).
CLR_TX_BAND = TColor($003030E0);
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;
FDXOverlayDirty := True;
FLastBandW := -MaxInt;
FLastBandCenter := -1; FLastBandSpan := -1;
FLastDXW := -MaxInt; FLastDXRender := -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);
DeleteTexture(FDXOverlayTex);
for i := 0 to High(FSliceTex) do DeleteTexture(FSliceTex[i].Tex);
for i := 0 to High(FLetterTex) do DeleteTexture(FLetterTex[i]);
for i := 0 to High(FIMDLabelTex) do DeleteTexture(FIMDLabelTex[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;
// Контекст пересоздан (смена MSAA → RecreateWnd): все GL-имена текстур
// стали недействительны. Обнуляем кэши БЕЗ glDelete — старого контекста
// уже нет, а в новом эти id могут достаться другим текстурам.
procedure TSpectrumViewOpenGL.ResetGLCache;
procedure Zap(var T: TGLTextureCache);
begin
T.Tex := 0; T.W := 0; T.H := 0; T.Dirty := True;
end;
var
i: Integer;
begin
Zap(FGridLabelTex);
Zap(FAGCLabelTex);
Zap(FAGCHangLabelTex);
Zap(FMarkerLabelTex);
Zap(FADCOverlayTex);
Zap(FSampleOverlayTex);
Zap(FVfoOverlayTex);
Zap(FDXOverlayTex);
Zap(FBandOverlayTex);
for i := 0 to High(FSliceTex) do Zap(FSliceTex[i].Tex);
for i := 0 to High(FLetterTex) do Zap(FLetterTex[i]);
for i := 0 to High(FIMDLabelTex) do
begin
Zap(FIMDLabelTex[i]);
FIMDLastText[i] := '';
end;
FLastAGCText := '';
FLastMarkerText := '';
FGridDirty := True;
FOverlayDirty := True;
FSampleOverlayDirty := True;
FVfoOverlayDirty := True;
FBandOverlayDirty := True;
FDXOverlayDirty := True;
FGLSpectrumW := 0;
FGLSpectrumH := 0;
// Водопад — свой контекст/текстуры (история + маркер). При reparent (pop-out)
// умирают ОБА контекста; при смене MSAA только спектровый — там сброс
// водопада лишь пере-зальёт его текстуру (дёшево, история и так в CPU-буфере).
if FWaterfall is TWaterfallViewOpenGL then
TWaterfallViewOpenGL(FWaterfall).ResetGLCache;
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, CarrY: Integer;
MainLetter: Char;
begin
TXX1 := 0;
TXX2 := 0;
TXVfoX := 0;
// На передаче полоса активного VFO рисуется по TX-фильтру (см. CPU-путь).
if FTXOverlay and (FTXVfoIndex = FActiveVfo) then
begin
if FActiveVfo = 0 then CalcTXBandX(FVfoA, W, X1, X2, VfoX)
else CalcTXBandX(FVfoB, W, X1, X2, VfoX);
end
else 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 CalcTXBandX(FVfoA, W, TXX1, TXX2, TXVfoX)
else CalcTXBandX(FVfoB, W, TXX1, TXX2, TXVfoX);
if TXX2 > TXX1 then DrawRect(TXX1, 0, TXX2, H, CLR_TX_BAND, 100 / 255);
end
else if X2 > X1 then DrawRect(X1, 0, X2, H, CLR_TX_BAND, 100 / 255);
end
else if X2 > X1 then
// Как у слайсов: полупрозрачная заливка (раньше здесь была alpha=1, и
// главная полоса выглядела плотным блоком рядом с просвечивающими).
// Цвет — SpecFilterBand, свой у полосы (см. AppTheme).
DrawRect(X1, 0, X2, H, FTheme.SpecFilterBand, SPEC_BAND_ALPHA / 255);
// Буква главного флага (A) на его полосе — только когда есть слайсы. Саму
// букву рисуем ниже, но знать о ней надо здесь: под неё уходит начало
// вертикали несущей и её «шляпка».
MainLetter := #0;
if (SliceOverlayCount > 0) and (FActiveVfo = 0) and Assigned(FVfoOverlay) then
MainLetter := FVfoOverlay.SliceLetter;
DrawLine(X1, 0, X1, H, FTheme.SpecFilterEdge, 1, False);
DrawLine(X2, 0, X2, H, FTheme.SpecFilterEdge, 1, False);
CarrY := CarrierTopYGL(X1, X2, VfoX, MainLetter);
DrawLine(VfoX, CarrY, VfoX, H - 12, FTheme.SpecVfoCursor, 2, False);
DrawRect(VfoX - 5, CarrY, VfoX + 5, CarrY + 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);
// Буква нарисована на RX-полосе (X1..X2) — с ней и сверяемся.
CarrY := CarrierTopYGL(X1, X2, TXVfoX, MainLetter);
DrawLine(TXVfoX, CarrY, TXVfoX, H - 12, TColor($002030E0), 2, False);
DrawRect(TXVfoX - 5, CarrY, TXVfoX + 5, CarrY + 8, TColor($002030E0), 1);
end;
if MainLetter <> #0 then DrawBandLetterGL(X1, X2, MainLetter);
DrawSliceFilterMarkers(W, H);
end;
// Маркер фильтра каждого слайса (B+) на спектре: полупрозрачная полоса
// пропускания + центральная несущая. Цвет — по букве слайса (как его бейдж).
procedure TSpectrumViewOpenGL.DrawSliceFilterMarkers(W, H: Integer);
var
i, SX1, SX2, SVfoX: Integer;
O: TVfoOverlay;
Clr: TColor;
begin
for i := 0 to SliceOverlayCount - 1 do
begin
O := SliceOverlayAt(i);
if (O = nil) or (not O.Visible) then Continue;
// Передающий слайс — красная полоса (как у главного при TX), иначе оттенок бейджа.
if O.TxActive then Clr := CLR_TX_BAND
else Clr := SliceColor(O.SliceLetter);
CalcSliceBandX(O, W, SX1, SX2, SVfoX);
if SX2 > SX1 then
DrawRect(SX1, 0, SX2, H, Clr,
IfThen(O.TxActive, SPEC_BAND_ALPHA_TX, SPEC_BAND_ALPHA) / 255);
DrawLine(SX1, 0, SX1, H, Clr, 1, False);
DrawLine(SX2, 0, SX2, H, Clr, 1, False);
// Несущая — под буквой, если она приходится на неё (AM/FM/DSB).
DrawLine(SVfoX, CarrierTopYGL(SX1, SX2, SVfoX, O.SliceLetter),
SVfoX, H - 12, 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;
function TSpectrumViewOpenGL.CarrierTopYGL(X1, X2, CarrierX: Integer;
L: Char): Integer;
// То же правило, что в CPU-пути: в модуляциях с несущей (AM/FM/DSB) вертикаль
// приходится ровно на букву — начинаем её ПОД буквой; в SSB/CW несущая у кромки
// полосы, пересечения нет и зазор нулевой. Текстуру буквы при необходимости
// заливаем здесь же: она нужна нам раньше, чем до неё дойдёт DrawBandLetterGL
// (порядок вызовов в кадре — линии, потом буквы).
const
CLEAR_X = 3;
CLEAR_Y = 2;
var
idx: Integer;
begin
Result := 0;
if (L < 'A') or (L > 'H') or (X2 <= X1) then Exit;
idx := Ord(L) - Ord('A');
if FLetterTex[idx].Tex = 0 then
UploadText(FLetterTex[idx], L, SliceColor(L), 8, True);
if FLetterTex[idx].H <= 0 then Exit;
if Abs(CarrierX - (X1 + X2) div 2) <= FLetterTex[idx].W div 2 + CLEAR_X then
Result := FLetterTex[idx].H + CLEAR_Y;
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.DrawDXSpotTicksGL(W, H: Integer);
// GL-двойник DrawDXSpotTicksRaw: те же X и цвета из раскладки оверлея, только
// линиями GL. EnsureRendered здесь и держит раскладку свежей — текстуру полосы
// DrawCachedOverlays перезальёт по RenderVersion, кто бы ни пересобрал кэш.
var
i, X, Y0: Integer;
Col: TColor;
begin
if (FDXSpotOverlay = nil) or (not FDXSpotOverlay.Active) then Exit;
FDXSpotOverlay.EnsureRendered(W);
Y0 := FDXSpotOverlay.BandHeight;
// Низкий пан: полоса подписей не влезла (её текстуру DrawCachedOverlays тоже
// пропускает) — штрихам не от чего идти.
if H <= Y0 + 2 then Exit;
for i := 0 to FDXSpotOverlay.TickCount - 1 do
begin
FDXSpotOverlay.Tick(i, X, Col);
if (X < 0) or (X >= W) then Continue;
DrawLine(X, Y0, X, H, Col, 1, True); // пунктир — как в CPU-пути
end;
end;
procedure TSpectrumViewOpenGL.DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
// Залитый кружок (triangle fan, 20 сегментов) — маркер пика 2TON/IMD.
var
CR, CG, CB: GLFloat;
a: Integer;
Ang: Single;
begin
ColorToRGB(C, CR, CG, CB);
glColor4f(CR, CG, CB, 1);
glBegin(GL_TRIANGLE_FAN);
glVertex2f(CX + 0.5, CY + 0.5);
for a := 0 to 20 do
begin
Ang := a * 2 * Pi / 20;
glVertex2f(CX + 0.5 + R * Cos(Ang), CY + 0.5 + R * Sin(Ang));
end;
glEnd;
end;
procedure TSpectrumViewOpenGL.DrawIMDMarkersGL(W, H: Integer;
DBmax, InvRange: Double);
// GL-вариант DrawIMDMarkersRaw: замер общий (ComputeIMDMarkers), подписи —
// текстуры с кэшем по строке (перезаливка только при смене значения).
const
CLR_TONE = TColor($0050FF50); // зелёный — основные тона
CLR_IMD = TColor($000A8CFF); // оранжевый — продукты IMD3
var
M: array[0..3] of TIMDMarker;
N, i, X, Y, TX, TY, BX1, BX2, BVX: Integer;
Col: TColor;
begin
if FSpanHz <= 0 then Exit;
N := ComputeIMDMarkers(M);
if N = 0 then Exit;
for i := 0 to N - 1 do
begin
if M[i].LevelDB < -500 then Continue; // частота вне окна буфера
X := Round((M[i].FreqHz - (FCenterFreq - FSpanHz / 2)) / FSpanHz * W);
if (X < 0) or (X >= W) then Continue;
Y := Max(0, Min(H - 1, Round((DBmax - M[i].LevelDB) * InvRange * H)));
// Все маркеры зелёные (dBm-замеры); оранжевый — только вычисленная
// сводка dBc, чтобы цвета не путались.
Col := CLR_TONE;
DrawCircleGL(X, Y, 4.0, Col);
if (M[i].Caption <> FIMDLastText[i]) or FIMDLabelTex[i].Dirty then
begin
UploadText(FIMDLabelTex[i], M[i].Caption, Col, 7, True);
FIMDLastText[i] := M[i].Caption;
end;
// Подпись по центру над своим кружком; у верхней кромки — под ним.
TY := Y - 16;
if TY < 2 then TY := Y + 8;
TX := Max(2, Min(W - FIMDLabelTex[i].W - 2, X - FIMDLabelTex[i].W div 2));
DrawTexture(FIMDLabelTex[i], TX, TY);
end;
// Сводка слева от полосы фильтра, чтобы не прятаться за SampleRateOverlay
// в левом верхнем углу и сразу бросаться в глаза рядом с сигналом.
if FIMDSummary <> '' then
begin
if (FIMDSummary <> FIMDLastText[4]) or FIMDLabelTex[4].Dirty then
begin
UploadText(FIMDLabelTex[4], FIMDSummary, CLR_IMD, 11, True);
FIMDLastText[4] := FIMDSummary;
end;
if FActiveVfo = 0 then CalcFilterBandX(FVfoA, W, BX1, BX2, BVX)
else CalcFilterBandX(FVfoB, W, BX1, BX2, BVX);
TX := Max(2, Min(W - FIMDLabelTex[4].W - 2,
BX1 - FIMDLabelTex[4].W - 8));
DrawTexture(FIMDLabelTex[4], TX, 6);
end;
end;
procedure TSpectrumViewOpenGL.DrawADCOverlay(W, H: Integer);
// Тот же образ, что CPU-путь (AlertOverlay.BuildAlertImage — единственный
// источник внешнего вида): грузится текстурой ОДИН раз при появлении плашки
// (кэш FADCOverlayTex), в кадре — только готовый DrawTexture.
var
Img: TAlertImage;
begin
if not FADCOverloadVisible then Exit;
if (W < 220) or (H < 60) then Exit; // как CPU-путь
if (not FLastADCVisible) or FADCOverlayTex.Dirty then
begin
BuildAlertImage('ADC OVERLOAD', 'Input clipping detected', Img);
if FADCOverlayTex.Tex = 0 then glGenTextures(1, @FADCOverlayTex.Tex);
FADCOverlayTex.W := Img.W;
FADCOverlayTex.H := Img.H;
glBindTexture(GL_TEXTURE_2D, FADCOverlayTex.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, Img.W, Img.H, 0, GL_RGBA,
GL_UNSIGNED_BYTE, @Img.RGBA[0]);
glBindTexture(GL_TEXTURE_2D, 0);
FADCOverlayTex.Dirty := False;
end;
FLastADCVisible := True;
DrawTexture(FADCOverlayTex, W - FADCOverlayTex.W - ALERT_PAD, ALERT_PAD);
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;
// Полоса подписей DX-спотов — вверху спектра. Тот же битмап, что в CPU-пути,
// заливается текстурой ТОЛЬКО при dirty (новый спот меняет CacheDirty
// оверлея, вид — центр/спан/ширину).
// Низкому пану полоса подписей не по росту — пропускаем её целиком (тот же
// гейт, что в CPU-пути DrawOverlay).
if Assigned(FDXSpotOverlay) and FDXSpotOverlay.Active and
(H > FDXSpotOverlay.BandHeight) then
begin
if FOverlayDirty or FDXOverlayDirty or FDXOverlayTex.Dirty or
(FLastDXW <> W) or (FLastDXRender <> FDXSpotOverlay.RenderVersion) then
begin
B := TBitmap.Create;
try
FDXSpotOverlay.DrawOverlayBitmap(B, W);
UploadBitmap(FDXOverlayTex, B, True, DXSPOT_ALPHA);
finally
B.Free;
end;
FLastDXW := W;
FLastDXRender := FDXSpotOverlay.RenderVersion;
FDXOverlayDirty := False;
end;
DrawTexture(FDXOverlayTex, 0, 0);
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);
DrawDXSpotTicksGL(W, H);
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
if FIMDActive then DrawIMDMarkersGL(W, H, DBmax, InvRange);
DrawADCOverlay(W, H);
DrawCachedOverlays(W, H);
FLastADCVisible := FADCOverloadVisible;
FGLControl.SwapBuffers;
end;
end.