unit WidebandView; { WidebandView.pas - raw ADC wideband spectrum pane. The network layer feeds 16-bit ADC samples collected from Protocol V4 wideband packets. This view feeds them to a dedicated WDSP analyzer and renders a compact Thetis-style wideband panadapter. CPU paint uses a bitmap; when MainForm creates a TOpenGLControl the same spectrum is rendered as GL primitives. } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses Classes, SysUtils, Math, Graphics, Controls, ExtCtrls, OpenGLContext, GL, AppTheme, WDSP, PerfLog; // ВРЕМЕННО (perf/cpu-profiling): зонные CPU-таймеры type TWidebandView = class private FBitmap: TBitmap; FLabelBitmap: TBitmap; FRulerBitmap: TBitmap; FTheme: TAppTheme; FData: array of Single; FPoints: array of TPoint; FGLTex: GLuint; FDirty: Boolean; FGLBackgroundDirty: Boolean; FSampleRateHz: Double; FRefLevel: Double; FRange: Double; FCalOffset: Double; FViewStartHz: Double; FViewEndHz: Double; FSourceStartHz: Double; FSourceEndHz: Double; FMarkerHz: Double; FFillSpectrum: Boolean; FWDSPAnalyzerOpen: Boolean; FWDSPAnalyzerConfigured: Boolean; FWDSPAnalyzerID: Integer; FWDSPFlp: array[0..0] of Integer; FWDSPIn: array of Double; FWDSPPixels: array of Single; procedure EnsureBitmap(W, H: Integer); function EnsureWDSPAnalyzer: Boolean; function ComputeSpectrumWDSP(const Samples: array of SmallInt; Count: Integer): Boolean; procedure CloseWDSPAnalyzer; function BuildSpectrumPoints(PlotW, H: Integer): Boolean; procedure DrawCPU(W, H: Integer; IncludeSpectrum: Boolean = True); procedure PaintCPU(C: TCanvas); procedure PaintGL(C: TOpenGLControl); procedure ColorToGL(AColor: TColor; out R, G, B: GLFloat); procedure DrawBackgroundGL(W, H, PlotW: Integer); procedure DrawGridGL(W, H, PlotW: Integer); procedure DrawSpectrumGL(PlotW, H: Integer); procedure DrawHamBandGL(PlotW, H: Integer; F1, F2: Double; AColor: TColor); procedure DrawHamBandsGL(PlotW, H: Integer); function SourceFreqToBin(FreqHz: Double; BinCount: Integer): Integer; function FreqToX(FreqHz: Double; W: Integer): Integer; function GridStepHz(W: Integer): Double; function RulerGridStepHz(C: TCanvas; PlotW: Integer): Double; procedure PaintVerticalGradient(C: TCanvas; W, H: Integer; TopColor, BottomColor: TColor); procedure AlphaFillRect(const R: TRect; AColor: TColor; Alpha: Byte); procedure DrawHamBands(C: TCanvas; PlotW, H: Integer); procedure DrawHamBand(C: TCanvas; PlotW, H: Integer; F1, F2: Double; const Name: string; AColor: TColor); procedure DrawFrequencyMarker(C: TCanvas; PlotW, H: Integer); procedure DrawSpectrumGradient(const SpPts: array of TPoint; PlotW, H: Integer); procedure DrawGLLabels(W, H, PlotW: Integer); procedure UploadLabelTextureToGL; procedure DrawLabelTextureGL(W, H: Integer); public constructor Create; destructor Destroy; override; procedure SetTheme(const T: TAppTheme); procedure SetSampleRateHz(AHz: Double); function SetFrequencyView(ViewStartHz, ViewEndHz, SourceStartHz, SourceEndHz: Double): Boolean; function SetMarkerHz(AHz: Double): Boolean; procedure SetFillSpectrum(AFill: Boolean); function TryPixelToFrequency(PixelX, PanelWidth: Integer; out FreqHz: Double): Boolean; procedure SetSamples(const Samples: array of SmallInt; Count: Integer); procedure SetBitmapSize(W, H: Integer); procedure SetRulerSize(W, H: Integer); procedure Draw; procedure DrawRuler; procedure Paint(Sender: TObject); procedure PaintRuler(Sender: TObject); property Dirty: Boolean read FDirty write FDirty; end; implementation const WB_DB_SCALE_W = 34; WB_WDSP_ID = 32; WB_WDSP_FFT = 16384; WB_WDSP_BLOCK = 512; WB_WDSP_PIXELS = 4096; constructor TWidebandView.Create; begin inherited Create; FBitmap := TBitmap.Create; FBitmap.PixelFormat := pf32bit; FLabelBitmap := TBitmap.Create; FLabelBitmap.PixelFormat := pf32bit; FRulerBitmap := TBitmap.Create; FRulerBitmap.PixelFormat := pf32bit; FTheme := DarkTheme; FSampleRateHz := 122880000.0; FRefLevel := -50.0; FRange := 120.0; FCalOffset := -40.1; FViewStartHz := 0.0; FViewEndHz := FSampleRateHz * 0.5; FSourceStartHz := 0.0; FSourceEndHz := FSampleRateHz * 0.5; FMarkerHz := 0.0; FFillSpectrum := False; FWDSPAnalyzerOpen := False; FWDSPAnalyzerConfigured := False; FWDSPAnalyzerID := WB_WDSP_ID; FWDSPFlp[0] := 0; SetLength(FWDSPIn, WB_WDSP_BLOCK * 2); SetLength(FWDSPPixels, WB_WDSP_PIXELS); FGLTex := 0; FDirty := True; FGLBackgroundDirty := True; end; destructor TWidebandView.Destroy; begin CloseWDSPAnalyzer; if FGLTex <> 0 then glDeleteTextures(1, @FGLTex); FRulerBitmap.Free; FLabelBitmap.Free; FBitmap.Free; inherited Destroy; end; procedure TWidebandView.SetTheme(const T: TAppTheme); begin FTheme := T; FDirty := True; FGLBackgroundDirty := True; end; procedure TWidebandView.SetSampleRateHz(AHz: Double); begin if AHz > 0 then begin FSampleRateHz := AHz; FWDSPAnalyzerConfigured := False; SetFrequencyView(0.0, FSampleRateHz * 0.5, 0.0, FSampleRateHz * 0.5); end; end; function TWidebandView.SetFrequencyView(ViewStartHz, ViewEndHz, SourceStartHz, SourceEndHz: Double): Boolean; var Nyq: Double; T: Double; begin Result := False; Nyq := FSampleRateHz * 0.5; if Nyq <= 0.0 then Nyq := 61440000.0; if ViewEndHz <= ViewStartHz then begin ViewStartHz := 0.0; ViewEndHz := Nyq; end; if SourceEndHz < SourceStartHz then begin T := SourceStartHz; SourceStartHz := SourceEndHz; SourceEndHz := T; end; if (Abs(FViewStartHz - ViewStartHz) < 0.5) and (Abs(FViewEndHz - ViewEndHz) < 0.5) and (Abs(FSourceStartHz - SourceStartHz) < 0.5) and (Abs(FSourceEndHz - SourceEndHz) < 0.5) then Exit; FViewStartHz := ViewStartHz; FViewEndHz := ViewEndHz; FSourceStartHz := SourceStartHz; FSourceEndHz := SourceEndHz; FDirty := True; FGLBackgroundDirty := True; Result := True; end; function TWidebandView.SetMarkerHz(AHz: Double): Boolean; begin Result := False; if Abs(FMarkerHz - AHz) < 0.5 then Exit; FMarkerHz := AHz; Result := True; end; procedure TWidebandView.SetFillSpectrum(AFill: Boolean); begin if FFillSpectrum = AFill then Exit; FFillSpectrum := AFill; FDirty := True; end; function TWidebandView.TryPixelToFrequency(PixelX, PanelWidth: Integer; out FreqHz: Double): Boolean; var PlotW: Integer; begin Result := False; FreqHz := 0.0; PlotW := Max(1, PanelWidth - WB_DB_SCALE_W); if (PanelWidth <= 0) or (PixelX < 0) or (PixelX >= PlotW) then Exit; if FViewEndHz <= FViewStartHz then Exit; FreqHz := FViewStartHz + PixelX / Max(1, PlotW - 1) * (FViewEndHz - FViewStartHz); Result := True; end; procedure TWidebandView.EnsureBitmap(W, H: Integer); begin W := Max(1, W); H := Max(1, H); if (FBitmap.Width <> W) or (FBitmap.Height <> H) then begin FBitmap.SetSize(W, H); FGLBackgroundDirty := True; end; if (FLabelBitmap.Width <> W) or (FLabelBitmap.Height <> H) then begin FLabelBitmap.SetSize(W, H); FGLBackgroundDirty := True; end; end; procedure TWidebandView.SetBitmapSize(W, H: Integer); begin EnsureBitmap(W, H); FDirty := True; end; procedure TWidebandView.SetRulerSize(W, H: Integer); begin W := Max(1, W); H := Max(1, H); if (FRulerBitmap.Width <> W) or (FRulerBitmap.Height <> H) then FRulerBitmap.SetSize(W, H); end; procedure TWidebandView.CloseWDSPAnalyzer; begin if FWDSPAnalyzerOpen and Assigned(@DestroyAnalyzer) then DestroyAnalyzer(FWDSPAnalyzerID); FWDSPAnalyzerOpen := False; FWDSPAnalyzerConfigured := False; end; function TWidebandView.EnsureWDSPAnalyzer: Boolean; var Success: Integer; SampleRate: Integer; AvBackmult: Double; begin Result := False; if (not Assigned(@XCreateAnalyzer)) or (not Assigned(@SetAnalyzer)) or (not Assigned(@Spectrum0)) or (not Assigned(@GetPixels)) then Exit; if not FWDSPAnalyzerOpen then begin Success := -1; XCreateAnalyzer(FWDSPAnalyzerID, @Success, WB_WDSP_FFT, 1, 1, nil); if Success <> 0 then Exit; FWDSPAnalyzerOpen := True; FWDSPAnalyzerConfigured := False; end; if not FWDSPAnalyzerConfigured then begin SampleRate := Max(1, Round(FSampleRateHz)); AvBackmult := Exp(-1.0 / (15.0 * 0.120)); // Thetis wideband default. SetAnalyzer( FWDSPAnalyzerID, 2, 1, 1, // Feed like piHPSDR: interleaved I/Q via Spectrum0. @FWDSPFlp[0], WB_WDSP_FFT, WB_WDSP_BLOCK, 6, // Thetis wideband default window. 14.0, 0, // no overlap for discontinuous WB packets. 0, 0.0, 0.0, WB_WDSP_PIXELS, 1, 0, 0.0, 0.0, 2 * WB_WDSP_FFT); SetDisplayAverageMode(FWDSPAnalyzerID, 0, AVERAGE_MODE_LOG_RECURSIVE); SetDisplayAvBackmult(FWDSPAnalyzerID, 0, AvBackmult); SetDisplaySampleRate(FWDSPAnalyzerID, SampleRate); ResetPixelBuffers(FWDSPAnalyzerID); FWDSPAnalyzerConfigured := True; end; Result := True; end; function TWidebandView.ComputeSpectrumWDSP(const Samples: array of SmallInt; Count: Integer): Boolean; var Offset, I, Flag: Integer; MaxPix: Single; begin Result := False; if Count < WB_WDSP_BLOCK then Exit; if not EnsureWDSPAnalyzer then Exit; Offset := 0; while Offset + WB_WDSP_BLOCK <= Count do begin for I := 0 to WB_WDSP_BLOCK - 1 do begin FWDSPIn[I * 2] := Samples[Offset + I] / 32768.0; FWDSPIn[I * 2 + 1] := 0.0; end; Spectrum0(1, FWDSPAnalyzerID, 0, 0, @FWDSPIn[0]); Inc(Offset, WB_WDSP_BLOCK); end; Flag := 0; GetPixels(FWDSPAnalyzerID, 0, @FWDSPPixels[0], @Flag); if Flag = 0 then Exit; MaxPix := -1.0E30; for I := 0 to WB_WDSP_PIXELS - 1 do if FWDSPPixels[I] > MaxPix then MaxPix := FWDSPPixels[I]; if MaxPix < -250.0 then Exit; SetLength(FData, WB_WDSP_PIXELS); for I := 0 to WB_WDSP_PIXELS - 1 do FData[I] := FWDSPPixels[I] + FCalOffset; Result := True; end; procedure TWidebandView.SetSamples(const Samples: array of SmallInt; Count: Integer); begin if ComputeSpectrumWDSP(Samples, Count) then FDirty := True; end; function TWidebandView.FreqToX(FreqHz: Double; W: Integer): Integer; var SpanHz: Double; begin SpanHz := FViewEndHz - FViewStartHz; if SpanHz <= 0.0 then SpanHz := Max(1.0, FSampleRateHz * 0.5); Result := Round((FreqHz - FViewStartHz) / SpanHz * Max(1, W - 1)); end; function TWidebandView.SourceFreqToBin(FreqHz: Double; BinCount: Integer): Integer; var Fs: Double; begin if BinCount <= 1 then Exit(0); Fs := FSampleRateHz; if Fs <= 0.0 then Fs := 122880000.0; // We feed WDSP through Spectrum0 as a complex stream with Q=0. GetPixels is // then laid out as -Fs/2..+Fs/2, so raw ADC frequencies 0..Fs/2 live in the // right half of the pixel array. Do not map 0..Nyquist across the whole array. Result := EnsureRange(Round((0.5 + FreqHz / Fs) * (BinCount - 1)), 0, BinCount - 1); end; function TWidebandView.GridStepHz(W: Integer): Double; var PixPerMHz, SpanMHz: Double; begin SpanMHz := Max(0.001, (FViewEndHz - FViewStartHz) / 1000000.0); PixPerMHz := W / SpanMHz; if PixPerMHz >= 44.0 then Result := 500000.0 else if PixPerMHz >= 18.0 then Result := 1000000.0 else if PixPerMHz >= 10.0 then Result := 2000000.0 else if PixPerMHz >= 5.0 then Result := 5000000.0 else Result := 10000000.0; end; function TWidebandView.RulerGridStepHz(C: TCanvas; PlotW: Integer): Double; var BaseStep, PixPerStep: Double; LabelMult: Integer; begin BaseStep := GridStepHz(PlotW); PixPerStep := PlotW * BaseStep / Max(1.0, FViewEndHz - FViewStartHz); if PixPerStep >= 1.0 then LabelMult := Max(1, Ceil((C.TextWidth('000.0') + 8) / PixPerStep)) else LabelMult := MaxInt; Result := BaseStep * LabelMult; end; procedure TWidebandView.PaintVerticalGradient(C: TCanvas; W, H: Integer; TopColor, BottomColor: TColor); var Y, B1, G1, R1, B2, G2, R2, B, G, R: Integer; T: Double; begin if (W <= 0) or (H <= 0) then Exit; B1 := (TopColor shr 16) and $FF; G1 := (TopColor shr 8) and $FF; R1 := TopColor and $FF; B2 := (BottomColor shr 16) and $FF; G2 := (BottomColor shr 8) and $FF; R2 := BottomColor and $FF; C.Pen.Style := psClear; C.Brush.Style := bsSolid; for Y := 0 to H - 1 do begin T := Y / Max(1, H - 1); B := Round(B1 + (B2 - B1) * T); G := Round(G1 + (G2 - G1) * T); R := Round(R1 + (R2 - R1) * T); C.Brush.Color := TColor((B shl 16) or (G shl 8) or R); C.FillRect(Rect(0, Y, W, Y + 1)); end; C.Pen.Style := psSolid; end; procedure TWidebandView.AlphaFillRect(const R: TRect; AColor: TColor; Alpha: Byte); var X, Y: Integer; Row: PByte; BR, BG, BB: Integer; SR, SG, SB: Integer; RR: TRect; begin if Alpha = 0 then Exit; RR := Rect( EnsureRange(R.Left, 0, FBitmap.Width), EnsureRange(R.Top, 0, FBitmap.Height), EnsureRange(R.Right, 0, FBitmap.Width), EnsureRange(R.Bottom, 0, FBitmap.Height)); if (RR.Right <= RR.Left) or (RR.Bottom <= RR.Top) then Exit; SR := AColor and $FF; SG := (AColor shr 8) and $FF; SB := (AColor shr 16) and $FF; FBitmap.BeginUpdate(False); try for Y := RR.Top to RR.Bottom - 1 do begin Row := PByte(FBitmap.ScanLine[Y]); Inc(Row, RR.Left * 4); for X := RR.Left to RR.Right - 1 do begin {$IFDEF DARWIN} BB := Row[3]; BG := Row[2]; BR := Row[1]; Row[1] := Byte((SR * Alpha + BR * (255 - Alpha)) div 255); Row[2] := Byte((SG * Alpha + BG * (255 - Alpha)) div 255); Row[3] := Byte((SB * Alpha + BB * (255 - Alpha)) div 255); {$ELSE} BB := Row[0]; BG := Row[1]; BR := Row[2]; Row[0] := Byte((SB * Alpha + BB * (255 - Alpha)) div 255); Row[1] := Byte((SG * Alpha + BG * (255 - Alpha)) div 255); Row[2] := Byte((SR * Alpha + BR * (255 - Alpha)) div 255); {$ENDIF} Inc(Row, 4); end; end; finally FBitmap.EndUpdate(False); end; end; procedure TWidebandView.DrawHamBand(C: TCanvas; PlotW, H: Integer; F1, F2: Double; const Name: string; AColor: TColor); var X1, X2, LabelX, LabelY, TW, TH: Integer; R: TRect; begin X1 := FreqToX(F1, PlotW); X2 := FreqToX(F2, PlotW); if (X2 <= 0) or (X1 >= PlotW) then Exit; X1 := EnsureRange(X1, 0, PlotW - 1); X2 := EnsureRange(X2, 0, PlotW - 1); if X2 <= X1 then Exit; R := Rect(X1, 0, X2 + 1, H); AlphaFillRect(R, AColor, 86); AlphaFillRect(Rect(X1, 0, X2 + 1, Min(H, 15)), AColor, 118); C.Font.Name := 'Sans'; C.Font.Size := 7; TW := C.TextWidth(Name); TH := C.TextHeight(Name); if X2 - X1 >= 2 then begin LabelX := EnsureRange(((X1 + X2) div 2) - TW div 2, 2, Max(2, PlotW - TW - 5)); LabelY := Max(1, Min(H - TH - 1, 2)); C.Font.Color := TColor($00EAF7D7); C.TextOut(LabelX, LabelY, Name); end; end; procedure TWidebandView.DrawHamBands(C: TCanvas; PlotW, H: Integer); begin DrawHamBand(C, PlotW, H, 1810000, 2000000, '160m', TColor($003B8F5A)); DrawHamBand(C, PlotW, H, 3500000, 3800000, '80m', TColor($004D8F3B)); DrawHamBand(C, PlotW, H, 5258500, 5403500, '60m', TColor($00688F3B)); DrawHamBand(C, PlotW, H, 7000000, 7300000, '40m', TColor($00808D34)); DrawHamBand(C, PlotW, H, 10100000, 10150000, '30m', TColor($008F7834)); DrawHamBand(C, PlotW, H, 14000000, 14350000, '20m', TColor($008F5D34)); DrawHamBand(C, PlotW, H, 18068000, 18168000, '17m', TColor($008F4934)); DrawHamBand(C, PlotW, H, 21000000, 21450000, '15m', TColor($008C3E58)); DrawHamBand(C, PlotW, H, 24890000, 24990000, '12m', TColor($007A3E8C)); DrawHamBand(C, PlotW, H, 28000000, 29700000, '10m', TColor($005B4B9A)); DrawHamBand(C, PlotW, H, 50000000, 51990000, '6m', TColor($003C729A)); end; procedure TWidebandView.DrawFrequencyMarker(C: TCanvas; PlotW, H: Integer); var X: Integer; begin if (FMarkerHz < FViewStartHz) or (FMarkerHz > FViewEndHz) then Exit; X := EnsureRange(FreqToX(FMarkerHz, PlotW), 0, PlotW - 1); C.Pen.Width := 1; C.Pen.Color := TColor($006DA6FF); C.MoveTo(Max(0, X - 2), 0); C.LineTo(Min(PlotW - 1, X + 2), 0); C.Pen.Color := TColor($00FFF3C0); C.MoveTo(X, 0); C.LineTo(X, H); end; procedure TWidebandView.DrawSpectrumGradient(const SpPts: array of TPoint; PlotW, H: Integer); var Row, Col, Alpha, YMin, Off: Integer; RowPtr: PByte; GradB, GradG, GradR: Byte; begin if (PlotW <= 0) or (H <= 0) or (Length(SpPts) < PlotW) then Exit; YMin := H; for Col := 0 to PlotW - 1 do if SpPts[Col].Y < YMin then YMin := SpPts[Col].Y; if YMin >= H then Exit; FBitmap.BeginUpdate(False); try for Row := YMin to H - 1 do begin Alpha := Round((1.0 - Sqr((Row - YMin) / Max(1.0, H - YMin - 1.0))) * 200); if Alpha <= 0 then Continue; if Alpha > 200 then Alpha := 200; GradB := Byte(FTheme.SpecGradB * Alpha div 200); GradG := Byte(FTheme.SpecGradG * Alpha div 200); GradR := Byte(FTheme.SpecGradR * Alpha div 200); RowPtr := PByte(FBitmap.ScanLine[Row]); for Col := 0 to PlotW - 1 do if SpPts[Col].Y <= Row then begin Off := Col * 4; {$IFDEF DARWIN} RowPtr[Off+1] := (GradR * Alpha + RowPtr[Off+1] * (200 - Alpha)) div 200; RowPtr[Off+2] := (GradG * Alpha + RowPtr[Off+2] * (200 - Alpha)) div 200; RowPtr[Off+3] := (GradB * Alpha + RowPtr[Off+3] * (200 - Alpha)) div 200; {$ELSE} RowPtr[Off] := (GradB * Alpha + RowPtr[Off] * (200 - Alpha)) div 200; RowPtr[Off+1] := (GradG * Alpha + RowPtr[Off+1] * (200 - Alpha)) div 200; RowPtr[Off+2] := (GradR * Alpha + RowPtr[Off+2] * (200 - Alpha)) div 200; {$ENDIF} end; end; finally FBitmap.EndUpdate(False); end; end; function TWidebandView.BuildSpectrumPoints(PlotW, H: Integer): Boolean; var X, Y, Bin, N, TopH: Integer; DB, InvRange, SrcHz, Nyq: Double; begin Result := False; N := Length(FData); if (N <= 1) or (PlotW <= 0) or (H <= 0) then Exit; TopH := Max(1, H - 1); InvRange := 1.0 / Max(1.0, FRange); SetLength(FPoints, PlotW); Nyq := FSampleRateHz * 0.5; if Nyq <= 0.0 then Nyq := 61440000.0; for X := 0 to PlotW - 1 do begin SrcHz := FSourceStartHz + X / Max(1, PlotW - 1) * (FSourceEndHz - FSourceStartHz); if (SrcHz < 0.0) or (SrcHz > Nyq) then DB := -200.0 else begin Bin := SourceFreqToBin(SrcHz, N); DB := FData[Bin]; end; Y := Round((FRefLevel - DB) * InvRange * TopH); Y := EnsureRange(Y, 1, TopH); FPoints[X] := Point(X, Y); end; Result := True; end; procedure TWidebandView.DrawCPU(W, H: Integer; IncludeSpectrum: Boolean); var C: TCanvas; X, Y, TopH, PlotW, ScaleX: Integer; DB, DBMin, InvRange, StepHz, FreqHz: Double; begin EnsureBitmap(W, H); C := FBitmap.Canvas; C.Brush.Color := FTheme.BG; C.FillRect(0, 0, W, H); PlotW := Max(1, W - WB_DB_SCALE_W); ScaleX := PlotW; DBMin := FRefLevel - FRange; InvRange := 1.0 / Max(1.0, FRange); C.Pen.Color := FTheme.SpecGrid; C.Font.Color := FTheme.TextDim; C.Font.Size := 8; StepHz := RulerGridStepHz(C, PlotW); FreqHz := Ceil(FViewStartHz / StepHz) * StepHz; while FreqHz <= FViewEndHz + 0.5 do begin X := FreqToX(FreqHz, PlotW); C.Line(X, 0, X, H); FreqHz := FreqHz + StepHz; end; TopH := Max(1, H - 1); DB := FRefLevel - 20.0; while DB >= DBMin do begin Y := Round((FRefLevel - DB) * InvRange * TopH); C.Line(0, Y, W, Y); DB := DB - 20.0; end; C.Pen.Style := psClear; C.Brush.Style := bsSolid; C.Brush.Color := FTheme.SpecLabelBand; C.FillRect(Rect(ScaleX, 0, W, H)); C.Pen.Style := psSolid; C.Pen.Color := FTheme.SpecGrid; C.MoveTo(ScaleX, 0); C.LineTo(ScaleX, H); C.Font.Name := 'Courier New'; C.Font.Size := 7; C.Font.Color := FTheme.SpecLabelText; C.Brush.Style := bsClear; DB := FRefLevel - 20.0; while DB >= DBMin do begin Y := Round((FRefLevel - DB) * InvRange * TopH); C.TextOut(ScaleX + 2, Y - 9, Format('%4.0f', [DB])); DB := DB - 20.0; end; if IncludeSpectrum and BuildSpectrumPoints(PlotW, H) then begin if FFillSpectrum then DrawSpectrumGradient(FPoints, PlotW, H); C.Pen.Color := TColor($0040FF80); C.Polyline(FPoints); end; DrawHamBands(C, PlotW, H); if IncludeSpectrum then FDirty := False else FGLBackgroundDirty := False; end; procedure TWidebandView.DrawRuler; var C: TCanvas; W, H, X, TW, PlotW: Integer; StepHz, FreqHz: Double; Lbl: string; begin W := FRulerBitmap.Width; H := FRulerBitmap.Height; if (W <= 0) or (H <= 0) then Exit; C := FRulerBitmap.Canvas; PaintVerticalGradient(C, W, H, FTheme.RulerGradTop, FTheme.RulerGradBot); C.Pen.Color := FTheme.RulerBorder; C.Pen.Width := 1; C.MoveTo(0, 0); C.LineTo(W, 0); C.MoveTo(0, H - 1); C.LineTo(W, H - 1); C.Font.Name := 'Courier New'; C.Font.Size := 7; C.Brush.Style := bsClear; C.Font.Color := FTheme.RulerText; PlotW := Max(1, W - WB_DB_SCALE_W); StepHz := RulerGridStepHz(C, PlotW); FreqHz := Ceil(FViewStartHz / StepHz) * StepHz; while FreqHz <= FViewEndHz + 0.5 do begin X := FreqToX(FreqHz, PlotW); C.Pen.Color := FTheme.RulerBorder; C.MoveTo(X, 0); C.LineTo(X, H div 2); if FreqHz >= 100000000.0 then Lbl := FormatFloat('0.###', FreqHz / 1000000.0) else Lbl := FormatFloat('0.#', FreqHz / 1000000.0); TW := C.TextWidth(Lbl); C.TextOut(EnsureRange(X - TW div 2, 2, Max(2, PlotW - TW - 2)), H div 2 - 1, Lbl); FreqHz := FreqHz + StepHz; end; C.Pen.Color := FTheme.RulerBorder; C.MoveTo(PlotW, 0); C.LineTo(PlotW, H); C.Brush.Style := bsSolid; C.Brush.Color := FTheme.SpecLabelBand; C.FillRect(Rect(PlotW + 1, 1, W, H - 1)); C.Brush.Style := bsClear; C.Font.Color := FTheme.TextDim; Lbl := 'MHz'; C.TextOut(Max(2, PlotW - C.TextWidth(Lbl) - 4), H div 2 - 1, Lbl); end; procedure TWidebandView.Draw; begin DrawCPU(FBitmap.Width, FBitmap.Height); end; procedure TWidebandView.PaintCPU(C: TCanvas); begin if FDirty then DrawCPU(FBitmap.Width, FBitmap.Height); C.Draw(0, 0, FBitmap); DrawFrequencyMarker(C, Max(1, FBitmap.Width - WB_DB_SCALE_W), FBitmap.Height); end; procedure TWidebandView.ColorToGL(AColor: TColor; out R, G, B: GLFloat); begin R := (AColor and $FF) / 255.0; G := ((AColor shr 8) and $FF) / 255.0; B := ((AColor shr 16) and $FF) / 255.0; end; procedure TWidebandView.DrawBackgroundGL(W, H, PlotW: Integer); var R1, G1, B1, R2, G2, B2: GLFloat; begin ColorToGL(FTheme.SpecGradTop, R1, G1, B1); ColorToGL(FTheme.SpecGradBot, R2, G2, B2); glBegin(GL_QUADS); glColor3f(R1, G1, B1); glVertex2f(0, H); glColor3f(R1, G1, B1); glVertex2f(W, H); glColor3f(R2, G2, B2); glVertex2f(W, 0); glColor3f(R2, G2, B2); glVertex2f(0, 0); glEnd; ColorToGL(FTheme.SpecLabelBand, R1, G1, B1); glColor3f(R1, G1, B1); glBegin(GL_QUADS); glVertex2f(PlotW, 0); glVertex2f(W, 0); glVertex2f(W, H); glVertex2f(PlotW, H); glEnd; end; procedure TWidebandView.DrawGridGL(W, H, PlotW: Integer); var X, Y, TopH: Integer; DB, DBMin, InvRange, StepHz, FreqHz: Double; R, G, B: GLFloat; begin DBMin := FRefLevel - FRange; InvRange := 1.0 / Max(1.0, FRange); TopH := Max(1, H - 1); ColorToGL(FTheme.SpecGrid, R, G, B); glColor4f(R, G, B, 0.78); glBegin(GL_LINES); FLabelBitmap.Canvas.Font.Name := 'Courier New'; FLabelBitmap.Canvas.Font.Size := 7; StepHz := RulerGridStepHz(FLabelBitmap.Canvas, PlotW); FreqHz := Ceil(FViewStartHz / StepHz) * StepHz; while FreqHz <= FViewEndHz + 0.5 do begin X := FreqToX(FreqHz, PlotW); glVertex2f(X, 0); glVertex2f(X, H); FreqHz := FreqHz + StepHz; end; DB := FRefLevel - 20.0; while DB >= DBMin do begin Y := Round((FRefLevel - DB) * InvRange * TopH); glVertex2f(0, H - Y); glVertex2f(W, H - Y); DB := DB - 20.0; end; glVertex2f(PlotW, 0); glVertex2f(PlotW, H); glEnd; end; procedure TWidebandView.DrawSpectrumGL(PlotW, H: Integer); var I: Integer; R, G, B: GLFloat; ATop, ABot: GLFloat; begin if not BuildSpectrumPoints(PlotW, H) then Exit; glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); if FFillSpectrum then begin R := FTheme.SpecGradR / 255.0; G := FTheme.SpecGradG / 255.0; B := FTheme.SpecGradB / 255.0; glBegin(GL_TRIANGLE_STRIP); for I := 0 to PlotW - 1 do begin ATop := 0.44; ABot := 0.02; glColor4f(R, G, B, ATop); glVertex2f(FPoints[I].X, H - FPoints[I].Y); glColor4f(R, G, B, ABot); glVertex2f(FPoints[I].X, 0); end; glEnd; end; glColor4f(0.25, 1.0, 0.50, 1.0); glBegin(GL_LINE_STRIP); for I := 0 to PlotW - 1 do glVertex2f(FPoints[I].X, H - FPoints[I].Y); glEnd; glDisable(GL_BLEND); end; procedure TWidebandView.DrawHamBandGL(PlotW, H: Integer; F1, F2: Double; AColor: TColor); var X1, X2: Integer; R, G, B: GLFloat; begin X1 := FreqToX(F1, PlotW); X2 := FreqToX(F2, PlotW); if (X2 <= 0) or (X1 >= PlotW) then Exit; X1 := EnsureRange(X1, 0, PlotW - 1); X2 := EnsureRange(X2, 0, PlotW - 1); if X2 <= X1 then Exit; ColorToGL(AColor, R, G, B); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glColor4f(R, G, B, 0.34); glBegin(GL_QUADS); glVertex2f(X1, 0); glVertex2f(X2 + 1, 0); glVertex2f(X2 + 1, H); glVertex2f(X1, H); glEnd; glColor4f(R, G, B, 0.46); glBegin(GL_QUADS); glVertex2f(X1, H - Min(H, 15)); glVertex2f(X2 + 1, H - Min(H, 15)); glVertex2f(X2 + 1, H); glVertex2f(X1, H); glEnd; glDisable(GL_BLEND); end; procedure TWidebandView.DrawHamBandsGL(PlotW, H: Integer); begin DrawHamBandGL(PlotW, H, 1810000, 2000000, TColor($003B8F5A)); DrawHamBandGL(PlotW, H, 3500000, 3800000, TColor($004D8F3B)); DrawHamBandGL(PlotW, H, 5258500, 5403500, TColor($00688F3B)); DrawHamBandGL(PlotW, H, 7000000, 7300000, TColor($00808D34)); DrawHamBandGL(PlotW, H, 10100000, 10150000, TColor($008F7834)); DrawHamBandGL(PlotW, H, 14000000, 14350000, TColor($008F5D34)); DrawHamBandGL(PlotW, H, 18068000, 18168000, TColor($008F4934)); DrawHamBandGL(PlotW, H, 21000000, 21450000, TColor($008C3E58)); DrawHamBandGL(PlotW, H, 24890000, 24990000, TColor($007A3E8C)); DrawHamBandGL(PlotW, H, 28000000, 29700000, TColor($005B4B9A)); DrawHamBandGL(PlotW, H, 50000000, 51990000, TColor($003C729A)); end; procedure TWidebandView.DrawGLLabels(W, H, PlotW: Integer); var C: TCanvas; X1, X2, LabelX, LabelY, TW, TH, Y, TopH, ScaleX: Integer; DB, DBMin, InvRange: Double; procedure BandLabel(F1, F2: Double; const Name: string); begin X1 := FreqToX(F1, PlotW); X2 := FreqToX(F2, PlotW); if (X2 <= 0) or (X1 >= PlotW) then Exit; X1 := EnsureRange(X1, 0, PlotW - 1); X2 := EnsureRange(X2, 0, PlotW - 1); if X2 <= X1 then Exit; TW := C.TextWidth(Name); TH := C.TextHeight(Name); LabelX := EnsureRange(((X1 + X2) div 2) - TW div 2, 2, Max(2, PlotW - TW - 5)); LabelY := Max(1, Min(H - TH - 1, 2)); C.TextOut(LabelX, LabelY, Name); end; begin if (W <= 0) or (H <= 0) then Exit; if (FLabelBitmap.Width <> W) or (FLabelBitmap.Height <> H) then FLabelBitmap.SetSize(W, H); C := FLabelBitmap.Canvas; C.Brush.Style := bsSolid; C.Brush.Color := clBlack; C.FillRect(Rect(0, 0, W, H)); C.Brush.Style := bsClear; DBMin := FRefLevel - FRange; InvRange := 1.0 / Max(1.0, FRange); TopH := Max(1, H - 1); ScaleX := PlotW; C.Font.Name := 'Courier New'; C.Font.Quality := fqDefault; C.Font.Size := 7; C.Font.Color := FTheme.SpecLabelText; DB := FRefLevel - 20.0; while DB >= DBMin do begin Y := Round((FRefLevel - DB) * InvRange * TopH); C.TextOut(ScaleX + 2, Y - 9, Format('%4.0f', [DB])); DB := DB - 20.0; end; C.Font.Name := 'Sans'; C.Font.Quality := fqDefault; C.Font.Size := 7; C.Font.Color := TColor($00EAF7D7); BandLabel(1810000, 2000000, '160m'); BandLabel(3500000, 3800000, '80m'); BandLabel(5258500, 5403500, '60m'); BandLabel(7000000, 7300000, '40m'); BandLabel(10100000, 10150000, '30m'); BandLabel(14000000, 14350000, '20m'); BandLabel(18068000, 18168000, '17m'); BandLabel(21000000, 21450000, '15m'); BandLabel(24890000, 24990000, '12m'); BandLabel(28000000, 29700000, '10m'); BandLabel(50000000, 51990000, '6m'); end; procedure TWidebandView.UploadLabelTextureToGL; var X, Y, I: Integer; Src: PByte; Buf: array of Byte; A: Byte; begin if (FLabelBitmap.Width <= 0) or (FLabelBitmap.Height <= 0) then Exit; if FGLTex = 0 then glGenTextures(1, @FGLTex); SetLength(Buf, FLabelBitmap.Width * FLabelBitmap.Height * 4); FLabelBitmap.BeginUpdate(False); try I := 0; for Y := 0 to FLabelBitmap.Height - 1 do begin Src := PByte(FLabelBitmap.ScanLine[Y]); for X := 0 to FLabelBitmap.Width - 1 do begin {$IFDEF DARWIN} // ARGB: byte0=A, byte1=R, byte2=G, byte3=B A := Max(Src[1], Max(Src[2], Src[3])); if A < 6 then A := 0; if A > 0 then begin Buf[I] := Byte(Min(255, Src[1] * 255 div A)); // R Buf[I + 1] := Byte(Min(255, Src[2] * 255 div A)); // G Buf[I + 2] := Byte(Min(255, Src[3] * 255 div A)); // B A := Byte(Min(255, A + (255 - A) div 3)); end else begin Buf[I] := 0; Buf[I + 1] := 0; Buf[I + 2] := 0; end; {$ELSE} // BGRA: byte0=B, byte1=G, byte2=R A := Max(Src[0], Max(Src[1], Src[2])); if A < 6 then A := 0; if A > 0 then begin Buf[I] := Byte(Min(255, Src[2] * 255 div A)); // R Buf[I + 1] := Byte(Min(255, Src[1] * 255 div A)); // G Buf[I + 2] := Byte(Min(255, Src[0] * 255 div A)); // B A := Byte(Min(255, A + (255 - A) div 3)); end else begin Buf[I] := 0; Buf[I + 1] := 0; Buf[I + 2] := 0; end; {$ENDIF} Buf[I + 3] := A; Inc(Src, 4); Inc(I, 4); end; end; finally FLabelBitmap.EndUpdate(False); end; glBindTexture(GL_TEXTURE_2D, FGLTex); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, FLabelBitmap.Width, FLabelBitmap.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @Buf[0]); end; procedure TWidebandView.DrawLabelTextureGL(W, H: Integer); begin if FGLTex = 0 then Exit; glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glEnable(GL_TEXTURE_2D); glBindTexture(GL_TEXTURE_2D, FGLTex); glColor4f(1, 1, 1, 1); glBegin(GL_QUADS); glTexCoord2f(0, 1); glVertex2f(0, 0); glTexCoord2f(1, 1); glVertex2f(W, 0); glTexCoord2f(1, 0); glVertex2f(W, H); glTexCoord2f(0, 0); glVertex2f(0, H); glEnd; glBindTexture(GL_TEXTURE_2D, 0); glDisable(GL_TEXTURE_2D); glDisable(GL_BLEND); end; procedure TWidebandView.PaintGL(C: TOpenGLControl); var W, H, PlotW, X: Integer; begin if C = nil then Exit; W := Max(1, C.Width); H := Max(1, C.Height); if not C.MakeCurrent then Exit; if (FBitmap.Width <> W) or (FBitmap.Height <> H) then SetBitmapSize(W, H); if FGLBackgroundDirty then begin PlotW := Max(1, W - WB_DB_SCALE_W); DrawGLLabels(W, H, PlotW); UploadLabelTextureToGL; FGLBackgroundDirty := False; end; glViewport(0, 0, W, H); glMatrixMode(GL_PROJECTION); glLoadIdentity; glOrtho(0, W, 0, H, -1, 1); glMatrixMode(GL_MODELVIEW); glLoadIdentity; glDisable(GL_DEPTH_TEST); glClearColor(0, 0, 0, 1.0); glClear(GL_COLOR_BUFFER_BIT); PlotW := Max(1, W - WB_DB_SCALE_W); DrawBackgroundGL(W, H, PlotW); DrawGridGL(W, H, PlotW); DrawSpectrumGL(PlotW, H); DrawHamBandsGL(PlotW, H); DrawLabelTextureGL(W, H); FDirty := False; if (FMarkerHz >= FViewStartHz) and (FMarkerHz <= FViewEndHz) then begin X := EnsureRange(FreqToX(FMarkerHz, PlotW), 0, PlotW - 1); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glColor4f(1.0, 0.64, 0.36, 0.32); glBegin(GL_QUADS); glVertex2f(Max(0, X - 2), 0); glVertex2f(Min(PlotW - 1, X + 2), 0); glVertex2f(Min(PlotW - 1, X + 2), H); glVertex2f(Max(0, X - 2), H); glEnd; glColor4f(1.0, 0.95, 0.75, 0.90); glBegin(GL_LINES); glVertex2f(X, 0); glVertex2f(X, H); glEnd; glDisable(GL_BLEND); end; C.SwapBuffers; FDirty := False; end; procedure TWidebandView.Paint(Sender: TObject); var T0: Int64; // PERF begin T0 := PerfNow; // PERF if Sender is TOpenGLControl then PaintGL(TOpenGLControl(Sender)) else if Sender is TPaintBox then PaintCPU(TPaintBox(Sender).Canvas); PerfAdd(pzUiWidebandPaint, T0); // PERF: кадр wideband-панорамы (CPU или GL) end; procedure TWidebandView.PaintRuler(Sender: TObject); var PB: TPaintBox; begin if not (Sender is TPaintBox) then Exit; PB := TPaintBox(Sender); if (FRulerBitmap.Width <> PB.Width) or (FRulerBitmap.Height <> PB.Height) then SetRulerSize(PB.Width, PB.Height); DrawRuler; if (FRulerBitmap.Width > 0) and (FRulerBitmap.Height > 0) then PB.Canvas.Draw(0, 0, FRulerBitmap); end; end.