diff --git a/MainForm.pas b/MainForm.pas
index ae19889..dbe7be8 100644
--- a/MainForm.pas
+++ b/MainForm.pas
@@ -431,7 +431,7 @@ type
PbSpectrum: TControl;
PbRuler: TPaintBox; // полоса частотных меток между спектром и водопадом
PanelSplitter: TPanel; // перетаскиваемый разделитель спектр/водопад
- PbWaterfall: TPaintBox;
+ PbWaterfall: TControl;
// ---- Status bar ----
StatusPanel: TMainStatusBar;
@@ -1469,6 +1469,8 @@ begin
FSplitterDrag := False;
FUseOpenGLSpectrum := HasOpenGLSpectrumSwitch;
+ if FUseOpenGLSpectrum then
+ FWaterfallFrameInterval := 1;
if FUseOpenGLSpectrum then
FSpecView := TSpectrumViewOpenGL.Create
else
@@ -2186,12 +2188,26 @@ begin
PanelSplitter.OnMouseMove := SplitterMouseMove;
PanelSplitter.OnMouseUp := SplitterMouseUp;
- PbWaterfall := TPaintBox.Create(Self);
+ if FUseOpenGLSpectrum then
+ begin
+ PbWaterfall := TOpenGLControl.Create(Self);
+ TOpenGLControl(PbWaterfall).AutoResizeViewport := False;
+ TOpenGLControl(PbWaterfall).DoubleBuffered := True;
+ TOpenGLControl(PbWaterfall).OnPaint := FSpecView.PaintWaterfall;
+ TOpenGLControl(PbWaterfall).OnMouseDown := PbWaterfallMouseDown;
+ TOpenGLControl(PbWaterfall).OnMouseMove := PbWaterfallMouseMove;
+ TOpenGLControl(PbWaterfall).OnMouseUp := PbWaterfallMouseUp;
+ TSpectrumViewOpenGL(FSpecView).AttachWaterfallControl(TOpenGLControl(PbWaterfall));
+ end
+ else
+ begin
+ PbWaterfall := TPaintBox.Create(Self);
+ TPaintBox(PbWaterfall).OnPaint := FSpecView.PaintWaterfall;
+ TPaintBox(PbWaterfall).OnMouseDown := PbWaterfallMouseDown;
+ TPaintBox(PbWaterfall).OnMouseMove := PbWaterfallMouseMove;
+ TPaintBox(PbWaterfall).OnMouseUp := PbWaterfallMouseUp;
+ end;
PbWaterfall.Parent := PanelRight;
- PbWaterfall.OnPaint := FSpecView.PaintWaterfall;
- PbWaterfall.OnMouseDown := PbWaterfallMouseDown;
- PbWaterfall.OnMouseMove := PbWaterfallMouseMove;
- PbWaterfall.OnMouseUp := PbWaterfallMouseUp;
// Initial layout
ResizeSpectrumPanels;
@@ -2616,7 +2632,8 @@ begin
if PbSpectrum is TPaintBox then
TPaintBox(PbSpectrum).Color := T.BG;
- PbWaterfall.Color := T.BG;
+ if PbWaterfall is TPaintBox then
+ TPaintBox(PbWaterfall).Color := T.BG;
if PanelSMeterRight <> nil then PanelSMeterRight.Color := T.Panel;
if PbSMeterRight <> nil then PbSMeterRight.Color := T.Panel;
ApplyStatusTheme(T);
@@ -7025,8 +7042,12 @@ begin
if FPS > 100 then FPS := 100;
FDisplayFPS := FPS;
FSpectrumTimer.Interval := 1000 div FPS;
- // Thetis по умолчанию обновляет водопад через один display frame.
- FWaterfallFrameInterval := 2;
+ // CPU path keeps the historical every-other-frame waterfall update.
+ // OpenGL uploads only one texture row per frame, so it can match display FPS.
+ if FUseOpenGLSpectrum then
+ FWaterfallFrameInterval := 1
+ else
+ FWaterfallFrameInterval := 2;
FWaterfallFrameCounter := 0;
FWaterfallDirty := True;
FSpecView.WfFrameInterval := FWaterfallFrameInterval;
diff --git a/SpectrumView.pas b/SpectrumView.pas
index a6c0cd1..01599cd 100644
--- a/SpectrumView.pas
+++ b/SpectrumView.pas
@@ -117,7 +117,7 @@ type
procedure SetWfAGCOffset(V: Double);
function GetWfFrameInterval: Integer;
procedure SetWfFrameInterval(V: Integer);
- procedure SetPbWaterfall(V: TPaintBox);
+ procedure SetPbWaterfall(V: TControl);
// SMeter sub-view delegating accessors
function GetLastSMeter: Double;
procedure SetLastSMeter(V: Double);
@@ -195,7 +195,7 @@ type
property WfFrameInterval: Integer read GetWfFrameInterval write SetWfFrameInterval;
// ── Ссылки на PaintBox ────────────────────────────────────────────────────
- property PbWaterfall: TPaintBox write SetPbWaterfall;
+ property PbWaterfall: TControl write SetPbWaterfall;
property PbRuler: TPaintBox write SetPbRuler;
property PbSMeterRight: TPaintBox write SetPbSMeterRight;
property SampleRateOverlay: TSampleRateOverlay read FSampleRateOverlay write FSampleRateOverlay;
@@ -410,7 +410,7 @@ function TSpectrumView.GetWfAGCOffset: Double; begin Result := FWaterfall.
procedure TSpectrumView.SetWfAGCOffset(V: Double); begin FWaterfall.WfAGCOffset := V; end;
function TSpectrumView.GetWfFrameInterval: Integer; begin Result := FWaterfall.WfFrameInterval; end;
procedure TSpectrumView.SetWfFrameInterval(V: Integer); begin FWaterfall.WfFrameInterval := V; end;
-procedure TSpectrumView.SetPbWaterfall(V: TPaintBox); begin FWaterfall.PbWaterfall := V; end;
+procedure TSpectrumView.SetPbWaterfall(V: TControl); begin FWaterfall.PbWaterfall := V; end;
function TSpectrumView.GetLastSMeter: Double; begin Result := FSMeter.LastSMeter; end;
procedure TSpectrumView.SetLastSMeter(V: Double); begin FSMeter.LastSMeter := V; end;
diff --git a/SpectrumViewOpengl.pas b/SpectrumViewOpengl.pas
index 1a3504a..b3817e4 100644
--- a/SpectrumViewOpengl.pas
+++ b/SpectrumViewOpengl.pas
@@ -17,7 +17,7 @@ interface
uses
Classes, SysUtils, Graphics, Controls, Math, Types,
OpenGLContext, GL,
- AppTheme, SpectrumView;
+ AppTheme, SpectrumView, WaterfallViewOpengl;
type
TGLTextureCache = record
@@ -83,6 +83,7 @@ type
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;
@@ -114,6 +115,9 @@ end;
constructor TSpectrumViewOpenGL.Create;
begin
inherited Create;
+ FWaterfall.Free;
+ FWaterfall := TWaterfallViewOpenGL.Create;
+ FWaterfall.WfFrameInterval := 1;
FGridDirty := True;
FOverlayDirty := True;
FSampleOverlayDirty := True;
@@ -144,6 +148,12 @@ 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
diff --git a/WaterfallView.pas b/WaterfallView.pas
index 01e25be..37324c9 100644
--- a/WaterfallView.pas
+++ b/WaterfallView.pas
@@ -17,7 +17,7 @@ uses
type
TWaterfallView = class
- private
+ protected
FWaterfallBitmap: TBitmap;
FWfBitmap: TBitmap;
FWfBitmapW: Integer;
@@ -45,7 +45,7 @@ type
FMarkerX: Integer;
FTheme: TAppTheme;
FLightTheme: Boolean;
- FPbWaterfall: TPaintBox;
+ FPbWaterfall: TControl;
procedure DrawMarkerLine(C: TCanvas; W, H: Integer);
public
@@ -66,15 +66,15 @@ type
property WfFrameInterval: Integer read FWfFrameInterval write FWfFrameInterval;
property MarkerActive: Boolean read FMarkerActive write FMarkerActive;
property MarkerX: Integer read FMarkerX write FMarkerX;
- property PbWaterfall: TPaintBox write FPbWaterfall;
+ property PbWaterfall: TControl write FPbWaterfall;
- procedure SetWaterfallData(const Pixels: array of Single; Count: Integer);
- procedure DrawWaterfall;
- procedure PaintWaterfall(Sender: TObject);
- procedure SetWaterfallBitmapSize(W, H: Integer);
- procedure ResetWfAvgBuf;
- procedure ResetWfBuf;
- procedure SetTheme(const T: TAppTheme);
+ procedure SetWaterfallData(const Pixels: array of Single; Count: Integer); virtual;
+ procedure DrawWaterfall; virtual;
+ procedure PaintWaterfall(Sender: TObject); virtual;
+ procedure SetWaterfallBitmapSize(W, H: Integer); virtual;
+ procedure ResetWfAvgBuf; virtual;
+ procedure ResetWfBuf; virtual;
+ procedure SetTheme(const T: TAppTheme); virtual;
end;
implementation
diff --git a/WaterfallViewOpengl.pas b/WaterfallViewOpengl.pas
new file mode 100644
index 0000000..00a2a4d
--- /dev/null
+++ b/WaterfallViewOpengl.pas
@@ -0,0 +1,520 @@
+unit WaterfallViewOpengl;
+
+{
+ OpenGL renderer for the waterfall pane.
+
+ The CPU path rebuilds a full bitmap after scrolling rows in memory. This
+ renderer keeps one GL texture and uploads only the newest waterfall row.
+}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, SysUtils, Graphics, Controls, Math,
+ OpenGLContext, GL,
+ AppTheme, WaterfallView;
+
+type
+ TWaterfallViewOpenGL = class(TWaterfallView)
+ private
+ FGLControl: TOpenGLControl;
+ FTexture: GLuint;
+ FTexW: Integer;
+ FTexH: Integer;
+ FLatestRow: Integer;
+ FRowPixels: array of Byte;
+ FMarkerTex: GLuint;
+ FMarkerTexW: Integer;
+ FMarkerTexH: Integer;
+ FMarkerText: string;
+
+ procedure DeleteTexture(var Tex: GLuint);
+ procedure EnsureTexture(W, H: Integer);
+ procedure UploadCurrentRow(W: Integer);
+ procedure DrawTextureWrapped(W, H: Integer);
+ procedure DrawMarker(W, H: Integer);
+ procedure UploadMarkerText(const S: string);
+ procedure UpdateLevels;
+ function FormatFreqGL(Hz: Double): string;
+ function ColorForDB(ValueDB, LowDB, HighDB: Double): LongWord;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure AttachControl(C: TOpenGLControl);
+ procedure SetWaterfallBitmapSize(W, H: Integer); override;
+ procedure DrawWaterfall; override;
+ procedure PaintWaterfall(Sender: TObject); override;
+ procedure SetTheme(const T: TAppTheme); override;
+ procedure ResetWfBuf; override;
+ procedure ResetWfAvgBuf; override;
+ end;
+
+implementation
+
+function EnsureByte(V: Integer): Byte;
+begin
+ if V < 0 then Result := 0
+ else if V > 255 then Result := 255
+ else Result := V;
+end;
+
+function TWaterfallViewOpenGL.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;
+
+constructor TWaterfallViewOpenGL.Create;
+begin
+ inherited Create;
+ FTexture := 0;
+ FMarkerTex := 0;
+ FTexW := 0;
+ FTexH := 0;
+ FLatestRow := 0;
+end;
+
+destructor TWaterfallViewOpenGL.Destroy;
+begin
+ if Assigned(FGLControl) and FGLControl.MakeCurrent then
+ begin
+ DeleteTexture(FTexture);
+ DeleteTexture(FMarkerTex);
+ end;
+ inherited Destroy;
+end;
+
+procedure TWaterfallViewOpenGL.AttachControl(C: TOpenGLControl);
+begin
+ FGLControl := C;
+end;
+
+procedure TWaterfallViewOpenGL.DeleteTexture(var Tex: GLuint);
+begin
+ if Tex <> 0 then glDeleteTextures(1, @Tex);
+ Tex := 0;
+end;
+
+function TWaterfallViewOpenGL.ColorForDB(ValueDB, LowDB, HighDB: Double): LongWord;
+const
+ NSTOPS = 8;
+ SR: array[0..NSTOPS-1] of Integer = (224, 160, 20, 0, 0, 220, 255, 255);
+ SG: array[0..NSTOPS-1] of Integer = (230, 185, 80, 185, 200, 210, 90, 20);
+ SB: array[0..NSTOPS-1] of Integer = (232, 210, 200, 210, 80, 0, 0, 20);
+var
+ Overall, Local, T: Double;
+ Seg, R, G, B: Integer;
+begin
+ if FLightTheme then
+ begin
+ if ValueDB <= LowDB then begin Result := $FFE0E6E8; Exit; end;
+ if ValueDB >= HighDB then
+ begin
+ Result := ($FF shl 24) or (SR[NSTOPS-1] shl 16) or
+ (SG[NSTOPS-1] shl 8) or SB[NSTOPS-1];
+ Exit;
+ end;
+ T := (ValueDB - LowDB) / Max(1E-9, HighDB - LowDB) * (NSTOPS - 1);
+ Seg := Min(NSTOPS - 2, Trunc(T));
+ T := T - Seg;
+ R := EnsureRange(Round(SR[Seg] * (1.0 - T) + SR[Seg+1] * T), 0, 255);
+ G := EnsureRange(Round(SG[Seg] * (1.0 - T) + SG[Seg+1] * T), 0, 255);
+ B := EnsureRange(Round(SB[Seg] * (1.0 - T) + SB[Seg+1] * T), 0, 255);
+ Result := ($FF shl 24) or (R shl 16) or (G shl 8) or B;
+ Exit;
+ end;
+
+ if ValueDB <= LowDB then begin Result := $FF000000; Exit; end;
+ if ValueDB >= HighDB then
+ begin
+ Result := ($FF shl 24) or (255 shl 16) or (124 shl 8) or 192;
+ Exit;
+ end;
+ Overall := (ValueDB - LowDB) / Max(1E-9, HighDB - LowDB);
+ if Overall < (2.0 / 9.0) then
+ begin Local := Overall / (2.0/9.0); R := 0; G := 0; B := Round(Local * 255.0); end
+ else if Overall < (3.0 / 9.0) then
+ begin Local := (Overall - 2.0/9.0) / (1.0/9.0); R := 0; G := Round(Local*255.0); B := 255; end
+ else if Overall < (4.0 / 9.0) then
+ begin Local := (Overall - 3.0/9.0) / (1.0/9.0); R := 0; G := 255; B := Round((1.0-Local)*255.0); end
+ else if Overall < (5.0 / 9.0) then
+ begin Local := (Overall - 4.0/9.0) / (1.0/9.0); R := Round(Local*255.0); G := 255; B := 0; end
+ else if Overall < (7.0 / 9.0) then
+ begin Local := (Overall - 5.0/9.0) / (2.0/9.0); R := 255; G := Round((1.0-Local)*255.0); B := 0; end
+ else if Overall < (8.0 / 9.0) then
+ begin Local := (Overall - 7.0/9.0) / (1.0/9.0); R := 255; G := 0; B := Round(Local*255.0); end
+ else
+ begin
+ Local := (Overall - 8.0/9.0) / (1.0/9.0);
+ R := Round((0.75 + 0.25 * (1.0 - Local)) * 255.0);
+ G := Round(Local * 255.0 * 0.5);
+ B := 255;
+ end;
+ Result := ($FF shl 24) or (EnsureRange(R, 0, 255) shl 16) or
+ (EnsureRange(G, 0, 255) shl 8) or EnsureRange(B, 0, 255);
+end;
+
+procedure TWaterfallViewOpenGL.UpdateLevels;
+var
+ X, SrcCount, LowTargetCount, HighTargetCount, CumCount, HistIdx: Integer;
+ Hist: array[0..191] of Integer;
+ HistMinDB, HistMaxDB, HistStepDB, NoiseFloorDB, SignalTopDB: Double;
+ TargetLow, TargetHigh: Double;
+const
+ ALPHA_HIGH = 0.10;
+ ALPHA_LOW = 0.08;
+ WF_AUTO_OFFSET = -4.0;
+ WF_MIN_RANGE = 48.0;
+ WF_MAX_RANGE = 62.0;
+begin
+ SrcCount := EnsureRange(FWaterfallBufCount, 2, 1024);
+ FillChar(Hist, SizeOf(Hist), 0);
+ HistMinDB := -170.0;
+ HistMaxDB := 22.0;
+ HistStepDB := (HistMaxDB - HistMinDB) / Length(Hist);
+ for X := 0 to SrcCount - 1 do
+ begin
+ HistIdx := EnsureRange(Trunc((FWaterfallBuf[X] - HistMinDB) / HistStepDB), 0, High(Hist));
+ Inc(Hist[HistIdx]);
+ end;
+
+ LowTargetCount := Round(SrcCount * 0.30);
+ HighTargetCount := Round(SrcCount * 0.98);
+ CumCount := 0;
+ NoiseFloorDB := FWfLow;
+ SignalTopDB := FWfHigh;
+ for HistIdx := 0 to High(Hist) do
+ begin
+ Inc(CumCount, Hist[HistIdx]);
+ if CumCount >= LowTargetCount then
+ begin
+ NoiseFloorDB := HistMinDB + (HistIdx + 0.5) * HistStepDB;
+ Break;
+ end;
+ end;
+ CumCount := 0;
+ for HistIdx := 0 to High(Hist) do
+ begin
+ Inc(CumCount, Hist[HistIdx]);
+ if CumCount >= HighTargetCount then
+ begin
+ SignalTopDB := HistMinDB + (HistIdx + 0.5) * HistStepDB;
+ Break;
+ end;
+ end;
+
+ if FWfAGCEnabled then
+ begin
+ TargetLow := NoiseFloorDB + WF_AUTO_OFFSET + FWfAGCOffset;
+ if FWfNFEnabled then TargetHigh := Max(TargetLow + WF_MIN_RANGE, SignalTopDB + 6.0)
+ else TargetHigh := TargetLow + 52.0;
+ if TargetHigh > TargetLow + WF_MAX_RANGE then TargetHigh := TargetLow + WF_MAX_RANGE;
+ FWfLow := FWfLow + ALPHA_LOW * (TargetLow - FWfLow);
+ FWfHigh := FWfHigh + ALPHA_HIGH * (TargetHigh - FWfHigh);
+ end;
+end;
+
+procedure TWaterfallViewOpenGL.EnsureTexture(W, H: Integer);
+var
+ Bg: LongWord;
+ Pixels: array of Byte;
+ I: Integer;
+begin
+ if (W <= 0) or (H <= 0) then Exit;
+ if (FTexture <> 0) and (FTexW = W) and (FTexH = H) then Exit;
+ DeleteTexture(FTexture);
+ FTexW := W;
+ FTexH := H;
+ FLatestRow := 0;
+ SetLength(FRowPixels, W * 4);
+ SetLength(Pixels, W * H * 4);
+ Bg := ColorForDB(-130.0, FWfManualLow, FWfManualHigh);
+ for I := 0 to W * H - 1 do
+ begin
+ Pixels[I * 4] := Byte(Bg shr 16);
+ Pixels[I * 4 + 1] := Byte(Bg shr 8);
+ Pixels[I * 4 + 2] := Byte(Bg);
+ Pixels[I * 4 + 3] := $FF;
+ end;
+ glGenTextures(1, @FTexture);
+ glBindTexture(GL_TEXTURE_2D, FTexture);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
+ glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, W, H, 0, GL_RGBA,
+ GL_UNSIGNED_BYTE, @Pixels[0]);
+ glBindTexture(GL_TEXTURE_2D, 0);
+end;
+
+procedure TWaterfallViewOpenGL.UploadCurrentRow(W: Integer);
+var
+ X, SrcCount, S0, S1, Off: Integer;
+ SrcF, Step, Frac, DBV, WfHigh, WfLow: Double;
+ Pal: LongWord;
+begin
+ if (FTexture = 0) or (W <= 0) then Exit;
+ UpdateLevels;
+ WfHigh := FWfHigh;
+ WfLow := FWfLow;
+ if not FWfAGCEnabled then
+ begin
+ WfHigh := FWfManualHigh;
+ WfLow := FWfManualLow;
+ end;
+ if WfHigh < WfLow + 40.0 then WfHigh := WfLow + 40.0;
+ if WfHigh > 0.0 then WfHigh := 0.0;
+ if WfLow < -160 then WfLow := -160;
+
+ SrcCount := EnsureRange(FWaterfallBufCount, 2, 1024);
+ Step := (SrcCount - 1.0) / Max(1, W - 1);
+ SrcF := 0.0;
+ for X := 0 to W - 1 do
+ begin
+ if FTXMode and (FTXSpanHz > 0) and (FSpanHz > 0) then
+ begin
+ DBV := FCenterFreq - FSpanHz * 0.5 + X * FSpanHz / Max(1, W - 1) - FTXFreq;
+ if (DBV < -FTXSpanHz * 0.5) or (DBV > FTXSpanHz * 0.5) then
+ DBV := WfLow
+ else
+ begin
+ SrcF := (DBV + FTXSpanHz * 0.5) / FTXSpanHz * (SrcCount - 1);
+ S0 := Min(Trunc(SrcF), SrcCount - 2);
+ S1 := S0 + 1;
+ Frac := SrcF - S0;
+ DBV := FWaterfallBuf[S0] * (1.0 - Frac) + FWaterfallBuf[S1] * Frac;
+ end;
+ end
+ else
+ begin
+ S0 := Min(Trunc(SrcF), SrcCount - 2);
+ S1 := S0 + 1;
+ Frac := SrcF - S0;
+ DBV := FWaterfallBuf[S0] * (1.0 - Frac) + FWaterfallBuf[S1] * Frac;
+ end;
+ Pal := ColorForDB(DBV, WfLow, WfHigh);
+ Off := X * 4;
+ FRowPixels[Off] := Byte(Pal shr 16);
+ FRowPixels[Off + 1] := Byte(Pal shr 8);
+ FRowPixels[Off + 2] := Byte(Pal);
+ FRowPixels[Off + 3] := $FF;
+ SrcF := SrcF + Step;
+ end;
+
+ Dec(FLatestRow);
+ if FLatestRow < 0 then FLatestRow := FTexH - 1;
+ glBindTexture(GL_TEXTURE_2D, FTexture);
+ glTexSubImage2D(GL_TEXTURE_2D, 0, 0, FLatestRow, W, 1, GL_RGBA,
+ GL_UNSIGNED_BYTE, @FRowPixels[0]);
+ glBindTexture(GL_TEXTURE_2D, 0);
+end;
+
+procedure TWaterfallViewOpenGL.DrawTextureWrapped(W, H: Integer);
+var
+ FirstRows, SecondRows: Integer;
+ V0, V1: GLFloat;
+begin
+ if FTexture = 0 then Exit;
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, FTexture);
+ glColor4f(1, 1, 1, 1);
+
+ FirstRows := FTexH - FLatestRow;
+ V0 := FLatestRow / FTexH;
+ V1 := 1.0;
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, V0); glVertex2f(0, 0);
+ glTexCoord2f(1, V0); glVertex2f(W, 0);
+ glTexCoord2f(1, V1); glVertex2f(W, FirstRows);
+ glTexCoord2f(0, V1); glVertex2f(0, FirstRows);
+ glEnd;
+
+ SecondRows := FLatestRow;
+ if SecondRows > 0 then
+ begin
+ V0 := 0.0;
+ V1 := FLatestRow / FTexH;
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, V0); glVertex2f(0, FirstRows);
+ glTexCoord2f(1, V0); glVertex2f(W, FirstRows);
+ glTexCoord2f(1, V1); glVertex2f(W, H);
+ glTexCoord2f(0, V1); glVertex2f(0, H);
+ glEnd;
+ end;
+ glBindTexture(GL_TEXTURE_2D, 0);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+procedure TWaterfallViewOpenGL.UploadMarkerText(const S: string);
+var
+ B: TBitmap;
+ X, Y, I: Integer;
+ Src: PByte;
+ Buf: array of Byte;
+ A: Byte;
+begin
+ if S = '' then Exit;
+ B := TBitmap.Create;
+ try
+ B.PixelFormat := pf32bit;
+ B.SetSize(8, 8);
+ B.Canvas.Font.Name := 'Courier New';
+ B.Canvas.Font.Size := 7;
+ FMarkerTexW := B.Canvas.TextWidth(S) + 4;
+ FMarkerTexH := B.Canvas.TextHeight(S) + 2;
+ B.SetSize(FMarkerTexW, FMarkerTexH);
+ B.Canvas.Brush.Color := clBlack;
+ B.Canvas.FillRect(0, 0, FMarkerTexW, FMarkerTexH);
+ B.Canvas.Font.Name := 'Courier New';
+ B.Canvas.Font.Size := 7;
+ B.Canvas.Font.Color := clWhite;
+ B.Canvas.Brush.Style := bsClear;
+ B.Canvas.TextOut(2, 1, S);
+ SetLength(Buf, FMarkerTexW * FMarkerTexH * 4);
+ I := 0;
+ B.BeginUpdate(False);
+ try
+ for Y := 0 to FMarkerTexH - 1 do
+ begin
+ Src := PByte(B.ScanLine[Y]);
+ for X := 0 to FMarkerTexW - 1 do
+ begin
+ A := Max(Src[0], Max(Src[1], Src[2]));
+ Buf[I] := $FF;
+ Buf[I + 1] := $44;
+ Buf[I + 2] := $44;
+ Buf[I + 3] := A;
+ Inc(Src, 4);
+ Inc(I, 4);
+ end;
+ end;
+ finally
+ B.EndUpdate(False);
+ end;
+ if FMarkerTex = 0 then glGenTextures(1, @FMarkerTex);
+ glBindTexture(GL_TEXTURE_2D, FMarkerTex);
+ 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, FMarkerTexW, FMarkerTexH, 0,
+ GL_RGBA, GL_UNSIGNED_BYTE, @Buf[0]);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ FMarkerText := S;
+ finally
+ B.Free;
+ end;
+end;
+
+procedure TWaterfallViewOpenGL.DrawMarker(W, H: Integer);
+var
+ MX, TX: Integer;
+ MarkerFreq: Double;
+ S: string;
+begin
+ if not FMarkerActive then Exit;
+ MX := Round(FMarkerX / 1000.0 * W);
+ if (MX < 0) or (MX >= W) then Exit;
+ glColor4f(1.0, $44 / 255.0, $44 / 255.0, 1);
+ glBegin(GL_LINES);
+ glVertex2f(MX + 0.5, 0);
+ glVertex2f(MX + 0.5, H);
+ glEnd;
+ MarkerFreq := (FCenterFreq - FSpanHz / 2) + FMarkerX / 1000.0 * FSpanHz;
+ S := FormatFreqGL(Round(MarkerFreq));
+ if (S <> FMarkerText) or (FMarkerTex = 0) then UploadMarkerText(S);
+ if FMarkerTex = 0 then Exit;
+ if MX + 4 + FMarkerTexW < W then TX := MX + 4
+ else TX := MX - 4 - FMarkerTexW;
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, FMarkerTex);
+ glColor4f(1, 1, 1, 1);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(TX, 4);
+ glTexCoord2f(1, 0); glVertex2f(TX + FMarkerTexW, 4);
+ glTexCoord2f(1, 1); glVertex2f(TX + FMarkerTexW, 4 + FMarkerTexH);
+ glTexCoord2f(0, 1); glVertex2f(TX, 4 + FMarkerTexH);
+ glEnd;
+ glBindTexture(GL_TEXTURE_2D, 0);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+procedure TWaterfallViewOpenGL.SetWaterfallBitmapSize(W, H: Integer);
+begin
+ if (W <= 0) or (H <= 0) then Exit;
+ if Assigned(FGLControl) and FGLControl.MakeCurrent then
+ EnsureTexture(W, H);
+ FWaterfallDirty := True;
+end;
+
+procedure TWaterfallViewOpenGL.DrawWaterfall;
+begin
+ if Assigned(FGLControl) then FGLControl.Invalidate;
+end;
+
+procedure TWaterfallViewOpenGL.PaintWaterfall(Sender: TObject);
+var
+ W, H: Integer;
+ R, G, B: GLFloat;
+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;
+
+ glViewport(0, 0, W, H);
+ 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);
+ R := (FTheme.Panel and $FF) / 255.0;
+ G := ((FTheme.Panel shr 8) and $FF) / 255.0;
+ B := ((FTheme.Panel shr 16) and $FF) / 255.0;
+ glClearColor(R, G, B, 1);
+ glClear(GL_COLOR_BUFFER_BIT);
+
+ EnsureTexture(W, H);
+ if FWaterfallDirty then
+ begin
+ UploadCurrentRow(W);
+ FWaterfallDirty := False;
+ end;
+ DrawTextureWrapped(W, H);
+ DrawMarker(W, H);
+ FGLControl.SwapBuffers;
+end;
+
+procedure TWaterfallViewOpenGL.SetTheme(const T: TAppTheme);
+begin
+ inherited SetTheme(T);
+ if Assigned(FGLControl) and FGLControl.MakeCurrent then
+ DeleteTexture(FTexture);
+ FTexW := 0;
+ FTexH := 0;
+end;
+
+procedure TWaterfallViewOpenGL.ResetWfBuf;
+begin
+ inherited ResetWfBuf;
+ if Assigned(FGLControl) and FGLControl.MakeCurrent then
+ DeleteTexture(FTexture);
+ FTexW := 0;
+ FTexH := 0;
+end;
+
+procedure TWaterfallViewOpenGL.ResetWfAvgBuf;
+begin
+ inherited ResetWfAvgBuf;
+end;
+
+end.
diff --git a/ewsdr.lpi b/ewsdr.lpi
index a267581..f094009 100644
--- a/ewsdr.lpi
+++ b/ewsdr.lpi
@@ -222,6 +222,10 @@
+
+
+
+