Files
ewsdr/TCIAdapter.pas
T
ew8bakandClaude Opus 5 66892fc7e0 fix(tci): пара «клиент+приёмник» только по факту передачи; перебор имён .part
[P1] FTxClient/FTxRx писались ДО Invoke, и команда, которая ничего не сделала,
всё равно их перебивала. Клиент, уже передающий с приёмника 1, шлёт
trx:0,true,tci — передатчик занят, SyncSetTRX не делает ничего (Started=False),
а маркеры ИДУЩЕЙ передачи с этого мига уходят под номером 0. MSHV такие блоки
отбрасывает (network.cpp:231), то есть передача просто замолкает. Теперь пара
назначается после Invoke и только при Started — тем же признаком, по которому
назначается хозяин эфира. Тот же гейт закрывает близнеца: trx:<N>,true без
',tci' поверх своей же передачи больше не снимает источник модуляции. Снятие
(',false') работает как прежде.

[P2] Имя временного файла (pid + счётчик) уникально внутри процесса, но не
между запусками: «.part», оставшийся от прошлой жизни (публиковать было
нечем), плюс повторно выданный системой pid дают EEXIST на создании — и
задание пропадало молча. TCICreateTempNear перебирает до 64 имён, но только
пока ошибка — «имя занято»: нет прав или каталога перебором не лечится.

Стенд test/tci: 219 проверок (было 217). Новое — занятое имя «.part» записи не
теряет (стенд занимает ровно то имя, которое возьмёт писатель) и пустая
команда TRX не меняет номер приёмника в маркерах. Негативный контроль на обе
правки. Попутно в тесте поправлены два комментария, описывавшие прежнюю
реализацию публикации.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-08-19 22:02:40 +03:00

3721 lines
162 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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);
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;
// Источник модуляции и НОМЕР ПРИЁМНИКА, под которым идут маркеры
// TX_CHRONO (см. PushTxChrono), — по тому же правилу: меняем их
// ТОЛЬКО когда команда и правда что-то сделала.
// ★Раньше пара «клиент+приёмник» писалась до Invoke, и команда, которая
// ничего не изменила, всё равно её перебивала: клиент, уже
// передававший с приёмника 1, присылает trx:0,true,tci — передатчик
// занят, SyncSetTRX не делает ничего, а маркеры его же идущей передачи
// с этого мига уходят под номером 0. MSHV такие блоки отбрасывает
// (network.cpp:231), то есть передача просто замолкает.
if B then
begin
if Started and FromTCI then
begin
FTxClient := Client;
FTxRx := Rx;
end
// Эфир поднял он же, но модуляцию просит НЕ из TCI — снимаем свою.
else if Started and (not Tune) and (FTxClient = Client) then
begin
FTxClient := nil;
FTxRx := 0;
end;
end
// Сам просит выключить — источник ему больше не нужен в любом случае.
else if (not Tune) and (FTxClient = Client) then
begin
FTxClient := nil;
FTxRx := 0;
end;
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:<N>,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.