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, PlatformUtils, DXSpotStore, TCIProtocol, TCIServer, TCIStreams; const // ★Приёмник TCI: 0 — главный тракт (каналы A/B = VFO A/B), N — слайс СЛОТА // N−1, то есть буквы B..G с флага, независимо от того, на каком он пане. // Панадаптером приёмник быть перестал: у Pluto пан ровно один (MaxPans=1), // и «второй приёмник» там существует только как слайс главного пана — при // нумерации по панам он был бы недоступен вовсе. А клиенты умеют мало // номеров: у MSHV в настройках всего rx1/rx2, то есть приёмники 0 и 1. // Со слотами правило «первый добавленный слайс = приёмник 1» держится на // любом железе: на openHPSDR слайс второго пана и на Pluto слайс главного // одинаково занимают слот B. Пан стал свойством слайса (его центр и IQ). TCI_MAX_RX = 1 + MAX_SLICES; // Аудио на выходе движка всегда 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; FWriter: TTCIWavWriter; // писатель WAV: один поток с очередью FTapsOn: Boolean; // тапы навешены на контроллер/движок // ── TX-аудио от клиента (§3.4) ── FTxLock: TCriticalSection; FTxClient: TTCIClient; // кто модулирует (nil — никто) FTxRx: Integer; // ЕГО номер приёмника (из TRX) — см. PushTxChrono FTrxOwner: TTCIClient; // кто поставил трансивер в эфир (§4.2) FLastTxOn: Boolean; // было ли радио в эфире на прошлом rfTransmitting 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; FsBool3: Boolean; FsRes: Boolean; // ОБРАТНО из Sync-метода (под тем же FLock) FsStr: string; // ── Sync-методы (поток контроллера) ── procedure SyncSetVfo; procedure SyncSetCenter; procedure SyncSetMode; procedure SyncSetFilter; procedure SyncSetTRX; procedure SyncStopTRX; 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); function EnqueueWav(const APath: string; const R: TTCIRecTake; ARate: Integer): Boolean; procedure DropClientRecorders(C: TTCIClient); // клиент ушёл — и запись с ним procedure SweepRecorders; // тик: истёкшие окна записи function RecordDir: string; // каталог, куда пишем WAV 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; function LiveRx(Rx: Integer): Boolean; // номер в потолке И приёмник существует function RxSlot(Rx: Integer): Integer; // слот слайса; −1 = главный тракт function RxPanId(Rx: Integer): Integer; // пан приёмника; −1 = приёмника нет 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; function TxRx: Integer; // приёмник, чей слайс сейчас источник передачи { Захват параметра (§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(Rx: Integer): string; function StrTune(Rx: Integer): 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 BroadcastTxEnable; // всем живым приёмникам, каждому со своим номером 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; FWriter := nil; // заводится на первом SAVE (см. EnqueueWav) // Состояние передачи на старте: фронт «было-стало» ловим с него (см. OnState). FLastTxOn := (AController <> nil) and (AController.FTransmitting or AController.FTuning); 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; // ★Писателя гасим ЗДЕСЬ и с ожиданием: раньше SAVE запускал ничей поток с // FreeOnTerminate, и штатный выход из программы обрывал запись на полуслове // (из 100000044 байт на диске оставалось 40960). Ждём ВСЮ очередь без срока: // за каждую запись в ней клиенту сказано «сохранено» (см. TCIStopWriter). TCIStopWriter(FWriter); 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; { ═══════════════════════════════════════════════════════════════════════════ Модель: приёмник 0 = главный тракт (каналы = VFO A/B), приёмник N = слайс слота N−1 (буквы B..G). См. комментарий у TCI_MAX_RX. ═══════════════════════════════════════════════════════════════════════════ } function TTCIAdapter.RxCount: Integer; // Потолок, а не число живых: TRX_COUNT протокол объявляет один раз, при // подключении (§4.1). Про приёмник, которого сейчас нет, просто молчим. begin Result := TCI_MAX_RX; end; function TTCIAdapter.ValidRx(Rx: Integer): Boolean; begin Result := (Rx >= 0) and (Rx < RxCount); end; function TTCIAdapter.LiveRx(Rx: Integer): Boolean; // Адресат команды. Про приёмник, которого нет (слот пуст), молчим целиком: // ответ с нулями клиент принял бы за настоящее состояние. begin Result := ValidRx(Rx) and RxActive(Rx); end; function TTCIAdapter.RxSlot(Rx: Integer): Integer; // Слот слайса, стоящего за приёмником Rx. −1 — это главный тракт (rx0) либо // номер вне потолка. begin if (Rx <= 0) or (Rx >= TCI_MAX_RX) then Result := -1 else Result := Rx - 1; end; function TTCIAdapter.RxActive(Rx: Integer): Boolean; // Приёмник существует. Для слайса это значит «слот занят»: удалили слайс — // приёмник исчез, и врать про его частоту нельзя (см. SendState). var Slot: Integer; begin if Rx = 0 then Exit(True); Slot := RxSlot(Rx); if Slot < 0 then Exit(False); FSliceLock.Enter; try Result := FSliceSnap[Slot].Used; finally FSliceLock.Leave; end; 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); FServer.Broadcast(StrDds(Rx)); for Ch := 0 to N - 1 do BroadcastRxState(Rx, Ch); FServer.Broadcast(TCIBuild('rx_channel_enable', [TCIIntStr(Rx), '1', TCIBoolStr(N > 1)])); // ★С адресом приёмника — иначе клиент его не увидит. Клиенты фильтруют // входящие по arg1 (см. StrTrx), а MSHV на этом ещё и завязывает передачу: // `set_ptt` начинается с `if (!tci_tx_enable) return;`. Слайс, созданный // ПОСЛЕ подключения клиента, без этой строки получал бы молча мёртвую PTT. FServer.Broadcast(StrTxEnable(Rx)); end; end; function TTCIAdapter.SnapSlice(Rx, Ch: Integer; out V: TSliceView): Boolean; // Слайс приёмника Rx из снимка. У приёмника-слайса канал один — A: второго // «саб-приёмника» внутри слайса не бывает. Для Rx=0 слайса нет вовсе: главный // тракт живёт в полях контроллера. var Slot: Integer; begin Result := False; FillChar(V, SizeOf(V), 0); Slot := RxSlot(Rx); if (Slot < 0) or (Ch <> 0) then Exit; FSliceLock.Enter; try if FSliceSnap[Slot].Used then begin V := FSliceSnap[Slot].V; Result := True; end; finally FSliceLock.Leave; end; end; function TTCIAdapter.RxPanId(Rx: Integer): Integer; // На каком пане живёт приёмник: у главного тракта это пан 0, у слайса — тот, // где он стоит. Отсюда берутся его центр (DDS) и поток IQ. var V: TSliceView; begin if Rx = 0 then Exit(0); if SnapSlice(Rx, 0, V) then Result := V.PanId else Result := -1; end; function TTCIAdapter.SliceIdOf(Rx, Ch: Integer): Integer; // Слайс приёмника Rx (канал A) из снимка. 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-методов: они идут в потоке // контроллера, где чтение безопасно, а снимок мог бы отстать на такт — команда // на установку обязана попасть в тот слайс, который есть сейчас. var Slot: Integer; begin Result := 0; Slot := RxSlot(Rx); if (Slot < 0) or (Ch <> 0) then Exit; Result := FController.SliceIdBySlot(Slot); 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: Integer; begin Result := False; Rx := 0; Ch := 0; if Id <= 0 then Exit; FSliceLock.Enter; try for i := 0 to MAX_SLICES - 1 do if FSliceSnap[i].Used and (FSliceSnap[i].V.Id = Id) then begin Rx := i + 1; Ch := 0; Exit(True); 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; // У главного тракта два канала (VFO A/B), у приёмника-слайса — один: канал B // в протоколе это второй саб-приёмник, а внутри слайса такого нет. begin if Rx = 0 then Exit(2); if RxActive(Rx) then Result := 1 else Result := 0; 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; // Слайса нет — приёмника нет: частоту не выдумываем (SendState про такой // номер молчит целиком). if SnapSlice(Rx, Ch, S) then Result := S.TargetHz; end; function TTCIAdapter.RxCenterHz(Rx: Integer): Double; // DDS приёмника — центр панорамы, на которой он живёт. У слайса это центр его // пана: для главного пана — FCenterFreq, для дополнительного — его DDC. var Pan: Integer; begin Result := 0; Pan := RxPanId(Rx); if Pan < 0 then Exit; if Pan = 0 then Result := FController.FCenterFreq else Result := FController.PanDDCFreq(Pan); 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.TxRx: Integer; // Номер приёмника, чей слайс СЕЙЧАС источник передачи (0 = главный VFO). // Ответы и уведомления TRX/TUNE обязаны называть именно его: клиент на // приёмнике 1, получивший «trx:0,true», решил бы, что его команда не прошла, а // клиент на приёмнике 0 — что в эфире он, хотя передаёт чужой слайс. var Rx, Ch: Integer; begin Result := 0; if FController = nil then Exit; if (FController.TxSliceId > 0) and SliceRxCh(FController.TxSliceId, Rx, Ch) then Result := Rx; end; function TTCIAdapter.StrTrx(Rx: Integer): string; // Состояние передатчика ДЛЯ ПРИЁМНИКА Rx: «true» значит, что в эфире именно // его слайс. Клиенты фильтруют входящие строки по номеру приёмника (MSHV, // например, отбрасывает всё, что адресовано не ему), поэтому автору команды // отвечаем ЕГО номером: `trx:1,false` — это «твоя заявка не прошла», а // `trx:0,false` он бы просто не увидел. В рассылку уходит номер того, чей // слайс сейчас источник передачи (`TxRx`). begin Result := TCIBuild('trx', [TCIIntStr(Rx), TCIBoolStr(FController.FTransmitting and (TxRx = Rx))]); end; function TTCIAdapter.StrTune(Rx: Integer): string; begin Result := TCIBuild('tune', [TCIIntStr(Rx), TCIBoolStr(FController.FTuning and (TxRx = Rx))]); 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.BroadcastTxEnable; // TX_ENABLE — величина всего радио, но адресуется приёмником, и клиент читает // только строки со СВОИМ номером. Одной строки `tx_enable:0,…` мало: клиент на // приёмнике 1 её отбрасывает, а у MSHV на этом флаге висит вся передача // (`set_ptt`: `if (!tci_tx_enable) return;`). var Rx: Integer; begin if (FServer = nil) or (FServer.ClientCount = 0) then Exit; for Rx := 0 to RxCount - 1 do if RxActive(Rx) then FServer.Broadcast(StrTxEnable(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(TxRx)); Reply(Client, StrTune(TxRx)); 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); DropClientRecorders(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 границ не // клампит, число уходит прямо в backend. if not FreqSaneLive(FsFreq) then Exit; // Двигать можно только центр главной панорамы — она и есть приёмник 0. // У приёмника-слайса DDS только читается: панорама под ним общая, и увести // её по просьбе одного клиента значит утащить за собой всех соседей по пану // и картинку оператора. Слайсу двигаться незачем — за окном DDC следит // TuneSliceInBand (см. SyncSetVfo). if FsInt = 0 then FController.SetCenter(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; // Поток контроллера. FsInt — номер приёмника из arg1, FsBool3 — это TUNE. // Наружу отдаёт FsRes: «эфир подняла ИМЕННО ЭТА команда» — по нему в потоке // клиента назначается хозяин передачи. // // ★Все решения принимаются здесь, а не в потоке клиента. Между разбором // команды и её исполнением оператор успевает нажать PTT, и снимок «шла ли // передача», снятый заранее, соврал бы — а по нему назначается хозяин эфира, // то есть право снять чужую передачу. var Id: Integer; WasTx, Started: Boolean; begin FsRes := False; WasTx := FController.FTransmitting or FController.FTuning; // Источник модуляции ставим ДО SetMOX — именно он его и читает при выборе // микрофона. Выключение передачи флаг снимает всегда: следующий раз оператор // может нажать PTT сам, и тогда в эфир должен идти его микрофон. // ★Ставим его ТОЛЬКО когда эфир поднимаем мы сами. SetMOX(True) поверх уже // идущей передачи не выходит рано — он заново выбирает микрофон, и // «trx:0,true,tci» посреди передачи оператора молча уводил модуляцию в ринг // TCI. Хозяином эфира клиент при этом не становился, так что его уход // оставлял в эфире несущую с тишиной. У TUNE источника нет вовсе (несущую // даёт генератор тона), и трогать чужой выбор микрофона он не вправе. if not FsBool3 then begin if not FsBool then FController.TCIMicRequested := False else if not WasTx then FController.TCIMicRequested := FsBool2; end; // Приёмник 0 — это главный VFO, то есть «радио целиком»: ведём себя как // обычный CAT-порт (в эфир уходит выбранный оператором TX-источник). Приёмник // N > 0 адресует слайс канала A своего пана — заявка идёт через контроллер, // который один имеет право сменить TX-источник. Id := SliceIdLive(FsInt, 0); if FsBool and WasTx then begin // Передатчик занят — чужую передачу не перехватываем и поверх неё ничего не // включаем: то же правило, что внутри RequestSliceTx, только оно обязано // работать и для приёмника 0. Иначе «tune:0,true» подмешивал настроечный // тон в чужую передачу, а хозяином TUN не становился никто — и после ухода // клиента тон оставался в эфире. Своя же передача и так идёт: повторная // команда — no-op. end else if FsInt > 0 then begin // Пан жив, но слайса на канале A может не быть (пан без слайсов показывает // центр) — тогда просьба просто не исполняется. Подменять её главным VFO // нельзя: это чужая частота, а то и чужой диапазон. if Id > 0 then FController.RequestSliceTx(Id, FsBool, FsBool3); end else if FsBool3 then FController.SetTune(FsBool) else FController.SetMOX(FsBool); Started := FsBool and (not WasTx) and (FController.FTransmitting or FController.FTuning); FsRes := Started; // Заявку могли отклонить (нет Auto TX у слайса, DMR, запрет передачи на // диапазоне) — тогда снимаем и источник модуляции: иначе следующая PTT // оператора ушла бы в эфир с микрофоном ушедшего клиента вместо его // собственного. if FsBool and (not FsBool3) and (not WasTx) and (not Started) then FController.TCIMicRequested := False; end; procedure TTCIAdapter.SyncStopTRX; // Поток контроллера. Передачу, начатую ушедшим клиентом, снимаем безусловно: // решение принято там, где известно, кто её начал, а здесь остаётся только // проверить, что она вообще идёт (оператор мог отпустить PTT сам). begin if FController = nil then Exit; if not (FController.FTransmitting or FController.FTuning) then Exit; FController.TCIMicRequested := False; // TUN снимаем именно SetTune: он гасит и тон, и PTT, и возвращает drive. // SetMOX(False) поверх включённого TUN оставил бы взведённым генератор тона, // а FTuning — поднятым, то есть аппарат в состоянии, которого на экране нет. if FController.FTuning then FController.SetTune(False) else 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.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:1,0,0» клиент принял бы за // настоящую частоту, а MSHV именно этим ответом завершает инициализацию // (network.cpp, Network::initAll) — то есть подключился бы к пустоте. if (Ch >= ChanCount(Rx)) or not RxActive(Rx) 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, Tune, Started: 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 LiveRx(Rx) then Exit; // Двигать центр можно только у приёмника 0 — у главной панорамы. У // приёмника-слайса DDS читается (центр его пана), но не пишется: панорама // под ним общая, и увести её по просьбе одного клиента значит утащить // соседей по пану и картинку оператора. Ответ уходит всегда — с текущим // значением, как и у AGC_GAIN доп. приёмника (§3.1). if (Rx = 0) and (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 LiveRx(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 LiveRx(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; // ── Передача ── // ★arg1 у TRX/TUNE — НОМЕР ПЕРЕДАТЧИКА, и он не декорация: клиент, работающий // на приёмнике N, просит эфир своему слайсу, а не тому, который оператор // выбрал мышкой. Игнорировать его значит передать на чужой частоте, а с // кросс-бандовым мультислайс-TX — и на чужом диапазоне, с чужими антенной и // фильтрами. Поэтому номер разбирается и проверяется, как везде, а исполнение // для N > 0 идёт через RequestSliceTx — ту же дверь, что у CAT-порта слайса // (там же и «в эфире только один», и уважение к флагу Auto TX). if (M.Name = 'TRX') or (M.Name = 'TUNE') then 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; // Номер объявлен (TRX_COUNT = потолок железа), но пана под ним может не // быть вовсе. Свести такую просьбу к главному VFO — то же самое, что // передать на чужой частоте, только молча. if (Rx > 0) and not RxActive(Rx) then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'receiver is not running'])); Exit; end; // Ключ захвата (§3.5) — общий на радио, а не на приёмник: передатчик один, // и два клиента, дёргающие эфир с разных приёмников, спорят именно за него. if TCITryArgBool(M, 1, B) and Claim(HoldKey('TRX', 0, 0), Client) then begin // arg3 — источник сигнала (только у TRX). Наш только 'tci': модуляция // берётся из аудиопотока этого клиента. Остальные значения // (mic1/mic2/micpc/ecoder2) называют физические входы ExpertSDR3, которых // у нас нет, — они значат «микрофон, выбранный в программе», то есть ровно // то, что и без arg3. Требование «включен аудиопоток по TCI» (§4.2) // проверяем буквально: без AUDIO_START модулировать нечем, и молча // оставить оператора с тишиной в эфире хуже, чем передавать с его // микрофона. Tune := M.Name = 'TUNE'; Name := LowerCase(Trim(TCIArg(M, 2))); FromTCI := B and (not Tune) and (Name = 'tci') and HasAudioStream(Client); FTxLock.Enter; try // ★Вместе с клиентом запоминаем НОМЕР ПРИЁМНИКА, которым он назвался: // маркеры TX_CHRONO обязаны идти под ним же (см. PushTxChrono). if FromTCI then begin FTxClient := Client; FTxRx := Rx; end else if (not Tune) and (FTxClient = Client) then begin FTxClient := nil; FTxRx := 0; end; finally FTxLock.Leave; end; Started := False; FLock.Enter; try FsInt := Rx; FsBool := B; FsBool2 := FromTCI; FsBool3 := Tune; FsRes := False; if CanInvoke then FController.Invoke(SyncSetTRX); Started := FsRes; // ответ Sync-метода — под тем же локом, что и вопрос finally FLock.Leave; end; // Кто поставил трансивер в эфир: его уход обязан эфир и снять (см. // StopTxOf). Источник модуляции тут ни при чём — несущую без хозяина // оставлять нельзя в любом случае. ★Хозяином записываемся, только если // эфир и правда начался ИМЕННО от этой команды — а знает об этом только // сам Sync-метод: он один видит состояние передатчика до и после, на // потоке контроллера и без окна, в которое влезает PTT оператора. FTxLock.Enter; try if Started then FTrxOwner := Client else if (not B) and (FTrxOwner = Client) then FTrxOwner := nil; finally FTxLock.Leave; end; end; // ★Автору отвечаем ЕГО номером приёмника (см. StrTrx): клиент фильтрует // входящие по arg1, и отказ, названный чужим номером, до него не дойдёт. if M.Name = 'TUNE' then Reply(Client, StrTune(Rx)) else Reply(Client, StrTrx(Rx)); 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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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 LiveRx(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; SweepRecorders; 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 // ★Частота IQ — свойство ПАНОРАМЫ, а приёмник теперь слайс: спрашиваем // рейт того пана, на котором он стоит. SrcRate := FController.IQTapRateHz(RxPanId(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 принадлежит это аудио. Главный тракт (SliceId = 0 на // пане 0) — приёмник 0, любой слайс — приёмник своего слота, на каком бы пане // он ни стоял. Зовётся из DSP-потока и берёт FSliceLock — ДО FStreamLock // (порядок!). var i: Integer; begin Result := -1; if SliceId <= 0 then begin if PanId = 0 then Result := 0; Exit; end; FSliceLock.Enter; try for i := 0 to MAX_SLICES - 1 do if FSliceSnap[i].Used and (FSliceSnap[i].V.Id = SliceId) then Exit(i + 1); finally FSliceLock.Leave; end; 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 движка, поэтому здесь тем более нельзя ждать. // // IQ — величина ПАНОРАМЫ, а приёмник теперь слайс: поток получают все // приёмники, чьи слайсы стоят на этом пане (и приёмник 0, если пан главный). // Карту «приёмник → пан» строим ДО FStreamLock: порядок локов один на весь // адаптер — FSliceLock, потом FStreamLock. var i: Integer; Mine: array[0..TCI_MAX_RX-1] of Boolean; begin if (N <= 0) or (RateHz <= 0) then Exit; if (PanId < 0) or (PanId >= MAX_PANS) then Exit; for i := 0 to TCI_MAX_RX - 1 do Mine[i] := RxPanId(i) = PanId; FStreamLock.Enter; try for i := 0 to High(FStreams) do if (FStreams[i].Kind = tstIQ) and (FStreams[i].Rx >= 0) and (FStreams[i].Rx < TCI_MAX_RX) and Mine[FStreams[i].Rx] 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, Req: string; Rec: TTCIRecTake; // куски записи + их место в бюджете 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 // ★Только ЖИВОЙ приёмник. Раньше хватало номера в потолке, а у мёртвого // приёмника Feed не зовут вовсе — значит и срок записи никто не проверял: // рекордер висел до перезапуска сервера. Отвечаем как потокам. if not RxActive(Rx) then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'receiver is not running'])); Exit; end; if not TCITryArgInt(M, 1, Sec) then Sec := TCI_RECORD_MAX_SEC; Sec := EnsureRange(Sec, 1, TCI_RECORD_MAX_SEC); // Объект заводим ДО лока — не ради памяти (её он больше не выделяет, см. // TTCIRecorder), а чтобы не звать чужой конструктор под локом DSP-потока. // Владельца помним: уйдёт клиент — уйдёт и его запись. New_ := TTCIRecorder.Create(Rx, TCI_AUDIO_ENGINE_RATE, Sec, Client); 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 Req := TCIUnescape(TCIArg(M, 1)); if Req = '' then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'no file name'])); Exit; end; // MP3 у нас кодировать нечем — молча подсунуть WAV с расширением .mp3 хуже, // чем сказать правду: клиент такой файл всё равно не откроет. Проверяем до // TCIRecordPath, чтобы у самой частой причины отказа был свой текст. if SameText(ExtractFileExt(Req), '.mp3') then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'only wav is supported'])); Exit; end; // ★Каталог всегда наш, из просьбы берётся одно имя файла — см. TCIRecordPath. Path := TCIRecordPath(RecordDir, Req); if Path = '' then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'bad file name'])); Exit; end; // Существующий файл не трогаем (окончательно это решит O_EXCL в писателе, // здесь — только чтобы клиент услышал причину). if FileExists(Path) then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'file exists'])); Exit; end; // Забираем рекордер из таблицы (сохранение завершает запись, §4.3) и только // потом снимаем с него данные: копия кольца — это десятки мегабайт, и делать // её под локом DSP-потока нельзя. Rec.Chunks := nil; Rec.Chunk := 0; Rec.Count := 0; Rec.Reserved := 0; Rate := TCI_AUDIO_ENGINE_RATE; FStreamLock.Enter; try Old := FRec[Rx]; FRec[Rx] := nil; finally FStreamLock.Leave; end; if Old <> nil then begin // ★Куски записи переезжают писателю КАК ЕСТЬ, вместе со своим местом в // бюджете: сплошная копия удваивала бы пик, а невыпущенный резерв был бы // дырой в потолке. Rec := Old.Take; Rate := Old.Rate; Old.Free; end; if Rec.Count <= 0 then begin // Резерва тут быть неоткуда (кусок выделяется только под сэмпл, который // тут же и пишется), но возвращаем на всякий случай: единственный путь, // на котором запись не доходит до писателя. TCIRecBudgetFree(Rec.Reserved); Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'nothing recorded'])); Exit; end; // Пишет отдельный поток: файл может быть в десятки мегабайт, а мы сейчас в // потоке клиента, который в это время не читает свой сокет. ★Поток ОДИН и // принадлежит адаптеру: очередь заданий ограничена, а при закрытии // программы её дожидаются (см. TTCIWavWriter). if not EnqueueWav(Path, Rec, Rate) then begin // Очередь полна (медленный диск) — запись отдать некому, значит и её // место в бюджете держать больше незачем. TCIRecBudgetFree(Rec.Reserved); Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'writer busy'])); end; end; function TTCIAdapter.EnqueueWav(const APath: string; const R: TTCIRecTake; ARate: Integer): Boolean; // Писателя заводим на первом сохранении: большинству операторов рекордер не // нужен вовсе, и держать ради них спящий поток незачем. Зовут из потока // клиента, поэтому создание — под FStreamLock. begin FStreamLock.Enter; try if FWriter = nil then FWriter := TTCIWavWriter.Create; finally FStreamLock.Leave; end; Result := FWriter.Enqueue(APath, R, ARate); end; procedure TTCIAdapter.DropClientRecorders(C: TTCIClient); // ★Клиент ушёл — забираем его записи. Рекордер живёт на приёмнике, а не на // клиенте (второй такой же был бы копией памяти), но платит за него тот, кто // нажал START: без этого пары «подключился, START, отключился» набивали память // до потолка бюджета, и вернуть её было некому до перезапуска сервера. var Rx: Integer; Dead: array[0..TCI_MAX_RX-1] of TTCIRecorder; begin if C = nil then Exit; FStreamLock.Enter; try for Rx := 0 to TCI_MAX_RX - 1 do begin Dead[Rx] := nil; if (FRec[Rx] <> nil) and (FRec[Rx].Owner = TObject(C)) then begin Dead[Rx] := FRec[Rx]; FRec[Rx] := nil; end; end; finally FStreamLock.Leave; end; // Освобождаем вне лока: его ждёт DSP-поток, а деструктор трогает свой лок. for Rx := 0 to TCI_MAX_RX - 1 do Dead[Rx].Free; end; procedure TTCIAdapter.SweepRecorders; // Тик сервера. ★Срок записи раньше проверял только Feed, то есть DSP-поток — // а он к рекордеру замьюченного, молчащего или пропавшего приёмника не приходит // вовсе. Окно закрывается по ЧАСАМ от START (§4.3), значит и спрашивать про // него надо по часам, а не по звуку. var Rx: Integer; Dead: array[0..TCI_MAX_RX-1] of TTCIRecorder; begin FStreamLock.Enter; try for Rx := 0 to TCI_MAX_RX - 1 do begin Dead[Rx] := nil; if (FRec[Rx] <> nil) and FRec[Rx].Expired then begin Dead[Rx] := FRec[Rx]; FRec[Rx] := nil; end; end; finally FStreamLock.Leave; end; for Rx := 0 to TCI_MAX_RX - 1 do Dead[Rx].Free; end; function TTCIAdapter.RecordDir: string; // Каталог записей: настройка, а пусто — <каталог конфигурации>/records. // Каталог создаём здесь же: писатель работает в своём потоке и сказать об // отсутствии каталога ему уже некому. begin Result := Trim(FCfg.RecordDir); if Result = '' then Result := GetAppCfgDir + 'records'; Result := IncludeTrailingPathDelimiter(Result); if not DirectoryExists(Result) then if not ForceDirectories(Result) then Result := ''; 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; FTxRx := 0; 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, Rx: Integer; ST: TTCISampleType; H: TTCIStreamHeader; Active: Boolean; begin FTxLock.Enter; try C := FTxClient; Rx := FTxRx; 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 // ★Номер приёмника — ТОТ, которым назвался клиент в TRX, а не 0. // Клиент фильтрует ВХОДЯЩИЕ БИНАРНЫЕ блоки по receiver (MSHV, // network.cpp:231: `if (pStream->receiver != tci_trx) return;`), а // TX-аудио шлёт ровно в ответ на этот маркер (там же, ветка TxChrono). // С нулём клиент на втором слайсе (tci_trx = 1) поднимал эфир и молчал: // маркеры до него не доходили вовсе. TCIFillHeader(H, tstTXChrono, Rx, 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), то есть // ровно то, сколько их и распаковалось. Верим меньшему из двух: клиент // вправе прислать короткий хвост, но не длиннее уместившегося. Заведомо // чужое число (мусор в заголовке) просто игнорируем — длину нам и так // ограничил размер кадра. Так же считает и MSHV, когда сам заполняет // заголовок: `t_txStream->length = (cr3/bit_s)`, где cr3 — байты блока. if H.DataLength > 0 then begin Want := Integer(H.DataLength); 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, TxNow: 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 оператора обязан идти с его микрофона. // ★Ловим именно ФРОНТ «было-стало», а не всякий rfTransmitting. Это поле // контроллер шлёт и просто «перерисуй TX-бейджи»: SetTxSlice заканчивается // Changed(rfTransmitting), хотя эфира ещё нет. По прежнему условию такой // сигнал приходил ПОСЕРЕДИНЕ нашей же команды trx:,true,tci (SyncSetTRX // ставит просьбу → RequestSliceTx → SetTxSlice → Changed) и стирал её ДО // SetMOX, который её и читает. Итог на живом железе: клиент на слайсе // поднимал эфир, а модуляция шла с микрофона оператора, то есть в эфир — // тишина. if (Field = rfTransmitting) and (FController <> nil) then begin TxNow := FController.FTransmitting or FController.FTuning; if FLastTxOn and (not TxNow) then begin ForgetTxOwner; FController.TCIMicRequested := False; end; FLastTxOn := TxNow; 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); // Передатчик один — и ключ захвата у него один на всех, кто его дёргает: // и TRX, и TUNE, и оператор. Отдельный ключ 'TUNE' делал защиту дырявой — // TUN поверх чужого MOX не спорил с ним ни за что. rfTransmitting, rfTuning: Claim(HoldKey('TRX', 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(TxRx)); rfTuning: FServer.Broadcast(StrTune(TxRx)); 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 // (она отсчитывается от центра), хотя абсолютная частота могла остаться // прежней. Какие это приёмники — знает RxPanId: слайсы одного пана // раскиданы по слотам, подряд они не лежат. for Rx := 1 to RxCount - 1 do if RxPanId(Rx) > 0 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 BroadcastTxEnable; 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; BroadcastTxEnable; 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.