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