mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
1231 lines
43 KiB
ObjectPascal
1231 lines
43 KiB
ObjectPascal
{
|
||
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.
|