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. Бинарные потоки (§3.4) живут в TCIStreams; здесь — только их подключение к контроллеру: тап RX-аудио (два вида: до громкости — «аудиопоток приёмника», после неё — «линейный выход»), тап сырого IQ в движке, приём TX-аудио от клиента и маркеры TX_CHRONO. Данные перемалывает DSP-поток, поэтому вся работа с потоками — под FStreamLock и без единого ожидания. } {$IFDEF FPC} {$MODE Delphi} {$LONGSTRINGS ON} {$ENDIF} interface uses Classes, SysUtils, DateUtils, Math, SyncObjs, RadioController, RadioBackend, WDSPEngine, Settings, DXSpotStore, TCIProtocol, TCIServer, TCIStreams; const TCI_MAX_RX = MAX_PANS; // приёмник TCI = панадаптер // Аудио на выходе движка всегда 48 кГц (TWDSPEngine.Create), от него и // считаются все прореживания и пересчёты потоков. TCI_AUDIO_ENGINE_RATE = 48000; // Потолок разворота одного блока TX-аудио в 48 кГц: 8192 отсчёта int16 на // 8 кГц дают ×6. Больше в блок не влезает по протоколу (data[16384]). TCI_TX_OUT_MAX = (TCI_STREAM_DATA_MAX div 2) * 6; // Захват параметра клиентом (§3.5): пока владелец его крутит, остальные // могут только слушать. Без этого два логгера перетягивают частоту друг у // друга бесконечно. TCI_HOLD_MS = 200; TCI_HOLD_SLOTS = 64; 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; { Снимок «железной» части контроллера: всё, ради чего иначе пришлось бы трогать FNetwork из потока клиента. Backend живёт в UI-потоке и на смене устройства освобождается — чтение его Caps и имени платы (а это ещё и строки) из чужого потока даёт обращение к освобождённой памяти. } TTCIDevSnap = record DevName: string; // копия, принадлежит адаптеру LimLoHz: Double; // границы настройки (VFO_LIMITS и проверка команд) LimHiHz: Double; MaxPans: Integer; SampleRate: Integer; HasTX: Boolean; end; { Запись снимка таблицы слайсов: то, что сетевым потокам разрешено читать. } TTCISliceSnap = record Used: Boolean; V: TSliceView; end; { Захваченный параметр (§3.5): кто им сейчас управляет и когда трогал. Owner = nil — изменение пришло не от клиента (оператор, CAT, бэнд-логика). } TTCIHold = record Key: string; Owner: TTCIClient; At: QWord; end; TTCIAdapter = class private FController: TRadioController; FSpots: TDXSpotStore; // может быть nil (демон/тесты) FServer: TTCIServer; FLock: TCriticalSection; FCfg: TTCISettings; // применённая конфигурация (для отката) // ── Эхо-состояние (пишут потоки клиентов ⇒ только под FEchoLock) ── FEchoLock: TCriticalSection; FEcho: array[0..TCI_MAX_RX-1] of TTCIRxEcho; FDiglOffset: Integer; FDiguOffset: Integer; FCwTerminal: Boolean; // ── Снимок железа: пишет поток контроллера, читают сетевые ── FDevLock: TCriticalSection; FDevSnap: TTCIDevSnap; // ── Снимок слайсов: пишет поток контроллера, читают сетевые ── FSliceLock: TCriticalSection; FSliceSnap: array[0..MAX_SLICES-1] of TTCISliceSnap; // ── Захват параметров клиентами (§3.5) ── FHoldLock: TCriticalSection; FHolds: array[0..TCI_HOLD_SLOTS-1] of TTCIHold; FHoldCount: Integer; // ── Бинарные потоки (§3.4) ── // Список исходящих потоков и рекордеры живут под ОДНИМ локом: их читает // DSP-поток (тап аудио/IQ), а меняют потоки клиентов. Порядок захвата // всегда FSliceLock → FStreamLock: тап сначала выясняет, чей это слайс, // и только потом ищет подписчиков. Обратный порядок дал бы клин. FStreamLock: TCriticalSection; FStreams: array of TTCIStreamOut; FRec: array[0..TCI_MAX_RX-1] of TTCIRecorder; FTapsOn: Boolean; // тапы навешены на контроллер/движок // ── TX-аудио от клиента (§3.4) ── FTxLock: TCriticalSection; FTxClient: TTCIClient; // кто модулирует (nil — никто) FTrxOwner: TTCIClient; // кто поставил трансивер в эфир (§4.2) FTxInterp: TTCIInterpolator; FTxInRate: Integer; // частота дискретизации подачи клиента FTxRunning: Boolean; // маркеры TX_CHRONO идут FTxOwed: Double; // сколько сэмплов клиент нам «должен» FTxLastMs: QWord; // Рабочие буферы разбора TX-блока. Полем, а не на стеке: развёрнутый в // 48 кГц блок — это сотни килобайт, и класть их в стек потока клиента // (да ещё на каждый блок двадцать раз в секунду) незачем. FTxRaw: array of Single; FTxMono: array of Single; FTxOut: array of Double; // ── Кэш для подавления повторов в уведомлениях ── FLastLimLo: Double; // последние разосланные VFO_LIMITS (поток контроллера) FLastLimHi: Double; FLastTxFreq: Double; FLastTxEnable: Boolean; FAppFocus: Boolean; // последнее, что сказал UI (для пачки состояния) FOnFocusRequest: TThreadMethod; // ── scratch для маршалинга в поток контроллера ── FsFreq: Double; FsInt: Integer; FsInt2: Integer; FsInt3: Integer; FsBool: Boolean; FsBool2: Boolean; FsStr: string; // ── Sync-методы (поток контроллера) ── procedure SyncSetVfo; procedure SyncSetCenter; procedure SyncSetMode; procedure SyncSetFilter; procedure SyncSetTRX; procedure SyncStopTRX; 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; procedure SyncTaps; // навесить/снять тапы аудио и IQ // ── Бинарные потоки ── function FindStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer): TTCIStreamOut; // под FStreamLock procedure StartStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer); procedure StopStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer); procedure DropClientStreams(C: TTCIClient); procedure RestartStreams(C: TTCIClient; K: TTCIStreamType); procedure DropDeadRxStreams; // приёмник исчез — гасим его потоки function EffIQRate(C: TTCIClient): Integer; // что реально отдадим procedure PushIQRate(Client: TTCIClient); // переобъявить её клиенту procedure StopAllStreams; procedure SetTaps(On_: Boolean); // поток контроллера function HasAudioStream(C: TTCIClient): Boolean; function StreamRxOf(PanId, SliceId: Integer): Integer; // −1 = не наш канал procedure OnAudioTap(Kind: TRadioAudioKind; PanId, SliceId: Integer; const Left, Right: array of Single; Count: Integer); procedure OnIQTap(PanId: Integer; PI_, PQ_: PDouble; N, RateHz: Integer); procedure HandleBinary(Client: TTCIClient; Data: PByte; Len: Integer); procedure PushTxChrono; // тик: маркеры времени клиенту procedure CmdStream(Client: TTCIClient; const M: TTCIMessage); procedure CmdRecorder(Client: TTCIClient; const M: TTCIMessage); procedure ClearTxClient(C: TTCIClient); // клиент ушёл/перестал модулировать procedure StopTxOf(C: TTCIClient); // ★снять эфир, начатый этим клиентом procedure ForgetTxOwner; // передача кончилась не по TCI // ── Помощники модели ── function CanInvoke: Boolean; function RxCount: Integer; function ValidRx(Rx: Integer): Boolean; function RxActive(Rx: Integer): Boolean; procedure CalcFreqLimits(out LoHz, HiHz: Double); // живые (поток контроллера) procedure FreqLimits(out LoHz, HiHz: Double); // из снимка (любой поток) function FreqSaneLive(Hz: Double): Boolean; // проверка перед установкой procedure PushVfoLimits; // разослать VFO_LIMITS, если границы уехали function FreqSane(Hz: Double): Boolean; procedure RefreshDev; // снимок железа (поток контроллера) function DevSnap: TTCIDevSnap; procedure RefreshSlices; // снимок таблицы слайсов (поток контроллера) function SliceMapSig: string; // «кто где стоит»: для детекта появления/ухода procedure PushChannelMap; // каналы приёмников появились/исчезли function SnapSlice(Rx, Ch: Integer; out V: TSliceView): Boolean; function SliceIdOf(Rx, Ch: Integer): Integer; // из снимка function SliceIdLive(Rx, Ch: Integer): Integer; // из живой таблицы (Sync*) function RxSlice(Rx: Integer; out S: TSliceView): Boolean; function SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; { Захват параметра (§3.5). True — параметр наш (свободен, наш или отпущен по таймауту), захват продлевается. False — им сейчас управляет другой. } function Claim(const Key: string; Owner: TTCIClient): Boolean; function HoldKey(const Name: string; Rx, Ch: Integer): string; procedure DropHolds(Owner: TTCIClient); 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 HandleDisconnect(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; FLastLimLo := 0; FLastLimHi := 0; FLastTxFreq := 0; FLastTxEnable := True; FAppFocus := True; FDevLock := TCriticalSection.Create; FSliceLock := TCriticalSection.Create; FillChar(FSliceSnap, SizeOf(FSliceSnap), 0); FHoldLock := TCriticalSection.Create; FHoldCount := 0; FStreamLock := TCriticalSection.Create; FTxLock := TCriticalSection.Create; FTapsOn := False; SetLength(FTxRaw, TCI_STREAM_DATA_MAX div 2); // худший случай: int16 SetLength(FTxMono, TCI_STREAM_DATA_MAX div 2); SetLength(FTxOut, TCI_TX_OUT_MAX); FServer := TTCIServer.Create; FServer.OnCommand := HandleCommand; FServer.OnBinary := HandleBinary; FServer.OnConnect := HandleConnect; FServer.OnDisconnect := HandleDisconnect; FServer.OnTick := HandleTick; RefreshDev; // Первый снимок — прямо здесь: конструктор идёт в потоке контроллера, а // слайсы могли быть восстановлены ещё до появления адаптера (события об их // создании мы уже не увидим). RefreshSlices; // Многоадресная подписка: OnStateChanged занят MainForm. FController.AddStateListener(OnState); end; destructor TTCIAdapter.Destroy; begin // Сначала отписка: контроллер живёт дольше адаптера, и Changed() после // нашей смерти позвал бы метод освобождённого объекта. По той же причине // ПЕРВЫМИ снимаем тапы аудио/IQ — их зовёт DSP-поток, который переживёт нас. SetTaps(False); if FController <> nil then FController.RemoveStateListener(OnState); if FServer <> nil then begin FServer.Stop; FreeAndNil(FServer); end; // Потоки — уже после остановки сервера: их объекты ссылаются на клиентов. StopAllStreams; FreeAndNil(FTxInterp); FLock.Free; FEchoLock.Free; FDevLock.Free; FSliceLock.Free; FHoldLock.Free; FStreamLock.Free; FTxLock.Free; inherited; end; function TTCIAdapter.ApplySettings(const T: TTCISettings): Boolean; // Порядок важен: сначала проверяем новую конфигурацию, и только потом гасим // работающий сервер. Иначе опечатка в адресе или занятый порт оставляли // оператора вообще без TCI — старый слушатель уже закрыт, новый не открылся. // Не удалось поднять новый — возвращаемся на прежний. var NewPort, OldPort: Word; begin RefreshDev; // зовут из потока контроллера — заодно освежаем снимки RefreshSlices; NewPort := Word(EnsureRange(T.Port, 1, 65535)); // Адрес разбирается ДО открытия сокета: невалидный означает отказ, а не // «слушаем все интерфейсы» — авторизации в TCI нет (см. TCIParseIPv4). if T.Enabled and not TTCIServer.ValidSettings(NewPort, T.BindAddr) then Exit(False); OldPort := FServer.Port; FServer.Stop; // Сервер остановлен — клиентов больше нет, значит и потоки чужие: снимаем // тапы, иначе DSP-поток продолжал бы носить аудио в никуда. StopAllStreams; SetTaps(False); if not T.Enabled then begin FCfg := T; Exit(True); end; Result := FServer.Configure(NewPort, T.BindAddr) and FServer.Start; if Result then begin FCfg := T; SetTaps(True); Exit; end; // Порт занят (или отобран правами) — поднимаем то, что работало. if FCfg.Enabled and TTCIServer.ValidSettings(OldPort, FCfg.BindAddr) then if FServer.Configure(OldPort, FCfg.BindAddr) and FServer.Start then SetTaps(True); 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 := DevSnap.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.RxActive(Rx: Integer): Boolean; // Приёмник существует физически. TRX_COUNT в протоколе объявляется один раз и // равен потолку железа, но пан из этого потолка может быть ещё не создан — // врать про его частоту нельзя (см. SendState). begin if Rx = 0 then Result := True else Result := ValidRx(Rx) and FController.PanDDCActive(Rx); end; procedure TTCIAdapter.CalcFreqLimits(out LoHz, HiHz: Double); // Живые границы настройки. Только поток контроллера: VisibleFreqBounds смотрит // в Caps бэкенда. XVTR → диапазон слота; устройства нет — тот же запасной // диапазон, что уходит в VFO_LIMITS. «Нет устройства = можно всё» недопустимо: // SetCenter/SetPanDDCFreq ничего не клампят и отдадут число прямо в backend. begin FController.VisibleFreqBounds(LoHz, HiHz); if (not FController.FDevConnected) or (HiHz <= LoHz) then begin LoHz := 10000; HiHz := 30000000; end; if LoHz < 1 then LoHz := 1; // нулевой частоты не бывает ни у кого end; function TTCIAdapter.FreqSaneLive(Hz: Double): Boolean; // Та же проверка, что FreqSane, но по ЖИВЫМ границам и в потоке контроллера. // Нужна отдельно: команду разбирает поток клиента, а исполняется она позже — // за это время оператор успевает сменить устройство (Pluto → HPSDR), и снимок, // по которому частоту пропустили, уже не описывает то радио, куда она уедет. var LoHz, HiHz: Double; begin Result := False; if IsNan(Hz) or IsInfinite(Hz) or (Hz <= 0) then Exit; CalcFreqLimits(LoHz, HiHz); Result := (Hz >= LoHz) and (Hz <= HiHz); end; procedure TTCIAdapter.RefreshDev; // Снимок железа. Только поток контроллера: здесь дёргаются BackendCaps и // BoardDisplayName, а они смотрят в FNetwork, который UI освобождает на смене // устройства. Сетевые потоки читают уже готовую копию (DevSnap). var D: TTCIDevSnap; Caps: TBackendCaps; begin Caps := FController.BackendCaps; D.DevName := FController.BoardDisplayName; D.MaxPans := Caps.MaxPans; D.HasTX := Caps.HasTX; D.SampleRate := FController.FSampleRate; CalcFreqLimits(D.LimLoHz, D.LimHiHz); FDevLock.Enter; try FDevSnap := D; // строка присваивается ТОЛЬКО здесь и только под локом finally FDevLock.Leave; end; end; function TTCIAdapter.DevSnap: TTCIDevSnap; begin FDevLock.Enter; try Result := FDevSnap; finally FDevLock.Leave; end; end; procedure TTCIAdapter.FreqLimits(out LoHz, HiHz: Double); // ЕДИНСТВЕННЫЙ источник границ настройки: и для VFO_LIMITS в пачке // инициализации, и для проверки частоты в командах. Раньше их было два, и они // расходились: клиенту объявлялись пределы АЦП, а команда под трансвертером // принимала вообще любое число. var D: TTCIDevSnap; begin D := DevSnap; LoHz := D.LimLoHz; HiHz := D.LimHiHz; end; procedure TTCIAdapter.PushVfoLimits; // Границы настройки не вечны: подключилось устройство, включился или выключился // трансвертер — и объявленные при подключении VFO_LIMITS начинают врать. Клиент // узнаёт об этом только от нас: перезапросить их в протоколе нечем. // Дедуп — по последнему известному значению: rfDevice приходит и на создание // слайса, и на обновление списка устройств. // ВАЖНО: кэш ведём всегда, даже когда клиентов нет. Иначе так: клиент видел // пределы устройства → все отключились → радио отвалилось (кэш бы не заметил) // → новый клиент получил запасные 10 кГц…30 МГц → радио вернулось → новые // пределы совпали с давним кэшем, рассылка подавилась, и клиент навсегда остался // с запасными. var Lo, Hi: Double; begin FreqLimits(Lo, Hi); if (Lo = FLastLimLo) and (Hi = FLastLimHi) then Exit; FLastLimLo := Lo; FLastLimHi := Hi; if (FServer = nil) or (FServer.ClientCount = 0) then Exit; FServer.Broadcast(TCIBuild('vfo_limits', [TCIIntStr(Round(Lo)), TCIIntStr(Round(Hi))])); end; function TTCIAdapter.FreqSane(Hz: Double): Boolean; // Годится ли частота к установке. Отрицательная и нулевая — точно нет: именно // такие получались из неразобранных аргументов. var LoHz, HiHz: Double; begin Result := False; if IsNan(Hz) or IsInfinite(Hz) or (Hz <= 0) then Exit; FreqLimits(LoHz, HiHz); Result := (Hz >= LoHz) and (Hz <= HiHz); end; procedure TTCIAdapter.RefreshSlices; // Снимок таблицы слайсов. Зовётся ТОЛЬКО в потоке контроллера (OnState и // Invoke при подключении клиента) — там писателей нет, и снимок каждой записи // получается согласованным. Сетевые потоки читают уже его: прямое чтение // FSlices из них давало смесь старых и новых полей одного слайса (частота // новая, мода ещё старая), даже когда managed-строк это не касалось. var i, Id: Integer; Tmp: array[0..MAX_SLICES-1] of TTCISliceSnap; V: TSliceView; begin for i := 0 to MAX_SLICES - 1 do begin Tmp[i].Used := False; FillChar(Tmp[i].V, SizeOf(Tmp[i].V), 0); Id := FController.SliceIdBySlot(i); // порядок слотов = порядок каналов if (Id > 0) and FController.GetSliceView(Id, V) then begin Tmp[i].Used := True; Tmp[i].V := V; end; end; FSliceLock.Enter; try for i := 0 to MAX_SLICES - 1 do FSliceSnap[i] := Tmp[i]; finally FSliceLock.Leave; end; end; function TTCIAdapter.SliceMapSig: string; // Слепок расстановки: id и пан каждого слайса по порядку слотов. Меняется и // когда слайс создали или удалили, и когда из-за удаления первого второй стал // каналом A. var i: Integer; begin Result := ''; FSliceLock.Enter; try for i := 0 to MAX_SLICES - 1 do if FSliceSnap[i].Used then Result := Result + IntToStr(FSliceSnap[i].V.Id) + ':' + IntToStr(FSliceSnap[i].V.PanId) + ';'; finally FSliceLock.Leave; end; end; procedure TTCIAdapter.PushChannelMap; // Каналы доп. приёмников появились, исчезли или перенумеровались. Об исчезнувшем // канале протокол сказать почти ничего не даёт: команды «приёмника больше нет» в // TCI 2.0 нет вовсе, а про канал B есть только RX_CHANNEL_ENABLE. Поэтому шлём // полную картину каждого живого приёмника — клиент перезаливает её целиком. var Rx, Ch, N: Integer; begin // Потоки пропавших приёмников гасим ВСЕГДА, даже если рассылать некому: // объект потока пережил бы свой пан и молча копил тишину, а клиент ждал бы // блоков, которых больше не будет. DropDeadRxStreams; if (FServer = nil) or (FServer.ClientCount = 0) then Exit; for Rx := 1 to RxCount - 1 do begin if not RxActive(Rx) then Continue; N := ChanCount(Rx); for Ch := 0 to N - 1 do BroadcastRxState(Rx, Ch); FServer.Broadcast(TCIBuild('rx_channel_enable', [TCIIntStr(Rx), '1', TCIBoolStr(N > 1)])); end; end; function TTCIAdapter.SnapSlice(Rx, Ch: Integer; out V: TSliceView): Boolean; // Слайс канала Ch приёмника Rx из снимка. Для Rx=0 слайса нет: главный тракт // живёт в полях контроллера. var i, Seen: Integer; begin Result := False; FillChar(V, SizeOf(V), 0); if (Rx <= 0) or (Ch < 0) then Exit; Seen := 0; FSliceLock.Enter; try for i := 0 to MAX_SLICES - 1 do if FSliceSnap[i].Used and (FSliceSnap[i].V.PanId = Rx) then begin if Seen = Ch then begin V := FSliceSnap[i].V; Exit(True); end; Inc(Seen); end; finally FSliceLock.Leave; end; end; function TTCIAdapter.SliceIdOf(Rx, Ch: Integer): Integer; // Слайсы пана Rx по порядку в таблице: 0-й = канал A, 1-й = канал B. var V: TSliceView; begin if SnapSlice(Rx, Ch, V) then Result := V.Id else Result := 0; end; function TTCIAdapter.SliceIdLive(Rx, Ch: Integer): Integer; // То же, но из живой таблицы. Только для Sync-методов: они идут в потоке // контроллера, где чтение безопасно, а снимок мог бы отстать на такт — команда // на установку обязана попасть в тот слайс, который есть сейчас. begin if Rx <= 0 then Result := 0 else Result := FController.PanSliceId(Rx, Ch); end; function TTCIAdapter.RxSlice(Rx: Integer; out S: TSliceView): Boolean; // Слайс, представляющий приёмник Rx как целое (канал A). begin Result := SnapSlice(Rx, 0, S); end; function TTCIAdapter.SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; // Обратное отображение слайс → (приёмник, канал). Нужно уведомлениям: контроллер // сообщает об изменении Id, а клиенту адресуются номера TCI. var i, Seen, Pan: Integer; begin Result := False; Rx := 0; Ch := 0; if Id <= 0 then Exit; Pan := -1; FSliceLock.Enter; try for i := 0 to MAX_SLICES - 1 do if FSliceSnap[i].Used and (FSliceSnap[i].V.Id = Id) then begin Pan := FSliceSnap[i].V.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 FSliceSnap[i].Used and (FSliceSnap[i].V.PanId = Pan) then begin if FSliceSnap[i].V.Id = Id then begin Rx := Pan; Ch := Seen; Exit(Seen < TCI_CHANNELS); end; Inc(Seen); end; finally FSliceLock.Leave; end; end; function TTCIAdapter.HoldKey(const Name: string; Rx, Ch: Integer): string; // Ключ захвата: параметр + адресат. VFO и IF — одно и то же значение с разных // сторон, поэтому у них общее имя. begin Result := Name + '/' + IntToStr(Rx) + '/' + IntToStr(Ch); end; function TTCIAdapter.Claim(const Key: string; Owner: TTCIClient): Boolean; // §3.5: захвативший параметр держит его 200 мс после последнего изменения. // Owner = nil — изменение от оператора/CAT: оно тоже захватывает параметр, но // НЕ отбирает его у клиента, который прямо сейчас им управляет. var i, Free_: Integer; Now_: QWord; begin Now_ := GetTickCount64; FHoldLock.Enter; try Free_ := -1; for i := 0 to FHoldCount - 1 do begin if FHolds[i].Key = Key then begin if (FHolds[i].Owner <> Owner) and (Now_ - FHolds[i].At < TCI_HOLD_MS) then Exit(False); FHolds[i].Owner := Owner; FHolds[i].At := Now_; Exit(True); end; // Заодно подбираем протухшую запись под переиспользование. if (Free_ < 0) and (Now_ - FHolds[i].At >= TCI_HOLD_MS) then Free_ := i; end; if Free_ < 0 then begin if FHoldCount >= TCI_HOLD_SLOTS then Exit(True); // мест нет — не мешаем Free_ := FHoldCount; Inc(FHoldCount); end; FHolds[Free_].Key := Key; FHolds[Free_].Owner := Owner; FHolds[Free_].At := Now_; Result := True; finally FHoldLock.Leave; end; end; procedure TTCIAdapter.DropHolds(Owner: TTCIClient); // Клиент отключился: его захваты снимаем сразу. Указатели мы только сравниваем // (разыменовывать нечего), но освободившийся адрес мог бы достаться новому // клиенту — и тот получил бы чужие захваты в наследство. var i: Integer; begin if Owner = nil then Exit; FHoldLock.Enter; try for i := 0 to FHoldCount - 1 do if FHolds[i].Owner = Owner then begin FHolds[i].Key := ''; FHolds[i].Owner := nil; FHolds[i].At := 0; end; finally FHoldLock.Leave; 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; FSliceLock.Enter; try for i := 0 to MAX_SLICES - 1 do if FSliceSnap[i].Used and (FSliceSnap[i].V.PanId = Rx) then Inc(Result); finally FSliceLock.Leave; end; if Result > TCI_CHANNELS then Result := TCI_CHANNELS; // Канал A в TCI выключить нечем: он есть у приёмника всегда. Пока пан жив, но // слайсов на нём не осталось, показываем канал A на центре пана — иначе после // удаления последнего слайса клиент навсегда остался бы с его частотой. if (Result = 0) and RxActive(Rx) then Result := 1; end; function TTCIAdapter.ChanFreq(Rx, Ch: Integer): Double; var S: TSliceView; begin Result := 0; if Rx = 0 then begin if Ch = 1 then Result := FController.FVfoB else Result := FController.FVfoA; Exit; end; if SnapSlice(Rx, Ch, S) then Exit(S.TargetHz); // Слайса нет: у живого пана канал A стоит на его центре (см. ChanCount). if (Ch = 0) and RxActive(Rx) then Result := RxCenterHz(Rx); 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: TSliceView; begin Result := FController.FMode; if Rx = 0 then Exit; if SnapSlice(Rx, 0, S) then Result := S.Mode; end; procedure TTCIAdapter.RxFilter(Rx: Integer; out Lo, Hi: Integer); var S: TSliceView; begin Lo := FController.FilterLo; Hi := FController.FilterHi; if Rx = 0 then Exit; if SnapSlice(Rx, 0, S) then begin Lo := S.FilterLo; Hi := S.FilterHi; end; end; function TTCIAdapter.RxMuted(Rx: Integer): Boolean; var S: TSliceView; begin if Rx = 0 then begin Result := FController.FMuted; Exit; end; Result := SnapSlice(Rx, 0, S) and S.Muted; end; function TTCIAdapter.RxVolumeDb(Rx, Ch: Integer): Double; // Громкость в TCI — величина канальная: у доп. пана второй слайс звучит своей. var S: TSliceView; begin if Rx = 0 then begin Result := TCIVolumeToDb(FController.FVolume); Exit; end; Result := TCI_VOL_MIN_DB; if SnapSlice(Rx, Ch, S) then Result := TCIVolumeToDb(Round(S.Volume * 100)); end; function TTCIAdapter.RxAGCUi(Rx: Integer): Integer; var S: TSliceView; begin Result := FController.FAGCMode; if Rx = 0 then Exit; if SnapSlice(Rx, 0, S) then Result := TRadioController.AGCModeToUI(S.AGC); end; // DSP и шумоподавитель: у доп. приёмника своё состояние (зеркало в TCtrlSlice). // Читать тут глобальные поля главного тракта нельзя — клиент увидел бы чужие // переключатели и, что хуже, записал бы их обратно. function TTCIAdapter.RxNROn(Rx: Integer): Boolean; var S: TSliceView; 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: TSliceView; 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: TSliceView; 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: TSliceView; 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: TSliceView; 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 := DevSnap.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); // Исполняется в потоке клиента, поэтому всё «железное» берётся из снимка // (DevSnap), а не из контроллера: BackendCaps и BoardDisplayName смотрят в // FNetwork, который UI освобождает на смене устройства. var D: TTCIDevSnap; Half: Integer; DevName: string; begin D := DevSnap; Half := D.SampleRate div 2; if Half <= 0 then Half := 48000; DevName := Trim(D.DevName); if 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 D.HasTX)])); Reply(Client, TCIBuild('trx_count', [TCIIntStr(RxCount)])); Reply(Client, TCIBuild('channel_count', [TCIIntStr(TCI_CHANNELS)])); // Границы — из того же снимка, что и проверка частоты в командах (§2.1). Reply(Client, TCIBuild('vfo_limits', [TCIIntStr(Round(D.LimLoHz)), TCIIntStr(Round(D.LimHiHz))])); 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 // Приёмника ещё нет (пан не создан): TRX_COUNT объявляет потолок железа, а // не число живых панов, и раньше на такой номер уходили dds/vfo/if с нулём // — клиент принимал ноль за настоящую частоту. Молчим до появления пана: // он придёт с rfPanFreq/rfSliceState. if not RxActive(Rx) then Continue; FEchoLock.Enter; try E := FEcho[Rx]; finally FEchoLock.Leave; end; Reply(Client, StrDds(Rx)); // Только реально существующие каналы: объявив пану второй канал, которого // нет, мы отдали бы клиенту vfo:rx,1,0 — и он принял бы ноль за частоту. // У пана без слайсов каналов нет вовсе — тогда только dds. Chans := ChanCount(Rx); 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])])); // VFO_LOCK — уведомление поканальное (§4.5): без него клиент, вошедший // на запертой ручке, о запрете не знает. Reply(Client, TCIBuild('vfo_lock', [TCIIntStr(Rx), TCIIntStr(Ch), TCIBoolStr(FController.FVfoLock)])); 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)])); // Частота передачи и фокус окна — состояние, а не только событие: на // стабильном радио TX_FREQUENCY не придёт ещё очень долго (уведомление шлётся // по изменению), а логгеру она нужна сразу — особенно в split и на TX-слайсе. Reply(Client, TCIBuild('tx_frequency', [TCIIntStr(Round(FController.ActiveTXFreqHz))])); Reply(Client, TCIBuild('app_focus', [TCIBoolStr(FAppFocus)])); if FController.FRunning then Reply(Client, TCIBuild('start')) else Reply(Client, TCIBuild('stop')); end; procedure TTCIAdapter.HandleConnect(Client: TTCIClient); // Зовётся сервером под FClientLock: рассылка ждёт, пока пачка не уложена в // очередь целиком, поэтому изменение, случившееся посреди дампа, приходит // ПОСЛЕ него, а не теряется. Отсюда запрет: никаких Invoke в поток контроллера // — он сам может стоять на этом локе внутри Broadcast. 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; procedure TTCIAdapter.HandleDisconnect(Client: TTCIClient); // Клиент ушёл — снимаем его захваты параметров, иначе следующий, кому достанется // тот же адрес объекта, унаследовал бы чужие права (§3.5). По той же причине // гасим его потоки: объект клиента вот-вот освободят, а на него смотрит // DSP-поток. Порядок обязателен — сначала потоки, потом возврат в сервер. begin DropHolds(Client); DropClientStreams(Client); ClearTxClient(Client); // ★И только теперь — сама передача: если в эфир нас поставил именно этот // клиент, снимаем MOX. Оставить включённый передатчик за ушедшим клиентом // нельзя ни при какой модуляции (§4.2). StopTxOf(Client); end; { ═══════════════════════════════════════════════════════════════════════════ Sync-методы: исполняются в потоке контроллера (через Invoke) ═══════════════════════════════════════════════════════════════════════════ } procedure TTCIAdapter.SyncSetVfo; var Id: Integer; begin // Окончательная проверка — здесь: см. FreqSaneLive. if not FreqSaneLive(FsFreq) then Exit; if FsInt = 0 then begin if FsInt2 = 1 then FController.SetVfoB(FsFreq) else FController.SetVfoA(FsFreq); Exit; end; Id := SliceIdLive(FsInt, FsInt2); // Тот же путь, что у CAT-порта слайса: внутри включённого диапазона слайс // ходит свободно, за захваченную полосу окно DDC переедет само, за границы // диапазона команда отбрасывается. Прямой SetSliceTarget (как было) уводил // слайс куда угодно, а для TX-слайса эта частота идёт прямо в DUC — то есть // в эфир на чужом диапазоне, без переключения антенн и фильтров. // SliceFreqChanged шлёт сам SetSliceTarget — и для нас, и для UI, и для CAT. if Id > 0 then FController.TuneSliceInBand(Id, FsFreq); end; procedure TTCIAdapter.SyncSetCenter; begin // Окончательная проверка — здесь: см. FreqSaneLive. Ни SetCenter, ни // SetPanDDCFreq границ не клампят, число уходит прямо в backend. if not FreqSaneLive(FsFreq) then Exit; 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 := SliceIdLive(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 := SliceIdLive(FsInt, 0); if Id > 0 then FController.SetSliceFilter(Id, FsInt2, FsInt3); end; procedure TTCIAdapter.SyncSetTRX; begin // Источник модуляции ставим ДО SetMOX — именно он его и читает при выборе // микрофона. Выключение передачи флаг снимает всегда: следующий раз оператор // может нажать PTT сам, и тогда в эфир должен идти его микрофон. FController.TCIMicRequested := FsBool and FsBool2; FController.SetMOX(FsBool); end; procedure TTCIAdapter.SyncStopTRX; // Поток контроллера. Передачу, начатую ушедшим клиентом, снимаем безусловно: // решение принято там, где известно, кто её начал, а здесь остаётся только // проверить, что она вообще идёт (оператор мог отпустить PTT сам). begin if (FController = nil) or not FController.FTransmitting then Exit; FController.TCIMicRequested := False; FController.SetMOX(False); end; procedure TTCIAdapter.SyncTaps; // Поток контроллера: движок и список тапов трогаем только отсюда. begin if FsBool then begin FController.AddAudioTap(OnAudioTap); FController.SetIQTap(OnIQTap); end else begin FController.RemoveAudioTap(OnAudioTap); FController.SetIQTap(nil); end; 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; // Адресно: SetVolume правит АКТИВНУЮ громкость, и на передаче с самоконтролем // команда VOLUME уехала бы в громкость монитора, а в ответ клиент получал бы // нетронутый FVolume. У TCI это разные команды — VOLUME и MON_VOLUME. begin FController.SetRxVolume(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 := SliceIdLive(FsInt, 0); if Id > 0 then FController.SetSliceMute(Id, FsBool); end; procedure TTCIAdapter.SyncSetRxVolume; var Id: Integer; begin // Тоже адресно (см. SyncSetVolume): RX_VOLUME — про приём, не про монитор. if FsInt = 0 then begin FController.SetRxVolume(FsInt2); Exit; end; Id := SliceIdLive(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 := SliceIdLive(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: TSliceView; begin if FsInt = 0 then begin if FsBool then FController.SetNR(1) else FController.SetNR(0); Exit; end; Id := SliceIdLive(FsInt, 0); if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceDSP(Id, Ord(FsBool), S.NBMode, S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetNB; var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin if FsBool then FController.SetNB(1) else FController.SetNB(0); Exit; end; Id := SliceIdLive(FsInt, 0); if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceDSP(Id, S.NRMode, Ord(FsBool), S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetANF; var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin FController.SetANF(FsBool); Exit; end; Id := SliceIdLive(FsInt, 0); if (Id > 0) and FController.GetSliceView(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: TSliceView; begin if FsInt = 0 then begin FController.SetFMSquelch(FsBool); Exit; end; Id := SliceIdLive(FsInt, 0); if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceFMSquelch(Id, FsBool, S.FMSQLevel); end; procedure TTCIAdapter.SyncSetSqlLevel; var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin FController.SetFMSquelchLevel(FsInt2); Exit; end; Id := SliceIdLive(FsInt, 0); if (Id > 0) and FController.GetSliceView(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 if not TCITryArgInt(M, 0, Rx) then Exit; if not TCITryArgInt(M, 1, Ch) then Ch := 0; if not ValidRx(Rx) then Exit; if (Ch < 0) or (Ch >= TCI_CHANNELS) then Exit; // Частота ставится, только если её удалось разобрать И она годная: «vfo:0,0,abc» // раньше превращалось в честный ноль и уводило приёмник на 0 Гц. if (M.ArgCount >= 3) and TCITryArgFloat(M, 2, Hz) then begin if IsIF then Hz := RxCenterHz(Rx) + Hz; if FreqSane(Hz) and Claim(HoldKey('VFO', Rx, Ch), Client) then begin FLock.Enter; try FsInt := Rx; FsInt2 := Ch; FsFreq := Hz; if CanInvoke then FController.Invoke(SyncSetVfo); finally FLock.Leave; end; 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'; // Поле называется TimeUTC и рисуется рядом со спотами кластера, которые // приходят в UTC: местное время сдвигало бы подпись на часовой пояс. // Stamp — наоборот, местное: по нему считается возраст спота (TTL). S.TimeUTC := FormatDateTime('hhnn', LocalTimeToUniversal(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; Lo, Hi: Integer; B, FromTCI: 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if (M.ArgCount >= 2) and TCITryArgFloat(M, 1, D) and FreqSane(D) and Claim(HoldKey('DDS', Rx, 0), Client) then begin 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 if not TCITryArgInt(M, 0, Rx) then Exit; 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) and Claim(HoldKey('MOD', Rx, 0), Client) 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; // Обе кромки обязаны разобраться, и нижняя обязана быть ниже верхней: // «rx_filter_band:0,x,y» иначе схлопывал фильтр в 0..0 и приёмник глох. if (M.ArgCount >= 3) and TCITryArgInt(M, 1, Lo) and TCITryArgInt(M, 2, Hi) and (Lo < Hi) and Claim(HoldKey('FILT', Rx, 0), Client) then begin FLock.Enter; try FsInt := Rx; FsInt2 := Lo; FsInt3 := Hi; if CanInvoke then FController.Invoke(SyncSetFilter); finally FLock.Leave; end; end; Reply(Client, StrFilterBand(Rx)); Exit; end; // ── Передача ── if M.Name = 'TRX' then begin // arg3 — источник сигнала. Наш только 'tci': модуляция берётся из // аудиопотока этого клиента. Остальные значения (mic1/mic2/micpc/ecoder2) // называют физические входы ExpertSDR3, которых у нас нет, — они значат // «микрофон, выбранный в программе», то есть ровно то, что и без arg3. // Требование «включен аудиопоток по TCI» (§4.2) проверяем буквально: // без AUDIO_START модулировать нечем, и молча оставить оператора с // тишиной в эфире хуже, чем передавать с его микрофона. if TCITryArgBool(M, 1, B) and Claim(HoldKey('TRX', 0, 0), Client) then begin Name := LowerCase(Trim(TCIArg(M, 2))); FromTCI := B and (Name = 'tci') and HasAudioStream(Client); FTxLock.Enter; try if FromTCI then FTxClient := Client else if FTxClient = Client then FTxClient := nil; // Кто поставил трансивер в эфир: его уход обязан эфир и снять // (см. StopTxOf). Источник модуляции тут ни при чём — несущую без // хозяина оставлять нельзя в любом случае. if B then FTrxOwner := Client else if FTrxOwner = Client then FTrxOwner := nil; finally FTxLock.Leave; end; FLock.Enter; try FsBool := B; FsBool2 := FromTCI; if CanInvoke then FController.Invoke(SyncSetTRX); finally FLock.Leave; end; end; Reply(Client, StrTrx); Exit; end; if M.Name = 'TUNE' then begin if TCITryArgBool(M, 1, B) and Claim(HoldKey('TUNE', 0, 0), Client) then begin FLock.Enter; try FsBool := B; if CanInvoke then FController.Invoke(SyncSetTune); finally FLock.Leave; end; end; Reply(Client, StrTune); Exit; end; if M.Name = 'DRIVE' then begin if TCITryArgInt(M, 1, V) and Claim(HoldKey('DRIVE', 0, 0), Client) then begin FLock.Enter; try FsInt := EnsureRange(V, 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 TCITryArgInt(M, 1, V) and Claim(HoldKey('TUNEDRIVE', 0, 0), Client) then begin FLock.Enter; try FsInt := EnsureRange(V, 0, 100); if CanInvoke then FController.Invoke(SyncSetTuneDrive); finally FLock.Leave; end; end; // Уровень TUN — величина общая для радио: отвечать одному автору значило бы // оставить остальных клиентов со старым числом (Broadcast включает автора). FServer.Broadcast(TCIBuild('tune_drive', ['0', TCIIntStr(FController.FTXSettings.TUNLevel)])); Exit; end; if M.Name = 'SPLIT_ENABLE' then begin if TCITryArgBool(M, 1, B) and Claim(HoldKey('SPLIT', 0, 0), Client) then begin FLock.Enter; try FsBool := B; if CanInvoke then FController.Invoke(SyncSetSplit); finally FLock.Leave; end; end; // Split — свойство радио, а не клиента: остальным о нём узнать больше // неоткуда (rfActiveVfo несёт его же, но только когда значение сменилось). FServer.Broadcast(TCIBuild('split_enable', ['0', TCIBoolStr(FController.FSplitTxB)])); Exit; end; // ── Громкость ── if M.Name = 'VOLUME' then begin if TCITryArgFloat(M, 0, D) and Claim(HoldKey('VOL', 0, 0), Client) then begin FLock.Enter; try FsInt := TCIDbToVolume(D); if CanInvoke then FController.Invoke(SyncSetVolume); finally FLock.Leave; end; end; Reply(Client, StrVolume); Exit; end; if M.Name = 'MUTE' then begin if TCITryArgBool(M, 0, B) and Claim(HoldKey('MUTE', 0, 0), Client) then begin FLock.Enter; try FsBool := B; if CanInvoke then FController.Invoke(SyncSetMute); finally FLock.Leave; end; end; Reply(Client, StrMute); Exit; end; if M.Name = 'RX_MUTE' then begin if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if TCITryArgBool(M, 1, B) and Claim(HoldKey('RXMUTE', Rx, 0), Client) then begin FLock.Enter; try FsInt := Rx; FsBool := B; 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not TCITryArgInt(M, 1, Ch) then Ch := 0; Ch := EnsureRange(Ch, 0, TCI_CHANNELS - 1); if not ValidRx(Rx) then Exit; if (M.ArgCount >= 3) and TCITryArgFloat(M, 2, D) and Claim(HoldKey('RXVOL', Rx, Ch), Client) then begin FLock.Enter; try FsInt := Rx; FsInt2 := TCIDbToVolume(D); 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 // Баланса каналов у нас нет — эхо, чтобы клиенты не расходились. if not TCITryArgInt(M, 0, Rx) then Exit; if not TCITryArgInt(M, 1, Ch) then Ch := 0; Ch := EnsureRange(Ch, 0, TCI_CHANNELS - 1); if not ValidRx(Rx) then Exit; FEchoLock.Enter; try if (M.ArgCount >= 3) and TCITryArgInt(M, 2, V) then FEcho[Rx].BalanceDb[Ch] := EnsureRange(V, -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 TCITryArgFloat(M, 0, D) and Claim(HoldKey('MONVOL', 0, 0), Client) then begin FLock.Enter; try FsInt := TCIDbToVolume(D); 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 TCITryArgBool(M, 0, B) and Claim(HoldKey('MONEN', 0, 0), Client) then begin FLock.Enter; try FsBool := B; 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 if not TCITryArgInt(M, 0, Rx) then Exit; 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) and Claim(HoldKey('AGC', Rx, 0), Client) 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; // AGC-T (порог АРУ) в ewsdr один на приёмный тракт: у слайса своего нет. // Правка от имени доп. приёмника трогала бы главный — не делаем этого, // просто отвечаем текущим значением (ограничение, см. doc/TCI.md). if (Rx = 0) and TCITryArgInt(M, 1, V) and Claim(HoldKey('AGCT', 0, 0), Client) then begin FLock.Enter; try FsInt := EnsureRange(V, 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if TCITryArgBool(M, 1, B) and Claim(HoldKey(M.Name, Rx, 0), Client) then begin FLock.Enter; try FsInt := Rx; FsBool := B; 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; FEchoLock.Enter; try if M.ArgCount >= 3 then begin if TCITryArgInt(M, 1, V) then FEcho[Rx].NBThreshold := EnsureRange(V, 1, 100); if TCITryArgInt(M, 2, V) then FEcho[Rx].NBDuration := EnsureRange(V, 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; FEchoLock.Enter; try if TCITryArgBool(M, 1, B) 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if TCITryArgBool(M, 1, B) and Claim(HoldKey('LOCK', 0, 0), Client) then begin FLock.Enter; try FsBool := B; if CanInvoke then FController.Invoke(SyncSetLock); finally FLock.Leave; end; end; Reply(Client, StrLock(Rx)); Exit; end; if M.Name = 'SQL_ENABLE' then begin if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if TCITryArgBool(M, 1, B) and Claim(HoldKey('SQL', Rx, 0), Client) then begin FLock.Enter; try FsInt := Rx; FsBool := B; if CanInvoke then FController.Invoke(SyncSetSql); finally FLock.Leave; end; end; Reply(Client, StrSqlEnable(Rx)); Exit; end; if M.Name = 'SQL_LEVEL' then begin if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if TCITryArgFloat(M, 1, D) and Claim(HoldKey('SQLLEV', Rx, 0), Client) then begin FLock.Enter; try FsInt := Rx; FsInt2 := TCISqlToLevel(D); 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; FEchoLock.Enter; try if TCITryArgBool(M, 1, B) then begin if M.Name = 'RIT_ENABLE' then FEcho[Rx].RitOn := B else FEcho[Rx].XitOn := B; 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 if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; FEchoLock.Enter; try if TCITryArgInt(M, 1, V) then begin V := EnsureRange(V, -50000, 50000); if M.Name = 'RIT_OFFSET' then FEcho[Rx].RitHz := V else FEcho[Rx].XitHz := V; 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). if not TCITryArgInt(M, 0, Rx) then Exit; if not TCITryArgInt(M, 1, Ch) then Ch := 1; if not ValidRx(Rx) then Exit; if TCITryArgBool(M, 2, B) then begin FEchoLock.Enter; try FEcho[Rx].ChannelBOn := B; 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 TCITryArgInt(M, 0, V) then begin V := EnsureRange(V, 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 TCITryArgInt(M, 0, V) and Claim(HoldKey('CWSPEED', 0, 0), Client) then begin FLock.Enter; try FsInt := EnsureRange(V, 5, 60); if CanInvoke then FController.Invoke(SyncSetCWSpeed); finally FLock.Leave; end; end; FServer.Broadcast(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 if not TCITryArgInt(M, 0, V) then Exit; if M.Name = 'CW_MACROS_SPEED_DOWN' then V := -V; if Claim(HoldKey('CWSPEED', 0, 0), Client) then begin FLock.Enter; try FsInt := EnsureRange(FController.FCWSettings.Speed + V, 5, 60); if CanInvoke then FController.Invoke(SyncSetCWSpeed); finally FLock.Leave; end; end; FServer.Broadcast(TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); Exit; end; if M.Name = 'CW_MACROS_DELAY' then begin if TCITryArgInt(M, 0, V) and Claim(HoldKey('CWDELAY', 0, 0), Client) then begin FLock.Enter; try FsInt := EnsureRange(V, 0, 1000); if CanInvoke then FController.Invoke(SyncSetCWDelay); finally FLock.Leave; end; end; FServer.Broadcast(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 if TCITryArgBool(M, 0, B) then FCwTerminal := B; 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 if not TCITryArgBool(M, 0, B) then Exit; if TCITryArgInt(M, 1, V) then Client.SetRxSensorsMs(EnsureRange(V, TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS)); Client.SetRxSensors(B); Exit; end; if M.Name = 'TX_SENSORS_ENABLE' then begin if not TCITryArgBool(M, 0, B) then Exit; if TCITryArgInt(M, 1, V) then Client.SetTxSensorsMs(EnsureRange(V, TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS)); Client.SetTxSensors(B); 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), а не устройства: два логгера вправе просить // разную частоту дискретизации. Поэтому живут в его объекте, а не в адаптере // — иначе один клиент перенастраивал бы будущие потоки всем остальным. // Изменение параметра на ходу перезапускает уже идущие потоки этого клиента: // блок с новой частотой посреди старого потока клиенты разбирают как мусор. if M.Name = 'IQ_SAMPLERATE' then begin // Набор частот оговорён протоколом; чужое значение отвергаем, а в ответе // отдаём действующее — клиент увидит, что его не приняли. if TCITryArgInt(M, 0, V) and TCIValidIQRate(V) and (V <> Client.IQRate) then begin Client.IQRate := V; RestartStreams(Client, tstIQ); end; // ★В ответе — та частота, которую клиент РЕАЛЬНО получит, а не его // просьба: на 576 и 960 кГц Pluto просьба «384» невыполнима (не делится // нацело), и подтвердить её значило бы соврать. Сама просьба остаётся // сохранённой — на другом устройстве она может стать выполнимой. Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(EffIQRate(Client))])); Exit; end; if M.Name = 'AUDIO_SAMPLERATE' then begin if TCITryArgInt(M, 0, V) and TCIValidAudioRate(V) and (V <> Client.AudioRate) then begin Client.AudioRate := V; // Число сэмплов в блоке у ExpertSDR3 своё на каждую частоту (§4.3), и // клиент вправе на это рассчитывать, пока не задал своё явно. Client.AudioSamples := TCIDefaultAudioSamples(V); RestartStreams(Client, tstRXAudio); RestartStreams(Client, tstLineOut); end; Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)])); Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLES' then begin if TCITryArgInt(M, 0, V) then begin V := EnsureRange(V, TCI_AUDIO_SAMPLES_MIN, TCI_AUDIO_SAMPLES_MAX); if V <> Client.AudioSamples then begin Client.AudioSamples := V; RestartStreams(Client, tstRXAudio); RestartStreams(Client, tstLineOut); end; end; Exit; end; if M.Name = 'AUDIO_STREAM_CHANNELS' then begin if TCITryArgInt(M, 0, V) then begin V := EnsureRange(V, 1, 2); if V <> Client.AudioChannels then begin Client.AudioChannels := V; RestartStreams(Client, tstRXAudio); RestartStreams(Client, tstLineOut); end; end; Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then begin Name := LowerCase(Trim(TCIArg(M, 0))); if TCIValidSampleType(Name) and (Name <> Client.AudioSampleType) then begin Client.AudioSampleType := Name; RestartStreams(Client, tstRXAudio); RestartStreams(Client, tstLineOut); end; Exit; end; if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then begin if TCITryArgInt(M, 0, V) then Client.TxBuffering := EnsureRange(V, 50, 500); Exit; end; // ── Запуск и остановка потоков (§3.4) ── if (M.Name = 'IQ_START') or (M.Name = 'IQ_STOP') or (M.Name = 'AUDIO_START') or (M.Name = 'AUDIO_STOP') or (M.Name = 'LINE_OUT_START') or (M.Name = 'LINE_OUT_STOP') then begin CmdStream(Client, M); Exit; end; if (M.Name = 'LINE_OUT_RECORDER_START') or (M.Name = 'LINE_OUT_RECORDER_SAVE') or (M.Name = 'LINE_OUT_RECORDER_BREAK') then begin CmdRecorder(Client, M); Exit; end; // Всё прочее незнакомое протокол разрешает игнорировать (§3.1). 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.DueRxSensors(Now_) then begin for Rx := 0 to RxCount - 1 do begin if not RxActive(Rx) then Continue; // несуществующий пан молчит, а не «-140» 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.DueTxSensors(Now_) then begin 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); PushTxChrono; except // молча: следующий тик через 20 мс попробует снова end; end; { ═══════════════════════════════════════════════════════════════════════════ Бинарные потоки (§3.4) Кто в каком потоке исполнения: • START/STOP и параметры — поток клиента (список правится под FStreamLock); • подача данных (OnAudioTap/OnIQTap) — DSP-поток: он же нарезает блоки и кладёт их в кольцо клиента, а в сокет пишет поток самого клиента; • TX_CHRONO — тик-поток (пейсинг по часам); • TX-аудио от клиента — поток этого клиента (HandleBinary). Тапы навешиваются на контроллер и движок только из потока контроллера (SetTaps зовут ApplySettings и деструктор), потому что снятие тапа обязано дождаться выхода DSP-потока из вызова. ═══════════════════════════════════════════════════════════════════════════ } procedure TTCIAdapter.SetTaps(On_: Boolean); // Только поток контроллера (ApplySettings, Destroy): снятие тапа обязано // дождаться выхода DSP-потока из вызова, а Invoke сюда звать не из чего — // мы в нём и находимся. begin if (FTapsOn = On_) or (FController = nil) then Exit; FTapsOn := On_; FLock.Enter; try FsBool := On_; SyncTaps; finally FLock.Leave; end; end; function TTCIAdapter.FindStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer): TTCIStreamOut; // Только под FStreamLock. var i: Integer; begin Result := nil; for i := 0 to High(FStreams) do if (FStreams[i] <> nil) and FStreams[i].Matches(C, K, Rx) then Exit(FStreams[i]); end; procedure TTCIAdapter.StartStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer); var S: TTCIStreamOut; SrcRate, WantRate, Chans, Block: Integer; ST: TTCISampleType; begin if C = nil then Exit; // Параметры снимаем ДО лока: геттеры клиента берут его собственный лок, и // держать при этом FStreamLock значило бы связать два лока без нужды. if K = tstIQ then begin SrcRate := FController.IQTapRateHz(Rx); WantRate := C.IQRate; Chans := 2; // IQ комплексный по определению ST := tsyFloat32; // формат IQ в TCI не настраивается Block := TCIMaxBlockSamples(ST, Chans); end else begin SrcRate := TCI_AUDIO_ENGINE_RATE; WantRate := C.AudioRate; Chans := EnsureRange(C.AudioChannels, 1, 2); if not TCISampleTypeByName(C.AudioSampleType, ST) then ST := tsyFloat32; Block := C.AudioSamples; end; if SrcRate <= 0 then SrcRate := TCI_AUDIO_ENGINE_RATE; FStreamLock.Enter; try if FindStream(C, K, Rx) <> nil then Exit; // повторный START — не ошибка S := TTCIStreamOut.Create(C, K, Rx, SrcRate, WantRate, Chans, ST, Block); SetLength(FStreams, Length(FStreams) + 1); FStreams[High(FStreams)] := S; finally FStreamLock.Leave; end; end; procedure TTCIAdapter.StopStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer); var i, j: Integer; begin FStreamLock.Enter; try for i := 0 to High(FStreams) do if (FStreams[i] <> nil) and FStreams[i].Matches(C, K, Rx) then begin FStreams[i].Free; for j := i to High(FStreams) - 1 do FStreams[j] := FStreams[j + 1]; SetLength(FStreams, Length(FStreams) - 1); Exit; end; finally FStreamLock.Leave; end; end; procedure TTCIAdapter.DropClientStreams(C: TTCIClient); var i, j: Integer; begin FStreamLock.Enter; try i := 0; while i <= High(FStreams) do if (FStreams[i] <> nil) and (FStreams[i].Client = C) then begin FStreams[i].Free; for j := i to High(FStreams) - 1 do FStreams[j] := FStreams[j + 1]; SetLength(FStreams, Length(FStreams) - 1); end else Inc(i); finally FStreamLock.Leave; end; end; procedure TTCIAdapter.RestartStreams(C: TTCIClient; K: TTCIStreamType); // Параметры потока сменились на ходу: пересоздаём то, что уже идёт, с новыми. // Пересобрать объект дешевле, чем учить его менять формат на лету, а клиент // всё равно обязан читать заголовок каждого блока. var Rx: Integer; Live: array[0..TCI_MAX_RX-1] of Boolean; begin FStreamLock.Enter; try for Rx := 0 to TCI_MAX_RX - 1 do Live[Rx] := FindStream(C, K, Rx) <> nil; finally FStreamLock.Leave; end; for Rx := 0 to TCI_MAX_RX - 1 do if Live[Rx] then begin StopStream(C, K, Rx); StartStream(C, K, Rx); end; end; procedure TTCIAdapter.DropDeadRxStreams; // Поток контроллера (OnState): живость приёмника спрашиваем ДО лока — внутри // него ходит DSP-поток, и лезть оттуда в контроллер незачем. var Rx, i, j: Integer; Alive: array[0..TCI_MAX_RX-1] of Boolean; begin for Rx := 0 to TCI_MAX_RX - 1 do Alive[Rx] := ValidRx(Rx) and RxActive(Rx); FStreamLock.Enter; try i := 0; while i <= High(FStreams) do if (FStreams[i].Rx >= 0) and (FStreams[i].Rx < TCI_MAX_RX) and not Alive[FStreams[i].Rx] then begin FStreams[i].Free; for j := i to High(FStreams) - 1 do FStreams[j] := FStreams[j + 1]; SetLength(FStreams, Length(FStreams) - 1); end else Inc(i); for Rx := 0 to TCI_MAX_RX - 1 do if not Alive[Rx] then FreeAndNil(FRec[Rx]); finally FStreamLock.Leave; end; end; procedure TTCIAdapter.StopAllStreams; var i: Integer; begin FStreamLock.Enter; try for i := 0 to High(FStreams) do FStreams[i].Free; SetLength(FStreams, 0); for i := 0 to TCI_MAX_RX - 1 do FreeAndNil(FRec[i]); finally FStreamLock.Leave; end; ClearTxClient(nil); // Страховка: клиент мог держать эфир и без своего аудио (TRX без 'tci'). StopTxOf(nil); end; function TTCIAdapter.EffIQRate(C: TTCIClient): Integer; // Частота IQ, которую клиент получит на ГЛАВНОМ приёмнике. У доп. панов rate // свой, и настоящая частота каждого потока всегда стоит в заголовке блока — // но команда IQ_SAMPLERATE в протоколе одна на клиента, поэтому и отвечать на // неё можно только про один приёмник. Частоту берём из снимка: зовут отсюда // потоки клиентов. begin Result := TCIPickIQRate(DevSnap.SampleRate, C.IQRate); end; procedure TTCIAdapter.PushIQRate(Client: TTCIClient); begin if Client.Ready then Client.Send(TCIBuild('iq_samplerate', [TCIIntStr(EffIQRate(Client))])); end; function TTCIAdapter.HasAudioStream(C: TTCIClient): Boolean; var Rx: Integer; begin Result := False; FStreamLock.Enter; try for Rx := 0 to TCI_MAX_RX - 1 do if FindStream(C, tstRXAudio, Rx) <> nil then Exit(True); finally FStreamLock.Leave; end; end; function TTCIAdapter.StreamRxOf(PanId, SliceId: Integer): Integer; // Какому приёмнику TCI принадлежит это аудио. Главный тракт — приёмник 0. // У доп. пана в потоках участвует только канал A (первый слайс): «аудиопоток // приёмника» в протоколе один на приёмник, второго канала у него нет. // Зовётся из DSP-потока и берёт FSliceLock — ДО FStreamLock (порядок!). begin Result := -1; if PanId <= 0 then begin if SliceId = 0 then Result := 0; // слайсы главного пана в модель не входят Exit; end; if not ValidRx(PanId) then Exit; if SliceIdOf(PanId, 0) = SliceId then Result := PanId; end; procedure TTCIAdapter.OnAudioTap(Kind: TRadioAudioKind; PanId, SliceId: Integer; const Left, Right: array of Single; Count: Integer); // DSP-поток. Всё, что здесь можно, — перемолоть блок и разложить его по // кольцам клиентов; ждать нельзя ничего. var Rx, i: Integer; K: TTCIStreamType; begin if Count <= 0 then Exit; Rx := StreamRxOf(PanId, SliceId); if Rx < 0 then Exit; if Kind = rakDemod then K := tstRXAudio else K := tstLineOut; FStreamLock.Enter; try for i := 0 to High(FStreams) do if (FStreams[i].Kind = K) and (FStreams[i].Rx = Rx) then FStreams[i].FeedAudio(Left, Right, Count); // Рекордер пишет ровно линейный выход — тот же источник, что и поток // LINEOUT (§4.3: «повторяет обычный аудио поток»). if (Kind = rakLineOut) and (Rx < TCI_MAX_RX) and (FRec[Rx] <> nil) then FRec[Rx].Feed(Left, Right, Count); finally FStreamLock.Leave; end; end; procedure TTCIAdapter.OnIQTap(PanId: Integer; PI_, PQ_: PDouble; N, RateHz: Integer); // DSP-поток, один вызов на накопленный блок. У пана этот вызов идёт под // FSliceLock движка, поэтому здесь тем более нельзя ждать. var i: Integer; begin if (N <= 0) or (RateHz <= 0) then Exit; if (PanId < 0) or (PanId >= TCI_MAX_RX) then Exit; FStreamLock.Enter; try for i := 0 to High(FStreams) do if (FStreams[i].Kind = tstIQ) and (FStreams[i].Rx = PanId) then begin // Rate устройства могли сменить уже после START (смена sample rate, // другой rate DDC пана): пересчитываем прореживание на месте, иначе // клиент получал бы поток с враньём в заголовке. if FStreams[i].SrcRate <> RateHz then FStreams[i].SetSourceRate(RateHz); FStreams[i].FeedIQ(PI_, PQ_, N); end; finally FStreamLock.Leave; end; end; procedure TTCIAdapter.CmdStream(Client: TTCIClient; const M: TTCIMessage); var Rx: Integer; K: TTCIStreamType; Start: Boolean; begin // Номер приёмника обязателен и обязан существовать: молча завести поток // несуществующего пана значит навсегда оставить клиента без данных. if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'bad receiver'])); Exit; end; Start := False; K := tstRXAudio; if M.Name = 'IQ_START' then begin K := tstIQ; Start := True; end else if M.Name = 'IQ_STOP' then K := tstIQ else if M.Name = 'AUDIO_START' then begin K := tstRXAudio; Start := True; end else if M.Name = 'AUDIO_STOP' then K := tstRXAudio else if M.Name = 'LINE_OUT_START' then begin K := tstLineOut; Start := True; end else if M.Name = 'LINE_OUT_STOP' then K := tstLineOut; if Start then begin // Пан существует, но не запущен — данных не будет вовсе. Честнее сказать // сразу, чем оставить клиента ждать блоков от мёртвого приёмника. if not RxActive(Rx) then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'receiver is not running'])); Exit; end; StartStream(Client, K, Rx); end else begin StopStream(Client, K, Rx); // Модулировать из потока, которого больше нет, нельзя (§4.2). if (K = tstRXAudio) and not HasAudioStream(Client) then ClearTxClient(Client); end; end; procedure TTCIAdapter.CmdRecorder(Client: TTCIClient; const M: TTCIMessage); var Rx, Sec, Rate: Integer; Path: string; Data: TTCIPcm; Old, New_: TTCIRecorder; begin if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'bad receiver'])); Exit; end; if M.Name = 'LINE_OUT_RECORDER_START' then begin if not TCITryArgInt(M, 1, Sec) then Sec := TCI_RECORD_MAX_SEC; Sec := EnsureRange(Sec, 1, TCI_RECORD_MAX_SEC); // Кольцо заводим ДО лока: на предельных 300 с это 57 МБ, и выделять их // под локом, которого ждёт DSP-поток, значит уронить звук на десятки мс. New_ := TTCIRecorder.Create(Rx, TCI_AUDIO_ENGINE_RATE, Sec); FStreamLock.Enter; try // Рекордер один на приёмник, а не на клиента: пишет он то, что слышно // в аппарате, и второй такой же был бы просто копией памяти. Old := FRec[Rx]; FRec[Rx] := New_; finally FStreamLock.Leave; end; Old.Free; // прежний — уже вне лока Exit; end; if M.Name = 'LINE_OUT_RECORDER_BREAK' then begin FStreamLock.Enter; try Old := FRec[Rx]; FRec[Rx] := nil; finally FStreamLock.Leave; end; Old.Free; Exit; end; // LINE_OUT_RECORDER_SAVE Path := TCIRecordPath(TCIUnescape(TCIArg(M, 1))); if Path = '' then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'no file name'])); Exit; end; // MP3 у нас кодировать нечем — молча подсунуть WAV с расширением .mp3 хуже, // чем сказать правду: клиент такой файл всё равно не откроет. if SameText(ExtractFileExt(Path), '.mp3') then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'only wav is supported'])); Exit; end; // Забираем рекордер из таблицы (сохранение завершает запись, §4.3) и только // потом снимаем с него данные: копия кольца — это десятки мегабайт, и делать // её под локом DSP-потока нельзя. Data := nil; Rate := TCI_AUDIO_ENGINE_RATE; FStreamLock.Enter; try Old := FRec[Rx]; FRec[Rx] := nil; finally FStreamLock.Leave; end; if Old <> nil then begin Data := Old.Take; Rate := Old.Rate; Old.Free; end; if Data = nil then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'nothing recorded'])); Exit; end; // Пишет отдельный поток: файл может быть в десятки мегабайт, а мы сейчас в // потоке клиента, который в это время не читает свой сокет. TTCIWavWriter.Create(Path, Data, Rate); end; procedure TTCIAdapter.ClearTxClient(C: TTCIClient); // C = nil — снять кого угодно (остановка сервера). var Drop: Boolean; begin Drop := False; FTxLock.Enter; try if (FTxClient <> nil) and ((C = nil) or (FTxClient = C)) then begin FTxClient := nil; FTxRunning := False; Drop := True; end; finally FTxLock.Leave; end; if not Drop then Exit; // Пишем прямо, без Invoke: это один Boolean, который SetMOX только читает, и // зовут нас откуда угодно — в том числе из деструктора адаптера, где ждать // поток контроллера уже некому. if FController = nil then Exit; FController.TCIMicRequested := False; // ★А вот саму передачу, если она ИДЁТ ИМЕННО ИЗ ЭТОГО ПОТОКА, оставлять // нельзя: источник модуляции только что исчез, и в эфире осталась бы // несущая с тишиной (или с последним, что застряло в ринге), которую никто // не снимет. Передачу с микрофона оператора это не трогает — там // TCIMicActive не поднят. if FController.TCIMicActive then StopTxOf(nil); end; procedure TTCIAdapter.StopTxOf(C: TTCIClient); // ★Безопасность (§4.2). Клиент, поставивший трансивер в эфир, ушёл — MOX // обязан упасть. C = nil — снять эфир, кем бы из клиентов он ни был начат // (остановка сервера, потеря источника модуляции). var Mine: Boolean; begin Mine := False; FTxLock.Enter; try if (FTrxOwner <> nil) and ((C = nil) or (FTrxOwner = C)) then begin FTrxOwner := nil; Mine := True; end; finally FTxLock.Leave; end; if not Mine or (FController = nil) then Exit; if CanInvoke then FController.Invoke(SyncStopTRX) else // CanInvoke=False бывает ровно в одном случае — сервер останавливается, а // останавливает его поток контроллера: он же сейчас и исполняет нас // (TTCIServer.Stop, шаг 5 → Disconnected). Ждать самого себя нельзя, и не // нужно — вызов и так на правильном потоке. SyncStopTRX; end; procedure TTCIAdapter.ForgetTxOwner; // Передача кончилась сама (оператор, CAT, PTT, тайм-аут) — забываем, кто её // начал. Иначе уход того клиента через час снимал бы уже чужой эфир. begin FTxLock.Enter; try FTrxOwner := nil; finally FTxLock.Leave; end; end; procedure TTCIAdapter.PushTxChrono; // Тик-поток. Маркер TX_CHRONO говорит клиенту «пришли столько-то отсчётов» // (§3.4). Пейсинг по часам: сколько времени прошло — столько и просим, плюс // разовая подушка TX_STREAM_AUDIO_BUFFERING на старте передачи. Ответа не // ждём: не успел клиент — в эфир уйдёт тишина, это его забота. var C: TTCIClient; Now_: QWord; Rate, Chans, Block: Integer; ST: TTCISampleType; H: TTCIStreamHeader; Active: Boolean; begin FTxLock.Enter; try C := FTxClient; finally FTxLock.Leave; end; if C = nil then Exit; Active := FController.TCIMicActive; Now_ := GetTickCount64; Rate := C.AudioRate; Chans := EnsureRange(C.AudioChannels, 1, 2); Block := EnsureRange(C.AudioSamples, TCI_AUDIO_SAMPLES_MIN, TCI_AUDIO_SAMPLES_MAX); if not TCISampleTypeByName(C.AudioSampleType, ST) then ST := tsyFloat32; FTxLock.Enter; try if not Active then begin FTxRunning := False; Exit; end; if not FTxRunning then begin FTxRunning := True; FTxLastMs := Now_; // Подушка: клиенту нужно время собрать первый блок, а тракт начнёт // забирать сэмплы сразу. FTxOwed := Rate * (C.TxBuffering / 1000.0); end else begin FTxOwed := FTxOwed + Rate * ((Now_ - FTxLastMs) / 1000.0); FTxLastMs := Now_; // Клиент замолчал, а время идёт — потолок долга держим в один блок, // иначе после паузы на него обрушится пачка маркеров. if FTxOwed > 4 * Block then FTxOwed := 4 * Block; end; while FTxOwed >= Block do begin TCIFillHeader(H, tstTXChrono, 0, Rate, ST, Block, Chans); C.SendBin(H, nil, 0); FTxOwed := FTxOwed - Block; end; finally FTxLock.Leave; end; end; procedure TTCIAdapter.HandleBinary(Client: TTCIClient; Data: PByte; Len: Integer); // Поток клиента. Единственный бинарный кадр, который нам присылают, — блок // TX-аудио (§3.4). Всё прочее молча отбрасываем: отвечать ошибкой на каждый // чужой блок значит захлебнуться на клиенте, который шлёт их пачками. var H: TTCIStreamHeader; ST: TTCISampleType; P: PByte; N, i, k, Chans, Rate, Factor, Bytes, Want: Integer; Mine: Boolean; begin if (Data = nil) or (Len <= SizeOf(H)) then Exit; Move(Data^, H, SizeOf(H)); if H.StreamType <> LongWord(Ord(tstTXAudio)) then Exit; FTxLock.Enter; try Mine := (FTxClient = Client); finally FTxLock.Leave; end; // Аудио от клиента, который не просил TRX:…,tci, — это не наша модуляция. // Принять его значит подмешать чужой звук в чужую же передачу. if not Mine then Exit; if not FController.TCIMicActive then Exit; if H.Format > LongWord(Ord(tsyFloat32)) then Exit; ST := TTCISampleType(H.Format); Chans := Integer(H.Channels); if Chans < 1 then Chans := 1; if Chans > 2 then Exit; Rate := Integer(H.SampleRate); if not TCIValidAudioRate(Rate) then Exit; // Тракт работает на 48 кГц; целое отношение — единственный случай, который // разрешает протокол (8/12/24/48), поэтому дробных пересчётов тут нет. if TCI_AUDIO_ENGINE_RATE mod Rate <> 0 then Exit; Factor := TCI_AUDIO_ENGINE_RATE div Rate; Bytes := Len - SizeOf(H); P := Data; Inc(P, SizeOf(H)); FTxLock.Enter; try N := TCIUnpackSamples(P, Bytes, ST, FTxRaw); if N <= 0 then Exit; // В аудиопотоке length — это сэмплы НА КАНАЛ (см. TCIFillHeader), значит // вещественных отсчётов в блоке length × channels. Верим меньшему из двух: // клиент вправе прислать короткий хвост, но не длиннее уместившегося. // Заведомо чужое число (мусор в заголовке) просто игнорируем — длину нам // и так ограничил размер кадра. if (H.DataLength > 0) and (H.DataLength <= LongWord(N)) then begin Want := Integer(H.DataLength) * Chans; if Want < N then N := Want; end; // В тракт идёт моно: TXA у нас один, а стерео от клиента — это его // собственный формат вывода, а не два независимых сигнала. if Chans = 2 then begin k := 0; i := 0; while i + 1 < N do begin FTxMono[k] := (FTxRaw[i] + FTxRaw[i + 1]) * 0.5; Inc(k); Inc(i, 2); end; end else begin k := N; for i := 0 to N - 1 do FTxMono[i] := FTxRaw[i]; end; if k <= 0 then Exit; if (FTxInterp = nil) or (FTxInRate <> Rate) then begin FreeAndNil(FTxInterp); FTxInterp := TTCIInterpolator.Create(Factor); FTxInRate := Rate; end; N := FTxInterp.Process(FTxMono, k, FTxOut); finally FTxLock.Leave; end; if N > 0 then FController.PushTCIAudio(FTxOut, N); end; { ═══════════════════════════════════════════════════════════════════════════ Уведомления: изменение состояния контроллера → всем клиентам ═══════════════════════════════════════════════════════════════════════════ } procedure TTCIAdapter.OnState(Sender: TObject; Field: TRadioField); var Rx, Ch: Integer; TxHz: Double; MapChanged: Boolean; Sig: string; begin // Снимок слайсов обновляем ДО всего остального и НЕЗАВИСИМО от того, есть ли // клиенты: подключившийся читает уже готовый снимок, а не заставляет поток // контроллера сниматься по требованию (Invoke из потока клиента ждал бы UI). // Все правки слайсов приходят сюда: сеттеры шлют rfSliceFreq/rfSliceState, // создание и удаление — rfDevice. // Снимок железа — первым: от него зависят и границы частоты, и всё, что // сетевые потоки читают о плате. if Field in [rfDevice, rfConnected, rfDeviceList, rfXvtr, rfBand, rfSampleRate] then RefreshDev; // Пан могли убрать и без правки слайсов — тогда сигнатура карты не менялась, // а поток остался бы висеть на несуществующем приёмнике. if Field in [rfDevice, rfConnected] then DropDeadRxStreams; // Передача кончилась — чья бы она ни была. Забываем хозяина эфира (иначе его // уход когда-нибудь потом снял бы уже чужую передачу) и снимаем просьбу // «модулируй из потока TCI»: она относилась ровно к той передаче, которую // клиент и начал, а следующий PTT оператора обязан идти с его микрофона. if (Field = rfTransmitting) and (FController <> nil) and not FController.FTransmitting then begin ForgetTxOwner; FController.TCIMicRequested := False; end; MapChanged := False; if Field in [rfSliceFreq, rfSliceState, rfDevice, rfPanFreq, rfSampleRate, rfBand, rfXvtr, rfCenterFreq] then begin Sig := SliceMapSig; RefreshSlices; MapChanged := Sig <> SliceMapSig; end; // Границы настройки — тоже до гейта по клиентам: их кэш обязан пережить // время, когда не подключён никто (см. PushVfoLimits). if Field in [rfDevice, rfXvtr, rfBand] then PushVfoLimits; if (FServer = nil) or (FServer.ClientCount = 0) then Exit; // §3.5: инициатор изменения захватывает параметр на 200 мс. Здесь инициатор — // не клиент (оператор, CAT, бэнд-логика), поэтому владелец nil. Если параметр // прямо сейчас крутит клиент, Claim его не отберёт — в том числе когда это // изменение и есть эхо его собственной команды. case Field of rfVfoA: Claim(HoldKey('VFO', 0, 0), nil); rfVfoB: Claim(HoldKey('VFO', 0, 1), nil); rfMode: Claim(HoldKey('MOD', 0, 0), nil); rfFilter, rfFilterBW: Claim(HoldKey('FILT', 0, 0), nil); rfAGCMode: Claim(HoldKey('AGC', 0, 0), nil); rfAGCTop: Claim(HoldKey('AGCT', 0, 0), nil); rfVolume: Claim(HoldKey('VOL', 0, 0), nil); rfMute: Claim(HoldKey('MUTE', 0, 0), nil); rfDrive: Claim(HoldKey('DRIVE', 0, 0), nil); rfTransmitting: Claim(HoldKey('TRX', 0, 0), nil); rfTuning: Claim(HoldKey('TUNE', 0, 0), nil); rfVfoLock: Claim(HoldKey('LOCK', 0, 0), nil); rfCenterFreq: Claim(HoldKey('DDS', 0, 0), nil); rfSliceFreq: if SliceRxCh(FController.FSliceFreqId, Rx, Ch) then Claim(HoldKey('VFO', Rx, Ch), nil); end; 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)); for Ch := 0 to TCI_CHANNELS - 1 do FServer.Broadcast(TCIBuild('vfo_lock', ['0', TCIIntStr(Ch), 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: begin FServer.Broadcast(TCIBuild('if_limits', [TCIIntStr(-(FController.FSampleRate div 2)), TCIIntStr(FController.FSampleRate div 2)])); // Сменился rate устройства — сменилось и то, что мы можем отдать в // потоке IQ (у каждого клиента своё: просьбы разные). Молчать нельзя: // клиент, попросивший 384 кГц на HPSDR, после перехода на Pluto 576 // получит 192 и должен об этом узнать, а не гадать по заголовкам. FServer.EnumClients(PushIQRate); end; rfDevice, rfConnected: // Смена устройства может утянуть за собой и rate (Pluto клампит чужой // rate к своему минимуму молча), поэтому переобъявляем и тут. FServer.EnumClients(PushIQRate); 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; rfActiveVfo: // Сюда же приходит смена split (SetSplit шлёт rfActiveVfo): без этого // переключение TX-VFO из окна программы мимо клиентов проходило молча. FServer.Broadcast(TCIBuild('split_enable', ['0', TCIBoolStr(FController.FSplitTxB)])); rfMonVolume: // Громкость самоконтроля — отдельная величина: раньше её правка уезжала // клиентам как обычный volume, то есть враньём. FServer.Broadcast(TCIBuild('mon_volume', [TCIIntStr(Round(TCIVolumeToDb(FController.FTxMonVolume)))])); rfTXProfile: // Уровень TUN живёт в TX-настройках: сменил его оператор или профиль — // клиентам об этом больше узнать неоткуда. FServer.Broadcast(TCIBuild('tune_drive', ['0', TCIIntStr(FController.FTXSettings.TUNLevel)])); rfCWSettings: begin FServer.Broadcast(TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); FServer.Broadcast(TCIBuild('cw_macros_delay', [TCIIntStr(FController.FCWSettings.RFDelayMS)])); end; end; // Слайс создали или удалили (rfDevice) — у приёмника изменился набор каналов, // и клиент, подключённый до этого, о новом канале не узнает никак. if MapChanged then PushChannelMap; // Частота передачи — отдельным уведомлением, но только когда она реально // изменилась: поле дёргается на каждый шаг ручки. 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 // Значение помним всегда: подключившемуся клиенту фокус уходит в пачке // состояния, а не только по следующей активации окна. FAppFocus := InFocus; if (FServer = nil) or (FServer.ClientCount = 0) then Exit; FServer.Broadcast(TCIBuild('app_focus', [TCIBoolStr(InFocus)])); end; end.