mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
ew8bakandClaude Opus 5
166fc65fc8
Всплесков на передаче нет, инструмент своё отработал и больше не нужен в горячем пути. Снято ровно то, что ставилd209697, и ничего сверх: * удалён юнит TxTrace.pas (кольцо + сброс дампа + TraceInit); * TCIAdapter: точки съёма маркеров и TX-аудио, поля FTxTraceLast/FTxTraceAudio; * HPSDRNetwork: DUC-DRY/DUC-RUN и переменная DryFrom (жила только для них), вместе с ними ушли из uses TxTrace и PlatformUtils — их добавлял тот же коммит, MonotonicUs в этом файле больше нигде не встречается; * RadioController: PTT-метка в SetMOX и сброс дампа на снятии PTT; * TraceInit из ewsdr.lpr и ewsdrd.lpr. Каждая удалённая строка стояла под `if TraceOn` — вычислений, от которых зависит тракт, в них не было. ★PlatformUtils.MonotonicUs НЕ тронут: на нём абсолютные дедлайны планировщика TX, это не отладка. Скрипт разбора test/hpsdr/txtrace_scan.py оставлен, формат дампа не менялся; в README стенда записан рецепт возврата зондов изd209697. Проверено: lazbuild --ws=qt6 и build-ewsdrd.sh собираются, test/tci 260/260, test/cat 50/50 — те же числа, что и с зондами. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01Bkwwyj7xVRrqnSVEseTRfV
4366 lines
204 KiB
ObjectPascal
4366 lines
204 KiB
ObjectPascal
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-аудио у клиента (§3.4) ──
|
||
// Квант = один блок TXA (512 отсчётов движка = 10.667 мс). Просить крупнее
|
||
// нельзя: подушка отправителя DUC — 2000 отсчётов @192 кГц, то есть 10.42 мс,
|
||
// и любой запрос длиннее её по времени оставляет очередь сухой на разницу.
|
||
TCI_TX_QUANTUM_ENGINE = 512;
|
||
// ★Потолок долга обязан быть БОЛЬШЕ окна в полёте, иначе связывающим
|
||
// ограничением становится он, а окно превращается в украшение: при долге,
|
||
// упёртом в потолок, новый маркер можно послать только взамен ответа, то есть
|
||
// темп подачи падает до «окно / время ответа». На клиенте с ответом 55 мс это
|
||
// давало 58% реального времени при полностью исправном клиенте — тракт
|
||
// недокармливался ровно так же, как при потерях. Держим потолок на квант выше
|
||
// окна.
|
||
TCI_TX_OWED_HEADROOM_Q = 1;
|
||
// Долгу разрешено уходить в минус: клиент вправе прислать больше
|
||
// запрошенного, и зажим в ноль заставил бы переспросить уже полученное, то
|
||
// есть подать звук дважды.
|
||
TCI_TX_OWED_FLOOR_Q = 4;
|
||
// Окно в полёте. Глубина конвейера = ceil(задержка ответа / период кванта),
|
||
// поэтому фиксированные 4 кванта сами становятся защёлкой на клиенте с
|
||
// задержкой больше ~42 мс. Растёт по измеренной задержке, но не выше
|
||
// серверного потолка: читать сильно вперёд опасно — у клиента можно
|
||
// вычерпать ещё не сформированный звук, и это отказ МОЛЧАЛИВЫЙ (в эфир уйдут
|
||
// неготовые данные, ни один счётчик их не покажет).
|
||
TCI_TX_WINDOW_MIN_Q = 4;
|
||
TCI_TX_MAX_INFLIGHT_MS = 80;
|
||
// Сторож. Отставание от реального времени видно ровно одним признаком:
|
||
// долг и окно ОДНОВРЕМЕННО стоят у своих потолков. Разность Owed−InFlight для
|
||
// этого не годится — в защёлке обе величины на потолке, и разность выглядит
|
||
// здоровой, как при нормальной работе.
|
||
TCI_TX_STALL_Q = 5; // выдержка насыщения, квантов
|
||
TCI_TX_STALL_RTT_K = 3; // и не меньше стольких оценённых задержек
|
||
TCI_TX_GRACE_MS = 300; // grace на старте: клиент собирает первый блок
|
||
TCI_TX_MARKERS_PER_TICK = 8; // явный потолок пачки за одно пробуждение
|
||
TCI_TX_STALL_MAX_MS = 250; // и не дольше этого: ждать больше нечего
|
||
// ★Аванс под ЗЕРНИСТОСТЬ КЛИЕНТА. Мелкого запроса мало: MSHV пишет свой
|
||
// TX-буфер granule'ами STREAM_C = 4096 отсчётов при 96 кГц (network.cpp), то
|
||
// есть 42.7 мс, и отвечает на маркеры ПАЧКАМИ по 4-5 блоков раз в ~44 мс — как
|
||
// ни дроби запрос. Замер на железе: 218 осушений очереди за 11 с, ровно по
|
||
// одному на пачку, из них 12 длиннее подушки. Лечится только запасом не меньше
|
||
// пачки. Это НЕ регулятор по уровню очереди (тот управлял бы темпом запроса,
|
||
// то есть скоростью звука) — разовая монотонная добавка к долгу с потолком.
|
||
TCI_TX_BURST_GAP_US = 2000; // пауза, разделяющая пачки ответов клиента
|
||
TCI_TX_GAP_MAX_US = 200000; // пауза длиннее — это не зернистость, а сбой
|
||
TCI_TX_LEAD_MAX_MS = 120; // потолок аванса (он же задержка передачи)
|
||
// ★Посев аванса, пока про клиента ничего не известно. Первая передача после
|
||
// подключения иначе стартует с pre-roll 31.75 мс против первого ответа MSHV
|
||
// на 41-й миллисекунде — и сохнет. Обучение к этому моменту физически не
|
||
// успевает: аванс появляется только после первого ответа.
|
||
TCI_TX_LEAD_DEF_MS = 50;
|
||
// Аванс умеет и уменьшаться, иначе посев выше — налог на клиента с мелкой
|
||
// гранулой (у него аванс это чистая задержка). Вниз только по выдержке:
|
||
// осушение дороже лишних миллисекунд задержки.
|
||
TCI_TX_LEAD_DOWN_MS = 3000;
|
||
// Потолок разворота одного блока 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 идут
|
||
// ── Бухгалтерия запросов TX-аудио ──
|
||
// ★ЕДИНИЦЫ: и долг, и окно считаются в КАДРАХ НА КАНАЛ при частоте клиента
|
||
// — ровно в тех, в которых называется квант в маркере. Гасить их надо на k
|
||
// (моно-кадры ДО интерполятора), а не на length из шапки (это значения,
|
||
// вдвое больше при стерео) и не на N после интерполяции (это уже 48 кГц,
|
||
// вшестеро больше у клиента на 8 кГц). Подмена любой из двух величин даёт
|
||
// стабильно неверный темп запроса, который не проявится на 48 кГц моно.
|
||
FTxOwed: Double; // сколько кадров клиент должен нам по часам
|
||
FTxInFlight: Double; // запрошено, но ещё не пришло
|
||
FTxLastUs: Int64; // монотонные часы долга
|
||
FTxProgressUs: Int64; // когда последний раз пришёл валидный блок
|
||
FTxSatSinceUs: Int64; // с какого момента насыщены И долг, И окно (0 — нет)
|
||
FTxArmed: Boolean; // сторож вооружён (после первого ответа/grace)
|
||
FTxReqUs: array[0..63] of Int64; // времена отправки маркеров (FIFO)
|
||
FTxReqHead: Integer;
|
||
FTxReqTail: Integer;
|
||
FTxLatencyUs: Double; // оценка «маркер → ответ», мкс
|
||
FTxWindowQ: Integer; // окно в полёте, квантов
|
||
FTxQuantum: Integer; // текущий квант, кадров на канал
|
||
FTxHealthy: Boolean; // участок без потерь/прощений (можно мерить задержку)
|
||
// ★Мерим ПЕРИОД между пачками, а не их размер. Размер зависит и от того,
|
||
// сколько мы запросили: попросили больше — клиент ответил длиннее — аванс
|
||
// подрос — попросили ещё больше. Это положительная обратная связь. Период
|
||
// же равен внутренней грануле клиента (у MSHV — STREAM_C/96 кГц = 42.7 мс)
|
||
// и от нашего темпа не зависит вовсе.
|
||
FTxGapUs: Double; // оценка периода между пачками, мкс
|
||
FTxLead: Integer; // выданный аванс под зернистость клиента, кадров
|
||
FTxLeadKeep: Integer; // ★он же, но ПЕРЕЖИВАЮЩИЙ конец передачи
|
||
FTxLeadRate: Integer; // частота, при которой аванс измерен
|
||
FTxLeadLowUs: Int64; // с какого момента оценка держится НИЖЕ аванса
|
||
FTxLastRxUs: Int64; // когда пришёл прошлый блок (границы пачек)
|
||
// Рабочие буферы разбора 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 SyncKeyerElement;
|
||
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); // поток контроллера
|
||
procedure PushTapWants; // поток контроллера: кого из слайсов слушают
|
||
procedure WantTaps; // то же, но зовут из любого потока
|
||
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; // планировщик: маркеры времени клиенту
|
||
function TxQuantumFor(C: TTCIClient; Rate: Integer): Integer;
|
||
procedure TxResetAccounting(Rate: Integer; C: TTCIClient);
|
||
procedure TxNoteRequest(NowUs: Int64);
|
||
procedure TxNoteReply(NowUs: Int64);
|
||
procedure TxUpdateWindow(Rate: Integer);
|
||
function TxOwedCap: Double;
|
||
procedure TxPublishLead(Rate: Integer);
|
||
procedure TxPreWarm(Client: TTCIClient; Rx: Integer);
|
||
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 HandleTxTick;
|
||
procedure PushSensors(Client: TTCIClient);
|
||
procedure OnState(Sender: TObject; Field: TRadioField);
|
||
|
||
// ── Отдельные команды (чтобы HandleCommand не превратился в простыню) ──
|
||
procedure CmdFreq(Client: TTCIClient; const M: TTCIMessage; IsIF: Boolean);
|
||
procedure CmdCWMacros(Client: TTCIClient; const M: TTCIMessage; IsMsg: Boolean);
|
||
procedure CmdKeyer(Client: TTCIClient; const M: TTCIMessage);
|
||
procedure CmdSpot(const M: TTCIMessage);
|
||
public
|
||
constructor Create(AController: TRadioController; ASpots: TDXSpotStore = nil);
|
||
destructor Destroy; override;
|
||
|
||
{ Настройки TCI: включение/порт/адрес. Зовётся при старте и из настроек.
|
||
False — включить просили, а порт не открылся (занят/нет прав/кривой
|
||
адрес): вызывающий обязан сказать это оператору, иначе тот останется с
|
||
галкой «включено» и мёртвым сервером. }
|
||
// Диагностика для стенда: состояние бухгалтерии запросов TX-аудио.
|
||
function TxDbgState(out Owed, InFlight: Double;
|
||
out WindowQ, Quantum, LeadFrames: Integer): Boolean;
|
||
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);
|
||
{ Номер TCI-приёмника, за которым стоит слайс Id. Нужен UI: уведомления
|
||
адресуются номерами TCI, а он знает только id слайса. 0 — слайса нет в
|
||
снимке (или Id = 0): адресуем главный тракт, он есть всегда. }
|
||
function RxOfSlice(Id: Integer): Integer;
|
||
{ Статус фокуса главного окна (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;
|
||
FServer.OnTxTick := HandleTxTick;
|
||
|
||
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;
|
||
// ★ПЕРВЫМИ снимаем тапы — тот же порядок, что и в Destroy, и по той же
|
||
// причине: их зовёт DSP-поток. Раньше здесь сначала звали FServer.Stop, а он
|
||
// на шаге 5 освобождает клиентов; тапы в этот момент ещё стояли, и DSP-поток,
|
||
// войдя в OnAudioTap между Stop и StopAllStreams, писал в уже освобождённого
|
||
// клиента (FStreams[i].FeedAudio -> EmitFull -> FClient.SendBin). Ловилось
|
||
// сменой порта или снятием галки «Enable» при живом AUDIO_START/IQ_START.
|
||
SetTaps(False);
|
||
FServer.Stop;
|
||
// Потоки — после остановки сервера: их объекты ссылаются на клиентов.
|
||
StopAllStreams;
|
||
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.SyncKeyerElement;
|
||
// Поток контроллера. FsBool — посылка (иначе пауза), FsInt — её длительность.
|
||
begin
|
||
FController.CWKeyerElement(FsBool, FsInt);
|
||
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(Client: TTCIClient; 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, Final: 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 := '';
|
||
|
||
// Финальный вариант позывного — ДО развёртки повторов: клиенту он нужен
|
||
// как позывной (§3.2.2), а не как «RA6LH RA6LH».
|
||
Final := Call;
|
||
P := Pos('$', Call);
|
||
if P > 0 then
|
||
begin
|
||
Final := Trim(Copy(Call, 1, P - 1));
|
||
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: подтверждение финального варианта позывного — АВТОРУ сообщения, а
|
||
// не всем (у остальных клиентов своих сообщений нет). ★Расхождение со спекой,
|
||
// осознанное: документ шлёт эту команду по факту окончания передачи позывного,
|
||
// а наш передатчик текста моментов внутри очереди не отмечает — подтверждаем
|
||
// сразу. Доотправка позывного (cw_msg:arg1;) всё равно не поддержана, так что
|
||
// финальный вариант известен уже здесь и позже не изменится.
|
||
if IsMsg and (Final <> '') then
|
||
Reply(Client, TCIBuild('callsign_send', [TCIEscape(Final)]));
|
||
end;
|
||
|
||
procedure TTCIAdapter.CmdKeyer(Client: TTCIClient; const M: TTCIMessage);
|
||
// KEYER:arg1,arg2,arg3; — arg1 передатчик, arg2 «ключ нажат», arg3 длительность
|
||
// ПРЕДЫДУЩЕГО интервала в мс (§4.3, «однонаправленное управление»).
|
||
//
|
||
// ★Ключ к команде — что arg3 описывает интервал, который ТОЛЬКО ЧТО кончился, а
|
||
// не тот, который начинается. Документ описывает это алгоритмом: первое нажатие
|
||
// даёт keyer:0,true,0, отпускание — keyer:0,false,142, то есть «посылка длилась
|
||
// 142 мс», следующее нажатие — keyer:0,true,58, то есть «пауза длилась 58 мс».
|
||
// Отсюда правило перевода в элементы: тип интервала — это состояние ключа ДО
|
||
// фронта, то есть ОБРАТНОЕ пришедшему (пришло false — кончилась посылка).
|
||
// Первое сообщение (arg3 = 0) играть нечего: оно лишь открывает передачу.
|
||
//
|
||
// Почему элементы, а не «дёрнуть ключ прямо сейчас»: между клиентом и нами
|
||
// сеть, и манипуляция по приходу пакетов — это её джиттер в эфире. Ради этого
|
||
// в протоколе и заведён третий аргумент; проигрывает очередь TCWElemPlayer.
|
||
var
|
||
Rx, Ms: Integer;
|
||
Down: Boolean;
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[TCIEscape(LowerCase(M.Name)), 'bad receiver']));
|
||
Exit;
|
||
end;
|
||
// Номер объявлен потолком железа, но пана под ним может не быть — как у TRX.
|
||
if (Rx > 0) and not RxActive(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[TCIEscape(LowerCase(M.Name)), 'receiver is not running']));
|
||
Exit;
|
||
end;
|
||
if not TCITryArgBool(M, 1, Down) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error', [TCIEscape(LowerCase(M.Name)), 'bad state']));
|
||
Exit;
|
||
end;
|
||
if not TCITryArgInt(M, 2, Ms) then Ms := 0;
|
||
if Ms <= 0 then Exit; // первое нажатие: играть ещё нечего
|
||
// Ключ — это передатчик, а он один: держит его тот же, кто держит TRX (§3.5).
|
||
// Чужую передачу с чужого ключа не портим.
|
||
if not Claim(HoldKey('TRX', 0, 0), Client) then Exit;
|
||
if Down then
|
||
begin
|
||
// Кончилась ПАУЗА (ключ был отпущен).
|
||
if Ms > TCI_KEYER_GAP_MAX_MS then Ms := TCI_KEYER_GAP_MAX_MS;
|
||
end
|
||
else if Ms > TCI_KEYER_MARK_MAX_MS then
|
||
Ms := TCI_KEYER_MARK_MAX_MS;
|
||
FLock.Enter;
|
||
try
|
||
FsBool := not Down; // посылка, если ключ ОТПУСТИЛИ
|
||
FsInt := Ms;
|
||
if CanInvoke then FController.Invoke(SyncKeyerElement);
|
||
finally
|
||
FLock.Leave;
|
||
end;
|
||
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',
|
||
[TCIEscape(LowerCase(M.Name)), 'bad receiver']));
|
||
Exit;
|
||
end;
|
||
// Номер объявлен (TRX_COUNT = потолок железа), но пана под ним может не
|
||
// быть вовсе. Свести такую просьбу к главному VFO — то же самое, что
|
||
// передать на чужой частоте, только молча.
|
||
if (Rx > 0) and not RxActive(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[TCIEscape(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;
|
||
// ★До SetMOX: запрос клиенту вперёд подготовки тракта (см. TxPreWarm).
|
||
if FromTCI then TxPreWarm(Client, Rx);
|
||
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;
|
||
// ★Будим планировщик немедленно. Иначе первый маркер уходил на
|
||
// 10-20 мс позже фронта PTT (дремотный шаг), и ровно этих
|
||
// миллисекунд не хватало нулевому pre-roll, чтобы дожить до первого
|
||
// ответа клиента: очередь DUC пересыхала на старте каждой передачи.
|
||
FServer.KickTxTick;
|
||
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 = 'KEYER' then begin CmdKeyer(Client, M); Exit; end;
|
||
if M.Name = 'CW_MACROS' then begin CmdCWMacros(Client, M, False); Exit; end;
|
||
if M.Name = 'CW_MSG' then begin CmdCWMacros(Client, 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.HandleTxTick;
|
||
begin
|
||
// Свой поток планировщика: исключение здесь остановило бы подачу модуляции
|
||
// до перезапуска сервера.
|
||
// ★Под замком освобождения клиентов: FTxClient указывает на объект, который
|
||
// тик-поток вправе освободить в любой момент, а этот поток — не тот, что
|
||
// раньше пользовался этим указателем.
|
||
FServer.BeginTxClientUse;
|
||
try
|
||
try
|
||
PushTxChrono;
|
||
except
|
||
// молча: следующий тик попробует снова
|
||
end;
|
||
finally
|
||
FServer.EndTxClientUse;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.HandleTick;
|
||
begin
|
||
// Тик крутится в своём потоке сервера: исключение здесь остановило бы
|
||
// измерители у ВСЕХ клиентов до перезапуска сервера.
|
||
try
|
||
FServer.EnumClients(PushSensors);
|
||
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;
|
||
// Слайс мог быть замьючен: без этого первый же блок для клиента не посчитался
|
||
// бы вовсе. Синхронно и ДО ответа клиенту — тогда не теряется ни один блок.
|
||
if K = tstRXAudio then WantTaps;
|
||
end;
|
||
|
||
procedure TTCIAdapter.PushTapWants;
|
||
// Поток контроллера. Кому из слайсов нужен демодулятор, даже когда оператор
|
||
// убрал у него звук: ровно тем, на кого есть живой поток RX_AUDIO.
|
||
//
|
||
// ★Считаем только RX_AUDIO. LINE_OUT и рекордер снимаются ПОСЛЕ мьюта (см.
|
||
// ProcessSlicesFor: FOnSliceAudio идёт за «if Muted then Continue»), поэтому на
|
||
// молчащем слайсе им и так достаётся тишина — считать его ради них незачем.
|
||
// Главный тракт (Rx 0) этим гейтом не управляется вовсе: он не слайс.
|
||
//
|
||
// ★Список слушателей снимаем под FStreamLock и отпускаем его ДО похода в
|
||
// движок: DSP-поток входит в тап, уже держа FSliceLock движка, и берёт в нём
|
||
// FStreamLock — противоположный порядок здесь дал бы классический клин.
|
||
var
|
||
Want: array[0..MAX_SLICES-1] of Boolean;
|
||
i, Rx, Id: Integer;
|
||
begin
|
||
if FController = nil then Exit;
|
||
FillChar(Want, SizeOf(Want), 0);
|
||
FStreamLock.Enter;
|
||
try
|
||
for i := 0 to High(FStreams) do
|
||
if (FStreams[i] <> nil) and (FStreams[i].Kind = tstRXAudio) then
|
||
begin
|
||
Rx := FStreams[i].Rx;
|
||
if (Rx >= 1) and (Rx <= MAX_SLICES) then Want[Rx - 1] := True;
|
||
end;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
// Номер приёмника — это слот слайса плюс один, поэтому идём по слотам: карта
|
||
// могла и поехать (слайс удалили — следующие сдвинулись), и флаг обязан
|
||
// сняться со старого хозяина слота ровно так же, как встать на нового.
|
||
for i := 0 to MAX_SLICES - 1 do
|
||
begin
|
||
Id := FController.SliceIdBySlot(i);
|
||
if Id > 0 then FController.SetSliceTapWanted(Id, Want[i]);
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.WantTaps;
|
||
// Потоки заводят и гасят потоки клиентов, а таблицу слайсов трогает только
|
||
// поток контроллера — поэтому через Invoke. CanInvoke=False бывает ровно на
|
||
// остановке сервера, и останавливает его как раз он: зовём напрямую.
|
||
begin
|
||
if FController = nil then Exit;
|
||
if CanInvoke then FController.Invoke(PushTapWants) else PushTapWants;
|
||
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);
|
||
Break;
|
||
end;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
// Слушателей у слайса могло не остаться — снимаем с него демодулятор. Строго
|
||
// ПОСЛЕ удаления записи: иначе гейт закрылся бы раньше, чем ушёл хвост.
|
||
if K = tstRXAudio then WantTaps;
|
||
end;
|
||
|
||
procedure TTCIAdapter.DropClientStreams(C: TTCIClient);
|
||
var i, j: Integer;
|
||
Had: Boolean;
|
||
begin
|
||
Had := False;
|
||
FStreamLock.Enter;
|
||
try
|
||
i := 0;
|
||
while i <= High(FStreams) do
|
||
if (FStreams[i] <> nil) and (FStreams[i].Client = C) then
|
||
begin
|
||
if FStreams[i].Kind = tstRXAudio then Had := True;
|
||
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;
|
||
if Had then WantTaps; // ушедший клиент мог быть последним слушателем слайса
|
||
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;
|
||
PushTapWants; // уже поток контроллера
|
||
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;
|
||
// Потоков не осталось — снимаем демодулятор со всех молчащих слайсов. Зовут
|
||
// нас из потока контроллера (ApplySettings, Destroy), Invoke не нужен.
|
||
PushTapWants;
|
||
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',
|
||
[TCIEscape(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',
|
||
[TCIEscape(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',
|
||
[TCIEscape(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',
|
||
[TCIEscape(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',
|
||
[TCIEscape(LowerCase(M.Name)), 'no file name']));
|
||
Exit;
|
||
end;
|
||
// MP3 у нас кодировать нечем — молча подсунуть WAV с расширением .mp3 хуже,
|
||
// чем сказать правду: клиент такой файл всё равно не откроет. Проверяем до
|
||
// TCIRecordPath, чтобы у самой частой причины отказа был свой текст.
|
||
if SameText(ExtractFileExt(Req), '.mp3') then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[TCIEscape(LowerCase(M.Name)), 'only wav is supported']));
|
||
Exit;
|
||
end;
|
||
// ★Каталог всегда наш, из просьбы берётся одно имя файла — см. TCIRecordPath.
|
||
Path := TCIRecordPath(RecordDir, Req);
|
||
if Path = '' then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[TCIEscape(LowerCase(M.Name)), 'bad file name']));
|
||
Exit;
|
||
end;
|
||
// Существующий файл не трогаем (окончательно это решит O_EXCL в писателе,
|
||
// здесь — только чтобы клиент услышал причину).
|
||
if FileExists(Path) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error', [TCIEscape(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',
|
||
[TCIEscape(LowerCase(M.Name)), 'nothing recorded']));
|
||
Exit;
|
||
end;
|
||
// Пишет отдельный поток: файл может быть в десятки мегабайт, а мы сейчас в
|
||
// потоке клиента, который в это время не читает свой сокет. ★Поток ОДИН и
|
||
// принадлежит адаптеру: очередь заданий ограничена, а при закрытии
|
||
// программы её дожидаются (см. TTCIWavWriter).
|
||
if not EnqueueWav(Path, Rec, Rate) then
|
||
begin
|
||
// Очередь полна (медленный диск) — запись отдать некому, значит и её
|
||
// место в бюджете держать больше незачем.
|
||
TCIRecBudgetFree(Rec.Reserved);
|
||
Reply(Client, TCIBuild('tci_error', [TCIEscape(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;
|
||
// Ушёл клиент — ушла и его зернистость: следующий может быть любым.
|
||
FTxLeadKeep := 0;
|
||
FTxLead := 0;
|
||
FTxGapUs := 0;
|
||
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;
|
||
|
||
function TTCIAdapter.TxQuantumFor(C: TTCIClient; Rate: Integer): Integer;
|
||
// Квант запроса в КАДРАХ НА КАНАЛ при частоте клиента. Целимся в один блок TXA
|
||
// (512 отсчётов движка): крупнее — очередь DUC сохнет на разнице с подушкой,
|
||
// мельче — растёт накладной расход на кадры WebSocket без выигрыша.
|
||
// Сверху ограничен размером блока, который клиент сам себе назначил: просить
|
||
// больше, чем он умеет собрать, бессмысленно.
|
||
begin
|
||
Result := Ceil(TCI_TX_QUANTUM_ENGINE * Rate / TCI_AUDIO_ENGINE_RATE);
|
||
if Result < TCI_AUDIO_SAMPLES_MIN then Result := TCI_AUDIO_SAMPLES_MIN;
|
||
Result := Min(Result, EnsureRange(C.AudioSamples, TCI_AUDIO_SAMPLES_MIN,
|
||
TCI_AUDIO_SAMPLES_MAX));
|
||
end;
|
||
|
||
procedure TTCIAdapter.TxResetAccounting(Rate: Integer; C: TTCIClient);
|
||
// Начало передачи. Под FTxLock.
|
||
begin
|
||
FTxQuantum := TxQuantumFor(C, Rate);
|
||
FTxInFlight := 0;
|
||
FTxLastUs := MonotonicUs;
|
||
FTxProgressUs := FTxLastUs;
|
||
FTxSatSinceUs := 0;
|
||
FTxArmed := False;
|
||
FTxReqHead := 0;
|
||
FTxReqTail := 0;
|
||
FTxLatencyUs := 0;
|
||
FTxHealthy := True;
|
||
FTxWindowQ := TCI_TX_WINDOW_MIN_Q;
|
||
FTxLastRxUs := 0;
|
||
// ★Аванс — свойство КЛИЕНТА, а не передачи: его зернистость от PTT к PTT не
|
||
// меняется. Обучение внутри передачи не успевает к первому же всплеску, зато
|
||
// прошлый результат готов сразу. Обнуляется он только при смене клиента или
|
||
// параметров его потока (см. ClearTxClient / смена rate-channels-samples).
|
||
FTxLead := FTxLeadKeep;
|
||
if FTxLead <= 0 then
|
||
FTxLead := (TCI_TX_LEAD_DEF_MS * Rate) div 1000; // посев, см. константу
|
||
FTxLeadLowUs := 0;
|
||
|
||
// Стартовый долг — РОВНО подушка, которую попросил сам клиент. Аванс сюда
|
||
// НЕ прибавляется, и это не упущение.
|
||
// ★Запас под зернистость клиента физически лежит в очереди DUC, а не в долге:
|
||
// на фронте PTT туда заливается FTxLead тишины (SetMOX → PrimeDUCIQ, размер
|
||
// берётся из TCITxLeadFrames). Очередь расходуется реальным временем и
|
||
// пополняется тем же темпом, поэтому залитая пачка нулей остаётся в ней до
|
||
// конца передачи — это и есть постоянный запас. Прибавить тот же аванс ещё и
|
||
// к долгу значило бы попросить у клиента вдобавок столько же ЗВУКА и сложить
|
||
// оба запаса в одну очередь: задержка передачи выросла бы вдвое без всякой
|
||
// пользы. Второе применение аванса — потолок долга (см. TxOwedCap): он даёт
|
||
// бухгалтерии место, чтобы пережить пачку, не упираясь в потолок.
|
||
FTxOwed := Rate * (C.TxBuffering / 1000.0);
|
||
end;
|
||
|
||
procedure TTCIAdapter.TxNoteRequest(NowUs: Int64);
|
||
// Запомнить время отправки маркера (FIFO — ответы сопоставляем по порядку).
|
||
var NextHead: Integer;
|
||
begin
|
||
NextHead := (FTxReqHead + 1) mod Length(FTxReqUs);
|
||
if NextHead = FTxReqTail then Exit; // кольцо полно — старейшее уже неинтересно
|
||
FTxReqUs[FTxReqHead] := NowUs;
|
||
FTxReqHead := NextHead;
|
||
end;
|
||
|
||
procedure TTCIAdapter.TxNoteReply(NowUs: Int64);
|
||
// Пришёл блок: снимаем старейший неотвеченный маркер и обновляем оценку
|
||
// задержки «маркер → ответ». ★Оценку двигаем ТОЛЬКО на здоровом участке: после
|
||
// потери соответствие ответов маркерам неоднозначно, и один пропуск притворился
|
||
// бы огромной задержкой, раздул окно и вытянул из клиента лишний backlog.
|
||
var Sample: Double;
|
||
begin
|
||
if FTxReqTail = FTxReqHead then Exit;
|
||
Sample := NowUs - FTxReqUs[FTxReqTail];
|
||
FTxReqTail := (FTxReqTail + 1) mod Length(FTxReqUs);
|
||
if not FTxHealthy then Exit;
|
||
if Sample < 0 then Exit;
|
||
if FTxLatencyUs <= 0 then
|
||
FTxLatencyUs := Sample
|
||
else if Sample > FTxLatencyUs then
|
||
FTxLatencyUs := FTxLatencyUs + 0.50 * (Sample - FTxLatencyUs) // вверх быстро
|
||
else
|
||
FTxLatencyUs := FTxLatencyUs + 0.02 * (Sample - FTxLatencyUs); // вниз медленно
|
||
// ★Потолок обязателен. Ответы сопоставляются маркерам FIFO по временам
|
||
// отправки, и после потери соответствие смещается: ответ на СЛЕДУЮЩИЙ маркер
|
||
// засчитывается старому, оценка взлетает на порядок. Она входит и в размер
|
||
// окна, и в выдержку сторожа — без потолка одна потеря растягивала выдержку до
|
||
// секунд, и зависшие кредиты не прощались почти всю передачу.
|
||
if FTxLatencyUs > TCI_TX_MAX_INFLIGHT_MS * 1000 then
|
||
FTxLatencyUs := TCI_TX_MAX_INFLIGHT_MS * 1000;
|
||
end;
|
||
|
||
function TTCIAdapter.TxDbgState(out Owed, InFlight: Double;
|
||
out WindowQ, Quantum, LeadFrames: Integer): Boolean;
|
||
begin
|
||
FTxLock.Enter;
|
||
try
|
||
Owed := FTxOwed;
|
||
InFlight := FTxInFlight;
|
||
WindowQ := FTxWindowQ;
|
||
Quantum := FTxQuantum;
|
||
LeadFrames := FTxLead;
|
||
Result := FTxRunning;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.TxPreWarm(Client: TTCIClient; Rx: Integer);
|
||
// Поток клиента, ДО SetMOX. Один маркер вперёд всей подготовки тракта.
|
||
//
|
||
// ★Зачем: MSHV отвечает на первый маркер только через ~41 мс, а сам маркер
|
||
// уходил лишь после того, как SetMOX отработает реле, pre-roll и PureSignal —
|
||
// ещё 9-17 мс. Эти два ожидания шли последовательно, и нулевого pre-roll не
|
||
// хватало: очередь DUC сохла на старте КАЖДОЙ первой передачи. Отправив запрос
|
||
// до Invoke, мы кладём раздумья клиента поверх собственной подготовки.
|
||
//
|
||
// Заявку могут и отклонить (запрет на диапазоне, DMR, нет Auto TX у слайса) —
|
||
// тогда запрошенный звук просто пропадёт: HandleBinary отбрасывает блоки, пока
|
||
// TCIMicActive не поднят. В бухгалтерию маркер не заносим: она считает долг по
|
||
// часам, а долгу разрешено уходить в минус, когда клиент прислал больше.
|
||
var
|
||
Rate, Chans, Q, Seed: Integer;
|
||
ST: TTCISampleType;
|
||
H: TTCIStreamHeader;
|
||
begin
|
||
if Client = nil then Exit;
|
||
// ★Только если заявка вообще имеет шанс: передатчик свободен и чужого
|
||
// источника на нём нет. Иначе конкурирующий клиент, чью просьбу мы сейчас
|
||
// отклоним, получил бы запрос на модуляцию — а он на него ответит звуком,
|
||
// который нам не нужен и который придётся выбрасывать.
|
||
FTxLock.Enter;
|
||
try
|
||
if (FTxClient <> nil) and (FTxClient <> Client) then Exit;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
if FController.FTransmitting or FController.FTuning then Exit;
|
||
Rate := Client.AudioRate;
|
||
if not TCIValidAudioRate(Rate) then Rate := TCI_AUDIO_RATE_DEF;
|
||
Chans := EnsureRange(Client.AudioChannels, 1, 2);
|
||
if not TCISampleTypeByName(Client.AudioSampleType, ST) then ST := tsyFloat32;
|
||
Q := TxQuantumFor(Client, Rate);
|
||
if Q <= 0 then Exit;
|
||
|
||
// Аванс контроллеру — ДО SetMOX: там по нему заливается нулевой pre-roll.
|
||
FTxLock.Enter;
|
||
try
|
||
Seed := FTxLeadKeep;
|
||
if (Seed <= 0) or (FTxLeadRate <> Rate) then
|
||
Seed := (TCI_TX_LEAD_DEF_MS * Rate) div 1000;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
FController.TCITxLeadFrames := Round(Seed * TCI_AUDIO_ENGINE_RATE / Rate);
|
||
|
||
TCIFillHeader(H, tstTXChrono, Rx, Rate, ST, Q, Chans);
|
||
Client.SendBinNow(H);
|
||
end;
|
||
|
||
procedure TTCIAdapter.TxPublishLead(Rate: Integer);
|
||
// Аванс переживает передачу и уходит контроллеру: по нему SetMOX растягивает
|
||
// нулевой pre-roll DUC на старте СЛЕДУЮЩЕЙ передачи — это и есть тот запас,
|
||
// который держит очередь между пачками клиента.
|
||
begin
|
||
FTxLeadKeep := FTxLead;
|
||
FTxLeadRate := Rate;
|
||
if Rate > 0 then
|
||
FController.TCITxLeadFrames :=
|
||
Round(FTxLead * TCI_AUDIO_ENGINE_RATE / Rate);
|
||
end;
|
||
|
||
function TTCIAdapter.TxOwedCap: Double;
|
||
// Потолок долга — на квант выше окна в полёте (см. TCI_TX_OWED_HEADROOM_Q).
|
||
// ★Плюс аванс: без этого потолок срезал бы его сразу после выдачи, и запас под
|
||
// пачки клиента не появился бы вовсе.
|
||
begin
|
||
Result := (FTxWindowQ + TCI_TX_OWED_HEADROOM_Q) * FTxQuantum + FTxLead;
|
||
end;
|
||
|
||
procedure TTCIAdapter.TxUpdateWindow(Rate: Integer);
|
||
// Окно в полёте по оценённой задержке ответа. Гистерезис зашит в саму оценку
|
||
// (вверх быстро, вниз медленно), поэтому здесь только арифметика и потолки.
|
||
var
|
||
PeriodUs, WantQ, MaxQ: Integer;
|
||
begin
|
||
if (FTxQuantum <= 0) or (Rate <= 0) then Exit;
|
||
PeriodUs := Round(FTxQuantum * 1000000.0 / Rate);
|
||
if PeriodUs <= 0 then Exit;
|
||
WantQ := TCI_TX_WINDOW_MIN_Q;
|
||
if FTxLatencyUs > 0 then
|
||
WantQ := Max(WantQ, Ceil(FTxLatencyUs / PeriodUs) + 2);
|
||
// Серверный потолок — во времени звука в полёте, а не в квантах: он про то,
|
||
// насколько далеко нам позволено забегать вперёд по буферу клиента.
|
||
MaxQ := Max(TCI_TX_WINDOW_MIN_Q,
|
||
(TCI_TX_MAX_INFLIGHT_MS * 1000) div PeriodUs);
|
||
FTxWindowQ := Min(WantQ, MaxQ);
|
||
end;
|
||
|
||
procedure TTCIAdapter.PushTxChrono;
|
||
// Планировщик TX_CHRONO (свой поток сервера, абсолютные дедлайны).
|
||
//
|
||
// Долг растёт по часам, гасится ТОЛЬКО фактически принятым звуком. Маркер
|
||
// уходит, пока непокрытая часть долга больше кванта:
|
||
//
|
||
// Owed − InFlight >= Q
|
||
//
|
||
// ★Сторож. Потерянный ответ навсегда занимает слот в InFlight: сам по себе один
|
||
// такой слот темпа не ломает (долг и окно просто стоят выше), но накопившись до
|
||
// потолка окна они дают ЗАЩЁЛКУ — условие выдачи перестаёт выполняться, маркеры
|
||
// прекращаются, и в эфир идёт тишина до конца посылки. Признак — долгое
|
||
// ОДНОВРЕМЕННОЕ насыщение долга и окна; частично замороженный конвейер при этом
|
||
// продолжает отдавать звук (медленнее реального времени), поэтому сторожа по
|
||
// одному лишь молчанию клиента недостаточно.
|
||
var
|
||
C: TTCIClient;
|
||
NowUs, PeriodUs, StallUs: Int64;
|
||
Rate, Chans, Q, Rx, Sent, LeadWant: Integer;
|
||
ST: TTCISampleType;
|
||
H: TTCIStreamHeader;
|
||
Active, Saturated: Boolean;
|
||
begin
|
||
FTxLock.Enter;
|
||
try
|
||
C := FTxClient;
|
||
Rx := FTxRx;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
if C = nil then
|
||
begin
|
||
FServer.TxTickPeriodMs := 0;
|
||
Exit;
|
||
end;
|
||
|
||
Active := FController.TCIMicActive;
|
||
NowUs := MonotonicUs;
|
||
Rate := C.AudioRate;
|
||
if not TCIValidAudioRate(Rate) then Rate := TCI_AUDIO_RATE_DEF;
|
||
Chans := EnsureRange(C.AudioChannels, 1, 2);
|
||
if not TCISampleTypeByName(C.AudioSampleType, ST) then ST := tsyFloat32;
|
||
|
||
FTxLock.Enter;
|
||
try
|
||
if not Active then
|
||
begin
|
||
FTxRunning := False;
|
||
FServer.TxTickPeriodMs := 0;
|
||
Exit;
|
||
end;
|
||
|
||
if not FTxRunning then
|
||
begin
|
||
FTxRunning := True;
|
||
TxResetAccounting(Rate, C);
|
||
end
|
||
else
|
||
begin
|
||
FTxOwed := FTxOwed + Rate * ((NowUs - FTxLastUs) / 1000000.0);
|
||
FTxLastUs := NowUs;
|
||
// Квант держим согласованным с текущими параметрами клиента: он вправе
|
||
// сменить их посреди передачи.
|
||
Q := TxQuantumFor(C, Rate);
|
||
if Q <> FTxQuantum then FTxQuantum := Q;
|
||
// Клиент сменил параметры потока — прежний аванс измерен не про него.
|
||
if Rate <> FTxLeadRate then
|
||
begin
|
||
FTxLeadRate := Rate;
|
||
FTxLeadKeep := 0;
|
||
FTxLead := 0;
|
||
FTxGapUs := 0;
|
||
end;
|
||
TxUpdateWindow(Rate);
|
||
if FTxOwed > TxOwedCap then FTxOwed := TxOwedCap;
|
||
end;
|
||
|
||
Q := FTxQuantum;
|
||
if Q <= 0 then Exit;
|
||
|
||
// ★Аванс под зернистость клиента. Пачка в N кадров означает, что между
|
||
// пачками очередь обязана прожить N кадров без подпитки, а подушка
|
||
// отправителя — всего 10.4 мс. Выдаём разницу ОДИН раз на каждое новое
|
||
// значение максимума: это не обратная связь по уровню очереди (та управляла
|
||
// бы темпом запроса, то есть скоростью звука), а разовый сдвиг фазы.
|
||
LeadWant := Min(Max(Round(FTxGapUs * Rate / 1000000.0) + Q, Q),
|
||
(TCI_TX_LEAD_MAX_MS * Rate) div 1000);
|
||
if LeadWant > FTxLead then
|
||
begin
|
||
FTxLead := LeadWant;
|
||
FTxLeadLowUs := 0;
|
||
TxPublishLead(Rate);
|
||
end
|
||
// Вниз — только когда оценка держится ниже целый TCI_TX_LEAD_DOWN_MS.
|
||
// Гистерезис в один квант: дрожание оценки вокруг текущего значения не
|
||
// должно раскачивать аванс.
|
||
else if LeadWant < FTxLead - Q then
|
||
begin
|
||
if FTxLeadLowUs = 0 then FTxLeadLowUs := NowUs
|
||
else if NowUs - FTxLeadLowUs > TCI_TX_LEAD_DOWN_MS * 1000 then
|
||
begin
|
||
FTxLead := LeadWant;
|
||
FTxLeadLowUs := NowUs;
|
||
TxPublishLead(Rate);
|
||
end;
|
||
end
|
||
else
|
||
FTxLeadLowUs := 0;
|
||
PeriodUs := Round(Q * 1000000.0 / Rate);
|
||
// ★Планировщик будим ВДВОЕ чаще кванта. Маркер может уйти только на
|
||
// пробуждении, поэтому шаг пробуждений — это и есть зернистость запроса:
|
||
// при шаге, равном кванту, интервалы слипаются в 1P/2P ровно так же, как
|
||
// раньше слипались в 2P/3P на общем тике 20 мс. Половина периода даёт
|
||
// превышение не больше половины кванта — это внутри подушки DUC.
|
||
FServer.TxTickPeriodMs := Max(1, Integer(PeriodUs div 2000));
|
||
|
||
// Сторож вооружается после первого валидного ответа либо по истечении
|
||
// стартового grace: пока клиент собирает первый блок, насыщение долга
|
||
// закономерно и прощать нечего.
|
||
if (not FTxArmed) and
|
||
(NowUs - FTxProgressUs > TCI_TX_GRACE_MS * 1000) then
|
||
FTxArmed := True;
|
||
|
||
// ★Выдержку считаем по ОДНОМУ долгу: он растёт по часам и гасится только
|
||
// принятым звуком, поэтому «долг у потолка» и значит «отстаём от реального
|
||
// времени», какова бы ни была причина. Здоровый конвейер сюда не попадает
|
||
// даже на медленном канале: там долг стоит около объёма данных в полёте,
|
||
// то есть на добрых три кванта НИЖЕ потолка (потолок = окно + квант).
|
||
// ★А вот второе условие (окно выбрано целиком) в выдержку брать нельзя:
|
||
// частично замороженный конвейер продолжает отвечать, InFlight на каждом
|
||
// ответе проседает ниже порога — и таймер, привязанный к нему, обнулялся бы
|
||
// на каждом круге, никогда не досчитывая до срока. Ровно это и наблюдалось:
|
||
// с шестью зависшими кредитами выдача жила на одном слоте, но прощение не
|
||
// срабатывало ни разу.
|
||
Saturated := FTxOwed >= TxOwedCap - FTxQuantum;
|
||
if Saturated then
|
||
begin
|
||
if FTxSatSinceUs = 0 then FTxSatSinceUs := NowUs;
|
||
StallUs := Max(Int64(TCI_TX_STALL_Q) * PeriodUs,
|
||
Round(TCI_TX_STALL_RTT_K * FTxLatencyUs));
|
||
if StallUs > TCI_TX_STALL_MAX_MS * 1000 then
|
||
StallUs := TCI_TX_STALL_MAX_MS * 1000;
|
||
if FTxArmed and (NowUs - FTxSatSinceUs > StallUs) and
|
||
(FTxInFlight >= (FTxWindowQ - 1) * FTxQuantum) then
|
||
begin
|
||
// Прощаем ровно один квант и начинаем выдержку заново: поздний ответ
|
||
// безопасен, он уведёт долг в минус и сам притормозит выдачу.
|
||
FTxInFlight := Max(0, FTxInFlight - Q);
|
||
// ★Срок сдвигаем НА выдержку, а не на «сейчас». Зависших кредитов может
|
||
// быть несколько, и прощение по одному за выдержку живого времени
|
||
// затягивало возврат на секунды: четыре потери подряд оставляли конвейер
|
||
// на одном рабочем слоте почти всю передачу. Так первый срок остаётся
|
||
// подтверждением («мы точно отстаём»), а дальше просроченное списывается
|
||
// подряд, пока условие держится.
|
||
FTxSatSinceUs := FTxSatSinceUs + StallUs;
|
||
FTxHealthy := False; // оценку задержки на этом участке не трогаем
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
FTxSatSinceUs := 0;
|
||
if FTxInFlight <= 0 then FTxHealthy := True;
|
||
end;
|
||
|
||
Sent := 0;
|
||
while (FTxOwed - FTxInFlight >= Q) and
|
||
(FTxInFlight + Q <= FTxWindowQ * Q) and
|
||
(Sent < TCI_TX_MARKERS_PER_TICK) 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, Q, Chans);
|
||
// ★Мимо очереди отправки: она выпускается только на пробуждении потока
|
||
// клиента (recv с таймаутом TCI_POLL_MS = 20 мс), а квант запроса — 10.7
|
||
// мс. Через очередь маркеры выходили бы пачками раз в 20 мс, и подача
|
||
// клиента снова стала бы рваной — тот же дефект, что и на старом тике.
|
||
C.SendBinNow(H);
|
||
FTxInFlight := FTxInFlight + Q;
|
||
TxNoteRequest(NowUs);
|
||
Inc(Sent);
|
||
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;
|
||
NowUs: Int64;
|
||
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;
|
||
|
||
// ★Погашение бухгалтерии. Единица — k, моно-кадры ДО интерполятора: ровно
|
||
// в них назван квант в маркере. Не H.DataLength (значения, вдвое больше
|
||
// при стерео) и не N ниже (уже 48 кГц, вшестеро больше у клиента на 8 кГц).
|
||
// Долгу разрешено уйти в минус — клиент вправе прислать больше, чем
|
||
// просили, и зажим в ноль заставил бы переспросить уже полученное.
|
||
// Прогресс отмечаем по САМОМУ ФАКТУ валидного блока, независимо от значений
|
||
// отсчётов: первые ответы MSHV — законные нули (network.cpp, ветка
|
||
// _reset_sta_ <= 5), и сторож не должен считать их отсутствием прогресса.
|
||
NowUs := MonotonicUs;
|
||
// Границы пачки: клиент отвечает не на каждый маркер по отдельности, а
|
||
// очередями по нескольку блоков — по своей внутренней зернистости записи.
|
||
// Меряем самую крупную пачку: под неё и нужен аванс.
|
||
if (FTxLastRxUs > 0) and (NowUs - FTxLastRxUs > TCI_TX_BURST_GAP_US) and
|
||
(NowUs - FTxLastRxUs < TCI_TX_GAP_MAX_US) then
|
||
begin
|
||
// Вверх быстро, вниз медленно: занизить период опаснее, чем завысить —
|
||
// занижение сразу вернёт осушения, завышение стоит лишь задержки.
|
||
if FTxGapUs <= 0 then FTxGapUs := NowUs - FTxLastRxUs
|
||
else if (NowUs - FTxLastRxUs) > FTxGapUs then
|
||
FTxGapUs := FTxGapUs + 0.50 * ((NowUs - FTxLastRxUs) - FTxGapUs)
|
||
else
|
||
FTxGapUs := FTxGapUs + 0.02 * ((NowUs - FTxLastRxUs) - FTxGapUs);
|
||
end;
|
||
FTxLastRxUs := NowUs;
|
||
FTxInFlight := Max(0, FTxInFlight - k);
|
||
FTxOwed := FTxOwed - k;
|
||
if FTxQuantum > 0 then
|
||
FTxOwed := Max(FTxOwed, -TCI_TX_OWED_FLOOR_Q * FTxQuantum);
|
||
FTxProgressUs := NowUs;
|
||
FTxArmed := True;
|
||
TxNoteReply(NowUs);
|
||
|
||
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, который её и читает. Итог на живом железе: клиент на слайсе
|
||
// поднимал эфир, а модуляция шла с микрофона оператора, то есть в эфир —
|
||
// тишина.
|
||
// ★Слушаем и rfTuning: выключение TUN гасит эфир изнутри SetTune, где
|
||
// SetMOX(False) шлёт rfTransmitting, пока FTuning ещё True (сброс флага идёт
|
||
// строкой ниже). Заднего фронта по одному rfTransmitting тут не видно, и
|
||
// хозяин эфира оставался протухшим: уход того клиента когда-нибудь потом
|
||
// снимал уже чужую — операторскую — передачу.
|
||
if (Field in [rfTransmitting, rfTuning]) 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;
|
||
|
||
// Карта слайсов поехала: слот сменил хозяина, и «этот слайс слушают» обязано
|
||
// переехать вместе с ним — слайс, занявший слот, приходит с чистым флагом, а
|
||
// на прежнем он остался бы висеть навсегда. Мы в потоке контроллера.
|
||
if MapChanged then PushTapWants;
|
||
|
||
// Границы настройки — тоже до гейта по клиентам: их кэш обязан пережить
|
||
// время, когда не подключён никто (см. 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
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TTCIAdapter.RxOfSlice(Id: Integer): Integer;
|
||
var Rx, Ch: Integer;
|
||
begin
|
||
if SliceRxCh(Id, Rx, Ch) then Result := Rx else Result := 0;
|
||
end;
|
||
|
||
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.
|