diff --git a/DXSpotStore.pas b/DXSpotStore.pas index 18577ca..90c4fa5 100644 --- a/DXSpotStore.pas +++ b/DXSpotStore.pas @@ -73,6 +73,8 @@ type // Добавить/обновить спот (вызывается из потока кластера). procedure Add(const S: TDXSpot); + // Убрать все споты позывного (SPOT_DELETE в TCI; регистр не важен). + procedure RemoveCall(const Call: string); procedure Clear; // Выбросить просроченное прямо сейчас. Нужен тому, кто следит за временем // снаружи: сам стор чистится только на Add и снимках, а когда споты никто @@ -364,6 +366,28 @@ begin end; end; +procedure TDXSpotStore.RemoveCall(const Call: string); +var i, j: Integer; Up: string; +begin + Up := UpperCase(Trim(Call)); + if Up = '' then Exit; + FLock.Enter; + try + i := 0; + while i < FCount do + if UpperCase(FSpots[i].Call) = Up then + begin + for j := i to FCount - 2 do FSpots[j] := FSpots[j + 1]; + Dec(FCount); + Inc(FVersion); + end + else + Inc(i); + finally + FLock.Leave; + end; +end; + function CompareSpotFreq(const A, B: TDXSpot): Integer; begin if A.FreqHz < B.FreqHz then Result := -1 diff --git a/MainForm.pas b/MainForm.pas index 6a2dc38..4876bad 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -35,6 +35,7 @@ uses Settings, WebServer, WebAdapter, CATAdapter, + TCIAdapter, SpectrumView, SpectrumViewOpengl, PanZoomBar, PanafallPanel, PanDisplayPopup, PureSignalPopup, FlatPopupMenu, WidebandView, @@ -246,6 +247,8 @@ type FWebSpecPixels: Integer; // потолок точек кадра спектра/водопада для web // --- CAT --- FCATAdapter: TCATAdapter; // адаптер CAT поверх контроллера (движок+транспорты+контекст) + FTCIAdapter: TTCIAdapter; // адаптер TCI (WebSocket-сервер Expert Electronics) + FTCICfg: TTCISettings; // текущие настройки TCI (UI/persist) FCATLastGlobal: TGlobalSettings; // текущие CAT-настройки (UI/persist; ApplySettings → адаптер) // Виджеты построены (конец FormCreate). До этого рендер состояния запрещён: // адаптеры (CAT/web), создаваемые по ходу FormCreate, могут дёрнуть @@ -835,6 +838,12 @@ type procedure ApplyADCSettings(Dither, Random: Boolean); procedure ApplyWebSettings(Enabled: Boolean; Port: Integer; const BindAddr, User, Pass: string; SpecPixels: Integer); + procedure ApplyTCISettings(Enabled: Boolean; Port: Integer; + const BindAddr: string); + // Фокус главного окна → APP_FOCUS клиентам TCI (логгеры так решают, кому + // отдавать клавиатуру). + procedure TCIFormActivate(Sender: TObject); + procedure TCIFormDeactivate(Sender: TObject); procedure ApplyGridParams(RefLevel, Range, GridStep: Double); // Пушит активные grid-параметры (RX или TX в зависимости от FTransmitting) // в FSpecView и сбрасывает кэш сетки. Вызывается при смене RX↔TX и при @@ -1447,6 +1456,7 @@ begin FreeAndNil(FWebAdapter); // адаптер не владеет сервером — освобождаем после Stop FWebServer.Free; FreeAndNil(FCATAdapter); // его Destroy останавливает+освобождает CAT движок/транспорты + FreeAndNil(FTCIAdapter); // Destroy останавливает TCI-сервер и его потоки // Ядро освобождаем последним — его Destroy закрывает и освобождает движки // (FreeEngines) и FSettings. FreeAndNil(FController); @@ -2705,6 +2715,14 @@ begin // DX-кластер: база спотов + сетевой поток + оверлей подписей. InitDXCluster; + // TCI-сервер — равноправный фронтенд рядом с CAT и web. Создаём после + // InitDXCluster: споты от TCI-клиентов кладутся в тот же стор. + FController.FSettings.LoadTCISettings(FTCICfg); + FTCIAdapter := TTCIAdapter.Create(FController, FDXStore); + FTCIAdapter.ApplySettings(FTCICfg); + OnActivate := TCIFormActivate; + OnDeactivate := TCIFormDeactivate; + // S-метр — внутри PanelToolbar, справа PanelSMeterRight := TPanel.Create(Self); PanelSMeterRight.Parent := PanelToolbar; @@ -5633,6 +5651,9 @@ begin FDXSpotOverlay.SpotAtPixel(X, Y, DXSpot) then begin OnDXTuneSpot(DXSpot.FreqHz, DXSpot.Mode); + // Клик по споту — уведомление TCI-клиентам (логгер открывает QSO-карточку). + if FTCIAdapter <> nil then + FTCIAdapter.NotifySpotClicked(DXSpot.Call, DXSpot.FreqHz, 0, FController.FActiveVfo); Exit; end; @@ -6548,6 +6569,26 @@ begin FController.FSettings.SaveWebSettings(W); end; +procedure TMainForm.ApplyTCISettings(Enabled: Boolean; Port: Integer; + const BindAddr: string); +begin + FTCICfg.Enabled := Enabled; + FTCICfg.Port := Port; + FTCICfg.BindAddr := BindAddr; + FController.FSettings.SaveTCISettings(FTCICfg); + if FTCIAdapter <> nil then FTCIAdapter.ApplySettings(FTCICfg); +end; + +procedure TMainForm.TCIFormActivate(Sender: TObject); +begin + if FTCIAdapter <> nil then FTCIAdapter.NotifyAppFocus(True); +end; + +procedure TMainForm.TCIFormDeactivate(Sender: TObject); +begin + if FTCIAdapter <> nil then FTCIAdapter.NotifyAppFocus(False); +end; + procedure TMainForm.OnSampleRateHidePanel; begin FPanelHidden := not FPanelHidden; @@ -7937,6 +7978,8 @@ begin P.DXOverlay.SpotAtPixel(X, Y, DXSpot) then begin DXTuneSpotOnPan(P, DXSpot.FreqHz, DXSpot.Mode); + if FTCIAdapter <> nil then + FTCIAdapter.NotifySpotClicked(DXSpot.Call, DXSpot.FreqHz, P.PanId, 0); Exit; end; W := TControl(Sender).Width; @@ -9634,6 +9677,7 @@ begin SF.OnWfAGCNFChange := ApplyWfAGCNF; SF.OnADCChange := ApplyADCSettings; SF.OnWebSettingsChange := ApplyWebSettings; + SF.OnTCISettingsChange := ApplyTCISettings; SF.OnDXClusterChange := OnDXClusterSettingsChange; end; SF := TSettingsForm(FSettingsForm); @@ -9689,6 +9733,7 @@ begin SF.LoadADCSettings(FController.FDitherEnabled, FController.FRandomEnabled); SF.LoadWebSettings(FWebEnabled, FWebPort, FWebBindAddr, FWebUser, FWebPass, FWebSpecPixels); + SF.LoadTCISettings(FTCICfg.Enabled, FTCICfg.Port, FTCICfg.BindAddr); SF.LoadDXClusterSettings(FDXCfg); SF.LoadFPS(FDisplayFPS); SF.LoadLightTheme(FLightTheme); diff --git a/RadioController.pas b/RadioController.pas index aa84084..2232bc1 100644 --- a/RadioController.pas +++ b/RadioController.pas @@ -1185,6 +1185,9 @@ type // Доп. наблюдатели состояния (помимо единственного OnStateChanged, который // занимает MainForm). Нужны CAT/Andromeda для push индикаторов панели. procedure AddStateListener(L: TRadioStateEvent); + // Снять наблюдателя. Обязателен для тех, кто умирает раньше контроллера + // (TCI-адаптер): иначе Changed() позовёт метод освобождённого объекта. + procedure RemoveStateListener(L: TRadioStateEvent); // Пост-тюн хук: вызывается в КОНЦЕ SetVfoA (после Changed(rfVfoA), т.е. вне // рендера) — сюда вешается канальная оркестрация (ChannelController.OnVfoTuned), // чтобы любой путь тюнинга (desktop/web/CAT/энкодер) был канал-aware headless. @@ -1447,6 +1450,21 @@ begin FStateListeners[High(FStateListeners)] := L; end; +procedure TRadioController.RemoveStateListener(L: TRadioStateEvent); +var i, j: Integer; +begin + if not Assigned(L) then Exit; + for i := 0 to High(FStateListeners) do + if (TMethod(FStateListeners[i]).Code = TMethod(L).Code) and + (TMethod(FStateListeners[i]).Data = TMethod(L).Data) then + begin + for j := i to High(FStateListeners) - 1 do + FStateListeners[j] := FStateListeners[j + 1]; + SetLength(FStateListeners, Length(FStateListeners) - 1); + Exit; + end; +end; + procedure TRadioController.PushNetworkState; // Полный HP-кадр в радио: RX/TX частоты (через трансвертор), drive, состояние // MOX. Вызывается командами, которые меняют центр/частоту/репитер-сдвиг. diff --git a/Settings.pas b/Settings.pas index bee3176..9709784 100644 --- a/Settings.pas +++ b/Settings.pas @@ -459,6 +459,15 @@ type SpecPixels: Integer; end; + // TCI-сервер (протокол Expert Electronics поверх WebSocket). Авторизации в + // протоколе нет, поэтому умолчание слушает только петлю: логгеры и цифровые + // программы обычно живут на том же ПК, а наружу порт открывается осознанно. + TTCISettings = record + Enabled: Boolean; + Port: Integer; // 1..65535, умолчание 40001 (как у ExpertSDR3) + BindAddr: string; // '127.0.0.1' или '0.0.0.0' + end; + // Transverter (XVTR) entry — один трансвертер. // Видимая частота VFO в [FreqBegin..FreqEnd] транслируется в IF-частоту, // которую слышит трансивер: f_IF = f_visible - LOOffset + LOError. @@ -779,6 +788,10 @@ type class procedure DefaultWeb(out W: TWebSettings); procedure LoadWebSettings(out W: TWebSettings); procedure SaveWebSettings(const W: TWebSettings); + // TCI-сервер — глобальные настройки (секция "tci" в корне JSON). + class procedure DefaultTCI(out T: TTCISettings); + procedure LoadTCISettings(out T: TTCISettings); + procedure SaveTCISettings(const T: TTCISettings); // Тема — глобальная настройка, не привязана к устройству procedure SaveTheme(ALightTheme: Boolean); function LoadTheme: Boolean; @@ -2981,6 +2994,34 @@ begin Save; end; +class procedure TSettingsManager.DefaultTCI(out T: TTCISettings); +begin + T.Enabled := False; // включается осознанно, как CAT-транспорты + T.Port := 40001; + T.BindAddr := '127.0.0.1'; +end; + +procedure TSettingsManager.LoadTCISettings(out T: TTCISettings); +var O: TJSONObject; +begin + DefaultTCI(T); + if FRoot.Find('tci') = nil then Exit; + O := EnsureObj(FRoot, 'tci'); + T.Enabled := JB(O, 'enabled', False); + T.Port := EnsureRange(JI(O, 'port', 40001), 1, 65535); + T.BindAddr := JS(O, 'bind_addr', '127.0.0.1'); +end; + +procedure TSettingsManager.SaveTCISettings(const T: TTCISettings); +var O: TJSONObject; +begin + O := EnsureObj(FRoot, 'tci'); + JW(O, 'enabled', T.Enabled); + JW(O, 'port', T.Port); + JWS(O, 'bind_addr', T.BindAddr); + Save; +end; + procedure TSettingsManager.SaveTheme(ALightTheme: Boolean); var O: TJSONObject; begin diff --git a/SettingsForm.pas b/SettingsForm.pas index a1870f6..5b4fed7 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -92,6 +92,8 @@ type TOnWebSettingsChange = procedure(Enabled: Boolean; Port: Integer; const BindAddr, User, Pass: string; SpecPixels: Integer) of object; + TOnTCISettingsChange = procedure(Enabled: Boolean; Port: Integer; + const BindAddr: string) of object; TOnCATChange = procedure( const SerEnabled: array of Boolean; const SerPort: array of string; @@ -470,6 +472,9 @@ type FEdWebUser: TFlatEdit; FEdWebPass: TFlatEdit; FCmbWebRes: TFlatComboBox; + FChkTCIEnabled: TFlatCheckBox; + FEdTCIPort: TFlatSpinEdit; + FEdTCIBind: TFlatEdit; // ---- Close button ---- FBtnClose: TFlatButton; @@ -483,6 +488,7 @@ type FOnVHFCalChange: TOnVHFCalChange; FOnADCChange: TOnADCChange; FOnWebSettingsChange: TOnWebSettingsChange; + FOnTCISettingsChange: TOnTCISettingsChange; FOnDXClusterChange: TOnDXClusterChange; FOnDisplayChange: TOnDisplayParamChange; FOnWaterfallChange: TOnWaterfallParamChange; @@ -535,6 +541,7 @@ type procedure BuildAdvancedTab; procedure OnADCChkChange(Sender: TObject); procedure OnWebAnyChange(Sender: TObject); + procedure OnTCIAnyChange(Sender: TObject); procedure CollectAlexFromUI; procedure FireAlexChange; procedure OnAlexAnyChange(Sender: TObject); @@ -720,6 +727,8 @@ type procedure LoadDXClusterSettings(const D: TDXClusterSettings); procedure LoadWebSettings(Enabled: Boolean; Port: Integer; const BindAddr, User, Pass: string; SpecPixels: Integer); + procedure LoadTCISettings(Enabled: Boolean; Port: Integer; + const BindAddr: string); property OnCATChange: TOnCATChange read FOnCATChange write FOnCATChange; property OnSliceCATChange: TOnSliceCATChange read FOnSliceCATChange write FOnSliceCATChange; @@ -756,6 +765,7 @@ type property OnWfAGCNFChange: TOnWfAGCNFChange read FOnWfAGCNFChange write FOnWfAGCNFChange; property OnADCChange: TOnADCChange read FOnADCChange write FOnADCChange; property OnWebSettingsChange: TOnWebSettingsChange read FOnWebSettingsChange write FOnWebSettingsChange; + property OnTCISettingsChange: TOnTCISettingsChange read FOnTCISettingsChange write FOnTCISettingsChange; property OnDXClusterChange: TOnDXClusterChange read FOnDXClusterChange write FOnDXClusterChange; end; @@ -3441,6 +3451,52 @@ begin Lbl := MakeLbl(Grp, '1024 px ~160 KB/s, 4096 px ~650 KB/s per client', GRP_PAD + LBL_W + 12, Y + ROW_H - 8, 320); Lbl.Font.Size := 8; + + // ── TCI Server ──────────────────────────────────────────────────────────── + // Протокол Expert Electronics поверх WebSocket: логгеры, скиммеры, цифра. + Grp := MakeGroupPanel(FPageAdvanced, 'TCI Server', MARGIN, 564, SETTINGS_CARD_W, 190); + + Y := R1; + Chk := TFlatCheckBox.Create(Self); + Chk.Parent := Grp; + Chk.Caption := 'Enabled'; + Chk.SetBounds(DpiScale(GRP_PAD), DpiScale(Y), DpiScale(260), DpiScale(22)); + Chk.Font.Size := 9; + Chk.Font.Color := CLR_TEXT; + Chk.Checked := False; + Chk.OnChange := OnTCIAnyChange; + FChkTCIEnabled := Chk; + + Y := Y + ROW_H; + MakeLbl(Grp, 'Port:', GRP_PAD, Y + 4, LBL_W); + Spin := TFlatSpinEdit.Create(Self); + Spin.Parent := Grp; + Spin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(90), DpiScale(BTN_H)); + Spin.Color := CLR_INPUT; + Spin.Font.Color := CLR_INPUT_TEXT; + Spin.Font.Size := 9; + Spin.MinValue := 1; + Spin.MaxValue := 65535; + Spin.Value := 40001; + Spin.OnChange := OnTCIAnyChange; + FEdTCIPort := Spin; + + Y := Y + ROW_H; + MakeLbl(Grp, 'Interface:', GRP_PAD, Y + 4, LBL_W); + Ed := TFlatEdit.Create(Self); + Ed.Parent := Grp; + Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(ED_W), DpiScale(BTN_H)); + Ed.Color := CLR_INPUT; + Ed.Font.Color := CLR_INPUT_TEXT; + Ed.Font.Size := 9; + Ed.Text := '127.0.0.1'; + Ed.OnChange := OnTCIAnyChange; + FEdTCIBind := Ed; + + // Авторизации в протоколе нет: открытый наружу порт = полный доступ к трансиверу. + Lbl := MakeLbl(Grp, 'No authentication in TCI — keep 127.0.0.1 unless the network is trusted', + GRP_PAD, Y + ROW_H, 460); + Lbl.Font.Size := 8; end; procedure TSettingsForm.BuildDXClusterTab; @@ -3689,6 +3745,26 @@ begin Res); end; +procedure TSettingsForm.OnTCIAnyChange(Sender: TObject); +begin + if FLoading then Exit; + if not Assigned(FOnTCISettingsChange) then Exit; + FOnTCISettingsChange(FChkTCIEnabled.Checked, FEdTCIPort.Value, FEdTCIBind.Text); +end; + +procedure TSettingsForm.LoadTCISettings(Enabled: Boolean; Port: Integer; + const BindAddr: string); +begin + FLoading := True; + try + FChkTCIEnabled.Checked := Enabled; + FEdTCIPort.Value := EnsureRange(Port, 1, 65535); + FEdTCIBind.Text := BindAddr; + finally + FLoading := False; + end; +end; + procedure TSettingsForm.LoadADCSettings(Dither, Random: Boolean); begin FLoading := True; diff --git a/TCIAdapter.pas b/TCIAdapter.pas new file mode 100644 index 0000000..1575f32 --- /dev/null +++ b/TCIAdapter.pas @@ -0,0 +1,1716 @@ +unit TCIAdapter; + +{ + TCIAdapter.pas — мост TCI ↔ TRadioController. + + Роль та же, что у TCATAdapter в CAT-подсистеме: равноправный клиент + контроллера, никаких обращений к MainForm. + + TCI-клиенты ──WS──► TTCIServer ──► TTCIAdapter ──► TRadioController + логгер/скиммер транспорт команды/ ядро + уведомления + + Потоки: + • Геттеры читают поля контроллера напрямую из потока клиента (атомарное + чтение, как в CAT). + • Сеттеры пишут параметр в scratch-поля под FLock и зовут + FController.Invoke(SyncXxx) — исполнение в потоке контроллера. + • Уведомления наружу идут из OnState (поток контроллера) рассылкой всем + клиентам: сервер TCI обязан синхронизировать всех подключённых (§3.5). + + Маппинг модели (выбран при проектировании, см. doc/TCI.md): + приёмник TCI = панадаптер ewsdr (0 = главный тракт, 1.. = доп. DDC-паны) + канал A/B = VFO A/B у приёмника 0; у панов 1.. — первый и второй слайс + + Чего в ewsdr нет (RIT/XIT, BIN/ANC/APF/DSE/NF, параметры NB, смещения + DIGL/DIGU): значения принимаются, хранятся здесь и отражаются клиентам — + так синхронизация между несколькими клиентами остаётся честной, а поведение + радио не выдумывается. Всё такое помечено «эхо» и перечислено в doc/TCI.md. + + Потоки IQ/аудио (§3.4) — следующий этап: команды управления потоками + принимаются и подтверждаются, но сами потоки не идут. +} + +{$IFDEF FPC} + {$MODE Delphi} + {$LONGSTRINGS ON} +{$ENDIF} + +interface + +uses + Classes, SysUtils, Math, SyncObjs, + RadioController, RadioBackend, WDSPEngine, Settings, + DXSpotStore, TCIProtocol, TCIServer; + +const + TCI_MAX_RX = MAX_PANS; // приёмник TCI = панадаптер + +type + { Параметры TCI, которым в ewsdr нет соответствия: храним и отражаем. } + TTCIRxEcho = record + RitOn, XitOn: Boolean; + RitHz, XitHz: Integer; + BinOn, ANCOn: Boolean; + APFOn, DSEOn: Boolean; + NFOn: Boolean; + NBThreshold: Integer; // 1..100 + NBDuration: Integer; // 1..300 + ChannelBOn: Boolean; + BalanceDb: array[0..TCI_CHANNELS-1] of Integer; + end; + + TTCIAdapter = class + private + FController: TRadioController; + FSpots: TDXSpotStore; // может быть nil (демон/тесты) + FServer: TTCIServer; + FLock: TCriticalSection; + + // ── Эхо-состояние ── + FEcho: array[0..TCI_MAX_RX-1] of TTCIRxEcho; + FDiglOffset: Integer; + FDiguOffset: Integer; + FIQRate: Integer; + FAudioRate: Integer; + FAudioSamples: Integer; + FAudioChannels: Integer; + FAudioSampleType: string; + FTxBuffering: Integer; + FCwTerminal: Boolean; + + // ── Кэш для подавления повторов в уведомлениях ── + FLastTxFreq: Double; + FLastTxEnable: Boolean; + + // ── scratch для маршалинга в поток контроллера ── + FsFreq: Double; + FsInt: Integer; + FsInt2: Integer; + FsInt3: Integer; + FsBool: Boolean; + FsStr: string; + + // ── Sync-методы (поток контроллера) ── + procedure SyncSetVfo; + procedure SyncSetCenter; + procedure SyncSetMode; + procedure SyncSetFilter; + procedure SyncSetTRX; + procedure SyncSetTune; + procedure SyncSetDrive; + procedure SyncSetTuneDrive; + procedure SyncSetSplit; + procedure SyncSetVolume; + procedure SyncSetMute; + procedure SyncSetRxMute; + procedure SyncSetRxVolume; + procedure SyncSetMonVolume; + procedure SyncSetMonEnable; + procedure SyncSetAGCMode; + procedure SyncSetAGCTop; + procedure SyncSetNR; + procedure SyncSetNB; + procedure SyncSetANF; + procedure SyncSetLock; + procedure SyncSetSql; + procedure SyncSetSqlLevel; + procedure SyncSetRun; + procedure SyncSetCWSpeed; + procedure SyncSetCWDelay; + procedure SyncCWSend; + procedure SyncCWStop; + + // ── Помощники модели ── + function RxCount: Integer; + function ValidRx(Rx: Integer): Boolean; + function SliceIdOf(Rx, Ch: Integer): Integer; + function ChanFreq(Rx, Ch: Integer): Double; + function ChanCount(Rx: Integer): Integer; + function RxCenterHz(Rx: Integer): Double; + function RxMode(Rx: Integer): Integer; + procedure RxFilter(Rx: Integer; out Lo, Hi: Integer); + function RxMuted(Rx: Integer): Boolean; + function RxVolumeDb(Rx: Integer): Double; + function RxAGCUi(Rx: Integer): Integer; + function RxSMeterDbm(Rx, Ch: Integer): Double; + function TxEnabled: Boolean; + + // ── Формирование строк состояния ── + function StrVfo(Rx, Ch: Integer): string; + function StrIf(Rx, Ch: Integer): string; + function StrDds(Rx: Integer): string; + function StrModulation(Rx: Integer): string; + function StrFilterBand(Rx: Integer): string; + function StrTrx: string; + function StrTune: string; + function StrDrive: string; + function StrVolume: string; + function StrMute: string; + function StrAGCMode(Rx: Integer): string; + function StrAGCGain(Rx: Integer): string; + function StrLock(Rx: Integer): string; + function StrSqlEnable(Rx: Integer): string; + function StrSqlLevel(Rx: Integer): string; + function StrTxEnable(Rx: Integer): string; + + procedure SendInit(Client: TTCIClient); + procedure SendState(Client: TTCIClient); + procedure Reply(Client: TTCIClient; const S: string); + + // ── События сервера/контроллера ── + procedure HandleCommand(Client: TTCIClient; const Cmd: string); + procedure DispatchCommand(Client: TTCIClient; const M: TTCIMessage); + procedure HandleConnect(Client: TTCIClient); + procedure HandleTick; + procedure PushSensors(Client: TTCIClient); + procedure OnState(Sender: TObject; Field: TRadioField); + + // ── Отдельные команды (чтобы HandleCommand не превратился в простыню) ── + procedure CmdFreq(Client: TTCIClient; const M: TTCIMessage; IsIF: Boolean); + procedure CmdCWMacros(const M: TTCIMessage; IsMsg: Boolean); + procedure CmdSpot(const M: TTCIMessage); + public + constructor Create(AController: TRadioController; ASpots: TDXSpotStore = nil); + destructor Destroy; override; + + { Настройки TCI: включение/порт/адрес. Зовётся при старте и из настроек. } + procedure ApplySettings(const T: TTCISettings); + + function Active: Boolean; + function ClientCount: Integer; + + { Уведомление о клике по споту на панораме (§4.4) — зовёт UI. } + procedure NotifySpotClicked(const Call: string; FreqHz: Double; + Rx: Integer = 0; Ch: Integer = 0); + { Статус фокуса главного окна (APP_FOCUS) — зовёт UI. } + procedure NotifyAppFocus(InFocus: Boolean); + + property Server: TTCIServer read FServer; + end; + +implementation + +{ ═══════════════════════════════════════════════════════════════════════════ + Жизненный цикл + ═══════════════════════════════════════════════════════════════════════════ } + +constructor TTCIAdapter.Create(AController: TRadioController; ASpots: TDXSpotStore); +var i, c: Integer; +begin + inherited Create; + FController := AController; + FSpots := ASpots; + FLock := TCriticalSection.Create; + + for i := 0 to TCI_MAX_RX - 1 do + begin + FillChar(FEcho[i], SizeOf(FEcho[i]), 0); + FEcho[i].NBThreshold := 50; + FEcho[i].NBDuration := 25; + for c := 0 to TCI_CHANNELS - 1 do FEcho[i].BalanceDb[c] := 0; + end; + FIQRate := 48000; + FAudioRate := 48000; + FAudioSamples := 2048; + FAudioChannels := 2; + FAudioSampleType := 'float32'; + FTxBuffering := 50; + FLastTxFreq := 0; + FLastTxEnable := True; + + FServer := TTCIServer.Create; + FServer.OnCommand := HandleCommand; + FServer.OnConnect := HandleConnect; + FServer.OnTick := HandleTick; + + // Многоадресная подписка: OnStateChanged занят MainForm. + FController.AddStateListener(OnState); +end; + +destructor TTCIAdapter.Destroy; +begin + // Сначала отписка: контроллер живёт дольше адаптера, и Changed() после + // нашей смерти позвал бы метод освобождённого объекта. + if FController <> nil then FController.RemoveStateListener(OnState); + if FServer <> nil then + begin + FServer.Stop; + FreeAndNil(FServer); + end; + FLock.Free; + inherited; +end; + +procedure TTCIAdapter.ApplySettings(const T: TTCISettings); +begin + FServer.Stop; + if not T.Enabled then Exit; + FServer.Configure(Word(EnsureRange(T.Port, 1, 65535)), T.BindAddr); + FServer.Start; +end; + +function TTCIAdapter.Active: Boolean; +begin + Result := (FServer <> nil) and FServer.Running; +end; + +function TTCIAdapter.ClientCount: Integer; +begin + if FServer = nil then Result := 0 else Result := FServer.ClientCount; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Модель: приёмник = панадаптер, канал = VFO A/B (пан 0) или слайс (паны 1..) + ═══════════════════════════════════════════════════════════════════════════ } + +function TTCIAdapter.RxCount: Integer; +begin + Result := FController.BackendCaps.MaxPans; + if Result < 1 then Result := 1; + if Result > TCI_MAX_RX then Result := TCI_MAX_RX; +end; + +function TTCIAdapter.ValidRx(Rx: Integer): Boolean; +begin + Result := (Rx >= 0) and (Rx < RxCount); +end; + +function TTCIAdapter.SliceIdOf(Rx, Ch: Integer): Integer; +// Слайсы пана Rx по порядку в таблице: 0-й = канал A, 1-й = канал B. +var i, Seen: Integer; +begin + Result := 0; + if Rx <= 0 then Exit; + Seen := 0; + for i := 0 to MAX_SLICES - 1 do + if FController.FSlices[i].Active and (FController.FSlices[i].PanId = Rx) then + begin + if Seen = Ch then + begin + Result := FController.FSlices[i].Id; + Exit; + end; + Inc(Seen); + end; +end; + +function TTCIAdapter.ChanCount(Rx: Integer): Integer; +var i: Integer; +begin + if Rx = 0 then begin Result := 2; Exit; end; // VFO A/B всегда есть + Result := 0; + for i := 0 to MAX_SLICES - 1 do + if FController.FSlices[i].Active and (FController.FSlices[i].PanId = Rx) then + Inc(Result); + if Result > TCI_CHANNELS then Result := TCI_CHANNELS; +end; + +function TTCIAdapter.ChanFreq(Rx, Ch: Integer): Double; +var S: TCtrlSlice; Id: Integer; +begin + Result := 0; + if Rx = 0 then + begin + if Ch = 1 then Result := FController.FVfoB else Result := FController.FVfoA; + Exit; + end; + Id := SliceIdOf(Rx, Ch); + if (Id > 0) and FController.GetSlice(Id, S) then Result := S.TargetHz; +end; + +function TTCIAdapter.RxCenterHz(Rx: Integer): Double; +begin + if Rx = 0 then Result := FController.FCenterFreq + else Result := FController.PanDDCFreq(Rx); +end; + +function TTCIAdapter.RxMode(Rx: Integer): Integer; +var S: TCtrlSlice; Id: Integer; +begin + if Rx = 0 then begin Result := FController.FMode; Exit; end; + Result := FController.FMode; + Id := SliceIdOf(Rx, 0); + if (Id > 0) and FController.GetSlice(Id, S) then Result := S.Mode; +end; + +procedure TTCIAdapter.RxFilter(Rx: Integer; out Lo, Hi: Integer); +var S: TCtrlSlice; Id: Integer; +begin + Lo := FController.FilterLo; + Hi := FController.FilterHi; + if Rx = 0 then Exit; + Id := SliceIdOf(Rx, 0); + if (Id > 0) and FController.GetSlice(Id, S) then + begin + Lo := S.FilterLo; + Hi := S.FilterHi; + end; +end; + +function TTCIAdapter.RxMuted(Rx: Integer): Boolean; +var S: TCtrlSlice; Id: Integer; +begin + if Rx = 0 then begin Result := FController.FMuted; Exit; end; + Result := False; + Id := SliceIdOf(Rx, 0); + if (Id > 0) and FController.GetSlice(Id, S) then Result := S.Muted; +end; + +function TTCIAdapter.RxVolumeDb(Rx: Integer): Double; +var S: TCtrlSlice; Id: Integer; +begin + if Rx = 0 then begin Result := TCIVolumeToDb(FController.FVolume); Exit; end; + Result := 0; + Id := SliceIdOf(Rx, 0); + if (Id > 0) and FController.GetSlice(Id, S) then + Result := TCIVolumeToDb(Round(S.Volume * 100)); +end; + +function TTCIAdapter.RxAGCUi(Rx: Integer): Integer; +var S: TCtrlSlice; Id: Integer; +begin + if Rx = 0 then begin Result := FController.FAGCMode; Exit; end; + Result := FController.FAGCMode; + Id := SliceIdOf(Rx, 0); + if (Id > 0) and FController.GetSlice(Id, S) then + Result := TRadioController.AGCModeToUI(S.AGC); +end; + +function TTCIAdapter.RxSMeterDbm(Rx, Ch: Integer): Double; +var Id: Integer; +begin + if Rx = 0 then + begin + Result := FController.ReadSMeterDBm; + Exit; + end; + Result := -140; + Id := SliceIdOf(Rx, Ch); + if Id > 0 then Result := FController.SliceSMeter(Id); +end; + +function TTCIAdapter.TxEnabled: Boolean; +begin + Result := FController.BackendCaps.HasTX and (not FController.TXProhibited); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Формирование строк состояния + ═══════════════════════════════════════════════════════════════════════════ } + +function TTCIAdapter.StrVfo(Rx, Ch: Integer): string; +begin + Result := TCIBuild('vfo', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIIntStr(Round(ChanFreq(Rx, Ch)))]); +end; + +function TTCIAdapter.StrIf(Rx, Ch: Integer): string; +begin + Result := TCIBuild('if', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIIntStr(Round(ChanFreq(Rx, Ch) - RxCenterHz(Rx)))]); +end; + +function TTCIAdapter.StrDds(Rx: Integer): string; +begin + Result := TCIBuild('dds', [TCIIntStr(Rx), TCIIntStr(Round(RxCenterHz(Rx)))]); +end; + +function TTCIAdapter.StrModulation(Rx: Integer): string; +begin + Result := TCIBuild('modulation', [TCIIntStr(Rx), TCIModeName(RxMode(Rx))]); +end; + +function TTCIAdapter.StrFilterBand(Rx: Integer): string; +var Lo, Hi: Integer; +begin + RxFilter(Rx, Lo, Hi); + Result := TCIBuild('rx_filter_band', [TCIIntStr(Rx), TCIIntStr(Lo), TCIIntStr(Hi)]); +end; + +function TTCIAdapter.StrTrx: string; +begin + Result := TCIBuild('trx', ['0', TCIBoolStr(FController.FTransmitting)]); +end; + +function TTCIAdapter.StrTune: string; +begin + Result := TCIBuild('tune', ['0', TCIBoolStr(FController.FTuning)]); +end; + +function TTCIAdapter.StrDrive: string; +begin + Result := TCIBuild('drive', ['0', TCIIntStr(FController.FDrivePercent)]); +end; + +function TTCIAdapter.StrVolume: string; +begin + Result := TCIBuild('volume', [TCIIntStr(Round(TCIVolumeToDb(FController.FVolume)))]); +end; + +function TTCIAdapter.StrMute: string; +begin + Result := TCIBuild('mute', [TCIBoolStr(FController.FMuted)]); +end; + +function TTCIAdapter.StrAGCMode(Rx: Integer): string; +var Ui: Integer; Name: string; +begin + Ui := RxAGCUi(Rx); + // UI: 0=Fast 1=Medium 2=Slow 3=Long 4=Off; TCI знает normal/fast/off. + if Ui = 4 then Name := 'off' + else if Ui = 0 then Name := 'fast' + else Name := 'normal'; + Result := TCIBuild('agc_mode', [TCIIntStr(Rx), Name]); +end; + +function TTCIAdapter.StrAGCGain(Rx: Integer): string; +begin + Result := TCIBuild('agc_gain', [TCIIntStr(Rx), TCIIntStr(FController.FAGCTop)]); +end; + +function TTCIAdapter.StrLock(Rx: Integer): string; +begin + Result := TCIBuild('lock', [TCIIntStr(Rx), TCIBoolStr(FController.FVfoLock)]); +end; + +function TTCIAdapter.StrSqlEnable(Rx: Integer): string; +begin + Result := TCIBuild('sql_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FFMSQOn)]); +end; + +function TTCIAdapter.StrSqlLevel(Rx: Integer): string; +begin + Result := TCIBuild('sql_level', [TCIIntStr(Rx), + TCIIntStr(Round(TCILevelToSql(FController.FFMSQLevel)))]); +end; + +function TTCIAdapter.StrTxEnable(Rx: Integer): string; +begin + Result := TCIBuild('tx_enable', [TCIIntStr(Rx), TCIBoolStr(TxEnabled)]); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Подключение клиента: инициализация + текущее состояние + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIAdapter.Reply(Client: TTCIClient; const S: string); +begin + if (Client <> nil) and (S <> '') then Client.Send(S); +end; + +procedure TTCIAdapter.SendInit(Client: TTCIClient); +var + Caps: TBackendCaps; + LoHz, HiHz: Double; + Half: Integer; + DevName: string; +begin + Caps := FController.BackendCaps; + + LoHz := Caps.MinFreqHz; + HiHz := Caps.MaxFreqHz; + if HiHz <= LoHz then begin LoHz := 10000; HiHz := 30000000; end; // не подключены + + Half := FController.FSampleRate div 2; + if Half <= 0 then Half := 48000; + + DevName := FController.BoardDisplayName; + if Trim(DevName) = '' then DevName := TCI_APP_NAME; + + Reply(Client, TCIBuild('protocol', [TCI_APP_NAME, TCI_VERSION])); + Reply(Client, TCIBuild('device', [DevName])); + Reply(Client, TCIBuild('receive_only', [TCIBoolStr(not Caps.HasTX)])); + Reply(Client, TCIBuild('trx_count', [TCIIntStr(RxCount)])); + Reply(Client, TCIBuild('channel_count', [TCIIntStr(TCI_CHANNELS)])); + Reply(Client, TCIBuild('vfo_limits', [TCIIntStr(Round(LoHz)), TCIIntStr(Round(HiHz))])); + Reply(Client, TCIBuild('if_limits', [TCIIntStr(-Half), TCIIntStr(Half)])); + Reply(Client, TCIBuild('modulations_list', [TCI_MODULATIONS])); +end; + +procedure TTCIAdapter.SendState(Client: TTCIClient); +var + Rx, Ch: Integer; +begin + for Rx := 0 to RxCount - 1 do + begin + Reply(Client, StrDds(Rx)); + for Ch := 0 to TCI_CHANNELS - 1 do + begin + Reply(Client, StrVfo(Rx, Ch)); + Reply(Client, StrIf(Rx, Ch)); + Reply(Client, TCIBuild('rx_volume', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIIntStr(Round(RxVolumeDb(Rx)))])); + Reply(Client, TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIIntStr(FEcho[Rx].BalanceDb[Ch])])); + end; + Reply(Client, TCIBuild('rx_channel_enable', + [TCIIntStr(Rx), '1', TCIBoolStr((Rx = 0) or (ChanCount(Rx) > 1))])); + Reply(Client, StrModulation(Rx)); + Reply(Client, StrFilterBand(Rx)); + Reply(Client, StrAGCMode(Rx)); + Reply(Client, StrAGCGain(Rx)); + Reply(Client, TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))])); + Reply(Client, TCIBuild('rx_nb_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNBMode > 0)])); + Reply(Client, TCIBuild('rx_nb_param', [TCIIntStr(Rx), + TCIIntStr(FEcho[Rx].NBThreshold), TCIIntStr(FEcho[Rx].NBDuration)])); + Reply(Client, TCIBuild('rx_nr_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNRMode > 0)])); + Reply(Client, TCIBuild('rx_anf_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FANF)])); + Reply(Client, TCIBuild('rx_bin_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].BinOn)])); + Reply(Client, TCIBuild('rx_anc_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].ANCOn)])); + Reply(Client, TCIBuild('rx_apf_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].APFOn)])); + Reply(Client, TCIBuild('rx_dse_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].DSEOn)])); + Reply(Client, TCIBuild('rx_nf_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].NFOn)])); + Reply(Client, StrLock(Rx)); + Reply(Client, StrSqlEnable(Rx)); + Reply(Client, StrSqlLevel(Rx)); + Reply(Client, TCIBuild('rit_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].RitOn)])); + Reply(Client, TCIBuild('rit_offset', [TCIIntStr(Rx), TCIIntStr(FEcho[Rx].RitHz)])); + Reply(Client, TCIBuild('xit_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].XitOn)])); + Reply(Client, TCIBuild('xit_offset', [TCIIntStr(Rx), TCIIntStr(FEcho[Rx].XitHz)])); + Reply(Client, StrTxEnable(Rx)); + end; + + Reply(Client, TCIBuild('split_enable', ['0', TCIBoolStr(FController.FSplitTxB)])); + Reply(Client, StrTrx); + Reply(Client, StrTune); + Reply(Client, StrDrive); + Reply(Client, TCIBuild('tune_drive', ['0', TCIIntStr(FController.FTXSettings.TUNLevel)])); + Reply(Client, StrVolume); + Reply(Client, StrMute); + Reply(Client, TCIBuild('mon_volume', [TCIIntStr(Round(TCIVolumeToDb(FController.FTxMonVolume)))])); + Reply(Client, TCIBuild('mon_enable', [TCIBoolStr(not FController.FRxMuteOnTx)])); + Reply(Client, TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); + Reply(Client, TCIBuild('cw_macros_delay', [TCIIntStr(FController.FCWSettings.RFDelayMS)])); + Reply(Client, TCIBuild('digl_offset', [TCIIntStr(FDiglOffset)])); + Reply(Client, TCIBuild('digu_offset', [TCIIntStr(FDiguOffset)])); + Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(FIQRate)])); + Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(FAudioRate)])); + if FController.FRunning then Reply(Client, TCIBuild('start')) + else Reply(Client, TCIBuild('stop')); +end; + +procedure TTCIAdapter.HandleConnect(Client: TTCIClient); +begin + // Не отдать READY молча нельзя: клиент, ждущий его, повиснет навсегда, — + // поэтому дамп состояния под защитой, а READY уходит в любом случае. + try + SendInit(Client); + SendState(Client); + except + on E: Exception do + Reply(Client, TCIBuild('tci_error', ['init', TCIEscape(E.Message)])); + end; + Reply(Client, TCIBuild('ready')); + Client.Ready := True; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Sync-методы: исполняются в потоке контроллера (через Invoke) + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIAdapter.SyncSetVfo; +var Id: Integer; +begin + if FsInt = 0 then + begin + if FsInt2 = 1 then FController.SetVfoB(FsFreq) else FController.SetVfoA(FsFreq); + Exit; + end; + Id := SliceIdOf(FsInt, FsInt2); + if Id > 0 then FController.SetSliceTarget(Id, FsFreq); +end; + +procedure TTCIAdapter.SyncSetCenter; +begin + if FsInt = 0 then FController.SetCenter(FsFreq) + else FController.SetPanDDCFreq(FsInt, FsFreq); +end; + +procedure TTCIAdapter.SyncSetMode; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetMode(FsInt2); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then FController.SetSliceMode(Id, FsInt2); +end; + +procedure TTCIAdapter.SyncSetFilter; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetFilterEdges(FsInt2, FsInt3); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then FController.SetSliceFilter(Id, FsInt2, FsInt3); +end; + +procedure TTCIAdapter.SyncSetTRX; +begin + FController.SetMOX(FsBool); +end; + +procedure TTCIAdapter.SyncSetTune; +begin + FController.SetTune(FsBool); +end; + +procedure TTCIAdapter.SyncSetDrive; +begin + FController.SetDrive(FsInt); +end; + +procedure TTCIAdapter.SyncSetTuneDrive; +var T: TTXSettings; +begin + T := FController.FTXSettings; + T.TUNLevel := FsInt; + FController.SetTXSettings(T); +end; + +procedure TTCIAdapter.SyncSetSplit; +begin + FController.SetSplit(FsBool); +end; + +procedure TTCIAdapter.SyncSetVolume; +begin + FController.SetVolume(FsInt); +end; + +procedure TTCIAdapter.SyncSetMute; +begin + FController.SetMute(FsBool); +end; + +procedure TTCIAdapter.SyncSetRxMute; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetMute(FsBool); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then FController.SetSliceMute(Id, FsBool); +end; + +procedure TTCIAdapter.SyncSetRxVolume; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetVolume(FsInt2); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then FController.SetSliceVolume(Id, FsInt2 / 100.0); +end; + +procedure TTCIAdapter.SyncSetMonVolume; +begin + FController.SetTXMonVolume(FsInt); +end; + +procedure TTCIAdapter.SyncSetMonEnable; +begin + // Самоконтроль на передаче = RX-аудио НЕ глушится (кнопка RX MUTE). + FController.SetRxMuteOnTx(not FsBool); +end; + +procedure TTCIAdapter.SyncSetAGCMode; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetAGCMode(FsInt2); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then + FController.SetSliceAGCMode(Id, TRadioController.AGCModeFromUI(FsInt2)); +end; + +procedure TTCIAdapter.SyncSetAGCTop; +begin + FController.SetAGCTop(FsInt); +end; + +procedure TTCIAdapter.SyncSetNR; +var Id: Integer; +begin + if FsInt = 0 then + begin + if FsBool then FController.SetNR(1) else FController.SetNR(0); + Exit; + end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then + FController.SetSliceDSP(Id, Ord(FsBool), FController.FNBMode, + FController.FSNB, FController.FANF); +end; + +procedure TTCIAdapter.SyncSetNB; +var Id: Integer; +begin + if FsInt = 0 then + begin + if FsBool then FController.SetNB(1) else FController.SetNB(0); + Exit; + end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then + FController.SetSliceDSP(Id, FController.FNRMode, Ord(FsBool), + FController.FSNB, FController.FANF); +end; + +procedure TTCIAdapter.SyncSetANF; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetANF(FsBool); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then + FController.SetSliceDSP(Id, FController.FNRMode, FController.FNBMode, + FController.FSNB, FsBool); +end; + +procedure TTCIAdapter.SyncSetLock; +begin + FController.SetVfoLock(FsBool); +end; + +procedure TTCIAdapter.SyncSetSql; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetFMSquelch(FsBool); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then FController.SetSliceFMSquelch(Id, FsBool, FController.FFMSQLevel); +end; + +procedure TTCIAdapter.SyncSetSqlLevel; +var Id: Integer; +begin + if FsInt = 0 then begin FController.SetFMSquelchLevel(FsInt2); Exit; end; + Id := SliceIdOf(FsInt, 0); + if Id > 0 then FController.SetSliceFMSquelch(Id, FController.FFMSQOn, FsInt2); +end; + +procedure TTCIAdapter.SyncSetRun; +begin + FController.SetRun(FsBool); +end; + +procedure TTCIAdapter.SyncSetCWSpeed; +var C: TCWSettings; +begin + C := FController.CWSettings; + C.Speed := FsInt; + FController.SetCWSettings(C); +end; + +procedure TTCIAdapter.SyncSetCWDelay; +var C: TCWSettings; +begin + C := FController.CWSettings; + C.RFDelayMS := FsInt; + FController.SetCWSettings(C); +end; + +procedure TTCIAdapter.SyncCWSend; +begin + FController.CWXSend(FsStr); +end; + +procedure TTCIAdapter.SyncCWStop; +begin + FController.CWXAbort; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Разбор команд клиента + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIAdapter.CmdFreq(Client: TTCIClient; const M: TTCIMessage; IsIF: Boolean); +// VFO:rx,ch[,hz] и IF:rx,ch[,hz] — разница только в системе отсчёта. +var + Rx, Ch: Integer; + Hz: Double; +begin + Rx := TCIArgInt(M, 0, -1); + Ch := TCIArgInt(M, 1, 0); + if not ValidRx(Rx) then Exit; + if (Ch < 0) or (Ch >= TCI_CHANNELS) then Exit; + + if M.ArgCount >= 3 then + begin + Hz := TCIArgFloat(M, 2, 0); + if IsIF then Hz := RxCenterHz(Rx) + Hz; + FLock.Enter; + try + FsInt := Rx; FsInt2 := Ch; FsFreq := Hz; + FController.Invoke(SyncSetVfo); + finally + FLock.Leave; + end; + end; + + if IsIF then Reply(Client, StrIf(Rx, Ch)) else Reply(Client, StrVfo(Rx, Ch)); +end; + +procedure TTCIAdapter.CmdCWMacros(const M: TTCIMessage; IsMsg: Boolean); +// CW_MACROS:trx,текст; CW_MSG:trx,префикс,позывной,суффикс; +// Разметку TCI приводим к тому, что понимает передатчик текста ewsdr: +// |ABBR| — слитная передача (у нас такой команды нет) → скобки снимаем; +// < / > — шаг скорости ±5 wpm (передатчик работает на одной скорости) → снимаем; +// CALL$N — повтор позывного N раз. +var + Text, Prefix, Call, Suffix, Rep: string; + P, N, i: Integer; +begin + if IsMsg then + begin + // cw_msg:arg1; — доотправка позывного по ходу передачи. Наш передатчик + // текста уже отданное не редактирует, поэтому такую форму игнорируем. + if M.ArgCount < 4 then Exit; + Prefix := TCIUnescape(TCIArg(M, 1)); + Call := TCIUnescape(TCIArg(M, 2)); + Suffix := TCIUnescape(TCIArg(M, 3)); + if Prefix = '_' then Prefix := ''; + if Suffix = '_' then Suffix := ''; + + P := Pos('$', Call); + if P > 0 then + begin + Rep := Copy(Call, P + 1, MaxInt); + Call := Copy(Call, 1, P - 1); + N := StrToIntDef(Trim(Rep), 1); + if N < 1 then N := 1; + if N > 5 then N := 5; + Text := ''; + for i := 1 to N do + begin + if Text <> '' then Text := Text + ' '; + Text := Text + Call; + end; + Call := Text; + end; + + Text := Trim(Prefix + ' ' + Call + ' ' + Suffix); + end + else + begin + if M.ArgCount < 2 then Exit; + Text := TCIUnescape(TCIArg(M, 1)); + end; + + Text := StringReplace(Text, '|', '', [rfReplaceAll]); + Text := StringReplace(Text, '<', '', [rfReplaceAll]); + Text := StringReplace(Text, '>', '', [rfReplaceAll]); + Text := Trim(Text); + if Text = '' then Exit; + + FLock.Enter; + try + FsStr := Text; + FController.Invoke(SyncCWSend); + finally + FLock.Leave; + end; + + // Позывной ушёл в эфир целиком — подтверждаем финальный вариант (§3.2.2). + if IsMsg and (Call <> '') then + FServer.Broadcast(TCIBuild('callsign_send', [Call])); +end; + +procedure TTCIAdapter.CmdSpot(const M: TTCIMessage); +// SPOT:позывной,мода,частота,цвет ARGB,текст; +var + S: TDXSpot; +begin + if FSpots = nil then Exit; + if M.ArgCount < 3 then Exit; + + S.Call := TCIUnescape(TCIArg(M, 0)); + S.FreqHz := TCIArgFloat(M, 2, 0); + S.Comment := TCIUnescape(TCIArg(M, 4)); + S.Spotter := 'TCI'; + S.TimeUTC := FormatDateTime('hhnn', Now); + S.Stamp := Now; + S.ModeGuessed := False; + S.Mode := DXModeFromComment(TCIArg(M, 1)); + if S.Mode = dxmUnknown then S.Mode := DXModeFromComment(S.Comment); + if S.Mode = dxmUnknown then + begin + S.Mode := DXModeFromFreq(S.FreqHz); + S.ModeGuessed := S.Mode <> dxmUnknown; + end; + if (S.Call = '') or (S.FreqHz <= 0) then Exit; + FSpots.Add(S); // стор потокобезопасен, маршалинг не нужен +end; + +procedure TTCIAdapter.HandleCommand(Client: TTCIClient; const Cmd: string); +// Внешняя оболочка: разбор + «одна команда не роняет соединение». Команда +// приходит из сети, а исполняется в потоке контроллера, где может рвануть что +// угодно (не поднятые движки, чужие сеттеры) — клиент за это платить не должен. +var + M: TTCIMessage; +begin + if not TCIParse(Cmd, M) then Exit; + try + DispatchCommand(Client, M); + except + on E: Exception do + Client.Send(TCIBuild('tci_error', [TCIEscape(LowerCase(M.Name)), + TCIEscape(E.Message)])); + end; +end; + +procedure TTCIAdapter.DispatchCommand(Client: TTCIClient; const M: TTCIMessage); +var + Rx, Ch, V: Integer; + B: Boolean; + D: Double; + Name: string; +begin + + // ── Управление устройством ── + if M.Name = 'START' then + begin + FLock.Enter; + try FsBool := True; FController.Invoke(SyncSetRun); finally FLock.Leave; end; + Exit; + end; + if M.Name = 'STOP' then + begin + FLock.Enter; + try FsBool := False; FController.Invoke(SyncSetRun); finally FLock.Leave; end; + Exit; + end; + + // ── Частоты ── + if M.Name = 'VFO' then begin CmdFreq(Client, M, False); Exit; end; + if M.Name = 'IF' then begin CmdFreq(Client, M, True); Exit; end; + + if M.Name = 'DDS' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + D := TCIArgFloat(M, 1, 0); + FLock.Enter; + try + FsInt := Rx; FsFreq := D; + FController.Invoke(SyncSetCenter); + finally FLock.Leave; end; + end; + Reply(Client, StrDds(Rx)); + Exit; + end; + + // ── Вид связи и фильтр ── + if M.Name = 'MODULATION' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + V := TCIModeIndex(TCIArg(M, 1), RxMode(Rx), ChanFreq(Rx, 0)); + if V >= 0 then + begin + FLock.Enter; + try + FsInt := Rx; FsInt2 := V; + FController.Invoke(SyncSetMode); + finally FLock.Leave; end; + end; + end; + Reply(Client, StrModulation(Rx)); + Exit; + end; + + if M.Name = 'RX_FILTER_BAND' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 3 then + begin + FLock.Enter; + try + FsInt := Rx; + FsInt2 := TCIArgInt(M, 1, 0); + FsInt3 := TCIArgInt(M, 2, 0); + FController.Invoke(SyncSetFilter); + finally FLock.Leave; end; + end; + Reply(Client, StrFilterBand(Rx)); + Exit; + end; + + // ── Передача ── + if M.Name = 'TRX' then + begin + if M.ArgCount >= 2 then + begin + // arg3 (источник сигнала: tci/mic1/…) игнорируем: аудио по TCI ещё нет, + // модуляция берётся из выбранного в программе входа. + FLock.Enter; + try + FsBool := TCIArgBool(M, 1, False); + FController.Invoke(SyncSetTRX); + finally FLock.Leave; end; + end; + Reply(Client, StrTrx); + Exit; + end; + + if M.Name = 'TUNE' then + begin + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsBool := TCIArgBool(M, 1, False); + FController.Invoke(SyncSetTune); + finally FLock.Leave; end; + end; + Reply(Client, StrTune); + Exit; + end; + + if M.Name = 'DRIVE' then + begin + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsInt := EnsureRange(TCIArgInt(M, 1, 0), 0, 100); + FController.Invoke(SyncSetDrive); + finally FLock.Leave; end; + end; + Reply(Client, StrDrive); + Exit; + end; + + if M.Name = 'TUNE_DRIVE' then + begin + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsInt := EnsureRange(TCIArgInt(M, 1, 0), 0, 100); + FController.Invoke(SyncSetTuneDrive); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('tune_drive', ['0', + TCIIntStr(FController.FTXSettings.TUNLevel)])); + Exit; + end; + + if M.Name = 'SPLIT_ENABLE' then + begin + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsBool := TCIArgBool(M, 1, False); + FController.Invoke(SyncSetSplit); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('split_enable', ['0', TCIBoolStr(FController.FSplitTxB)])); + Exit; + end; + + // ── Громкость ── + if M.Name = 'VOLUME' then + begin + if M.ArgCount >= 1 then + begin + FLock.Enter; + try + FsInt := TCIDbToVolume(TCIArgFloat(M, 0, -60)); + FController.Invoke(SyncSetVolume); + finally FLock.Leave; end; + end; + Reply(Client, StrVolume); + Exit; + end; + + if M.Name = 'MUTE' then + begin + if M.ArgCount >= 1 then + begin + FLock.Enter; + try + FsBool := TCIArgBool(M, 0, False); + FController.Invoke(SyncSetMute); + finally FLock.Leave; end; + end; + Reply(Client, StrMute); + Exit; + end; + + if M.Name = 'RX_MUTE' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsInt := Rx; FsBool := TCIArgBool(M, 1, False); + FController.Invoke(SyncSetRxMute); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))])); + Exit; + end; + + if M.Name = 'RX_VOLUME' then + begin + Rx := TCIArgInt(M, 0, -1); + Ch := EnsureRange(TCIArgInt(M, 1, 0), 0, TCI_CHANNELS - 1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 3 then + begin + FLock.Enter; + try + FsInt := Rx; + FsInt2 := TCIDbToVolume(TCIArgFloat(M, 2, -60)); + FController.Invoke(SyncSetRxVolume); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('rx_volume', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIIntStr(Round(RxVolumeDb(Rx)))])); + Exit; + end; + + if M.Name = 'RX_BALANCE' then + begin + // Баланса каналов у нас нет — эхо, чтобы клиенты не расходились. + Rx := TCIArgInt(M, 0, -1); + Ch := EnsureRange(TCIArgInt(M, 1, 0), 0, TCI_CHANNELS - 1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 3 then + FEcho[Rx].BalanceDb[Ch] := EnsureRange(TCIArgInt(M, 2, 0), -40, 40); + FServer.Broadcast(TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIIntStr(FEcho[Rx].BalanceDb[Ch])])); + Exit; + end; + + if M.Name = 'MON_VOLUME' then + begin + if M.ArgCount >= 1 then + begin + FLock.Enter; + try + FsInt := TCIDbToVolume(TCIArgFloat(M, 0, -60)); + FController.Invoke(SyncSetMonVolume); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('mon_volume', + [TCIIntStr(Round(TCIVolumeToDb(FController.FTxMonVolume)))])); + Exit; + end; + + if M.Name = 'MON_ENABLE' then + begin + if M.ArgCount >= 1 then + begin + FLock.Enter; + try + FsBool := TCIArgBool(M, 0, False); + FController.Invoke(SyncSetMonEnable); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('mon_enable', [TCIBoolStr(not FController.FRxMuteOnTx)])); + Exit; + end; + + // ── АРУ ── + if M.Name = 'AGC_MODE' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + Name := LowerCase(TCIArg(M, 1)); + if Name = 'off' then V := 4 + else if Name = 'fast' then V := 0 + else if Name = 'normal' then V := 1 + else V := -1; + if V >= 0 then + begin + FLock.Enter; + try + FsInt := Rx; FsInt2 := V; + FController.Invoke(SyncSetAGCMode); + finally FLock.Leave; end; + end; + end; + Reply(Client, StrAGCMode(Rx)); + Exit; + end; + + if M.Name = 'AGC_GAIN' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsInt := EnsureRange(TCIArgInt(M, 1, 0), TCI_AGC_MIN_DB, TCI_AGC_MAX_DB); + FController.Invoke(SyncSetAGCTop); + finally FLock.Leave; end; + end; + Reply(Client, StrAGCGain(Rx)); + Exit; + end; + + // ── Шумоподавление ── + if (M.Name = 'RX_NR_ENABLE') or (M.Name = 'RX_NB_ENABLE') or + (M.Name = 'RX_ANF_ENABLE') then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsInt := Rx; FsBool := TCIArgBool(M, 1, False); + if M.Name = 'RX_NR_ENABLE' then FController.Invoke(SyncSetNR) + else if M.Name = 'RX_NB_ENABLE' then FController.Invoke(SyncSetNB) + else FController.Invoke(SyncSetANF); + finally FLock.Leave; end; + end; + if M.Name = 'RX_NR_ENABLE' then + Reply(Client, TCIBuild('rx_nr_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNRMode > 0)])) + else if M.Name = 'RX_NB_ENABLE' then + Reply(Client, TCIBuild('rx_nb_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNBMode > 0)])) + else + Reply(Client, TCIBuild('rx_anf_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FANF)])); + Exit; + end; + + if M.Name = 'RX_NB_PARAM' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 3 then + begin + FEcho[Rx].NBThreshold := EnsureRange(TCIArgInt(M, 1, 50), 1, 100); + FEcho[Rx].NBDuration := EnsureRange(TCIArgInt(M, 2, 25), 1, 300); + end; + FServer.Broadcast(TCIBuild('rx_nb_param', [TCIIntStr(Rx), + TCIIntStr(FEcho[Rx].NBThreshold), TCIIntStr(FEcho[Rx].NBDuration)])); + Exit; + end; + + // ── Эхо-переключатели обработки (в ewsdr соответствующих трактов нет) ── + if (M.Name = 'RX_BIN_ENABLE') or (M.Name = 'RX_ANC_ENABLE') or + (M.Name = 'RX_APF_ENABLE') or (M.Name = 'RX_DSE_ENABLE') or + (M.Name = 'RX_NF_ENABLE') then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + B := TCIArgBool(M, 1, False); + if M.ArgCount >= 2 then + begin + if M.Name = 'RX_BIN_ENABLE' then FEcho[Rx].BinOn := B + else if M.Name = 'RX_ANC_ENABLE' then FEcho[Rx].ANCOn := B + else if M.Name = 'RX_APF_ENABLE' then FEcho[Rx].APFOn := B + else if M.Name = 'RX_DSE_ENABLE' then FEcho[Rx].DSEOn := B + else FEcho[Rx].NFOn := B; + end; + if M.Name = 'RX_BIN_ENABLE' then B := FEcho[Rx].BinOn + else if M.Name = 'RX_ANC_ENABLE' then B := FEcho[Rx].ANCOn + else if M.Name = 'RX_APF_ENABLE' then B := FEcho[Rx].APFOn + else if M.Name = 'RX_DSE_ENABLE' then B := FEcho[Rx].DSEOn + else B := FEcho[Rx].NFOn; + FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIBoolStr(B)])); + Exit; + end; + + // ── Блокировка, шумоподавитель ── + if M.Name = 'LOCK' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsBool := TCIArgBool(M, 1, False); + FController.Invoke(SyncSetLock); + finally FLock.Leave; end; + end; + Reply(Client, StrLock(Rx)); + Exit; + end; + + if M.Name = 'SQL_ENABLE' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsInt := Rx; FsBool := TCIArgBool(M, 1, False); + FController.Invoke(SyncSetSql); + finally FLock.Leave; end; + end; + Reply(Client, StrSqlEnable(Rx)); + Exit; + end; + + if M.Name = 'SQL_LEVEL' then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + FLock.Enter; + try + FsInt := Rx; + FsInt2 := TCISqlToLevel(TCIArgFloat(M, 1, -140)); + FController.Invoke(SyncSetSqlLevel); + finally FLock.Leave; end; + end; + Reply(Client, StrSqlLevel(Rx)); + Exit; + end; + + // ── Расстройка: своего RIT/XIT в ewsdr нет — храним и отражаем ── + if (M.Name = 'RIT_ENABLE') or (M.Name = 'XIT_ENABLE') then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + if M.Name = 'RIT_ENABLE' then FEcho[Rx].RitOn := TCIArgBool(M, 1, False) + else FEcho[Rx].XitOn := TCIArgBool(M, 1, False); + end; + if M.Name = 'RIT_ENABLE' then B := FEcho[Rx].RitOn else B := FEcho[Rx].XitOn; + FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIBoolStr(B)])); + Exit; + end; + + if (M.Name = 'RIT_OFFSET') or (M.Name = 'XIT_OFFSET') then + begin + Rx := TCIArgInt(M, 0, -1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 2 then + begin + if M.Name = 'RIT_OFFSET' then FEcho[Rx].RitHz := TCIArgInt(M, 1, 0) + else FEcho[Rx].XitHz := TCIArgInt(M, 1, 0); + end; + if M.Name = 'RIT_OFFSET' then V := FEcho[Rx].RitHz else V := FEcho[Rx].XitHz; + FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIIntStr(V)])); + Exit; + end; + + if M.Name = 'RX_CHANNEL_ENABLE' then + begin + // Канал B у главного приёмника — это VFO B, он есть всегда; у доп. панов + // вторым каналом был бы второй слайс (создание слайсов по TCI — этап 2). + Rx := TCIArgInt(M, 0, -1); + Ch := TCIArgInt(M, 1, 1); + if not ValidRx(Rx) then Exit; + if M.ArgCount >= 3 then FEcho[Rx].ChannelBOn := TCIArgBool(M, 2, False); + B := (Rx = 0) or (ChanCount(Rx) > 1); + FServer.Broadcast(TCIBuild('rx_channel_enable', + [TCIIntStr(Rx), TCIIntStr(Ch), TCIBoolStr(B)])); + Exit; + end; + + // ── Смещения цифровых видов (эхо) ── + if (M.Name = 'DIGL_OFFSET') or (M.Name = 'DIGU_OFFSET') then + begin + if M.ArgCount >= 1 then + begin + V := EnsureRange(TCIArgInt(M, 0, 0), 0, 4000); + if M.Name = 'DIGL_OFFSET' then FDiglOffset := V else FDiguOffset := V; + end; + if M.Name = 'DIGL_OFFSET' then V := FDiglOffset else V := FDiguOffset; + FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(V)])); + Exit; + end; + + // ── Телеграф ── + if (M.Name = 'CW_MACROS_SPEED') or (M.Name = 'CW_KEYER_SPEED') then + begin + if M.ArgCount >= 1 then + begin + FLock.Enter; + try + FsInt := EnsureRange(TCIArgInt(M, 0, 20), 5, 60); + FController.Invoke(SyncSetCWSpeed); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); + Exit; + end; + + if (M.Name = 'CW_MACROS_SPEED_UP') or (M.Name = 'CW_MACROS_SPEED_DOWN') then + begin + V := TCIArgInt(M, 0, 0); + if M.Name = 'CW_MACROS_SPEED_DOWN' then V := -V; + FLock.Enter; + try + FsInt := EnsureRange(FController.FCWSettings.Speed + V, 5, 60); + FController.Invoke(SyncSetCWSpeed); + finally FLock.Leave; end; + FServer.Broadcast(TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); + Exit; + end; + + if M.Name = 'CW_MACROS_DELAY' then + begin + if M.ArgCount >= 1 then + begin + FLock.Enter; + try + FsInt := EnsureRange(TCIArgInt(M, 0, 0), 0, 1000); + FController.Invoke(SyncSetCWDelay); + finally FLock.Leave; end; + end; + Reply(Client, TCIBuild('cw_macros_delay', [TCIIntStr(FController.FCWSettings.RFDelayMS)])); + Exit; + end; + + if M.Name = 'CW_MACROS' then begin CmdCWMacros(M, False); Exit; end; + if M.Name = 'CW_MSG' then begin CmdCWMacros(M, True); Exit; end; + if M.Name = 'CW_MACROS_STOP' then + begin + FLock.Enter; + try FController.Invoke(SyncCWStop); finally FLock.Leave; end; + Exit; + end; + if M.Name = 'CW_TERMINAL' then + begin + FCwTerminal := TCIArgBool(M, 0, False); + FServer.Broadcast(TCIBuild('cw_terminal', [TCIBoolStr(FCwTerminal)])); + Exit; + end; + + // ── Споты ── + if M.Name = 'SPOT' then begin CmdSpot(M); Exit; end; + if M.Name = 'SPOT_DELETE' then + begin + if FSpots <> nil then FSpots.RemoveCall(TCIUnescape(TCIArg(M, 0))); + Exit; + end; + if M.Name = 'SPOT_CLEAR' then + begin + if FSpots <> nil then FSpots.Clear; + Exit; + end; + + // ── Измерители ── + if M.Name = 'RX_SENSORS_ENABLE' then + begin + Client.RxSensors := TCIArgBool(M, 0, False); + if M.ArgCount >= 2 then + Client.RxSensorsMs := EnsureRange(TCIArgInt(M, 1, 200), + TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS); + Exit; + end; + if M.Name = 'TX_SENSORS_ENABLE' then + begin + Client.TxSensors := TCIArgBool(M, 0, False); + if M.ArgCount >= 2 then + Client.TxSensorsMs := EnsureRange(TCIArgInt(M, 1, 200), + TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS); + Exit; + end; + + // ── Параметры потоков: принимаем и подтверждаем, сами потоки — этап 2 ── + if M.Name = 'IQ_SAMPLERATE' then + begin + if M.ArgCount >= 1 then FIQRate := TCIArgInt(M, 0, FIQRate); + Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(FIQRate)])); + Exit; + end; + if M.Name = 'AUDIO_SAMPLERATE' then + begin + if M.ArgCount >= 1 then FAudioRate := TCIArgInt(M, 0, FAudioRate); + Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(FAudioRate)])); + Exit; + end; + if M.Name = 'AUDIO_STREAM_SAMPLES' then + begin + FAudioSamples := EnsureRange(TCIArgInt(M, 0, FAudioSamples), 100, 2048); + Exit; + end; + if M.Name = 'AUDIO_STREAM_CHANNELS' then + begin + FAudioChannels := EnsureRange(TCIArgInt(M, 0, FAudioChannels), 1, 2); + Exit; + end; + if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then + begin + FAudioSampleType := LowerCase(TCIArg(M, 0)); + Exit; + end; + if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then + begin + FTxBuffering := EnsureRange(TCIArgInt(M, 0, FTxBuffering), 50, 500); + Exit; + end; + + // IQ_START/STOP, AUDIO_START/STOP, LINE_OUT_* — потоки этапа 2. Молча + // игнорируем: протокол разрешает игнорировать команды, которых не понимаем. +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Измерители (тик сервера, 20 мс) + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIAdapter.PushSensors(Client: TTCIClient); +var + Now_: QWord; + Rx, Ch: Integer; + Snap: TRadioSnapshot; +begin + if not Client.Ready then Exit; + Now_ := GetTickCount64; + + if Client.RxSensors and (Now_ - Client.RxSensorsAt >= QWord(Client.RxSensorsMs)) then + begin + Client.RxSensorsAt := Now_; + for Rx := 0 to RxCount - 1 do + begin + for Ch := 0 to ChanCount(Rx) - 1 do + Client.Send(TCIBuild('rx_channel_sensors', + [TCIIntStr(Rx), TCIIntStr(Ch), TCIFloatStr(RxSMeterDbm(Rx, Ch), 1)])); + // Устаревшая форма — её ещё ждут старые клиенты. + Client.Send(TCIBuild('rx_sensors', + [TCIIntStr(Rx), TCIFloatStr(RxSMeterDbm(Rx, 0), 1)])); + end; + end; + + if Client.TxSensors and (Now_ - Client.TxSensorsAt >= QWord(Client.TxSensorsMs)) then + begin + Client.TxSensorsAt := Now_; + Snap := FController.GetSnapshot; + // arg2 — уровень микрофона: измерителя микрофона в ewsdr нет, отдаём + // нижнюю границу шкалы, чтобы клиент не рисовал случайные значения. + Client.Send(TCIBuild('tx_sensors', + ['0', '-60.0', TCIFloatStr(Snap.FwdW, 1), TCIFloatStr(Snap.FwdW, 1), + TCIFloatStr(Snap.SWR, 2)])); + end; +end; + +procedure TTCIAdapter.HandleTick; +begin + // Тик крутится в своём потоке сервера: исключение здесь остановило бы + // измерители у ВСЕХ клиентов до перезапуска сервера. + try + FServer.EnumClients(PushSensors); + except + // молча: следующий тик через 20 мс попробует снова + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Уведомления: изменение состояния контроллера → всем клиентам + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIAdapter.OnState(Sender: TObject; Field: TRadioField); +var + Rx: Integer; + TxHz: Double; +begin + if (FServer = nil) or (FServer.ClientCount = 0) then Exit; + + case Field of + rfVfoA: + begin + FServer.Broadcast(StrVfo(0, 0)); + FServer.Broadcast(StrIf(0, 0)); + end; + rfVfoB: + begin + FServer.Broadcast(StrVfo(0, 1)); + FServer.Broadcast(StrIf(0, 1)); + end; + rfMode: + begin + FServer.Broadcast(StrModulation(0)); + FServer.Broadcast(StrFilterBand(0)); + end; + rfFilter, rfFilterBW: FServer.Broadcast(StrFilterBand(0)); + rfAGCMode: FServer.Broadcast(StrAGCMode(0)); + rfAGCTop: FServer.Broadcast(StrAGCGain(0)); + rfVolume: FServer.Broadcast(StrVolume); + rfMute: FServer.Broadcast(StrMute); + rfDrive: FServer.Broadcast(StrDrive); + rfTransmitting: FServer.Broadcast(StrTrx); + rfTuning: FServer.Broadcast(StrTune); + rfVfoLock: + begin + FServer.Broadcast(StrLock(0)); + FServer.Broadcast(TCIBuild('vfo_lock', + ['0', '0', TCIBoolStr(FController.FVfoLock)])); + end; + rfNR: FServer.Broadcast(TCIBuild('rx_nr_enable', ['0', TCIBoolStr(FController.FNRMode > 0)])); + rfNB: FServer.Broadcast(TCIBuild('rx_nb_enable', ['0', TCIBoolStr(FController.FNBMode > 0)])); + rfANF: FServer.Broadcast(TCIBuild('rx_anf_enable', ['0', TCIBoolStr(FController.FANF)])); + rfFMSQ: FServer.Broadcast(StrSqlEnable(0)); + rfFMSQLevel: FServer.Broadcast(StrSqlLevel(0)); + rfRxMuteOnTx: FServer.Broadcast(TCIBuild('mon_enable', + [TCIBoolStr(not FController.FRxMuteOnTx)])); + rfCenterFreq: + begin + FServer.Broadcast(StrDds(0)); + FServer.Broadcast(StrIf(0, 0)); + FServer.Broadcast(StrIf(0, 1)); + end; + rfSampleRate: + FServer.Broadcast(TCIBuild('if_limits', + [TCIIntStr(-(FController.FSampleRate div 2)), + TCIIntStr(FController.FSampleRate div 2)])); + rfRunning: + if FController.FRunning then FServer.Broadcast(TCIBuild('start')) + else FServer.Broadcast(TCIBuild('stop')); + rfPanFreq: + for Rx := 1 to RxCount - 1 do + if FController.PanDDCActive(Rx) then FServer.Broadcast(StrDds(Rx)); + rfSliceFreq: + for Rx := 1 to RxCount - 1 do + if FController.PanDDCActive(Rx) then FServer.Broadcast(StrVfo(Rx, 0)); + rfBand, rfXvtr: + begin + FServer.Broadcast(StrTxEnable(0)); + FServer.Broadcast(StrVfo(0, 0)); + end; + end; + + // Частота передачи — отдельным уведомлением, но только когда она реально + // изменилась: поле дёргается на каждый шаг ручки. + if Field in [rfVfoA, rfVfoB, rfActiveVfo, rfBand, rfXvtr, rfTransmitting] then + begin + TxHz := FController.ActiveTXFreqHz; + if Abs(TxHz - FLastTxFreq) >= 1 then + begin + FLastTxFreq := TxHz; + FServer.Broadcast(TCIBuild('tx_frequency', [TCIIntStr(Round(TxHz))])); + end; + if TxEnabled <> FLastTxEnable then + begin + FLastTxEnable := TxEnabled; + FServer.Broadcast(StrTxEnable(0)); + end; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Уведомления, которые инициирует UI + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIAdapter.NotifySpotClicked(const Call: string; FreqHz: Double; + Rx, Ch: Integer); +begin + if (FServer = nil) or (FServer.ClientCount = 0) then Exit; + FServer.Broadcast(TCIBuild('rx_clicked_on_spot', + [TCIIntStr(Rx), TCIIntStr(Ch), TCIEscape(Call), TCIIntStr(Round(FreqHz))])); + // Устаревшая форма — её ещё слушают старые клиенты. + FServer.Broadcast(TCIBuild('clicked_on_spot', + [TCIEscape(Call), TCIIntStr(Round(FreqHz))])); +end; + +procedure TTCIAdapter.NotifyAppFocus(InFocus: Boolean); +begin + if (FServer = nil) or (FServer.ClientCount = 0) then Exit; + FServer.Broadcast(TCIBuild('app_focus', [TCIBoolStr(InFocus)])); +end; + +end. diff --git a/TCIProtocol.pas b/TCIProtocol.pas new file mode 100644 index 0000000..f2223eb --- /dev/null +++ b/TCIProtocol.pas @@ -0,0 +1,379 @@ +unit TCIProtocol; + +{ + TCIProtocol.pas — протокол TCI 2.0 (Expert Electronics), чистый слой. + + Только разбор/сборка строк и словари протокола: ни сокетов, ни контроллера. + Роль та же, что у CATEngine в CAT-подсистеме, но парсер тут тривиальный, и + вся логика команд живёт в TCIAdapter — команд у TCI мало, а аргументы у них + типизированы (номер приёмника/канала), поэтому таблица команд вырождается в + case по имени. + + Формат (док, §3.1): + <имя>:<арг1>,<арг2>,…; команда с аргументами + <имя>; команда без аргументов + Зарезервированные символы: ':' ',' ';' — внутри аргументов запрещены и + заменяются на '^' '~' '*' (§3.2.1), обратная подстановка — TCIUnescape. + + Регистр значения не имеет. ExpertSDR3 шлёт всё в нижнем регистре, и часть + клиентов сравнивает строки как есть — поэтому наружу тоже пишем строчными, + а внутрь принимаем любой. +} + +{$IFDEF FPC} + {$MODE Delphi} + {$LONGSTRINGS ON} +{$ENDIF} + +interface + +uses + Classes, SysUtils, Math, RadioModes; + +const + TCI_VERSION = '2.0'; // версия протокола, отдаётся в PROTOCOL + TCI_APP_NAME = 'EWSDR'; + TCI_DEFAULT_PORT = 40001; // порт TCI-сервера ExpertSDR3 + TCI_CHANNELS = 2; // каналов приёма на приёмник (A/B) + + // Список видов связи для MODULATIONS_LIST. Первые десять — словарь + // ExpertSDR3 (клиенты сверяются именно с ними), dmr/fmraw — наше + // расширение: протокол расширяемый по замыслу (§1.4). + TCI_MODULATIONS = 'am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw'; + + // Границы, оговорённые протоколом (клампим сами — клиент шлёт что угодно). + TCI_VOL_MIN_DB = -60; TCI_VOL_MAX_DB = 0; + TCI_SQL_MIN_DB = -140; TCI_SQL_MAX_DB = 0; + TCI_AGC_MIN_DB = -20; TCI_AGC_MAX_DB = 120; + TCI_SENSOR_MIN_MS = 30; TCI_SENSOR_MAX_MS = 1000; + +type + TTCIArgs = array of string; + + { Разобранная команда. Name — в ВЕРХНЕМ регистре (сравнивать в case), + аргументы — как пришли, с уже снятым экранированием только там, где это + нужно вызывающему (текст CW), поэтому здесь их не трогаем. } + TTCIMessage = record + Name: string; + Args: TTCIArgs; + ArgCount: Integer; + end; + + { Тип бинарного потока (§3.4). Потоки — следующий этап (см. doc/TCI.md), + но формат протокольный, поэтому объявлен здесь, а не в транспорте. } + TTCIStreamType = (tstIQ, tstRXAudio, tstTXAudio, tstTXChrono, tstLineOut); + TTCISampleType = (tsyInt16, tsyInt24, tsyInt32, tsyFloat32); + + { Заголовок блока потока: 16 × uint32 перед сэмплами. } + TTCIStreamHeader = packed record + Receiver: LongWord; + SampleRate: LongWord; + Format: LongWord; // TTCISampleType + Codec: LongWord; // всегда 0 (сжатие не реализовано) + CRC: LongWord; // всегда 0 + DataLength: LongWord; // количество вещественных отсчётов в data[] + StreamType: LongWord; // TTCIStreamType + Channels: LongWord; + Reserv: array[0..7] of LongWord; + end; + +{ ── Разбор ─────────────────────────────────────────────────────────────── } + +{ Разбирает ОДНУ команду (без завершающей ';' или с ней). False — мусор. } +function TCIParse(const S: string; out M: TTCIMessage): Boolean; + +{ Режет полученный текстовый фрейм на отдельные команды по ';'. Клиенты + склеивают команды в один фрейм, и это законно. } +function TCISplit(const Payload: string; Lines: TStrings): Integer; + +function TCIArg(const M: TTCIMessage; Idx: Integer): string; +function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer; +function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double; +function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean; + +{ ── Сборка ─────────────────────────────────────────────────────────────── } + +function TCIBuild(const Name: string): string; overload; +function TCIBuild(const Name: string; const Args: array of string): string; overload; + +function TCIBoolStr(B: Boolean): string; +function TCIIntStr(V: Int64): string; +function TCIFloatStr(V: Double; Digits: Integer = 1): string; + +{ ── Экранирование текстовых аргументов (§3.2.1) ────────────────────────── } + +function TCIUnescape(const S: string): string; +function TCIEscape(const S: string): string; + +{ ── Виды связи ─────────────────────────────────────────────────────────── } + +{ Имя вида связи для TCI по индексу RadioModes (CWL/CWU схлопываются в 'cw'). } +function TCIModeName(ModeIdx: Integer): string; + +{ Индекс RadioModes по имени TCI. 'cw' сам по себе боковую не задаёт: + оставляем текущую, если уже телеграф, иначе выбираем по частоте (ниже + 10 МГц — CWL, выше — CWU, общепринятая конвенция). -1 = имя неизвестно. } +function TCIModeIndex(const Name: string; CurMode: Integer; FreqHz: Double): Integer; + +{ ── Пересчёт величин ───────────────────────────────────────────────────── } + +function TCIVolumeToDb(V: Integer): Double; // громкость 0..100 → -60..0 дБ +function TCIDbToVolume(Db: Double): Integer; // и обратно +function TCISqlToLevel(Db: Double): Integer; // порог -140..0 дБ → 0..100 +function TCILevelToSql(V: Integer): Double; + +implementation + +var + // Числа протокола — только с точкой, независимо от локали хоста. + TCIFormatSettings: TFormatSettings; + +{ ═══════════════════════════════════════════════════════════════════════════ + Разбор + ═══════════════════════════════════════════════════════════════════════════ } + +function TCIParse(const S: string; out M: TTCIMessage): Boolean; +var + Body, ArgStr: string; + P, Start, i: Integer; +begin + Result := False; + M.Name := ''; + M.ArgCount := 0; + SetLength(M.Args, 0); + + Body := Trim(S); + // Хвостовая ';' необязательна: транспорт мог её уже срезать при нарезке. + if (Body <> '') and (Body[Length(Body)] = ';') then + Body := Copy(Body, 1, Length(Body) - 1); + Body := Trim(Body); + if Body = '' then Exit; + + P := Pos(':', Body); + if P = 0 then + begin + M.Name := UpperCase(Body); + Result := M.Name <> ''; + Exit; + end; + + M.Name := UpperCase(Trim(Copy(Body, 1, P - 1))); + if M.Name = '' then Exit; + + ArgStr := Copy(Body, P + 1, MaxInt); + Start := 1; + for i := 1 to Length(ArgStr) + 1 do + if (i > Length(ArgStr)) or (ArgStr[i] = ',') then + begin + SetLength(M.Args, M.ArgCount + 1); + M.Args[M.ArgCount] := Trim(Copy(ArgStr, Start, i - Start)); + Inc(M.ArgCount); + Start := i + 1; + end; + + Result := True; +end; + +function TCISplit(const Payload: string; Lines: TStrings): Integer; +var + i, Start: Integer; + Piece: string; +begin + Lines.Clear; + Start := 1; + for i := 1 to Length(Payload) do + if Payload[i] = ';' then + begin + Piece := Trim(Copy(Payload, Start, i - Start)); + if Piece <> '' then Lines.Add(Piece); + Start := i + 1; + end; + // Хвост без ';' — недоприехавшая команда; протокол её игнорирует (§3.1). + Result := Lines.Count; +end; + +function TCIArg(const M: TTCIMessage; Idx: Integer): string; +begin + if (Idx >= 0) and (Idx < M.ArgCount) then Result := M.Args[Idx] else Result := ''; +end; + +function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer; +var + D: Double; +begin + // Клиенты шлют и «7100000», и «7100000.0» — берём через Float и округляем. + if not TryStrToFloat(StringReplace(TCIArg(M, Idx), ',', '.', [rfReplaceAll]), + D, TCIFormatSettings) then + Result := Def + else + Result := Round(D); +end; + +function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double; +begin + if not TryStrToFloat(StringReplace(TCIArg(M, Idx), ',', '.', [rfReplaceAll]), + Result, TCIFormatSettings) then + Result := Def; +end; + +function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean; +var + S: string; +begin + S := LowerCase(TCIArg(M, Idx)); + if (S = 'true') or (S = '1') then Result := True + else if (S = 'false') or (S = '0') then Result := False + else Result := Def; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Сборка + ═══════════════════════════════════════════════════════════════════════════ } + +function TCIBuild(const Name: string): string; +begin + Result := LowerCase(Name) + ';'; +end; + +function TCIBuild(const Name: string; const Args: array of string): string; +var + i: Integer; +begin + if Length(Args) = 0 then begin Result := TCIBuild(Name); Exit; end; + Result := LowerCase(Name) + ':'; + for i := 0 to High(Args) do + begin + if i > 0 then Result := Result + ','; + Result := Result + Args[i]; + end; + Result := Result + ';'; +end; + +function TCIBoolStr(B: Boolean): string; +begin + if B then Result := 'true' else Result := 'false'; +end; + +function TCIIntStr(V: Int64): string; +begin + Result := IntToStr(V); +end; + +function TCIFloatStr(V: Double; Digits: Integer): string; +begin + if IsNan(V) or IsInfinite(V) then V := 0; + Result := FloatToStrF(V, ffFixed, 15, Digits, TCIFormatSettings); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Экранирование + ═══════════════════════════════════════════════════════════════════════════ } + +function TCIUnescape(const S: string): string; +begin + Result := StringReplace(S, '^', ':', [rfReplaceAll]); + Result := StringReplace(Result, '~', ',', [rfReplaceAll]); + Result := StringReplace(Result, '*', ';', [rfReplaceAll]); +end; + +function TCIEscape(const S: string): string; +begin + Result := StringReplace(S, ':', '^', [rfReplaceAll]); + Result := StringReplace(Result, ',', '~', [rfReplaceAll]); + Result := StringReplace(Result, ';', '*', [rfReplaceAll]); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Виды связи + ═══════════════════════════════════════════════════════════════════════════ } + +function TCIModeName(ModeIdx: Integer): string; +begin + case ModeIdx of + MODE_LSB: Result := 'lsb'; + MODE_USB: Result := 'usb'; + MODE_DSB: Result := 'dsb'; + MODE_CWL, + MODE_CWU: Result := 'cw'; + MODE_FM: Result := 'nfm'; + MODE_AM: Result := 'am'; + MODE_SAM: Result := 'sam'; + MODE_DIGU: Result := 'digu'; + MODE_DIGL: Result := 'digl'; + MODE_WFM: Result := 'wfm'; + MODE_DMR: Result := 'dmr'; + MODE_FMRAW: Result := 'fmraw'; + else + Result := 'usb'; + end; +end; + +function TCIModeIndex(const Name: string; CurMode: Integer; FreqHz: Double): Integer; +var + S: string; +begin + S := LowerCase(Trim(Name)); + if S = 'lsb' then Result := MODE_LSB + else if S = 'usb' then Result := MODE_USB + else if S = 'dsb' then Result := MODE_DSB + else if S = 'am' then Result := MODE_AM + else if S = 'sam' then Result := MODE_SAM + else if (S = 'nfm') or (S = 'fm') then Result := MODE_FM + else if S = 'wfm' then Result := MODE_WFM + else if S = 'digu' then Result := MODE_DIGU + else if S = 'digl' then Result := MODE_DIGL + else if S = 'dmr' then Result := MODE_DMR + else if S = 'fmraw' then Result := MODE_FMRAW + else if S = 'cwl' then Result := MODE_CWL + else if S = 'cwu' then Result := MODE_CWU + else if S = 'cw' then + begin + if (CurMode = MODE_CWL) or (CurMode = MODE_CWU) then + Result := CurMode // боковую телеграфа не трогаем + else if FreqHz < 10000000 then + Result := MODE_CWL + else + Result := MODE_CWU; + end + else + Result := -1; // 'drm' и всё незнакомое — молча игнорируем (§3.1) +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Пересчёт величин + ═══════════════════════════════════════════════════════════════════════════ } + +function TCIVolumeToDb(V: Integer): Double; +begin + if V <= 0 then Result := TCI_VOL_MIN_DB + else if V >= 100 then Result := 0 + else Result := TCI_VOL_MIN_DB + (TCI_VOL_MIN_DB * -1) * (V / 100.0); +end; + +function TCIDbToVolume(Db: Double): Integer; +begin + if Db <= TCI_VOL_MIN_DB then Result := 0 + else if Db >= 0 then Result := 100 + else Result := Round((Db - TCI_VOL_MIN_DB) / (TCI_VOL_MIN_DB * -1) * 100.0); +end; + +function TCISqlToLevel(Db: Double): Integer; +begin + // Порог шумоподавителя: у нас 0..100 (FM squelch), у TCI — dBm -140..0. + if Db <= TCI_SQL_MIN_DB then Result := 0 + else if Db >= 0 then Result := 100 + else Result := Round((Db - TCI_SQL_MIN_DB) / (TCI_SQL_MIN_DB * -1) * 100.0); +end; + +function TCILevelToSql(V: Integer): Double; +begin + if V <= 0 then Result := TCI_SQL_MIN_DB + else if V >= 100 then Result := 0 + else Result := TCI_SQL_MIN_DB + (TCI_SQL_MIN_DB * -1) * (V / 100.0); +end; + +initialization + TCIFormatSettings := DefaultFormatSettings; + TCIFormatSettings.DecimalSeparator := '.'; + +end. diff --git a/TCIServer.pas b/TCIServer.pas new file mode 100644 index 0000000..1992579 --- /dev/null +++ b/TCIServer.pas @@ -0,0 +1,688 @@ +unit TCIServer; + +{ + TCIServer.pas — транспорт TCI: WebSocket-сервер (роль сервера играем мы, + как ExpertSDR3; клиенты — логгеры, скиммеры, программы цифровых видов). + + Что делает: + • слушает TCP-порт (умолчание 40001), принимает HTTP-Upgrade на WebSocket + по любому пути (клиенты ходят на ws://host:40001/); + • режет входящие текстовые фреймы на команды и отдаёт их наверх + (OnCommand) прямо в потоке клиента — маршалинг в поток контроллера + делает TCIAdapter, как это устроено у CAT; + • рассылает строки всем клиентам (Broadcast) — сервер TCI обязан + синхронизировать всех подключённых (§3.5); + • тикает OnTick (умолчание 20 мс) — по нему адаптер шлёт показания + измерителей с индивидуальным для каждого клиента периодом. + + Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2, + см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются. + + Сокеты и WS-фреймы переиспользованы из веб-подсистемы (WebUtils/WsClient): + тот же код handshake и та же схема «поток на клиента + accept-поток», что в + WebServer. + + Авторизации у TCI нет by design. Порт слушается там, где сказано в + настройках; умолчание — 127.0.0.1, чтобы наружу он не торчал без спроса. +} + +{$IFDEF FPC} + {$MODE Delphi} + {$LONGSTRINGS ON} +{$ENDIF} + +interface + +uses + Classes, SysUtils, + WebUtils, WsClient, TCIProtocol + {$IFDEF WINDOWS}, Windows, WinSock2{$ELSE}, Sockets{$ENDIF}, + SyncObjs; // ← после платформенных юнитов (конфликт идентификатора Create) + +const + TCI_MAX_CLIENTS = 8; + TCI_TICK_MS = 20; // период OnTick (сенсоры троттлятся адаптером) + TCI_WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; + TCI_SEND_TIMEOUT = 1000; // мс на SockSend, иначе клиент считается мёртвым + +type + TTCIServer = class; + + { Один подключённый клиент: WS-сокет + его личные подписки. Подписки на + сенсоры в TCI индивидуальны (RX_SENSORS_ENABLE «отправляется только + клиентом»), поэтому живут здесь, а не в адаптере. } + TTCIClient = class + private + FWs: TWsClient; + FReady: Boolean; // пачка инициализации отправлена + FRxSensors: Boolean; + FRxSensorsMs: Integer; + FRxSensorsAt: QWord; // тик последней отправки + FTxSensors: Boolean; + FTxSensorsMs: Integer; + FTxSensorsAt: QWord; + public + constructor Create(AWs: TWsClient); + { Текстовый фрейм клиенту. False — соединение уже мертво. } + function Send(const S: string): Boolean; + property Ws: TWsClient read FWs; + property Ready: Boolean read FReady write FReady; + property RxSensors: Boolean read FRxSensors write FRxSensors; + property RxSensorsMs: Integer read FRxSensorsMs write FRxSensorsMs; + property RxSensorsAt: QWord read FRxSensorsAt write FRxSensorsAt; + property TxSensors: Boolean read FTxSensors write FTxSensors; + property TxSensorsMs: Integer read FTxSensorsMs write FTxSensorsMs; + property TxSensorsAt: QWord read FTxSensorsAt write FTxSensorsAt; + end; + + TTCIClientEvent = procedure(Client: TTCIClient) of object; + TTCICommandEvent = procedure(Client: TTCIClient; const Cmd: string) of object; + + TTCIServer = class + private + FListenSock: TSocket; + FClients: array[0..TCI_MAX_CLIENTS-1] of TTCIClient; + FClientCount: Integer; + FClientLock: TCriticalSection; + FAcceptThread: TThread; + FTickThread: TThread; + FThreadCount: LongInt; // живых клиентских потоков (Interlocked*) + FRunning: Boolean; + FPort: Word; + FBindIP: string; + FOnCommand: TTCICommandEvent; + FOnConnect: TTCIClientEvent; + FOnDisconnect: TTCIClientEvent; + FOnTick: TThreadMethod; + function InitListen: Boolean; + procedure RemoveClient(Client: TTCIClient); + public + constructor Create; + destructor Destroy; override; + + { Настройка слушателя. Применяется при следующем Start. } + procedure Configure(APort: Word; const ABindIP: string); + + function Start: Boolean; + procedure Stop; + function Running: Boolean; + + { Всем клиентам, прошедшим инициализацию. Skip — кого пропустить + (обычно автора изменения не пропускаем: сервер отвечает и ему тоже, + это и есть подтверждение установки). } + procedure Broadcast(const S: string; Skip: TTCIClient = nil); + + { Обход клиентов под локом — для рассылки с индивидуальным периодом. } + procedure EnumClients(Proc: TTCIClientEvent); + + function ClientCount: Integer; + + { Внутреннее (зовётся потоками сервера). } + procedure AcceptLoop; + procedure TickLoop; + procedure HandleClient(Client: TTCIClient); + procedure ThreadDone; // клиентский поток отработал + + property Port: Word read FPort; + property BindIP: string read FBindIP; + property OnCommand: TTCICommandEvent read FOnCommand write FOnCommand; + property OnConnect: TTCIClientEvent read FOnConnect write FOnConnect; + property OnDisconnect: TTCIClientEvent read FOnDisconnect write FOnDisconnect; + property OnTick: TThreadMethod read FOnTick write FOnTick; + end; + +implementation + +type + TTCIAcceptThread = class(TThread) + private FServer: TTCIServer; + protected procedure Execute; override; + public constructor Create(AServer: TTCIServer); + end; + + TTCITickThread = class(TThread) + private FServer: TTCIServer; + protected procedure Execute; override; + public constructor Create(AServer: TTCIServer); + end; + + TTCIClientThread = class(TThread) + private FServer: TTCIServer; FClient: TTCIClient; + protected procedure Execute; override; + public constructor Create(AServer: TTCIServer; AClient: TTCIClient); + end; + +constructor TTCIAcceptThread.Create(AServer: TTCIServer); +begin + inherited Create(True); + FServer := AServer; + FreeOnTerminate := False; +end; + +procedure TTCIAcceptThread.Execute; +begin + FServer.AcceptLoop; +end; + +constructor TTCITickThread.Create(AServer: TTCIServer); +begin + inherited Create(True); + FServer := AServer; + FreeOnTerminate := False; +end; + +procedure TTCITickThread.Execute; +begin + FServer.TickLoop; +end; + +constructor TTCIClientThread.Create(AServer: TTCIServer; AClient: TTCIClient); +begin + inherited Create(True); + FServer := AServer; + FClient := AClient; + FreeOnTerminate := True; +end; + +procedure TTCIClientThread.Execute; +begin + try + FServer.HandleClient(FClient); + finally + FServer.ThreadDone; // Stop ждёт обнуления счётчика перед зачисткой + end; +end; + +{ IPv4 из строки в сетевом порядке. Свой, потому что WebServer держит такой же + в implementation и наружу не отдаёт. } +function TCIParseIPv4(const S: string): LongWord; +var + Oct: array[0..3] of LongWord; + N, i, Start: Integer; + Part: string; +begin + Result := 0; // INADDR_ANY + if (S = '') or (S = '0.0.0.0') then Exit; + N := 0; + Start := 1; + for i := 1 to Length(S) + 1 do + if (i > Length(S)) or (S[i] = '.') then + begin + if N > 3 then Exit; + Part := Copy(S, Start, i - Start); + Oct[N] := LongWord(StrToIntDef(Part, 0)) and $FF; + Inc(N); + Start := i + 1; + end; + if N <> 4 then Exit; + // Сетевой порядок байт: первый октет — младший байт in_addr. + Result := Oct[0] or (Oct[1] shl 8) or (Oct[2] shl 16) or (Oct[3] shl 24); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + TTCIClient + ═══════════════════════════════════════════════════════════════════════════ } + +constructor TTCIClient.Create(AWs: TWsClient); +begin + inherited Create; + FWs := AWs; + FReady := False; + FRxSensors := False; + FRxSensorsMs := 200; + FTxSensors := False; + FTxSensorsMs := 200; +end; + +function TTCIClient.Send(const S: string): Boolean; +begin + Result := (FWs <> nil) and (FWs.State = wsOpen) and FWs.SendText(S); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + TTCIServer — жизненный цикл + ═══════════════════════════════════════════════════════════════════════════ } + +constructor TTCIServer.Create; +{$IFDEF WINDOWS} +var WSAData: TWSAData; +{$ENDIF} +begin + inherited Create; + {$IFDEF WINDOWS} + WSAStartup($0202, WSAData); // refcounted: свой вызов на каждый сервер + {$ENDIF} + FListenSock := SOCK_INVALID; + FClientCount := 0; + FClientLock := TCriticalSection.Create; + FPort := TCI_DEFAULT_PORT; + FBindIP := '127.0.0.1'; +end; + +destructor TTCIServer.Destroy; +begin + Stop; + FClientLock.Free; + {$IFDEF WINDOWS} + WSACleanup; + {$ENDIF} + inherited; +end; + +procedure TTCIServer.Configure(APort: Word; const ABindIP: string); +begin + FPort := APort; + FBindIP := ABindIP; +end; + +function TTCIServer.Running: Boolean; +begin + Result := FRunning; +end; + +function TTCIServer.InitListen: Boolean; +var + Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; + One: Integer; +begin + Result := False; + {$IFDEF WINDOWS} + FListenSock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); + {$ELSE} + FListenSock := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP); + {$ENDIF} + if FListenSock = SOCK_INVALID then Exit; + + One := 1; + {$IFDEF WINDOWS} + setsockopt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One)); + FillChar(Addr, SizeOf(Addr), 0); + Addr.sin_family := AF_INET; + Addr.sin_port := htons(FPort); + Addr.sin_addr.S_addr := TCIParseIPv4(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(FPort); + Addr.sin_addr.s_addr := TCIParseIPv4(FBindIP); + if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then Exit; + if fpListen(FListenSock, 5) <> 0 then Exit; + {$ENDIF} + Result := True; +end; + +function TTCIServer.Start: Boolean; +begin + Result := False; + if FRunning then Exit; + if not InitListen then + begin + if FListenSock <> SOCK_INVALID then + begin + SockClose(FListenSock); + FListenSock := SOCK_INVALID; + end; + Exit; + end; + FRunning := True; + FAcceptThread := TTCIAcceptThread.Create(Self); + TTCIAcceptThread(FAcceptThread).Start; + FTickThread := TTCITickThread.Create(Self); + TTCITickThread(FTickThread).Start; + Result := True; +end; + +procedure TTCIServer.Stop; +var i, Waited: Integer; +begin + if not FRunning then Exit; + FRunning := False; + + // Шаг 1: гасим listen-сокет. SockShutdown обязателен до close — иначе + // fpAccept в accept-потоке не разблокируется (см. WebServer.Stop). + if FListenSock <> SOCK_INVALID then + begin + SockShutdown(FListenSock); + SockClose(FListenSock); + FListenSock := SOCK_INVALID; + end; + + // Шаг 2: будим клиентские потоки, висящие в recv. + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if FClients[i] <> nil then + begin + FClients[i].Ws.State := wsClosed; + SockShutdown(FClients[i].Ws.Socket); + end; + finally + FClientLock.Leave; + end; + + // Шаг 3: свои потоки (клиентские — FreeOnTerminate, ждём их отдельно). + if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end; + if FTickThread <> nil then begin FTickThread.WaitFor; FreeAndNil(FTickThread); end; + + // Шаг 4: даём клиентским потокам выйти самим. Освобождает клиента ТОТ, + // кто вынул его из массива (RemoveClient в клиентском потоке), — иначе + // Stop освободил бы объект из-под работающего потока. + Waited := 0; + while (FThreadCount > 0) and (Waited < 2000) do + begin + Sleep(10); + Inc(Waited, 10); + end; + + // Вырожденный случай: поток завис (не должно случаться — сокеты закрыты). + // Чистим остатки, чтобы не течь; объекты уже никем не используются. + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if FClients[i] <> nil then + begin + FClients[i].Ws.Free; + FreeAndNil(FClients[i]); + end; + FClientCount := 0; + finally + FClientLock.Leave; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Приём соединений + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIServer.AcceptLoop; +var + CSock: TSocket; + Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; + ALen: {$IFDEF WINDOWS}Integer{$ELSE}TSockLen{$ENDIF}; + Client: TTCIClient; + T: TTCIClientThread; +begin + while FRunning do + begin + ALen := SizeOf(Addr); + {$IFDEF WINDOWS} + CSock := accept(FListenSock, @Addr, @ALen); + {$ELSE} + CSock := fpAccept(FListenSock, @Addr, @ALen); + {$ENDIF} + if CSock = SOCK_INVALID then + begin + if FRunning then Sleep(10); + Continue; + end; + if FClientCount >= TCI_MAX_CLIENTS then + begin + SockClose(CSock); + Continue; + end; + SockSetSndTimeout(CSock, TCI_SEND_TIMEOUT); + Client := TTCIClient.Create(TWsClient.Create(CSock)); + FClientLock.Enter; + try + FClients[FClientCount] := Client; + Inc(FClientCount); + finally + FClientLock.Leave; + end; + InterLockedIncrement(FThreadCount); + T := TTCIClientThread.Create(Self, Client); + T.Start; + end; +end; + +procedure TTCIServer.RemoveClient(Client: TTCIClient); +var i, j: Integer; +begin + if Client = nil then Exit; + if Assigned(FOnDisconnect) then FOnDisconnect(Client); + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if FClients[i] = Client then + begin + for j := i to FClientCount - 2 do FClients[j] := FClients[j + 1]; + FClients[FClientCount - 1] := nil; + Dec(FClientCount); + Break; + end; + finally + FClientLock.Leave; + end; + Client.Ws.Free; // закрывает сокет + Client.Free; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Клиентский поток: handshake + разбор WS-фреймов + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIServer.HandleClient(Client: TTCIClient); +var + Ws: TWsClient; + R, HeaderEnd: Integer; + Header, HeaderLC, Key, AcceptKey, Response, Text: string; + Raw: array[0..4095] of Byte; + RawLen: Integer; + B0, B1: Byte; + Masked: Boolean; + PayLen, Need, i, j, Consumed, KPos, KEnd: Integer; + Mask: array[0..3] of Byte; + Payload: array of Byte; + Opcode: Byte; + Cmds: TStringList; +begin + Ws := Client.Ws; + RawLen := 0; + + // ── HTTP-запрос: ждём конца заголовков ─────────────────────────────────── + Header := ''; + HeaderEnd := 0; + repeat + R := SockRecv(Ws.Socket, @Raw[RawLen], SizeOf(Raw) - RawLen, 0); + if R <= 0 then begin Ws.State := wsClosed; Break; end; + Inc(RawLen, R); + SetLength(Header, RawLen); + Move(Raw[0], Header[1], RawLen); + HeaderEnd := System.Pos(#13#10#13#10, Header); + until (HeaderEnd > 0) or (RawLen >= SizeOf(Raw)); + + if (Ws.State = wsClosed) or (HeaderEnd = 0) then + begin + RemoveClient(Client); Exit; + end; + + Header := Copy(Header, 1, HeaderEnd + 3); + HeaderLC := LowerCase(Header); + + // Путь не проверяем: клиенты ходят на '/', но протокол его не оговаривает. + if System.Pos('upgrade: websocket', HeaderLC) = 0 then + begin + Response := 'HTTP/1.1 426 Upgrade Required'#13#10 + + 'Content-Length: 0'#13#10'Connection: close'#13#10#13#10; + Ws.SendRaw(Response[1], Length(Response)); + RemoveClient(Client); Exit; + end; + + Key := ''; + KPos := System.Pos('sec-websocket-key: ', HeaderLC); + if KPos > 0 then + begin + Key := Copy(Header, KPos + 19, 100); + KEnd := System.Pos(#13, Key); + if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1); + Key := Trim(Key); + end; + AcceptKey := Base64EncodeBytes(SHA1(Key + TCI_WS_GUID), 20); + Response := 'HTTP/1.1 101 Switching Protocols'#13#10 + + 'Upgrade: websocket'#13#10 + + 'Connection: Upgrade'#13#10 + + 'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10; + if not Ws.SendRaw(Response[1], Length(Response)) then + begin + RemoveClient(Client); Exit; + end; + Ws.State := wsOpen; + + // Пачка инициализации + текущее состояние (§3.1) — дело адаптера. + if Assigned(FOnConnect) then FOnConnect(Client); + + // ── Цикл WS-сообщений ──────────────────────────────────────────────────── + Cmds := TStringList.Create; + try + Ws.BufLen := 0; + while FRunning and (Ws.State = wsOpen) do + begin + R := Ws.Recv; + if R <= 0 then Break; + + while Ws.BufLen >= 2 do + begin + B0 := Ws.BufData[0]; + B1 := Ws.BufData[1]; + Opcode := B0 and $0F; + Masked := (B1 and $80) <> 0; + PayLen := B1 and $7F; + + Need := 2; + if PayLen = 126 then Inc(Need, 2) + else if PayLen = 127 then Inc(Need, 8); + if Masked then Inc(Need, 4); + if Ws.BufLen < Need then Break; + + i := 2; + if PayLen = 126 then + begin + PayLen := (Ws.BufData[2] shl 8) or Ws.BufData[3]; + Inc(i, 2); + end + else if PayLen = 127 then + begin + PayLen := (Ws.BufData[6] shl 24) or (Ws.BufData[7] shl 16) or + (Ws.BufData[8] shl 8) or Ws.BufData[9]; + Inc(i, 8); + end; + + // Фрейм крупнее приёмного буфера TWsClient никогда не соберётся — + // BufLen упрётся в потолок и цикл встанет намертво. Рвём соединение: + // команд такой длины у TCI нет, а бинарные потоки от клиента (TX-аудио) + // мы пока не принимаем. + if Need + PayLen > 4096 then + begin + Ws.State := wsClosed; + Break; + end; + + if Ws.BufLen < Need + PayLen then Break; + + if Masked then + begin + Mask[0] := Ws.BufData[i]; Mask[1] := Ws.BufData[i+1]; + Mask[2] := Ws.BufData[i+2]; Mask[3] := Ws.BufData[i+3]; + Inc(i, 4); + end; + + SetLength(Payload, PayLen); + if PayLen > 0 then + begin + Move(Ws.BufData[i], Payload[0], PayLen); + if Masked then + for j := 0 to PayLen - 1 do + Payload[j] := Payload[j] xor Mask[j and 3]; + end; + + Consumed := i + PayLen; + if Ws.BufLen > Consumed then + Move(Ws.BufData[Consumed], Ws.BufData[0], Ws.BufLen - Consumed); + Ws.BufLen := Ws.BufLen - Consumed; + + case Opcode of + $01: // текст — одна или несколько команд в одном фрейме + begin + SetLength(Text, PayLen); + if PayLen > 0 then Move(Payload[0], Text[1], PayLen); + if Assigned(FOnCommand) then + begin + TCISplit(Text, Cmds); + for j := 0 to Cmds.Count - 1 do + FOnCommand(Client, Cmds[j]); + end; + end; + $02: ; // binary: TX-аудио от клиента — этап 2, пока игнорируем + $08: // close + begin + Ws.State := wsClosed; + Break; + end; + $09: // ping → pong + if PayLen > 0 then Ws.SendWsFrame($0A, Payload[0], PayLen) + else Ws.SendWsFrame($0A, PayLen, 0); + end; + end; + end; + finally + Cmds.Free; + end; + + RemoveClient(Client); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Рассылка и обход + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TTCIServer.Broadcast(const S: string; Skip: TTCIClient); +var i: Integer; +begin + if S = '' then Exit; + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if (FClients[i] <> nil) and (FClients[i] <> Skip) and FClients[i].Ready then + FClients[i].Send(S); + finally + FClientLock.Leave; + end; +end; + +procedure TTCIServer.EnumClients(Proc: TTCIClientEvent); +var i: Integer; +begin + if not Assigned(Proc) then Exit; + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if FClients[i] <> nil then Proc(FClients[i]); + finally + FClientLock.Leave; + end; +end; + +procedure TTCIServer.ThreadDone; +begin + InterLockedDecrement(FThreadCount); +end; + +function TTCIServer.ClientCount: Integer; +begin + Result := FClientCount; +end; + +procedure TTCIServer.TickLoop; +begin + while FRunning do + begin + Sleep(TCI_TICK_MS); + if not FRunning then Break; + if (FClientCount > 0) and Assigned(FOnTick) then FOnTick; + end; +end; + +end. diff --git a/doc/TCI Protocol_RU.pdf b/doc/TCI Protocol_RU.pdf new file mode 100644 index 0000000..0eba196 Binary files /dev/null and b/doc/TCI Protocol_RU.pdf differ diff --git a/doc/TCI.md b/doc/TCI.md new file mode 100644 index 0000000..3ef7a0c --- /dev/null +++ b/doc/TCI.md @@ -0,0 +1,221 @@ +# TCI в EWSDR — статус реализации + +Ветка разработки: `feature/tci-protocol`. +Дата последнего обновления: 2026-08-17. + +Эталон протокола — «Протокол TCI, версия 2.0» Expert Electronics +(`doc/TCI Protocol_RU.pdf`, 12 января 2024). EWSDR выступает **сервером** +(как ExpertSDR3): порт слушаем мы, клиенты — логгеры, скиммеры, программы +цифровых видов, внешние усилители и коммутаторы. + +--- + +## 1. Архитектура + +``` +TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ──► TRadioController +логгер/скиммер/цифра транспорт команды + ядро + уведомления +``` + +| Файл | Назначение | +|---|---| +| `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. | +| `TCIServer.pas` (~660 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). | +| `TCIAdapter.pas` (~1100 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители. | + +Принципы те же, что у CAT (см. `doc/CAT_STATUS.md`): + +- **TCI — равноправный клиент контроллера.** Никаких обращений к `MainForm`; + единственное исключение — стор спотов `TDXSpotStore`, который передаётся + адаптеру ссылкой (команды `SPOT`/`SPOT_DELETE`/`SPOT_CLEAR` кладут споты в + ту же базу, что и DX-кластер). +- **Потоки.** Геттеры читают поля контроллера напрямую из потока клиента; + сеттеры пишут параметр в scratch-поля под `FLock` и зовут + `FController.Invoke(SyncXxx)` — исполнение в потоке контроллера + (GUI = `TThread.Synchronize`). +- **Синхронизация клиентов.** Изменение любого поля контроллера приходит в + `OnState` (multicast-подписка `AddStateListener`) и рассылается всем + подключённым — как того требует §3.5 спецификации. Отвечающий на команду + клиент дополнительно получает прямой ответ. + +### 1.1 Настройки + +Секция `tci` в корне `settings.json`: + +```json +"tci": { "enabled": false, "port": 40001, "bind_addr": "127.0.0.1" } +``` + +UI — вкладка **Advanced → TCI Server** (галка, порт, интерфейс). В протоколе +**нет авторизации**: открытый наружу порт означает полный доступ к трансиверу, +поэтому умолчание слушает только петлю. + +### 1.2 Маппинг модели + +| TCI | EWSDR | +|---|---| +| приёмник (`TRX_COUNT`) | панадаптер: 0 = главный тракт, 1.. = доп. DDC-паны. Число = `BackendCaps.MaxPans` | +| канал A/B (`CHANNEL_COUNT` = 2) | у приёмника 0 — VFO A / VFO B; у панов 1.. — первый и второй слайс пана | +| `DDS` | центр панадаптера (`SetCenter` / `SetPanDDCFreq`) | +| `IF` | смещение канала от центра панорамы | +| `VFO` | абсолютная частота канала | +| передатчик (`arg1` у TRX/TUNE/DRIVE) | всегда один — главный тракт | + +--- + +## 2. Что реализовано + +### 2.1 Инициализация (§4.1) + +`PROTOCOL`, `DEVICE`, `RECEIVE_ONLY`, `TRX_COUNT`, `CHANNEL_COUNT`, +`VFO_LIMITS`, `IF_LIMITS`, `MODULATIONS_LIST`, `READY`. + +`READY` шлётся **после** полного дампа состояния: клиент, дождавшийся его, +уже знает всё. Границы частот берутся из `BackendCaps`; пока устройство не +подключено — 10 кГц…30 МГц. `IF_LIMITS` = ±sample rate/2, пересылается при +смене частоты дискретизации. + +Список видов связи: `am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw`. +`dmr`/`fmraw` — наше расширение (протокол расширяемый, §1.4). `CWL`/`CWU` +схлопываются в `cw`; при установке `cw` боковая сохраняется, если уже +телеграф, иначе выбирается по частоте (ниже 10 МГц — CWL). + +### 2.2 Двунаправленное управление (§4.2) + +Полностью проведено в контроллер: + +| Команда | Куда легло | +|---|---| +| `START` / `STOP` | `SetRun` | +| `DDS` | `SetCenter` / `SetPanDDCFreq` | +| `IF`, `VFO` | `SetVfoA/B`, `SetSliceTarget` | +| `MODULATION` | `SetMode` / `SetSliceMode` | +| `TRX` | `SetMOX` | +| `TUNE` | `SetTune` | +| `DRIVE` | `SetDrive` | +| `TUNE_DRIVE` | `FTXSettings.TUNLevel` через `SetTXSettings` | +| `SPLIT_ENABLE` | `SetSplit` | +| `RX_FILTER_BAND` | `SetFilterEdges` / `SetSliceFilter` | +| `VOLUME`, `MUTE` | `SetVolume`, `SetMute` (дБ ↔ 0..100) | +| `RX_MUTE`, `RX_VOLUME` | громкость/мьют слайса | +| `MON_VOLUME`, `MON_ENABLE` | `SetTXMonVolume`, `SetRxMuteOnTx` | +| `AGC_MODE` | `off`→Off, `fast`→Fast, `normal`→Medium | +| `AGC_GAIN` | `SetAGCTop` (AGC-T) | +| `RX_NR_ENABLE`, `RX_NB_ENABLE`, `RX_ANF_ENABLE` | `SetNR/SetNB/SetANF`, для панов — `SetSliceDSP` | +| `LOCK` | `SetVfoLock` | +| `SQL_ENABLE`, `SQL_LEVEL` | FM-шумоподавитель; дБ (-140..0) ↔ порог 0..100 | +| `CW_MACROS_SPEED`, `CW_KEYER_SPEED` | `TCWSettings.Speed` | +| `CW_MACROS_DELAY` | `TCWSettings.RFDelayMS` | + +### 2.3 Однонаправленное управление (§4.3) + +`TX_ENABLE` (по `BackendCaps.HasTX` + `TXProhibited`), `CW_MACROS_SPEED_UP/DOWN`, +`SPOT`, `SPOT_DELETE`, `SPOT_CLEAR` (в `TDXSpotStore`, спот виден на всех +панадаптерах), `RX_SENSORS_ENABLE`, `TX_SENSORS_ENABLE` (период — на клиента), +`IQ_SAMPLERATE`, `AUDIO_SAMPLERATE`, `AUDIO_STREAM_*`, `TX_STREAM_AUDIO_BUFFERING` +(значения принимаются и подтверждаются; сами потоки — этап 2). + +### 2.4 Уведомления (§4.4, §4.5) + +`RX_CHANNEL_SENSORS` + устаревшая `RX_SENSORS` (S-метр в дБм, период 30…1000 мс +на клиента), `TX_SENSORS`, `TX_FREQUENCY`, `VFO_LOCK`, `APP_FOCUS` +(активация/деактивация главного окна), `RX_CLICKED_ON_SPOT` + устаревшая +`CLICKED_ON_SPOT` (клик по подписи спота на любом панадаптере), +`CALLSIGN_SEND` (после `CW_MSG`). + +### 2.5 Телеграф (§3.2) + +`CW_MACROS`, `CW_MSG`, `CW_MACROS_STOP`, `CW_TERMINAL`. + +Текст приводится к тому, что понимает передатчик текста ewsdr (`CWXSend`): +экранирование `^ ~ *` снимается, `CALL$N` разворачивается в N повторов +позывного, префикс/суффикс `_` считаются пустыми. **Не поддержано:** шаг +скорости внутри текста (`<` / `>`) и слитная передача аббревиатур (`|SK|`) — +эти символы просто снимаются, потому что `TCWSender` работает на одной +скорости и не знает прос-знаков. Доотправка позывного (`cw_msg:arg1;`) +игнорируется: уже отданный в очередь текст не редактируется. + +--- + +## 3. Осознанные заглушки («эхо») + +Значения принимаются, хранятся в адаптере и рассылаются клиентам — так +синхронизация между несколькими клиентами остаётся честной, но на радио они +не влияют, потому что соответствующего тракта в EWSDR нет: + +| Команда | Причина | +|---|---| +| `RIT_ENABLE`, `RIT_OFFSET`, `XIT_ENABLE`, `XIT_OFFSET` | расстройки RX/TX в контроллере нет вообще | +| `RX_BIN_ENABLE` | псевдостерео не реализовано | +| `RX_ANC_ENABLE`, `RX_APF_ENABLE`, `RX_DSE_ENABLE`, `RX_NF_ENABLE` | таких блоков в тракте нет | +| `RX_NB_PARAM` | параметры NB в WDSP наружу не выведены | +| `RX_BALANCE` | баланса каналов у слайса нет | +| `DIGL_OFFSET`, `DIGU_OFFSET` | смещения цифровых мод не реализованы | +| `RX_CHANNEL_ENABLE` | канал B главного приёмника — это VFO B, он есть всегда; создание второго слайса на пане по TCI — этап 2 | +| `SET_IN_FOCUS` | окно программы не поднимаем | + +Отдельно: у `TX_SENSORS` второй аргумент — уровень микрофона; измерителя +микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не +рисовал случайные значения. Третий аргумент (RMS) и четвёртый (пик) отдаём +одинаковыми — в телеметрии платы одно значение forward power. + +У `TRX` третий аргумент (источник сигнала `tci`/`mic1`/…) игнорируется: +аудио по TCI ещё нет, модуляция берётся из выбранного в программе входа. + +--- + +## 4. Этап 2 — бинарные потоки (§3.4) + +Не реализовано ничего из потоков; команды управления ими принимаются, но +данные не идут. Что нужно сделать: + +1. **Заголовок блока** уже описан — `TTCIStreamHeader` в `TCIProtocol.pas` + (16 × uint32 + сэмплы). +2. **`RX_AUDIO_STREAM`** — нужен multicast-тап RX-аудио в контроллере. + Сейчас есть только `OnAudioConsume` — одиночный перехват, которым владеет + веб-адаптер (он же глушит локальный звук). Для TCI нужен именно тап + «послушать, не забирая», по образцу `AddStateListener`. +3. **`TX_AUDIO_STREAM` + `TX_CHRONO`** — приём бинарных фреймов от клиента + (сейчас `TCIServer` их отбрасывает; приёмный буфер `TWsClient` — 4 КБ, под + 16 КБ блоков его придётся растить) и подача в TX-тракт наравне с + веб-микрофоном (`PushMicSamples`). +4. **`IQ_STREAM`** — тап сырого IQ в `TWDSPEngine.PushIQItemToDSP` (как у + декодера маяка), с децимацией до `IQ_SAMPLERATE` (48/96/192/384 кГц). +5. **`LINEOUT_STREAM` + `LINE_OUT_RECORDER_*`** — запись в WAV/MP3. + +Также в очереди: `RX_CHANNEL_ENABLE` как реальное создание/удаление второго +слайса пана и `SET_IN_FOCUS`. + +--- + +## 5. Проверено + +Стендом (WS-клиент на сыром сокете, без внешних библиотек): + +- **Транспорт:** handshake, маска входящих фреймов, несколько команд в одном + фрейме, регистронезависимость, экранированный текст, ping/pong, игнорирование + бинарных фреймов, рассылка всем клиентам, чистая остановка сервера с живым + клиентом (потоки дренируются, зависаний нет). +- **Сквозной прогон** с настоящим `TRadioController` (движки созданы, железо не + подключено): пачка инициализации из 57 строк со всеми обязательными + командами и `READY` в конце; `VFO`, `MODULATION` (`cw` на 7 МГц дал CWL), + `RX_FILTER_BAND`, `DRIVE`, `VOLUME`, `MUTE`, `AGC_GAIN`, `LOCK`, + `CW_MACROS_SPEED`, `SPOT`, `RIT_*` — состояние контроллера после прогона + совпало с посланным; чтение (`vfo:0,1;`) отвечает; `RX_SENSORS_ENABLE:true,100` + даёт поток `rx_channel_sensors` с заданным периодом. +- **Устойчивость:** исключение в обработке команды не рвёт соединение — клиенту + уходит `tci_error:<команда>,<сообщение>;`, остальные команды продолжают + работать (проверено на контроллере без движков, где `SetMode`/`SetCWSettings` + падают с AV на неинициализированном `FNetwork`). + +Сборка: `lazbuild -B --ws=qt6 ewsdr.lpr` и `./build-ewsdrd.sh` (демон собирается, +TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в +`ewsdrd.lpr`, как web). + +**На реальном железе и с реальным клиентом (Log4OM/N1MM/WSJT-X/CW Skimmer) не +проверялось.** + +Ответ на команду-установку клиент получает дважды: прямым ответом и рассылкой +из `OnState`. Это осознанно — дубли идемпотентны, а рассылка нужна для тех +случаев, когда значение поменял не клиент, а оператор.