mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
ew8bakandClaude Opus 5
7aae0fdfcd
Потолок 128 МБ всё ещё пробивался примерно вдвое на пике: Take собирал
линейную копию ДО освобождения FChunks, поэтому при полном бюджете рядом
жили ~128 МБ кусков и ~128 МБ копии, а счётчик показывал 128. Передача
резерва писателю (9b77809) закрывала учёт, но не сам пик.
Копии больше нет вовсе. Take отдаёт куски КАК ЕСТЬ — новый TTCIRecTake
(Chunks + Chunk + Count + Reserved), — и вместе с ними уезжает их место в
бюджете целиком. TTCIWavWriter пишет куски в файл подряд: в WAV сэмплы и
так лежат встык, а хвост последнего куска за Count просто не наш. Место
отпускается в ReleaseData, ровно один раз на любом пути выхода Execute.
Продовый путь теперь не выделяет под запись ни одного лишнего байта:
TTCIPcm остался только внутри куска. Склейка нужна одному стенду, чтобы
проверять порядок и уровень, — она и живёт в стенде (FlatTake).
Стенд 199/199: 2.5 с записи отдаются ТРЕМЯ кусками по секунде (свёрнутая
копия дала бы один), счёт бюджета при Take не меняется, резерва хватает
на отданные куски, склеенные куски дают непрерывный звук, писатель
возвращает резерв по окончании. Проверено, что копирующая реализация Take
краснит четыре проверки. GUI (--ws=qt6) и демон зелёные.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
3640 lines
156 KiB
ObjectPascal
3640 lines
156 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-аудио в 48 кГц: 8192 отсчёта int16 на
|
||
// 8 кГц дают ×6. Больше в блок не влезает по протоколу (data[16384]).
|
||
TCI_TX_OUT_MAX = (TCI_STREAM_DATA_MAX div 2) * 6;
|
||
// Захват параметра клиентом (§3.5): пока владелец его крутит, остальные
|
||
// могут только слушать. Без этого два логгера перетягивают частоту друг у
|
||
// друга бесконечно.
|
||
TCI_HOLD_MS = 200;
|
||
TCI_HOLD_SLOTS = 64;
|
||
|
||
type
|
||
{ Параметры TCI, которым в ewsdr нет соответствия: храним и отражаем. }
|
||
TTCIRxEcho = record
|
||
RitOn, XitOn: Boolean;
|
||
RitHz, XitHz: Integer;
|
||
BinOn, ANCOn: Boolean;
|
||
APFOn, DSEOn: Boolean;
|
||
NFOn: Boolean;
|
||
NBThreshold: Integer; // 1..100
|
||
NBDuration: Integer; // 1..300
|
||
ChannelBOn: Boolean;
|
||
BalanceDb: array[0..TCI_CHANNELS-1] of Integer;
|
||
end;
|
||
|
||
{ Снимок «железной» части контроллера: всё, ради чего иначе пришлось бы
|
||
трогать FNetwork из потока клиента. Backend живёт в UI-потоке и на смене
|
||
устройства освобождается — чтение его Caps и имени платы (а это ещё и
|
||
строки) из чужого потока даёт обращение к освобождённой памяти. }
|
||
TTCIDevSnap = record
|
||
DevName: string; // копия, принадлежит адаптеру
|
||
LimLoHz: Double; // границы настройки (VFO_LIMITS и проверка команд)
|
||
LimHiHz: Double;
|
||
MaxPans: Integer;
|
||
SampleRate: Integer;
|
||
HasTX: Boolean;
|
||
end;
|
||
|
||
{ Запись снимка таблицы слайсов: то, что сетевым потокам разрешено читать. }
|
||
TTCISliceSnap = record
|
||
Used: Boolean;
|
||
V: TSliceView;
|
||
end;
|
||
|
||
{ Захваченный параметр (§3.5): кто им сейчас управляет и когда трогал.
|
||
Owner = nil — изменение пришло не от клиента (оператор, CAT, бэнд-логика). }
|
||
TTCIHold = record
|
||
Key: string;
|
||
Owner: TTCIClient;
|
||
At: QWord;
|
||
end;
|
||
|
||
TTCIAdapter = class
|
||
private
|
||
FController: TRadioController;
|
||
FSpots: TDXSpotStore; // может быть nil (демон/тесты)
|
||
FServer: TTCIServer;
|
||
FLock: TCriticalSection;
|
||
FCfg: TTCISettings; // применённая конфигурация (для отката)
|
||
|
||
// ── Эхо-состояние (пишут потоки клиентов ⇒ только под FEchoLock) ──
|
||
FEchoLock: TCriticalSection;
|
||
FEcho: array[0..TCI_MAX_RX-1] of TTCIRxEcho;
|
||
FDiglOffset: Integer;
|
||
FDiguOffset: Integer;
|
||
FCwTerminal: Boolean;
|
||
|
||
// ── Снимок железа: пишет поток контроллера, читают сетевые ──
|
||
FDevLock: TCriticalSection;
|
||
FDevSnap: TTCIDevSnap;
|
||
|
||
// ── Снимок слайсов: пишет поток контроллера, читают сетевые ──
|
||
FSliceLock: TCriticalSection;
|
||
FSliceSnap: array[0..MAX_SLICES-1] of TTCISliceSnap;
|
||
|
||
// ── Захват параметров клиентами (§3.5) ──
|
||
FHoldLock: TCriticalSection;
|
||
FHolds: array[0..TCI_HOLD_SLOTS-1] of TTCIHold;
|
||
FHoldCount: Integer;
|
||
|
||
// ── Бинарные потоки (§3.4) ──
|
||
// Список исходящих потоков и рекордеры живут под ОДНИМ локом: их читает
|
||
// DSP-поток (тап аудио/IQ), а меняют потоки клиентов. Порядок захвата
|
||
// всегда FSliceLock → FStreamLock: тап сначала выясняет, чей это слайс,
|
||
// и только потом ищет подписчиков. Обратный порядок дал бы клин.
|
||
FStreamLock: TCriticalSection;
|
||
FStreams: array of TTCIStreamOut;
|
||
FRec: array[0..TCI_MAX_RX-1] of TTCIRecorder;
|
||
FTapsOn: Boolean; // тапы навешены на контроллер/движок
|
||
|
||
// ── TX-аудио от клиента (§3.4) ──
|
||
FTxLock: TCriticalSection;
|
||
FTxClient: TTCIClient; // кто модулирует (nil — никто)
|
||
FTrxOwner: TTCIClient; // кто поставил трансивер в эфир (§4.2)
|
||
FTxInterp: TTCIInterpolator;
|
||
FTxInRate: Integer; // частота дискретизации подачи клиента
|
||
FTxRunning: Boolean; // маркеры TX_CHRONO идут
|
||
FTxOwed: Double; // сколько сэмплов клиент нам «должен»
|
||
FTxLastMs: QWord;
|
||
// Рабочие буферы разбора TX-блока. Полем, а не на стеке: развёрнутый в
|
||
// 48 кГц блок — это сотни килобайт, и класть их в стек потока клиента
|
||
// (да ещё на каждый блок двадцать раз в секунду) незачем.
|
||
FTxRaw: array of Single;
|
||
FTxMono: array of Single;
|
||
FTxOut: array of Double;
|
||
|
||
// ── Кэш для подавления повторов в уведомлениях ──
|
||
FLastLimLo: Double; // последние разосланные VFO_LIMITS (поток контроллера)
|
||
FLastLimHi: Double;
|
||
FLastTxFreq: Double;
|
||
FLastTxEnable: Boolean;
|
||
FAppFocus: Boolean; // последнее, что сказал UI (для пачки состояния)
|
||
FOnFocusRequest: TThreadMethod;
|
||
|
||
// ── scratch для маршалинга в поток контроллера ──
|
||
FsFreq: Double;
|
||
FsInt: Integer;
|
||
FsInt2: Integer;
|
||
FsInt3: Integer;
|
||
FsBool: Boolean;
|
||
FsBool2: Boolean;
|
||
FsBool3: Boolean;
|
||
FsRes: Boolean; // ОБРАТНО из Sync-метода (под тем же FLock)
|
||
FsStr: string;
|
||
|
||
// ── Sync-методы (поток контроллера) ──
|
||
procedure SyncSetVfo;
|
||
procedure SyncSetCenter;
|
||
procedure SyncSetMode;
|
||
procedure SyncSetFilter;
|
||
procedure SyncSetTRX;
|
||
procedure SyncStopTRX;
|
||
procedure SyncSetDrive;
|
||
procedure SyncSetTuneDrive;
|
||
procedure SyncSetSplit;
|
||
procedure SyncSetVolume;
|
||
procedure SyncSetMute;
|
||
procedure SyncSetRxMute;
|
||
procedure SyncSetRxVolume;
|
||
procedure SyncSetMonVolume;
|
||
procedure SyncSetMonEnable;
|
||
procedure SyncSetAGCMode;
|
||
procedure SyncSetAGCTop;
|
||
procedure SyncSetNR;
|
||
procedure SyncSetNB;
|
||
procedure SyncSetANF;
|
||
procedure SyncSetLock;
|
||
procedure SyncSetSql;
|
||
procedure SyncSetSqlLevel;
|
||
procedure SyncSetRun;
|
||
procedure SyncSetCWSpeed;
|
||
procedure SyncSetCWDelay;
|
||
procedure SyncCWSend;
|
||
procedure SyncCWStop;
|
||
procedure SyncFocus;
|
||
procedure SyncTaps; // навесить/снять тапы аудио и IQ
|
||
|
||
// ── Бинарные потоки ──
|
||
function FindStream(C: TTCIClient; K: TTCIStreamType;
|
||
Rx: Integer): TTCIStreamOut; // под FStreamLock
|
||
procedure StartStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer);
|
||
procedure StopStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer);
|
||
procedure DropClientStreams(C: TTCIClient);
|
||
procedure RestartStreams(C: TTCIClient; K: TTCIStreamType);
|
||
procedure DropDeadRxStreams; // приёмник исчез — гасим его потоки
|
||
function EffIQRate(C: TTCIClient): Integer; // что реально отдадим
|
||
procedure PushIQRate(Client: TTCIClient); // переобъявить её клиенту
|
||
procedure StopAllStreams;
|
||
procedure SetTaps(On_: Boolean); // поток контроллера
|
||
function HasAudioStream(C: TTCIClient): Boolean;
|
||
function StreamRxOf(PanId, SliceId: Integer): Integer; // −1 = не наш канал
|
||
procedure OnAudioTap(Kind: TRadioAudioKind; PanId, SliceId: Integer;
|
||
const Left, Right: array of Single; Count: Integer);
|
||
procedure OnIQTap(PanId: Integer; PI_, PQ_: PDouble; N, RateHz: Integer);
|
||
procedure HandleBinary(Client: TTCIClient; Data: PByte; Len: Integer);
|
||
procedure PushTxChrono; // тик: маркеры времени клиенту
|
||
procedure CmdStream(Client: TTCIClient; const M: TTCIMessage);
|
||
procedure CmdRecorder(Client: TTCIClient; const M: TTCIMessage);
|
||
procedure DropClientRecorders(C: TTCIClient); // клиент ушёл — и запись с ним
|
||
procedure SweepRecorders; // тик: истёкшие окна записи
|
||
function RecordDir: string; // каталог, куда пишем WAV
|
||
procedure ClearTxClient(C: TTCIClient); // клиент ушёл/перестал модулировать
|
||
procedure StopTxOf(C: TTCIClient); // ★снять эфир, начатый этим клиентом
|
||
procedure ForgetTxOwner; // передача кончилась не по TCI
|
||
|
||
// ── Помощники модели ──
|
||
function CanInvoke: Boolean;
|
||
function RxCount: Integer;
|
||
function ValidRx(Rx: Integer): Boolean;
|
||
function RxActive(Rx: Integer): Boolean;
|
||
function LiveRx(Rx: Integer): Boolean; // номер в потолке И приёмник существует
|
||
function RxSlot(Rx: Integer): Integer; // слот слайса; −1 = главный тракт
|
||
function RxPanId(Rx: Integer): Integer; // пан приёмника; −1 = приёмника нет
|
||
procedure CalcFreqLimits(out LoHz, HiHz: Double); // живые (поток контроллера)
|
||
procedure FreqLimits(out LoHz, HiHz: Double); // из снимка (любой поток)
|
||
function FreqSaneLive(Hz: Double): Boolean; // проверка перед установкой
|
||
procedure PushVfoLimits; // разослать VFO_LIMITS, если границы уехали
|
||
function FreqSane(Hz: Double): Boolean;
|
||
procedure RefreshDev; // снимок железа (поток контроллера)
|
||
function DevSnap: TTCIDevSnap;
|
||
procedure RefreshSlices; // снимок таблицы слайсов (поток контроллера)
|
||
function SliceMapSig: string; // «кто где стоит»: для детекта появления/ухода
|
||
procedure PushChannelMap; // каналы приёмников появились/исчезли
|
||
function SnapSlice(Rx, Ch: Integer; out V: TSliceView): Boolean;
|
||
function SliceIdOf(Rx, Ch: Integer): Integer; // из снимка
|
||
function SliceIdLive(Rx, Ch: Integer): Integer; // из живой таблицы (Sync*)
|
||
function RxSlice(Rx: Integer; out S: TSliceView): Boolean;
|
||
function SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean;
|
||
function TxRx: Integer; // приёмник, чей слайс сейчас источник передачи
|
||
{ Захват параметра (§3.5). True — параметр наш (свободен, наш или отпущен
|
||
по таймауту), захват продлевается. False — им сейчас управляет другой. }
|
||
function Claim(const Key: string; Owner: TTCIClient): Boolean;
|
||
function HoldKey(const Name: string; Rx, Ch: Integer): string;
|
||
procedure DropHolds(Owner: TTCIClient);
|
||
function ChanFreq(Rx, Ch: Integer): Double;
|
||
function ChanCount(Rx: Integer): Integer;
|
||
function RxCenterHz(Rx: Integer): Double;
|
||
function RxMode(Rx: Integer): Integer;
|
||
procedure RxFilter(Rx: Integer; out Lo, Hi: Integer);
|
||
function RxMuted(Rx: Integer): Boolean;
|
||
function RxVolumeDb(Rx, Ch: Integer): Double;
|
||
function RxAGCUi(Rx: Integer): Integer;
|
||
function RxNROn(Rx: Integer): Boolean;
|
||
function RxNBOn(Rx: Integer): Boolean;
|
||
function RxANFOn(Rx: Integer): Boolean;
|
||
function RxSqlOn(Rx: Integer): Boolean;
|
||
function RxSqlLevel(Rx: Integer): Integer;
|
||
function RxSMeterDbm(Rx, Ch: Integer): Double;
|
||
function TxEnabled: Boolean;
|
||
|
||
// ── Формирование строк состояния ──
|
||
function StrVfo(Rx, Ch: Integer): string;
|
||
function StrIf(Rx, Ch: Integer): string;
|
||
function StrDds(Rx: Integer): string;
|
||
function StrModulation(Rx: Integer): string;
|
||
function StrFilterBand(Rx: Integer): string;
|
||
function StrTrx(Rx: Integer): string;
|
||
function StrTune(Rx: Integer): string;
|
||
function StrDrive: string;
|
||
function StrVolume: string;
|
||
function StrMute: string;
|
||
function StrAGCMode(Rx: Integer): string;
|
||
function StrAGCGain(Rx: Integer): string;
|
||
function StrLock(Rx: Integer): string;
|
||
function StrSqlEnable(Rx: Integer): string;
|
||
function StrSqlLevel(Rx: Integer): string;
|
||
function StrTxEnable(Rx: Integer): string;
|
||
function StrRxVolume(Rx, Ch: Integer): string;
|
||
function StrNR(Rx: Integer): string;
|
||
function StrNB(Rx: Integer): string;
|
||
function StrANF(Rx: Integer): string;
|
||
{ Полный набор строк по приёмнику — рассылка после правки слайса. }
|
||
procedure BroadcastRxState(Rx, Ch: Integer);
|
||
procedure BroadcastTxEnable; // всем живым приёмникам, каждому со своим номером
|
||
|
||
procedure SendInit(Client: TTCIClient);
|
||
procedure SendState(Client: TTCIClient);
|
||
procedure Reply(Client: TTCIClient; const S: string);
|
||
|
||
// ── События сервера/контроллера ──
|
||
procedure HandleCommand(Client: TTCIClient; const Cmd: string);
|
||
procedure DispatchCommand(Client: TTCIClient; const M: TTCIMessage);
|
||
procedure HandleConnect(Client: TTCIClient);
|
||
procedure HandleDisconnect(Client: TTCIClient);
|
||
procedure HandleTick;
|
||
procedure PushSensors(Client: TTCIClient);
|
||
procedure OnState(Sender: TObject; Field: TRadioField);
|
||
|
||
// ── Отдельные команды (чтобы HandleCommand не превратился в простыню) ──
|
||
procedure CmdFreq(Client: TTCIClient; const M: TTCIMessage; IsIF: Boolean);
|
||
procedure CmdCWMacros(const M: TTCIMessage; IsMsg: Boolean);
|
||
procedure CmdSpot(const M: TTCIMessage);
|
||
public
|
||
constructor Create(AController: TRadioController; ASpots: TDXSpotStore = nil);
|
||
destructor Destroy; override;
|
||
|
||
{ Настройки TCI: включение/порт/адрес. Зовётся при старте и из настроек.
|
||
False — включить просили, а порт не открылся (занят/нет прав/кривой
|
||
адрес): вызывающий обязан сказать это оператору, иначе тот останется с
|
||
галкой «включено» и мёртвым сервером. }
|
||
function ApplySettings(const T: TTCISettings): Boolean;
|
||
|
||
function Active: Boolean;
|
||
function ClientCount: Integer;
|
||
|
||
{ Уведомление о клике по споту на панораме (§4.4) — зовёт UI. }
|
||
procedure NotifySpotClicked(const Call: string; FreqHz: Double;
|
||
Rx: Integer = 0; Ch: Integer = 0);
|
||
{ Статус фокуса главного окна (APP_FOCUS) — зовёт UI. }
|
||
procedure NotifyAppFocus(InFocus: Boolean);
|
||
|
||
property Server: TTCIServer read FServer;
|
||
{ SET_IN_FOCUS (§4.3): клиент просит поднять окно программы. Ставит UI;
|
||
вызывается в потоке контроллера. nil — команда игнорируется. }
|
||
property OnFocusRequest: TThreadMethod read FOnFocusRequest write FOnFocusRequest;
|
||
end;
|
||
|
||
implementation
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Жизненный цикл
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
constructor TTCIAdapter.Create(AController: TRadioController; ASpots: TDXSpotStore);
|
||
var i, c: Integer;
|
||
begin
|
||
inherited Create;
|
||
FController := AController;
|
||
FSpots := ASpots;
|
||
FLock := TCriticalSection.Create;
|
||
FEchoLock := TCriticalSection.Create;
|
||
|
||
for i := 0 to TCI_MAX_RX - 1 do
|
||
begin
|
||
FillChar(FEcho[i], SizeOf(FEcho[i]), 0);
|
||
FEcho[i].NBThreshold := 50;
|
||
FEcho[i].NBDuration := 25;
|
||
for c := 0 to TCI_CHANNELS - 1 do FEcho[i].BalanceDb[c] := 0;
|
||
end;
|
||
FLastLimLo := 0;
|
||
FLastLimHi := 0;
|
||
FLastTxFreq := 0;
|
||
FLastTxEnable := True;
|
||
FAppFocus := True;
|
||
FDevLock := TCriticalSection.Create;
|
||
FSliceLock := TCriticalSection.Create;
|
||
FillChar(FSliceSnap, SizeOf(FSliceSnap), 0);
|
||
FHoldLock := TCriticalSection.Create;
|
||
FHoldCount := 0;
|
||
|
||
FStreamLock := TCriticalSection.Create;
|
||
FTxLock := TCriticalSection.Create;
|
||
FTapsOn := False;
|
||
SetLength(FTxRaw, TCI_STREAM_DATA_MAX div 2); // худший случай: int16
|
||
SetLength(FTxMono, TCI_STREAM_DATA_MAX div 2);
|
||
SetLength(FTxOut, TCI_TX_OUT_MAX);
|
||
|
||
FServer := TTCIServer.Create;
|
||
FServer.OnCommand := HandleCommand;
|
||
FServer.OnBinary := HandleBinary;
|
||
FServer.OnConnect := HandleConnect;
|
||
FServer.OnDisconnect := HandleDisconnect;
|
||
FServer.OnTick := HandleTick;
|
||
|
||
RefreshDev;
|
||
// Первый снимок — прямо здесь: конструктор идёт в потоке контроллера, а
|
||
// слайсы могли быть восстановлены ещё до появления адаптера (события об их
|
||
// создании мы уже не увидим).
|
||
RefreshSlices;
|
||
|
||
// Многоадресная подписка: OnStateChanged занят MainForm.
|
||
FController.AddStateListener(OnState);
|
||
end;
|
||
|
||
destructor TTCIAdapter.Destroy;
|
||
begin
|
||
// Сначала отписка: контроллер живёт дольше адаптера, и Changed() после
|
||
// нашей смерти позвал бы метод освобождённого объекта. По той же причине
|
||
// ПЕРВЫМИ снимаем тапы аудио/IQ — их зовёт DSP-поток, который переживёт нас.
|
||
SetTaps(False);
|
||
if FController <> nil then FController.RemoveStateListener(OnState);
|
||
if FServer <> nil then
|
||
begin
|
||
FServer.Stop;
|
||
FreeAndNil(FServer);
|
||
end;
|
||
// Потоки — уже после остановки сервера: их объекты ссылаются на клиентов.
|
||
StopAllStreams;
|
||
FreeAndNil(FTxInterp);
|
||
FLock.Free;
|
||
FEchoLock.Free;
|
||
FDevLock.Free;
|
||
FSliceLock.Free;
|
||
FHoldLock.Free;
|
||
FStreamLock.Free;
|
||
FTxLock.Free;
|
||
inherited;
|
||
end;
|
||
|
||
function TTCIAdapter.ApplySettings(const T: TTCISettings): Boolean;
|
||
// Порядок важен: сначала проверяем новую конфигурацию, и только потом гасим
|
||
// работающий сервер. Иначе опечатка в адресе или занятый порт оставляли
|
||
// оператора вообще без TCI — старый слушатель уже закрыт, новый не открылся.
|
||
// Не удалось поднять новый — возвращаемся на прежний.
|
||
var
|
||
NewPort, OldPort: Word;
|
||
begin
|
||
RefreshDev; // зовут из потока контроллера — заодно освежаем снимки
|
||
RefreshSlices;
|
||
NewPort := Word(EnsureRange(T.Port, 1, 65535));
|
||
// Адрес разбирается ДО открытия сокета: невалидный означает отказ, а не
|
||
// «слушаем все интерфейсы» — авторизации в TCI нет (см. TCIParseIPv4).
|
||
if T.Enabled and not TTCIServer.ValidSettings(NewPort, T.BindAddr) then
|
||
Exit(False);
|
||
|
||
OldPort := FServer.Port;
|
||
FServer.Stop;
|
||
// Сервер остановлен — клиентов больше нет, значит и потоки чужие: снимаем
|
||
// тапы, иначе DSP-поток продолжал бы носить аудио в никуда.
|
||
StopAllStreams;
|
||
SetTaps(False);
|
||
if not T.Enabled then
|
||
begin
|
||
FCfg := T;
|
||
Exit(True);
|
||
end;
|
||
|
||
Result := FServer.Configure(NewPort, T.BindAddr) and FServer.Start;
|
||
if Result then
|
||
begin
|
||
FCfg := T;
|
||
SetTaps(True);
|
||
Exit;
|
||
end;
|
||
// Порт занят (или отобран правами) — поднимаем то, что работало.
|
||
if FCfg.Enabled and TTCIServer.ValidSettings(OldPort, FCfg.BindAddr) then
|
||
if FServer.Configure(OldPort, FCfg.BindAddr) and FServer.Start then
|
||
SetTaps(True);
|
||
end;
|
||
|
||
function TTCIAdapter.CanInvoke: Boolean;
|
||
// Пока сервер останавливается, новых вызовов в поток контроллера не начинаем:
|
||
// останавливает нас как раз он (UI), и Synchronize из потока клиента в него
|
||
// уже не вернётся.
|
||
begin
|
||
Result := (FController <> nil) and
|
||
((FServer = nil) or not FServer.Stopping);
|
||
end;
|
||
|
||
function TTCIAdapter.Active: Boolean;
|
||
begin
|
||
Result := (FServer <> nil) and FServer.Running;
|
||
end;
|
||
|
||
function TTCIAdapter.ClientCount: Integer;
|
||
begin
|
||
if FServer = nil then Result := 0 else Result := FServer.ClientCount;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Модель: приёмник 0 = главный тракт (каналы = VFO A/B), приёмник N = слайс
|
||
слота N−1 (буквы B..G). См. комментарий у TCI_MAX_RX.
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TTCIAdapter.RxCount: Integer;
|
||
// Потолок, а не число живых: TRX_COUNT протокол объявляет один раз, при
|
||
// подключении (§4.1). Про приёмник, которого сейчас нет, просто молчим.
|
||
begin
|
||
Result := TCI_MAX_RX;
|
||
end;
|
||
|
||
function TTCIAdapter.ValidRx(Rx: Integer): Boolean;
|
||
begin
|
||
Result := (Rx >= 0) and (Rx < RxCount);
|
||
end;
|
||
|
||
function TTCIAdapter.LiveRx(Rx: Integer): Boolean;
|
||
// Адресат команды. Про приёмник, которого нет (слот пуст), молчим целиком:
|
||
// ответ с нулями клиент принял бы за настоящее состояние.
|
||
begin
|
||
Result := ValidRx(Rx) and RxActive(Rx);
|
||
end;
|
||
|
||
function TTCIAdapter.RxSlot(Rx: Integer): Integer;
|
||
// Слот слайса, стоящего за приёмником Rx. −1 — это главный тракт (rx0) либо
|
||
// номер вне потолка.
|
||
begin
|
||
if (Rx <= 0) or (Rx >= TCI_MAX_RX) then Result := -1 else Result := Rx - 1;
|
||
end;
|
||
|
||
function TTCIAdapter.RxActive(Rx: Integer): Boolean;
|
||
// Приёмник существует. Для слайса это значит «слот занят»: удалили слайс —
|
||
// приёмник исчез, и врать про его частоту нельзя (см. SendState).
|
||
var Slot: Integer;
|
||
begin
|
||
if Rx = 0 then Exit(True);
|
||
Slot := RxSlot(Rx);
|
||
if Slot < 0 then Exit(False);
|
||
FSliceLock.Enter;
|
||
try
|
||
Result := FSliceSnap[Slot].Used;
|
||
finally
|
||
FSliceLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.CalcFreqLimits(out LoHz, HiHz: Double);
|
||
// Живые границы настройки. Только поток контроллера: VisibleFreqBounds смотрит
|
||
// в Caps бэкенда. XVTR → диапазон слота; устройства нет — тот же запасной
|
||
// диапазон, что уходит в VFO_LIMITS. «Нет устройства = можно всё» недопустимо:
|
||
// SetCenter/SetPanDDCFreq ничего не клампят и отдадут число прямо в backend.
|
||
begin
|
||
FController.VisibleFreqBounds(LoHz, HiHz);
|
||
if (not FController.FDevConnected) or (HiHz <= LoHz) then
|
||
begin
|
||
LoHz := 10000;
|
||
HiHz := 30000000;
|
||
end;
|
||
if LoHz < 1 then LoHz := 1; // нулевой частоты не бывает ни у кого
|
||
end;
|
||
|
||
function TTCIAdapter.FreqSaneLive(Hz: Double): Boolean;
|
||
// Та же проверка, что FreqSane, но по ЖИВЫМ границам и в потоке контроллера.
|
||
// Нужна отдельно: команду разбирает поток клиента, а исполняется она позже —
|
||
// за это время оператор успевает сменить устройство (Pluto → HPSDR), и снимок,
|
||
// по которому частоту пропустили, уже не описывает то радио, куда она уедет.
|
||
var LoHz, HiHz: Double;
|
||
begin
|
||
Result := False;
|
||
if IsNan(Hz) or IsInfinite(Hz) or (Hz <= 0) then Exit;
|
||
CalcFreqLimits(LoHz, HiHz);
|
||
Result := (Hz >= LoHz) and (Hz <= HiHz);
|
||
end;
|
||
|
||
procedure TTCIAdapter.RefreshDev;
|
||
// Снимок железа. Только поток контроллера: здесь дёргаются BackendCaps и
|
||
// BoardDisplayName, а они смотрят в FNetwork, который UI освобождает на смене
|
||
// устройства. Сетевые потоки читают уже готовую копию (DevSnap).
|
||
var
|
||
D: TTCIDevSnap;
|
||
Caps: TBackendCaps;
|
||
begin
|
||
Caps := FController.BackendCaps;
|
||
D.DevName := FController.BoardDisplayName;
|
||
D.MaxPans := Caps.MaxPans;
|
||
D.HasTX := Caps.HasTX;
|
||
D.SampleRate := FController.FSampleRate;
|
||
CalcFreqLimits(D.LimLoHz, D.LimHiHz);
|
||
|
||
FDevLock.Enter;
|
||
try
|
||
FDevSnap := D; // строка присваивается ТОЛЬКО здесь и только под локом
|
||
finally
|
||
FDevLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.DevSnap: TTCIDevSnap;
|
||
begin
|
||
FDevLock.Enter;
|
||
try Result := FDevSnap; finally FDevLock.Leave; end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.FreqLimits(out LoHz, HiHz: Double);
|
||
// ЕДИНСТВЕННЫЙ источник границ настройки: и для VFO_LIMITS в пачке
|
||
// инициализации, и для проверки частоты в командах. Раньше их было два, и они
|
||
// расходились: клиенту объявлялись пределы АЦП, а команда под трансвертером
|
||
// принимала вообще любое число.
|
||
var D: TTCIDevSnap;
|
||
begin
|
||
D := DevSnap;
|
||
LoHz := D.LimLoHz;
|
||
HiHz := D.LimHiHz;
|
||
end;
|
||
|
||
procedure TTCIAdapter.PushVfoLimits;
|
||
// Границы настройки не вечны: подключилось устройство, включился или выключился
|
||
// трансвертер — и объявленные при подключении VFO_LIMITS начинают врать. Клиент
|
||
// узнаёт об этом только от нас: перезапросить их в протоколе нечем.
|
||
// Дедуп — по последнему известному значению: rfDevice приходит и на создание
|
||
// слайса, и на обновление списка устройств.
|
||
// ВАЖНО: кэш ведём всегда, даже когда клиентов нет. Иначе так: клиент видел
|
||
// пределы устройства → все отключились → радио отвалилось (кэш бы не заметил)
|
||
// → новый клиент получил запасные 10 кГц…30 МГц → радио вернулось → новые
|
||
// пределы совпали с давним кэшем, рассылка подавилась, и клиент навсегда остался
|
||
// с запасными.
|
||
var Lo, Hi: Double;
|
||
begin
|
||
FreqLimits(Lo, Hi);
|
||
if (Lo = FLastLimLo) and (Hi = FLastLimHi) then Exit;
|
||
FLastLimLo := Lo;
|
||
FLastLimHi := Hi;
|
||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||
FServer.Broadcast(TCIBuild('vfo_limits',
|
||
[TCIIntStr(Round(Lo)), TCIIntStr(Round(Hi))]));
|
||
end;
|
||
|
||
function TTCIAdapter.FreqSane(Hz: Double): Boolean;
|
||
// Годится ли частота к установке. Отрицательная и нулевая — точно нет: именно
|
||
// такие получались из неразобранных аргументов.
|
||
var LoHz, HiHz: Double;
|
||
begin
|
||
Result := False;
|
||
if IsNan(Hz) or IsInfinite(Hz) or (Hz <= 0) then Exit;
|
||
FreqLimits(LoHz, HiHz);
|
||
Result := (Hz >= LoHz) and (Hz <= HiHz);
|
||
end;
|
||
|
||
procedure TTCIAdapter.RefreshSlices;
|
||
// Снимок таблицы слайсов. Зовётся ТОЛЬКО в потоке контроллера (OnState и
|
||
// Invoke при подключении клиента) — там писателей нет, и снимок каждой записи
|
||
// получается согласованным. Сетевые потоки читают уже его: прямое чтение
|
||
// FSlices из них давало смесь старых и новых полей одного слайса (частота
|
||
// новая, мода ещё старая), даже когда managed-строк это не касалось.
|
||
var
|
||
i, Id: Integer;
|
||
Tmp: array[0..MAX_SLICES-1] of TTCISliceSnap;
|
||
V: TSliceView;
|
||
begin
|
||
for i := 0 to MAX_SLICES - 1 do
|
||
begin
|
||
Tmp[i].Used := False;
|
||
FillChar(Tmp[i].V, SizeOf(Tmp[i].V), 0);
|
||
Id := FController.SliceIdBySlot(i); // порядок слотов = порядок каналов
|
||
if (Id > 0) and FController.GetSliceView(Id, V) then
|
||
begin
|
||
Tmp[i].Used := True;
|
||
Tmp[i].V := V;
|
||
end;
|
||
end;
|
||
FSliceLock.Enter;
|
||
try
|
||
for i := 0 to MAX_SLICES - 1 do FSliceSnap[i] := Tmp[i];
|
||
finally
|
||
FSliceLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.SliceMapSig: string;
|
||
// Слепок расстановки: id и пан каждого слайса по порядку слотов. Меняется и
|
||
// когда слайс создали или удалили, и когда из-за удаления первого второй стал
|
||
// каналом A.
|
||
var i: Integer;
|
||
begin
|
||
Result := '';
|
||
FSliceLock.Enter;
|
||
try
|
||
for i := 0 to MAX_SLICES - 1 do
|
||
if FSliceSnap[i].Used then
|
||
Result := Result + IntToStr(FSliceSnap[i].V.Id) + ':' +
|
||
IntToStr(FSliceSnap[i].V.PanId) + ';';
|
||
finally
|
||
FSliceLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.PushChannelMap;
|
||
// Каналы доп. приёмников появились, исчезли или перенумеровались. Об исчезнувшем
|
||
// канале протокол сказать почти ничего не даёт: команды «приёмника больше нет» в
|
||
// TCI 2.0 нет вовсе, а про канал B есть только RX_CHANNEL_ENABLE. Поэтому шлём
|
||
// полную картину каждого живого приёмника — клиент перезаливает её целиком.
|
||
var Rx, Ch, N: Integer;
|
||
begin
|
||
// Потоки пропавших приёмников гасим ВСЕГДА, даже если рассылать некому:
|
||
// объект потока пережил бы свой пан и молча копил тишину, а клиент ждал бы
|
||
// блоков, которых больше не будет.
|
||
DropDeadRxStreams;
|
||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||
for Rx := 1 to RxCount - 1 do
|
||
begin
|
||
if not RxActive(Rx) then Continue;
|
||
N := ChanCount(Rx);
|
||
FServer.Broadcast(StrDds(Rx));
|
||
for Ch := 0 to N - 1 do BroadcastRxState(Rx, Ch);
|
||
FServer.Broadcast(TCIBuild('rx_channel_enable',
|
||
[TCIIntStr(Rx), '1', TCIBoolStr(N > 1)]));
|
||
// ★С адресом приёмника — иначе клиент его не увидит. Клиенты фильтруют
|
||
// входящие по arg1 (см. StrTrx), а MSHV на этом ещё и завязывает передачу:
|
||
// `set_ptt` начинается с `if (!tci_tx_enable) return;`. Слайс, созданный
|
||
// ПОСЛЕ подключения клиента, без этой строки получал бы молча мёртвую PTT.
|
||
FServer.Broadcast(StrTxEnable(Rx));
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.SnapSlice(Rx, Ch: Integer; out V: TSliceView): Boolean;
|
||
// Слайс приёмника Rx из снимка. У приёмника-слайса канал один — A: второго
|
||
// «саб-приёмника» внутри слайса не бывает. Для Rx=0 слайса нет вовсе: главный
|
||
// тракт живёт в полях контроллера.
|
||
var Slot: Integer;
|
||
begin
|
||
Result := False;
|
||
FillChar(V, SizeOf(V), 0);
|
||
Slot := RxSlot(Rx);
|
||
if (Slot < 0) or (Ch <> 0) then Exit;
|
||
FSliceLock.Enter;
|
||
try
|
||
if FSliceSnap[Slot].Used then
|
||
begin
|
||
V := FSliceSnap[Slot].V;
|
||
Result := True;
|
||
end;
|
||
finally
|
||
FSliceLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.RxPanId(Rx: Integer): Integer;
|
||
// На каком пане живёт приёмник: у главного тракта это пан 0, у слайса — тот,
|
||
// где он стоит. Отсюда берутся его центр (DDS) и поток IQ.
|
||
var V: TSliceView;
|
||
begin
|
||
if Rx = 0 then Exit(0);
|
||
if SnapSlice(Rx, 0, V) then Result := V.PanId else Result := -1;
|
||
end;
|
||
|
||
function TTCIAdapter.SliceIdOf(Rx, Ch: Integer): Integer;
|
||
// Слайс приёмника Rx (канал A) из снимка.
|
||
var V: TSliceView;
|
||
begin
|
||
if SnapSlice(Rx, Ch, V) then Result := V.Id else Result := 0;
|
||
end;
|
||
|
||
function TTCIAdapter.SliceIdLive(Rx, Ch: Integer): Integer;
|
||
// То же, но из живой таблицы. Только для Sync-методов: они идут в потоке
|
||
// контроллера, где чтение безопасно, а снимок мог бы отстать на такт — команда
|
||
// на установку обязана попасть в тот слайс, который есть сейчас.
|
||
var Slot: Integer;
|
||
begin
|
||
Result := 0;
|
||
Slot := RxSlot(Rx);
|
||
if (Slot < 0) or (Ch <> 0) then Exit;
|
||
Result := FController.SliceIdBySlot(Slot);
|
||
end;
|
||
|
||
function TTCIAdapter.RxSlice(Rx: Integer; out S: TSliceView): Boolean;
|
||
// Слайс, представляющий приёмник Rx как целое (канал A).
|
||
begin
|
||
Result := SnapSlice(Rx, 0, S);
|
||
end;
|
||
|
||
function TTCIAdapter.SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean;
|
||
// Обратное отображение слайс → (приёмник, канал). Нужно уведомлениям: контроллер
|
||
// сообщает об изменении Id, а клиенту адресуются номера TCI. Слот слайса и есть
|
||
// его номер приёмника — искать по панам больше нечего.
|
||
var i: Integer;
|
||
begin
|
||
Result := False;
|
||
Rx := 0; Ch := 0;
|
||
if Id <= 0 then Exit;
|
||
FSliceLock.Enter;
|
||
try
|
||
for i := 0 to MAX_SLICES - 1 do
|
||
if FSliceSnap[i].Used and (FSliceSnap[i].V.Id = Id) then
|
||
begin
|
||
Rx := i + 1;
|
||
Ch := 0;
|
||
Exit(True);
|
||
end;
|
||
finally
|
||
FSliceLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.HoldKey(const Name: string; Rx, Ch: Integer): string;
|
||
// Ключ захвата: параметр + адресат. VFO и IF — одно и то же значение с разных
|
||
// сторон, поэтому у них общее имя.
|
||
begin
|
||
Result := Name + '/' + IntToStr(Rx) + '/' + IntToStr(Ch);
|
||
end;
|
||
|
||
function TTCIAdapter.Claim(const Key: string; Owner: TTCIClient): Boolean;
|
||
// §3.5: захвативший параметр держит его 200 мс после последнего изменения.
|
||
// Owner = nil — изменение от оператора/CAT: оно тоже захватывает параметр, но
|
||
// НЕ отбирает его у клиента, который прямо сейчас им управляет.
|
||
var
|
||
i, Free_: Integer;
|
||
Now_: QWord;
|
||
begin
|
||
Now_ := GetTickCount64;
|
||
FHoldLock.Enter;
|
||
try
|
||
Free_ := -1;
|
||
for i := 0 to FHoldCount - 1 do
|
||
begin
|
||
if FHolds[i].Key = Key then
|
||
begin
|
||
if (FHolds[i].Owner <> Owner) and (Now_ - FHolds[i].At < TCI_HOLD_MS) then
|
||
Exit(False);
|
||
FHolds[i].Owner := Owner;
|
||
FHolds[i].At := Now_;
|
||
Exit(True);
|
||
end;
|
||
// Заодно подбираем протухшую запись под переиспользование.
|
||
if (Free_ < 0) and (Now_ - FHolds[i].At >= TCI_HOLD_MS) then Free_ := i;
|
||
end;
|
||
if Free_ < 0 then
|
||
begin
|
||
if FHoldCount >= TCI_HOLD_SLOTS then Exit(True); // мест нет — не мешаем
|
||
Free_ := FHoldCount;
|
||
Inc(FHoldCount);
|
||
end;
|
||
FHolds[Free_].Key := Key;
|
||
FHolds[Free_].Owner := Owner;
|
||
FHolds[Free_].At := Now_;
|
||
Result := True;
|
||
finally
|
||
FHoldLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.DropHolds(Owner: TTCIClient);
|
||
// Клиент отключился: его захваты снимаем сразу. Указатели мы только сравниваем
|
||
// (разыменовывать нечего), но освободившийся адрес мог бы достаться новому
|
||
// клиенту — и тот получил бы чужие захваты в наследство.
|
||
var i: Integer;
|
||
begin
|
||
if Owner = nil then Exit;
|
||
FHoldLock.Enter;
|
||
try
|
||
for i := 0 to FHoldCount - 1 do
|
||
if FHolds[i].Owner = Owner then
|
||
begin
|
||
FHolds[i].Key := '';
|
||
FHolds[i].Owner := nil;
|
||
FHolds[i].At := 0;
|
||
end;
|
||
finally
|
||
FHoldLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.ChanCount(Rx: Integer): Integer;
|
||
// У главного тракта два канала (VFO A/B), у приёмника-слайса — один: канал B
|
||
// в протоколе это второй саб-приёмник, а внутри слайса такого нет.
|
||
begin
|
||
if Rx = 0 then Exit(2);
|
||
if RxActive(Rx) then Result := 1 else Result := 0;
|
||
end;
|
||
|
||
function TTCIAdapter.ChanFreq(Rx, Ch: Integer): Double;
|
||
var S: TSliceView;
|
||
begin
|
||
Result := 0;
|
||
if Rx = 0 then
|
||
begin
|
||
if Ch = 1 then Result := FController.FVfoB else Result := FController.FVfoA;
|
||
Exit;
|
||
end;
|
||
// Слайса нет — приёмника нет: частоту не выдумываем (SendState про такой
|
||
// номер молчит целиком).
|
||
if SnapSlice(Rx, Ch, S) then Result := S.TargetHz;
|
||
end;
|
||
|
||
function TTCIAdapter.RxCenterHz(Rx: Integer): Double;
|
||
// DDS приёмника — центр панорамы, на которой он живёт. У слайса это центр его
|
||
// пана: для главного пана — FCenterFreq, для дополнительного — его DDC.
|
||
var Pan: Integer;
|
||
begin
|
||
Result := 0;
|
||
Pan := RxPanId(Rx);
|
||
if Pan < 0 then Exit;
|
||
if Pan = 0 then Result := FController.FCenterFreq
|
||
else Result := FController.PanDDCFreq(Pan);
|
||
end;
|
||
|
||
function TTCIAdapter.RxMode(Rx: Integer): Integer;
|
||
var S: TSliceView;
|
||
begin
|
||
Result := FController.FMode;
|
||
if Rx = 0 then Exit;
|
||
if SnapSlice(Rx, 0, S) then Result := S.Mode;
|
||
end;
|
||
|
||
procedure TTCIAdapter.RxFilter(Rx: Integer; out Lo, Hi: Integer);
|
||
var S: TSliceView;
|
||
begin
|
||
Lo := FController.FilterLo;
|
||
Hi := FController.FilterHi;
|
||
if Rx = 0 then Exit;
|
||
if SnapSlice(Rx, 0, S) then
|
||
begin
|
||
Lo := S.FilterLo;
|
||
Hi := S.FilterHi;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.RxMuted(Rx: Integer): Boolean;
|
||
var S: TSliceView;
|
||
begin
|
||
if Rx = 0 then begin Result := FController.FMuted; Exit; end;
|
||
Result := SnapSlice(Rx, 0, S) and S.Muted;
|
||
end;
|
||
|
||
function TTCIAdapter.RxVolumeDb(Rx, Ch: Integer): Double;
|
||
// Громкость в TCI — величина канальная: у доп. пана второй слайс звучит своей.
|
||
var S: TSliceView;
|
||
begin
|
||
if Rx = 0 then begin Result := TCIVolumeToDb(FController.FVolume); Exit; end;
|
||
Result := TCI_VOL_MIN_DB;
|
||
if SnapSlice(Rx, Ch, S) then Result := TCIVolumeToDb(Round(S.Volume * 100));
|
||
end;
|
||
|
||
function TTCIAdapter.RxAGCUi(Rx: Integer): Integer;
|
||
var S: TSliceView;
|
||
begin
|
||
Result := FController.FAGCMode;
|
||
if Rx = 0 then Exit;
|
||
if SnapSlice(Rx, 0, S) then Result := TRadioController.AGCModeToUI(S.AGC);
|
||
end;
|
||
|
||
// DSP и шумоподавитель: у доп. приёмника своё состояние (зеркало в TCtrlSlice).
|
||
// Читать тут глобальные поля главного тракта нельзя — клиент увидел бы чужие
|
||
// переключатели и, что хуже, записал бы их обратно.
|
||
function TTCIAdapter.RxNROn(Rx: Integer): Boolean;
|
||
var S: TSliceView;
|
||
begin
|
||
if Rx = 0 then Result := FController.FNRMode > 0
|
||
else Result := RxSlice(Rx, S) and (S.NRMode > 0);
|
||
end;
|
||
|
||
function TTCIAdapter.RxNBOn(Rx: Integer): Boolean;
|
||
var S: TSliceView;
|
||
begin
|
||
if Rx = 0 then Result := FController.FNBMode > 0
|
||
else Result := RxSlice(Rx, S) and (S.NBMode > 0);
|
||
end;
|
||
|
||
function TTCIAdapter.RxANFOn(Rx: Integer): Boolean;
|
||
var S: TSliceView;
|
||
begin
|
||
if Rx = 0 then Result := FController.FANF
|
||
else Result := RxSlice(Rx, S) and S.ANF;
|
||
end;
|
||
|
||
function TTCIAdapter.RxSqlOn(Rx: Integer): Boolean;
|
||
var S: TSliceView;
|
||
begin
|
||
if Rx = 0 then Result := FController.FFMSQOn
|
||
else Result := RxSlice(Rx, S) and S.FMSQOn;
|
||
end;
|
||
|
||
function TTCIAdapter.RxSqlLevel(Rx: Integer): Integer;
|
||
var S: TSliceView;
|
||
begin
|
||
if Rx = 0 then begin Result := FController.FFMSQLevel; Exit; end;
|
||
if RxSlice(Rx, S) then Result := S.FMSQLevel else Result := 0;
|
||
end;
|
||
|
||
function TTCIAdapter.RxSMeterDbm(Rx, Ch: Integer): Double;
|
||
var Id: Integer;
|
||
begin
|
||
if Rx = 0 then
|
||
begin
|
||
Result := FController.ReadSMeterDBm;
|
||
Exit;
|
||
end;
|
||
Result := -140;
|
||
Id := SliceIdOf(Rx, Ch);
|
||
if Id > 0 then Result := FController.SliceSMeter(Id);
|
||
end;
|
||
|
||
function TTCIAdapter.TxEnabled: Boolean;
|
||
begin
|
||
Result := DevSnap.HasTX and (not FController.TXProhibited);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Формирование строк состояния
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TTCIAdapter.StrVfo(Rx, Ch: Integer): string;
|
||
begin
|
||
Result := TCIBuild('vfo', [TCIIntStr(Rx), TCIIntStr(Ch),
|
||
TCIIntStr(Round(ChanFreq(Rx, Ch)))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrIf(Rx, Ch: Integer): string;
|
||
begin
|
||
Result := TCIBuild('if', [TCIIntStr(Rx), TCIIntStr(Ch),
|
||
TCIIntStr(Round(ChanFreq(Rx, Ch) - RxCenterHz(Rx)))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrDds(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('dds', [TCIIntStr(Rx), TCIIntStr(Round(RxCenterHz(Rx)))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrModulation(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('modulation', [TCIIntStr(Rx), TCIModeName(RxMode(Rx))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrFilterBand(Rx: Integer): string;
|
||
var Lo, Hi: Integer;
|
||
begin
|
||
RxFilter(Rx, Lo, Hi);
|
||
Result := TCIBuild('rx_filter_band', [TCIIntStr(Rx), TCIIntStr(Lo), TCIIntStr(Hi)]);
|
||
end;
|
||
|
||
function TTCIAdapter.TxRx: Integer;
|
||
// Номер приёмника, чей слайс СЕЙЧАС источник передачи (0 = главный VFO).
|
||
// Ответы и уведомления TRX/TUNE обязаны называть именно его: клиент на
|
||
// приёмнике 1, получивший «trx:0,true», решил бы, что его команда не прошла, а
|
||
// клиент на приёмнике 0 — что в эфире он, хотя передаёт чужой слайс.
|
||
var
|
||
Rx, Ch: Integer;
|
||
begin
|
||
Result := 0;
|
||
if FController = nil then Exit;
|
||
if (FController.TxSliceId > 0) and SliceRxCh(FController.TxSliceId, Rx, Ch) then
|
||
Result := Rx;
|
||
end;
|
||
|
||
function TTCIAdapter.StrTrx(Rx: Integer): string;
|
||
// Состояние передатчика ДЛЯ ПРИЁМНИКА Rx: «true» значит, что в эфире именно
|
||
// его слайс. Клиенты фильтруют входящие строки по номеру приёмника (MSHV,
|
||
// например, отбрасывает всё, что адресовано не ему), поэтому автору команды
|
||
// отвечаем ЕГО номером: `trx:1,false` — это «твоя заявка не прошла», а
|
||
// `trx:0,false` он бы просто не увидел. В рассылку уходит номер того, чей
|
||
// слайс сейчас источник передачи (`TxRx`).
|
||
begin
|
||
Result := TCIBuild('trx', [TCIIntStr(Rx),
|
||
TCIBoolStr(FController.FTransmitting and (TxRx = Rx))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrTune(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('tune', [TCIIntStr(Rx),
|
||
TCIBoolStr(FController.FTuning and (TxRx = Rx))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrDrive: string;
|
||
begin
|
||
Result := TCIBuild('drive', ['0', TCIIntStr(FController.FDrivePercent)]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrVolume: string;
|
||
begin
|
||
Result := TCIBuild('volume', [TCIIntStr(Round(TCIVolumeToDb(FController.FVolume)))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrMute: string;
|
||
begin
|
||
Result := TCIBuild('mute', [TCIBoolStr(FController.FMuted)]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrAGCMode(Rx: Integer): string;
|
||
var Ui: Integer; Name: string;
|
||
begin
|
||
Ui := RxAGCUi(Rx);
|
||
// UI: 0=Fast 1=Medium 2=Slow 3=Long 4=Off; TCI знает normal/fast/off.
|
||
if Ui = 4 then Name := 'off'
|
||
else if Ui = 0 then Name := 'fast'
|
||
else Name := 'normal';
|
||
Result := TCIBuild('agc_mode', [TCIIntStr(Rx), Name]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrAGCGain(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('agc_gain', [TCIIntStr(Rx), TCIIntStr(FController.FAGCTop)]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrLock(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('lock', [TCIIntStr(Rx), TCIBoolStr(FController.FVfoLock)]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrSqlEnable(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('sql_enable', [TCIIntStr(Rx), TCIBoolStr(RxSqlOn(Rx))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrSqlLevel(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('sql_level', [TCIIntStr(Rx),
|
||
TCIIntStr(Round(TCILevelToSql(RxSqlLevel(Rx))))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrTxEnable(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('tx_enable', [TCIIntStr(Rx), TCIBoolStr(TxEnabled)]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrRxVolume(Rx, Ch: Integer): string;
|
||
begin
|
||
Result := TCIBuild('rx_volume', [TCIIntStr(Rx), TCIIntStr(Ch),
|
||
TCIIntStr(Round(RxVolumeDb(Rx, Ch)))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrNR(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('rx_nr_enable', [TCIIntStr(Rx), TCIBoolStr(RxNROn(Rx))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrNB(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('rx_nb_enable', [TCIIntStr(Rx), TCIBoolStr(RxNBOn(Rx))]);
|
||
end;
|
||
|
||
function TTCIAdapter.StrANF(Rx: Integer): string;
|
||
begin
|
||
Result := TCIBuild('rx_anf_enable', [TCIIntStr(Rx), TCIBoolStr(RxANFOn(Rx))]);
|
||
end;
|
||
|
||
procedure TTCIAdapter.BroadcastRxState(Rx, Ch: Integer);
|
||
// Слайс перенастроили (кто угодно: TCI, CAT, оператор мышью) — синхронизируем
|
||
// всех клиентов. Канал B доп. пана в протоколе несёт только частоту и
|
||
// громкость: вид связи, фильтр, АРУ и шумодавы в TCI — свойства приёмника
|
||
// целиком, и относятся к каналу A.
|
||
begin
|
||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||
FServer.Broadcast(StrVfo(Rx, Ch));
|
||
FServer.Broadcast(StrIf(Rx, Ch));
|
||
FServer.Broadcast(StrRxVolume(Rx, Ch));
|
||
if Ch <> 0 then Exit;
|
||
FServer.Broadcast(StrModulation(Rx));
|
||
FServer.Broadcast(StrFilterBand(Rx));
|
||
FServer.Broadcast(StrAGCMode(Rx));
|
||
FServer.Broadcast(TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))]));
|
||
FServer.Broadcast(StrNR(Rx));
|
||
FServer.Broadcast(StrNB(Rx));
|
||
FServer.Broadcast(StrANF(Rx));
|
||
FServer.Broadcast(StrSqlEnable(Rx));
|
||
FServer.Broadcast(StrSqlLevel(Rx));
|
||
end;
|
||
|
||
procedure TTCIAdapter.BroadcastTxEnable;
|
||
// TX_ENABLE — величина всего радио, но адресуется приёмником, и клиент читает
|
||
// только строки со СВОИМ номером. Одной строки `tx_enable:0,…` мало: клиент на
|
||
// приёмнике 1 её отбрасывает, а у MSHV на этом флаге висит вся передача
|
||
// (`set_ptt`: `if (!tci_tx_enable) return;`).
|
||
var Rx: Integer;
|
||
begin
|
||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||
for Rx := 0 to RxCount - 1 do
|
||
if RxActive(Rx) then FServer.Broadcast(StrTxEnable(Rx));
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Подключение клиента: инициализация + текущее состояние
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TTCIAdapter.Reply(Client: TTCIClient; const S: string);
|
||
begin
|
||
if (Client <> nil) and (S <> '') then Client.Send(S);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SendInit(Client: TTCIClient);
|
||
// Исполняется в потоке клиента, поэтому всё «железное» берётся из снимка
|
||
// (DevSnap), а не из контроллера: BackendCaps и BoardDisplayName смотрят в
|
||
// FNetwork, который UI освобождает на смене устройства.
|
||
var
|
||
D: TTCIDevSnap;
|
||
Half: Integer;
|
||
DevName: string;
|
||
begin
|
||
D := DevSnap;
|
||
|
||
Half := D.SampleRate div 2;
|
||
if Half <= 0 then Half := 48000;
|
||
|
||
DevName := Trim(D.DevName);
|
||
if DevName = '' then DevName := TCI_APP_NAME;
|
||
|
||
Reply(Client, TCIBuild('protocol', [TCI_APP_NAME, TCI_VERSION]));
|
||
Reply(Client, TCIBuild('device', [DevName]));
|
||
Reply(Client, TCIBuild('receive_only', [TCIBoolStr(not D.HasTX)]));
|
||
Reply(Client, TCIBuild('trx_count', [TCIIntStr(RxCount)]));
|
||
Reply(Client, TCIBuild('channel_count', [TCIIntStr(TCI_CHANNELS)]));
|
||
// Границы — из того же снимка, что и проверка частоты в командах (§2.1).
|
||
Reply(Client, TCIBuild('vfo_limits',
|
||
[TCIIntStr(Round(D.LimLoHz)), TCIIntStr(Round(D.LimHiHz))]));
|
||
Reply(Client, TCIBuild('if_limits', [TCIIntStr(-Half), TCIIntStr(Half)]));
|
||
Reply(Client, TCIBuild('modulations_list', [TCI_MODULATIONS]));
|
||
end;
|
||
|
||
procedure TTCIAdapter.SendState(Client: TTCIClient);
|
||
var
|
||
Rx, Ch, Chans: Integer;
|
||
E: TTCIRxEcho;
|
||
begin
|
||
for Rx := 0 to RxCount - 1 do
|
||
begin
|
||
// Приёмника ещё нет (пан не создан): TRX_COUNT объявляет потолок железа, а
|
||
// не число живых панов, и раньше на такой номер уходили dds/vfo/if с нулём
|
||
// — клиент принимал ноль за настоящую частоту. Молчим до появления пана:
|
||
// он придёт с rfPanFreq/rfSliceState.
|
||
if not RxActive(Rx) then Continue;
|
||
|
||
FEchoLock.Enter;
|
||
try E := FEcho[Rx]; finally FEchoLock.Leave; end;
|
||
|
||
Reply(Client, StrDds(Rx));
|
||
// Только реально существующие каналы: объявив пану второй канал, которого
|
||
// нет, мы отдали бы клиенту vfo:rx,1,0 — и он принял бы ноль за частоту.
|
||
// У пана без слайсов каналов нет вовсе — тогда только dds.
|
||
Chans := ChanCount(Rx);
|
||
for Ch := 0 to Chans - 1 do
|
||
begin
|
||
Reply(Client, StrVfo(Rx, Ch));
|
||
Reply(Client, StrIf(Rx, Ch));
|
||
Reply(Client, StrRxVolume(Rx, Ch));
|
||
Reply(Client, TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch),
|
||
TCIIntStr(E.BalanceDb[Ch])]));
|
||
// VFO_LOCK — уведомление поканальное (§4.5): без него клиент, вошедший
|
||
// на запертой ручке, о запрете не знает.
|
||
Reply(Client, TCIBuild('vfo_lock', [TCIIntStr(Rx), TCIIntStr(Ch),
|
||
TCIBoolStr(FController.FVfoLock)]));
|
||
end;
|
||
Reply(Client, TCIBuild('rx_channel_enable',
|
||
[TCIIntStr(Rx), '1', TCIBoolStr(Chans > 1)]));
|
||
Reply(Client, StrModulation(Rx));
|
||
Reply(Client, StrFilterBand(Rx));
|
||
Reply(Client, StrAGCMode(Rx));
|
||
Reply(Client, StrAGCGain(Rx));
|
||
Reply(Client, TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))]));
|
||
Reply(Client, StrNB(Rx));
|
||
Reply(Client, TCIBuild('rx_nb_param', [TCIIntStr(Rx),
|
||
TCIIntStr(E.NBThreshold), TCIIntStr(E.NBDuration)]));
|
||
Reply(Client, StrNR(Rx));
|
||
Reply(Client, StrANF(Rx));
|
||
Reply(Client, TCIBuild('rx_bin_enable', [TCIIntStr(Rx), TCIBoolStr(E.BinOn)]));
|
||
Reply(Client, TCIBuild('rx_anc_enable', [TCIIntStr(Rx), TCIBoolStr(E.ANCOn)]));
|
||
Reply(Client, TCIBuild('rx_apf_enable', [TCIIntStr(Rx), TCIBoolStr(E.APFOn)]));
|
||
Reply(Client, TCIBuild('rx_dse_enable', [TCIIntStr(Rx), TCIBoolStr(E.DSEOn)]));
|
||
Reply(Client, TCIBuild('rx_nf_enable', [TCIIntStr(Rx), TCIBoolStr(E.NFOn)]));
|
||
Reply(Client, StrLock(Rx));
|
||
Reply(Client, StrSqlEnable(Rx));
|
||
Reply(Client, StrSqlLevel(Rx));
|
||
Reply(Client, TCIBuild('rit_enable', [TCIIntStr(Rx), TCIBoolStr(E.RitOn)]));
|
||
Reply(Client, TCIBuild('rit_offset', [TCIIntStr(Rx), TCIIntStr(E.RitHz)]));
|
||
Reply(Client, TCIBuild('xit_enable', [TCIIntStr(Rx), TCIBoolStr(E.XitOn)]));
|
||
Reply(Client, TCIBuild('xit_offset', [TCIIntStr(Rx), TCIIntStr(E.XitHz)]));
|
||
Reply(Client, StrTxEnable(Rx));
|
||
end;
|
||
|
||
Reply(Client, TCIBuild('split_enable', ['0', TCIBoolStr(FController.FSplitTxB)]));
|
||
// В пачке инициализации называем того, чей слайс сейчас источник передачи.
|
||
Reply(Client, StrTrx(TxRx));
|
||
Reply(Client, StrTune(TxRx));
|
||
Reply(Client, StrDrive);
|
||
Reply(Client, TCIBuild('tune_drive', ['0', TCIIntStr(FController.FTXSettings.TUNLevel)]));
|
||
Reply(Client, StrVolume);
|
||
Reply(Client, StrMute);
|
||
Reply(Client, TCIBuild('mon_volume', [TCIIntStr(Round(TCIVolumeToDb(FController.FTxMonVolume)))]));
|
||
Reply(Client, TCIBuild('mon_enable', [TCIBoolStr(not FController.FRxMuteOnTx)]));
|
||
Reply(Client, TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)]));
|
||
Reply(Client, TCIBuild('cw_macros_delay', [TCIIntStr(FController.FCWSettings.RFDelayMS)]));
|
||
FEchoLock.Enter;
|
||
try
|
||
Reply(Client, TCIBuild('digl_offset', [TCIIntStr(FDiglOffset)]));
|
||
Reply(Client, TCIBuild('digu_offset', [TCIIntStr(FDiguOffset)]));
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)]));
|
||
Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)]));
|
||
// Частота передачи и фокус окна — состояние, а не только событие: на
|
||
// стабильном радио TX_FREQUENCY не придёт ещё очень долго (уведомление шлётся
|
||
// по изменению), а логгеру она нужна сразу — особенно в split и на TX-слайсе.
|
||
Reply(Client, TCIBuild('tx_frequency',
|
||
[TCIIntStr(Round(FController.ActiveTXFreqHz))]));
|
||
Reply(Client, TCIBuild('app_focus', [TCIBoolStr(FAppFocus)]));
|
||
if FController.FRunning then Reply(Client, TCIBuild('start'))
|
||
else Reply(Client, TCIBuild('stop'));
|
||
end;
|
||
|
||
procedure TTCIAdapter.HandleConnect(Client: TTCIClient);
|
||
// Зовётся сервером под FClientLock: рассылка ждёт, пока пачка не уложена в
|
||
// очередь целиком, поэтому изменение, случившееся посреди дампа, приходит
|
||
// ПОСЛЕ него, а не теряется. Отсюда запрет: никаких Invoke в поток контроллера
|
||
// — он сам может стоять на этом локе внутри Broadcast.
|
||
begin
|
||
// Не отдать READY молча нельзя: клиент, ждущий его, повиснет навсегда, —
|
||
// поэтому дамп состояния под защитой, а READY уходит в любом случае.
|
||
try
|
||
SendInit(Client);
|
||
SendState(Client);
|
||
except
|
||
on E: Exception do
|
||
Reply(Client, TCIBuild('tci_error', ['init', TCIEscape(E.Message)]));
|
||
end;
|
||
Reply(Client, TCIBuild('ready'));
|
||
Client.Ready := True;
|
||
end;
|
||
|
||
procedure TTCIAdapter.HandleDisconnect(Client: TTCIClient);
|
||
// Клиент ушёл — снимаем его захваты параметров, иначе следующий, кому достанется
|
||
// тот же адрес объекта, унаследовал бы чужие права (§3.5). По той же причине
|
||
// гасим его потоки: объект клиента вот-вот освободят, а на него смотрит
|
||
// DSP-поток. Порядок обязателен — сначала потоки, потом возврат в сервер.
|
||
begin
|
||
DropHolds(Client);
|
||
DropClientStreams(Client);
|
||
DropClientRecorders(Client);
|
||
ClearTxClient(Client);
|
||
// ★И только теперь — сама передача: если в эфир нас поставил именно этот
|
||
// клиент, снимаем MOX. Оставить включённый передатчик за ушедшим клиентом
|
||
// нельзя ни при какой модуляции (§4.2).
|
||
StopTxOf(Client);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Sync-методы: исполняются в потоке контроллера (через Invoke)
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TTCIAdapter.SyncSetVfo;
|
||
var Id: Integer;
|
||
begin
|
||
// Окончательная проверка — здесь: см. FreqSaneLive.
|
||
if not FreqSaneLive(FsFreq) then Exit;
|
||
if FsInt = 0 then
|
||
begin
|
||
if FsInt2 = 1 then FController.SetVfoB(FsFreq) else FController.SetVfoA(FsFreq);
|
||
Exit;
|
||
end;
|
||
Id := SliceIdLive(FsInt, FsInt2);
|
||
// Тот же путь, что у CAT-порта слайса: внутри включённого диапазона слайс
|
||
// ходит свободно, за захваченную полосу окно DDC переедет само, за границы
|
||
// диапазона команда отбрасывается. Прямой SetSliceTarget (как было) уводил
|
||
// слайс куда угодно, а для TX-слайса эта частота идёт прямо в DUC — то есть
|
||
// в эфир на чужом диапазоне, без переключения антенн и фильтров.
|
||
// SliceFreqChanged шлёт сам SetSliceTarget — и для нас, и для UI, и для CAT.
|
||
if Id > 0 then FController.TuneSliceInBand(Id, FsFreq);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetCenter;
|
||
begin
|
||
// Окончательная проверка — здесь: см. FreqSaneLive. SetCenter границ не
|
||
// клампит, число уходит прямо в backend.
|
||
if not FreqSaneLive(FsFreq) then Exit;
|
||
// Двигать можно только центр главной панорамы — она и есть приёмник 0.
|
||
// У приёмника-слайса DDS только читается: панорама под ним общая, и увести
|
||
// её по просьбе одного клиента значит утащить за собой всех соседей по пану
|
||
// и картинку оператора. Слайсу двигаться незачем — за окном DDC следит
|
||
// TuneSliceInBand (см. SyncSetVfo).
|
||
if FsInt = 0 then FController.SetCenter(FsFreq);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetMode;
|
||
var Id: Integer;
|
||
begin
|
||
if FsInt = 0 then begin FController.SetMode(FsInt2); Exit; end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if Id > 0 then FController.SetSliceMode(Id, FsInt2);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetFilter;
|
||
var Id: Integer;
|
||
begin
|
||
if FsInt = 0 then begin FController.SetFilterEdges(FsInt2, FsInt3); Exit; end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if Id > 0 then FController.SetSliceFilter(Id, FsInt2, FsInt3);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetTRX;
|
||
// Поток контроллера. FsInt — номер приёмника из arg1, FsBool3 — это TUNE.
|
||
// Наружу отдаёт FsRes: «эфир подняла ИМЕННО ЭТА команда» — по нему в потоке
|
||
// клиента назначается хозяин передачи.
|
||
//
|
||
// ★Все решения принимаются здесь, а не в потоке клиента. Между разбором
|
||
// команды и её исполнением оператор успевает нажать PTT, и снимок «шла ли
|
||
// передача», снятый заранее, соврал бы — а по нему назначается хозяин эфира,
|
||
// то есть право снять чужую передачу.
|
||
var
|
||
Id: Integer;
|
||
WasTx, Started: Boolean;
|
||
begin
|
||
FsRes := False;
|
||
WasTx := FController.FTransmitting or FController.FTuning;
|
||
|
||
// Источник модуляции ставим ДО SetMOX — именно он его и читает при выборе
|
||
// микрофона. Выключение передачи флаг снимает всегда: следующий раз оператор
|
||
// может нажать PTT сам, и тогда в эфир должен идти его микрофон.
|
||
// ★Ставим его ТОЛЬКО когда эфир поднимаем мы сами. SetMOX(True) поверх уже
|
||
// идущей передачи не выходит рано — он заново выбирает микрофон, и
|
||
// «trx:0,true,tci» посреди передачи оператора молча уводил модуляцию в ринг
|
||
// TCI. Хозяином эфира клиент при этом не становился, так что его уход
|
||
// оставлял в эфире несущую с тишиной. У TUNE источника нет вовсе (несущую
|
||
// даёт генератор тона), и трогать чужой выбор микрофона он не вправе.
|
||
if not FsBool3 then
|
||
begin
|
||
if not FsBool then FController.TCIMicRequested := False
|
||
else if not WasTx then FController.TCIMicRequested := FsBool2;
|
||
end;
|
||
|
||
// Приёмник 0 — это главный VFO, то есть «радио целиком»: ведём себя как
|
||
// обычный CAT-порт (в эфир уходит выбранный оператором TX-источник). Приёмник
|
||
// N > 0 адресует слайс канала A своего пана — заявка идёт через контроллер,
|
||
// который один имеет право сменить TX-источник.
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if FsBool and WasTx then
|
||
begin
|
||
// Передатчик занят — чужую передачу не перехватываем и поверх неё ничего не
|
||
// включаем: то же правило, что внутри RequestSliceTx, только оно обязано
|
||
// работать и для приёмника 0. Иначе «tune:0,true» подмешивал настроечный
|
||
// тон в чужую передачу, а хозяином TUN не становился никто — и после ухода
|
||
// клиента тон оставался в эфире. Своя же передача и так идёт: повторная
|
||
// команда — no-op.
|
||
end
|
||
else if FsInt > 0 then
|
||
begin
|
||
// Пан жив, но слайса на канале A может не быть (пан без слайсов показывает
|
||
// центр) — тогда просьба просто не исполняется. Подменять её главным VFO
|
||
// нельзя: это чужая частота, а то и чужой диапазон.
|
||
if Id > 0 then FController.RequestSliceTx(Id, FsBool, FsBool3);
|
||
end
|
||
else if FsBool3 then
|
||
FController.SetTune(FsBool)
|
||
else
|
||
FController.SetMOX(FsBool);
|
||
|
||
Started := FsBool and (not WasTx) and
|
||
(FController.FTransmitting or FController.FTuning);
|
||
FsRes := Started;
|
||
// Заявку могли отклонить (нет Auto TX у слайса, DMR, запрет передачи на
|
||
// диапазоне) — тогда снимаем и источник модуляции: иначе следующая PTT
|
||
// оператора ушла бы в эфир с микрофоном ушедшего клиента вместо его
|
||
// собственного.
|
||
if FsBool and (not FsBool3) and (not WasTx) and (not Started) then
|
||
FController.TCIMicRequested := False;
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncStopTRX;
|
||
// Поток контроллера. Передачу, начатую ушедшим клиентом, снимаем безусловно:
|
||
// решение принято там, где известно, кто её начал, а здесь остаётся только
|
||
// проверить, что она вообще идёт (оператор мог отпустить PTT сам).
|
||
begin
|
||
if FController = nil then Exit;
|
||
if not (FController.FTransmitting or FController.FTuning) then Exit;
|
||
FController.TCIMicRequested := False;
|
||
// TUN снимаем именно SetTune: он гасит и тон, и PTT, и возвращает drive.
|
||
// SetMOX(False) поверх включённого TUN оставил бы взведённым генератор тона,
|
||
// а FTuning — поднятым, то есть аппарат в состоянии, которого на экране нет.
|
||
if FController.FTuning then FController.SetTune(False)
|
||
else FController.SetMOX(False);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncTaps;
|
||
// Поток контроллера: движок и список тапов трогаем только отсюда.
|
||
begin
|
||
if FsBool then
|
||
begin
|
||
FController.AddAudioTap(OnAudioTap);
|
||
FController.SetIQTap(OnIQTap);
|
||
end
|
||
else
|
||
begin
|
||
FController.RemoveAudioTap(OnAudioTap);
|
||
FController.SetIQTap(nil);
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetDrive;
|
||
begin
|
||
FController.SetDrive(FsInt);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetTuneDrive;
|
||
var T: TTXSettings;
|
||
begin
|
||
T := FController.FTXSettings;
|
||
T.TUNLevel := FsInt;
|
||
FController.SetTXSettings(T);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetSplit;
|
||
begin
|
||
FController.SetSplit(FsBool);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetVolume;
|
||
// Адресно: SetVolume правит АКТИВНУЮ громкость, и на передаче с самоконтролем
|
||
// команда VOLUME уехала бы в громкость монитора, а в ответ клиент получал бы
|
||
// нетронутый FVolume. У TCI это разные команды — VOLUME и MON_VOLUME.
|
||
begin
|
||
FController.SetRxVolume(FsInt);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetMute;
|
||
begin
|
||
FController.SetMute(FsBool);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetRxMute;
|
||
var Id: Integer;
|
||
begin
|
||
if FsInt = 0 then begin FController.SetMute(FsBool); Exit; end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if Id > 0 then FController.SetSliceMute(Id, FsBool);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetRxVolume;
|
||
var Id: Integer;
|
||
begin
|
||
// Тоже адресно (см. SyncSetVolume): RX_VOLUME — про приём, не про монитор.
|
||
if FsInt = 0 then begin FController.SetRxVolume(FsInt2); Exit; end;
|
||
Id := SliceIdLive(FsInt, FsInt3); // FsInt3 — канал: у слайсов громкость своя
|
||
if Id > 0 then FController.SetSliceVolume(Id, FsInt2 / 100.0);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetMonVolume;
|
||
begin
|
||
FController.SetTXMonVolume(FsInt);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetMonEnable;
|
||
begin
|
||
// Самоконтроль на передаче = RX-аудио НЕ глушится (кнопка RX MUTE).
|
||
FController.SetRxMuteOnTx(not FsBool);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetAGCMode;
|
||
var Id: Integer;
|
||
begin
|
||
if FsInt = 0 then begin FController.SetAGCMode(FsInt2); Exit; end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if Id > 0 then
|
||
FController.SetSliceAGCMode(Id, TRadioController.AGCModeFromUI(FsInt2));
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetAGCTop;
|
||
begin
|
||
FController.SetAGCTop(FsInt);
|
||
end;
|
||
|
||
// DSP слайса ставится одной командой на все четыре блока, поэтому остальные три
|
||
// берём из САМОГО слайса. Подставлять сюда поля главного тракта (как было)
|
||
// значило бы: включил клиент NR на доп. приёмнике — и заодно переписал ему NB,
|
||
// SNB и ANF значениями главного.
|
||
procedure TTCIAdapter.SyncSetNR;
|
||
var Id: Integer; S: TSliceView;
|
||
begin
|
||
if FsInt = 0 then
|
||
begin
|
||
if FsBool then FController.SetNR(1) else FController.SetNR(0);
|
||
Exit;
|
||
end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if (Id > 0) and FController.GetSliceView(Id, S) then
|
||
FController.SetSliceDSP(Id, Ord(FsBool), S.NBMode, S.SNB, S.ANF);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetNB;
|
||
var Id: Integer; S: TSliceView;
|
||
begin
|
||
if FsInt = 0 then
|
||
begin
|
||
if FsBool then FController.SetNB(1) else FController.SetNB(0);
|
||
Exit;
|
||
end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if (Id > 0) and FController.GetSliceView(Id, S) then
|
||
FController.SetSliceDSP(Id, S.NRMode, Ord(FsBool), S.SNB, S.ANF);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetANF;
|
||
var Id: Integer; S: TSliceView;
|
||
begin
|
||
if FsInt = 0 then begin FController.SetANF(FsBool); Exit; end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if (Id > 0) and FController.GetSliceView(Id, S) then
|
||
FController.SetSliceDSP(Id, S.NRMode, S.NBMode, S.SNB, FsBool);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetLock;
|
||
begin
|
||
FController.SetVfoLock(FsBool);
|
||
end;
|
||
|
||
// Squelch слайса — тоже парный сеттер: второй параметр берём из слайса, а не
|
||
// из главного тракта (иначе правка порога сбрасывала бы включение, и наоборот).
|
||
procedure TTCIAdapter.SyncSetSql;
|
||
var Id: Integer; S: TSliceView;
|
||
begin
|
||
if FsInt = 0 then begin FController.SetFMSquelch(FsBool); Exit; end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if (Id > 0) and FController.GetSliceView(Id, S) then
|
||
FController.SetSliceFMSquelch(Id, FsBool, S.FMSQLevel);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetSqlLevel;
|
||
var Id: Integer; S: TSliceView;
|
||
begin
|
||
if FsInt = 0 then begin FController.SetFMSquelchLevel(FsInt2); Exit; end;
|
||
Id := SliceIdLive(FsInt, 0);
|
||
if (Id > 0) and FController.GetSliceView(Id, S) then
|
||
FController.SetSliceFMSquelch(Id, S.FMSQOn, FsInt2);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetRun;
|
||
begin
|
||
FController.SetRun(FsBool);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetCWSpeed;
|
||
var C: TCWSettings;
|
||
begin
|
||
C := FController.CWSettings;
|
||
C.Speed := FsInt;
|
||
FController.SetCWSettings(C);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncSetCWDelay;
|
||
var C: TCWSettings;
|
||
begin
|
||
C := FController.CWSettings;
|
||
C.RFDelayMS := FsInt;
|
||
FController.SetCWSettings(C);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncCWSend;
|
||
begin
|
||
FController.CWXSend(FsStr);
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncCWStop;
|
||
begin
|
||
FController.CWXAbort;
|
||
end;
|
||
|
||
procedure TTCIAdapter.SyncFocus;
|
||
// SET_IN_FOCUS: поднять окно программы. Само окно адаптеру недоступно (он
|
||
// равноправный клиент контроллера) — действие ставит UI через OnFocusRequest.
|
||
begin
|
||
if Assigned(FOnFocusRequest) then FOnFocusRequest;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Разбор команд клиента
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TTCIAdapter.CmdFreq(Client: TTCIClient; const M: TTCIMessage; IsIF: Boolean);
|
||
// VFO:rx,ch[,hz] и IF:rx,ch[,hz] — разница только в системе отсчёта.
|
||
var
|
||
Rx, Ch: Integer;
|
||
Hz: Double;
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not TCITryArgInt(M, 1, Ch) then Ch := 0;
|
||
if not ValidRx(Rx) then Exit;
|
||
if (Ch < 0) or (Ch >= TCI_CHANNELS) then Exit;
|
||
// ★Про приёмник, которого нет (слайс не создан или уже удалён), молчим
|
||
// целиком — и на чтение тоже. Ответ «vfo:1,0,0» клиент принял бы за
|
||
// настоящую частоту, а MSHV именно этим ответом завершает инициализацию
|
||
// (network.cpp, Network::initAll) — то есть подключился бы к пустоте.
|
||
if (Ch >= ChanCount(Rx)) or not RxActive(Rx) then Exit;
|
||
|
||
// Частота ставится, только если её удалось разобрать И она годная: «vfo:0,0,abc»
|
||
// раньше превращалось в честный ноль и уводило приёмник на 0 Гц.
|
||
if (M.ArgCount >= 3) and TCITryArgFloat(M, 2, Hz) then
|
||
begin
|
||
if IsIF then Hz := RxCenterHz(Rx) + Hz;
|
||
if FreqSane(Hz) and Claim(HoldKey('VFO', Rx, Ch), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx; FsInt2 := Ch; FsFreq := Hz;
|
||
if CanInvoke then FController.Invoke(SyncSetVfo);
|
||
finally
|
||
FLock.Leave;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if IsIF then Reply(Client, StrIf(Rx, Ch)) else Reply(Client, StrVfo(Rx, Ch));
|
||
end;
|
||
|
||
procedure TTCIAdapter.CmdCWMacros(const M: TTCIMessage; IsMsg: Boolean);
|
||
// CW_MACROS:trx,текст; CW_MSG:trx,префикс,позывной,суффикс;
|
||
// Разметку TCI приводим к тому, что понимает передатчик текста ewsdr:
|
||
// |ABBR| — слитная передача (у нас такой команды нет) → скобки снимаем;
|
||
// < / > — шаг скорости ±5 wpm (передатчик работает на одной скорости) → снимаем;
|
||
// CALL$N — повтор позывного N раз.
|
||
var
|
||
Text, Prefix, Call, Suffix, Rep: string;
|
||
P, N, i: Integer;
|
||
begin
|
||
if IsMsg then
|
||
begin
|
||
// cw_msg:arg1; — доотправка позывного по ходу передачи. Наш передатчик
|
||
// текста уже отданное не редактирует, поэтому такую форму игнорируем.
|
||
if M.ArgCount < 4 then Exit;
|
||
Prefix := TCIUnescape(TCIArg(M, 1));
|
||
Call := TCIUnescape(TCIArg(M, 2));
|
||
Suffix := TCIUnescape(TCIArg(M, 3));
|
||
if Prefix = '_' then Prefix := '';
|
||
if Suffix = '_' then Suffix := '';
|
||
|
||
P := Pos('$', Call);
|
||
if P > 0 then
|
||
begin
|
||
Rep := Copy(Call, P + 1, MaxInt);
|
||
Call := Copy(Call, 1, P - 1);
|
||
N := StrToIntDef(Trim(Rep), 1);
|
||
if N < 1 then N := 1;
|
||
if N > 5 then N := 5;
|
||
Text := '';
|
||
for i := 1 to N do
|
||
begin
|
||
if Text <> '' then Text := Text + ' ';
|
||
Text := Text + Call;
|
||
end;
|
||
Call := Text;
|
||
end;
|
||
|
||
Text := Trim(Prefix + ' ' + Call + ' ' + Suffix);
|
||
end
|
||
else
|
||
begin
|
||
if M.ArgCount < 2 then Exit;
|
||
Text := TCIUnescape(TCIArg(M, 1));
|
||
end;
|
||
|
||
Text := StringReplace(Text, '|', '', [rfReplaceAll]);
|
||
Text := StringReplace(Text, '<', '', [rfReplaceAll]);
|
||
Text := StringReplace(Text, '>', '', [rfReplaceAll]);
|
||
Text := Trim(Text);
|
||
if Text = '' then Exit;
|
||
|
||
FLock.Enter;
|
||
try
|
||
FsStr := Text;
|
||
if CanInvoke then FController.Invoke(SyncCWSend);
|
||
finally
|
||
FLock.Leave;
|
||
end;
|
||
|
||
// Позывной ушёл в эфир целиком — подтверждаем финальный вариант (§3.2.2).
|
||
if IsMsg and (Call <> '') then
|
||
FServer.Broadcast(TCIBuild('callsign_send', [Call]));
|
||
end;
|
||
|
||
procedure TTCIAdapter.CmdSpot(const M: TTCIMessage);
|
||
// SPOT:позывной,мода,частота,цвет ARGB,текст;
|
||
var
|
||
S: TDXSpot;
|
||
begin
|
||
if FSpots = nil then Exit;
|
||
if M.ArgCount < 3 then Exit;
|
||
|
||
S.Call := TCIUnescape(TCIArg(M, 0));
|
||
S.FreqHz := TCIArgFloat(M, 2, 0);
|
||
S.Comment := TCIUnescape(TCIArg(M, 4));
|
||
S.Spotter := 'TCI';
|
||
// Поле называется TimeUTC и рисуется рядом со спотами кластера, которые
|
||
// приходят в UTC: местное время сдвигало бы подпись на часовой пояс.
|
||
// Stamp — наоборот, местное: по нему считается возраст спота (TTL).
|
||
S.TimeUTC := FormatDateTime('hhnn', LocalTimeToUniversal(Now));
|
||
S.Stamp := Now;
|
||
S.ModeGuessed := False;
|
||
S.Mode := DXModeFromComment(TCIArg(M, 1));
|
||
if S.Mode = dxmUnknown then S.Mode := DXModeFromComment(S.Comment);
|
||
if S.Mode = dxmUnknown then
|
||
begin
|
||
S.Mode := DXModeFromFreq(S.FreqHz);
|
||
S.ModeGuessed := S.Mode <> dxmUnknown;
|
||
end;
|
||
if (S.Call = '') or (S.FreqHz <= 0) then Exit;
|
||
FSpots.Add(S); // стор потокобезопасен, маршалинг не нужен
|
||
end;
|
||
|
||
procedure TTCIAdapter.HandleCommand(Client: TTCIClient; const Cmd: string);
|
||
// Внешняя оболочка: разбор + «одна команда не роняет соединение». Команда
|
||
// приходит из сети, а исполняется в потоке контроллера, где может рвануть что
|
||
// угодно (не поднятые движки, чужие сеттеры) — клиент за это платить не должен.
|
||
var
|
||
M: TTCIMessage;
|
||
begin
|
||
if not TCIParse(Cmd, M) then Exit;
|
||
try
|
||
DispatchCommand(Client, M);
|
||
except
|
||
on E: Exception do
|
||
Client.Send(TCIBuild('tci_error', [TCIEscape(LowerCase(M.Name)),
|
||
TCIEscape(E.Message)]));
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.DispatchCommand(Client: TTCIClient; const M: TTCIMessage);
|
||
var
|
||
Rx, Ch, V: Integer;
|
||
Lo, Hi: Integer;
|
||
B, FromTCI, Tune, Started: Boolean;
|
||
D: Double;
|
||
Name: string;
|
||
begin
|
||
|
||
// ── Управление устройством ──
|
||
if M.Name = 'START' then
|
||
begin
|
||
FLock.Enter;
|
||
try FsBool := True; if CanInvoke then FController.Invoke(SyncSetRun); finally FLock.Leave; end;
|
||
Exit;
|
||
end;
|
||
if M.Name = 'STOP' then
|
||
begin
|
||
FLock.Enter;
|
||
try FsBool := False; if CanInvoke then FController.Invoke(SyncSetRun); finally FLock.Leave; end;
|
||
Exit;
|
||
end;
|
||
|
||
// ── Частоты ──
|
||
if M.Name = 'VFO' then begin CmdFreq(Client, M, False); Exit; end;
|
||
if M.Name = 'IF' then begin CmdFreq(Client, M, True); Exit; end;
|
||
|
||
if M.Name = 'DDS' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
// Двигать центр можно только у приёмника 0 — у главной панорамы. У
|
||
// приёмника-слайса DDS читается (центр его пана), но не пишется: панорама
|
||
// под ним общая, и увести её по просьбе одного клиента значит утащить
|
||
// соседей по пану и картинку оператора. Ответ уходит всегда — с текущим
|
||
// значением, как и у AGC_GAIN доп. приёмника (§3.1).
|
||
if (Rx = 0) and
|
||
(M.ArgCount >= 2) and TCITryArgFloat(M, 1, D) and FreqSane(D) and
|
||
Claim(HoldKey('DDS', Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx; FsFreq := D;
|
||
if CanInvoke then FController.Invoke(SyncSetCenter);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrDds(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Вид связи и фильтр ──
|
||
if M.Name = 'MODULATION' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
if M.ArgCount >= 2 then
|
||
begin
|
||
V := TCIModeIndex(TCIArg(M, 1), RxMode(Rx), ChanFreq(Rx, 0));
|
||
if (V >= 0) and Claim(HoldKey('MOD', Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx; FsInt2 := V;
|
||
if CanInvoke then FController.Invoke(SyncSetMode);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
end;
|
||
Reply(Client, StrModulation(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'RX_FILTER_BAND' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
// Обе кромки обязаны разобраться, и нижняя обязана быть ниже верхней:
|
||
// «rx_filter_band:0,x,y» иначе схлопывал фильтр в 0..0 и приёмник глох.
|
||
if (M.ArgCount >= 3) and TCITryArgInt(M, 1, Lo) and TCITryArgInt(M, 2, Hi) and
|
||
(Lo < Hi) and Claim(HoldKey('FILT', Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx;
|
||
FsInt2 := Lo;
|
||
FsInt3 := Hi;
|
||
if CanInvoke then FController.Invoke(SyncSetFilter);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrFilterBand(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Передача ──
|
||
// ★arg1 у TRX/TUNE — НОМЕР ПЕРЕДАТЧИКА, и он не декорация: клиент, работающий
|
||
// на приёмнике N, просит эфир своему слайсу, а не тому, который оператор
|
||
// выбрал мышкой. Игнорировать его значит передать на чужой частоте, а с
|
||
// кросс-бандовым мультислайс-TX — и на чужом диапазоне, с чужими антенной и
|
||
// фильтрами. Поэтому номер разбирается и проверяется, как везде, а исполнение
|
||
// для N > 0 идёт через RequestSliceTx — ту же дверь, что у CAT-порта слайса
|
||
// (там же и «в эфире только один», и уважение к флагу Auto TX).
|
||
if (M.Name = 'TRX') or (M.Name = 'TUNE') then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'bad receiver']));
|
||
Exit;
|
||
end;
|
||
// Номер объявлен (TRX_COUNT = потолок железа), но пана под ним может не
|
||
// быть вовсе. Свести такую просьбу к главному VFO — то же самое, что
|
||
// передать на чужой частоте, только молча.
|
||
if (Rx > 0) and not RxActive(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[LowerCase(M.Name), 'receiver is not running']));
|
||
Exit;
|
||
end;
|
||
// Ключ захвата (§3.5) — общий на радио, а не на приёмник: передатчик один,
|
||
// и два клиента, дёргающие эфир с разных приёмников, спорят именно за него.
|
||
if TCITryArgBool(M, 1, B) and Claim(HoldKey('TRX', 0, 0), Client) then
|
||
begin
|
||
// arg3 — источник сигнала (только у TRX). Наш только 'tci': модуляция
|
||
// берётся из аудиопотока этого клиента. Остальные значения
|
||
// (mic1/mic2/micpc/ecoder2) называют физические входы ExpertSDR3, которых
|
||
// у нас нет, — они значат «микрофон, выбранный в программе», то есть ровно
|
||
// то, что и без arg3. Требование «включен аудиопоток по TCI» (§4.2)
|
||
// проверяем буквально: без AUDIO_START модулировать нечем, и молча
|
||
// оставить оператора с тишиной в эфире хуже, чем передавать с его
|
||
// микрофона.
|
||
Tune := M.Name = 'TUNE';
|
||
Name := LowerCase(Trim(TCIArg(M, 2)));
|
||
FromTCI := B and (not Tune) and (Name = 'tci') and HasAudioStream(Client);
|
||
FTxLock.Enter;
|
||
try
|
||
if FromTCI then FTxClient := Client
|
||
else if (not Tune) and (FTxClient = Client) then FTxClient := nil;
|
||
finally FTxLock.Leave; end;
|
||
Started := False;
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx;
|
||
FsBool := B;
|
||
FsBool2 := FromTCI;
|
||
FsBool3 := Tune;
|
||
FsRes := False;
|
||
if CanInvoke then FController.Invoke(SyncSetTRX);
|
||
Started := FsRes; // ответ Sync-метода — под тем же локом, что и вопрос
|
||
finally FLock.Leave; end;
|
||
// Кто поставил трансивер в эфир: его уход обязан эфир и снять (см.
|
||
// StopTxOf). Источник модуляции тут ни при чём — несущую без хозяина
|
||
// оставлять нельзя в любом случае. ★Хозяином записываемся, только если
|
||
// эфир и правда начался ИМЕННО от этой команды — а знает об этом только
|
||
// сам Sync-метод: он один видит состояние передатчика до и после, на
|
||
// потоке контроллера и без окна, в которое влезает PTT оператора.
|
||
FTxLock.Enter;
|
||
try
|
||
if Started then FTrxOwner := Client
|
||
else if (not B) and (FTrxOwner = Client) then FTrxOwner := nil;
|
||
finally FTxLock.Leave; end;
|
||
end;
|
||
// ★Автору отвечаем ЕГО номером приёмника (см. StrTrx): клиент фильтрует
|
||
// входящие по arg1, и отказ, названный чужим номером, до него не дойдёт.
|
||
if M.Name = 'TUNE' then Reply(Client, StrTune(Rx)) else Reply(Client, StrTrx(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'DRIVE' then
|
||
begin
|
||
if TCITryArgInt(M, 1, V) and Claim(HoldKey('DRIVE', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := EnsureRange(V, 0, 100);
|
||
if CanInvoke then FController.Invoke(SyncSetDrive);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrDrive);
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'TUNE_DRIVE' then
|
||
begin
|
||
if TCITryArgInt(M, 1, V) and Claim(HoldKey('TUNEDRIVE', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := EnsureRange(V, 0, 100);
|
||
if CanInvoke then FController.Invoke(SyncSetTuneDrive);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
// Уровень TUN — величина общая для радио: отвечать одному автору значило бы
|
||
// оставить остальных клиентов со старым числом (Broadcast включает автора).
|
||
FServer.Broadcast(TCIBuild('tune_drive', ['0',
|
||
TCIIntStr(FController.FTXSettings.TUNLevel)]));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'SPLIT_ENABLE' then
|
||
begin
|
||
if TCITryArgBool(M, 1, B) and Claim(HoldKey('SPLIT', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsBool := B;
|
||
if CanInvoke then FController.Invoke(SyncSetSplit);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
// Split — свойство радио, а не клиента: остальным о нём узнать больше
|
||
// неоткуда (rfActiveVfo несёт его же, но только когда значение сменилось).
|
||
FServer.Broadcast(TCIBuild('split_enable',
|
||
['0', TCIBoolStr(FController.FSplitTxB)]));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Громкость ──
|
||
if M.Name = 'VOLUME' then
|
||
begin
|
||
if TCITryArgFloat(M, 0, D) and Claim(HoldKey('VOL', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := TCIDbToVolume(D);
|
||
if CanInvoke then FController.Invoke(SyncSetVolume);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrVolume);
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'MUTE' then
|
||
begin
|
||
if TCITryArgBool(M, 0, B) and Claim(HoldKey('MUTE', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsBool := B;
|
||
if CanInvoke then FController.Invoke(SyncSetMute);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrMute);
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'RX_MUTE' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
if TCITryArgBool(M, 1, B) and Claim(HoldKey('RXMUTE', Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx; FsBool := B;
|
||
if CanInvoke then FController.Invoke(SyncSetRxMute);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))]));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'RX_VOLUME' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not TCITryArgInt(M, 1, Ch) then Ch := 0;
|
||
Ch := EnsureRange(Ch, 0, TCI_CHANNELS - 1);
|
||
if not LiveRx(Rx) then Exit;
|
||
if (M.ArgCount >= 3) and TCITryArgFloat(M, 2, D) and
|
||
Claim(HoldKey('RXVOL', Rx, Ch), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx;
|
||
FsInt2 := TCIDbToVolume(D);
|
||
FsInt3 := Ch;
|
||
if CanInvoke then FController.Invoke(SyncSetRxVolume);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrRxVolume(Rx, Ch));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'RX_BALANCE' then
|
||
begin
|
||
// Баланса каналов у нас нет — эхо, чтобы клиенты не расходились.
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not TCITryArgInt(M, 1, Ch) then Ch := 0;
|
||
Ch := EnsureRange(Ch, 0, TCI_CHANNELS - 1);
|
||
if not LiveRx(Rx) then Exit;
|
||
FEchoLock.Enter;
|
||
try
|
||
if (M.ArgCount >= 3) and TCITryArgInt(M, 2, V) then
|
||
FEcho[Rx].BalanceDb[Ch] := EnsureRange(V, -40, 40);
|
||
V := FEcho[Rx].BalanceDb[Ch];
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
FServer.Broadcast(TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch),
|
||
TCIIntStr(V)]));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'MON_VOLUME' then
|
||
begin
|
||
if TCITryArgFloat(M, 0, D) and Claim(HoldKey('MONVOL', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := TCIDbToVolume(D);
|
||
if CanInvoke then FController.Invoke(SyncSetMonVolume);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, TCIBuild('mon_volume',
|
||
[TCIIntStr(Round(TCIVolumeToDb(FController.FTxMonVolume)))]));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'MON_ENABLE' then
|
||
begin
|
||
if TCITryArgBool(M, 0, B) and Claim(HoldKey('MONEN', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsBool := B;
|
||
if CanInvoke then FController.Invoke(SyncSetMonEnable);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, TCIBuild('mon_enable', [TCIBoolStr(not FController.FRxMuteOnTx)]));
|
||
Exit;
|
||
end;
|
||
|
||
// ── АРУ ──
|
||
if M.Name = 'AGC_MODE' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
if M.ArgCount >= 2 then
|
||
begin
|
||
Name := LowerCase(TCIArg(M, 1));
|
||
if Name = 'off' then V := 4
|
||
else if Name = 'fast' then V := 0
|
||
else if Name = 'normal' then V := 1
|
||
else V := -1;
|
||
if (V >= 0) and Claim(HoldKey('AGC', Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx; FsInt2 := V;
|
||
if CanInvoke then FController.Invoke(SyncSetAGCMode);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
end;
|
||
Reply(Client, StrAGCMode(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'AGC_GAIN' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
// AGC-T (порог АРУ) в ewsdr один на приёмный тракт: у слайса своего нет.
|
||
// Правка от имени доп. приёмника трогала бы главный — не делаем этого,
|
||
// просто отвечаем текущим значением (ограничение, см. doc/TCI.md).
|
||
if (Rx = 0) and TCITryArgInt(M, 1, V) and Claim(HoldKey('AGCT', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := EnsureRange(V, TCI_AGC_MIN_DB, TCI_AGC_MAX_DB);
|
||
if CanInvoke then FController.Invoke(SyncSetAGCTop);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrAGCGain(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Шумоподавление ──
|
||
if (M.Name = 'RX_NR_ENABLE') or (M.Name = 'RX_NB_ENABLE') or
|
||
(M.Name = 'RX_ANF_ENABLE') then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
if TCITryArgBool(M, 1, B) and Claim(HoldKey(M.Name, Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx; FsBool := B;
|
||
if M.Name = 'RX_NR_ENABLE' then if CanInvoke then FController.Invoke(SyncSetNR)
|
||
else if M.Name = 'RX_NB_ENABLE' then if CanInvoke then FController.Invoke(SyncSetNB)
|
||
else if CanInvoke then FController.Invoke(SyncSetANF);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
if M.Name = 'RX_NR_ENABLE' then Reply(Client, StrNR(Rx))
|
||
else if M.Name = 'RX_NB_ENABLE' then Reply(Client, StrNB(Rx))
|
||
else Reply(Client, StrANF(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'RX_NB_PARAM' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
FEchoLock.Enter;
|
||
try
|
||
if M.ArgCount >= 3 then
|
||
begin
|
||
if TCITryArgInt(M, 1, V) then FEcho[Rx].NBThreshold := EnsureRange(V, 1, 100);
|
||
if TCITryArgInt(M, 2, V) then FEcho[Rx].NBDuration := EnsureRange(V, 1, 300);
|
||
end;
|
||
V := FEcho[Rx].NBThreshold;
|
||
Ch := FEcho[Rx].NBDuration;
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
FServer.Broadcast(TCIBuild('rx_nb_param',
|
||
[TCIIntStr(Rx), TCIIntStr(V), TCIIntStr(Ch)]));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Эхо-переключатели обработки (в ewsdr соответствующих трактов нет) ──
|
||
if (M.Name = 'RX_BIN_ENABLE') or (M.Name = 'RX_ANC_ENABLE') or
|
||
(M.Name = 'RX_APF_ENABLE') or (M.Name = 'RX_DSE_ENABLE') or
|
||
(M.Name = 'RX_NF_ENABLE') then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
FEchoLock.Enter;
|
||
try
|
||
if TCITryArgBool(M, 1, B) then
|
||
begin
|
||
if M.Name = 'RX_BIN_ENABLE' then FEcho[Rx].BinOn := B
|
||
else if M.Name = 'RX_ANC_ENABLE' then FEcho[Rx].ANCOn := B
|
||
else if M.Name = 'RX_APF_ENABLE' then FEcho[Rx].APFOn := B
|
||
else if M.Name = 'RX_DSE_ENABLE' then FEcho[Rx].DSEOn := B
|
||
else FEcho[Rx].NFOn := B;
|
||
end;
|
||
if M.Name = 'RX_BIN_ENABLE' then B := FEcho[Rx].BinOn
|
||
else if M.Name = 'RX_ANC_ENABLE' then B := FEcho[Rx].ANCOn
|
||
else if M.Name = 'RX_APF_ENABLE' then B := FEcho[Rx].APFOn
|
||
else if M.Name = 'RX_DSE_ENABLE' then B := FEcho[Rx].DSEOn
|
||
else B := FEcho[Rx].NFOn;
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIBoolStr(B)]));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Блокировка, шумоподавитель ──
|
||
if M.Name = 'LOCK' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
if TCITryArgBool(M, 1, B) and Claim(HoldKey('LOCK', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsBool := B;
|
||
if CanInvoke then FController.Invoke(SyncSetLock);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrLock(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'SQL_ENABLE' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
if TCITryArgBool(M, 1, B) and Claim(HoldKey('SQL', Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx; FsBool := B;
|
||
if CanInvoke then FController.Invoke(SyncSetSql);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrSqlEnable(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'SQL_LEVEL' then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
if TCITryArgFloat(M, 1, D) and Claim(HoldKey('SQLLEV', Rx, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := Rx;
|
||
FsInt2 := TCISqlToLevel(D);
|
||
if CanInvoke then FController.Invoke(SyncSetSqlLevel);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
Reply(Client, StrSqlLevel(Rx));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Расстройка: своего RIT/XIT в ewsdr нет — храним и отражаем ──
|
||
if (M.Name = 'RIT_ENABLE') or (M.Name = 'XIT_ENABLE') then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
FEchoLock.Enter;
|
||
try
|
||
if TCITryArgBool(M, 1, B) then
|
||
begin
|
||
if M.Name = 'RIT_ENABLE' then FEcho[Rx].RitOn := B
|
||
else FEcho[Rx].XitOn := B;
|
||
end;
|
||
if M.Name = 'RIT_ENABLE' then B := FEcho[Rx].RitOn else B := FEcho[Rx].XitOn;
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIBoolStr(B)]));
|
||
Exit;
|
||
end;
|
||
|
||
if (M.Name = 'RIT_OFFSET') or (M.Name = 'XIT_OFFSET') then
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not LiveRx(Rx) then Exit;
|
||
FEchoLock.Enter;
|
||
try
|
||
if TCITryArgInt(M, 1, V) then
|
||
begin
|
||
V := EnsureRange(V, -50000, 50000);
|
||
if M.Name = 'RIT_OFFSET' then FEcho[Rx].RitHz := V
|
||
else FEcho[Rx].XitHz := V;
|
||
end;
|
||
if M.Name = 'RIT_OFFSET' then V := FEcho[Rx].RitHz else V := FEcho[Rx].XitHz;
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIIntStr(V)]));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'RX_CHANNEL_ENABLE' then
|
||
begin
|
||
// Канал B у главного приёмника — это VFO B, он есть всегда; у доп. панов
|
||
// вторым каналом был бы второй слайс (создание слайсов по TCI — этап 2).
|
||
if not TCITryArgInt(M, 0, Rx) then Exit;
|
||
if not TCITryArgInt(M, 1, Ch) then Ch := 1;
|
||
if not LiveRx(Rx) then Exit;
|
||
if TCITryArgBool(M, 2, B) then
|
||
begin
|
||
FEchoLock.Enter;
|
||
try FEcho[Rx].ChannelBOn := B; finally FEchoLock.Leave; end;
|
||
end;
|
||
B := ChanCount(Rx) > 1;
|
||
FServer.Broadcast(TCIBuild('rx_channel_enable',
|
||
[TCIIntStr(Rx), TCIIntStr(Ch), TCIBoolStr(B)]));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Смещения цифровых видов (эхо) ──
|
||
if (M.Name = 'DIGL_OFFSET') or (M.Name = 'DIGU_OFFSET') then
|
||
begin
|
||
FEchoLock.Enter;
|
||
try
|
||
if TCITryArgInt(M, 0, V) then
|
||
begin
|
||
V := EnsureRange(V, 0, 4000);
|
||
if M.Name = 'DIGL_OFFSET' then FDiglOffset := V else FDiguOffset := V;
|
||
end;
|
||
if M.Name = 'DIGL_OFFSET' then V := FDiglOffset else V := FDiguOffset;
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(V)]));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Телеграф ──
|
||
if (M.Name = 'CW_MACROS_SPEED') or (M.Name = 'CW_KEYER_SPEED') then
|
||
begin
|
||
if TCITryArgInt(M, 0, V) and Claim(HoldKey('CWSPEED', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := EnsureRange(V, 5, 60);
|
||
if CanInvoke then FController.Invoke(SyncSetCWSpeed);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
FServer.Broadcast(TCIBuild('cw_macros_speed',
|
||
[TCIIntStr(FController.FCWSettings.Speed)]));
|
||
Exit;
|
||
end;
|
||
|
||
if (M.Name = 'CW_MACROS_SPEED_UP') or (M.Name = 'CW_MACROS_SPEED_DOWN') then
|
||
begin
|
||
if not TCITryArgInt(M, 0, V) then Exit;
|
||
if M.Name = 'CW_MACROS_SPEED_DOWN' then V := -V;
|
||
if Claim(HoldKey('CWSPEED', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := EnsureRange(FController.FCWSettings.Speed + V, 5, 60);
|
||
if CanInvoke then FController.Invoke(SyncSetCWSpeed);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
FServer.Broadcast(TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)]));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'CW_MACROS_DELAY' then
|
||
begin
|
||
if TCITryArgInt(M, 0, V) and Claim(HoldKey('CWDELAY', 0, 0), Client) then
|
||
begin
|
||
FLock.Enter;
|
||
try
|
||
FsInt := EnsureRange(V, 0, 1000);
|
||
if CanInvoke then FController.Invoke(SyncSetCWDelay);
|
||
finally FLock.Leave; end;
|
||
end;
|
||
FServer.Broadcast(TCIBuild('cw_macros_delay',
|
||
[TCIIntStr(FController.FCWSettings.RFDelayMS)]));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'CW_MACROS' then begin CmdCWMacros(M, False); Exit; end;
|
||
if M.Name = 'CW_MSG' then begin CmdCWMacros(M, True); Exit; end;
|
||
if M.Name = 'CW_MACROS_STOP' then
|
||
begin
|
||
FLock.Enter;
|
||
try if CanInvoke then FController.Invoke(SyncCWStop); finally FLock.Leave; end;
|
||
Exit;
|
||
end;
|
||
if M.Name = 'CW_TERMINAL' then
|
||
begin
|
||
FEchoLock.Enter;
|
||
try
|
||
if TCITryArgBool(M, 0, B) then FCwTerminal := B;
|
||
B := FCwTerminal;
|
||
finally
|
||
FEchoLock.Leave;
|
||
end;
|
||
FServer.Broadcast(TCIBuild('cw_terminal', [TCIBoolStr(B)]));
|
||
Exit;
|
||
end;
|
||
|
||
// ── Споты ──
|
||
if M.Name = 'SPOT' then begin CmdSpot(M); Exit; end;
|
||
if M.Name = 'SPOT_DELETE' then
|
||
begin
|
||
if FSpots <> nil then FSpots.RemoveCall(TCIUnescape(TCIArg(M, 0)));
|
||
Exit;
|
||
end;
|
||
if M.Name = 'SPOT_CLEAR' then
|
||
begin
|
||
if FSpots <> nil then FSpots.Clear;
|
||
Exit;
|
||
end;
|
||
|
||
// ── Измерители ──
|
||
// Период ставится ДО включения: иначе тик-поток успел бы отправить первую
|
||
// пачку со старым периодом.
|
||
if M.Name = 'RX_SENSORS_ENABLE' then
|
||
begin
|
||
if not TCITryArgBool(M, 0, B) then Exit;
|
||
if TCITryArgInt(M, 1, V) then
|
||
Client.SetRxSensorsMs(EnsureRange(V, TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS));
|
||
Client.SetRxSensors(B);
|
||
Exit;
|
||
end;
|
||
if M.Name = 'TX_SENSORS_ENABLE' then
|
||
begin
|
||
if not TCITryArgBool(M, 0, B) then Exit;
|
||
if TCITryArgInt(M, 1, V) then
|
||
Client.SetTxSensorsMs(EnsureRange(V, TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS));
|
||
Client.SetTxSensors(B);
|
||
Exit;
|
||
end;
|
||
|
||
// Поднять окно программы (§4.3). Через UI: адаптер до окна не дотягивается.
|
||
if M.Name = 'SET_IN_FOCUS' then
|
||
begin
|
||
FLock.Enter;
|
||
try if CanInvoke then FController.Invoke(SyncFocus); finally FLock.Leave; end;
|
||
Exit;
|
||
end;
|
||
|
||
// ── Параметры потоков ──
|
||
// Это настройки КЛИЕНТА (§4.3), а не устройства: два логгера вправе просить
|
||
// разную частоту дискретизации. Поэтому живут в его объекте, а не в адаптере
|
||
// — иначе один клиент перенастраивал бы будущие потоки всем остальным.
|
||
// Изменение параметра на ходу перезапускает уже идущие потоки этого клиента:
|
||
// блок с новой частотой посреди старого потока клиенты разбирают как мусор.
|
||
if M.Name = 'IQ_SAMPLERATE' then
|
||
begin
|
||
// Набор частот оговорён протоколом; чужое значение отвергаем, а в ответе
|
||
// отдаём действующее — клиент увидит, что его не приняли.
|
||
if TCITryArgInt(M, 0, V) and TCIValidIQRate(V) and (V <> Client.IQRate) then
|
||
begin
|
||
Client.IQRate := V;
|
||
RestartStreams(Client, tstIQ);
|
||
end;
|
||
// ★В ответе — та частота, которую клиент РЕАЛЬНО получит, а не его
|
||
// просьба: на 576 и 960 кГц Pluto просьба «384» невыполнима (не делится
|
||
// нацело), и подтвердить её значило бы соврать. Сама просьба остаётся
|
||
// сохранённой — на другом устройстве она может стать выполнимой.
|
||
Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(EffIQRate(Client))]));
|
||
Exit;
|
||
end;
|
||
if M.Name = 'AUDIO_SAMPLERATE' then
|
||
begin
|
||
if TCITryArgInt(M, 0, V) and TCIValidAudioRate(V) and (V <> Client.AudioRate) then
|
||
begin
|
||
Client.AudioRate := V;
|
||
// Число сэмплов в блоке у ExpertSDR3 своё на каждую частоту (§4.3), и
|
||
// клиент вправе на это рассчитывать, пока не задал своё явно.
|
||
Client.AudioSamples := TCIDefaultAudioSamples(V);
|
||
RestartStreams(Client, tstRXAudio);
|
||
RestartStreams(Client, tstLineOut);
|
||
end;
|
||
Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)]));
|
||
Exit;
|
||
end;
|
||
if M.Name = 'AUDIO_STREAM_SAMPLES' then
|
||
begin
|
||
if TCITryArgInt(M, 0, V) then
|
||
begin
|
||
V := EnsureRange(V, TCI_AUDIO_SAMPLES_MIN, TCI_AUDIO_SAMPLES_MAX);
|
||
if V <> Client.AudioSamples then
|
||
begin
|
||
Client.AudioSamples := V;
|
||
RestartStreams(Client, tstRXAudio);
|
||
RestartStreams(Client, tstLineOut);
|
||
end;
|
||
end;
|
||
Exit;
|
||
end;
|
||
if M.Name = 'AUDIO_STREAM_CHANNELS' then
|
||
begin
|
||
if TCITryArgInt(M, 0, V) then
|
||
begin
|
||
V := EnsureRange(V, 1, 2);
|
||
if V <> Client.AudioChannels then
|
||
begin
|
||
Client.AudioChannels := V;
|
||
RestartStreams(Client, tstRXAudio);
|
||
RestartStreams(Client, tstLineOut);
|
||
end;
|
||
end;
|
||
Exit;
|
||
end;
|
||
if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then
|
||
begin
|
||
Name := LowerCase(Trim(TCIArg(M, 0)));
|
||
if TCIValidSampleType(Name) and (Name <> Client.AudioSampleType) then
|
||
begin
|
||
Client.AudioSampleType := Name;
|
||
RestartStreams(Client, tstRXAudio);
|
||
RestartStreams(Client, tstLineOut);
|
||
end;
|
||
Exit;
|
||
end;
|
||
if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then
|
||
begin
|
||
if TCITryArgInt(M, 0, V) then
|
||
Client.TxBuffering := EnsureRange(V, 50, 500);
|
||
Exit;
|
||
end;
|
||
|
||
// ── Запуск и остановка потоков (§3.4) ──
|
||
if (M.Name = 'IQ_START') or (M.Name = 'IQ_STOP') or
|
||
(M.Name = 'AUDIO_START') or (M.Name = 'AUDIO_STOP') or
|
||
(M.Name = 'LINE_OUT_START') or (M.Name = 'LINE_OUT_STOP') then
|
||
begin
|
||
CmdStream(Client, M);
|
||
Exit;
|
||
end;
|
||
if (M.Name = 'LINE_OUT_RECORDER_START') or
|
||
(M.Name = 'LINE_OUT_RECORDER_SAVE') or
|
||
(M.Name = 'LINE_OUT_RECORDER_BREAK') then
|
||
begin
|
||
CmdRecorder(Client, M);
|
||
Exit;
|
||
end;
|
||
|
||
// Всё прочее незнакомое протокол разрешает игнорировать (§3.1).
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Измерители (тик сервера, 20 мс)
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TTCIAdapter.PushSensors(Client: TTCIClient);
|
||
var
|
||
Now_: QWord;
|
||
Rx, Ch: Integer;
|
||
Snap: TRadioSnapshot;
|
||
begin
|
||
if not Client.Ready then Exit;
|
||
Now_ := GetTickCount64;
|
||
|
||
// Набор {включено, период, время последней отправки} проверяется и обновляется
|
||
// одним шагом под локом клиента: пишет его поток, читает этот.
|
||
if Client.DueRxSensors(Now_) then
|
||
begin
|
||
for Rx := 0 to RxCount - 1 do
|
||
begin
|
||
if not RxActive(Rx) then Continue; // несуществующий пан молчит, а не «-140»
|
||
for Ch := 0 to ChanCount(Rx) - 1 do
|
||
Client.Send(TCIBuild('rx_channel_sensors',
|
||
[TCIIntStr(Rx), TCIIntStr(Ch), TCIFloatStr(RxSMeterDbm(Rx, Ch), 1)]));
|
||
// Устаревшая форма — её ещё ждут старые клиенты.
|
||
Client.Send(TCIBuild('rx_sensors',
|
||
[TCIIntStr(Rx), TCIFloatStr(RxSMeterDbm(Rx, 0), 1)]));
|
||
end;
|
||
end;
|
||
|
||
if Client.DueTxSensors(Now_) then
|
||
begin
|
||
Snap := FController.GetSnapshot;
|
||
// arg2 — уровень микрофона: измерителя микрофона в ewsdr нет, отдаём
|
||
// нижнюю границу шкалы, чтобы клиент не рисовал случайные значения.
|
||
Client.Send(TCIBuild('tx_sensors',
|
||
['0', '-60.0', TCIFloatStr(Snap.FwdW, 1), TCIFloatStr(Snap.FwdW, 1),
|
||
TCIFloatStr(Snap.SWR, 2)]));
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.HandleTick;
|
||
begin
|
||
// Тик крутится в своём потоке сервера: исключение здесь остановило бы
|
||
// измерители у ВСЕХ клиентов до перезапуска сервера.
|
||
try
|
||
FServer.EnumClients(PushSensors);
|
||
PushTxChrono;
|
||
SweepRecorders;
|
||
except
|
||
// молча: следующий тик через 20 мс попробует снова
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Бинарные потоки (§3.4)
|
||
|
||
Кто в каком потоке исполнения:
|
||
• START/STOP и параметры — поток клиента (список правится под FStreamLock);
|
||
• подача данных (OnAudioTap/OnIQTap) — DSP-поток: он же нарезает блоки и
|
||
кладёт их в кольцо клиента, а в сокет пишет поток самого клиента;
|
||
• TX_CHRONO — тик-поток (пейсинг по часам);
|
||
• TX-аудио от клиента — поток этого клиента (HandleBinary).
|
||
Тапы навешиваются на контроллер и движок только из потока контроллера
|
||
(SetTaps зовут ApplySettings и деструктор), потому что снятие тапа обязано
|
||
дождаться выхода DSP-потока из вызова.
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TTCIAdapter.SetTaps(On_: Boolean);
|
||
// Только поток контроллера (ApplySettings, Destroy): снятие тапа обязано
|
||
// дождаться выхода DSP-потока из вызова, а Invoke сюда звать не из чего —
|
||
// мы в нём и находимся.
|
||
begin
|
||
if (FTapsOn = On_) or (FController = nil) then Exit;
|
||
FTapsOn := On_;
|
||
FLock.Enter;
|
||
try
|
||
FsBool := On_;
|
||
SyncTaps;
|
||
finally
|
||
FLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.FindStream(C: TTCIClient; K: TTCIStreamType;
|
||
Rx: Integer): TTCIStreamOut;
|
||
// Только под FStreamLock.
|
||
var i: Integer;
|
||
begin
|
||
Result := nil;
|
||
for i := 0 to High(FStreams) do
|
||
if (FStreams[i] <> nil) and FStreams[i].Matches(C, K, Rx) then
|
||
Exit(FStreams[i]);
|
||
end;
|
||
|
||
procedure TTCIAdapter.StartStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer);
|
||
var
|
||
S: TTCIStreamOut;
|
||
SrcRate, WantRate, Chans, Block: Integer;
|
||
ST: TTCISampleType;
|
||
begin
|
||
if C = nil then Exit;
|
||
|
||
// Параметры снимаем ДО лока: геттеры клиента берут его собственный лок, и
|
||
// держать при этом FStreamLock значило бы связать два лока без нужды.
|
||
if K = tstIQ then
|
||
begin
|
||
// ★Частота IQ — свойство ПАНОРАМЫ, а приёмник теперь слайс: спрашиваем
|
||
// рейт того пана, на котором он стоит.
|
||
SrcRate := FController.IQTapRateHz(RxPanId(Rx));
|
||
WantRate := C.IQRate;
|
||
Chans := 2; // IQ комплексный по определению
|
||
ST := tsyFloat32; // формат IQ в TCI не настраивается
|
||
Block := TCIMaxBlockSamples(ST, Chans);
|
||
end
|
||
else
|
||
begin
|
||
SrcRate := TCI_AUDIO_ENGINE_RATE;
|
||
WantRate := C.AudioRate;
|
||
Chans := EnsureRange(C.AudioChannels, 1, 2);
|
||
if not TCISampleTypeByName(C.AudioSampleType, ST) then ST := tsyFloat32;
|
||
Block := C.AudioSamples;
|
||
end;
|
||
if SrcRate <= 0 then SrcRate := TCI_AUDIO_ENGINE_RATE;
|
||
|
||
FStreamLock.Enter;
|
||
try
|
||
if FindStream(C, K, Rx) <> nil then Exit; // повторный START — не ошибка
|
||
S := TTCIStreamOut.Create(C, K, Rx, SrcRate, WantRate, Chans, ST, Block);
|
||
SetLength(FStreams, Length(FStreams) + 1);
|
||
FStreams[High(FStreams)] := S;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.StopStream(C: TTCIClient; K: TTCIStreamType; Rx: Integer);
|
||
var i, j: Integer;
|
||
begin
|
||
FStreamLock.Enter;
|
||
try
|
||
for i := 0 to High(FStreams) do
|
||
if (FStreams[i] <> nil) and FStreams[i].Matches(C, K, Rx) then
|
||
begin
|
||
FStreams[i].Free;
|
||
for j := i to High(FStreams) - 1 do FStreams[j] := FStreams[j + 1];
|
||
SetLength(FStreams, Length(FStreams) - 1);
|
||
Exit;
|
||
end;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.DropClientStreams(C: TTCIClient);
|
||
var i, j: Integer;
|
||
begin
|
||
FStreamLock.Enter;
|
||
try
|
||
i := 0;
|
||
while i <= High(FStreams) do
|
||
if (FStreams[i] <> nil) and (FStreams[i].Client = C) then
|
||
begin
|
||
FStreams[i].Free;
|
||
for j := i to High(FStreams) - 1 do FStreams[j] := FStreams[j + 1];
|
||
SetLength(FStreams, Length(FStreams) - 1);
|
||
end
|
||
else
|
||
Inc(i);
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.RestartStreams(C: TTCIClient; K: TTCIStreamType);
|
||
// Параметры потока сменились на ходу: пересоздаём то, что уже идёт, с новыми.
|
||
// Пересобрать объект дешевле, чем учить его менять формат на лету, а клиент
|
||
// всё равно обязан читать заголовок каждого блока.
|
||
var
|
||
Rx: Integer;
|
||
Live: array[0..TCI_MAX_RX-1] of Boolean;
|
||
begin
|
||
FStreamLock.Enter;
|
||
try
|
||
for Rx := 0 to TCI_MAX_RX - 1 do Live[Rx] := FindStream(C, K, Rx) <> nil;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
for Rx := 0 to TCI_MAX_RX - 1 do
|
||
if Live[Rx] then
|
||
begin
|
||
StopStream(C, K, Rx);
|
||
StartStream(C, K, Rx);
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.DropDeadRxStreams;
|
||
// Поток контроллера (OnState): живость приёмника спрашиваем ДО лока — внутри
|
||
// него ходит DSP-поток, и лезть оттуда в контроллер незачем.
|
||
var
|
||
Rx, i, j: Integer;
|
||
Alive: array[0..TCI_MAX_RX-1] of Boolean;
|
||
begin
|
||
for Rx := 0 to TCI_MAX_RX - 1 do
|
||
Alive[Rx] := ValidRx(Rx) and RxActive(Rx);
|
||
FStreamLock.Enter;
|
||
try
|
||
i := 0;
|
||
while i <= High(FStreams) do
|
||
if (FStreams[i].Rx >= 0) and (FStreams[i].Rx < TCI_MAX_RX) and
|
||
not Alive[FStreams[i].Rx] then
|
||
begin
|
||
FStreams[i].Free;
|
||
for j := i to High(FStreams) - 1 do FStreams[j] := FStreams[j + 1];
|
||
SetLength(FStreams, Length(FStreams) - 1);
|
||
end
|
||
else
|
||
Inc(i);
|
||
for Rx := 0 to TCI_MAX_RX - 1 do
|
||
if not Alive[Rx] then FreeAndNil(FRec[Rx]);
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.StopAllStreams;
|
||
var i: Integer;
|
||
begin
|
||
FStreamLock.Enter;
|
||
try
|
||
for i := 0 to High(FStreams) do FStreams[i].Free;
|
||
SetLength(FStreams, 0);
|
||
for i := 0 to TCI_MAX_RX - 1 do FreeAndNil(FRec[i]);
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
ClearTxClient(nil);
|
||
// Страховка: клиент мог держать эфир и без своего аудио (TRX без 'tci').
|
||
StopTxOf(nil);
|
||
end;
|
||
|
||
function TTCIAdapter.EffIQRate(C: TTCIClient): Integer;
|
||
// Частота IQ, которую клиент получит на ГЛАВНОМ приёмнике. У доп. панов rate
|
||
// свой, и настоящая частота каждого потока всегда стоит в заголовке блока —
|
||
// но команда IQ_SAMPLERATE в протоколе одна на клиента, поэтому и отвечать на
|
||
// неё можно только про один приёмник. Частоту берём из снимка: зовут отсюда
|
||
// потоки клиентов.
|
||
begin
|
||
Result := TCIPickIQRate(DevSnap.SampleRate, C.IQRate);
|
||
end;
|
||
|
||
procedure TTCIAdapter.PushIQRate(Client: TTCIClient);
|
||
begin
|
||
if Client.Ready then
|
||
Client.Send(TCIBuild('iq_samplerate', [TCIIntStr(EffIQRate(Client))]));
|
||
end;
|
||
|
||
function TTCIAdapter.HasAudioStream(C: TTCIClient): Boolean;
|
||
var Rx: Integer;
|
||
begin
|
||
Result := False;
|
||
FStreamLock.Enter;
|
||
try
|
||
for Rx := 0 to TCI_MAX_RX - 1 do
|
||
if FindStream(C, tstRXAudio, Rx) <> nil then Exit(True);
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function TTCIAdapter.StreamRxOf(PanId, SliceId: Integer): Integer;
|
||
// Какому приёмнику TCI принадлежит это аудио. Главный тракт (SliceId = 0 на
|
||
// пане 0) — приёмник 0, любой слайс — приёмник своего слота, на каком бы пане
|
||
// он ни стоял. Зовётся из DSP-потока и берёт FSliceLock — ДО FStreamLock
|
||
// (порядок!).
|
||
var i: Integer;
|
||
begin
|
||
Result := -1;
|
||
if SliceId <= 0 then
|
||
begin
|
||
if PanId = 0 then Result := 0;
|
||
Exit;
|
||
end;
|
||
FSliceLock.Enter;
|
||
try
|
||
for i := 0 to MAX_SLICES - 1 do
|
||
if FSliceSnap[i].Used and (FSliceSnap[i].V.Id = SliceId) then
|
||
Exit(i + 1);
|
||
finally
|
||
FSliceLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.OnAudioTap(Kind: TRadioAudioKind; PanId, SliceId: Integer;
|
||
const Left, Right: array of Single; Count: Integer);
|
||
// DSP-поток. Всё, что здесь можно, — перемолоть блок и разложить его по
|
||
// кольцам клиентов; ждать нельзя ничего.
|
||
var
|
||
Rx, i: Integer;
|
||
K: TTCIStreamType;
|
||
begin
|
||
if Count <= 0 then Exit;
|
||
Rx := StreamRxOf(PanId, SliceId);
|
||
if Rx < 0 then Exit;
|
||
|
||
if Kind = rakDemod then K := tstRXAudio else K := tstLineOut;
|
||
|
||
FStreamLock.Enter;
|
||
try
|
||
for i := 0 to High(FStreams) do
|
||
if (FStreams[i].Kind = K) and (FStreams[i].Rx = Rx) then
|
||
FStreams[i].FeedAudio(Left, Right, Count);
|
||
// Рекордер пишет ровно линейный выход — тот же источник, что и поток
|
||
// LINEOUT (§4.3: «повторяет обычный аудио поток»).
|
||
if (Kind = rakLineOut) and (Rx < TCI_MAX_RX) and (FRec[Rx] <> nil) then
|
||
FRec[Rx].Feed(Left, Right, Count);
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.OnIQTap(PanId: Integer; PI_, PQ_: PDouble;
|
||
N, RateHz: Integer);
|
||
// DSP-поток, один вызов на накопленный блок. У пана этот вызов идёт под
|
||
// FSliceLock движка, поэтому здесь тем более нельзя ждать.
|
||
//
|
||
// IQ — величина ПАНОРАМЫ, а приёмник теперь слайс: поток получают все
|
||
// приёмники, чьи слайсы стоят на этом пане (и приёмник 0, если пан главный).
|
||
// Карту «приёмник → пан» строим ДО FStreamLock: порядок локов один на весь
|
||
// адаптер — FSliceLock, потом FStreamLock.
|
||
var
|
||
i: Integer;
|
||
Mine: array[0..TCI_MAX_RX-1] of Boolean;
|
||
begin
|
||
if (N <= 0) or (RateHz <= 0) then Exit;
|
||
if (PanId < 0) or (PanId >= MAX_PANS) then Exit;
|
||
for i := 0 to TCI_MAX_RX - 1 do Mine[i] := RxPanId(i) = PanId;
|
||
FStreamLock.Enter;
|
||
try
|
||
for i := 0 to High(FStreams) do
|
||
if (FStreams[i].Kind = tstIQ) and (FStreams[i].Rx >= 0) and
|
||
(FStreams[i].Rx < TCI_MAX_RX) and Mine[FStreams[i].Rx] then
|
||
begin
|
||
// Rate устройства могли сменить уже после START (смена sample rate,
|
||
// другой rate DDC пана): пересчитываем прореживание на месте, иначе
|
||
// клиент получал бы поток с враньём в заголовке.
|
||
if FStreams[i].SrcRate <> RateHz then FStreams[i].SetSourceRate(RateHz);
|
||
FStreams[i].FeedIQ(PI_, PQ_, N);
|
||
end;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.CmdStream(Client: TTCIClient; const M: TTCIMessage);
|
||
var
|
||
Rx: Integer;
|
||
K: TTCIStreamType;
|
||
Start: Boolean;
|
||
begin
|
||
// Номер приёмника обязателен и обязан существовать: молча завести поток
|
||
// несуществующего пана значит навсегда оставить клиента без данных.
|
||
if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[LowerCase(M.Name), 'bad receiver']));
|
||
Exit;
|
||
end;
|
||
|
||
Start := False;
|
||
K := tstRXAudio;
|
||
if M.Name = 'IQ_START' then begin K := tstIQ; Start := True; end
|
||
else if M.Name = 'IQ_STOP' then K := tstIQ
|
||
else if M.Name = 'AUDIO_START' then begin K := tstRXAudio; Start := True; end
|
||
else if M.Name = 'AUDIO_STOP' then K := tstRXAudio
|
||
else if M.Name = 'LINE_OUT_START' then begin K := tstLineOut; Start := True; end
|
||
else if M.Name = 'LINE_OUT_STOP' then K := tstLineOut;
|
||
|
||
if Start then
|
||
begin
|
||
// Пан существует, но не запущен — данных не будет вовсе. Честнее сказать
|
||
// сразу, чем оставить клиента ждать блоков от мёртвого приёмника.
|
||
if not RxActive(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[LowerCase(M.Name), 'receiver is not running']));
|
||
Exit;
|
||
end;
|
||
StartStream(Client, K, Rx);
|
||
end
|
||
else
|
||
begin
|
||
StopStream(Client, K, Rx);
|
||
// Модулировать из потока, которого больше нет, нельзя (§4.2).
|
||
if (K = tstRXAudio) and not HasAudioStream(Client) then ClearTxClient(Client);
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.CmdRecorder(Client: TTCIClient; const M: TTCIMessage);
|
||
var
|
||
Rx, Sec, Rate: Integer;
|
||
Path, Req: string;
|
||
Rec: TTCIRecTake; // куски записи + их место в бюджете
|
||
Old, New_: TTCIRecorder;
|
||
begin
|
||
if not TCITryArgInt(M, 0, Rx) or not ValidRx(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'bad receiver']));
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'LINE_OUT_RECORDER_START' then
|
||
begin
|
||
// ★Только ЖИВОЙ приёмник. Раньше хватало номера в потолке, а у мёртвого
|
||
// приёмника Feed не зовут вовсе — значит и срок записи никто не проверял:
|
||
// рекордер висел до перезапуска сервера. Отвечаем как потокам.
|
||
if not RxActive(Rx) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[LowerCase(M.Name), 'receiver is not running']));
|
||
Exit;
|
||
end;
|
||
if not TCITryArgInt(M, 1, Sec) then Sec := TCI_RECORD_MAX_SEC;
|
||
Sec := EnsureRange(Sec, 1, TCI_RECORD_MAX_SEC);
|
||
// Объект заводим ДО лока — не ради памяти (её он больше не выделяет, см.
|
||
// TTCIRecorder), а чтобы не звать чужой конструктор под локом DSP-потока.
|
||
// Владельца помним: уйдёт клиент — уйдёт и его запись.
|
||
New_ := TTCIRecorder.Create(Rx, TCI_AUDIO_ENGINE_RATE, Sec, Client);
|
||
FStreamLock.Enter;
|
||
try
|
||
// Рекордер один на приёмник, а не на клиента: пишет он то, что слышно
|
||
// в аппарате, и второй такой же был бы просто копией памяти.
|
||
Old := FRec[Rx];
|
||
FRec[Rx] := New_;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
Old.Free; // прежний — уже вне лока
|
||
Exit;
|
||
end;
|
||
|
||
if M.Name = 'LINE_OUT_RECORDER_BREAK' then
|
||
begin
|
||
FStreamLock.Enter;
|
||
try
|
||
Old := FRec[Rx];
|
||
FRec[Rx] := nil;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
Old.Free;
|
||
Exit;
|
||
end;
|
||
|
||
// LINE_OUT_RECORDER_SAVE
|
||
Req := TCIUnescape(TCIArg(M, 1));
|
||
if Req = '' then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'no file name']));
|
||
Exit;
|
||
end;
|
||
// MP3 у нас кодировать нечем — молча подсунуть WAV с расширением .mp3 хуже,
|
||
// чем сказать правду: клиент такой файл всё равно не откроет. Проверяем до
|
||
// TCIRecordPath, чтобы у самой частой причины отказа был свой текст.
|
||
if SameText(ExtractFileExt(Req), '.mp3') then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error',
|
||
[LowerCase(M.Name), 'only wav is supported']));
|
||
Exit;
|
||
end;
|
||
// ★Каталог всегда наш, из просьбы берётся одно имя файла — см. TCIRecordPath.
|
||
Path := TCIRecordPath(RecordDir, Req);
|
||
if Path = '' then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'bad file name']));
|
||
Exit;
|
||
end;
|
||
// Существующий файл не трогаем (окончательно это решит O_EXCL в писателе,
|
||
// здесь — только чтобы клиент услышал причину).
|
||
if FileExists(Path) then
|
||
begin
|
||
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'file exists']));
|
||
Exit;
|
||
end;
|
||
|
||
// Забираем рекордер из таблицы (сохранение завершает запись, §4.3) и только
|
||
// потом снимаем с него данные: копия кольца — это десятки мегабайт, и делать
|
||
// её под локом DSP-потока нельзя.
|
||
Rec.Chunks := nil;
|
||
Rec.Chunk := 0;
|
||
Rec.Count := 0;
|
||
Rec.Reserved := 0;
|
||
Rate := TCI_AUDIO_ENGINE_RATE;
|
||
FStreamLock.Enter;
|
||
try
|
||
Old := FRec[Rx];
|
||
FRec[Rx] := nil;
|
||
finally
|
||
FStreamLock.Leave;
|
||
end;
|
||
if Old <> nil then
|
||
begin
|
||
// ★Куски записи переезжают писателю КАК ЕСТЬ, вместе со своим местом в
|
||
// бюджете: сплошная копия удваивала бы пик, а невыпущенный резерв был бы
|
||
// дырой в потолке.
|
||
Rec := Old.Take;
|
||
Rate := Old.Rate;
|
||
Old.Free;
|
||
end;
|
||
if Rec.Count <= 0 then
|
||
begin
|
||
// Резерва тут быть неоткуда (кусок выделяется только под сэмпл, который
|
||
// тут же и пишется), но возвращаем на всякий случай: единственный путь,
|
||
// на котором запись не доходит до писателя.
|
||
TCIRecBudgetFree(Rec.Reserved);
|
||
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'nothing recorded']));
|
||
Exit;
|
||
end;
|
||
// Пишет отдельный поток: файл может быть в десятки мегабайт, а мы сейчас в
|
||
// потоке клиента, который в это время не читает свой сокет.
|
||
TTCIWavWriter.Create(Path, Rec, Rate);
|
||
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;
|
||
FTxRunning := False;
|
||
Drop := True;
|
||
end;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
if not Drop then Exit;
|
||
// Пишем прямо, без Invoke: это один Boolean, который SetMOX только читает, и
|
||
// зовут нас откуда угодно — в том числе из деструктора адаптера, где ждать
|
||
// поток контроллера уже некому.
|
||
if FController = nil then Exit;
|
||
FController.TCIMicRequested := False;
|
||
// ★А вот саму передачу, если она ИДЁТ ИМЕННО ИЗ ЭТОГО ПОТОКА, оставлять
|
||
// нельзя: источник модуляции только что исчез, и в эфире осталась бы
|
||
// несущая с тишиной (или с последним, что застряло в ринге), которую никто
|
||
// не снимет. Передачу с микрофона оператора это не трогает — там
|
||
// TCIMicActive не поднят.
|
||
if FController.TCIMicActive then StopTxOf(nil);
|
||
end;
|
||
|
||
procedure TTCIAdapter.StopTxOf(C: TTCIClient);
|
||
// ★Безопасность (§4.2). Клиент, поставивший трансивер в эфир, ушёл — MOX
|
||
// обязан упасть. C = nil — снять эфир, кем бы из клиентов он ни был начат
|
||
// (остановка сервера, потеря источника модуляции).
|
||
var Mine: Boolean;
|
||
begin
|
||
Mine := False;
|
||
FTxLock.Enter;
|
||
try
|
||
if (FTrxOwner <> nil) and ((C = nil) or (FTrxOwner = C)) then
|
||
begin
|
||
FTrxOwner := nil;
|
||
Mine := True;
|
||
end;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
if not Mine or (FController = nil) then Exit;
|
||
if CanInvoke then
|
||
FController.Invoke(SyncStopTRX)
|
||
else
|
||
// CanInvoke=False бывает ровно в одном случае — сервер останавливается, а
|
||
// останавливает его поток контроллера: он же сейчас и исполняет нас
|
||
// (TTCIServer.Stop, шаг 5 → Disconnected). Ждать самого себя нельзя, и не
|
||
// нужно — вызов и так на правильном потоке.
|
||
SyncStopTRX;
|
||
end;
|
||
|
||
procedure TTCIAdapter.ForgetTxOwner;
|
||
// Передача кончилась сама (оператор, CAT, PTT, тайм-аут) — забываем, кто её
|
||
// начал. Иначе уход того клиента через час снимал бы уже чужой эфир.
|
||
begin
|
||
FTxLock.Enter;
|
||
try
|
||
FTrxOwner := nil;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.PushTxChrono;
|
||
// Тик-поток. Маркер TX_CHRONO говорит клиенту «пришли столько-то отсчётов»
|
||
// (§3.4). Пейсинг по часам: сколько времени прошло — столько и просим, плюс
|
||
// разовая подушка TX_STREAM_AUDIO_BUFFERING на старте передачи. Ответа не
|
||
// ждём: не успел клиент — в эфир уйдёт тишина, это его забота.
|
||
var
|
||
C: TTCIClient;
|
||
Now_: QWord;
|
||
Rate, Chans, Block: Integer;
|
||
ST: TTCISampleType;
|
||
H: TTCIStreamHeader;
|
||
Active: Boolean;
|
||
begin
|
||
FTxLock.Enter;
|
||
try
|
||
C := FTxClient;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
if C = nil then Exit;
|
||
|
||
Active := FController.TCIMicActive;
|
||
Now_ := GetTickCount64;
|
||
Rate := C.AudioRate;
|
||
Chans := EnsureRange(C.AudioChannels, 1, 2);
|
||
Block := EnsureRange(C.AudioSamples, TCI_AUDIO_SAMPLES_MIN,
|
||
TCI_AUDIO_SAMPLES_MAX);
|
||
if not TCISampleTypeByName(C.AudioSampleType, ST) then ST := tsyFloat32;
|
||
|
||
FTxLock.Enter;
|
||
try
|
||
if not Active then
|
||
begin
|
||
FTxRunning := False;
|
||
Exit;
|
||
end;
|
||
if not FTxRunning then
|
||
begin
|
||
FTxRunning := True;
|
||
FTxLastMs := Now_;
|
||
// Подушка: клиенту нужно время собрать первый блок, а тракт начнёт
|
||
// забирать сэмплы сразу.
|
||
FTxOwed := Rate * (C.TxBuffering / 1000.0);
|
||
end
|
||
else
|
||
begin
|
||
FTxOwed := FTxOwed + Rate * ((Now_ - FTxLastMs) / 1000.0);
|
||
FTxLastMs := Now_;
|
||
// Клиент замолчал, а время идёт — потолок долга держим в один блок,
|
||
// иначе после паузы на него обрушится пачка маркеров.
|
||
if FTxOwed > 4 * Block then FTxOwed := 4 * Block;
|
||
end;
|
||
while FTxOwed >= Block do
|
||
begin
|
||
TCIFillHeader(H, tstTXChrono, 0, Rate, ST, Block, Chans);
|
||
C.SendBin(H, nil, 0);
|
||
FTxOwed := FTxOwed - Block;
|
||
end;
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TTCIAdapter.HandleBinary(Client: TTCIClient; Data: PByte; Len: Integer);
|
||
// Поток клиента. Единственный бинарный кадр, который нам присылают, — блок
|
||
// TX-аудио (§3.4). Всё прочее молча отбрасываем: отвечать ошибкой на каждый
|
||
// чужой блок значит захлебнуться на клиенте, который шлёт их пачками.
|
||
var
|
||
H: TTCIStreamHeader;
|
||
ST: TTCISampleType;
|
||
P: PByte;
|
||
N, i, k, Chans, Rate, Factor, Bytes, Want: Integer;
|
||
Mine: Boolean;
|
||
begin
|
||
if (Data = nil) or (Len <= SizeOf(H)) then Exit;
|
||
Move(Data^, H, SizeOf(H));
|
||
if H.StreamType <> LongWord(Ord(tstTXAudio)) then Exit;
|
||
|
||
FTxLock.Enter;
|
||
try Mine := (FTxClient = Client); finally FTxLock.Leave; end;
|
||
// Аудио от клиента, который не просил TRX:…,tci, — это не наша модуляция.
|
||
// Принять его значит подмешать чужой звук в чужую же передачу.
|
||
if not Mine then Exit;
|
||
if not FController.TCIMicActive then Exit;
|
||
|
||
if H.Format > LongWord(Ord(tsyFloat32)) then Exit;
|
||
ST := TTCISampleType(H.Format);
|
||
|
||
Chans := Integer(H.Channels);
|
||
if Chans < 1 then Chans := 1;
|
||
if Chans > 2 then Exit;
|
||
Rate := Integer(H.SampleRate);
|
||
if not TCIValidAudioRate(Rate) then Exit;
|
||
// Тракт работает на 48 кГц; целое отношение — единственный случай, который
|
||
// разрешает протокол (8/12/24/48), поэтому дробных пересчётов тут нет.
|
||
if TCI_AUDIO_ENGINE_RATE mod Rate <> 0 then Exit;
|
||
Factor := TCI_AUDIO_ENGINE_RATE div Rate;
|
||
|
||
Bytes := Len - SizeOf(H);
|
||
P := Data;
|
||
Inc(P, SizeOf(H));
|
||
|
||
FTxLock.Enter;
|
||
try
|
||
N := TCIUnpackSamples(P, Bytes, ST, FTxRaw);
|
||
if N <= 0 then Exit;
|
||
// length — вещественные отсчёты всего блока (см. TCIFillHeader), то есть
|
||
// ровно то, сколько их и распаковалось. Верим меньшему из двух: клиент
|
||
// вправе прислать короткий хвост, но не длиннее уместившегося. Заведомо
|
||
// чужое число (мусор в заголовке) просто игнорируем — длину нам и так
|
||
// ограничил размер кадра. Так же считает и MSHV, когда сам заполняет
|
||
// заголовок: `t_txStream->length = (cr3/bit_s)`, где cr3 — байты блока.
|
||
if H.DataLength > 0 then
|
||
begin
|
||
Want := Integer(H.DataLength);
|
||
if Want < N then N := Want;
|
||
end;
|
||
|
||
// В тракт идёт моно: TXA у нас один, а стерео от клиента — это его
|
||
// собственный формат вывода, а не два независимых сигнала.
|
||
if Chans = 2 then
|
||
begin
|
||
k := 0;
|
||
i := 0;
|
||
while i + 1 < N do
|
||
begin
|
||
FTxMono[k] := (FTxRaw[i] + FTxRaw[i + 1]) * 0.5;
|
||
Inc(k);
|
||
Inc(i, 2);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
k := N;
|
||
for i := 0 to N - 1 do FTxMono[i] := FTxRaw[i];
|
||
end;
|
||
if k <= 0 then Exit;
|
||
|
||
if (FTxInterp = nil) or (FTxInRate <> Rate) then
|
||
begin
|
||
FreeAndNil(FTxInterp);
|
||
FTxInterp := TTCIInterpolator.Create(Factor);
|
||
FTxInRate := Rate;
|
||
end;
|
||
N := FTxInterp.Process(FTxMono, k, FTxOut);
|
||
finally
|
||
FTxLock.Leave;
|
||
end;
|
||
if N > 0 then FController.PushTCIAudio(FTxOut, N);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Уведомления: изменение состояния контроллера → всем клиентам
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TTCIAdapter.OnState(Sender: TObject; Field: TRadioField);
|
||
var
|
||
Rx, Ch: Integer;
|
||
TxHz: Double;
|
||
MapChanged: Boolean;
|
||
Sig: string;
|
||
begin
|
||
// Снимок слайсов обновляем ДО всего остального и НЕЗАВИСИМО от того, есть ли
|
||
// клиенты: подключившийся читает уже готовый снимок, а не заставляет поток
|
||
// контроллера сниматься по требованию (Invoke из потока клиента ждал бы UI).
|
||
// Все правки слайсов приходят сюда: сеттеры шлют rfSliceFreq/rfSliceState,
|
||
// создание и удаление — rfDevice.
|
||
// Снимок железа — первым: от него зависят и границы частоты, и всё, что
|
||
// сетевые потоки читают о плате.
|
||
if Field in [rfDevice, rfConnected, rfDeviceList, rfXvtr, rfBand, rfSampleRate] then
|
||
RefreshDev;
|
||
// Пан могли убрать и без правки слайсов — тогда сигнатура карты не менялась,
|
||
// а поток остался бы висеть на несуществующем приёмнике.
|
||
if Field in [rfDevice, rfConnected] then DropDeadRxStreams;
|
||
|
||
// Передача кончилась — чья бы она ни была. Забываем хозяина эфира (иначе его
|
||
// уход когда-нибудь потом снял бы уже чужую передачу) и снимаем просьбу
|
||
// «модулируй из потока TCI»: она относилась ровно к той передаче, которую
|
||
// клиент и начал, а следующий PTT оператора обязан идти с его микрофона.
|
||
if (Field = rfTransmitting) and (FController <> nil)
|
||
and not FController.FTransmitting then
|
||
begin
|
||
ForgetTxOwner;
|
||
FController.TCIMicRequested := False;
|
||
end;
|
||
|
||
MapChanged := False;
|
||
if Field in [rfSliceFreq, rfSliceState, rfDevice, rfPanFreq, rfSampleRate,
|
||
rfBand, rfXvtr, rfCenterFreq] then
|
||
begin
|
||
Sig := SliceMapSig;
|
||
RefreshSlices;
|
||
MapChanged := Sig <> SliceMapSig;
|
||
end;
|
||
|
||
// Границы настройки — тоже до гейта по клиентам: их кэш обязан пережить
|
||
// время, когда не подключён никто (см. PushVfoLimits).
|
||
if Field in [rfDevice, rfXvtr, rfBand] then PushVfoLimits;
|
||
|
||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||
|
||
// §3.5: инициатор изменения захватывает параметр на 200 мс. Здесь инициатор —
|
||
// не клиент (оператор, CAT, бэнд-логика), поэтому владелец nil. Если параметр
|
||
// прямо сейчас крутит клиент, Claim его не отберёт — в том числе когда это
|
||
// изменение и есть эхо его собственной команды.
|
||
case Field of
|
||
rfVfoA: Claim(HoldKey('VFO', 0, 0), nil);
|
||
rfVfoB: Claim(HoldKey('VFO', 0, 1), nil);
|
||
rfMode: Claim(HoldKey('MOD', 0, 0), nil);
|
||
rfFilter,
|
||
rfFilterBW: Claim(HoldKey('FILT', 0, 0), nil);
|
||
rfAGCMode: Claim(HoldKey('AGC', 0, 0), nil);
|
||
rfAGCTop: Claim(HoldKey('AGCT', 0, 0), nil);
|
||
rfVolume: Claim(HoldKey('VOL', 0, 0), nil);
|
||
rfMute: Claim(HoldKey('MUTE', 0, 0), nil);
|
||
rfDrive: Claim(HoldKey('DRIVE', 0, 0), nil);
|
||
// Передатчик один — и ключ захвата у него один на всех, кто его дёргает:
|
||
// и TRX, и TUNE, и оператор. Отдельный ключ 'TUNE' делал защиту дырявой —
|
||
// TUN поверх чужого MOX не спорил с ним ни за что.
|
||
rfTransmitting,
|
||
rfTuning: Claim(HoldKey('TRX', 0, 0), nil);
|
||
rfVfoLock: Claim(HoldKey('LOCK', 0, 0), nil);
|
||
rfCenterFreq: Claim(HoldKey('DDS', 0, 0), nil);
|
||
rfSliceFreq:
|
||
if SliceRxCh(FController.FSliceFreqId, Rx, Ch) then
|
||
Claim(HoldKey('VFO', Rx, Ch), nil);
|
||
end;
|
||
|
||
case Field of
|
||
rfVfoA:
|
||
begin
|
||
FServer.Broadcast(StrVfo(0, 0));
|
||
FServer.Broadcast(StrIf(0, 0));
|
||
end;
|
||
rfVfoB:
|
||
begin
|
||
FServer.Broadcast(StrVfo(0, 1));
|
||
FServer.Broadcast(StrIf(0, 1));
|
||
end;
|
||
rfMode:
|
||
begin
|
||
FServer.Broadcast(StrModulation(0));
|
||
FServer.Broadcast(StrFilterBand(0));
|
||
end;
|
||
rfFilter, rfFilterBW: FServer.Broadcast(StrFilterBand(0));
|
||
rfAGCMode: FServer.Broadcast(StrAGCMode(0));
|
||
rfAGCTop: FServer.Broadcast(StrAGCGain(0));
|
||
rfVolume: FServer.Broadcast(StrVolume);
|
||
rfMute: FServer.Broadcast(StrMute);
|
||
rfDrive: FServer.Broadcast(StrDrive);
|
||
rfTransmitting: FServer.Broadcast(StrTrx(TxRx));
|
||
rfTuning: FServer.Broadcast(StrTune(TxRx));
|
||
rfVfoLock:
|
||
begin
|
||
FServer.Broadcast(StrLock(0));
|
||
for Ch := 0 to TCI_CHANNELS - 1 do
|
||
FServer.Broadcast(TCIBuild('vfo_lock',
|
||
['0', TCIIntStr(Ch), TCIBoolStr(FController.FVfoLock)]));
|
||
end;
|
||
rfNR: FServer.Broadcast(TCIBuild('rx_nr_enable', ['0', TCIBoolStr(FController.FNRMode > 0)]));
|
||
rfNB: FServer.Broadcast(TCIBuild('rx_nb_enable', ['0', TCIBoolStr(FController.FNBMode > 0)]));
|
||
rfANF: FServer.Broadcast(TCIBuild('rx_anf_enable', ['0', TCIBoolStr(FController.FANF)]));
|
||
rfFMSQ: FServer.Broadcast(StrSqlEnable(0));
|
||
rfFMSQLevel: FServer.Broadcast(StrSqlLevel(0));
|
||
rfRxMuteOnTx: FServer.Broadcast(TCIBuild('mon_enable',
|
||
[TCIBoolStr(not FController.FRxMuteOnTx)]));
|
||
rfCenterFreq:
|
||
begin
|
||
FServer.Broadcast(StrDds(0));
|
||
FServer.Broadcast(StrIf(0, 0));
|
||
FServer.Broadcast(StrIf(0, 1));
|
||
end;
|
||
rfSampleRate:
|
||
begin
|
||
FServer.Broadcast(TCIBuild('if_limits',
|
||
[TCIIntStr(-(FController.FSampleRate div 2)),
|
||
TCIIntStr(FController.FSampleRate div 2)]));
|
||
// Сменился rate устройства — сменилось и то, что мы можем отдать в
|
||
// потоке IQ (у каждого клиента своё: просьбы разные). Молчать нельзя:
|
||
// клиент, попросивший 384 кГц на HPSDR, после перехода на Pluto 576
|
||
// получит 192 и должен об этом узнать, а не гадать по заголовкам.
|
||
FServer.EnumClients(PushIQRate);
|
||
end;
|
||
rfDevice, rfConnected:
|
||
// Смена устройства может утянуть за собой и rate (Pluto клампит чужой
|
||
// rate к своему минимуму молча), поэтому переобъявляем и тут.
|
||
FServer.EnumClients(PushIQRate);
|
||
rfRunning:
|
||
if FController.FRunning then FServer.Broadcast(TCIBuild('start'))
|
||
else FServer.Broadcast(TCIBuild('stop'));
|
||
rfPanFreq:
|
||
// Центр пана уехал: у приёмников, которые на нём стоят, изменилась IF
|
||
// (она отсчитывается от центра), хотя абсолютная частота могла остаться
|
||
// прежней. Какие это приёмники — знает RxPanId: слайсы одного пана
|
||
// раскиданы по слотам, подряд они не лежат.
|
||
for Rx := 1 to RxCount - 1 do
|
||
if RxPanId(Rx) > 0 then
|
||
begin
|
||
FServer.Broadcast(StrDds(Rx));
|
||
for Ch := 0 to ChanCount(Rx) - 1 do FServer.Broadcast(StrIf(Rx, Ch));
|
||
end;
|
||
rfSliceFreq, rfSliceState:
|
||
// Кто именно изменился — в FSliceFreqId: рассылать состояние канала 0
|
||
// всех панов (как было) значило бы врать про второй слайс.
|
||
if SliceRxCh(FController.FSliceFreqId, Rx, Ch) then
|
||
BroadcastRxState(Rx, Ch);
|
||
rfBand, rfXvtr:
|
||
begin
|
||
BroadcastTxEnable;
|
||
FServer.Broadcast(StrVfo(0, 0));
|
||
end;
|
||
rfActiveVfo:
|
||
// Сюда же приходит смена split (SetSplit шлёт rfActiveVfo): без этого
|
||
// переключение TX-VFO из окна программы мимо клиентов проходило молча.
|
||
FServer.Broadcast(TCIBuild('split_enable',
|
||
['0', TCIBoolStr(FController.FSplitTxB)]));
|
||
rfMonVolume:
|
||
// Громкость самоконтроля — отдельная величина: раньше её правка уезжала
|
||
// клиентам как обычный volume, то есть враньём.
|
||
FServer.Broadcast(TCIBuild('mon_volume',
|
||
[TCIIntStr(Round(TCIVolumeToDb(FController.FTxMonVolume)))]));
|
||
rfTXProfile:
|
||
// Уровень TUN живёт в TX-настройках: сменил его оператор или профиль —
|
||
// клиентам об этом больше узнать неоткуда.
|
||
FServer.Broadcast(TCIBuild('tune_drive', ['0',
|
||
TCIIntStr(FController.FTXSettings.TUNLevel)]));
|
||
rfCWSettings:
|
||
begin
|
||
FServer.Broadcast(TCIBuild('cw_macros_speed',
|
||
[TCIIntStr(FController.FCWSettings.Speed)]));
|
||
FServer.Broadcast(TCIBuild('cw_macros_delay',
|
||
[TCIIntStr(FController.FCWSettings.RFDelayMS)]));
|
||
end;
|
||
end;
|
||
|
||
// Слайс создали или удалили (rfDevice) — у приёмника изменился набор каналов,
|
||
// и клиент, подключённый до этого, о новом канале не узнает никак.
|
||
if MapChanged then PushChannelMap;
|
||
|
||
// Частота передачи — отдельным уведомлением, но только когда она реально
|
||
// изменилась: поле дёргается на каждый шаг ручки.
|
||
if Field in [rfVfoA, rfVfoB, rfActiveVfo, rfBand, rfXvtr, rfTransmitting] then
|
||
begin
|
||
TxHz := FController.ActiveTXFreqHz;
|
||
if Abs(TxHz - FLastTxFreq) >= 1 then
|
||
begin
|
||
FLastTxFreq := TxHz;
|
||
FServer.Broadcast(TCIBuild('tx_frequency', [TCIIntStr(Round(TxHz))]));
|
||
end;
|
||
if TxEnabled <> FLastTxEnable then
|
||
begin
|
||
FLastTxEnable := TxEnabled;
|
||
BroadcastTxEnable;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Уведомления, которые инициирует UI
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TTCIAdapter.NotifySpotClicked(const Call: string; FreqHz: Double;
|
||
Rx, Ch: Integer);
|
||
begin
|
||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||
FServer.Broadcast(TCIBuild('rx_clicked_on_spot',
|
||
[TCIIntStr(Rx), TCIIntStr(Ch), TCIEscape(Call), TCIIntStr(Round(FreqHz))]));
|
||
// Устаревшая форма — её ещё слушают старые клиенты.
|
||
FServer.Broadcast(TCIBuild('clicked_on_spot',
|
||
[TCIEscape(Call), TCIIntStr(Round(FreqHz))]));
|
||
end;
|
||
|
||
procedure TTCIAdapter.NotifyAppFocus(InFocus: Boolean);
|
||
begin
|
||
// Значение помним всегда: подключившемуся клиенту фокус уходит в пачке
|
||
// состояния, а не только по следующей активации окна.
|
||
FAppFocus := InFocus;
|
||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||
FServer.Broadcast(TCIBuild('app_focus', [TCIBoolStr(InFocus)]));
|
||
end;
|
||
|
||
end.
|