unit TCIAdapter; { TCIAdapter.pas — мост TCI ↔ TRadioController. Роль та же, что у TCATAdapter в CAT-подсистеме: равноправный клиент контроллера, никаких обращений к MainForm. TCI-клиенты ──WS──► TTCIServer ──► TTCIAdapter ──► TRadioController логгер/скиммер транспорт команды/ ядро уведомления Потоки: • Геттеры читают поля контроллера напрямую из потока клиента (атомарное чтение, как в CAT). • Сеттеры пишут параметр в scratch-поля под FLock и зовут if CanInvoke then 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; // ── Эхо-состояние (пишут потоки клиентов ⇒ только под FEchoLock) ── FEchoLock: TCriticalSection; FEcho: array[0..TCI_MAX_RX-1] of TTCIRxEcho; FDiglOffset: Integer; FDiguOffset: Integer; FCwTerminal: Boolean; // ── Кэш для подавления повторов в уведомлениях ── FLastTxFreq: Double; FLastTxEnable: Boolean; FOnFocusRequest: TThreadMethod; // ── 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; procedure SyncFocus; // ── Помощники модели ── function CanInvoke: Boolean; function RxCount: Integer; function ValidRx(Rx: Integer): Boolean; function SliceIdOf(Rx, Ch: Integer): Integer; function RxSlice(Rx: Integer; out S: TCtrlSlice): Boolean; function SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; 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, Ch: Integer): Double; function RxAGCUi(Rx: Integer): Integer; function RxNROn(Rx: Integer): Boolean; function RxNBOn(Rx: Integer): Boolean; function RxANFOn(Rx: Integer): Boolean; function RxSqlOn(Rx: Integer): Boolean; function RxSqlLevel(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; function StrRxVolume(Rx, Ch: Integer): string; function StrNR(Rx: Integer): string; function StrNB(Rx: Integer): string; function StrANF(Rx: Integer): string; { Полный набор строк по приёмнику — рассылка после правки слайса. } procedure BroadcastRxState(Rx, Ch: Integer); 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: включение/порт/адрес. Зовётся при старте и из настроек. False — включить просили, а порт не открылся (занят/нет прав/кривой адрес): вызывающий обязан сказать это оператору, иначе тот останется с галкой «включено» и мёртвым сервером. } function ApplySettings(const T: TTCISettings): Boolean; 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; { SET_IN_FOCUS (§4.3): клиент просит поднять окно программы. Ставит UI; вызывается в потоке контроллера. nil — команда игнорируется. } property OnFocusRequest: TThreadMethod read FOnFocusRequest write FOnFocusRequest; end; implementation { ═══════════════════════════════════════════════════════════════════════════ Жизненный цикл ═══════════════════════════════════════════════════════════════════════════ } constructor TTCIAdapter.Create(AController: TRadioController; ASpots: TDXSpotStore); var i, c: Integer; begin inherited Create; FController := AController; FSpots := ASpots; FLock := TCriticalSection.Create; FEchoLock := 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; 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; FEchoLock.Free; inherited; end; function TTCIAdapter.ApplySettings(const T: TTCISettings): Boolean; begin FServer.Stop; if not T.Enabled then Exit(True); // Адрес разбирается ДО открытия сокета: невалидный означает отказ, а не // «слушаем все интерфейсы» — авторизации в TCI нет (см. TCIParseIPv4). Result := FServer.Configure(Word(EnsureRange(T.Port, 1, 65535)), T.BindAddr) and FServer.Start; end; function TTCIAdapter.CanInvoke: Boolean; // Пока сервер останавливается, новых вызовов в поток контроллера не начинаем: // останавливает нас как раз он (UI), и Synchronize из потока клиента в него // уже не вернётся. begin Result := (FController <> nil) and ((FServer = nil) or not FServer.Stopping); 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.RxSlice(Rx: Integer; out S: TCtrlSlice): Boolean; // Слайс, представляющий приёмник Rx как целое (канал A). Для Rx=0 слайса нет: // главный тракт живёт в полях контроллера. var Id: Integer; begin Result := False; FillChar(S, SizeOf(S), 0); if Rx <= 0 then Exit; Id := SliceIdOf(Rx, 0); if Id <= 0 then Exit; Result := FController.GetSlice(Id, S); end; function TTCIAdapter.SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; // Обратное отображение слайс → (приёмник, канал). Нужно уведомлениям: контроллер // сообщает об изменении Id, а клиенту адресуются номера TCI. var i, Seen: Integer; Pan: Integer; begin Result := False; Rx := 0; Ch := 0; if Id <= 0 then Exit; Pan := -1; for i := 0 to MAX_SLICES - 1 do if FController.FSlices[i].Active and (FController.FSlices[i].Id = Id) then begin Pan := FController.FSlices[i].PanId; Break; end; // Пан 0 в модели TCI — это VFO A/B главного приёмника, а не его слайсы: // слайсу на главном пане в протоколе места нет. if (Pan <= 0) or not ValidRx(Pan) then Exit; Seen := 0; for i := 0 to MAX_SLICES - 1 do if FController.FSlices[i].Active and (FController.FSlices[i].PanId = Pan) then begin if FController.FSlices[i].Id = Id then begin Rx := Pan; Ch := Seen; Exit(Seen < TCI_CHANNELS); 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, Ch: Integer): Double; // Громкость в TCI — величина канальная: у доп. пана второй слайс звучит своей. var S: TCtrlSlice; Id: Integer; begin if Rx = 0 then begin Result := TCIVolumeToDb(FController.FVolume); Exit; end; Result := TCI_VOL_MIN_DB; Id := SliceIdOf(Rx, Ch); 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; // DSP и шумоподавитель: у доп. приёмника своё состояние (зеркало в TCtrlSlice). // Читать тут глобальные поля главного тракта нельзя — клиент увидел бы чужие // переключатели и, что хуже, записал бы их обратно. function TTCIAdapter.RxNROn(Rx: Integer): Boolean; var S: TCtrlSlice; begin if Rx = 0 then Result := FController.FNRMode > 0 else Result := RxSlice(Rx, S) and (S.NRMode > 0); end; function TTCIAdapter.RxNBOn(Rx: Integer): Boolean; var S: TCtrlSlice; begin if Rx = 0 then Result := FController.FNBMode > 0 else Result := RxSlice(Rx, S) and (S.NBMode > 0); end; function TTCIAdapter.RxANFOn(Rx: Integer): Boolean; var S: TCtrlSlice; begin if Rx = 0 then Result := FController.FANF else Result := RxSlice(Rx, S) and S.ANF; end; function TTCIAdapter.RxSqlOn(Rx: Integer): Boolean; var S: TCtrlSlice; begin if Rx = 0 then Result := FController.FFMSQOn else Result := RxSlice(Rx, S) and S.FMSQOn; end; function TTCIAdapter.RxSqlLevel(Rx: Integer): Integer; var S: TCtrlSlice; begin if Rx = 0 then begin Result := FController.FFMSQLevel; Exit; end; if RxSlice(Rx, S) then Result := S.FMSQLevel else Result := 0; 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(RxSqlOn(Rx))]); end; function TTCIAdapter.StrSqlLevel(Rx: Integer): string; begin Result := TCIBuild('sql_level', [TCIIntStr(Rx), TCIIntStr(Round(TCILevelToSql(RxSqlLevel(Rx))))]); end; function TTCIAdapter.StrTxEnable(Rx: Integer): string; begin Result := TCIBuild('tx_enable', [TCIIntStr(Rx), TCIBoolStr(TxEnabled)]); end; function TTCIAdapter.StrRxVolume(Rx, Ch: Integer): string; begin Result := TCIBuild('rx_volume', [TCIIntStr(Rx), TCIIntStr(Ch), TCIIntStr(Round(RxVolumeDb(Rx, Ch)))]); end; function TTCIAdapter.StrNR(Rx: Integer): string; begin Result := TCIBuild('rx_nr_enable', [TCIIntStr(Rx), TCIBoolStr(RxNROn(Rx))]); end; function TTCIAdapter.StrNB(Rx: Integer): string; begin Result := TCIBuild('rx_nb_enable', [TCIIntStr(Rx), TCIBoolStr(RxNBOn(Rx))]); end; function TTCIAdapter.StrANF(Rx: Integer): string; begin Result := TCIBuild('rx_anf_enable', [TCIIntStr(Rx), TCIBoolStr(RxANFOn(Rx))]); end; procedure TTCIAdapter.BroadcastRxState(Rx, Ch: Integer); // Слайс перенастроили (кто угодно: TCI, CAT, оператор мышью) — синхронизируем // всех клиентов. Канал B доп. пана в протоколе несёт только частоту и // громкость: вид связи, фильтр, АРУ и шумодавы в TCI — свойства приёмника // целиком, и относятся к каналу A. begin if (FServer = nil) or (FServer.ClientCount = 0) then Exit; FServer.Broadcast(StrVfo(Rx, Ch)); FServer.Broadcast(StrIf(Rx, Ch)); FServer.Broadcast(StrRxVolume(Rx, Ch)); if Ch <> 0 then Exit; FServer.Broadcast(StrModulation(Rx)); FServer.Broadcast(StrFilterBand(Rx)); FServer.Broadcast(StrAGCMode(Rx)); FServer.Broadcast(TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))])); FServer.Broadcast(StrNR(Rx)); FServer.Broadcast(StrNB(Rx)); FServer.Broadcast(StrANF(Rx)); FServer.Broadcast(StrSqlEnable(Rx)); FServer.Broadcast(StrSqlLevel(Rx)); 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, Chans: Integer; E: TTCIRxEcho; begin for Rx := 0 to RxCount - 1 do begin FEchoLock.Enter; try E := FEcho[Rx]; finally FEchoLock.Leave; end; Reply(Client, StrDds(Rx)); // Только реально существующие каналы: объявив пану второй канал, которого // нет, мы отдали бы клиенту vfo:rx,1,0 — и он принял бы ноль за частоту. Chans := ChanCount(Rx); if Chans < 1 then Chans := 1; for Ch := 0 to Chans - 1 do begin Reply(Client, StrVfo(Rx, Ch)); Reply(Client, StrIf(Rx, Ch)); Reply(Client, StrRxVolume(Rx, Ch)); Reply(Client, TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch), TCIIntStr(E.BalanceDb[Ch])])); end; Reply(Client, TCIBuild('rx_channel_enable', [TCIIntStr(Rx), '1', TCIBoolStr(Chans > 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, StrNB(Rx)); Reply(Client, TCIBuild('rx_nb_param', [TCIIntStr(Rx), TCIIntStr(E.NBThreshold), TCIIntStr(E.NBDuration)])); Reply(Client, StrNR(Rx)); Reply(Client, StrANF(Rx)); Reply(Client, TCIBuild('rx_bin_enable', [TCIIntStr(Rx), TCIBoolStr(E.BinOn)])); Reply(Client, TCIBuild('rx_anc_enable', [TCIIntStr(Rx), TCIBoolStr(E.ANCOn)])); Reply(Client, TCIBuild('rx_apf_enable', [TCIIntStr(Rx), TCIBoolStr(E.APFOn)])); Reply(Client, TCIBuild('rx_dse_enable', [TCIIntStr(Rx), TCIBoolStr(E.DSEOn)])); Reply(Client, TCIBuild('rx_nf_enable', [TCIIntStr(Rx), TCIBoolStr(E.NFOn)])); Reply(Client, StrLock(Rx)); Reply(Client, StrSqlEnable(Rx)); Reply(Client, StrSqlLevel(Rx)); Reply(Client, TCIBuild('rit_enable', [TCIIntStr(Rx), TCIBoolStr(E.RitOn)])); Reply(Client, TCIBuild('rit_offset', [TCIIntStr(Rx), TCIIntStr(E.RitHz)])); Reply(Client, TCIBuild('xit_enable', [TCIIntStr(Rx), TCIBoolStr(E.XitOn)])); Reply(Client, TCIBuild('xit_offset', [TCIIntStr(Rx), TCIIntStr(E.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)])); FEchoLock.Enter; try Reply(Client, TCIBuild('digl_offset', [TCIIntStr(FDiglOffset)])); Reply(Client, TCIBuild('digu_offset', [TCIIntStr(FDiguOffset)])); finally FEchoLock.Leave; end; Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)])); Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)])); 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 begin FController.SetSliceTarget(Id, FsFreq); // Уведомление контроллера: без него о перестройке слайса не узнают ни UI // (флаг остался бы со старыми цифрами), ни остальные клиенты TCI. FController.SliceFreqChanged(Id); end; 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, FsInt3); // FsInt3 — канал: у слайсов громкость своя 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; // DSP слайса ставится одной командой на все четыре блока, поэтому остальные три // берём из САМОГО слайса. Подставлять сюда поля главного тракта (как было) // значило бы: включил клиент NR на доп. приёмнике — и заодно переписал ему NB, // SNB и ANF значениями главного. procedure TTCIAdapter.SyncSetNR; var Id: Integer; S: TCtrlSlice; 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) and FController.GetSlice(Id, S) then FController.SetSliceDSP(Id, Ord(FsBool), S.NBMode, S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetNB; var Id: Integer; S: TCtrlSlice; 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) and FController.GetSlice(Id, S) then FController.SetSliceDSP(Id, S.NRMode, Ord(FsBool), S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetANF; var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin FController.SetANF(FsBool); Exit; end; Id := SliceIdOf(FsInt, 0); if (Id > 0) and FController.GetSlice(Id, S) then FController.SetSliceDSP(Id, S.NRMode, S.NBMode, S.SNB, FsBool); end; procedure TTCIAdapter.SyncSetLock; begin FController.SetVfoLock(FsBool); end; // Squelch слайса — тоже парный сеттер: второй параметр берём из слайса, а не // из главного тракта (иначе правка порога сбрасывала бы включение, и наоборот). procedure TTCIAdapter.SyncSetSql; var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin FController.SetFMSquelch(FsBool); Exit; end; Id := SliceIdOf(FsInt, 0); if (Id > 0) and FController.GetSlice(Id, S) then FController.SetSliceFMSquelch(Id, FsBool, S.FMSQLevel); end; procedure TTCIAdapter.SyncSetSqlLevel; var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin FController.SetFMSquelchLevel(FsInt2); Exit; end; Id := SliceIdOf(FsInt, 0); if (Id > 0) and FController.GetSlice(Id, S) then FController.SetSliceFMSquelch(Id, S.FMSQOn, 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.SyncFocus; // SET_IN_FOCUS: поднять окно программы. Само окно адаптеру недоступно (он // равноправный клиент контроллера) — действие ставит UI через OnFocusRequest. begin if Assigned(FOnFocusRequest) then FOnFocusRequest; 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; if CanInvoke then 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; if CanInvoke then 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; if CanInvoke then FController.Invoke(SyncSetRun); finally FLock.Leave; end; Exit; end; if M.Name = 'STOP' then begin FLock.Enter; try FsBool := False; if CanInvoke then 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; if CanInvoke then 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; if CanInvoke then 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); if CanInvoke then 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); if CanInvoke then 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); if CanInvoke then 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); if CanInvoke then 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); if CanInvoke then 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); if CanInvoke then 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)); if CanInvoke then 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); if CanInvoke then 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); if CanInvoke then 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)); FsInt3 := Ch; if CanInvoke then FController.Invoke(SyncSetRxVolume); finally FLock.Leave; end; end; Reply(Client, StrRxVolume(Rx, Ch)); 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; FEchoLock.Enter; try if M.ArgCount >= 3 then FEcho[Rx].BalanceDb[Ch] := EnsureRange(TCIArgInt(M, 2, 0), -40, 40); V := FEcho[Rx].BalanceDb[Ch]; finally FEchoLock.Leave; end; FServer.Broadcast(TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch), TCIIntStr(V)])); Exit; end; if M.Name = 'MON_VOLUME' then begin if M.ArgCount >= 1 then begin FLock.Enter; try FsInt := TCIDbToVolume(TCIArgFloat(M, 0, -60)); if CanInvoke then 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); if CanInvoke then 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; if CanInvoke then 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; // AGC-T (порог АРУ) в ewsdr один на приёмный тракт: у слайса своего нет. // Правка от имени доп. приёмника трогала бы главный — не делаем этого, // просто отвечаем текущим значением (ограничение, см. doc/TCI.md). if (M.ArgCount >= 2) and (Rx = 0) then begin FLock.Enter; try FsInt := EnsureRange(TCIArgInt(M, 1, 0), TCI_AGC_MIN_DB, TCI_AGC_MAX_DB); if CanInvoke then 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 if CanInvoke then FController.Invoke(SyncSetNR) else if M.Name = 'RX_NB_ENABLE' then if CanInvoke then FController.Invoke(SyncSetNB) else if CanInvoke then FController.Invoke(SyncSetANF); finally FLock.Leave; end; end; if M.Name = 'RX_NR_ENABLE' then Reply(Client, StrNR(Rx)) else if M.Name = 'RX_NB_ENABLE' then Reply(Client, StrNB(Rx)) else Reply(Client, StrANF(Rx)); Exit; end; if M.Name = 'RX_NB_PARAM' then begin Rx := TCIArgInt(M, 0, -1); if not ValidRx(Rx) then Exit; FEchoLock.Enter; try 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; V := FEcho[Rx].NBThreshold; Ch := FEcho[Rx].NBDuration; finally FEchoLock.Leave; end; FServer.Broadcast(TCIBuild('rx_nb_param', [TCIIntStr(Rx), TCIIntStr(V), TCIIntStr(Ch)])); 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); FEchoLock.Enter; try 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; finally FEchoLock.Leave; end; 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); if CanInvoke then 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); if CanInvoke then 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)); if CanInvoke then 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; FEchoLock.Enter; try 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; finally FEchoLock.Leave; end; 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; FEchoLock.Enter; try 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; finally FEchoLock.Leave; end; 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 begin FEchoLock.Enter; try FEcho[Rx].ChannelBOn := TCIArgBool(M, 2, False); finally FEchoLock.Leave; end; end; B := 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 FEchoLock.Enter; try 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; finally FEchoLock.Leave; end; 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); if CanInvoke then 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); if CanInvoke then 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); if CanInvoke then 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 if CanInvoke then FController.Invoke(SyncCWStop); finally FLock.Leave; end; Exit; end; if M.Name = 'CW_TERMINAL' then begin FEchoLock.Enter; try FCwTerminal := TCIArgBool(M, 0, False); B := FCwTerminal; finally FEchoLock.Leave; end; FServer.Broadcast(TCIBuild('cw_terminal', [TCIBoolStr(B)])); 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; // Поднять окно программы (§4.3). Через UI: адаптер до окна не дотягивается. if M.Name = 'SET_IN_FOCUS' then begin FLock.Enter; try if CanInvoke then FController.Invoke(SyncFocus); finally FLock.Leave; end; Exit; end; // ── Параметры потоков ── // Это настройки КЛИЕНТА (§4.3), а не устройства: два логгера вправе просить // разную частоту дискретизации. Поэтому живут в его объекте, а не в адаптере // — иначе один клиент перенастраивал бы будущие потоки всем остальным. // Сами потоки — этап 2, значения только принимаются и подтверждаются. if M.Name = 'IQ_SAMPLERATE' then begin if M.ArgCount >= 1 then Client.IQRate := TCIArgInt(M, 0, Client.IQRate); Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)])); Exit; end; if M.Name = 'AUDIO_SAMPLERATE' then begin if M.ArgCount >= 1 then Client.AudioRate := TCIArgInt(M, 0, Client.AudioRate); Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)])); Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLES' then begin Client.AudioSamples := EnsureRange(TCIArgInt(M, 0, Client.AudioSamples), 100, 2048); Exit; end; if M.Name = 'AUDIO_STREAM_CHANNELS' then begin Client.AudioChannels := EnsureRange(TCIArgInt(M, 0, Client.AudioChannels), 1, 2); Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then begin Client.AudioSampleType := LowerCase(TCIArg(M, 0)); Exit; end; if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then begin Client.TxBuffering := EnsureRange(TCIArgInt(M, 0, Client.TxBuffering), 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, Ch: 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: // Центр пана уехал: у его каналов изменилась и IF (она отсчитывается // от центра), хотя абсолютная частота могла остаться прежней. for Rx := 1 to RxCount - 1 do if FController.PanDDCActive(Rx) then begin FServer.Broadcast(StrDds(Rx)); for Ch := 0 to ChanCount(Rx) - 1 do FServer.Broadcast(StrIf(Rx, Ch)); end; rfSliceFreq, rfSliceState: // Кто именно изменился — в FSliceFreqId: рассылать состояние канала 0 // всех панов (как было) значило бы врать про второй слайс. if SliceRxCh(FController.FSliceFreqId, Rx, Ch) then BroadcastRxState(Rx, Ch); 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.