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