diff --git a/BeaconScopeForm.pas b/BeaconScopeForm.pas index 3bda2a9..0078b84 100644 --- a/BeaconScopeForm.pas +++ b/BeaconScopeForm.pas @@ -1,23 +1,52 @@ unit BeaconScopeForm; -{ TBeaconScopeForm — окно диагностики QO-100 beacon-декодера (Milestone 1). - Показывает BPSK-констелляцию демодулированного маяка + метрики захвата: - carrier-lock, symbol-lock, SNR, измеренную скорость, снос NCO. +{ TBeaconScopeForm — окно QO-100 beacon-декодера. - Это смотровое окно фронтенда ДО подключения FEC: если констелляция сжимается - в два чётких сгустка по оси I и горят оба лока — демодуляция корректна, можно - цеплять Viterbi/RS (libfec). Открывается из RX-блока MainForm (ПКМ по BEACON). + Три части сверху вниз: + 1. ЛУПА НАВЕДЕНИЯ (BEACON TUNING) — узкий кусок спектра вокруг маяка в + высоком разрешении + мини-водопад. На общей спектрограмме (полоса + захвата 576к и шире) центральный маяк занимает пару пикселей, и ткнуть + в него мышью почти нельзя; здесь то же наведение делается по широкому + следу. Клик = TRadioController.BeaconSeedAtHz, ровно как по главному + спектру — способ навестись со спектрограммы никуда не девался. + Увеличение делает САМ WDSP: у лупы свой analyzer со своим FFT и своим + span-clip (см. TWDSPEngine.SetBeaconZoom), поэтому окно детальное, а не + растянутые бины главного дисплея. + 2. Констелляция BPSK + метрики захвата (carrier/symbol lock, SNR, скорость, + снос NCO) — смотровое окно демодулятора. + 3. Декодированный бюллетень (кадры AO-40). - Данные тянутся из TRadioController.GetBeaconScope по таймеру (~25 Гц). } + Открывается из RX-блока MainForm (ПКМ по BEACON). Данные тянутся из + TRadioController по таймеру (~25 Гц). } {$mode objfpc}{$H+} interface uses - Classes, SysUtils, Math, StrUtils, + Classes, SysUtils, Math, StrUtils, Types, Forms, Controls, Graphics, ExtCtrls, StdCtrls, - AppTheme, BeaconDecoder, BeaconFEC, RadioController, DpiUtils, FlatMemo; + AppTheme, BeaconDecoder, BeaconFEC, RadioController, DpiUtils, FlatMemo, + FlatButton, WaterfallView; + +const + // Потолок точек в кадре лупы (движок отдаёт BCN_ZOOM_PIXELS = 1024). + BCN_MAX_PIX = 4096; + // Границы ширины окна лупы. Ниже 300 Гц смысла нет — маяк BPSK 400 Bd + // занимает ~800 Гц; выше 200 кГц лупа перестаёт быть лупой. + BCN_SPAN_MIN = 600.0; + BCN_SPAN_MAX = 200000.0; + BCN_SPAN_DEF = 40000.0; + BCN_ZOOM_STEP = 1.6; + // Полоса приёма декодера (± от несущей) — та же цифра, что у маркера на + // главном спектре в MainForm.UpdateBeaconButton. + BCN_DEC_BW_HZ = 450.0; + // Цвета маркеров — ровно те же, что на главном спектре + // (SpectrumView.DrawBeaconMarkersRaw / SpectrumViewOpengl.DrawBeaconMarkersGL), + // чтобы лупа и панорама читались как одна картинка. + BCN_CLR_REF = TColor($0000FF00); // clLime — где маяк ДОЛЖЕН быть (пунктир) + BCN_CLR_TRK = TColor($000AA5FF); // отслеживаемый центроид (оранж) + BCN_CLR_DEC = TColor($0020D0FF); // грани полосы приёма + центр наведения type TBeaconScopeForm = class(TForm) @@ -34,13 +63,89 @@ type FTimer: TTimer; FTheme: TAppTheme; FLastFrames: Int64; // счётчик кадров на прошлом тике (детект нового) + // Констелляция+метрики: кадр в офскрине, статичная обвязка — в отдельном + // кэше (идиома TSpectrumView.FGridBitmap). + FScope: TBitmap; + FScopeChrome: TBitmap; + FChromeW, FChromeH: Integer; // размер, под который собрана обвязка + FScopeValid: Boolean; // в FScope лежит актуальный кадр + + // --- Лупа наведения --- + FTune: TPanel; // карточка BEACON TUNING + FTuneTitle: TLabel; + FTuneHint: TLabel; + FSpecBox: TPaintBox; // спектр лупы + линейка частот + FWfBox: TPaintBox; // мини-водопад лупы + FWf: TWaterfallView; + FStrip: TBitmap; // офскрин спектра (без него мигает) + FBtnZoomIn, FBtnZoomOut, FBtnReset, FBtnFollow: TFlatButton; + + FCenterHz: Double; // центр окна лупы (display Hz), 0 = ещё не задан + FSpanHz: Double; // ширина окна лупы + FFollow: Boolean; // держать наведение декодера в окне + FViewLo, FViewHi: Double; // фактическое окно последнего кадра (display Hz) + FPix: array[0..BCN_MAX_PIX - 1] of Single; + FPixCount: Integer; + FWfPix: array[0..BCN_MAX_PIX - 1] of Single; + FHaveFrame: Boolean; + FSpecLo, FSpecHi: Double; // сглаженные границы шкалы дБ + // Рендер как во всей программе: кадр собирается в офскрин ТОЛЬКО когда есть + // что перерисовывать (FZoomDirty), а OnPaint лишь блитит битмап и кладёт + // сверху курсор. Иначе expose-события и движения мыши гоняли бы полную + // сборку кадра. + FZoomDirty: Boolean; + FStripValid: Boolean; // в FStrip лежит кадр под текущий размер + FLastRefHz, FLastTrkHz, FLastDecHz: Double; // детект сдвига маркеров + FCursorX: Integer; // -1 = курсор вне лупы + FDragging: Boolean; // ЛКМ зажата в лупе + FDragMoved: Boolean; // увели мышь → это панорамирование, не клик + FDragX: Integer; + FDragCenter: Double; + procedure DoTick(Sender: TObject); + procedure ScopeLayout(W, H: Integer; out GraphR, MetricsR, PlotR: TRect; + out cx, cy, r: Integer; out Wide: Boolean); + function MetricTileRect(const MetricsR: TRect; Wide: Boolean; + n: Integer): TRect; + procedure BuildScopeChrome(W, H: Integer); // статичная обвязка в кэш + procedure DrawScope; // кадр констелляции в офскрин procedure DoPaint(Sender: TObject); procedure FormResize(Sender: TObject); procedure PollFrame; function FrameToText(const Frame: TBeaconFrame): string; + + // --- Лупа --- + procedure BuildTunePanel; + procedure LayoutTunePanel; + procedure PollZoom; // забрать кадр лупы у контроллера + procedure ClampWindow; // окно не вылезает из полосы захвата + function DefaultCenterHz: Double; // куда смотреть, пока не выбрали + function XToFreq(X, W: Integer): Double; + function FreqToX(F: Double; W: Integer): Integer; + procedure ZoomBy(Factor: Double; AnchorX, W: Integer); + procedure DrawZoomStrip; // сборка кадра лупы в офскрин + procedure PaintSpec(Sender: TObject); + procedure PaintWf(Sender: TObject); + procedure SpecMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure SpecMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure SpecMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure SpecMouseLeave(Sender: TObject); + procedure SpecWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + procedure SpecDblClick(Sender: TObject); + procedure BtnZoomInClick(Sender: TObject); + procedure BtnZoomOutClick(Sender: TObject); + procedure BtnResetClick(Sender: TObject); + procedure BtnFollowClick(Sender: TObject); + procedure StyleTuneButtons; + protected + procedure DoShow; override; + procedure DoHide; override; public constructor CreateWith(AOwner: TComponent; ACtl: TRadioController); + destructor Destroy; override; procedure ApplyTheme(const T: TAppTheme); end; @@ -72,12 +177,19 @@ begin end; MaxW := WorkArea.Right - WorkArea.Left - DpiScale(48); MaxH := WorkArea.Bottom - WorkArea.Top - DpiScale(48); - Width := Min(DpiScale(760), MaxW); - Height := Min(DpiScale(700), MaxH); - Constraints.MinWidth := Min(DpiScale(520), Width); - Constraints.MinHeight := Min(DpiScale(560), Height); + Width := Min(DpiScale(820), MaxW); + Height := Min(DpiScale(940), MaxH); + Constraints.MinWidth := Min(DpiScale(560), Width); + Constraints.MinHeight := Min(DpiScale(700), Height); Color := FTheme.BG; + FCenterHz := 0.0; // задастся первым тиком (DefaultCenterHz) + FSpanHz := BCN_SPAN_DEF; + FFollow := True; + FCursorX := -1; + FSpecLo := -130.0; + FSpecHi := -60.0; + FHeader := TPanel.Create(Self); FHeader.Parent := Self; FHeader.Align := alTop; @@ -98,13 +210,15 @@ begin FSubtitle := TLabel.Create(Self); FSubtitle.Parent := FHeader; FSubtitle.Caption := - 'BPSK constellation, carrier recovery and AO-40 telemetry'; + 'Zoomed tuning window, BPSK constellation and AO-40 telemetry'; FSubtitle.AutoSize := False; FSubtitle.SetBounds(DpiScale(20), DpiScale(40), DpiScale(620), DpiScale(20)); FSubtitle.Font.Size := 9; FSubtitle.Font.Color := FTheme.TextDim; + BuildTunePanel; + FBulletin := TPanel.Create(Self); FBulletin.Parent := Self; FBulletin.Align := alBottom; @@ -151,6 +265,12 @@ begin FBox.Parent := Self; FBox.Align := alClient; FBox.OnPaint := @DoPaint; + FScope := TBitmap.Create; + FScope.PixelFormat := pf32bit; + FScopeChrome := TBitmap.Create; + FScopeChrome.PixelFormat := pf32bit; + FChromeW := 0; + FChromeH := 0; OnResize := @FormResize; FormResize(nil); @@ -160,6 +280,140 @@ begin FTimer.Enabled := True; end; +// =========================================================================== +// Лупа наведения: построение +// =========================================================================== + +procedure TBeaconScopeForm.BuildTunePanel; +begin + FTune := TPanel.Create(Self); + FTune.Parent := Self; + FTune.Top := FHeader.Height + 1; // ставим ПОД шапкой до Align (LCL сортирует по Top) + FTune.Align := alTop; + FTune.Height := DpiScale(252); + FTune.BevelOuter := bvNone; + FTune.Color := FTheme.BG; + + FTuneTitle := TLabel.Create(Self); + FTuneTitle.Parent := FTune; + FTuneTitle.Caption := 'BEACON TUNING'; + FTuneTitle.AutoSize := False; + FTuneTitle.SetBounds(DpiScale(20), DpiScale(10), DpiScale(300), DpiScale(18)); + FTuneTitle.Font.Size := 8; + FTuneTitle.Font.Style := [fsBold]; + FTuneTitle.Font.Color := FTheme.MeterOn; + + FTuneHint := TLabel.Create(Self); + FTuneHint.Parent := FTune; + FTuneHint.Caption := 'click the beacon to point the decoder · wheel zooms · drag pans'; + FTuneHint.AutoSize := False; + FTuneHint.SetBounds(DpiScale(120), DpiScale(11), DpiScale(360), DpiScale(16)); + FTuneHint.Font.Size := 8; + FTuneHint.Font.Color := FTheme.TextDim; + + FBtnFollow := MakeFlatBtn(FTune, 'FOLLOW', 0, 0, + DpiScale(66), DpiScale(22), @BtnFollowClick); + FBtnReset := MakeFlatBtn(FTune, 'RESET', 0, 0, + DpiScale(58), DpiScale(22), @BtnResetClick); + FBtnZoomOut := MakeFlatBtn(FTune, '−', 0, 0, + DpiScale(30), DpiScale(22), @BtnZoomOutClick); + FBtnZoomIn := MakeFlatBtn(FTune, '+', 0, 0, + DpiScale(30), DpiScale(22), @BtnZoomInClick); + StyleTuneButtons; + + FSpecBox := TPaintBox.Create(Self); + FSpecBox.Parent := FTune; + FSpecBox.OnPaint := @PaintSpec; + FSpecBox.OnMouseDown := @SpecMouseDown; + FSpecBox.OnMouseMove := @SpecMouseMove; + FSpecBox.OnMouseUp := @SpecMouseUp; + FSpecBox.OnMouseLeave := @SpecMouseLeave; + FSpecBox.OnMouseWheel := @SpecWheel; + FSpecBox.OnDblClick := @SpecDblClick; + FSpecBox.Cursor := crCross; + + FWfBox := TPaintBox.Create(Self); + FWfBox.Parent := FTune; + FWfBox.OnPaint := @PaintWf; + FWfBox.OnMouseDown := @SpecMouseDown; + FWfBox.OnMouseMove := @SpecMouseMove; + FWfBox.OnMouseUp := @SpecMouseUp; + FWfBox.OnMouseLeave := @SpecMouseLeave; + FWfBox.OnMouseWheel := @SpecWheel; + FWfBox.OnDblClick := @SpecDblClick; + FWfBox.Cursor := crCross; + + // Водопад лупы — тот же движок, что у главного окна: своя палитра, свой + // гистограммный AGC. Кадры идут по одному (интервал 1): у лупы окно узкое, + // накапливать max-hold нечего. + FWf := TWaterfallView.Create; + FWf.PbWaterfall := FWfBox; + FWf.WfFrameInterval := 1; + FWf.WfAGCEnabled := True; + FWf.SetTheme(FTheme); + + FStrip := TBitmap.Create; + FStrip.PixelFormat := pf32bit; + + LayoutTunePanel; +end; + +procedure TBeaconScopeForm.StyleTuneButtons; + + procedure Style(B: TFlatButton); + begin + if B = nil then Exit; + B.ClrNorm := FTheme.BtnNorm; + B.ClrActive := FTheme.BtnActive; + B.ClrHot := FTheme.BtnHot; + B.ClrBorder := FTheme.BtnBorderNorm; + B.ClrText := FTheme.BtnText; + B.ClrTextAct := FTheme.BtnTextActive; + B.Font.Size := 8; + B.Invalidate; + end; + +begin + Style(FBtnZoomIn); + Style(FBtnZoomOut); + Style(FBtnReset); + Style(FBtnFollow); + if FBtnFollow <> nil then FBtnFollow.Active := FFollow; +end; + +procedure TBeaconScopeForm.LayoutTunePanel; +// Ряд кнопок справа в строке заголовка, под ним спектр, под ним водопад. +var + W, X, Y, SpecTop, SpecH, WfTop, WfH, Pad: Integer; +begin + if FTune = nil then Exit; + W := FTune.ClientWidth; + Pad := DpiScale(14); + + Y := DpiScale(8); + X := W - Pad; + Dec(X, FBtnFollow.Width); FBtnFollow.SetBounds(X, Y, FBtnFollow.Width, FBtnFollow.Height); + Dec(X, DpiScale(6) + FBtnReset.Width); + FBtnReset.SetBounds(X, Y, FBtnReset.Width, FBtnReset.Height); + Dec(X, DpiScale(10) + FBtnZoomIn.Width); + FBtnZoomIn.SetBounds(X, Y, FBtnZoomIn.Width, FBtnZoomIn.Height); + Dec(X, DpiScale(4) + FBtnZoomOut.Width); + FBtnZoomOut.SetBounds(X, Y, FBtnZoomOut.Width, FBtnZoomOut.Height); + + FTuneTitle.SetBounds(DpiScale(20), DpiScale(10), DpiScale(96), DpiScale(18)); + FTuneHint.SetBounds(DpiScale(122), DpiScale(11), + Max(0, X - DpiScale(132)), DpiScale(16)); + + SpecTop := DpiScale(36); + WfH := DpiScale(64); + WfTop := FTune.ClientHeight - DpiScale(10) - WfH; + SpecH := Max(DpiScale(60), WfTop - SpecTop - DpiScale(2)); + FSpecBox.SetBounds(Pad, SpecTop, Max(DpiScale(40), W - 2 * Pad), SpecH); + FWfBox.SetBounds(Pad, WfTop, Max(DpiScale(40), W - 2 * Pad), WfH); + if FWf <> nil then + FWf.SetWaterfallBitmapSize(FWfBox.Width, FWfBox.Height); +end; + procedure TBeaconScopeForm.ApplyTheme(const T: TAppTheme); begin FTheme := T; @@ -172,21 +426,34 @@ begin if FBulletinHint <> nil then FBulletinHint.Font.Color := T.TextDim; if FMemo <> nil then FMemo.SetAppTheme(T); + if FTune <> nil then FTune.Color := T.BG; + if FTuneTitle <> nil then FTuneTitle.Font.Color := T.MeterOn; + if FTuneHint <> nil then FTuneHint.Font.Color := T.TextDim; + StyleTuneButtons; + if FWf <> nil then FWf.SetTheme(T); + FStripValid := False; + FChromeW := 0; // тема поменялась — обвязку пересобрать + FScopeValid := False; + if FSpecBox <> nil then FSpecBox.Invalidate; + if FWfBox <> nil then FWfBox.Invalidate; if FBox <> nil then FBox.Invalidate; end; procedure TBeaconScopeForm.FormResize(Sender: TObject); var - BulletinH, MaxBulletinH: Integer; + BulletinH, MaxBulletinH, TuneH: Integer; begin + TuneH := 0; + if FTune <> nil then TuneH := FTune.Height; if (FHeader <> nil) and (FBulletin <> nil) then begin - MaxBulletinH := ClientHeight - FHeader.Height - DpiScale(270); + MaxBulletinH := ClientHeight - FHeader.Height - TuneH - DpiScale(270); BulletinH := Min(DpiScale(236), Max(DpiScale(150), MaxBulletinH)); if FBulletin.Height <> BulletinH then FBulletin.Height := BulletinH; end; + LayoutTunePanel; if FTitle <> nil then FTitle.Width := Max(0, FHeader.ClientWidth - DpiScale(40)); if FSubtitle <> nil then @@ -197,6 +464,9 @@ begin FBulletinHint.Width := Max(0, FBulletin.ClientWidth - DpiScale(266)); end; + FStripValid := False; + FChromeW := 0; // размер поменялся — обвязку пересобрать + FScopeValid := False; if FBox <> nil then FBox.Invalidate; end; @@ -204,9 +474,152 @@ procedure TBeaconScopeForm.DoTick(Sender: TObject); begin if not Visible then Exit; PollFrame; + PollZoom; + // Констелляция и метрики обновляются каждый тик по существу — но сборка + // кадра идёт в офскрин из DrawScope, а Paint только копирует. + FScopeValid := False; if FBox <> nil then FBox.Invalidate; end; +// =========================================================================== +// Лупа наведения: данные и геометрия окна +// =========================================================================== + +function TBeaconScopeForm.DefaultCenterHz: Double; +// Куда смотреть, пока пользователь не выбрал сам: на наведение декодера, если +// оно есть, иначе на измеренную частоту маяка, иначе на опорную (10489.750). +begin + Result := 0; + if FCtl = nil then Exit; + Result := FCtl.BeaconDecodeFreqHz; + if Result > 0 then Exit; + Result := FCtl.BeaconTrackedFreqHz; + if Result > 0 then Exit; + Result := FCtl.BeaconRefHz; +end; + +procedure TBeaconScopeForm.ClampWindow; +// Окно лупы живёт внутри полосы захвата: за её краем анализатору нечего резать. +var + CapLo, CapHi, Half: Double; +begin + if FCtl = nil then Exit; + FCtl.GetCaptureWindow(CapLo, CapHi); + if CapHi - CapLo <= 0 then Exit; + FSpanHz := EnsureRange(FSpanHz, BCN_SPAN_MIN, Min(BCN_SPAN_MAX, CapHi - CapLo)); + Half := FSpanHz / 2.0; + FCenterHz := EnsureRange(FCenterHz, CapLo + Half, CapHi - Half); +end; + +procedure TBeaconScopeForm.PollZoom; +// Раз/тик: держим окно на месте (или тянем за декодером), просим у контроллера +// свежий кадр лупы и отдаём водопаду. +var + Cnt: Integer; + Lo, Hi, Dec_: Double; + GotWf: Boolean; +begin + if FCtl = nil then Exit; + + if FCenterHz <= 0 then FCenterHz := DefaultCenterHz; + // FOLLOW не «ведёт» окно постоянно (картинка ездила бы под рукой), а лишь не + // даёт потерять наведение: подтягивает окно, когда маркер ушёл за край. + if FFollow and not FDragging then + begin + Dec_ := FCtl.BeaconDecodeFreqHz; + if (Dec_ > 0) and (Abs(Dec_ - FCenterHz) > FSpanHz * 0.45) then + begin + FCenterHz := Dec_; + FZoomDirty := True; + end; + end; + ClampWindow; + + FCtl.SetBeaconZoomWindow(True, FCenterHz, FSpanHz); + + // Кадр анализатора приходит реже таймера (BCN_ZOOM_FPS) — пересобираем + // картинку ТОЛЬКО на свежем кадре либо когда переехали маркеры/окно. + // «Несвежий» кадр всё равно забираем: он нужен как последний нарисованный, + // пока анализатор наполняет FFT-окно после переарма. + FCtl.GetBeaconZoomSpectrum(FPix, Cnt, Lo, Hi); + if Cnt > 0 then + begin + if (Cnt <> FPixCount) or (Abs(Lo - FViewLo) > 0.01) + or (Abs(Hi - FViewHi) > 0.01) then + FZoomDirty := True; + FPixCount := Cnt; + FViewLo := Lo; + FViewHi := Hi; + FHaveFrame := True; + end + else + FPixCount := 0; + + if FCtl.BeaconRefHz <> FLastRefHz then FZoomDirty := True; + if FCtl.BeaconTrackedFreqHz <> FLastTrkHz then FZoomDirty := True; + if FCtl.BeaconDecodeFreqHz <> FLastDecHz then FZoomDirty := True; + FLastRefHz := FCtl.BeaconRefHz; + FLastTrkHz := FCtl.BeaconTrackedFreqHz; + FLastDecHz := FCtl.BeaconDecodeFreqHz; + + GotWf := FCtl.GetBeaconZoomWaterfall(FWfPix, Cnt); + if GotWf and (Cnt > 0) and (FWf <> nil) then + begin + FWf.CenterFreq := (FViewLo + FViewHi) / 2.0; + FWf.SpanHz := Max(1.0, FViewHi - FViewLo); + FWf.SetWaterfallData(FWfPix, Cnt); + if FWf.WaterfallDirty then + begin + FWf.DrawWaterfall; // новая строка в кольцо — только тогда и рисуем + FWf.WaterfallDirty := False; + if FWfBox <> nil then FWfBox.Invalidate; + end; + end; + + if FZoomDirty then + begin + FZoomDirty := False; + FStripValid := False; + if FSpecBox <> nil then FSpecBox.Invalidate; // сборку кадра сделает PaintSpec + end; +end; + +function TBeaconScopeForm.XToFreq(X, W: Integer): Double; +var Lo, Hi: Double; +begin + if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end + else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end; + if W <= 1 then Exit(Lo); + Result := Lo + (Hi - Lo) * X / (W - 1); +end; + +function TBeaconScopeForm.FreqToX(F: Double; W: Integer): Integer; +var Lo, Hi: Double; +begin + if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end + else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end; + if Hi - Lo <= 0 then Exit(-1); + Result := Round((F - Lo) / (Hi - Lo) * (W - 1)); +end; + +procedure TBeaconScopeForm.ZoomBy(Factor: Double; AnchorX, W: Integer); +// Зум вокруг точки под курсором: частота под ней остаётся на месте. +var + FAnchor, NewSpan, Frac: Double; +begin + NewSpan := EnsureRange(FSpanHz * Factor, BCN_SPAN_MIN, BCN_SPAN_MAX); + if Abs(NewSpan - FSpanHz) < 1E-6 then Exit; + if (AnchorX >= 0) and (W > 1) then + begin + FAnchor := XToFreq(AnchorX, W); + Frac := AnchorX / (W - 1); + FCenterHz := FAnchor - (Frac - 0.5) * NewSpan; + end; + FSpanHz := NewSpan; + ClampWindow; + FZoomDirty := True; +end; + function TBeaconScopeForm.FrameToText(const Frame: TBeaconFrame): string; // AO-40 кадр QO-100 = ASCII-текст (space-padded), последние 2 байта = CRC-16. // Как gr-satellites qo100.parse: отбрасываем CRC, печатные ASCII, строки по 64. @@ -227,6 +640,160 @@ begin end; end; +// =========================================================================== +// Лупа наведения: мышь и кнопки +// =========================================================================== + +procedure TBeaconScopeForm.SpecMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button <> mbLeft then Exit; + FDragging := True; + FDragMoved := False; + FDragX := X; + FDragCenter := FCenterHz; + FCursorX := X; +end; + +procedure TBeaconScopeForm.SpecMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); +// Тянем с зажатой ЛКМ — панорамируем окно; отпустили не сдвинув — это клик +// наведения (см. SpecMouseUp). +var + W: Integer; + Lo, Hi: Double; +begin + FCursorX := X; + W := TControl(Sender).Width; + if FDragging then + begin + if Abs(X - FDragX) > DpiScale(3) then FDragMoved := True; + if FDragMoved and (W > 1) then + begin + if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end + else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end; + FCenterHz := FDragCenter - (X - FDragX) * (Hi - Lo) / (W - 1); + ClampWindow; + FZoomDirty := True; + end; + end; + if FSpecBox <> nil then FSpecBox.Invalidate; + if FWfBox <> nil then FWfBox.Invalidate; +end; + +procedure TBeaconScopeForm.SpecMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +// Клик = навести декодер на эту частоту. Ровно тот же путь, что у клика по +// главному спектру (MainForm.PbSpectrumMouseDown): BeaconSeedAtHz сам включит +// лок, если он был выключен. +var W: Integer; +begin + if Button <> mbLeft then Exit; + W := TControl(Sender).Width; + if FDragging and not FDragMoved and (FCtl <> nil) and (W > 1) then + FCtl.BeaconSeedAtHz(XToFreq(X, W)); + FDragging := False; + FDragMoved := False; +end; + +procedure TBeaconScopeForm.SpecMouseLeave(Sender: TObject); +begin + FCursorX := -1; + FDragging := False; + if FSpecBox <> nil then FSpecBox.Invalidate; + if FWfBox <> nil then FWfBox.Invalidate; +end; + +procedure TBeaconScopeForm.SpecWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +// MousePos у колеса — экранные координаты, поэтому якорь берём из последнего +// MouseMove (FCursorX), он всегда в координатах виджета. +begin + if WheelDelta = 0 then Exit; + if WheelDelta > 0 then + ZoomBy(1.0 / BCN_ZOOM_STEP, FCursorX, TControl(Sender).Width) + else + ZoomBy(BCN_ZOOM_STEP, FCursorX, TControl(Sender).Width); + Handled := True; + if FSpecBox <> nil then FSpecBox.Invalidate; +end; + +procedure TBeaconScopeForm.SpecDblClick(Sender: TObject); +// Двойной клик — центрировать окно на точке под курсором. +var W: Integer; +begin + W := TControl(Sender).Width; + if (FCursorX >= 0) and (W > 1) then + begin + FCenterHz := XToFreq(FCursorX, W); + ClampWindow; + FZoomDirty := True; + end; +end; + +procedure TBeaconScopeForm.BtnZoomInClick(Sender: TObject); +begin + ZoomBy(1.0 / BCN_ZOOM_STEP, -1, 0); +end; + +procedure TBeaconScopeForm.BtnZoomOutClick(Sender: TObject); +begin + ZoomBy(BCN_ZOOM_STEP, -1, 0); +end; + +procedure TBeaconScopeForm.BtnResetClick(Sender: TObject); +begin + FSpanHz := BCN_SPAN_DEF; + FCenterHz := DefaultCenterHz; + ClampWindow; + FZoomDirty := True; +end; + +procedure TBeaconScopeForm.BtnFollowClick(Sender: TObject); +begin + FFollow := not FFollow; + if FBtnFollow <> nil then FBtnFollow.Active := FFollow; +end; + +procedure TBeaconScopeForm.DoShow; +begin + inherited DoShow; + if FCenterHz <= 0 then FCenterHz := DefaultCenterHz; + // Палитра/гамма водопада — те же, что выбраны для главного (настройки живут + // в контроллере), иначе лупа выглядела бы чужой панелью. + if (FWf <> nil) and (FCtl <> nil) then + begin + FWf.WfPalette := FCtl.FWfPalette; + FWf.WfGamma := FCtl.FWfGamma; + end; + LayoutTunePanel; + FZoomDirty := True; + FStripValid := False; + if FTimer <> nil then FTimer.Enabled := True; +end; + +procedure TBeaconScopeForm.DoHide; +begin + // Окно закрыли — гасим analyzer лупы: он второй по счёту на том же IQ, + // держать его без зрителя незачем. Таймер тоже стоп: MainForm освобождает + // контроллер раньше, чем эту форму, и тик по мёртвому FCtl был бы фатален. + if FTimer <> nil then FTimer.Enabled := False; + if FCtl <> nil then FCtl.SetBeaconZoomWindow(False, 0, 0); + inherited DoHide; +end; + +destructor TBeaconScopeForm.Destroy; +// Контроллер здесь НЕ трогаем: форму владелец (MainForm) освобождает уже после +// своего FormDestroy, где FController освобождён — analyzer лупы к этому моменту +// умер вместе с движком. Гасит лупу DoHide, он же отрабатывает при закрытии окна. +begin + FWf.Free; + FStrip.Free; + FScope.Free; + FScopeChrome.Free; + inherited Destroy; +end; + procedure TBeaconScopeForm.PollFrame; // Раз/тик: если декодер выдал НОВЫЙ кадр (S.Frames вырос) — печатаем бюллетень. var @@ -245,113 +812,356 @@ begin FMemo.SelStart := Length(FMemo.Text); // автоскролл вниз end; -procedure TBeaconScopeForm.DoPaint(Sender: TObject); +// =========================================================================== +// Лупа наведения: отрисовка +// =========================================================================== + +function FormatBcnFreq(Hz: Double): string; +// 10489750123 → '10489.750.123' +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 FormatTick(Hz: Double; StepHz: Double): string; +// Подпись деления линейки: килогерцы (+ герцы на мелком шаге). Полная частота +// висит в углу карточки, так что здесь важны только младшие разряды. +var KHz, Rest: Integer; +begin + KHz := (Trunc(Hz) div 1000) mod 1000; + Rest := Trunc(Hz) mod 1000; + if StepHz >= 1000 then Result := Format('%3.3d', [KHz]) + else Result := Format('%3.3d.%3.3d', [KHz, Rest]); +end; + +function NiceStep(SpanHz: Double; WantTicks: Integer): Double; +// Ближайший «круглый» шаг (1/2/5·10^k), дающий примерно WantTicks делений. +var Raw, Mag, Norm: Double; +begin + Raw := SpanHz / Max(1, WantTicks); + if Raw <= 0 then Exit(1.0); + Mag := Power(10, Floor(Log10(Raw))); + Norm := Raw / Mag; + if Norm < 1.5 then Result := Mag + else if Norm < 3.5 then Result := 2 * Mag + else if Norm < 7.5 then Result := 5 * Mag + else Result := 10 * Mag; +end; + +procedure TBeaconScopeForm.DrawZoomStrip; +// Полная сборка кадра лупы в офскрин FStrip. Зовётся ТОЛЬКО по FZoomDirty +// (новый кадр анализатора, сдвиг маркеров/окна, ресайз, смена темы) — так же, +// как MainForm гоняет FSpecView.DrawSpectrum по FSpectrumDirty. Курсор сюда не +// входит: он живёт в PaintSpec, чтобы движение мыши не пересобирало кадр. var C: TCanvas; - W, H, M, Gap, CardGap, GraphSize, cx, cy, r, i, px, py: Integer; - GraphR, MetricsR, PlotR: TRect; - S: TBeaconScope; - ok, Wide: Boolean; - CarrierText, SymbolText, SNRText, BaudText: string; - OffsetText, ResidText, FramesText, FECText: string; - TechText: string; - CarrierColor, SymbolColor: TColor; + W, H, PlotH, RulerH, i, X, Y, Cnt: Integer; + Pts: array of TPoint; + Lo, Hi, Span, dB, MaxDB, Step, F, T: Double; + DecHz, RefHz, TrkHz: Double; + Txt: string; + Sorted: array of Double; + TmpD: Double; + a, b: Integer; - procedure SetUIFont(ASize: Integer; AStyle: TFontStyles = []); + procedure SetFont(ASize: Integer; AStyle: TFontStyles = []); begin C.Font.Assign(Self.Font); C.Font.Size := ASize; C.Font.Style := AStyle; end; - procedure DrawCard(const R: TRect; const ATitle: string); + procedure VLine(FreqHz: Double; AColor: TColor; Dotted: Boolean); begin - C.Brush.Style := bsSolid; - C.Brush.Color := FTheme.Panel; - C.Pen.Style := psSolid; + X := FreqToX(FreqHz, W); + if (X < 0) or (X >= W) then Exit; + C.Pen.Color := AColor; C.Pen.Width := 1; - C.Pen.Color := FTheme.Border; - C.RoundRect(R.Left, R.Top, R.Right, R.Bottom, - DpiScale(8), DpiScale(8)); - SetUIFont(8, [fsBold]); - C.Font.Color := FTheme.TextDim; - C.Brush.Style := bsClear; - C.TextOut(R.Left + DpiScale(14), R.Top + DpiScale(10), ATitle); - end; - - procedure DrawMetricTile(const R: TRect; const ALabel, AValue: string; - AValueColor: TColor); - begin - C.Brush.Style := bsSolid; - C.Brush.Color := FTheme.BG; + if Dotted then C.Pen.Style := psDot else C.Pen.Style := psSolid; + C.MoveTo(X, 0); + C.LineTo(X, PlotH); C.Pen.Style := psSolid; - C.Pen.Color := FTheme.Border; - C.RoundRect(R.Left, R.Top, R.Right, R.Bottom, - DpiScale(5), DpiScale(5)); - - C.Brush.Style := bsClear; - SetUIFont(8); - C.Font.Color := FTheme.TextDim; - C.TextOut(R.Left + DpiScale(9), R.Top + DpiScale(6), ALabel); - SetUIFont(9, [fsBold]); - C.Font.Color := AValueColor; - C.TextOut(R.Left + DpiScale(9), R.Top + DpiScale(21), AValue); - end; - - procedure DrawMetrics; - const - LABELS: array[0..7] of string = - ('CARRIER', 'SYMBOL', 'SNR', 'SYMBOL RATE', - 'TUNE OFFSET', 'RESIDUAL', 'FRAMES', 'FEC'); - var - Values: array[0..7] of string; - Colors: array[0..7] of TColor; - Cols, Rows, Col, Row, TileW, TileH, X, Y, n: Integer; - R: TRect; - begin - Values[0] := CarrierText; Values[1] := SymbolText; - Values[2] := SNRText; Values[3] := BaudText; - Values[4] := OffsetText; Values[5] := ResidText; - Values[6] := FramesText; Values[7] := FECText; - for n := 0 to 7 do Colors[n] := FTheme.Text; - Colors[0] := CarrierColor; - Colors[1] := SymbolColor; - if ok and S.HasFrame then Colors[6] := FTheme.MeterOn; - if ok and S.HasFrame then Colors[7] := FTheme.MeterOn; - - if Wide then begin Cols := 2; Rows := 4; end - else begin Cols := 4; Rows := 2; end; - CardGap := DpiScale(8); - TileW := (MetricsR.Right - MetricsR.Left - DpiScale(28) - - (Cols - 1) * CardGap) div Cols; - TileH := (MetricsR.Bottom - MetricsR.Top - DpiScale(70) - - (Rows - 1) * CardGap) div Rows; - for n := 0 to 7 do - begin - Col := n mod Cols; - Row := n div Cols; - X := MetricsR.Left + DpiScale(14) + Col * (TileW + CardGap); - Y := MetricsR.Top + DpiScale(34) + Row * (TileH + CardGap); - R := Rect(X, Y, X + TileW, Y + TileH); - DrawMetricTile(R, LABELS[n], Values[n], Colors[n]); - end; - SetUIFont(7); - C.Font.Color := FTheme.TextDim; - C.Brush.Style := bsClear; - C.TextOut(MetricsR.Left + DpiScale(14), - MetricsR.Bottom - DpiScale(20), TechText); end; begin - C := FBox.Canvas; - W := FBox.Width; H := FBox.Height; + W := FSpecBox.Width; + H := FSpecBox.Height; + if (W <= 4) or (H <= 8) then Exit; + if (FStrip.Width <> W) or (FStrip.Height <> H) then + FStrip.SetSize(W, H); + C := FStrip.Canvas; + RulerH := DpiScale(15); + PlotH := H - RulerH; + // Фон + рамка C.Brush.Style := bsSolid; - C.Brush.Color := FTheme.BG; + C.Brush.Color := FTheme.SpecGradBot; C.FillRect(0, 0, W, H); - if (W <= 0) or (H <= 0) then Exit; + C.Brush.Color := FTheme.Panel; + C.FillRect(0, PlotH, W, H); - M := DpiScale(16); + if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end + else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end; + Span := Hi - Lo; + Cnt := FPixCount; + + // --- Шкала дБ: верх по максимуму кадра, низ по медиане (шумовой пол) --- + // Границы тянутся к цели плавно: иначе шкала прыгала бы на каждой посылке + // соседней SSB-станции, а маяк — то, что должно стоять на месте. + if Cnt > 1 then + begin + MaxDB := -400; + for i := 0 to Cnt - 1 do + if FPix[i] > MaxDB then MaxDB := FPix[i]; + // Медиана считается по прореженной выборке (каждая 8-я точка кадра) — + // сортировка вставками по ~128 значениям дешевле полной по 1024. + SetLength(Sorted, (Cnt + 7) div 8); + for i := 0 to High(Sorted) do + Sorted[i] := FPix[Min(i * 8, Cnt - 1)]; + for a := 1 to High(Sorted) do + begin + TmpD := Sorted[a]; + b := a - 1; + while (b >= 0) and (Sorted[b] > TmpD) do + begin + Sorted[b + 1] := Sorted[b]; + Dec(b); + end; + Sorted[b + 1] := TmpD; + end; + dB := Sorted[Length(Sorted) div 2]; // ≈ шумовой пол + if MaxDB - dB < 30 then MaxDB := dB + 30; + FSpecHi := FSpecHi + 0.2 * ((MaxDB + 6) - FSpecHi); + FSpecLo := FSpecLo + 0.2 * ((dB - 12) - FSpecLo); + if FSpecHi - FSpecLo < 25 then FSpecHi := FSpecLo + 25; + end; + + // --- Сетка --- + C.Pen.Style := psSolid; + C.Pen.Width := 1; + C.Pen.Color := FTheme.SpecGrid; + for i := 1 to 3 do + begin + Y := PlotH * i div 4; + C.MoveTo(0, Y); C.LineTo(W, Y); + end; + Step := NiceStep(Span, 6); + F := Ceil(Lo / Step) * Step; + while F < Hi do + begin + X := FreqToX(F, W); + if (X > 0) and (X < W) then + begin + C.Pen.Color := FTheme.SpecGrid; + C.MoveTo(X, 0); C.LineTo(X, PlotH); + end; + F := F + Step; + end; + + DecHz := 0; RefHz := 0; TrkHz := 0; + if FCtl <> nil then + begin + DecHz := FCtl.BeaconDecodeFreqHz; + RefHz := FCtl.BeaconRefHz; + TrkHz := FCtl.BeaconTrackedFreqHz; + end; + + // --- Трасса --- + if Cnt > 1 then + begin + SetLength(Pts, W + 2); + for X := 0 to W - 1 do + begin + // Кадр лупы (1024 точки) шире полотна — берём максимум группы, чтобы + // узкая несущая маяка не потерялась между пикселями. + a := Trunc(X * Cnt / W); + b := Trunc((X + 1) * Cnt / W); + if b <= a then b := a + 1; + if b > Cnt then b := Cnt; + dB := FPix[a]; + for i := a + 1 to b - 1 do + if FPix[i] > dB then dB := FPix[i]; + T := (dB - FSpecLo) / Max(1.0, FSpecHi - FSpecLo); + Y := PlotH - 1 - Round(EnsureRange(T, 0.0, 1.0) * (PlotH - 2)); + Pts[X] := Point(X, Y); + end; + // Заливка под трассой + Pts[W] := Point(W - 1, PlotH); + Pts[W + 1] := Point(0, PlotH); + C.Brush.Style := bsSolid; + C.Brush.Color := FTheme.SpecGradTop; + C.Pen.Style := psClear; + C.Polygon(Pts); + C.Pen.Style := psSolid; + C.Pen.Color := FTheme.SpecLine; + C.Pen.Width := 1; + C.MoveTo(Pts[0].X, Pts[0].Y); + for X := 1 to W - 1 do + C.LineTo(Pts[X].X, Pts[X].Y); + end + else + begin + SetFont(9); + C.Brush.Style := bsClear; + C.Font.Color := FTheme.TextDim; + Txt := 'waiting for IQ…'; + C.TextOut((W - C.TextWidth(Txt)) div 2, PlotH div 2 - DpiScale(8), Txt); + end; + + // --- Маркеры: один в один с главным спектром (DrawBeaconMarkersRaw/GL) --- + // Опорная (пунктир) + центроид, и три линии полосы приёма декодера. Заливки + // полосы намеренно нет: там так же — «дешевле для CPU и единый вид с GL». + if RefHz > 0 then VLine(RefHz, BCN_CLR_REF, True); + if TrkHz > 0 then VLine(TrkHz, BCN_CLR_TRK, False); + if DecHz > 0 then + begin + VLine(DecHz - BCN_DEC_BW_HZ, BCN_CLR_DEC, False); + VLine(DecHz + BCN_DEC_BW_HZ, BCN_CLR_DEC, False); + VLine(DecHz, BCN_CLR_DEC, False); + end; + + // --- Линейка частот --- + SetFont(7); + C.Brush.Style := bsClear; + C.Pen.Color := FTheme.Border; + C.MoveTo(0, PlotH); C.LineTo(W, PlotH); + F := Ceil(Lo / Step) * Step; + while F < Hi do + begin + X := FreqToX(F, W); + if (X > 0) and (X < W) then + begin + C.Pen.Color := FTheme.Border; + C.MoveTo(X, PlotH); C.LineTo(X, PlotH + DpiScale(3)); + Txt := FormatTick(F, Step); + C.Font.Color := FTheme.RulerText; + a := X - C.TextWidth(Txt) div 2; + if (a > 0) and (a + C.TextWidth(Txt) < W) then + C.TextOut(a, PlotH + DpiScale(2), Txt); + end; + F := F + Step; + end; + + // --- Показания в углах --- + SetFont(8, [fsBold]); + C.Brush.Style := bsClear; + C.Font.Color := FTheme.Text; + C.TextOut(DpiScale(6), DpiScale(4), FormatBcnFreq((Lo + Hi) / 2)); + SetFont(7); + C.Font.Color := FTheme.TextDim; + if (FCtl <> nil) and (FCtl.BeaconZoomBinHz > 0) then + Txt := Format('span %s · %.1f Hz/bin', + [IfThen(Span >= 10000, Format('%.0f kHz', [Span / 1000]), + Format('%.1f kHz', [Span / 1000])), + FCtl.BeaconZoomBinHz]) + else + Txt := Format('span %.1f kHz', [Span / 1000]); + C.TextOut(W - DpiScale(6) - C.TextWidth(Txt), DpiScale(5), Txt); + + // Рамка карточки поверх всего + C.Brush.Style := bsClear; + C.Pen.Style := psSolid; + C.Pen.Color := FTheme.Border; + C.Rectangle(0, 0, W, H); + + FStripValid := True; +end; + +procedure TBeaconScopeForm.PaintSpec(Sender: TObject); +// Только блит готового кадра + курсор поверх. Курсор рисуется здесь (а не в +// DrawZoomStrip) по образцу TWaterfallView.PaintWaterfall/DrawMarkerLine: +// движение мыши стоит блит и одну линию, а не пересборку кадра. +var + C: TCanvas; + W, H, PlotH, TxtX: Integer; + Txt: string; +begin + W := FSpecBox.Width; + H := FSpecBox.Height; + if (W <= 4) or (H <= 8) then Exit; + if (not FStripValid) or (FStrip.Width <> W) or (FStrip.Height <> H) then + DrawZoomStrip; + C := FSpecBox.Canvas; + C.Draw(0, 0, FStrip); + if (FCursorX < 0) or (FCursorX >= W) then Exit; + + PlotH := H - DpiScale(15); + C.Pen.Color := FTheme.SpecVfoCursor; + C.Pen.Style := psDot; + C.MoveTo(FCursorX, 0); C.LineTo(FCursorX, PlotH); + C.Pen.Style := psSolid; + C.Font.Assign(Self.Font); + C.Font.Size := 7; + C.Brush.Style := bsSolid; + C.Brush.Color := FTheme.Panel; + C.Font.Color := FTheme.Text; + Txt := ' ' + FormatBcnFreq(XToFreq(FCursorX, W)) + ' '; + TxtX := FCursorX + DpiScale(4); + if TxtX + C.TextWidth(Txt) > W then + TxtX := FCursorX - DpiScale(4) - C.TextWidth(Txt); + C.TextOut(TxtX, PlotH - DpiScale(14), Txt); + C.Brush.Style := bsClear; +end; + +procedure TBeaconScopeForm.PaintWf(Sender: TObject); +var + C: TCanvas; + W, H, X: Integer; + DecHz: Double; +begin + if FWf = nil then Exit; + FWf.PaintWaterfall(Sender); + C := FWfBox.Canvas; + W := FWfBox.Width; + H := FWfBox.Height; + if (W <= 0) or (H <= 0) then Exit; + // Маркер наведения продолжается на водопад — так видно, держится ли след + // маяка под полосой приёма. + DecHz := 0; + if FCtl <> nil then DecHz := FCtl.BeaconDecodeFreqHz; + if DecHz > 0 then + begin + X := FreqToX(DecHz, W); + if (X >= 0) and (X < W) then + begin + C.Pen.Style := psDot; + C.Pen.Color := BCN_CLR_DEC; + C.MoveTo(X, 0); C.LineTo(X, H); + C.Pen.Style := psSolid; + end; + end; + if (FCursorX >= 0) and (FCursorX < W) then + begin + C.Pen.Style := psDot; + C.Pen.Color := FTheme.SpecVfoCursor; + C.MoveTo(FCursorX, 0); C.LineTo(FCursorX, H); + C.Pen.Style := psSolid; + end; + C.Brush.Style := bsClear; + C.Pen.Color := FTheme.Border; + C.Rectangle(0, 0, W, H); +end; + +// =========================================================================== +// Констелляция и метрики: геометрия / статичная подложка / кадр +// =========================================================================== +// Рендер разложен на три слоя по образцу TSpectrumView (FGridBitmap → кадр → +// блит): неподвижная обвязка (карточки, оси, кружки, рамки и подписи плиток) +// живёт в отдельном битмапе и пересобирается только на ресайз/смену темы, +// кадр собирается по FScopeValid, а OnPaint лишь копирует готовое. Раньше вся +// эта геометрия — два RoundRect карточек, восемь RoundRect плиток и десяток +// TextOut — рисовалась заново 25 раз в секунду прямо в обработчике Paint. + +procedure TBeaconScopeForm.ScopeLayout(W, H: Integer; + out GraphR, MetricsR, PlotR: TRect; out cx, cy, r: Integer; + out Wide: Boolean); +var + M, Gap, GraphSize: Integer; +begin + M := DpiScale(16); Gap := DpiScale(14); Wide := W >= DpiScale(600); if Wide then @@ -366,8 +1176,6 @@ begin GraphR := Rect(M, M, W - M, M + GraphSize); MetricsR := Rect(M, GraphR.Bottom + Gap, W - M, H - M); end; - DrawCard(GraphR, 'CONSTELLATION'); - DrawCard(MetricsR, 'DECODER STATUS'); // Квадрат констелляции центрируется внутри своей карточки. GraphSize := Min(GraphR.Right - GraphR.Left - DpiScale(28), @@ -381,28 +1189,144 @@ begin PlotR.Bottom := PlotR.Top + GraphSize; cx := (PlotR.Left + PlotR.Right) div 2; cy := (PlotR.Top + PlotR.Bottom) div 2; - r := GraphSize div 2 - DpiScale(8); + r := GraphSize div 2 - DpiScale(8); +end; +function TBeaconScopeForm.MetricTileRect(const MetricsR: TRect; Wide: Boolean; + n: Integer): TRect; +var + Cols, Rows, Col, Row, TileW, TileH, X, Y, CardGap: Integer; +begin + if Wide then begin Cols := 2; Rows := 4; end + else begin Cols := 4; Rows := 2; end; + CardGap := DpiScale(8); + TileW := (MetricsR.Right - MetricsR.Left - DpiScale(28) + - (Cols - 1) * CardGap) div Cols; + TileH := (MetricsR.Bottom - MetricsR.Top - DpiScale(70) + - (Rows - 1) * CardGap) div Rows; + Col := n mod Cols; + Row := n div Cols; + X := MetricsR.Left + DpiScale(14) + Col * (TileW + CardGap); + Y := MetricsR.Top + DpiScale(34) + Row * (TileH + CardGap); + Result := Rect(X, Y, X + TileW, Y + TileH); +end; + +procedure TBeaconScopeForm.BuildScopeChrome(W, H: Integer); +// Всё, что не меняется от кадра к кадру. Значения метрик и точки констелляции +// сюда НЕ входят — они ложатся поверх в DrawScope. +const + LABELS: array[0..7] of string = + ('CARRIER', 'SYMBOL', 'SNR', 'SYMBOL RATE', + 'TUNE OFFSET', 'RESIDUAL', 'FRAMES', 'FEC'); +var + C: TCanvas; + GraphR, MetricsR, PlotR, TileR: TRect; + cx, cy, r, n: Integer; + Wide: Boolean; + + procedure SetUIFont(ASize: Integer; AStyle: TFontStyles = []); + begin + C.Font.Assign(Self.Font); + C.Font.Size := ASize; + C.Font.Style := AStyle; + end; + + procedure DrawCard(const AR: TRect; const ATitle: string); + begin + C.Brush.Style := bsSolid; + C.Brush.Color := FTheme.Panel; + C.Pen.Style := psSolid; + C.Pen.Width := 1; + C.Pen.Color := FTheme.Border; + C.RoundRect(AR.Left, AR.Top, AR.Right, AR.Bottom, + DpiScale(8), DpiScale(8)); + SetUIFont(8, [fsBold]); + C.Font.Color := FTheme.TextDim; + C.Brush.Style := bsClear; + C.TextOut(AR.Left + DpiScale(14), AR.Top + DpiScale(10), ATitle); + end; + +begin + FScopeChrome.SetSize(W, H); + FChromeW := W; + FChromeH := H; + C := FScopeChrome.Canvas; + + C.Brush.Style := bsSolid; + C.Brush.Color := FTheme.BG; + C.FillRect(0, 0, W, H); + + ScopeLayout(W, H, GraphR, MetricsR, PlotR, cx, cy, r, Wide); + DrawCard(GraphR, 'CONSTELLATION'); + DrawCard(MetricsR, 'DECODER STATUS'); + + // Поле констелляции: рамка, оси, единичная/половинная окружности и две + // «идеальные» точки BPSK на оси I. C.Brush.Style := bsSolid; C.Brush.Color := FTheme.BG; C.Pen.Style := psSolid; C.Pen.Color := FTheme.Border; C.Rectangle(PlotR.Left, PlotR.Top, PlotR.Right, PlotR.Bottom); - C.Pen.Style := psSolid; C.Pen.Color := FTheme.SpecGrid; C.Line(cx - r, cy, cx + r, cy); C.Line(cx, cy - r, cx, cy + r); C.Brush.Style := bsClear; C.Ellipse(cx - r, cy - r, cx + r, cy + r); C.Ellipse(cx - r div 2, cy - r div 2, cx + r div 2, cy + r div 2); - C.Pen.Color := FTheme.TextDim; C.Ellipse(cx + r div 2 - DpiScale(3), cy - DpiScale(3), cx + r div 2 + DpiScale(3), cy + DpiScale(3)); C.Ellipse(cx - r div 2 - DpiScale(3), cy - DpiScale(3), cx - r div 2 + DpiScale(3), cy + DpiScale(3)); + // Плитки метрик: фон, рамка и подпись. Значение — динамика, поверх. + for n := 0 to 7 do + begin + TileR := MetricTileRect(MetricsR, Wide, n); + C.Brush.Style := bsSolid; + C.Brush.Color := FTheme.BG; + C.Pen.Style := psSolid; + C.Pen.Color := FTheme.Border; + C.RoundRect(TileR.Left, TileR.Top, TileR.Right, TileR.Bottom, + DpiScale(5), DpiScale(5)); + C.Brush.Style := bsClear; + SetUIFont(8); + C.Font.Color := FTheme.TextDim; + C.TextOut(TileR.Left + DpiScale(9), TileR.Top + DpiScale(6), LABELS[n]); + end; +end; + +procedure TBeaconScopeForm.DrawScope; +var + C: TCanvas; + W, H, cx, cy, r, i, px, py, n: Integer; + GraphR, MetricsR, PlotR, TileR: TRect; + S: TBeaconScope; + ok, Wide: Boolean; + Values: array[0..7] of string; + Colors: array[0..7] of TColor; + TechText: string; + + procedure SetUIFont(ASize: Integer; AStyle: TFontStyles = []); + begin + C.Font.Assign(Self.Font); + C.Font.Size := ASize; + C.Font.Style := AStyle; + end; + +begin + W := FBox.Width; H := FBox.Height; + if (W <= 0) or (H <= 0) then Exit; + if (FScope.Width <> W) or (FScope.Height <> H) then FScope.SetSize(W, H); + if (FChromeW <> W) or (FChromeH <> H) then BuildScopeChrome(W, H); + + C := FScope.Canvas; + C.Draw(0, 0, FScopeChrome); // подложка = заодно стирание прошлого кадра + ScopeLayout(W, H, GraphR, MetricsR, PlotR, cx, cy, r, Wide); + ok := (FCtl <> nil) and FCtl.GetBeaconScope(S); + + // --- Точки констелляции --- if ok and S.Enabled then begin C.Pen.Style := psClear; @@ -418,48 +1342,77 @@ begin end; end; + // --- Значения метрик --- + for n := 0 to 7 do Colors[n] := FTheme.Text; if not ok then begin - CarrierText := 'UNAVAILABLE'; - SymbolText := 'UNAVAILABLE'; - SNRText := '--'; BaudText := '--'; - OffsetText := '--'; ResidText := '--'; - FramesText := '--'; FECText := '--'; + Values[0] := 'UNAVAILABLE'; Values[1] := 'UNAVAILABLE'; + Values[2] := '--'; Values[3] := '--'; + Values[4] := '--'; Values[5] := '--'; + Values[6] := '--'; Values[7] := '--'; TechText := 'Decoder data unavailable'; - CarrierColor := FTheme.TextDim; - SymbolColor := FTheme.TextDim; - end; - if ok and (not S.Enabled) then + Colors[0] := FTheme.TextDim; + Colors[1] := FTheme.TextDim; + end + else if not S.Enabled then begin - CarrierText := 'OFF'; SymbolText := 'OFF'; - SNRText := '--'; BaudText := '--'; - OffsetText := '--'; ResidText := '--'; - FramesText := IntToStr(S.Frames); - FECText := '--'; - TechText := 'Enable BEACON and select the beacon on the spectrum'; - CarrierColor := FTheme.TextDim; - SymbolColor := FTheme.TextDim; - end; - if ok and S.Enabled then + Values[0] := 'OFF'; Values[1] := 'OFF'; + Values[2] := '--'; Values[3] := '--'; + Values[4] := '--'; Values[5] := '--'; + Values[6] := IntToStr(S.Frames); + Values[7] := '--'; + TechText := 'Enable BEACON and click the beacon in the tuning window'; + Colors[0] := FTheme.TextDim; + Colors[1] := FTheme.TextDim; + end + else begin - CarrierText := IfThen(S.CarrierLock, 'LOCKED', 'SEARCH'); - SymbolText := IfThen(S.SymbolLock, 'LOCKED', 'SEARCH'); - if S.SNRdB > -50 then SNRText := Format('%.1f dB', [S.SNRdB]) - else SNRText := '--'; - BaudText := Format('%.1f Bd', [S.SymRate]); - OffsetText := Format('%.0f Hz', [S.OffsetHz]); - ResidText := Format('%.0f Hz', [S.ResidHz]); - FramesText := IntToStr(S.Frames); - FECText := Format('RS %d · P%d', [S.LastRSErr, S.ManPhase]); + Values[0] := IfThen(S.CarrierLock, 'LOCKED', 'SEARCH'); + Values[1] := IfThen(S.SymbolLock, 'LOCKED', 'SEARCH'); + if S.SNRdB > -50 then Values[2] := Format('%.1f dB', [S.SNRdB]) + else Values[2] := '--'; + Values[3] := Format('%.1f Bd', [S.SymRate]); + Values[4] := Format('%.0f Hz', [S.OffsetHz]); + Values[5] := Format('%.0f Hz', [S.ResidHz]); + Values[6] := IntToStr(S.Frames); + Values[7] := Format('RS %d · P%d', [S.LastRSErr, S.ManPhase]); TechText := Format('INV %s · PROM %.0f · Fs %.0f · Fd %.0f · SPS %.1f', [IfThen(FCtl.BeaconDecodeInvert, 'ON', 'OFF'), S.CarProm, S.FsHz, S.FdecHz, S.Sps]); - if S.CarrierLock then CarrierColor := FTheme.MeterOn - else CarrierColor := FTheme.TextDim; - if S.SymbolLock then SymbolColor := FTheme.MeterOn - else SymbolColor := FTheme.TextDim; + if S.CarrierLock then Colors[0] := FTheme.MeterOn + else Colors[0] := FTheme.TextDim; + if S.SymbolLock then Colors[1] := FTheme.MeterOn + else Colors[1] := FTheme.TextDim; + if S.HasFrame then + begin + Colors[6] := FTheme.MeterOn; + Colors[7] := FTheme.MeterOn; + end; end; - DrawMetrics; + + C.Brush.Style := bsClear; + SetUIFont(9, [fsBold]); + for n := 0 to 7 do + begin + TileR := MetricTileRect(MetricsR, Wide, n); + C.Font.Color := Colors[n]; + C.TextOut(TileR.Left + DpiScale(9), TileR.Top + DpiScale(21), Values[n]); + end; + SetUIFont(7); + C.Font.Color := FTheme.TextDim; + C.TextOut(MetricsR.Left + DpiScale(14), + MetricsR.Bottom - DpiScale(20), TechText); + + FScopeValid := True; +end; + +procedure TBeaconScopeForm.DoPaint(Sender: TObject); +begin + if (FBox.Width <= 0) or (FBox.Height <= 0) then Exit; + if (not FScopeValid) or (FScope.Width <> FBox.Width) + or (FScope.Height <> FBox.Height) then + DrawScope; + FBox.Canvas.Draw(0, 0, FScope); end; end. diff --git a/RadioController.pas b/RadioController.pas index 26e2419..24ad03d 100644 --- a/RadioController.pas +++ b/RadioController.pas @@ -988,6 +988,20 @@ type function BeaconDecodeInvert: Boolean; function GetBeaconScope(out S: TBeaconScope): Boolean; function GetBeaconFrame(out Frame: TBeaconFrame; out RSErrors: Integer): Boolean; + // --- Лупа маяка (окно наведения в BeaconScopeForm) ------------------- + // Отдельный WDSP-анализатор на IQ главного тракта, вырезающий узкое окно + // вокруг маяка: на общей спектрограмме 576к маяк — пара пикселей, точно + // ткнуть в него нельзя. Все частоты — АБСОЛЮТНЫЕ display-Гц, как у + // BeaconSeedAtHz. Зовётся с таймера окна маяка; окно закрыто → Enabled=False + // и анализатор уничтожается. + procedure SetBeaconZoomWindow(AEnabled: Boolean; ACenterHz, ASpanHz: Double); + function GetBeaconZoomSpectrum(var Pixels: array of Single; + out Count: Integer; out LowHz, HighHz: Double): Boolean; + function GetBeaconZoomWaterfall(var Pixels: array of Single; + out Count: Integer): Boolean; + // Полоса захвата (display-Гц): за её пределы лупу не увести. + procedure GetCaptureWindow(out ALowHz, AHighHz: Double); + function BeaconZoomBinHz: Double; // разрешение лупы, Гц/бин (для подписи) function GetDMRStatus(out S: TDMRStatus): Boolean; function GetSliceDMRStatus(SliceId: Integer; out S: TDMRStatus): Boolean; @@ -3486,6 +3500,64 @@ begin Result := Assigned(FBeaconDec) and FBeaconDec.GetLastFrame(Frame, RSErrors); end; +// --------------------------------------------------------------------------- +// Лупа маяка: окно наведения высокого разрешения (BeaconScopeForm) +// --------------------------------------------------------------------------- +// Движок работает в Гц относительно центра DDC, наружу отдаём абсолютные +// display-Гц — в них живут BeaconSeedAtHz, маркеры и клики пользователя. + +procedure TRadioController.GetCaptureWindow(out ALowHz, AHighHz: Double); +var Half: Double; +begin + Half := FSpanHz / 2.0; + if Half <= 0 then Half := FSampleRate / 2.0; + ALowHz := FCenterFreq - Half; + AHighHz := FCenterFreq + Half; +end; + +procedure TRadioController.SetBeaconZoomWindow(AEnabled: Boolean; + ACenterHz, ASpanHz: Double); +begin + if not Assigned(FDSPEngine) then Exit; + if AEnabled and (ACenterHz > 0) then + FDSPEngine.SetBeaconZoom(True, ACenterHz - FCenterFreq, ASpanHz) + else + FDSPEngine.SetBeaconZoom(False, 0, 0); +end; + +function TRadioController.GetBeaconZoomSpectrum(var Pixels: array of Single; + out Count: Integer; out LowHz, HighHz: Double): Boolean; +begin + Count := 0; + LowHz := 0; + HighHz := 0; + Result := False; + if not Assigned(FDSPEngine) then Exit; + Result := FDSPEngine.GetBeaconZoomSpectrum(Pixels, Count, LowHz, HighHz); + if Count > 0 then + begin + LowHz := LowHz + FCenterFreq; + HighHz := HighHz + FCenterFreq; + end; +end; + +function TRadioController.GetBeaconZoomWaterfall(var Pixels: array of Single; + out Count: Integer): Boolean; +begin + Count := 0; + Result := False; + if not Assigned(FDSPEngine) then Exit; + Result := FDSPEngine.GetBeaconZoomWaterfall(Pixels, Count); +end; + +function TRadioController.BeaconZoomBinHz: Double; +begin + Result := 0; + if not Assigned(FDSPEngine) then Exit; + if FDSPEngine.BeaconZoomFFT > 0 then + Result := FDSPEngine.SampleRate / FDSPEngine.BeaconZoomFFT; +end; + function TRadioController.GetDMRStatus(out S: TDMRStatus): Boolean; begin Result := Assigned(FDMRDec); diff --git a/WDSPEngine.pas b/WDSPEngine.pas index 03d8751..0f34f4d 100644 --- a/WDSPEngine.pas +++ b/WDSPEngine.pas @@ -142,17 +142,29 @@ const RX_DISP_ID = 0; // analyzer для RX-спектра/водопада TX_DISP_ID = 1; // analyzer для TX-спектра/водопада + // Отдельный analyzer лупы QO-100-маяка (окно BeaconScopeForm). Кормится тем + // же IQ главного тракта, но со своим FFT и своим span-clip — узкое окно + // вокруг маяка в высоком разрешении. Живёт только пока окно маяка открыто. + BCN_DISP_ID = 4; // --- Панадаптеры на аппаратных DDC (этап 3) --- // Пан 0 = главный тракт (RXA/RX_DISP_ID), доп. паны 1..MAX_PANS-1 живут на // своих DDC. Единый потолок для движка/контроллера/UI. MAX_PANS = 4; - // Analyzer id пана N = PAN_DISP_BASE + N (9..11). ID 4/5 заняты веткой - // feature/qo100-zoom-panel — не пересекаемся при будущем merge. + // Analyzer id пана N = PAN_DISP_BASE + N (9..11). ID 4 занят лупой маяка + // (BCN_DISP_ID), 5 держим свободным про запас. PAN_DISP_BASE = 8; DSP_BUFSIZE = 1024; SPECTRUM_PIXELS = 4096; // потолок точек дисплея; синхронно с WaterfallView.WF_MAX_PIXELS + // Точек в кадре лупы маяка. Фиксировано (а не по ширине виджета), чтобы + // изменение размера окна маяка не переармировало analyzer: переарм сбрасывает + // FFT-историю, а на крупных FFT она наполняется почти секунду. Рендер сам + // ужимает кадр под свою ширину. + BCN_ZOOM_PIXELS = 1024; + // Частота кадров лупы. Своя, ниже главного дисплея — см. + // ApplyBeaconAnalyzerSettings. + BCN_ZOOM_FPS = 15.0; DISPLAY_BLOCK_SIZE = 64; // Очередь IQ пакетов между сетевым и DSP потоком (общая: главный + паны). @@ -336,6 +348,27 @@ type FViewLowHz: Double; FViewHighHz: Double; + // --- Лупа маяка (BCN_DISP_ID) --------------------------------------- + // Второй analyzer на том же IQ главного тракта: своя FFT (крупнее) и свой + // span-clip, вырезающий узкое окно вокруг маяка. Создаётся/убивается по + // запросу UI (окно маяка открыто/закрыто), поэтому весь доступ к disp'у + // сериализуется FBcnLock: SetAnalyzer/Destroy зовёт UI-поток, Spectrum0 — + // DSP-поток, GetPixels — display-поток. + FBcnLock: TCriticalSection; + FBcnOpen: Boolean; // XCreateAnalyzer(BCN_DISP_ID) жив + FBcnDispBuf: array of Double; // feed анализатора (DISPLAY_BLOCK_SIZE пар) + FBcnDispPos: Integer; + FBcnReqCenter: Double; // запрошенный центр окна, Гц отн. DDC-центра + FBcnReqSpan: Double; // запрошенная ширина окна, Гц + FBcnLowHz: Double; // фактическое окно (снаппится по бинам FFT) + FBcnHighHz: Double; + FBcnFFT: Integer; // размер FFT лупы (свой, не FFFTSize) + FBcnPixCount: Integer; // точек в кадре лупы + FBcnSpecPix: array[0..SPECTRUM_PIXELS - 1] of Single; + FBcnWfPix: array[0..SPECTRUM_PIXELS - 1] of Single; + FBcnSpecFresh: Boolean; // в кэше есть непрочитанный кадр спектра + FBcnWfFresh: Boolean; + FOnAudio: TOnAudioReady; FOnDemodAudio:TOnAudioReady; // pre-volume/mute tap for digital decoders FOnSpectrum: TOnSpectrumReady; @@ -572,6 +605,12 @@ type procedure ApplyPSParams; // прокидывает FPS*-параметры в WDSP calcc procedure ApplyRXAnalyzerSettings; // применяет RX FFT/Window/Det/Avg к RX_DISP_ID procedure ApplyTXAnalyzerSettings; // применяет TX FFT/Window/Det/Avg к TX_DISP_ID + // --- Лупа маяка --- + procedure ApplyBeaconAnalyzerSettings; // span-clip окна маяка; под FBcnLock + function BeaconFFTFor(SpanHz: Double): Integer; // FFT под запрошенную ширину + procedure CloseBeaconAnalyzer; // Destroy + сброс (сам берёт FBcnLock) + procedure RearmBeaconAnalyzer; // полный переарм (смена rate) + procedure ReapplyBeaconDisplayModes; // детектор/усреднение без переарма public constructor Create(SampleRate: Integer = 192000; @@ -771,6 +810,23 @@ type property ViewLowHz: Double read FViewLowHz; property ViewHighHz: Double read FViewHighHz; + // --- Лупа маяка (BCN_DISP_ID) --------------------------------------- + // Включает/выключает второй analyzer на IQ главного тракта и задаёт его + // окно: ACenterHz/ASpanHz — В ГЕРЦАХ ОТНОСИТЕЛЬНО ЦЕНТРА DDC (как + // ViewLowHz/ViewHighHz). Окно клампится в полосу захвата. Вызывать из + // UI-потока. Enabled=False — analyzer уничтожается (нулевая цена, когда + // окно маяка закрыто). + procedure SetBeaconZoom(AEnabled: Boolean; ACenterHz, ASpanHz: Double); + // Забрать последний кадр лупы. Fresh=False, если нового кадра не было — + // вызывающий рисует предыдущий. Low/High — фактическое окно (Гц отн. + // центра DDC), уже снаппенное по бинам FFT. + function GetBeaconZoomSpectrum(var Pixels: array of Single; + out Count: Integer; out LowHz, HighHz: Double): Boolean; + function GetBeaconZoomWaterfall(var Pixels: array of Single; + out Count: Integer): Boolean; + property BeaconZoomOpen: Boolean read FBcnOpen; + property BeaconZoomFFT: Integer read FBcnFFT; + property Initialized: Boolean read FInitialized; property SampleRate: Integer read FSampleRate; property TXSampleRate: Integer read FTXSampleRate; @@ -1427,6 +1483,16 @@ begin FMainGated := False; FMainLock := TCriticalSection.Create; + // Лупа маяка — analyzer создаётся по требованию UI (SetBeaconZoom) + FBcnLock := TCriticalSection.Create; + FBcnOpen := False; + FBcnDispPos := 0; + FBcnReqCenter := 0.0; + FBcnReqSpan := 40000.0; + FBcnFFT := 0; + FBcnPixCount := 0; + SetLength(FBcnDispBuf, DISPLAY_BLOCK_SIZE * 2); + // Мультислайсы FSliceLock := TCriticalSection.Create; FillChar(FSlices, SizeOf(FSlices), 0); @@ -1526,6 +1592,7 @@ begin RTLEventDestroy(FTXMicSem); FSliceLock.Free; FMainLock.Free; + FBcnLock.Free; inherited; end; @@ -1757,12 +1824,241 @@ begin end; end; +// --------------------------------------------------------------------------- +// Лупа маяка (BCN_DISP_ID) +// --------------------------------------------------------------------------- + +function TWDSPEngine.BeaconFFTFor(SpanHz: Double): Integer; +// FFT лупы выбираем ОТ ШИРИНЫ ОКНА, а не от настройки дисплея: цель — держать +// ~BINS_PER_PIXEL бинов на точку кадра, чтобы узкое окно оставалось детальным +// (в этом весь смысл лупы). Span-clip НЕ удешевляет FFT — она всё равно по всей +// полосе захвата, поэтому потолок жёсткий: 262144 (= max_size в +// XCreateAnalyzer), а частота кадров лупы понижена (BCN_ZOOM_FPS). +const + BINS_PER_PIXEL = 2.0; +var + Want: Double; +begin + if SpanHz <= 0 then Exit(65536); + Want := BINS_PER_PIXEL * BCN_ZOOM_PIXELS * FSampleRate / SpanHz; + Result := 16384; + while (Result < Want) and (Result < 262144) do + Result := Result shl 1; +end; + +procedure TWDSPEngine.ApplyBeaconAnalyzerSettings; +// Переармирует analyzer лупы под FBcnReqCenter/FBcnReqSpan. Вызывать ПОД +// FBcnLock при FBcnOpen=True. +// +// Окно вырезается тем же span-clip'ом, что и зум главного спектра, но здесь +// клипы считаются НЕ из зум-слайдера, а прямо из желаемых границ в Гц — +// анализатор умеет ассиметричный клип, поэтому окно можно поставить в любое +// место полосы захвата, а не только вокруг центра DDC. +var + AvgCount, WfAvgCount, MaxW, Overlap: Integer; + Backmult, WfBackmult: Double; + Bins, ClipL, ClipH: Integer; + BinWidth, BW, WantLo, WantHi: Double; +begin + FBcnFFT := BeaconFFTFor(FBcnReqSpan); + FBcnDispPos := 0; + BinWidth := FSampleRate / FBcnFFT; + Bins := FBcnFFT; + BW := Bins * BinWidth; + + // Желаемые границы, зажатые в полосу захвата с запасом в один бин. + WantLo := FBcnReqCenter - FBcnReqSpan / 2.0; + WantHi := FBcnReqCenter + FBcnReqSpan / 2.0; + if WantLo < -0.5 * BW + BinWidth then WantLo := -0.5 * BW + BinWidth; + if WantHi > 0.5 * BW - BinWidth then WantHi := 0.5 * BW - BinWidth; + if WantHi - WantLo < 4 * BinWidth then WantHi := WantLo + 4 * BinWidth; + + ClipL := Floor((WantLo + 0.5 * BW + BinWidth / 2.0) / BinWidth); + ClipH := Floor((0.5 * BW - BinWidth / 2.0 - WantHi) / BinWidth); + ClipL := EnsureRange(ClipL, 0, Bins - 4); + ClipH := EnsureRange(ClipH, 0, Bins - 4 - ClipL); + // Фактическое окно — то же выражение, что в ApplyRXAnalyzerSettings. + FBcnLowHz := -(0.5 * BW - ClipL * BinWidth + BinWidth / 2.0); + FBcnHighHz := (0.5 * BW - ClipH * BinWidth - BinWidth / 2.0); + + // Кадры лупы считаем реже главного дисплея: FFT здесь крупная (до 262144) и + // идёт по ВСЕЙ полосе захвата, а для наведения на маяк 15 кадров/с с запасом. + // На 60 fps это была бы полноценная загрузка ядра ради картинки, в которой + // ничего не меняется. + Overlap := Max(0, Ceil(FBcnFFT - FSampleRate / BCN_ZOOM_FPS)); + MaxW := FBcnFFT + Round(Min(0.10 * FSampleRate, 0.10 * FBcnFFT * BCN_ZOOM_FPS)); + AverageTimeToParams(FSpecAvgMode, FSpecAvgTimeMS, AvgCount, Backmult); + AverageTimeToParams(FWfAvgMode, FWfAvgTimeMS, WfAvgCount, WfBackmult); + FBcnPixCount := BCN_ZOOM_PIXELS; + + SetAnalyzer(BCN_DISP_ID, 2, 1, 1, @FFlp[0], FBcnFFT, DISPLAY_BLOCK_SIZE, + FWindowType, 14.0, Overlap, 0, ClipL, ClipH, BCN_ZOOM_PIXELS, + 1, 0, 0.0, 0.0, MaxW); + SetDisplayDetectorMode(BCN_DISP_ID, 0, FSpecDetector); + SetDisplayAverageMode (BCN_DISP_ID, 0, FSpecAvgMode); + SetDisplayNumAverage (BCN_DISP_ID, 0, AvgCount); + SetDisplayAvBackmult (BCN_DISP_ID, 0, Backmult); + SetDisplayNormOneHz (BCN_DISP_ID, 0, UsePanNormOneHz(FSpecDetector)); + SetDisplayDetectorMode(BCN_DISP_ID, 1, FWfDetector); + SetDisplayAverageMode (BCN_DISP_ID, 1, FWfAvgMode); + SetDisplayNumAverage (BCN_DISP_ID, 1, WfAvgCount); + SetDisplayAvBackmult (BCN_DISP_ID, 1, WfBackmult); + SetDisplayNormOneHz (BCN_DISP_ID, 1, 0); + SetDisplaySampleRate (BCN_DISP_ID, FSampleRate); +end; + +procedure TWDSPEngine.CloseBeaconAnalyzer; +begin + FBcnLock.Enter; + try + if not FBcnOpen then Exit; + FBcnOpen := False; // DSP/display-потоки перестают трогать disp + DestroyAnalyzer(BCN_DISP_ID); + FBcnSpecFresh := False; + FBcnWfFresh := False; + FBcnPixCount := 0; + FBcnDispPos := 0; + finally + FBcnLock.Leave; + end; +end; + +procedure TWDSPEngine.RearmBeaconAnalyzer; +// Полный переарм лупы — после смены sample rate: и окно, и выбор FFT считаются +// от FSampleRate. +begin + if not FBcnOpen then Exit; + FBcnLock.Enter; + try + if FBcnOpen then ApplyBeaconAnalyzerSettings; + finally + FBcnLock.Leave; + end; +end; + +procedure TWDSPEngine.ReapplyBeaconDisplayModes; +// Детектор/усреднение с главного дисплея на лупу БЕЗ SetAnalyzer: переарм +// сбросил бы FFT-историю (на 256к бинах это ~0.5с замершего кадра), а сменой +// детектора/усреднения окно лупы не меняется. +var + AvgCount, WfAvgCount: Integer; + Backmult, WfBackmult: Double; +begin + if not FBcnOpen then Exit; + FBcnLock.Enter; + try + if not FBcnOpen then Exit; + AverageTimeToParams(FSpecAvgMode, FSpecAvgTimeMS, AvgCount, Backmult); + AverageTimeToParams(FWfAvgMode, FWfAvgTimeMS, WfAvgCount, WfBackmult); + SetDisplayDetectorMode(BCN_DISP_ID, 0, FSpecDetector); + SetDisplayAverageMode (BCN_DISP_ID, 0, FSpecAvgMode); + SetDisplayNumAverage (BCN_DISP_ID, 0, AvgCount); + SetDisplayAvBackmult (BCN_DISP_ID, 0, Backmult); + SetDisplayNormOneHz (BCN_DISP_ID, 0, UsePanNormOneHz(FSpecDetector)); + SetDisplayDetectorMode(BCN_DISP_ID, 1, FWfDetector); + SetDisplayAverageMode (BCN_DISP_ID, 1, FWfAvgMode); + SetDisplayNumAverage (BCN_DISP_ID, 1, WfAvgCount); + SetDisplayAvBackmult (BCN_DISP_ID, 1, WfBackmult); + finally + FBcnLock.Leave; + end; +end; + +procedure TWDSPEngine.SetBeaconZoom(AEnabled: Boolean; ACenterHz, ASpanHz: Double); +var + Success: Integer; + SameWindow: Boolean; +begin + if (not AEnabled) or (not FInitialized) or (not FAnalyzerOpen) then + begin + CloseBeaconAnalyzer; + Exit; + end; + + ASpanHz := EnsureRange(ASpanHz, 200.0, FSampleRate); + ACenterHz := EnsureRange(ACenterHz, -FSampleRate / 2.0, FSampleRate / 2.0); + + FBcnLock.Enter; + try + // Переарм сбрасывает историю FFT (кадр «замирает» на время наполнения) — + // на неизменившемся окне не дёргаем, лупа зовётся из таймера UI. + SameWindow := FBcnOpen and + (Abs(ACenterHz - FBcnReqCenter) < 0.5) and + (Abs(ASpanHz - FBcnReqSpan) < 0.5); + FBcnReqCenter := ACenterHz; + FBcnReqSpan := ASpanHz; + if SameWindow then Exit; + + if not FBcnOpen then + begin + Success := -1; + XCreateAnalyzer(BCN_DISP_ID, @Success, 262144, 1, 1, nil); + if Success <> 0 then + begin + FLastError := Format('XCreateAnalyzer(BCN) failed: %d', [Success]); + Exit; // лупа не поднялась — окно маяка просто останется пустым + end; + FBcnOpen := True; + end; + ApplyBeaconAnalyzerSettings; + finally + FBcnLock.Leave; + end; +end; + +function TWDSPEngine.GetBeaconZoomSpectrum(var Pixels: array of Single; + out Count: Integer; out LowHz, HighHz: Double): Boolean; +var N: Integer; +begin + Result := False; + Count := 0; + LowHz := 0; + HighHz := 0; + if not FBcnOpen then Exit; + FBcnLock.Enter; + try + if not FBcnOpen then Exit; + LowHz := FBcnLowHz; + HighHz := FBcnHighHz; + N := Min(FBcnPixCount, Length(Pixels)); + if N <= 0 then Exit; + Move(FBcnSpecPix[0], Pixels[0], N * SizeOf(Single)); + Count := N; + Result := FBcnSpecFresh; + FBcnSpecFresh := False; + finally + FBcnLock.Leave; + end; +end; + +function TWDSPEngine.GetBeaconZoomWaterfall(var Pixels: array of Single; + out Count: Integer): Boolean; +var N: Integer; +begin + Result := False; + Count := 0; + if not FBcnOpen then Exit; + FBcnLock.Enter; + try + if not FBcnOpen then Exit; + N := Min(FBcnPixCount, Length(Pixels)); + if N <= 0 then Exit; + Move(FBcnWfPix[0], Pixels[0], N * SizeOf(Single)); + Count := N; + Result := FBcnWfFresh; + FBcnWfFresh := False; + finally + FBcnLock.Leave; + end; +end; + procedure TWDSPEngine.ApplyAnalyzerSettings; // Совместимый вход: применяет настройки и к RX, и к TX analyzer'у, и к панам. begin ApplyRXAnalyzerSettings; ApplyTXAnalyzerSettings; ReapplyPanDisplaySettings; + ReapplyBeaconDisplayModes; end; procedure TWDSPEngine.SetZoomPan(AZoom, APan: Double); @@ -1796,6 +2092,9 @@ begin end; DestroyAnalyzer(RX_DISP_ID); DestroyAnalyzer(TX_DISP_ID); + // Лупа маяка: не пересоздаётся в OpenAnalyzer — окно маяка запросит её сама + // (SetBeaconZoom зовётся с таймера формы). + CloseBeaconAnalyzer; // Анализаторы доп. панов (записи FPans сохраняются — пересоздание в OpenAnalyzer). FSliceLock.Enter; try @@ -2085,6 +2384,8 @@ begin // главного дисплея сбрасывается (при смене rate это неизбежно), паны // не затронуты. if FAnalyzerOpen then ApplyRXAnalyzerSettings; + // Лупа маяка тоже считает окно и FFT от rate — переармируем. + RearmBeaconAnalyzer; // Beacon-декодер пересчитывает децимацию/RRC под новый IQ-rate. if FBeaconDec <> nil then FBeaconDec.Configure(FSampleRate); @@ -2310,6 +2611,26 @@ begin end; end; + // Лупа маяка — второй analyzer на том же потоке сэмплов. Живёт только пока + // окно маяка открыто, поэтому в обычном режиме это одна проверка Boolean. + if FBcnOpen then + begin + FBcnDispBuf[FBcnDispPos * 2] := DI; + FBcnDispBuf[FBcnDispPos * 2 + 1] := DQ; + Inc(FBcnDispPos); + if FBcnDispPos >= DISPLAY_BLOCK_SIZE then + begin + FBcnDispPos := 0; + FBcnLock.Enter; // UI-поток может в этот момент рвать analyzer + try + if FBcnOpen then + Spectrum0(1, BCN_DISP_ID, 0, 0, @FBcnDispBuf[0]); + finally + FBcnLock.Leave; + end; + end; + end; + if Bec <> nil then Bec.Feed(DI, DQ); FRXAccI[FRXAccPos] := DI; @@ -4058,6 +4379,7 @@ var i, N, p: Integer; DispID: Integer; Cal: Single; + MainCal: Single; // калибровка главного тракта (Cal ниже перетирается панами) GotSpec, GotWf: Boolean; begin if not FInitialized or not FAnalyzerOpen then Exit; @@ -4068,6 +4390,7 @@ begin // На TX-дисплее коррекция входного тракта не при чём. if Assigned(FOnDispCal) and (DispID = RX_DISP_ID) then Cal := FOnDispCal(0) else Cal := 0; + MainCal := Cal; Flag := 0; GetPixels(DispID, 0, @PixBuf[0], @Flag); @@ -4128,6 +4451,37 @@ begin if GotWf and Assigned(FOnPanWaterfall) then FOnPanWaterfall(p, WfBuf, N); end; + + // Лупа маяка: кадр кладём в кэш, а не в колбэк — окно маяка тянет его своим + // таймером (форма живёт отдельно от главного рендера и может быть закрыта). + if FBcnOpen then + begin + FBcnLock.Enter; + try + if FBcnOpen then + begin + N := EnsureRange(FBcnPixCount, 0, SPECTRUM_PIXELS); + Flag := 0; + GetPixels(BCN_DISP_ID, 0, @PixBuf[0], @Flag); + if Flag <> 0 then + begin + for i := 0 to N - 1 do + FBcnSpecPix[i] := PixBuf[i] + MainCal; + FBcnSpecFresh := True; + end; + Flag := 0; + GetPixels(BCN_DISP_ID, 1, @WfBuf[0], @Flag); + if Flag <> 0 then + begin + for i := 0 to N - 1 do + FBcnWfPix[i] := WfBuf[i] + MainCal; + FBcnWfFresh := True; + end; + end; + finally + FBcnLock.Leave; + end; + end; end; procedure TWDSPEngine.GetSpectrumData(var Pixels: array of Single;