From e0d49c7bfa3889026b76603b008aedcbd8806753 Mon Sep 17 00:00:00 2001 From: Uladzimir Karpenka Date: Tue, 26 May 2026 16:24:07 +0300 Subject: [PATCH] Add wideband display pane --- HPSDRNetwork.pas | 132 ++++++++- MainForm.pas | 241 ++++++++++++++- Settings.pas | 4 + SettingsForm.pas | 22 +- WidebandView.pas | 752 +++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 1139 insertions(+), 12 deletions(-) create mode 100644 WidebandView.pas diff --git a/HPSDRNetwork.pas b/HPSDRNetwork.pas index 1a4d750..0bbd229 100644 --- a/HPSDRNetwork.pas +++ b/HPSDRNetwork.pas @@ -91,6 +91,9 @@ type const Data: TDDCIQPacket) of object; TOnMicPacket = procedure(const Data: TMicDataPacket) of object; TOnHPStatus = procedure(const Status: THighPriorityStatus) of object; + TOnWidebandFrame = procedure(ADCIndex: Integer; + const Samples: array of SmallInt; + Count: Integer) of object; { THPSDRNetwork } THPSDRNetwork = class @@ -117,6 +120,7 @@ type FOnDDCIQ: TOnDDCIQPacket; FOnMic: TOnMicPacket; FOnHPStatus: TOnHPStatus; + FOnWideband: TOnWidebandFrame; FPortDDCSpec: Word; FPortDUCSpec: Word; @@ -124,6 +128,16 @@ type FPortDDCAudio: Word; FPortDUCIQ: Word; FDirectIP: string; // для unicast discovery + FWidebandADC: Integer; + FWidebandEnabled: Boolean; + FWBPacketsPerFrame: Integer; + FWBSamplesPerPacket: Integer; + FWBSampleBits: Integer; + FWBUpdateRateMS: Integer; + FWBFrame: array of SmallInt; + FWBFrameCount: Integer; + FWBLastSeq: LongWord; + FWBSeqValid: Boolean; // Кэш DDC/DUC Specific — keepalive повторно шлёт первые 5 сек после старта. // duc_specific_thread эмулятора биндится на 1026 только после HP Run=1, @@ -178,6 +192,7 @@ type procedure HandleHPStatus(const Buf: array of Byte; Len: Integer); procedure HandleDDCIQ(const Buf: array of Byte; Len: Integer; DDCIdx: Integer); procedure HandleMicData(const Buf: array of Byte; Len: Integer); + procedure HandleWidebandData(const Buf: array of Byte; Len: Integer; ADCIdx: Integer); procedure StartThreads; procedure StopThreads; procedure ResetDUCIQQueue; @@ -195,6 +210,9 @@ type procedure Disconnect; procedure SendGeneralPacket(const Pkt: TGeneralPacket); + procedure ConfigureWideband(ADCIndex: Integer; Enabled: Boolean; + SamplesPerPacket: Integer = 512; SampleBits: Integer = 16; + UpdateRateMS: Integer = 70; PacketsPerFrame: Integer = 32); procedure SendDDCSpecific(const Pkt: TDDCSpecificPacket); procedure ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; ADCSource: Byte = 0; DitherEnabled: Boolean = True; RandomEnabled: Boolean = True); @@ -227,6 +245,7 @@ type property OnDDCIQ: TOnDDCIQPacket read FOnDDCIQ write FOnDDCIQ; property OnMicPacket: TOnMicPacket read FOnMic write FOnMic; property OnHPStatus: TOnHPStatus read FOnHPStatus write FOnHPStatus; + property OnWideband: TOnWidebandFrame read FOnWideband write FOnWideband; property DirectIP: string read FDirectIP write FDirectIP; // unicast discovery end; @@ -367,6 +386,8 @@ begin PORT_MIC_DATA: if Len >= 132 then FNet.HandleMicData(Buf, Len); + PORT_WIDEBAND_ADC0 .. PORT_WIDEBAND_ADC0 + MAX_ADCS - 1: + FNet.HandleWidebandData(Buf, Len, SrcPort - PORT_WIDEBAND_ADC0); PORT_DDC0_IQ .. PORT_DDC0_IQ + MAX_DDCS - 1: FNet.HandleDDCIQ(Buf, Len, SrcPort - PORT_DDC0_IQ); end; @@ -577,6 +598,14 @@ begin FPortHPFromPC := PORT_HP_FROM_PC; FPortDDCAudio := PORT_DDC_AUDIO; FPortDUCIQ := PORT_DUC_IQ; + FWidebandADC := 0; + FWidebandEnabled := False; + FWBPacketsPerFrame := 32; + FWBSamplesPerPacket := 512; + FWBSampleBits := 16; + FWBUpdateRateMS := 70; + FWBFrameCount := 0; + FWBSeqValid := False; FCurrentRXFreq := 7100000; FCurrentTXFreq := 7100000; FCurrentDrive := 0; @@ -1020,6 +1049,56 @@ begin FOnMic(Pkt); // прямой вызов из receive thread — TX обработка не касается UI end; +procedure THPSDRNetwork.HandleWidebandData(const Buf: array of Byte; Len: Integer; + ADCIdx: Integer); +var + Seq: LongWord; + I, SamplesInPacket, TargetCount, S: Integer; +begin + if (not FWidebandEnabled) or (ADCIdx <> FWidebandADC) or + (FWBSampleBits <> 16) or (Len < 6) then Exit; + + SamplesInPacket := (Len - 4) div 2; + if SamplesInPacket <= 0 then Exit; + if FWBSamplesPerPacket > 0 then + SamplesInPacket := Min(SamplesInPacket, FWBSamplesPerPacket); + + Seq := (LongWord(Buf[0]) shl 24) or (LongWord(Buf[1]) shl 16) or + (LongWord(Buf[2]) shl 8) or LongWord(Buf[3]); + if Seq = 0 then + begin + FWBFrameCount := 0; + FWBSeqValid := True; + end + else if FWBSeqValid and (Seq <> FWBLastSeq + 1) then + begin + FWBFrameCount := 0; + FWBSeqValid := False; + Exit; + end; + FWBLastSeq := Seq; + FWBSeqValid := True; + + TargetCount := Max(1, FWBPacketsPerFrame) * Max(1, FWBSamplesPerPacket); + if Length(FWBFrame) <> TargetCount then + SetLength(FWBFrame, TargetCount); + + for I := 0 to SamplesInPacket - 1 do + begin + if FWBFrameCount >= TargetCount then Break; + S := (SmallInt(ShortInt(Buf[4 + I * 2])) shl 8) or Buf[5 + I * 2]; + FWBFrame[FWBFrameCount] := SmallInt(S); + Inc(FWBFrameCount); + end; + + if (FWBFrameCount >= TargetCount) and Assigned(FOnWideband) then + begin + FOnWideband(ADCIdx, FWBFrame, FWBFrameCount); + FWBFrameCount := 0; + FWBSeqValid := False; + end; +end; + // --------------------------------------------------------------------------- // Отправка пакетов // --------------------------------------------------------------------------- @@ -1029,10 +1108,51 @@ var B: TGeneralPacket; begin B := Pkt; + B.WBPort[0] := (PORT_WIDEBAND_ADC0 shr 8) and $FF; + B.WBPort[1] := PORT_WIDEBAND_ADC0 and $FF; + if FWidebandEnabled then + B.WBEnable := 1 shl EnsureRange(FWidebandADC, 0, 7) + else + B.WBEnable := 0; + B.WBSamplesPerPkt[0] := (FWBSamplesPerPacket shr 8) and $FF; + B.WBSamplesPerPkt[1] := FWBSamplesPerPacket and $FF; + B.WBSampleSize := FWBSampleBits; + B.WBUpdateRate := FWBUpdateRateMS; + B.WBPacketsPerFrame := FWBPacketsPerFrame; PackSeqBytes(B.Seq, NextSeq(FSeqGeneral)); DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, PORT_COMMAND); end; +procedure THPSDRNetwork.ConfigureWideband(ADCIndex: Integer; Enabled: Boolean; + SamplesPerPacket: Integer; SampleBits: Integer; UpdateRateMS: Integer; + PacketsPerFrame: Integer); +var + Gen: TGeneralPacket; +begin + FWidebandADC := EnsureRange(ADCIndex, 0, 7); + FWidebandEnabled := Enabled; + FWBSamplesPerPacket := EnsureRange(SamplesPerPacket, 1, 4096); + FWBSampleBits := EnsureRange(SampleBits, 1, 32); + FWBUpdateRateMS := EnsureRange(UpdateRateMS, 0, 255); + FWBPacketsPerFrame := EnsureRange(PacketsPerFrame, 1, 255); + FWBFrameCount := 0; + FWBSeqValid := False; + if FConnected then + begin + FillChar(Gen, SizeOf(Gen), 0); + Gen.Command := CMD_GENERAL; + Gen.Flags37 := $08; + Gen.Flags38 := $01; + Gen.PAConfig := $01; + if FDevice.BoardType = BOARD_ORION_MK2 then + Gen.AlexEnable := $03 + else + Gen.AlexEnable := $01; + SendGeneralPacket(Gen); + SendFullHP; + end; +end; + procedure THPSDRNetwork.SendDDCSpecific(const Pkt: TDDCSpecificPacket); var B: TDDCSpecificPacket; @@ -1078,12 +1198,16 @@ end; // XVTR без усиления. // XvtrActive — True когда активен XVTR-диапазон; разрешает биты 8+11 // (стандарт) или 8+14 (Orion2) из Alex.RxOnly[IF_band]=3. +// WidebandBypass — True когда открыт raw ADC wideband. Как Thetis, раскрываем +// RX front-end через HF bypass, иначе видна только полоса +// текущего HPF/BPF, а не весь ADC span. function CalcAlex0(RXFreqHz, TXFreqHz: Double; Transmitting, IsOrion2: Boolean; const Alex: TAlexSettings; XvtrRxAnt: Byte = 0; XvtrDisablePA: Boolean = False; - XvtrActive: Boolean = False): LongWord; + XvtrActive: Boolean = False; + WidebandBypass: Boolean = False): LongWord; var txf: Double; BandIdx: Integer; @@ -1100,7 +1224,9 @@ begin Result := Result or $08000000; // bit 27: T/R relay // HPF (ANAN-100/200) или BPF (ANAN-7000/8000/Saturn/G2) — по RX-частоте. - if IsOrion2 then + if WidebandBypass and (not Transmitting) then + Result := Result or $00001000 // bit 12: HF/front-end bypass for WB + else if IsOrion2 then begin // Band-pass filters — Orion MkII 5.2, ANAN-7000DLE, Saturn, ANAN-G2 if RXFreqHz < 1500000 then Result := Result or $00001000 // bit 12: HF Bypass @@ -1402,7 +1528,7 @@ begin Alex0 := CalcAlex0(FCurrentRXFreq, FCurrentTXFreq, FIsTransmitting, IsOrion2, FAlexConfig, FXvtrRxAntOverride, FXvtrDisablePA, - FXvtrEnable); + FXvtrEnable, FWidebandEnabled); Buf[1432] := (Alex0 shr 24) and $FF; Buf[1433] := (Alex0 shr 16) and $FF; Buf[1434] := (Alex0 shr 8) and $FF; diff --git a/MainForm.pas b/MainForm.pas index 866779c..15b8142 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -34,6 +34,7 @@ uses WebServer, CATEngine, CATSerial, CATTcp, SpectrumView, SpectrumViewOpengl, + WidebandView, StatusBar, PlatformUtils, WinFirewall; @@ -267,14 +268,17 @@ type // ---- Spectrum / Waterfall view ---- FSpecView: TSpectrumView; + FWidebandView: TWidebandView; FUseOpenGLSpectrum: Boolean; FSpectrumWidth: Integer; // актуальная ширина для FDSPEngine и resize-детектора FSpectrumHeight: Integer; FWaterfallHeight:Integer; FShowSpectrum: Boolean; FShowWaterfall: Boolean; + FShowWideband: Boolean; FDisplayFPS: Integer; FWaterfallDirty: Boolean; + FWidebandDirty: Boolean; // Waterfall settings (kept here for MakeGlobalSettings, buttons, settings dialog) FWfAGCEnabled: Boolean; FWfNFEnabled: Boolean; @@ -430,6 +434,8 @@ type // ---- Right panel ---- PanelRight: TPanel; PbSpectrum: TControl; + PbWideband: TControl; + PbWidebandRuler: TPaintBox; PbRuler: TPaintBox; // полоса частотных меток между спектром и водопадом PanelSplitter: TPanel; // перетаскиваемый разделитель спектр/водопад PbWaterfall: TControl; @@ -458,6 +464,7 @@ type procedure ResizeSMeter; procedure ResizeSpectrumPanels; + function UpdateWidebandFrequencyView: Boolean; procedure InvalidateGridCache; procedure SyncSpecViewFreq; procedure RecreateDSPEngine(ASampleRate: Integer); @@ -467,6 +474,8 @@ type procedure OnDeviceFound(const Dev: THPSDRDevice); procedure OnHPStatusCB(const Status: THighPriorityStatus); procedure OnDDCIQCB(DDCIndex: Integer; const Data: TDDCIQPacket); + procedure OnWidebandCB(ADCIndex: Integer; const Samples: array of SmallInt; + Count: Integer); procedure OnWDSPOpenDone(Success: Boolean); procedure DoConnectDevice(const Dev: THPSDRDevice); procedure OnMicPacketCB(const Data: TMicDataPacket); @@ -537,6 +546,8 @@ type procedure PbSpectrumMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PbSpectrumMouseLeave(Sender: TObject); + procedure PbWidebandMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); procedure PbWaterfallMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PbWaterfallMouseMove(Sender: TObject; Shift: TShiftState; @@ -545,6 +556,7 @@ type Shift: TShiftState; X, Y: Integer); procedure DoSpectrumClick(PixelX: Integer; PanelWidth: Integer); procedure DoSpectrumDrag(PixelX: Integer; PanelWidth: Integer); + procedure DoWidebandClick(PixelX: Integer; PanelWidth: Integer); procedure BtnVfoSwapClick(Sender: TObject); procedure BtnVfoACopyBClick(Sender: TObject); procedure BtnVfoBCopyAClick(Sender: TObject); @@ -722,7 +734,7 @@ type procedure SendDUCSpecificFromSettings; function PullSoundCardMic(MaxN: Integer): Integer; function BuildMicLineSelectByte: Byte; - procedure ApplyVisibility(ShowSpectrum, ShowWaterfall: Boolean); + procedure ApplyVisibility(ShowSpectrum, ShowWaterfall, ShowWideband: Boolean); procedure ApplyFPS(FPS: Integer); procedure ApplyFreqMhzDigits(Digits: Integer); @@ -1147,6 +1159,7 @@ begin Result.AudioSampleRate := FAudioOut.SampleRate; Result.ShowSpectrum := FShowSpectrum; Result.ShowWaterfall := FShowWaterfall; + Result.ShowWideband := FShowWideband; Result.DisplayDuplex := FDisplayDuplex; Result.DisplayFPS := FDisplayFPS; Result.LightTheme := FLightTheme; @@ -1464,6 +1477,7 @@ begin FPanelHidden := False; FShowSpectrum := True; FShowWaterfall := True; + FShowWideband := False; FDisplayFPS := 60; FFreqMhzDigits := 3; FSplitterRatio := 0.40; @@ -1513,12 +1527,14 @@ begin FSpecView.TXSpanHz := WDSPEngine.TX_SAMPLE_RATE; FSpecView.WfFrameInterval := FWaterfallFrameInterval; FSpecView.PAMaxPower := FPAMaxPower; + FWidebandView := TWidebandView.Create; FNetwork := THPSDRNetwork.Create; FNetwork.OnDeviceFound := OnDeviceFound; FNetwork.OnHPStatus := OnHPStatusCB; FNetwork.OnDDCIQ := OnDDCIQCB; FNetwork.OnMicPacket := OnMicPacketCB; + FNetwork.OnWideband := OnWidebandCB; // Дефолты TX, Alex и XVTR (на случай если устройство ещё не выбрано). TSettingsManager.DefaultTX(FTXSettings); TSettingsManager.DefaultAlex(FAlexSettings); @@ -1593,6 +1609,7 @@ begin FDSPEngine.Close; FDSPEngine.Free; FreeAndNil(FSpecView); + FreeAndNil(FWidebandView); // Сохраняем настройки при закрытии if FDevConnected then @@ -2163,6 +2180,29 @@ begin PbSMeterRight.OnPaint := FSpecView.PaintSMeterRight; PbSMeterRight.Color := CLR_PANEL; + if FUseOpenGLSpectrum then + begin + PbWideband := TOpenGLControl.Create(Self); + TOpenGLControl(PbWideband).AutoResizeViewport := False; + TOpenGLControl(PbWideband).DoubleBuffered := True; + TOpenGLControl(PbWideband).OnPaint := FWidebandView.Paint; + TOpenGLControl(PbWideband).OnMouseDown := PbWidebandMouseDown; + end + else + begin + PbWideband := TPaintBox.Create(Self); + TPaintBox(PbWideband).OnPaint := FWidebandView.Paint; + TPaintBox(PbWideband).OnMouseDown := PbWidebandMouseDown; + end; + PbWideband.Parent := PanelRight; + PbWideband.Visible := False; + + PbWidebandRuler := TPaintBox.Create(Self); + PbWidebandRuler.Parent := PanelRight; + PbWidebandRuler.OnPaint := FWidebandView.PaintRuler; + PbWidebandRuler.Cursor := crDefault; + PbWidebandRuler.Visible := False; + if FUseOpenGLSpectrum then begin PbSpectrum := TOpenGLControl.Create(Self); @@ -2479,13 +2519,41 @@ begin PanelSMeterRight.SetBounds(SMLeft, SMTop, SMW, SMBot - SMTop); end; +function TMainForm.UpdateWidebandFrequencyView: Boolean; +var + E: TXvtrEntry; + SrcStart, SrcEnd: Double; + MarkerChanged, ViewChanged: Boolean; +begin + Result := False; + if FWidebandView = nil then Exit; + if FActiveVfo = 0 then + MarkerChanged := FWidebandView.SetMarkerHz(FVfoA) + else + MarkerChanged := FWidebandView.SetMarkerHz(FVfoB); + if (FCurrentXvtr >= 0) and (FCurrentXvtr < CFG_XVTR_COUNT) and + FXvtrSettings.Entries[FCurrentXvtr].Enabled then + begin + E := FXvtrSettings.Entries[FCurrentXvtr]; + SrcStart := E.FreqBegin - E.LOOffset + E.LOError; + SrcEnd := E.FreqEnd - E.LOOffset + E.LOError; + ViewChanged := FWidebandView.SetFrequencyView(E.FreqBegin, E.FreqEnd, + SrcStart, SrcEnd); + end + else + ViewChanged := FWidebandView.SetFrequencyView(0.0, 61440000.0, 0.0, + 61440000.0); + Result := MarkerChanged or ViewChanged; +end; + procedure TMainForm.ResizeSpectrumPanels; const SPLITTER_H = 5; + WB_H = 118; MIN_SH = 60; // минимальная высота спектра MIN_WH = 40; // минимальная высота водопада var - RW, RH, SH, WH, TopOff: Integer; + RW, RH, SH, WH, TopOff, WideH, WideSpecH: Integer; AvailH: Integer; RULER_H: Integer; begin @@ -2494,7 +2562,34 @@ begin if Assigned(FSpecView) then SyncSpecViewFreq; RW := PanelRight.ClientWidth; RH := PanelRight.ClientHeight; - TopOff := 0; + UpdateWidebandFrequencyView; + WideH := 0; + WideSpecH := 0; + if FShowWideband then + WideH := Min(MulDiv(WB_H, Screen.PixelsPerInch, 96), Max(40, RH div 2)); + if WideH > 0 then + WideSpecH := Max(1, WideH - RULER_H); + TopOff := WideH; + if PbWideband <> nil then + begin + PbWideband.SetBounds(0, 0, RW, WideSpecH); + PbWideband.Visible := FShowWideband and (WideSpecH > 0); + if FShowWideband and (RW > 0) and (WideSpecH > 0) then + begin + FWidebandView.SetBitmapSize(RW, WideSpecH); + PbWideband.Invalidate; + end; + end; + if PbWidebandRuler <> nil then + begin + PbWidebandRuler.SetBounds(0, WideSpecH, RW, IfThen(FShowWideband and (WideH > 0), RULER_H, 0)); + PbWidebandRuler.Visible := FShowWideband and (WideH > 0); + if FShowWideband and (RW > 0) and (WideH > 0) then + begin + FWidebandView.SetRulerSize(RW, RULER_H); + PbWidebandRuler.Invalidate; + end; + end; // S-метр позиционируется отдельно в ResizeSMeter ResizeSMeter; @@ -2704,6 +2799,7 @@ begin // Спектр FSpecView.SetTheme(T); + if Assigned(FWidebandView) then FWidebandView.SetTheme(T); // VFO display — вызывает UpdateVfoDisplay, который использует тему UpdateVfoDisplay; @@ -2981,6 +3077,8 @@ begin // Какой VFO привязан к TX (для split-полос фильтра): 1=B при FSplitTxB, иначе FActiveVfo. if FSplitTxB then FSpecView.TXVfoIndex := 1 else FSpecView.TXVfoIndex := FActiveVfo; + if UpdateWidebandFrequencyView and FShowWideband and (PbWideband <> nil) then + PbWideband.Invalidate; end; @@ -3063,6 +3161,7 @@ begin // PbSpectrum.Height может быть ненулевым при FSpectrumHeight=0, // что вызвало бы сброс буфера водопада на каждом тике. if (FSpectrumWidth = 0) or + (FShowWideband and (PbWideband.Width <> FSpectrumWidth)) or (FShowSpectrum and ((PbSpectrum.Width <> FSpectrumWidth) or (PbSpectrum.Height <> FSpectrumHeight))) or (FShowWaterfall and not FShowSpectrum and @@ -3147,6 +3246,11 @@ begin PbWaterfall.Invalidate; FWaterfallDirty := False; end; + if FWidebandDirty and FShowWideband then + begin + PbWideband.Invalidate; + FWidebandDirty := False; + end; end else begin @@ -3565,6 +3669,14 @@ begin FLastDDCIndex := DDCIndex; end; +procedure TMainForm.OnWidebandCB(ADCIndex: Integer; + const Samples: array of SmallInt; Count: Integer); +begin + if (not FShowWideband) or (FWidebandView = nil) then Exit; + FWidebandView.SetSamples(Samples, Count); + FWidebandDirty := True; +end; + procedure TMainForm.DoUpdateDDCSeq(DDCIdx: Integer; Seq: LongWord); begin SetStatusText(4, 'RX running'); @@ -4121,6 +4233,7 @@ begin FSpecView.ResetWfAvgBuf; FShowSpectrum := G_Settings.ShowSpectrum; FShowWaterfall := G_Settings.ShowWaterfall; + FShowWideband := G_Settings.ShowWideband; FDisplayDuplex := G_Settings.DisplayDuplex; if BtnDUP <> nil then StyleButton(BtnDUP, FDisplayDuplex); if G_Settings.DisplayFPS > 0 then @@ -4192,11 +4305,20 @@ begin GenPkt.Flags37 := $08; GenPkt.Flags38 := $01; GenPkt.PAConfig := $01; + GenPkt.WBPort[0] := (PORT_WIDEBAND_ADC0 shr 8) and $FF; + GenPkt.WBPort[1] := PORT_WIDEBAND_ADC0 and $FF; + GenPkt.WBEnable := IfThen(FShowWideband, 1, 0); + GenPkt.WBSamplesPerPkt[0] := 512 shr 8; + GenPkt.WBSamplesPerPkt[1] := 512 and $FF; + GenPkt.WBSampleSize := 16; + GenPkt.WBUpdateRate := 70; + GenPkt.WBPacketsPerFrame := 32; if FNetwork.Device.BoardType = 5 then GenPkt.AlexEnable := $03 else GenPkt.AlexEnable := $01; FNetwork.SendGeneralPacket(GenPkt); + FNetwork.ConfigureWideband(0, FShowWideband, 512, 16, 70, 32); if FNetwork.Device.BoardType in [3, 4, 5] then FActiveDDC := 2 @@ -4255,6 +4377,7 @@ begin StyleButton(BtnStartStop, True); SetStatusText(2, 'Running'); BtnMOX.Enabled := True; + ResizeSpectrumPanels; end; @@ -4849,6 +4972,94 @@ begin end; end; +procedure TMainForm.DoWidebandClick(PixelX: Integer; PanelWidth: Integer); +var + FreqHz: Double; + ClickFreq: Int64; + StepHz: Int64; + BandIdx: Integer; + WasCTun: Boolean; +begin + if (FWidebandView = nil) or + (not FWidebandView.TryPixelToFrequency(PixelX, PanelWidth, FreqHz)) then Exit; + + if (FMode = MODE_FM) and FFMStepOn then + StepHz := FM_STEP_HZ[FFMStepIdx] + else + StepHz := 100; + ClickFreq := Round(FreqHz); + ClickFreq := (ClickFreq div StepHz) * StepHz; + + if (FCurrentXvtr >= 0) and (FCurrentXvtr < CFG_XVTR_COUNT) and + FXvtrSettings.Entries[FCurrentXvtr].Enabled then + begin + if ClickFreq < FXvtrSettings.Entries[FCurrentXvtr].FreqBegin then + ClickFreq := Round(FXvtrSettings.Entries[FCurrentXvtr].FreqBegin); + if ClickFreq > FXvtrSettings.Entries[FCurrentXvtr].FreqEnd then + ClickFreq := Round(FXvtrSettings.Entries[FCurrentXvtr].FreqEnd); + end; + + if FCurrentXvtr < 0 then + begin + BandIdx := FreqToBandIdx(ClickFreq); + if (BandIdx >= 0) and (BandIdx <> FCurrentBand) then + begin + if FDevConnected then + begin + SaveCurrentBand; + FSettings.Save; + end; + FCurrentBand := BandIdx; + RestoreBand(FCurrentBand); + end; + end; + + if FActiveVfo = 0 then + begin + WasCTun := FCTun; + FCTun := False; + ApplyVfoA(ClickFreq); + FCTun := WasCTun; + if WasCTun and FWDSPReady then + FDSPEngine.SetShift(0.0); + end + else + begin + FVfoB := ClickFreq; + FreqDispB.Frequency := Round(FVfoB); + FCenterFreq := ClickFreq; + if FWDSPReady then FDSPEngine.SetShift(0.0); + if FNetwork.Connected and FNetwork.Running then + begin + FNetwork.UpdateState(XvtrTranslate(FCenterFreq), + XvtrTranslate(ActiveTXFreqHz), FDriveLevel, FTransmitting, True, True); + FNetwork.SendFullHP; + end; + if FCurrentXvtr < 0 then + begin + BandIdx := FreqToBandIdx(FVfoB); + if (BandIdx >= 0) and (BandIdx <> FCurrentBand) then + begin + if FCurrentBand >= 0 then + StyleButton(BtnBand[FCurrentBand], False); + FCurrentBand := BandIdx; + StyleButton(BtnBand[FCurrentBand], True); + end; + end; + UpdateVfoDisplay; + SyncSpecViewFreq; + FSpectrumDirty := True; + PbSpectrum.Invalidate; + end; + + FSpecView.InvalidateRulerCache; + if PbRuler <> nil then PbRuler.Invalidate; + FWaterfallDirty := True; + if PbWaterfall <> nil then PbWaterfall.Invalidate; + if UpdateWidebandFrequencyView and (PbWideband <> nil) then + PbWideband.Invalidate; +end; + procedure TMainForm.DoSpectrumDrag(PixelX: Integer; PanelWidth: Integer); var dPix: Integer; @@ -4943,6 +5154,13 @@ begin end; end; +procedure TMainForm.PbWidebandMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + DoWidebandClick(X, TControl(Sender).Width); +end; + procedure TMainForm.PbSpectrumMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin @@ -6726,6 +6944,9 @@ begin FSpecView.DrawWaterfall; PbWaterfall.Invalidate; if PbRuler <> nil then PbRuler.Invalidate; + UpdateWidebandFrequencyView; + if PbWideband <> nil then PbWideband.Invalidate; + if PbWidebandRuler <> nil then PbWidebandRuler.Invalidate; PushXvtrToWeb; end; @@ -6758,6 +6979,9 @@ begin // RestoreBand сам обновит подсветку HF band-кнопки и сетевое состояние. if (FCurrentBand >= 0) and (FCurrentBand < CFG_BAND_COUNT) then RestoreBand(FCurrentBand); + UpdateWidebandFrequencyView; + if PbWideband <> nil then PbWideband.Invalidate; + if PbWidebandRuler <> nil then PbWidebandRuler.Invalidate; PushXvtrToWeb; end; @@ -6772,6 +6996,9 @@ begin DeactivateXvtr; // Перепрошить XVTR в сеть (если параметры текущего изменились) ApplyXvtrToNetwork; + UpdateWidebandFrequencyView; + if PbWideband <> nil then PbWideband.Invalidate; + if PbWidebandRuler <> nil then PbWidebandRuler.Invalidate; PushXvtrToWeb; if FDevConnected then begin @@ -7046,10 +7273,14 @@ begin FSettings.Save; end; -procedure TMainForm.ApplyVisibility(ShowSpectrum, ShowWaterfall: Boolean); +procedure TMainForm.ApplyVisibility(ShowSpectrum, ShowWaterfall, + ShowWideband: Boolean); begin FShowSpectrum := ShowSpectrum; FShowWaterfall := ShowWaterfall; + FShowWideband := ShowWideband; + if Assigned(FNetwork) and FNetwork.Connected then + FNetwork.ConfigureWideband(0, FShowWideband, 512, 16, 70, 32); ResizeSpectrumPanels; end; @@ -7134,7 +7365,7 @@ begin FCATLastGlobal.CATTcpPort); // Перечисляем PA устройства SF.RefreshAudioDevices(FAudioOut, FAudioIn); - SF.LoadVisibility(FShowSpectrum, FShowWaterfall); + SF.LoadVisibility(FShowSpectrum, FShowWaterfall, FShowWideband); SF.LoadWfAGCNF(FWfAGCEnabled, FWfNFEnabled); SF.LoadADCSettings(FDitherEnabled, FRandomEnabled); SF.LoadWebSettings(FWebEnabled, FWebPort, FWebBindAddr, FWebUser, FWebPass); diff --git a/Settings.pas b/Settings.pas index cb8a2c9..1ba132e 100644 --- a/Settings.pas +++ b/Settings.pas @@ -216,6 +216,7 @@ type // --- Visibility settings --- ShowSpectrum: Boolean; // True = draw spectrum on main form ShowWaterfall: Boolean; // True = draw waterfall on main form + ShowWideband: Boolean; // True = draw raw ADC wideband pane on main form DisplayDuplex: Boolean; // DUP: при TX показывать RX-водопад, TX-фильтр overlay'ем // --- Display FPS --- DisplayFPS: Integer; // spectrum/waterfall timer fps (1..100) @@ -390,6 +391,7 @@ begin G.AudioInDevice := ''; G.ShowSpectrum := True; G.ShowWaterfall := True; + G.ShowWideband := False; G.DisplayDuplex := False; G.DisplayFPS := 60; G.FreqMhzDigits := 3; @@ -604,6 +606,7 @@ begin // Visibility settings G.ShowSpectrum := JB(GObj,'show_spectrum',True); G.ShowWaterfall := JB(GObj,'show_waterfall',True); + G.ShowWideband := JB(GObj,'show_wideband',False); G.DisplayDuplex := JB(GObj,'display_duplex',False); G.DisplayFPS := JI(GObj,'display_fps',60); G.LightTheme := JB(GObj,'light_theme',False); @@ -689,6 +692,7 @@ begin // Visibility settings JW(O,'show_spectrum',G.ShowSpectrum); JW(O,'show_waterfall',G.ShowWaterfall); + JW(O,'show_wideband',G.ShowWideband); JW(O,'display_duplex',G.DisplayDuplex); JW(O,'display_fps',G.DisplayFPS); JW(O,'light_theme',G.LightTheme); diff --git a/SettingsForm.pas b/SettingsForm.pas index f371282..06ffeee 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -49,7 +49,7 @@ type TOnAudioDevChange = procedure(DevIndex: Integer; const DevName: string) of object; TOnAudioInDevChange = procedure(DevIndex: Integer; const DevName: string) of object; TOnAudioBufferChange = procedure(BufferSize: Integer) of object; - TOnVisibilityChange = procedure(ShowSpectrum, ShowWaterfall: Boolean) of object; + TOnVisibilityChange = procedure(ShowSpectrum, ShowWaterfall, ShowWideband: Boolean) of object; TOnFPSChange = procedure(FPS: Integer) of object; TOnThemeChange = procedure(LightTheme: Boolean) of object; TOnWfAGCNFChange = procedure(WfAGC, WfNF: Boolean) of object; @@ -120,6 +120,7 @@ type // ---- General display tab controls ---- FChkShowSpectrum: TFlatCheckBox; FChkShowWaterfall: TFlatCheckBox; + FChkShowWideband: TFlatCheckBox; FCmbFPS: TFlatComboBox; FChkLightTheme: TFlatCheckBox; FCmbFreqMhzDigits: TFlatComboBox; @@ -371,7 +372,7 @@ type procedure RefreshAudioDevices(AudioOut: TAudioOutput; AudioIn: TAudioInput); procedure LoadAudioBufferSize(BufferSize: Integer); - procedure LoadVisibility(ShowSpectrum, ShowWaterfall: Boolean); + procedure LoadVisibility(ShowSpectrum, ShowWaterfall, ShowWideband: Boolean); procedure LoadFPS(FPS: Integer); procedure LoadLightTheme(ALight: Boolean); procedure LoadFreqMhzDigits(Digits: Integer); @@ -822,6 +823,16 @@ begin FChkShowWaterfall.Font.Size := 9; FChkShowWaterfall.OnChange := OnVisibilityChkChange; + FChkShowWideband := TFlatCheckBox.Create(Self); + FChkShowWideband.Parent := Grp; + FChkShowWideband.Caption := 'Wideband'; + FChkShowWideband.SetBounds(PAD + (CHKW + 20) * 2, R1, CHKW, 22); + FChkShowWideband.Checked := False; + FChkShowWideband.Font.Color := CLR_TEXT; + FChkShowWideband.Font.Name := UI_FONT; + FChkShowWideband.Font.Size := 9; + FChkShowWideband.OnChange := OnVisibilityChkChange; + Grp := MakeGroupPanel(FPageDisplay, 'Performance', MARGIN, 186, 650, 92); MakeLbl(Grp, 'Refresh rate', PAD, R1 + 5, LW); @@ -2301,12 +2312,14 @@ begin FOnAudioBufferChange(BufferSize); end; -procedure TSettingsForm.LoadVisibility(ShowSpectrum, ShowWaterfall: Boolean); +procedure TSettingsForm.LoadVisibility(ShowSpectrum, ShowWaterfall, + ShowWideband: Boolean); begin FLoading := True; try FChkShowSpectrum.Checked := ShowSpectrum; FChkShowWaterfall.Checked := ShowWaterfall; + FChkShowWideband.Checked := ShowWideband; finally FLoading := False; end; @@ -2327,7 +2340,8 @@ procedure TSettingsForm.OnVisibilityChkChange(Sender: TObject); begin if FLoading then Exit; if not Assigned(FOnVisibilityChange) then Exit; - FOnVisibilityChange(FChkShowSpectrum.Checked, FChkShowWaterfall.Checked); + FOnVisibilityChange(FChkShowSpectrum.Checked, FChkShowWaterfall.Checked, + FChkShowWideband.Checked); end; procedure TSettingsForm.OnLightThemeChkChange(Sender: TObject); diff --git a/WidebandView.pas b/WidebandView.pas new file mode 100644 index 0000000..94e2359 --- /dev/null +++ b/WidebandView.pas @@ -0,0 +1,752 @@ +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 windows the frame, runs an in-process real FFT + 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; + +type + TWidebandView = class + private + FBitmap: TBitmap; + FRulerBitmap: TBitmap; + FTheme: TAppTheme; + FData: array of Single; + FPoints: array of TPoint; + FGLTex: GLuint; + FDirty: Boolean; + FSampleRateHz: Double; + FRefLevel: Double; + FRange: Double; + FCalOffset: Double; + FViewStartHz: Double; + FViewEndHz: Double; + FSourceStartHz: Double; + FSourceEndHz: Double; + FMarkerHz: Double; + procedure EnsureBitmap(W, H: Integer); + procedure ComputeSpectrum(const Samples: array of SmallInt; Count: Integer); + procedure DrawCPU(W, H: Integer); + procedure PaintCPU(C: TCanvas); + procedure PaintGL(C: TOpenGLControl); + procedure ColorToGL(AColor: TColor; out R, G, B: GLFloat); + function BinToMHz(Bin, BinCount: Integer): Double; + 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 UploadBitmapToGL; + 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; + 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; + +constructor TWidebandView.Create; +begin + inherited Create; + FBitmap := TBitmap.Create; + FBitmap.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; + FGLTex := 0; + FDirty := True; +end; + +destructor TWidebandView.Destroy; +begin + if FGLTex <> 0 then + glDeleteTextures(1, @FGLTex); + FRulerBitmap.Free; + FBitmap.Free; + inherited Destroy; +end; + +procedure TWidebandView.SetTheme(const T: TAppTheme); +begin + FTheme := T; + FDirty := True; +end; + +procedure TWidebandView.SetSampleRateHz(AHz: Double); +begin + if AHz > 0 then + begin + FSampleRateHz := AHz; + 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; + 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; + +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 + FBitmap.SetSize(W, H); +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.ComputeSpectrum(const Samples: array of SmallInt; + Count: Integer); +var + N, Half, I, J, K, M, Step: Integer; + Wr, Wi, Ur, Ui, Tr, Ti, Ang, Re, Im, Mag, Win, WinSum: Double; + RealBuf, ImagBuf: array of Double; +begin + if Count < 256 then Exit; + N := 1; + while (N shl 1 <= Count) and (N shl 1 <= 16384) do + N := N shl 1; + Half := N div 2; + SetLength(RealBuf, N); + SetLength(ImagBuf, N); + WinSum := 0.0; + for I := 0 to N - 1 do + begin + Win := 0.35875 - 0.48829 * Cos(2 * Pi * I / (N - 1)) + + 0.14128 * Cos(4 * Pi * I / (N - 1)) - + 0.01168 * Cos(6 * Pi * I / (N - 1)); + WinSum := WinSum + Win; + RealBuf[I] := Samples[I] / 32768.0 * Win; + ImagBuf[I] := 0.0; + end; + if WinSum <= 0.0 then WinSum := N; + + J := 0; + for I := 1 to N - 2 do + begin + K := N shr 1; + while J >= K do + begin + Dec(J, K); + K := K shr 1; + end; + Inc(J, K); + if I < J then + begin + Re := RealBuf[I]; RealBuf[I] := RealBuf[J]; RealBuf[J] := Re; + Im := ImagBuf[I]; ImagBuf[I] := ImagBuf[J]; ImagBuf[J] := Im; + end; + end; + + M := 2; + while M <= N do + begin + Ang := -2 * Pi / M; + Wr := Cos(Ang); + Wi := Sin(Ang); + Step := M div 2; + K := 0; + while K < N do + begin + Ur := 1.0; + Ui := 0.0; + for J := 0 to Step - 1 do + begin + I := K + J; + Tr := Ur * RealBuf[I + Step] - Ui * ImagBuf[I + Step]; + Ti := Ur * ImagBuf[I + Step] + Ui * RealBuf[I + Step]; + RealBuf[I + Step] := RealBuf[I] - Tr; + ImagBuf[I + Step] := ImagBuf[I] - Ti; + RealBuf[I] := RealBuf[I] + Tr; + ImagBuf[I] := ImagBuf[I] + Ti; + Re := Ur * Wr - Ui * Wi; + Ui := Ur * Wi + Ui * Wr; + Ur := Re; + end; + Inc(K, M); + end; + M := M shl 1; + end; + + SetLength(FData, Half); + for I := 0 to Half - 1 do + begin + Mag := Sqr(RealBuf[I]) + Sqr(ImagBuf[I]); + // Convert FFT bin amplitude to dBFS, then apply Thetis-style display + // calibration offset. The previous unnormalised FFT power depended on N + // and could not line up with the dB scale. + FData[I] := 20.0 * Log10((2.0 * Sqrt(Mag) / WinSum) + 1.0E-20) + FCalOffset; + end; +end; + +procedure TWidebandView.SetSamples(const Samples: array of SmallInt; Count: Integer); +begin + ComputeSpectrum(Samples, Count); + FDirty := True; +end; + +function TWidebandView.BinToMHz(Bin, BinCount: Integer): Double; +begin + if BinCount <= 1 then Result := 0 + else Result := (Bin / (BinCount - 1)) * (FSampleRateHz * 0.5) / 1000000.0; +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.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 + 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); + 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.DrawCPU(W, H: Integer); +var + C: TCanvas; + X, Y, Bin, N, TopH, PlotW, ScaleX: Integer; + DB, DBMin, InvRange, StepHz, FreqHz, SrcHz, Nyq: 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; + + N := Length(FData); + if N > 1 then + begin + 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 := EnsureRange(Round(SrcHz / Nyq * (N - 1)), 0, N - 1); + DB := FData[Bin]; + end; + Y := Round((FRefLevel - DB) * InvRange * TopH); + Y := EnsureRange(Y, 1, TopH); + FPoints[X] := Point(X, Y); + end; + C.Pen.Color := TColor($0040FF80); + C.Polyline(FPoints); + end; + + DrawHamBands(C, PlotW, H); + + C.Font.Color := FTheme.Text; + C.TextOut(6, 4, 'Wideband'); + FDirty := 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.UploadBitmapToGL; +var + X, Y, I: Integer; + Src: PByte; + Buf: array of Byte; +begin + if (FBitmap.Width <= 0) or (FBitmap.Height <= 0) then Exit; + if FGLTex = 0 then + glGenTextures(1, @FGLTex); + SetLength(Buf, FBitmap.Width * FBitmap.Height * 4); + FBitmap.BeginUpdate(False); + try + I := 0; + for Y := 0 to FBitmap.Height - 1 do + begin + Src := PByte(FBitmap.ScanLine[Y]); + for X := 0 to FBitmap.Width - 1 do + begin + Buf[I] := Src[2]; + Buf[I + 1] := Src[1]; + Buf[I + 2] := Src[0]; + Buf[I + 3] := $FF; + Inc(Src, 4); + Inc(I, 4); + end; + end; + finally + FBitmap.EndUpdate(False); + end; + glBindTexture(GL_TEXTURE_2D, FGLTex); + 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, FBitmap.Width, FBitmap.Height, 0, + GL_RGBA, GL_UNSIGNED_BYTE, @Buf[0]); +end; + +procedure TWidebandView.PaintGL(C: TOpenGLControl); +var + W, H, PlotW, X: Integer; + NeedUpload: Boolean; +begin + if C = nil then Exit; + W := Max(1, C.Width); + H := Max(1, C.Height); + if not C.MakeCurrent then Exit; + NeedUpload := False; + if (FBitmap.Width <> W) or (FBitmap.Height <> H) then + begin + SetBitmapSize(W, H); + NeedUpload := True; + end; + if FDirty then + begin + DrawCPU(W, H); + NeedUpload := True; + end; + if FGLTex = 0 then + NeedUpload := True; + if NeedUpload then + UploadBitmapToGL; + 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); + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, FGLTex); + glColor3f(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); + + if (FMarkerHz >= FViewStartHz) and (FMarkerHz <= FViewEndHz) then + begin + PlotW := Max(1, W - WB_DB_SCALE_W); + 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); +begin + if Sender is TOpenGLControl then + PaintGL(TOpenGLControl(Sender)) + else if Sender is TPaintBox then + PaintCPU(TPaintBox(Sender).Canvas); +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.