diff --git a/FlatButton.pas b/FlatButton.pas index bcfc5c4..363481f 100644 --- a/FlatButton.pas +++ b/FlatButton.pas @@ -8,7 +8,7 @@ unit FlatButton; interface uses - Classes, SysUtils, Controls, Graphics, LCLType, Types; + Classes, SysUtils, Controls, Graphics, LCLType, LMessages, Types; type TFlatButton = class(TGraphicControl) @@ -27,6 +27,7 @@ type procedure Paint; override; procedure MouseEnter; override; procedure MouseLeave; override; + procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; @@ -131,6 +132,11 @@ begin Invalidate; end; +procedure TFlatButton.CMTextChanged(var Msg: TLMessage); +begin + Invalidate; +end; + procedure TFlatButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin diff --git a/HPSDRNetwork.pas b/HPSDRNetwork.pas index 6ba5dbd..c9dcd38 100644 --- a/HPSDRNetwork.pas +++ b/HPSDRNetwork.pas @@ -200,7 +200,8 @@ type procedure SendGeneralPacket(const Pkt: TGeneralPacket); procedure SendDDCSpecific(const Pkt: TDDCSpecificPacket); - procedure ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; ADCSource: Byte = 0); + procedure ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; ADCSource: Byte = 0; + DitherEnabled: Boolean = True; RandomEnabled: Boolean = True); procedure SendDUCSpecific(const Pkt: TDUCSpecificPacket); procedure SendHighPriority(const Pkt: THighPriorityPacket); procedure SetRunAndFreq(Run: Boolean; DDC0FreqHz, DUCFreqHz: Double; @@ -1266,7 +1267,8 @@ begin end; procedure THPSDRNetwork.ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; - ADCSource: Byte); + ADCSource: Byte; + DitherEnabled: Boolean; RandomEnabled: Boolean); var Pkt: TDDCSpecificPacket; i, ddc: Integer; @@ -1280,6 +1282,12 @@ begin else Pkt.NumADCs := 1; + // Dither/Random — биты 0..NumADCs-1 (один бит на ADC) + if DitherEnabled then + Pkt.DitherADC := (1 shl Pkt.NumADCs) - 1; + if RandomEnabled then + Pkt.RandomADC := (1 shl Pkt.NumADCs) - 1; + // Для ANGELIA/ORION/ORION2/SATURN DDC начинается с индекса 2 (DDC0/1 — PureSignal) // Для HERMES/HL2 — с 0 if FDevice.BoardType in [3, 4, 5, 10] then // ANGELIA=3, ORION=4, ORION2=5, SATURN=10 diff --git a/MainForm.pas b/MainForm.pas index 5b6a751..05a0f01 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -76,12 +76,26 @@ const (16000, 12000, 10000, 8000, 6600, 5200, 4000, 3100, 2900, 2400); FILT_AM_DEF = 3; // 8k - // FM - FILT_FM_NAMES: array[0..FILT_COUNT-1] of string = - ('20k','15k','12k','10k','8k','6k','5k','4k','3k','2k'); - FILT_FM_BW: array[0..FILT_COUNT-1] of Integer = - (20000, 15000, 12000, 10000, 8000, 6000, 5000, 4000, 3000, 2000); - FILT_FM_DEF = 0; // 20k + // FM: NFM (2.5 kHz deviation / 11 kHz BW) and FM (5.0 kHz deviation / 16 kHz BW) + FILT_FM_COUNT = 2; + FILT_FM_NAMES: array[0..1] of string = ('NFM', 'FM'); + FILT_FM_BW: array[0..1] of Integer = (11000, 16000); + FILT_FM_DEV: array[0..1] of Double = (2500.0, 5000.0); + FILT_FM_DEF = 0; // NFM + + // CTCSS tones (38 standard tones, no None — toggle via CTCSS button) + CTCSS_COUNT = 38; + CTCSS_TONES: array[0..37] of Double = ( + 67.0, 71.9, 74.4, 77.0, 79.7, 82.5, 85.4, 88.5, 91.5, 94.8, + 97.4, 100.0, 103.5, 107.2, 110.9, 114.8, 118.8, 123.0, 127.3, 131.8, + 136.5, 141.3, 146.2, 151.4, 156.7, 162.2, 167.9, 173.8, 179.9, 186.2, + 192.8, 203.5, 210.7, 218.1, 225.7, 233.6, 241.8, 250.3); + CTCSS_NAMES: array[0..37] of string = ( + '67.0', '71.9', '74.4', '77.0', '79.7', '82.5', '85.4', '88.5', + '91.5', '94.8', '97.4', '100.0', '103.5', '107.2', '110.9', '114.8', + '118.8', '123.0', '127.3', '131.8', '136.5', '141.3', '146.2', '151.4', + '156.7', '162.2', '167.9', '173.8', '179.9', '186.2', '192.8', '203.5', + '210.7', '218.1', '225.7', '233.6', '241.8', '250.3'); BAND_NAMES: array[0..BAND_COUNT-1] of string = ( '160m','80m','60m','40m','30m','20m','17m','15m','12m','10m','6m'); @@ -230,6 +244,13 @@ type // Waterfall settings (kept here for MakeGlobalSettings, buttons, settings dialog) FWfAGCEnabled: Boolean; FWfNFEnabled: Boolean; + FDitherEnabled: Boolean; + FRandomEnabled: Boolean; + FFMDeviation: Double; + FFMCTCSSOn: Boolean; + FFMCTCSSToneIdx: Integer; + FFMSQOn: Boolean; + FFMSQLevel: Integer; FWfManualHigh: Double; FWfManualLow: Double; FWfAGCOffset: Double; @@ -257,7 +278,12 @@ type FSplitterRatio: Double; // --- Settings --- FSettings: TSettingsManager; - FWebServer: TWebServer; // веб-интерфейс (порт 8080) + FWebServer: TWebServer; + FWebEnabled: Boolean; + FWebPort: Integer; + FWebBindAddr: string; + FWebUser: string; + FWebPass: string; FSavedMicSource: TTXMicSource; // сохраняется при переключении на txmsWeb FWebMicActive: Boolean; // True если текущий TX идёт через txmsWeb // --- CAT --- @@ -331,6 +357,15 @@ type BtnFilter: array[0..FILT_COUNT-1] of TFlatButton; BtnCTun: TFlatButton; BtnDUP: TFlatButton; + PanelFMSQ: TPanel; + BtnFMSQ: TFlatButton; + TrkFMSQ: TFlatSlider; + LblFMSQ: TLabel; + PanelFMCTCSS: TPanel; + BtnFMCTCSS: TFlatButton; + BtnFMCTCSSTone: TFlatButton; + PanelFMCTCSSPop: TPanel; + FBtnCTCSSTones: array[0..CTCSS_COUNT - 1] of TFlatButton; PanelRX: TPanel; BtnAGCMode: array[0..4] of TFlatButton; // FAST MED SLOW LONG OFF @@ -441,6 +476,14 @@ type procedure BtnTUNClick(Sender: TObject); procedure ApplyTUN(Active: Boolean); procedure UpdateFilterButtons; + procedure BtnFMSQClick(Sender: TObject); + procedure TrkFMSQChange(Sender: TObject); + procedure ApplyFMSquelch; + procedure BtnFMCTCSSClick(Sender: TObject); + procedure BtnFMCTCSSToneClick(Sender: TObject); + procedure BtnFMToneSelectClick(Sender: TObject); + procedure SetFMCTCSSTone(Idx: Integer); + procedure CloseCTCSSPopup; procedure PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PbSpectrumMouseMove(Sender: TObject; Shift: TShiftState; @@ -610,6 +653,9 @@ type procedure ApplyWaterfallParams(WfDet, WfAvgMode: Integer; WfAvgTimeMS, WfHigh, WfLow, WfAGCOffset: Double); procedure ApplyWfAGCNF(WfAGC, WfNF: Boolean); + procedure ApplyADCSettings(Dither, Random: Boolean); + procedure ApplyWebSettings(Enabled: Boolean; Port: Integer; + const BindAddr, User, Pass: string); procedure ApplyGridParams(RefLevel, Range, GridStep: Double); // Пушит активные grid-параметры (RX или TX в зависимости от FTransmitting) // в FSpecView и сбрасывает кэш сетки. Вызывается при смене RX↔TX и при @@ -857,6 +903,8 @@ begin Result.AGCTop := FAGCTop; Result.CTun := FCTun; Result.SpanHz := FSpanHz; + Result.FMSQOn := FFMSQOn; + Result.FMSQLevel := FFMSQLevel; // Waterfall AGC/NF — глобальные (не диапазонные) end; @@ -877,6 +925,8 @@ begin Result.AGCHangThreshold := 100; Result.WfAGCEnabled := FWfAGCEnabled; Result.WfNFEnabled := FWfNFEnabled; + Result.DitherEnabled := FDitherEnabled; + Result.RandomEnabled := FRandomEnabled; Result.LastBand := FCurrentBand; Result.LastXvtr := FCurrentXvtr; Result.SampleRate := FSampleRate; @@ -990,6 +1040,11 @@ begin end; FSpecView.AGCTop := FAGCTop; + // --- FM Squelch --- + FFMSQOn := B.FMSQOn; + FFMSQLevel := B.FMSQLevel; + // UI update happens inside UpdateFilterButtons (called above) when mode=FM + // --- CTUN --- FCTun := B.CTun; StyleButton(BtnCTun, FCTun); @@ -1035,6 +1090,7 @@ end; procedure TMainForm.FormCreate(Sender: TObject); var bi_, StartupRate, i: Integer; + WebCfg: TWebSettings; StartupVfoA, StartupVfoB: Double; begin FVfoA := 14200000; @@ -1069,6 +1125,13 @@ begin FWfAGCOffset := 0.0; FWfAGCEnabled := True; FWfNFEnabled := False; + FDitherEnabled := True; + FRandomEnabled := True; + FFMDeviation := FILT_FM_DEV[FILT_FM_DEF]; + FFMCTCSSOn := False; + FFMCTCSSToneIdx := 0; + FFMSQOn := False; + FFMSQLevel := 30; FSpectrumBufCount := 1024; FWaterfallBufCount := 1024; FWaterfallFrameInterval := 2; @@ -1110,8 +1173,14 @@ begin // (будет пересчитан в первом тике SpectrumTimerTick) FLastSMeter := -130; - // Создаём веб-сервер (логин: admin, пароль: hpsdr — менять здесь) - FWebServer := TWebServer.Create('admin', 'hpsdr'); + // Загружаем настройки веб-сервера из JSON и создаём сервер + FSettings.LoadWebSettings(WebCfg); + FWebEnabled := WebCfg.Enabled; + FWebPort := WebCfg.Port; + FWebBindAddr := WebCfg.BindAddr; + FWebUser := WebCfg.User; + FWebPass := WebCfg.Pass; + FWebServer := TWebServer.Create(FWebUser, FWebPass, Word(FWebPort), FWebBindAddr); FWebServer.OnFreq := WebOnFreq; FWebServer.OnMode := WebOnMode; FWebServer.OnFilter := WebOnFilter; @@ -1139,7 +1208,7 @@ begin FWebServer.OnTun := WebOnTun; FWebServer.OnWebMic := WebOnMic; FWebServer.OnXvtrBand := WebOnXvtrBand; - FWebServer.Start; + if FWebEnabled then FWebServer.Start; PushXvtrToWeb; FillChar(FCATLastGlobal, SizeOf(FCATLastGlobal), 0); FCATLastGlobal.CATTcpPort := 19090; @@ -1653,6 +1722,70 @@ begin Inc(Y, 76); + // FM Squelch panel (visible only in FM mode, above CTCSS) + PanelFMSQ := TPanel.Create(Self); + PanelFMSQ.Parent := PanelLeft; + PanelFMSQ.SetBounds(0, Y, LEFT_W, 50); + PanelFMSQ.BevelOuter := bvNone; + PanelFMSQ.Visible := False; + MakeLbl(PanelFMSQ, 'SQL', 4, 4); + W := LEFT_W div 4 - 2; // button width ~56px + BtnFMSQ := MakeBtn(PanelFMSQ, 'SQL', 2, 20, W, BTN_SM, BtnFMSQClick); + StyleButton(BtnFMSQ, False); + // Slider: vertically centred with button text (button top=20, h=24 → center=32) + // Reserve 28px on the right for the numeric label + TrkFMSQ := TFlatSlider.Create(Self); + TrkFMSQ.Parent := PanelFMSQ; + TrkFMSQ.Left := W + 6; + TrkFMSQ.Top := 25; // 32 - 14/2 = 25 + TrkFMSQ.Width := LEFT_W - W - 6 - 30 - 4; // leave 30px for label + margins + TrkFMSQ.Height := 14; + TrkFMSQ.Min := 0; TrkFMSQ.Max := 100; + TrkFMSQ.Position := FFMSQLevel; + TrkFMSQ.OnChange := TrkFMSQChange; + // Numeric value label to the right of the slider + LblFMSQ := TLabel.Create(Self); + LblFMSQ.Parent := PanelFMSQ; + LblFMSQ.Left := TrkFMSQ.Left + TrkFMSQ.Width + 3; + LblFMSQ.Top := 25; + LblFMSQ.Width := 26; + LblFMSQ.Caption := IntToStr(FFMSQLevel); + LblFMSQ.Font.Color := CLR_TEXT; + LblFMSQ.Font.Name := 'Courier New'; + LblFMSQ.Font.Size := 8; + + // FM CTCSS panel (visible only when FM mode is active) + PanelFMCTCSS := TPanel.Create(Self); + PanelFMCTCSS.Parent := PanelLeft; + PanelFMCTCSS.SetBounds(0, Y, LEFT_W, 50); + PanelFMCTCSS.BevelOuter := bvNone; + PanelFMCTCSS.Visible := False; + MakeLbl(PanelFMCTCSS, 'CTCSS', 4, 4); + W := LEFT_W div 3 - 2; + BtnFMCTCSS := MakeBtn(PanelFMCTCSS, 'CTCSS', 2, 20, W, BTN_H, BtnFMCTCSSClick); + StyleButton(BtnFMCTCSS, False); + BtnFMCTCSSTone := MakeBtn(PanelFMCTCSS, CTCSS_NAMES[0], W + 4, 20, LEFT_W - W - 8, BTN_H, BtnFMCTCSSToneClick); + StyleButton(BtnFMCTCSSTone, False); + + // Tone picker popup (child of PanelLeft, hidden until BtnFMCTCSSTone is clicked) + PanelFMCTCSSPop := TPanel.Create(Self); + PanelFMCTCSSPop.Parent := PanelLeft; + PanelFMCTCSSPop.BevelOuter := bvNone; + PanelFMCTCSSPop.Color := CLR_PANEL; + PanelFMCTCSSPop.Visible := False; + W := (LEFT_W - 4) div 4; + PanelFMCTCSSPop.SetBounds(0, 0, LEFT_W, ((CTCSS_COUNT + 3) div 4) * BTN_SM); + for i := 0 to CTCSS_COUNT - 1 do + begin + B := MakeBtn(PanelFMCTCSSPop, CTCSS_NAMES[i], + 2 + (i mod 4) * W, + (i div 4) * BTN_SM, + W - 2, BTN_SM, BtnFMToneSelectClick); + B.Tag := i; + StyleButton(B, i = FFMCTCSSToneIdx); + FBtnCTCSSTones[i] := B; + end; + // CTUN / DUP buttons (display-related) BtnCTun := MakeBtn(PanelLeft, 'CTUN', 2, Y, LEFT_W div 3 - 2, BTN_H, BtnCTunClick); BtnCTun.Tag := 0; @@ -2251,6 +2384,9 @@ begin DP(PanelTopVfoGroup); DP(PanelTopVfoA); DP(PanelTopVfoB); DP(PanelVfoA); DP(PanelVfoB); DP(PanelVfoButtons); DP(PanelBands); DP(PanelMode); DP(PanelFilter); + if PanelFMSQ <> nil then DP(PanelFMSQ); + if PanelFMCTCSS <> nil then DP(PanelFMCTCSS); + if PanelFMCTCSSPop <> nil then DP(PanelFMCTCSSPop); DP(PanelRX); DP(PanelTX); DP(PanelRight); DP(PanelSpanButtons); @@ -2262,6 +2398,7 @@ begin // Метки DL(LblAGCTop, False); DL(LblDrv); DL(LblSpan); + if LblFMSQ <> nil then DL(LblFMSQ, False); // Кнопки тулбара BtnDiscover.ClrNorm := T.TbDiscoverNorm; @@ -2283,6 +2420,12 @@ begin for i := 0 to 4 do StyleButton(BtnAGCMode[i],BtnAGCMode[i].Active); StyleButton(BtnCTun, BtnCTun.Active); StyleButton(BtnDUP, BtnDUP.Active); + if BtnFMSQ <> nil then StyleButton(BtnFMSQ, BtnFMSQ.Active); + if TrkFMSQ <> nil then DS(TrkFMSQ); + if BtnFMCTCSS <> nil then StyleButton(BtnFMCTCSS, BtnFMCTCSS.Active); + if BtnFMCTCSSTone <> nil then StyleButton(BtnFMCTCSSTone, False); + for i := 0 to CTCSS_COUNT-1 do + if FBtnCTCSSTones[i] <> nil then StyleButton(FBtnCTCSSTones[i], FBtnCTCSSTones[i].Active); StyleButton(BtnNR, BtnNR.Active); StyleButton(BtnNB, BtnNB.Active); StyleButton(BtnSNB, BtnSNB.Active); @@ -3511,8 +3654,10 @@ begin BtnNB.Tag := EnsureRange(G_Settings.NBMode, 0, 2); UpdateNBButton; BtnSNB.Tag := Ord(G_Settings.SNBEnabled); UpdateSNBButton; BtnANF.Tag := Ord(G_Settings.ANFEnabled); UpdateANFButton; - FWfAGCEnabled := G_Settings.WfAGCEnabled; - FWfNFEnabled := G_Settings.WfNFEnabled; + FWfAGCEnabled := G_Settings.WfAGCEnabled; + FWfNFEnabled := G_Settings.WfNFEnabled; + FDitherEnabled := G_Settings.DitherEnabled; + FRandomEnabled := G_Settings.RandomEnabled; FWfManualHigh := G_Settings.WfManualHigh; FWfManualLow := G_Settings.WfManualLow; FWfAGCOffset := G_Settings.WfAGCOffset; @@ -3639,7 +3784,7 @@ begin // DDC и DUC Specific — теперь потоки эмулятора слушают на своих портах. // DUC Specific содержит mic-конфигурацию (boost/bias/line/PTT) из FTXSettings. - FNetwork.ConfigureDDCs(1, FSampleRate div 1000, 0); + FNetwork.ConfigureDDCs(1, FSampleRate div 1000, 0, FDitherEnabled, FRandomEnabled); SendDUCSpecificFromSettings; // Применяем TX-цепь (фильтр, mic gain, EQ, leveler, ALC, comp, ...). ApplyTXSettingsToDSP; @@ -3879,7 +4024,56 @@ var i: Integer; Names: array[0..FILT_COUNT-1] of string; DefIdx: Integer; + W: Integer; begin + if FMode = MODE_FM then + begin + // FM: show only NFM and WFM buttons, resize them to fill the row + CloseCTCSSPopup; + FFilter := FILT_FM_DEF; + FFilterBW := FILT_FM_BW[FILT_FM_DEF]; + FFMDeviation := FILT_FM_DEV[FILT_FM_DEF]; + W := (PanelFilter.Width - 6) div 2; + BtnFilter[0].Caption := FILT_FM_NAMES[0]; + BtnFilter[0].Left := 2; + BtnFilter[0].Width := W - 2; + BtnFilter[0].Top := 16; + BtnFilter[0].Visible := True; + StyleButton(BtnFilter[0], FFilter = 0); + BtnFilter[1].Caption := FILT_FM_NAMES[1]; + BtnFilter[1].Left := W + 2; + BtnFilter[1].Width := W - 2; + BtnFilter[1].Top := 16; + BtnFilter[1].Visible := True; + StyleButton(BtnFilter[1], FFilter = 1); + for i := 2 to FILT_COUNT - 1 do BtnFilter[i].Visible := False; + // Shrink panel to fit label + 1 button row so SQL/CTCSS sit right below + PanelFilter.Height := BtnFilter[0].Top + BtnFilter[0].Height + 4; + if PanelFMSQ <> nil then + begin + PanelFMSQ.Visible := True; + StyleButton(BtnFMSQ, FFMSQOn); + TrkFMSQ.Position := FFMSQLevel; + LblFMSQ.Caption := IntToStr(FFMSQLevel); + end; + if PanelFMCTCSS <> nil then PanelFMCTCSS.Visible := True; + RelayoutBelowBands; + Exit; + end; + + // Non-FM: restore full 2-row height and 5-column layout, hide FM panels + PanelFilter.Height := 74; + if PanelFMSQ <> nil then PanelFMSQ.Visible := False; + if PanelFMCTCSS <> nil then PanelFMCTCSS.Visible := False; + W := (PanelFilter.Width - 6) div 5; + for i := 0 to FILT_COUNT - 1 do + begin + BtnFilter[i].Left := 2 + (i mod 5) * W; + BtnFilter[i].Top := 16 + (i div 5) * 27; + BtnFilter[i].Width := W - 2; + BtnFilter[i].Visible := True; + end; + case FMode of 0, 1: begin for i := 0 to FILT_COUNT-1 do Names[i] := FILT_SSB_NAMES[i]; @@ -3889,10 +4083,6 @@ begin for i := 0 to FILT_COUNT-1 do Names[i] := FILT_CW_NAMES[i]; DefIdx := FILT_CW_DEF; end; - 5: begin - for i := 0 to FILT_COUNT-1 do Names[i] := FILT_FM_NAMES[i]; - DefIdx := FILT_FM_DEF; - end; else begin for i := 0 to FILT_COUNT-1 do Names[i] := FILT_AM_NAMES[i]; DefIdx := FILT_AM_DEF; @@ -3903,7 +4093,6 @@ begin case FMode of 0, 1: FFilterBW := FILT_SSB_BW[DefIdx]; 3, 4: FFilterBW := FILT_CW_BW[DefIdx]; - 5: FFilterBW := FILT_FM_BW[DefIdx]; else FFilterBW := FILT_AM_BW[DefIdx]; end; @@ -3912,6 +4101,7 @@ begin BtnFilter[i].Caption := Names[i]; StyleButton(BtnFilter[i], i = FFilter); end; + RelayoutBelowBands; end; // --------------------------------------------------------------------------- @@ -4398,7 +4588,7 @@ var begin Half := FFilterBW div 2; case FMode of - 0: begin Lo := -FFilterBW; Hi := -100; end; // LSB: верхний срез -100 Гц + 0: begin Lo := -FFilterBW; Hi := -100; end; // LSB 1: begin Lo := 100; Hi := FFilterBW; end; // USB 2: begin Lo := -Half; Hi := Half; end; // DSB 3: begin Lo := -Half; Hi := Half; end; // CWL @@ -4408,9 +4598,19 @@ begin 7: begin Lo := -Half; Hi := Half; end; // SAM else Lo := -Half; Hi := Half; end; - if FWDSPReady then begin + if FWDSPReady then + begin FDSPEngine.SetFilter(Lo, Hi); FDSPEngine.SetTXFilter(Lo, Hi); + if FMode = MODE_FM then + begin + FDSPEngine.SetRXFMDeviation(FFMDeviation); + FDSPEngine.SetTXFMParams(FFMDeviation, FTXSettings.FMLowCut, + FTXSettings.FMHighCut, FTXSettings.FMEmphPosition); + FDSPEngine.SetFMSquelch(FFMSQOn, FFMSQLevel); + end + else + FDSPEngine.SetFMSquelch(False, 0); end; end; @@ -4439,18 +4639,109 @@ var begin N := (Sender as TFlatButton).Tag; FFilter := N; - // Устанавливаем полосу по текущему режиму case FMode of - 0, 1: FFilterBW := FILT_SSB_BW[N]; - 3, 4: FFilterBW := FILT_CW_BW[N]; - 5: FFilterBW := FILT_FM_BW[N]; - else FFilterBW := FILT_AM_BW[N]; // DSB, AM, SAM + 0, 1: FFilterBW := FILT_SSB_BW[N]; + 3, 4: FFilterBW := FILT_CW_BW[N]; + 5: begin + FFilterBW := FILT_FM_BW[N]; + FFMDeviation := FILT_FM_DEV[N]; + end; + else FFilterBW := FILT_AM_BW[N]; end; for i := 0 to FILT_COUNT - 1 do StyleButton(BtnFilter[i], i = FFilter); ApplyModeFilter; SyncSpecViewFreq; end; +// --------------------------------------------------------------------------- +// FM CTCSS helpers +// --------------------------------------------------------------------------- + +procedure TMainForm.ApplyFMSquelch; +begin + if FWDSPReady then + FDSPEngine.SetFMSquelch(FFMSQOn and (FMode = MODE_FM), FFMSQLevel); +end; + +procedure TMainForm.BtnFMSQClick(Sender: TObject); +begin + FFMSQOn := not FFMSQOn; + StyleButton(BtnFMSQ, FFMSQOn); + BtnFMSQ.Repaint; + ApplyFMSquelch; + SaveCurrentBand; +end; + +procedure TMainForm.TrkFMSQChange(Sender: TObject); +begin + FFMSQLevel := TrkFMSQ.Position; + if LblFMSQ <> nil then LblFMSQ.Caption := IntToStr(FFMSQLevel); + ApplyFMSquelch; + SaveCurrentBand; +end; + +procedure TMainForm.CloseCTCSSPopup; +begin + if (PanelFMCTCSSPop <> nil) and PanelFMCTCSSPop.Visible then + PanelFMCTCSSPop.Visible := False; +end; + +procedure TMainForm.SetFMCTCSSTone(Idx: Integer); +var + OldIdx: Integer; +begin + OldIdx := FFMCTCSSToneIdx; + FFMCTCSSToneIdx := Idx; + if BtnFMCTCSSTone <> nil then + begin + BtnFMCTCSSTone.Caption := CTCSS_NAMES[Idx]; + BtnFMCTCSSTone.Invalidate; + end; + // Only flip Active on the two affected buttons — avoids 38× StyleButton/font overhead + if (OldIdx <> Idx) and (FBtnCTCSSTones[OldIdx] <> nil) then + FBtnCTCSSTones[OldIdx].Active := False; + if FBtnCTCSSTones[Idx] <> nil then + FBtnCTCSSTones[Idx].Active := True; + if FWDSPReady then + FDSPEngine.SetTXCTCSS(FFMCTCSSOn, CTCSS_TONES[Idx]); +end; + +procedure TMainForm.BtnFMCTCSSClick(Sender: TObject); +begin + FFMCTCSSOn := not FFMCTCSSOn; + StyleButton(BtnFMCTCSS, FFMCTCSSOn); + BtnFMCTCSS.Repaint; // Flush visual state before WDSP call + if FWDSPReady then + FDSPEngine.SetTXCTCSS(FFMCTCSSOn, CTCSS_TONES[FFMCTCSSToneIdx]); +end; + +procedure TMainForm.BtnFMCTCSSToneClick(Sender: TObject); +var + Y0: Integer; +begin + // Toggle the dropdown + if PanelFMCTCSSPop.Visible then + begin + CloseCTCSSPopup; + Exit; + end; + // Position below the CTCSS panel, or above if no room + Y0 := PanelFMCTCSS.Top + PanelFMCTCSS.Height + 2; + if Y0 + PanelFMCTCSSPop.Height > PanelLeft.ClientHeight then + Y0 := PanelFMCTCSS.Top - PanelFMCTCSSPop.Height - 2; + if Y0 < 0 then Y0 := 0; + PanelFMCTCSSPop.Top := Y0; + PanelFMCTCSSPop.Left := 0; + PanelFMCTCSSPop.BringToFront; + PanelFMCTCSSPop.Visible := True; +end; + +procedure TMainForm.BtnFMToneSelectClick(Sender: TObject); +begin + CloseCTCSSPopup; + SetFMCTCSSTone((Sender as TFlatButton).Tag); +end; + procedure TMainForm.BtnVfoSwapClick(Sender: TObject); var Tmp: Double; @@ -4730,6 +5021,35 @@ begin FSpecView.WfNFEnabled := FWfNFEnabled; end; +procedure TMainForm.ApplyADCSettings(Dither, Random: Boolean); +begin + FDitherEnabled := Dither; + FRandomEnabled := Random; + if FNetwork.Connected and FRunning then + FNetwork.ConfigureDDCs(1, FSampleRate div 1000, 0, FDitherEnabled, FRandomEnabled); + if FDevConnected then + FSettings.SaveGlobal(FDevMAC, MakeGlobalSettings); +end; + +procedure TMainForm.ApplyWebSettings(Enabled: Boolean; Port: Integer; + const BindAddr, User, Pass: string); +var W: TWebSettings; +begin + FWebEnabled := Enabled; + FWebPort := Port; + FWebBindAddr := BindAddr; + FWebUser := User; + FWebPass := Pass; + FWebServer.Reconfigure(User, Pass, BindAddr, Word(Port)); + if Enabled then FWebServer.Start; + W.Enabled := Enabled; + W.Port := Port; + W.BindAddr := BindAddr; + W.User := User; + W.Pass := Pass; + FSettings.SaveWebSettings(W); +end; + procedure TMainForm.BtnHidePanelClick(Sender: TObject); begin FPanelHidden := not FPanelHidden; @@ -4831,7 +5151,7 @@ begin // 2. Отправляем новый rate трансиверу // (после остановки DSP — новые пакеты сразу идут с правильным rate) if FNetwork.Connected then - FNetwork.ConfigureDDCs(1, DDCRate, 0); + FNetwork.ConfigureDDCs(1, DDCRate, 0, FDitherEnabled, FRandomEnabled); // 3. Восстанавливаем настройки DSP FWDSPReady := FDSPEngine.Initialized; @@ -5626,6 +5946,14 @@ begin Y := PanelBands.Top + PanelBands.Height + 2; PanelMode.Top := Y; Y := Y + PanelMode.Height + 2; PanelFilter.Top := Y; Y := Y + PanelFilter.Height + 2; + if (PanelFMSQ <> nil) and PanelFMSQ.Visible then + begin + PanelFMSQ.Top := Y; Y := Y + PanelFMSQ.Height + 2; + end; + if (PanelFMCTCSS <> nil) and PanelFMCTCSS.Visible then + begin + PanelFMCTCSS.Top := Y; Y := Y + PanelFMCTCSS.Height + 2; + end; BtnCTun.Top := Y; BtnDUP.Top := Y; Y := Y + BtnCTun.Height + 4; PanelRX.Top := Y; end; @@ -6141,6 +6469,8 @@ begin SF.OnAlexChange := OnAlexSettingsChange; SF.OnXvtrChange := OnXvtrSettingsChange; SF.OnWfAGCNFChange := ApplyWfAGCNF; + SF.OnADCChange := ApplyADCSettings; + SF.OnWebSettingsChange := ApplyWebSettings; end; SF := TSettingsForm(FSettingsForm); SF.LoadTXSettings(FTXSettings); @@ -6161,6 +6491,8 @@ begin SF.RefreshAudioDevices(FAudioOut, FAudioIn); SF.LoadVisibility(FShowSpectrum, FShowWaterfall); SF.LoadWfAGCNF(FWfAGCEnabled, FWfNFEnabled); + SF.LoadADCSettings(FDitherEnabled, FRandomEnabled); + SF.LoadWebSettings(FWebEnabled, FWebPort, FWebBindAddr, FWebUser, FWebPass); SF.LoadFPS(FDisplayFPS); SF.LoadLightTheme(FLightTheme); SF.LoadFreqMhzDigits(FFreqMhzDigits); diff --git a/Settings.pas b/Settings.pas index e2b262d..6a3e8b0 100644 --- a/Settings.pas +++ b/Settings.pas @@ -29,6 +29,8 @@ type AGCTop: Integer; CTun: Boolean; SpanHz: Double; + FMSQOn: Boolean; + FMSQLevel: Integer; // 0..100 → WDSP threshold 0.0..0.5 end; // TX-настройки per-device. Хранятся в JSON-секции "tx" под MAC, @@ -104,6 +106,15 @@ type TXSpecGridStep: Double; // grid step in dB, e.g. 10 end; + // Web-сервер — глобальные настройки (не привязаны к устройству, секция "web"). + TWebSettings = record + Enabled: Boolean; + Port: Integer; // 1..65535 + BindAddr: string; // e.g. '0.0.0.0' (все интерфейсы) + User: string; + Pass: string; + end; + // Transverter (XVTR) entry — один трансвертер. // Видимая частота VFO в [FreqBegin..FreqEnd] транслируется в IF-частоту, // которую слышит трансивер: f_IF = f_visible - LOOffset + LOError. @@ -197,6 +208,9 @@ type // --- PA (Power Amplifier) settings --- PAMaxPower: Double; // максимальная выходная мощность, Вт (5..200) PABandCal: array[0..CFG_BAND_COUNT-1] of Double; // калибровка на диапазон 38.8..100.0 + // --- ADC settings --- + DitherEnabled: Boolean; // DDC Specific byte 5 — уменьшает интермодуляцию + RandomEnabled: Boolean; // DDC Specific byte 6 — рандомизация ADC // --- CAT (Computer Aided Transceiver) settings --- // До 4 последовательных портов (Linux: /dev/ttyS0, Windows: COM1 и т.д.) CATSerialEnabled: array[0..3] of Boolean; @@ -264,6 +278,10 @@ type class procedure DefaultXvtr(out X: TXvtrSettings); function LoadXvtr(const MAC: array of Byte; out X: TXvtrSettings): Boolean; procedure SaveXvtr(const MAC: array of Byte; const X: TXvtrSettings); + // Web-сервер — глобальные настройки (секция "web" в корне JSON). + class procedure DefaultWeb(out W: TWebSettings); + procedure LoadWebSettings(out W: TWebSettings); + procedure SaveWebSettings(const W: TWebSettings); // Тема — глобальная настройка, не привязана к устройству procedure SaveTheme(ALightTheme: Boolean); function LoadTheme: Boolean; @@ -309,6 +327,8 @@ begin B.AGCTop := 90; B.CTun := False; B.SpanHz := 192000; + B.FMSQOn := False; + B.FMSQLevel := 30; end; class procedure TSettingsManager.DefaultGlobal(out G: TGlobalSettings); @@ -362,6 +382,9 @@ begin end; G.CATTcpEnabled := False; G.CATTcpPort := 19090; + // ADC — включены по умолчанию: поддерживаются на Hermes, Angelia, Orion + G.DitherEnabled := True; + G.RandomEnabled := True; end; constructor TSettingsManager.Create(const FilePath: string); @@ -578,6 +601,9 @@ begin end; G.CATTcpEnabled := JB(GObj,'cat_tcp_enabled', False); G.CATTcpPort := JI(GObj,'cat_tcp_port', 19090); + // ADC settings + G.DitherEnabled := JB(GObj,'dither_enabled', True); + G.RandomEnabled := JB(GObj,'random_enabled', True); for i := 0 to CFG_BAND_COUNT-1 do begin @@ -654,6 +680,9 @@ begin end; JW(O,'cat_tcp_enabled',G.CATTcpEnabled); JW(O,'cat_tcp_port',G.CATTcpPort); + // ADC settings + JW(O,'dither_enabled',G.DitherEnabled); + JW(O,'random_enabled',G.RandomEnabled); end; procedure TSettingsManager.SaveBand(const MAC: array of Byte; BandIdx: Integer; @@ -667,6 +696,7 @@ begin JW(O,'filter_idx',B.FilterIdx); JW(O,'filter_bw',B.FilterBW); JW(O,'agc_mode',B.AGCMode); JW(O,'agc_top',B.AGCTop); JW(O,'ctun',B.CTun); JW(O,'span_hz',B.SpanHz); + JW(O,'fmsq_on',B.FMSQOn); JW(O,'fmsq_level',B.FMSQLevel); end; function TSettingsManager.LoadBand(const MAC: array of Byte; BandIdx: Integer; @@ -687,6 +717,8 @@ begin B.AGCTop := JI(O,'agc_top', B.AGCTop); B.CTun := JB(O,'ctun', B.CTun); B.SpanHz := JD(O,'span_hz', B.SpanHz); + B.FMSQOn := JB(O,'fmsq_on', B.FMSQOn); + B.FMSQLevel := JI(O,'fmsq_level', B.FMSQLevel); end; procedure TSettingsManager.SaveWindowBounds(L, T, W, H: Integer); @@ -1137,6 +1169,40 @@ begin end; end; +class procedure TSettingsManager.DefaultWeb(out W: TWebSettings); +begin + W.Enabled := True; + W.Port := 8080; + W.BindAddr := '0.0.0.0'; + W.User := 'admin'; + W.Pass := 'hpsdr'; +end; + +procedure TSettingsManager.LoadWebSettings(out W: TWebSettings); +var O: TJSONObject; +begin + DefaultWeb(W); + if FRoot.Find('web') = nil then Exit; + O := EnsureObj(FRoot, 'web'); + W.Enabled := JB(O, 'enabled', True); + W.Port := EnsureRange(JI(O, 'port', 8080), 1, 65535); + W.BindAddr := JS(O, 'bind_addr', '0.0.0.0'); + W.User := JS(O, 'user', 'admin'); + W.Pass := JS(O, 'pass', 'hpsdr'); +end; + +procedure TSettingsManager.SaveWebSettings(const W: TWebSettings); +var O: TJSONObject; +begin + O := EnsureObj(FRoot, 'web'); + JW(O, 'enabled', W.Enabled); + JW(O, 'port', W.Port); + JWS(O, 'bind_addr', W.BindAddr); + JWS(O, 'user', W.User); + JWS(O, 'pass', W.Pass); + Save; +end; + procedure TSettingsManager.SaveTheme(ALightTheme: Boolean); var O: TJSONObject; begin diff --git a/SettingsForm.pas b/SettingsForm.pas index 234e85a..e17b925 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -48,6 +48,9 @@ type TOnFPSChange = procedure(FPS: Integer) of object; TOnThemeChange = procedure(LightTheme: Boolean) of object; TOnWfAGCNFChange = procedure(WfAGC, WfNF: Boolean) of object; + TOnADCChange = procedure(Dither, Random: Boolean) of object; + TOnWebSettingsChange = procedure(Enabled: Boolean; Port: Integer; + const BindAddr, User, Pass: string) of object; TOnCATChange = procedure( const SerEnabled: array of Boolean; const SerPort: array of string; @@ -234,12 +237,23 @@ type FCATTcpEn: TCheckBox; FCATTcpPort: TSpinEdit; + // ---- Advanced tab controls ---- + FChkDither: TCheckBox; + FChkRandom: TCheckBox; + FChkWebEnabled: TCheckBox; + FEdWebPort: TSpinEdit; + FEdWebBind: TEdit; + FEdWebUser: TEdit; + FEdWebPass: TEdit; + // ---- Close button ---- FBtnClose: TFlatButton; // ---- Callbacks ---- FOnCATChange: TOnCATChange; FOnPAChange: TOnPASettingsChange; + FOnADCChange: TOnADCChange; + FOnWebSettingsChange: TOnWebSettingsChange; FOnDisplayChange: TOnDisplayParamChange; FOnWaterfallChange: TOnWaterfallParamChange; FOnGridChange: TOnGridParamChange; @@ -262,6 +276,9 @@ type procedure BuildCATTab; procedure BuildTransmitTab; procedure BuildAlexTab; + procedure BuildAdvancedTab; + procedure OnADCChkChange(Sender: TObject); + procedure OnWebAnyChange(Sender: TObject); procedure CollectAlexFromUI; procedure FireAlexChange; procedure OnAlexAnyChange(Sender: TObject); @@ -354,6 +371,9 @@ type procedure LoadAlexSettings(const A: TAlexSettings; BoardType: Integer); procedure LoadXvtrSettings(const X: TXvtrSettings); procedure LoadWfAGCNF(AGC, NF: Boolean); + procedure LoadADCSettings(Dither, Random: Boolean); + procedure LoadWebSettings(Enabled: Boolean; Port: Integer; + const BindAddr, User, Pass: string); property OnCATChange: TOnCATChange read FOnCATChange write FOnCATChange; property OnAlexChange: TOnAlexChange read FOnAlexChange write FOnAlexChange; @@ -370,6 +390,8 @@ type property OnFreqMhzDigitsChange: TOnFreqMhzDigitsChange read FOnFreqMhzDigitsChange write FOnFreqMhzDigitsChange; property OnTXChange: TOnTXSettingsChange read FOnTXChange write FOnTXChange; property OnWfAGCNFChange: TOnWfAGCNFChange read FOnWfAGCNFChange write FOnWfAGCNFChange; + property OnADCChange: TOnADCChange read FOnADCChange write FOnADCChange; + property OnWebSettingsChange: TOnWebSettingsChange read FOnWebSettingsChange write FOnWebSettingsChange; end; implementation @@ -606,6 +628,7 @@ begin BuildRX1Tab; BuildTransmitTab; BuildPATab; + BuildAdvancedTab; BuildCATTab; BuildAlexTab; BuildXvtrTab; @@ -1561,6 +1584,23 @@ begin FEdBandCal[i].Tag := i; end; +end; + +procedure TSettingsForm.BuildAdvancedTab; +const + MARGIN = 22; + GRP_PAD = 18; + LBL_W = 110; + ED_W = 200; + BTN_H = 22; + ROW_H = 28; +var + Grp: TPanel; + Chk: TCheckBox; + Ed: TEdit; + Spin: TSpinEdit; + Y: Integer; +begin with TLabel.Create(Self) do begin Parent := FPageAdvanced; @@ -1572,14 +1612,144 @@ begin Font.Color := CLR_TEXT; end; - with TLabel.Create(Self) do - begin - Parent := FPageAdvanced; - Caption := 'Transmit, CAT and DSP-only settings will appear here when they are wired to runtime settings.'; - SetBounds(MARGIN, 48, 680, 20); - Font.Name := UI_FONT; - Font.Size := 9; - Font.Color := CLR_TEXTDIM; + // ── ADC ─────────────────────────────────────────────────────────────────── + Grp := MakeGroupPanel(FPageAdvanced, 'ADC', MARGIN, 62, 420, 82); + + Chk := TCheckBox.Create(Self); + Chk.Parent := Grp; + Chk.Caption := 'Dither Enabled'; + Chk.SetBounds(GRP_PAD, 24, 260, BTN_H); + Chk.Font.Name := UI_FONT; + Chk.Font.Size := 9; + Chk.Font.Color := CLR_TEXT; + Chk.Checked := True; + Chk.OnChange := OnADCChkChange; + FChkDither := Chk; + + Chk := TCheckBox.Create(Self); + Chk.Parent := Grp; + Chk.Caption := 'Random Enabled'; + Chk.SetBounds(GRP_PAD, 50, 260, BTN_H); + Chk.Font.Name := UI_FONT; + Chk.Font.Size := 9; + Chk.Font.Color := CLR_TEXT; + Chk.Checked := True; + Chk.OnChange := OnADCChkChange; + FChkRandom := Chk; + + // ── Web Server ──────────────────────────────────────────────────────────── + Grp := MakeGroupPanel(FPageAdvanced, 'Web Server', MARGIN, 160, 420, 196); + + Y := 24; + Chk := TCheckBox.Create(Self); + Chk.Parent := Grp; + Chk.Caption := 'Enabled'; + Chk.SetBounds(GRP_PAD, Y, 260, BTN_H); + Chk.Font.Name := UI_FONT; + Chk.Font.Size := 9; + Chk.Font.Color := CLR_TEXT; + Chk.Checked := True; + Chk.OnChange := OnWebAnyChange; + FChkWebEnabled := Chk; + + Y := Y + ROW_H + 4; + MakeLbl(Grp, 'Port:', GRP_PAD, Y + 4, LBL_W); + Spin := TSpinEdit.Create(Self); + Spin.Parent := Grp; + Spin.SetBounds(GRP_PAD + LBL_W, Y, 90, BTN_H + 2); + Spin.Color := CLR_INPUT; + Spin.Font.Color := CLR_INPUT_TEXT; + Spin.Font.Name := UI_FONT; + Spin.Font.Size := 9; + Spin.MinValue := 1; + Spin.MaxValue := 65535; + Spin.Value := 8080; + Spin.OnChange := OnWebAnyChange; + FEdWebPort := Spin; + + Y := Y + ROW_H; + MakeLbl(Grp, 'Interface:', GRP_PAD, Y + 4, LBL_W); + Ed := TEdit.Create(Self); + Ed.Parent := Grp; + Ed.SetBounds(GRP_PAD + LBL_W, Y, ED_W, BTN_H + 2); + Ed.Color := CLR_INPUT; + Ed.Font.Color := CLR_INPUT_TEXT; + Ed.Font.Name := UI_FONT; + Ed.Font.Size := 9; + Ed.Text := '0.0.0.0'; + Ed.OnChange := OnWebAnyChange; + FEdWebBind := Ed; + + Y := Y + ROW_H; + MakeLbl(Grp, 'Username:', GRP_PAD, Y + 4, LBL_W); + Ed := TEdit.Create(Self); + Ed.Parent := Grp; + Ed.SetBounds(GRP_PAD + LBL_W, Y, ED_W, BTN_H + 2); + Ed.Color := CLR_INPUT; + Ed.Font.Color := CLR_INPUT_TEXT; + Ed.Font.Name := UI_FONT; + Ed.Font.Size := 9; + Ed.Text := 'admin'; + Ed.OnChange := OnWebAnyChange; + FEdWebUser := Ed; + + Y := Y + ROW_H; + MakeLbl(Grp, 'Password:', GRP_PAD, Y + 4, LBL_W); + Ed := TEdit.Create(Self); + Ed.Parent := Grp; + Ed.SetBounds(GRP_PAD + LBL_W, Y, ED_W, BTN_H + 2); + Ed.Color := CLR_INPUT; + Ed.Font.Color := CLR_INPUT_TEXT; + Ed.Font.Name := UI_FONT; + Ed.Font.Size := 9; + Ed.PasswordChar := '*'; + Ed.Text := 'hpsdr'; + Ed.OnChange := OnWebAnyChange; + FEdWebPass := Ed; +end; + +procedure TSettingsForm.OnADCChkChange(Sender: TObject); +begin + if FLoading then Exit; + if Assigned(FOnADCChange) then + FOnADCChange(FChkDither.Checked, FChkRandom.Checked); +end; + +procedure TSettingsForm.OnWebAnyChange(Sender: TObject); +begin + if FLoading then Exit; + if Assigned(FOnWebSettingsChange) then + FOnWebSettingsChange( + FChkWebEnabled.Checked, + FEdWebPort.Value, + FEdWebBind.Text, + FEdWebUser.Text, + FEdWebPass.Text); +end; + +procedure TSettingsForm.LoadADCSettings(Dither, Random: Boolean); +begin + FLoading := True; + try + FChkDither.Checked := Dither; + FChkRandom.Checked := Random; + finally + FLoading := False; + end; +end; + +procedure TSettingsForm.LoadWebSettings(Enabled: Boolean; Port: Integer; + const BindAddr, User, Pass: string); +begin + FLoading := True; + try + FChkWebEnabled.Checked := Enabled; + FEdWebPort.Value := EnsureRange(Port, 1, 65535); + FEdWebBind.Text := BindAddr; + FEdWebUser.Text := User; + FEdWebPass.Text := Pass; + finally + FLoading := False; end; end; diff --git a/WDSPEngine.pas b/WDSPEngine.pas index 8b4ef40..dbaaf6e 100644 --- a/WDSPEngine.pas +++ b/WDSPEngine.pas @@ -360,6 +360,8 @@ type procedure SetNB(Enable: Boolean); procedure SetSNB(Enable: Boolean); procedure SetANF(Enable: Boolean); + procedure SetRXFMDeviation(Deviation: Double); + procedure SetFMSquelch(Enable: Boolean; Level: Integer); procedure SetVolume(Vol: Double); procedure SetMute(Mute: Boolean); @@ -1513,6 +1515,26 @@ begin ApplyANFState; end; +procedure TWDSPEngine.SetRXFMDeviation(Deviation: Double); +begin + if not FInitialized then Exit; + SetRXAFMDeviation(RXA_CHAN, Deviation); +end; + +procedure TWDSPEngine.SetFMSquelch(Enable: Boolean; Level: Integer); +var Threshold: Double; +begin + if not FInitialized then Exit; + if Enable then + begin + Threshold := Level / 200.0; // 0..100 → 0.0..0.5 + SetRXAFMSQThreshold(RXA_CHAN, Threshold); + SetRXAFMSQRun(RXA_CHAN, 1); + end + else + SetRXAFMSQRun(RXA_CHAN, 0); +end; + procedure TWDSPEngine.SetVolume(Vol: Double); begin FVolume := Max(0.0, Min(1.0, Vol)); diff --git a/WebServer.pas b/WebServer.pas index 5f9fe1b..8c0e2e4 100644 --- a/WebServer.pas +++ b/WebServer.pas @@ -181,6 +181,9 @@ type // ── Авторизация ── FAuthToken: string; // Base64(user:pass) + // ── Сетевая конфигурация ── + FPort: Word; + FBindIP: string; // ── Состояние (обновляется из MainForm) ── FSpectrumBuf: array[0..1023] of Single; @@ -272,11 +275,13 @@ type procedure ProcessWsFrame(Client: TWsClient; const Data: array of Byte; Len: Integer; Opcode: Byte); public - constructor Create(const Username, Password: string); + constructor Create(const Username, Password: string; + Port: Word = 8080; const BindIP: string = '0.0.0.0'); destructor Destroy; override; function Start: Boolean; procedure Stop; + procedure Reconfigure(const Username, Password, BindIP: string; Port: Word); // Вызывается из DSP-потока (аудио, 48kHz mono) procedure PushAudio(const Samples: PSingle; Count: Integer); @@ -396,7 +401,8 @@ end; TWebServer — конструктор / деструктор ═══════════════════════════════════════════════════════════════════════════ } -constructor TWebServer.Create(const Username, Password: string); +constructor TWebServer.Create(const Username, Password: string; + Port: Word; const BindIP: string); {$IFDEF WINDOWS} var WSAData: TWSAData; @@ -408,6 +414,8 @@ begin {$ENDIF} inherited Create; FAuthToken := Base64EncodeStr(Username + ':' + Password); + FPort := Port; + FBindIP := BindIP; FListenSock := SOCK_INVALID; FRunning := False; FClientCount := 0; @@ -531,6 +539,41 @@ end; Start / Stop ═══════════════════════════════════════════════════════════════════════════ } +function ParseIPv4(const S: string): LongWord; +// Парсит dotted-decimal '1.2.3.4', возвращает сетевой порядок байт. +// '0.0.0.0' и '' → INADDR_ANY (0). +var + P, Start: PChar; + Parts: array[0..3] of Byte; + Idx, V: Integer; +begin + Result := 0; + if (S = '') or (S = '0.0.0.0') then Exit; + Idx := 0; + P := PChar(S); + Start := P; + while True do + begin + if (P^ = '.') or (P^ = #0) then + begin + if Idx > 3 then Exit; + V := StrToIntDef(Copy(S, Start - PChar(S) + 1, P - Start), -1); + if (V < 0) or (V > 255) then Exit; + Parts[Idx] := Byte(V); + Inc(Idx); + if P^ = #0 then Break; + Inc(P); + Start := P; + end else + Inc(P); + end; + if Idx <> 4 then Exit; + // Сетевой порядок: старший байт первый + Result := (LongWord(Parts[0]) shl 24) or (LongWord(Parts[1]) shl 16) + or (LongWord(Parts[2]) shl 8) or LongWord(Parts[3]); + Result := htonl(Result); +end; + function TWebServer.InitListen: Boolean; var Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; @@ -549,16 +592,16 @@ begin setsockopt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One)); FillChar(Addr, SizeOf(Addr), 0); Addr.sin_family := AF_INET; - Addr.sin_port := htons(WEB_PORT); - Addr.sin_addr.S_addr := INADDR_ANY; + Addr.sin_port := htons(FPort); + Addr.sin_addr.S_addr := ParseIPv4(FBindIP); if bind(FListenSock, @Addr, SizeOf(Addr)) = SOCKET_ERROR then Exit; if listen(FListenSock, 5) = SOCKET_ERROR then Exit; {$ELSE} fpSetSockOpt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One)); FillChar(Addr, SizeOf(Addr), 0); Addr.sin_family := AF_INET; - Addr.sin_port := htons(WEB_PORT); - Addr.sin_addr.s_addr := htonl(INADDR_ANY); + Addr.sin_port := htons(FPort); + Addr.sin_addr.s_addr := ParseIPv4(FBindIP); if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then Exit; if fpListen(FListenSock, 5) <> 0 then Exit; {$ENDIF} @@ -628,6 +671,14 @@ begin UnloadOpus; end; +procedure TWebServer.Reconfigure(const Username, Password, BindIP: string; Port: Word); +begin + Stop; + FAuthToken := Base64EncodeStr(Username + ':' + Password); + FPort := Port; + FBindIP := BindIP; +end; + { ═══════════════════════════════════════════════════════════════════════════ Accept loop ═══════════════════════════════════════════════════════════════════════════ }