From 50908385633cdf6e5d493f00eb2ef5a49e48b051 Mon Sep 17 00:00:00 2001 From: Uladzimir Karpenka Date: Mon, 25 May 2026 20:16:37 +0300 Subject: [PATCH] Add OpenGL spectrum renderer --- MainForm.pas | 71 +++- SampleRateOverlay.pas | 41 +++ SpectrumView.pas | 48 +-- SpectrumViewOpengl.pas | 772 +++++++++++++++++++++++++++++++++++++++++ VfoOverlay.pas | 14 + ewsdr.lpi | 7 + ewsdr.lpr | 3 +- 7 files changed, 921 insertions(+), 35 deletions(-) create mode 100644 SpectrumViewOpengl.pas diff --git a/MainForm.pas b/MainForm.pas index 3c9a062..ae19889 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -25,6 +25,7 @@ uses Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, SampleRateOverlay, FlatButton, FlatSlider, FlatDropDown, AppTheme, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, Math, Types, + OpenGLContext, FlatProgressBar, LCLIntf, LCLType, GraphType, HPSDRProtocol, HPSDRNetwork, @@ -32,7 +33,7 @@ uses Settings, WebServer, CATEngine, CATSerial, CATTcp, - SpectrumView, + SpectrumView, SpectrumViewOpengl, StatusBar, WinFirewall; @@ -265,6 +266,7 @@ type // ---- Spectrum / Waterfall view ---- FSpecView: TSpectrumView; + FUseOpenGLSpectrum: Boolean; FSpectrumWidth: Integer; // актуальная ширина для FDSPEngine и resize-детектора FSpectrumHeight: Integer; FWaterfallHeight:Integer; @@ -426,7 +428,7 @@ type // ---- Right panel ---- PanelRight: TPanel; - PbSpectrum: TPaintBox; + PbSpectrum: TControl; PbRuler: TPaintBox; // полоса частотных меток между спектром и водопадом PanelSplitter: TPanel; // перетаскиваемый разделитель спектр/водопад PbWaterfall: TPaintBox; @@ -766,6 +768,20 @@ uses SettingsForm; {$R *.lfm} +function HasOpenGLSpectrumSwitch: Boolean; +var + I: Integer; + S: string; +begin + Result := False; + for I := 1 to ParamCount do + begin + S := LowerCase(ParamStr(I)); + if (S = '--opengl') or (S = '-opengl') or (S = '/opengl') then + Exit(True); + end; +end; + function TMainForm.LeftPanelButtonWidth(PanelWidth, ColCount, ColIndex: Integer): Integer; var @@ -1452,7 +1468,11 @@ begin FSplitterRatio := 0.40; FSplitterDrag := False; - FSpecView := TSpectrumView.Create; + FUseOpenGLSpectrum := HasOpenGLSpectrumSwitch; + if FUseOpenGLSpectrum then + FSpecView := TSpectrumViewOpenGL.Create + else + FSpecView := TSpectrumView.Create; FSpecView.VfoOverlay := FVfoOverlay; FSpecView.VfoA := FVfoA; FSpecView.VfoB := FVfoB; @@ -2124,14 +2144,30 @@ begin PbSMeterRight.OnPaint := FSpecView.PaintSMeterRight; PbSMeterRight.Color := CLR_PANEL; - PbSpectrum := TPaintBox.Create(Self); + if FUseOpenGLSpectrum then + begin + PbSpectrum := TOpenGLControl.Create(Self); + TOpenGLControl(PbSpectrum).AutoResizeViewport := False; + TOpenGLControl(PbSpectrum).DoubleBuffered := True; + TOpenGLControl(PbSpectrum).OnPaint := FSpecView.PaintSpectrum; + TOpenGLControl(PbSpectrum).OnMouseDown := PbSpectrumMouseDown; + TOpenGLControl(PbSpectrum).OnDblClick := PbSpectrumDblClick; + TOpenGLControl(PbSpectrum).OnMouseMove := PbSpectrumMouseMove; + TOpenGLControl(PbSpectrum).OnMouseUp := PbSpectrumMouseUp; + TOpenGLControl(PbSpectrum).OnMouseLeave := PbSpectrumMouseLeave; + TSpectrumViewOpenGL(FSpecView).AttachControl(TOpenGLControl(PbSpectrum)); + end + else + begin + PbSpectrum := TPaintBox.Create(Self); + TPaintBox(PbSpectrum).OnPaint := FSpecView.PaintSpectrum; + TPaintBox(PbSpectrum).OnMouseDown := PbSpectrumMouseDown; + TPaintBox(PbSpectrum).OnDblClick := PbSpectrumDblClick; + TPaintBox(PbSpectrum).OnMouseMove := PbSpectrumMouseMove; + TPaintBox(PbSpectrum).OnMouseUp := PbSpectrumMouseUp; + TPaintBox(PbSpectrum).OnMouseLeave := PbSpectrumMouseLeave; + end; PbSpectrum.Parent := PanelRight; - PbSpectrum.OnPaint := FSpecView.PaintSpectrum; - PbSpectrum.OnMouseDown := PbSpectrumMouseDown; - PbSpectrum.OnDblClick := PbSpectrumDblClick; - PbSpectrum.OnMouseMove := PbSpectrumMouseMove; - PbSpectrum.OnMouseUp := PbSpectrumMouseUp; - PbSpectrum.OnMouseLeave := PbSpectrumMouseLeave; PbRuler := TPaintBox.Create(Self); PbRuler.Parent := PanelRight; @@ -2578,7 +2614,8 @@ begin DP(PanelRX); DP(PanelTX); DP(PanelRight); - PbSpectrum.Color := T.BG; + if PbSpectrum is TPaintBox then + TPaintBox(PbSpectrum).Color := T.BG; PbWaterfall.Color := T.BG; if PanelSMeterRight <> nil then PanelSMeterRight.Color := T.Panel; if PbSMeterRight <> nil then PbSMeterRight.Color := T.Panel; @@ -2732,7 +2769,11 @@ end; procedure TMainForm.OnSampleRateOverlayInvalidate(Sender: TObject); begin FSpectrumDirty := True; - if Assigned(FSpecView) then FSpecView.SpectrumDirty := True; + if Assigned(FSpecView) then + begin + FSpecView.SpectrumDirty := True; + FSpecView.InvalidateOverlayCache; + end; if Assigned(PbSpectrum) then PbSpectrum.Invalidate; end; @@ -5610,7 +5651,11 @@ end; procedure TMainForm.OnVfoOverlayInvalidate(Sender: TObject); begin FSpectrumDirty := True; - if Assigned(FSpecView) then FSpecView.SpectrumDirty := True; + if Assigned(FSpecView) then + begin + FSpecView.SpectrumDirty := True; + FSpecView.InvalidateOverlayCache; + end; if Assigned(PbSpectrum) then PbSpectrum.Invalidate; end; diff --git a/SampleRateOverlay.pas b/SampleRateOverlay.pas index bb5b4a0..0e10095 100644 --- a/SampleRateOverlay.pas +++ b/SampleRateOverlay.pas @@ -43,6 +43,7 @@ type constructor Create(AOwner: TComponent); override; procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); procedure DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer); + procedure DrawOverlayBitmap(Target: TBitmap; W, H: Integer); function HandleMouseMove(X, Y: Integer): Boolean; function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean; function HandleMouseLeave: Boolean; @@ -242,6 +243,46 @@ begin DrawSelf(Target, C, FLeft, FTop, Min(FWidth, W - FLeft), Min(FHeight, H - FTop)); end; +procedure TSampleRateOverlay.DrawOverlayBitmap(Target: TBitmap; W, H: Integer); +var + HitTarget: TBitmap; + I, ContentW: Integer; +begin + if (Target = nil) or (W <= 0) or (H <= 0) then Exit; + Target.PixelFormat := pf32bit; + + Target.SetSize(8, 8); + Target.Canvas.Font.Name := 'Courier New'; + Target.Canvas.Font.Size := 7; + Target.Canvas.Font.Style := []; + ContentW := PAD_X + HIDE_W + BTN_GAP; + for I := 0 to High(SPAN_NAMES) do + begin + Inc(ContentW, SpanBtnWidth(SPAN_NAMES[I], Target.Canvas)); + if I < High(SPAN_NAMES) then Inc(ContentW, BTN_GAP); + end; + Inc(ContentW, PAD_X); + ContentW := Min(ContentW, W); + + Target.SetSize(ContentW, H); + Target.Canvas.Brush.Color := TColor($00141414); + Target.Canvas.Brush.Style := bsSolid; + Target.Canvas.Pen.Style := psClear; + Target.Canvas.FillRect(Rect(0, 0, ContentW, H)); + DrawSelf(Target, Target.Canvas, 0, 0, ContentW, H); + + HitTarget := TBitmap.Create; + try + HitTarget.PixelFormat := pf32bit; + HitTarget.SetSize(Max(1, FLeft + ContentW), Max(1, FTop + H)); + HitTarget.Canvas.Brush.Color := TColor($00141414); + HitTarget.Canvas.FillRect(Rect(0, 0, HitTarget.Width, HitTarget.Height)); + DrawSelf(HitTarget, HitTarget.Canvas, FLeft, FTop, ContentW, H); + finally + HitTarget.Free; + end; +end; + function TSampleRateOverlay.HandleMouseMove(X, Y: Integer): Boolean; var I, OldHot: Integer; diff --git a/SpectrumView.pas b/SpectrumView.pas index febc724..a6c0cd1 100644 --- a/SpectrumView.pas +++ b/SpectrumView.pas @@ -28,7 +28,7 @@ const type TSpectrumView = class - private + protected // ── Off-screen bitmaps ──────────────────────────────────────────────────── FSpectrumBitmap: TBitmap; FGridBitmap: TBitmap; @@ -202,34 +202,35 @@ type property VfoOverlay: TVfoOverlay read FVfoOverlay write FVfoOverlay; // ── Данные от DSP ───────────────────────────────────────────────────────── - procedure SetSpectrumData(const Pixels: array of Single; Count: Integer); - procedure SetWaterfallData(const Pixels: array of Single; Count: Integer); + procedure SetSpectrumData(const Pixels: array of Single; Count: Integer); virtual; + procedure SetWaterfallData(const Pixels: array of Single; Count: Integer); virtual; // ── Рендеринг ───────────────────────────────────────────────────────────── - procedure DrawSpectrum; - procedure DrawWaterfall; - procedure DrawRuler; + procedure DrawSpectrum; virtual; + procedure DrawWaterfall; virtual; + procedure DrawRuler; virtual; // ── Управление размером bitmap ──────────────────────────────────────────── - procedure SetSpectrumBitmapSize(W, H: Integer); - procedure SetWaterfallBitmapSize(W, H: Integer); - procedure SetRulerSize(W, H: Integer); - function SpectrumBitmapWidth: Integer; + procedure SetSpectrumBitmapSize(W, H: Integer); virtual; + procedure SetWaterfallBitmapSize(W, H: Integer); virtual; + procedure SetRulerSize(W, H: Integer); virtual; + function SpectrumBitmapWidth: Integer; virtual; // ── Paint-обработчики ──────────────────────────────────────────────────── - procedure PaintSpectrum(Sender: TObject); - procedure PaintWaterfall(Sender: TObject); - procedure PaintRuler(Sender: TObject); - procedure PaintSMeterRight(Sender: TObject); + procedure PaintSpectrum(Sender: TObject); virtual; + procedure PaintWaterfall(Sender: TObject); virtual; + procedure PaintRuler(Sender: TObject); virtual; + procedure PaintSMeterRight(Sender: TObject); virtual; // ── Утилиты ─────────────────────────────────────────────────────────────── - procedure InvalidateGridCache; - procedure SetTheme(const T: TAppTheme); - procedure InvalidateRulerCache; - procedure ResetSpectrumBuf; - procedure ResetWfAvgBuf; - procedure FillDemoSpectrum; - function NeedsRulerRedraw: Boolean; + procedure InvalidateGridCache; virtual; + procedure InvalidateOverlayCache; virtual; + procedure SetTheme(const T: TAppTheme); virtual; + procedure InvalidateRulerCache; virtual; + procedure ResetSpectrumBuf; virtual; + procedure ResetWfAvgBuf; virtual; + procedure FillDemoSpectrum; virtual; + function NeedsRulerRedraw: Boolean; virtual; end; implementation @@ -640,6 +641,11 @@ begin FSpectrumDirty := True; end; +procedure TSpectrumView.InvalidateOverlayCache; +begin + FSpectrumDirty := True; +end; + procedure TSpectrumView.SetTheme(const T: TAppTheme); begin FTheme := T; diff --git a/SpectrumViewOpengl.pas b/SpectrumViewOpengl.pas new file mode 100644 index 0000000..1a3504a --- /dev/null +++ b/SpectrumViewOpengl.pas @@ -0,0 +1,772 @@ +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, + OpenGLContext, GL, + AppTheme, SpectrumView; + +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; + FGridLabelTex: TGLTextureCache; + FAGCLabelTex: TGLTextureCache; + FAGCHangLabelTex: TGLTextureCache; + FMarkerLabelTex: TGLTextureCache; + FADCOverlayTex: TGLTextureCache; + FSampleOverlayTex: TGLTextureCache; + FVfoOverlayTex: TGLTextureCache; + FLastAGCText: string; + FLastAGCY: Integer; + FLastAGCHangY: Integer; + FLastMarkerText: string; + FLastMarkerX: Integer; + FLastADCVisible: Boolean; + FLastSampleX: Integer; + FLastSampleY: Integer; + FLastSampleW: Integer; + FLastSampleH: Integer; + FLastVfoX: Integer; + FLastVfoY: Integer; + FLastVfoW: Integer; + FLastVfoH: Integer; + 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 DrawADCOverlay(W, H: Integer); + procedure DrawCachedOverlays(W, H: Integer); + function FormatFreqGL(Hz: Double): string; + function ActiveVfoFrequency: Double; + public + constructor Create; + destructor Destroy; override; + procedure AttachControl(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 SetTheme(const T: TAppTheme); override; + end; + +implementation + +const + KEY_COLOR = TColor($00FF00FF); + +function ClampI(V, Lo, Hi: Integer): Integer; +begin + if V < Lo then Result := Lo + else if V > Hi then Result := Hi + else Result := V; +end; + +procedure ColorToRGB(C: TColor; out R, G, B: GLFloat); +begin + R := (C and $FF) / 255.0; + G := ((C shr 8) and $FF) / 255.0; + B := ((C shr 16) and $FF) / 255.0; +end; + +constructor TSpectrumViewOpenGL.Create; +begin + inherited Create; + FGridDirty := True; + FOverlayDirty := True; + FSampleOverlayDirty := True; + FVfoOverlayDirty := True; + FLastAGCY := -MaxInt; + FLastAGCHangY := -MaxInt; + FLastMarkerX := -MaxInt; + FLastADCVisible := False; +end; + +destructor TSpectrumViewOpenGL.Destroy; +begin + if Assigned(FGLControl) and FGLControl.MakeCurrent then + begin + DeleteTexture(FGridLabelTex); + DeleteTexture(FAGCLabelTex); + DeleteTexture(FAGCHangLabelTex); + DeleteTexture(FMarkerLabelTex); + DeleteTexture(FADCOverlayTex); + DeleteTexture(FSampleOverlayTex); + DeleteTexture(FVfoOverlayTex); + end; + inherited Destroy; +end; + +procedure TSpectrumViewOpenGL.AttachControl(C: TOpenGLControl); +begin + FGLControl := 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 + 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]; + 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 + A := Max(Src[0], Max(Src[1], Src[2])); + 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.SetTheme(const T: TAppTheme); +begin + inherited SetTheme(T); + FGridDirty := True; + FOverlayDirty := True; +end; + +function TSpectrumViewOpenGL.FormatFreqGL(Hz: Double): string; +var Mhz: Int64; KHz, Rest: Integer; +begin + Mhz := Trunc(Hz / 1000000); + KHz := Trunc((Hz - Mhz * 1000000) / 1000); + Rest := Trunc(Hz) mod 1000; + Result := Format('%d.%3.3d.%3.3d', [Mhz, KHz, Rest]); +end; + +function TSpectrumViewOpenGL.ActiveVfoFrequency: Double; +begin + if FActiveVfo = 0 then Result := FVfoA else Result := FVfoB; +end; + +procedure TSpectrumViewOpenGL.DrawVerticalGradient(W, H: Integer); +var + R1, G1, B1, R2, G2, B2: GLFloat; +begin + ColorToRGB(FTheme.SpecGradTop, R1, G1, B1); + ColorToRGB(FTheme.SpecGradBot, R2, G2, B2); + glBegin(GL_QUADS); + glColor4f(R1, G1, B1, 1); glVertex2f(0, 0); glVertex2f(W, 0); + glColor4f(R2, G2, B2, 1); glVertex2f(W, H); glVertex2f(0, H); + glEnd; + DrawRect(0, 0, 28, H, FTheme.SpecLabelBand, 1); +end; + +procedure TSpectrumViewOpenGL.DrawGrid(W, H: Integer; DBmax, DBmin, + InvRange: Double); +var + I, Yp, GX, N, GridMult: Integer; + DB, GridFreqS, GridLine, PixPerStep: Double; + B: TBitmap; +begin + DB := DBmax - FSpecGridStep; + while DB >= DBmin do + begin + Yp := Round((DBmax - DB) * InvRange * H); + DrawLine(0, Yp, W - 1, Yp, FTheme.SpecGrid, 1, False); + DB := DB - FSpecGridStep; + end; + + if FFMGridStepHz > 0 then + begin + GridFreqS := FCenterFreq - FSpanHz / 2; + PixPerStep := W * FFMGridStepHz / FSpanHz; + if PixPerStep >= 1.0 then GridMult := Max(1, Ceil(4.0 / PixPerStep)) + else GridMult := 0; + if GridMult > 0 then + begin + N := Ceil(GridFreqS / FFMGridStepHz); + GridLine := N * FFMGridStepHz; + while GridLine <= FCenterFreq + FSpanHz / 2 + 0.5 do + begin + if (N mod GridMult) = 0 then + begin + GX := Round((GridLine - GridFreqS) / FSpanHz * W); + if (GX >= 0) and (GX < W) then DrawLine(GX, 0, GX, H, FTheme.SpecGrid, 1, False); + end; + Inc(N); + GridLine := GridLine + FFMGridStepHz; + end; + end; + end + else + for I := 0 to 8 do + begin + GX := Round(I / 8 * W); + DrawLine(GX, 0, GX, H, FTheme.SpecGrid, 1, False); + end; + + if FGridDirty or FGridLabelTex.Dirty or (FGridLabelTex.H <> H) then + begin + B := TBitmap.Create; + try + B.PixelFormat := pf32bit; + B.SetSize(28, H); + B.Canvas.Brush.Color := clBlack; + B.Canvas.Brush.Style := bsSolid; + B.Canvas.Pen.Style := psClear; + B.Canvas.FillRect(Rect(0, 0, 28, H)); + B.Canvas.Font.Name := 'Courier New'; + B.Canvas.Font.Size := 7; + B.Canvas.Font.Color := clWhite; + B.Canvas.Brush.Style := bsClear; + DB := DBmax - FSpecGridStep; + while DB >= DBmin do + begin + Yp := Round((DBmax - DB) * InvRange * H); + B.Canvas.TextOut(1, Yp - 9, Format('%4.0f', [DB])); + DB := DB - FSpecGridStep; + end; + UploadAlphaMask(FGridLabelTex, B, FTheme.SpecLabelText); + finally + B.Free; + end; + FGridDirty := False; + end; + DrawTexture(FGridLabelTex, 0, 0); +end; + +procedure TSpectrumViewOpenGL.DrawFilterAndCursors(W, H: Integer); +var + X1, X2, VfoX, TXX1, TXX2, TXVfoX: Integer; +begin + TXX1 := 0; + TXX2 := 0; + TXVfoX := 0; + if FActiveVfo = 0 then CalcFilterBandX(FVfoA, W, X1, X2, VfoX) + else CalcFilterBandX(FVfoB, W, X1, X2, VfoX); + + if FTXOverlay then + begin + if FTXVfoIndex <> FActiveVfo then + begin + if X2 > X1 then DrawRect(X1, 0, X2, H, TColor($0030C030), 100 / 255); + if FTXVfoIndex = 0 then CalcFilterBandX(FVfoA, W, TXX1, TXX2, TXVfoX) + else CalcFilterBandX(FVfoB, W, TXX1, TXX2, TXVfoX); + if TXX2 > TXX1 then DrawRect(TXX1, 0, TXX2, H, TColor($00E03030), 100 / 255); + end + else if X2 > X1 then DrawRect(X1, 0, X2, H, TColor($00E03030), 100 / 255); + end + else if X2 > X1 then + DrawRect(X1, 0, X2, H, FTheme.SpecFilter, 1); + + DrawLine(X1, 0, X1, H, FTheme.SpecFilterEdge, 1, False); + DrawLine(X2, 0, X2, H, FTheme.SpecFilterEdge, 1, False); + DrawLine(VfoX, 0, VfoX, H - 12, FTheme.SpecVfoCursor, 2, False); + DrawRect(VfoX - 5, 0, VfoX + 5, 8, FTheme.SpecVfoCursor, 1); + + if FTXOverlay and (FTXVfoIndex <> FActiveVfo) then + begin + DrawLine(TXX1, 0, TXX1, H, TColor($002030E0), 1, False); + DrawLine(TXX2, 0, TXX2, H, TColor($002030E0), 1, False); + DrawLine(TXVfoX, 0, TXVfoX, H - 12, TColor($002030E0), 2, False); + DrawRect(TXVfoX - 5, 0, TXVfoX + 5, 8, TColor($002030E0), 1); + end; +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, 1024); + 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.DrawADCOverlay(W, H: Integer); +var + B: TBitmap; +begin + if not FADCOverloadVisible then Exit; + if (not FLastADCVisible) or FADCOverlayTex.Dirty then + begin + B := TBitmap.Create; + try + B.PixelFormat := pf32bit; + B.SetSize(210, 38); + B.Canvas.Brush.Color := TColor($00202020); + B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height)); + B.Canvas.Pen.Color := TColor($000030C0); + B.Canvas.Brush.Style := bsClear; + B.Canvas.Rectangle(0, 0, B.Width, B.Height); + B.Canvas.Font.Name := 'Courier New'; + B.Canvas.Font.Size := 10; + B.Canvas.Font.Style := [fsBold]; + B.Canvas.Font.Color := TColor($000030C0); + B.Canvas.TextOut(12, 5, 'ADC OVERLOAD'); + B.Canvas.Font.Size := 7; + B.Canvas.Font.Style := []; + B.Canvas.Font.Color := TColor($00D0D0D0); + B.Canvas.TextOut(12, 21, 'Input clipping detected'); + UploadBitmap(FADCOverlayTex, B, False, 232); + finally + B.Free; + end; + end; + FLastADCVisible := True; + DrawTexture(FADCOverlayTex, (W - FADCOverlayTex.W) div 2, 8); +end; + +procedure TSpectrumViewOpenGL.DrawCachedOverlays(W, H: Integer); +var + B: TBitmap; + OW, OH: Integer; +begin + 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 + (FLastVfoX <> FVfoOverlay.Left) or (FLastVfoY <> FVfoOverlay.Top) or + (FLastVfoW <> FVfoOverlay.Width) or (FLastVfoH <> FVfoOverlay.Height) then + begin + B := TBitmap.Create; + try + FVfoOverlay.DrawOverlayBitmap(B); + UploadBitmap(FVfoOverlayTex, B, True, 218); + finally + B.Free; + end; + FLastVfoX := FVfoOverlay.Left; + FLastVfoY := FVfoOverlay.Top; + FLastVfoW := FVfoOverlay.Width; + FLastVfoH := FVfoOverlay.Height; + FVfoOverlayDirty := False; + end; + DrawTexture(FVfoOverlayTex, FVfoOverlay.Left, FVfoOverlay.Top); + end; + FOverlayDirty := False; +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; + + 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); + 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); + DrawADCOverlay(W, H); + DrawCachedOverlays(W, H); + + FLastADCVisible := FADCOverloadVisible; + FGLControl.SwapBuffers; +end; + +end. diff --git a/VfoOverlay.pas b/VfoOverlay.pas index 84c66de..246bb20 100644 --- a/VfoOverlay.pas +++ b/VfoOverlay.pas @@ -63,6 +63,7 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DrawOverlay(Target: TBitmap; W, H: Integer); + procedure DrawOverlayBitmap(Target: TBitmap); function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean; function HandleMouseMove(X, Y: Integer): Boolean; function HandleMouseLeave: Boolean; @@ -632,6 +633,19 @@ begin BlendBitmapKey(Target, FCacheBitmap, Left, Top, 218); end; +procedure TVfoOverlay.DrawOverlayBitmap(Target: TBitmap); +begin + if (Target = nil) or (Width <= 0) or (Height <= 0) then Exit; + Target.PixelFormat := pf32bit; + Target.SetSize(Width, Height); + Target.Canvas.Brush.Color := KEY_COLOR; + Target.Canvas.Brush.Style := bsSolid; + Target.Canvas.Pen.Style := psClear; + Target.Canvas.FillRect(Rect(0, 0, Width, Height)); + DrawSelf(Target.Canvas, Width, Height); + FCacheDirty := False; +end; + function TVfoOverlay.HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean; begin Result := False; diff --git a/ewsdr.lpi b/ewsdr.lpi index 618a90c..a267581 100644 --- a/ewsdr.lpi +++ b/ewsdr.lpi @@ -55,6 +55,9 @@ + + + @@ -207,6 +210,10 @@ + + + + diff --git a/ewsdr.lpr b/ewsdr.lpr index f96552a..845b11e 100644 --- a/ewsdr.lpr +++ b/ewsdr.lpr @@ -15,7 +15,8 @@ uses {$ENDIF} Interfaces, // LCL platform WindowsDPI, - Forms, MainForm, AudioOutput, DeviceForm, FlatButton, FreqDisplay, VfoOverlay, + Forms, LazOpenGLContext, + MainForm, AudioOutput, DeviceForm, FlatButton, FreqDisplay, VfoOverlay, WDSP, WDSPEngine, WebPageHtml, WebServer, WebUtils, WinFirewall, WsClient, Settings;