ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-26 18:57:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

feat(tci): этап 2 — бинарные потоки IQ/аудио, TX-аудио и запись линейного выхода

Browse Source 
Реализованы все четыре потока §3.4 и рекордер:

  • RX_AUDIO_STREAM — тап ДО громкости и мьюта (OnDemodAudioReady): скиммеру
    и цифре нужен звук приёмника, а не то, что осталось после ручки;
  • LINEOUT_STREAM — тап ПОСЛЕ (OnAudioReady), то есть что слышно;
  • IQ_STREAM — тап сырого IQ в движке, ОДИН вызов на накопленный блок;
  • TX_AUDIO_STREAM + TX_CHRONO — TRX:0,true,tci берёт модуляцию из потока
    клиента (флаг TCIMicRequested впереди web в SetMOX), маркеры времени идут
    из тика по часам, аудио клиента разворачивается в 48 кГц моно в тот же
    ринг, что и web-микрофон;
  • LINE_OUT_RECORDER_* — кольцо int16 на приёмник, WAV пишет отдельный поток.

Тапы аудио в контроллере многоадресные (AddAudioTap): слушают, ничего не
забирая, в отличие от OnAudioConsume, которым владеет web. Блоки нарезает и
раскладывает по кольцам клиентов сам DSP-поток, в сокет пишет поток клиента —
та же дисциплина, что у команд. Порядок локов везде FSliceLock → FStreamLock.
У очереди команд и кольца блоков разная политика переполнения: команду терять
нельзя, блок потока — можно (теряется самый старый).

Пересчёт частоты многоступенчатый (TCIStreams). Одноступенчатый FIR на верхнем
пресете Pluto (5760 кГц, коэффициент 120) упирался в потолок отводов и давал
завал 1.3 дБ в полосе при подавлении зеркала 16 дБ — то есть поток IQ с
мусором. Теперь коэффициент раскладывается на множители, спецификацию фильтра
каждой ступени задаёт ИТОГОВАЯ полоса, а свёртка идёт со сложением
симметричных пар: −83 дБ на любом коэффициенте, ≈10% ядра на 5.76 МГц.

Согласование частот с железом: из пресетов Pluto 576 и 960 кГц на 384 не
делятся, поэтому отдаём наибольшую ЗАКОННУЮ частоту, делящую источник нацело
(576/960 → 192 кГц). Ответ на IQ_SAMPLERATE называет достижимое, а не просьбу
клиента, и переобъявляется без запроса при смене rate и устройства.

Приёмный буфер соединения 4 → 32 КБ: блок TX-аудио это 64 байта заголовка плюс
data[16384], а кадр крупнее буфера не собирается никогда.

Настройки TCI переехали из Advanced на вкладку CAT, справа от TCP CAT Server:
это такой же канал внешнего управления трансивером.

Стенд (scratchpad, tcitest.pas): 112 проверок, все зелёные — включая сквозной
прогон через живой WDSP (синтетический IQ → блоки RX-аудио и IQ у настоящего
WS-клиента, и обратно TX-аудио клиента → блоки TX-IQ).

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
ew8bak
2026-08-18 12:36:50 +03:00
co-authored by Claude Opus 5
parent 4165cbe9a5
commit de0830fd19
10 changed files with 2463 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files
RadioController.pas
+146 -4
View File
@@ -47,7 +47,7 @@ unit RadioController;
interface
uses
Classes, SysUtils, Math,
Classes, SysUtils, Math, SyncObjs,
HPSDRProtocol, HPSDRNetwork, RadioBackend, PlutoBackend, IIOBindings,
WDSPEngine, AudioOutput, AudioInput, BeaconDecoder, BeaconFEC, DMRDecoder,
Settings, ChannelStore, FMRepeater, BoardUtils, DeviceStore, CWMorse, CWKeyer,
@@ -105,6 +105,19 @@ type
TAudioConsumeEvent = function(const Left, Right: array of Single;
Count: Integer): Boolean of object;
// Тап RX-аудио: «послушать, не забирая», в отличие от OnAudioConsume. Нужен
// потокам TCI (§3.4): их может быть несколько, и ни один не имеет права
// отбирать звук у локальной звуковухи или у web-клиента.
// rakDemod — ДО громкости и мьюта, без сайдтона (аудиопоток приёмника);
// rakLineOut — то, что реально уходит на выход (поток линейного выхода).
// PanId: 0 = главный тракт, 1.. = доп. пан. SliceId — слайс-источник
// (0 у главного тракта): по нему потребитель отличает канал A от канала B.
// Вызывается из DSP-потока: обработчик обязан быть быстрым и не ждать.
TRadioAudioKind = (rakDemod, rakLineOut);
TRadioAudioTapEvent = procedure(Kind: TRadioAudioKind; PanId, SliceId: Integer;
const Left, Right: array of Single;
Count: Integer) of object;
// Сырьё спектра/водопада наружу (фронтенды рисуют). Вызывается из DSP-потока.
TPixelDataEvent = procedure(const Pixels: array of Single; Count: Integer) of object;
@@ -230,7 +243,15 @@ type
FLocalAudio: Boolean; // локальный звук (динамик/мик ПК): GUI=True, демон=False
FOnSpectrumData: TPixelDataEvent; // сырьё спектра наружу (UI рисует FSpecView)
FOnWaterfallData: TPixelDataEvent; // сырьё водопада наружу (UI: децимация+рендер)
// Тапы RX-аудио (TCI-потоки). Список короткий и меняется редко, но пишет
// его поток контроллера, а читает DSP — отсюда лок: снять тап на лету
// (клиент ушёл) иначе означало бы вызов метода освобождённого объекта.
FAudioTaps: array of TRadioAudioTapEvent;
FAudioTapLock: TCriticalSection;
FAudioTapCount: LongInt; // быстрый гейт: без тапов не берём и лок
procedure Changed(Field: TRadioField);
procedure FireAudioTap(Kind: TRadioAudioKind; PanId, SliceId: Integer;
const Left, Right: array of Single; Count: Integer);
// --- Мультислайсы ---
function FindSliceIndex(Id: Integer): Integer; // -1 если нет
procedure OnSliceAudioReady(SliceId: Integer;
@@ -422,6 +443,8 @@ type
FHWPTTStartedTX: Boolean;
FWebClientActive: Boolean; // выставляет web-слой (connect/disconnect клиента)
FWebMicActive: Boolean; // True если текущий TX идёт через txmsWeb
FTCIMicRequested: Boolean; // TCI-клиент попросил TRX:…,tci
FTCIMicActive: Boolean; // True если текущий TX модулируется из TCI
FSendAudioToRadio: Boolean;
FAudioOutDevName: string;
FAudioInDevName: string;
@@ -1233,9 +1256,27 @@ type
property OnAfterTune: TThreadMethod read FOnAfterTune write FOnAfterTune;
property OnBeforeStop: TThreadMethod read FOnBeforeStop write FOnBeforeStop;
property OnAudioConsume: TAudioConsumeEvent read FOnAudioConsume write FOnAudioConsume;
// Тапы RX-аудио: слушают, ничего не забирая (см. TRadioAudioTapEvent).
// Снимать обязан тот, кто умирает раньше контроллера.
procedure AddAudioTap(T: TRadioAudioTapEvent);
procedure RemoveAudioTap(T: TRadioAudioTapEvent);
// Тап сырого RX-IQ (потоки IQ по TCI). Пас в движок: он же и владелец
// потока, из которого тап зовётся. nil — снять.
procedure SetIQTap(T: TIQTapEvent);
// Частота дискретизации источника IQ для приёмника: главный тракт — rate
// устройства, доп. пан — rate его DDC.
function IQTapRateHz(PanId: Integer): Integer;
// TX-аудио от TCI-клиента: 48 кГц моно в тот же ринг, что и web-микрофон.
procedure PushTCIAudio(const Samples: array of Double; N: Integer);
// Локальный звук ПК (динамик RX / микрофон TX). Демон ставит False: аудио
// только через web (OnAudioConsume), локальная звуковая карта не трогается.
property LocalAudioEnabled: Boolean read FLocalAudio write FLocalAudio;
// Клиент TCI просит брать модуляцию из своего аудиопотока (TRX:0,true,tci,
// §4.2). Ставит адаптер, читает SetMOX при выборе источника.
property TCIMicRequested: Boolean read FTCIMicRequested write FTCIMicRequested;
// Идёт ли текущая передача с модуляцией из TCI (адаптеру — гнать ли
// маркеры TX_CHRONO).
property TCIMicActive: Boolean read FTCIMicActive;
property OnSpectrumData: TPixelDataEvent read FOnSpectrumData write FOnSpectrumData;
property OnWaterfallData: TPixelDataEvent read FOnWaterfallData write FOnWaterfallData;
end;
@@ -1307,6 +1348,8 @@ begin
inherited Create;
FSettings := TSettingsManager.Create; // владелец настроек (GUI и демон)
FDeviceStore := TDeviceStore.Create; // общий список устройств (desktop+web)
FAudioTapLock := TCriticalSection.Create;
FAudioTapCount := 0;
// Дефолты (дублируют TMainForm.FormCreate; в GUI перезапишутся, в демоне нужны).
FVfoA := 14200000; FVfoB := 7100000; FActiveVfo := 0;
FMode := MODE_USB; FFilter := 5;
@@ -1471,6 +1514,8 @@ begin
if Assigned(FCWDec) then FreeAndNil(FCWDec);
FreeAndNil(FDeviceStore);
FreeAndNil(FSettings);
// Лок тапов — последним: до FreeEngines по нему ходит DSP-поток.
FreeAndNil(FAudioTapLock);
inherited Destroy;
end;
@@ -1489,6 +1534,75 @@ begin
FStateListeners[High(FStateListeners)] := L;
end;
procedure TRadioController.AddAudioTap(T: TRadioAudioTapEvent);
begin
if not Assigned(T) then Exit;
FAudioTapLock.Enter;
try
SetLength(FAudioTaps, Length(FAudioTaps) + 1);
FAudioTaps[High(FAudioTaps)] := T;
FAudioTapCount := Length(FAudioTaps);
finally
FAudioTapLock.Leave;
end;
end;
procedure TRadioController.RemoveAudioTap(T: TRadioAudioTapEvent);
var i, j: Integer;
begin
if not Assigned(T) then Exit;
FAudioTapLock.Enter;
try
for i := 0 to High(FAudioTaps) do
if (TMethod(FAudioTaps[i]).Code = TMethod(T).Code) and
(TMethod(FAudioTaps[i]).Data = TMethod(T).Data) then
begin
for j := i to High(FAudioTaps) - 1 do FAudioTaps[j] := FAudioTaps[j + 1];
SetLength(FAudioTaps, Length(FAudioTaps) - 1);
FAudioTapCount := Length(FAudioTaps);
Exit;
end;
finally
FAudioTapLock.Leave;
end;
end;
procedure TRadioController.FireAudioTap(Kind: TRadioAudioKind;
PanId, SliceId: Integer; const Left, Right: array of Single; Count: Integer);
// DSP-поток. Без единого тапа (обычный случай) — одна проверка целого и выход:
// лок в звуковом маршруте на каждый блок иначе стоил бы дороже самой работы.
var i: Integer;
begin
if FAudioTapCount = 0 then Exit;
FAudioTapLock.Enter;
try
for i := 0 to High(FAudioTaps) do
if Assigned(FAudioTaps[i]) then
FAudioTaps[i](Kind, PanId, SliceId, Left, Right, Count);
finally
FAudioTapLock.Leave;
end;
end;
procedure TRadioController.SetIQTap(T: TIQTapEvent);
begin
if Assigned(FDSPEngine) then FDSPEngine.SetIQTap(T);
end;
function TRadioController.IQTapRateHz(PanId: Integer): Integer;
begin
if PanId <= 0 then Result := FSampleRate
else Result := PanDDCRateKHz(PanId) * 1000;
end;
procedure TRadioController.PushTCIAudio(const Samples: array of Double; N: Integer);
// Поток клиента TCI. Ринг микрофона в движке лок-фри и рассчитан ровно на это
// (тем же путём ходит web-микрофон); переполнение — дроп, как у железа.
begin
if FWDSPReady and Assigned(FDSPEngine) then
FDSPEngine.PushTXMicSamplesD(Samples, N);
end;
procedure TRadioController.RemoveStateListener(L: TRadioStateEvent);
var i, j: Integer;
begin
@@ -1831,6 +1945,10 @@ begin
begin
if FSendAudioToRadio then
FNetwork.SendSpeakerAudio(FCWSTBufL, FCWSTBufR, Count);
// Линейный выход (TCI LINEOUT_STREAM) — здесь: это ровно то, что слышно,
// вместе с сайдтоном и после громкости. Тап слушает, ничего не забирая,
// поэтому стоит ДО перехвата web-клиентом.
FireAudioTap(rakLineOut, 0, 0, FCWSTBufL, FCWSTBufR, Count);
if Assigned(FOnAudioConsume) and FOnAudioConsume(FCWSTBufL, FCWSTBufR, Count) then
Exit;
if FLocalAudio then
@@ -1840,6 +1958,7 @@ begin
if FSendAudioToRadio then
FNetwork.SendSpeakerAudio(Left, Right, Count);
FireAudioTap(rakLineOut, 0, 0, Left, Right, Count);
if Assigned(FOnAudioConsume) and FOnAudioConsume(Left, Right, Count) then
Exit;
// Без локального звука (демон) на этом маршрут заканчивается: если web-клиент
@@ -1852,6 +1971,10 @@ procedure TRadioController.OnDemodAudioReady(const Left, Right: array of Single;
Count: Integer);
// DSP thread, pre-volume/pre-mute. FeedAudio only copies into a bounded ring.
begin
// Аудиопоток приёмника для TCI (§3.4) — именно отсюда: скиммеру и цифре
// нужен звук приёмника, а не то, что осталось после ручки громкости и
// мьюта. Линейный выход у TCI отдельным потоком (см. OnAudioReady).
FireAudioTap(rakDemod, 0, 0, Left, Right, Count);
if FMode = MODE_DMR then
begin
if not Assigned(FDMRDec) then Exit;
@@ -1905,6 +2028,7 @@ begin
end;
if FSendAudioToRadio and Assigned(FNetwork) then
FNetwork.SendSpeakerAudio(Left, Right, OutPos);
FireAudioTap(rakLineOut, 0, 0, Left, Right, OutPos);
if Assigned(FOnAudioConsume) and FOnAudioConsume(Left, Right, OutPos) then Exit;
if FLocalAudio and Assigned(FAudioOut) then FAudioOut.Write(Left, Right, OutPos);
end;
@@ -1927,9 +2051,12 @@ procedure TRadioController.OnSliceAudioReady(SliceId: Integer;
const Left, Right: array of Single; Count: Integer);
var idx: Integer;
begin
if not FLocalAudio then Exit;
idx := FindSliceIndex(SliceId);
if idx < 0 then Exit;
// Линейный выход слайса для TCI — до гейта локального звука: в демоне
// звуковухи нет вовсе, а поток клиенту идти обязан.
FireAudioTap(rakLineOut, FSlices[idx].PanId, SliceId, Left, Right, Count);
if not FLocalAudio then Exit;
if FSlices[idx].Mode in [MODE_DMR, MODE_FMRAW] then Exit;
if SliceMutedByTx(idx) then Exit;
if FSlices[idx].Audio <> nil then
@@ -1952,6 +2079,7 @@ var idx: Integer;
begin
idx := FindSliceIndex(SliceId);
if idx < 0 then Exit;
FireAudioTap(rakDemod, FSlices[idx].PanId, SliceId, Left, Right, Count);
if (FSlices[idx].Mode = MODE_DMR) and Assigned(FSlices[idx].DMR) then
FSlices[idx].DMR.FeedAudio(Left, Right, Count);
if (FSlices[idx].Mode = MODE_FMRAW) and FLocalAudio and
@@ -2594,7 +2722,11 @@ begin
FDSPEngine.SetTXMode(ActiveTXMode);
if (Mode = MODE_FMRAW) or (OldMode = MODE_FMRAW) then
begin
if Mode = MODE_FMRAW then FWebMicActive := False;
if Mode = MODE_FMRAW then
begin
FWebMicActive := False;
FTCIMicActive := False;
end;
FDSPEngine.SetTXMicSource(DefaultMicSource);
if Assigned(ActiveMicInput) and ActiveMicInput.IsOpen then
ActiveMicInput.Flush;
@@ -4602,6 +4734,7 @@ begin
if FTransmitting and (ActiveTXMode = MODE_FMRAW) then
begin
FWebMicActive := False;
FTCIMicActive := False;
FDSPEngine.SetTXMicSource(DefaultMicSource);
if Assigned(ActiveMicInput) and ActiveMicInput.IsOpen then
ActiveMicInput.Flush;
@@ -6131,6 +6264,14 @@ begin
begin
if ActiveTXMode = MODE_FMRAW then
FDSPEngine.SetTXMicSource(DefaultMicSource)
// TCI впереди web: клиент попросил модуляцию из своего потока ЯВНО
// (TRX:0,true,tci), а web-микрофон включается самим фактом подключения
// браузера. Явная просьба сильнее умолчания.
else if FTCIMicRequested then
begin
FTCIMicActive := True;
FDSPEngine.SetTXMicSource(txmsWeb); // тот же ринг внешней подачи
end
else if FWebClientActive then
begin
FWebMicActive := True;
@@ -6141,9 +6282,10 @@ begin
else
FDSPEngine.SetTXMicSource(DefaultMicSource);
end
else if FWebMicActive then
else if FWebMicActive or FTCIMicActive then
begin
FWebMicActive := False;
FTCIMicActive := False;
FDSPEngine.SetTXMicSource(DefaultMicSource);
end;
// Сброс бэклога sound-card микрофона на RX→TX: пока шёл приём, ринг
SettingsForm.pas
+61 -53
View File
@@ -3457,55 +3457,8 @@ begin
GRP_PAD + LBL_W + 12, Y + ROW_H - 8, 320);
Lbl.Font.Size := 8;
// ── TCI Server ────────────────────────────────────────────────────────────
// Протокол Expert Electronics поверх WebSocket: логгеры, скиммеры, цифра.
Grp := MakeGroupPanel(FPageAdvanced, 'TCI Server', MARGIN, 564, SETTINGS_CARD_W, 190);
Y := R1;
Chk := TFlatCheckBox.Create(Self);
Chk.Parent := Grp;
Chk.Caption := 'Enabled';
Chk.SetBounds(DpiScale(GRP_PAD), DpiScale(Y), DpiScale(260), DpiScale(22));
Chk.Font.Size := 9;
Chk.Font.Color := CLR_TEXT;
Chk.Checked := False;
Chk.OnChange := OnTCIAnyChange;
FChkTCIEnabled := Chk;
Y := Y + ROW_H;
MakeLbl(Grp, 'Port:', GRP_PAD, Y + 4, LBL_W);
Spin := TFlatSpinEdit.Create(Self);
Spin.Parent := Grp;
Spin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(90), DpiScale(BTN_H));
Spin.Color := CLR_INPUT;
Spin.Font.Color := CLR_INPUT_TEXT;
Spin.Font.Size := 9;
Spin.MinValue := 1;
Spin.MaxValue := 65535;
Spin.Value := 40001;
// Применяем по уходу фокуса, а не на каждое нажатие: набирая «40001», через
// OnChange мы бы подряд перезапустили сервер на портах 4, 40, 400, 4000.
Spin.OnExit := OnTCIAnyChange;
FEdTCIPort := Spin;
Y := Y + ROW_H;
MakeLbl(Grp, 'Interface:', GRP_PAD, Y + 4, LBL_W);
Ed := TFlatEdit.Create(Self);
Ed.Parent := Grp;
Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(ED_W), DpiScale(BTN_H));
Ed.Color := CLR_INPUT;
Ed.Font.Color := CLR_INPUT_TEXT;
Ed.Font.Size := 9;
Ed.Text := '127.0.0.1';
// Тем более адрес: промежуточное «127.0.0.» — не адрес, и раньше это молча
// означало «слушать на всех интерфейсах». Применяем по уходу фокуса.
Ed.OnExit := OnTCIAnyChange;
FEdTCIBind := Ed;
// Авторизации в протоколе нет: открытый наружу порт = полный доступ к трансиверу.
Lbl := MakeLbl(Grp, 'No authentication in TCI — keep 127.0.0.1 unless the network is trusted',
GRP_PAD, Y + ROW_H, 460);
Lbl.Font.Size := 8;
// TCI Server живёт на вкладке CAT (см. BuildCATTab): это такой же канал
// внешнего управления трансивером, что и CAT, и оператор ищет его там.
end;
procedure TSettingsForm.BuildDXClusterTab;
@@ -4639,6 +4592,8 @@ const
EDT_W = 160;
R1 = 42;
STEP = 32;
// Высота сетевых карточек (TCP CAT и TCI) — общая: стоят они в одной строке.
NET_GRP_H = 176;
var
i, col, row, gx, gy, j: Integer;
Grp: TPanel;
@@ -4646,9 +4601,10 @@ var
Ed: TFlatEdit;
Cmb: TFlatComboBox;
Spin: TFlatSpinEdit;
Lbl: TLabel;
begin
MakePageHeader(FPageCAT, 'CAT',
'Computer Aided Transceiver — serial port and TCP server settings.');
'External control: serial CAT ports, TCP CAT server and TCI server.');
for i := 0 to 3 do
begin
@@ -4727,10 +4683,12 @@ begin
FCATSerialAndromeda[i] := Chk;
end;
// TCP server group below the two rows of serial port panels
// Два сетевых канала управления — рядом, одной строкой под последовательными
// портами: TCP CAT слева, TCI справа. Высота у обоих одна, иначе нижняя
// кромка страницы получается рваной.
gy := 86 + 2 * (GRP_H + GRP_GAP);
Grp := MakeGroupPanel(FPageCAT, 'TCP CAT Server', MARGIN, gy, GRP_W * 2 + GRP_GAP, 116);
Grp.Tag := TAG_RESPONSIVE_CARD;
Grp := MakeGroupPanel(FPageCAT, 'TCP CAT Server', MARGIN, gy, GRP_W, NET_GRP_H);
Grp.Tag := TAG_RESPONSIVE_HALF_LEFT;
FCATTcpEn := TFlatCheckBox.Create(Self);
FCATTcpEn.Parent := Grp;
@@ -4750,6 +4708,56 @@ begin
Spin.Value := 19090;
Spin.OnChange := OnCATTcpChange;
FCATTcpPort := Spin;
// ── TCI Server ────────────────────────────────────────────────────────────
// Протокол Expert Electronics поверх WebSocket: логгеры, скиммеры, цифра.
Grp := MakeGroupPanel(FPageCAT, 'TCI Server',
MARGIN + GRP_W + GRP_GAP, gy, GRP_W, NET_GRP_H);
Grp.Tag := TAG_RESPONSIVE_HALF_RIGHT;
Chk := TFlatCheckBox.Create(Self);
Chk.Parent := Grp;
Chk.Caption := 'Enable TCI server (default port 40001)';
Chk.SetBounds(DpiScale(PAD), DpiScale(R1), DpiScale(GRP_W - PAD * 2), DpiScale(22));
Chk.Font.Color := CLR_TEXT;
Chk.Font.Size := 9;
Chk.Checked := False;
Chk.OnChange := OnTCIAnyChange;
FChkTCIEnabled := Chk;
MakeLbl(Grp, 'Port:', PAD, R1 + STEP + 6, LW);
Spin := TFlatSpinEdit.Create(Self);
Spin.Parent := Grp;
Spin.SetBounds(DpiScale(CX), DpiScale(R1 + STEP), DpiScale(100), DpiScale(BTN_H + 2));
Spin.Color := CLR_INPUT; Spin.Font.Color := CLR_INPUT_TEXT;
Spin.Font.Size := 9;
Spin.MinValue := 1; Spin.MaxValue := 65535;
Spin.Value := 40001;
// Применяем по уходу фокуса, а не на каждое нажатие: набирая «40001», через
// OnChange мы бы подряд перезапустили сервер на портах 4, 40, 400, 4000.
Spin.OnExit := OnTCIAnyChange;
FEdTCIPort := Spin;
MakeLbl(Grp, 'Interface:', PAD, R1 + 2 * STEP + 6, LW);
Ed := TFlatEdit.Create(Self);
Ed.Parent := Grp;
Ed.SetBounds(DpiScale(CX), DpiScale(R1 + 2 * STEP), DpiScale(EDT_W), DpiScale(BTN_H));
Ed.Color := CLR_INPUT; Ed.Font.Color := CLR_INPUT_TEXT;
Ed.Font.Size := 9;
Ed.Text := '127.0.0.1';
// Тем более адрес: промежуточное «127.0.0.» — не адрес, и раньше это молча
// означало «слушать на всех интерфейсах». Применяем по уходу фокуса.
Ed.OnExit := OnTCIAnyChange;
FEdTCIBind := Ed;
// Авторизации в протоколе нет: открытый наружу порт = полный доступ к
// трансиверу. В половинную карточку строка не влезает — режем на две.
Lbl := MakeLbl(Grp, 'No authentication in TCI: keep 127.0.0.1',
PAD, R1 + 3 * STEP + 2, GRP_W - PAD * 2);
Lbl.Font.Size := 8;
Lbl := MakeLbl(Grp, 'unless the network is trusted.',
PAD, R1 + 3 * STEP + 16, GRP_W - PAD * 2);
Lbl.Font.Size := 8;
end;
// ---------------------------------------------------------------------------
TCIAdapter.pas
+783 -26
View File
@@ -27,8 +27,11 @@ unit TCIAdapter;
так синхронизация между несколькими клиентами остаётся честной, а поведение
радио не выдумывается. Всё такое помечено «эхо» и перечислено в doc/TCI.md.
Потоки IQ/аудио (§3.4) — следующий этап: команды управления потоками
принимаются и подтверждаются, но сами потоки не идут.
Бинарные потоки (§3.4) живут в TCIStreams; здесь — только их подключение к
контроллеру: тап RX-аудио (два вида: до громкости — «аудиопоток приёмника»,
после неё — «линейный выход»), тап сырого IQ в движке, приём TX-аудио от
клиента и маркеры TX_CHRONO. Данные перемалывает DSP-поток, поэтому вся
работа с потоками — под FStreamLock и без единого ожидания.
}
{$IFDEF FPC}
@@ -41,10 +44,16 @@ interface
uses
Classes, SysUtils, DateUtils, Math, SyncObjs,
RadioController, RadioBackend, WDSPEngine, Settings,
DXSpotStore, TCIProtocol, TCIServer;
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): пока владелец его крутит, остальные
// могут только слушать. Без этого два логгера перетягивают частоту друг у
// друга бесконечно.
@@ -120,6 +129,31 @@ type
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 — никто)
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;
@@ -134,6 +168,7 @@ type
FsInt2: Integer;
FsInt3: Integer;
FsBool: Boolean;
FsBool2: Boolean;
FsStr: string;
// ── Sync-методы (поток контроллера) ──
@@ -166,6 +201,30 @@ type
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); // клиент ушёл/перестал модулировать
// ── Помощники модели ──
function CanInvoke: Boolean;
@@ -307,8 +366,16 @@ begin
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;
@@ -326,18 +393,25 @@ 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;
@@ -359,6 +433,10 @@ begin
OldPort := FServer.Port;
FServer.Stop;
// Сервер остановлен — клиентов больше нет, значит и потоки чужие: снимаем
// тапы, иначе DSP-поток продолжал бы носить аудио в никуда.
StopAllStreams;
SetTaps(False);
if not T.Enabled then
begin
FCfg := T;
@@ -369,11 +447,13 @@ begin
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) then FServer.Start;
if FServer.Configure(OldPort, FCfg.BindAddr) and FServer.Start then
SetTaps(True);
end;
function TTCIAdapter.CanInvoke: Boolean;
@@ -577,6 +657,10 @@ procedure TTCIAdapter.PushChannelMap;
// полную картину каждого живого приёмника — клиент перезаливает её целиком.
var Rx, Ch, N: Integer;
begin
// Потоки пропавших приёмников гасим ВСЕГДА, даже если рассылать некому:
// объект потока пережил бы свой пан и молча копил тишину, а клиент ждал бы
// блоков, которых больше не будет.
DropDeadRxStreams;
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
for Rx := 1 to RxCount - 1 do
begin
@@ -1168,9 +1252,13 @@ end;
procedure TTCIAdapter.HandleDisconnect(Client: TTCIClient);
// Клиент ушёл — снимаем его захваты параметров, иначе следующий, кому достанется
// тот же адрес объекта, унаследовал бы чужие права (§3.5).
// тот же адрес объекта, унаследовал бы чужие права (§3.5). По той же причине
// гасим его потоки: объект клиента вот-вот освободят, а на него смотрит
// DSP-поток. Порядок обязателен — сначала потоки, потом возврат в сервер.
begin
DropHolds(Client);
DropClientStreams(Client);
ClearTxClient(Client);
end;
{ ═══════════════════════════════════════════════════════════════════════════
@@ -1224,9 +1312,28 @@ end;
procedure TTCIAdapter.SyncSetTRX;
begin
// Источник модуляции ставим ДО SetMOX — именно он его и читает при выборе
// микрофона. Выключение передачи флаг снимает всегда: следующий раз оператор
// может нажать PTT сам, и тогда в эфир должен идти его микрофон.
FController.TCIMicRequested := FsBool and FsBool2;
FController.SetMOX(FsBool);
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);
@@ -1557,7 +1664,7 @@ procedure TTCIAdapter.DispatchCommand(Client: TTCIClient; const M: TTCIMessage);
var
Rx, Ch, V: Integer;
Lo, Hi: Integer;
B: Boolean;
B, FromTCI: Boolean;
D: Double;
Name: string;
begin
@@ -1642,13 +1749,26 @@ begin
// ── Передача ──
if M.Name = 'TRX' then
begin
// arg3 (источник сигнала: tci/mic1/…) игнорируем: аудио по TCI ещё нет,
// модуляция берётся из выбранного в программе входа.
// 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;
finally FTxLock.Leave; end;
FLock.Enter;
try
FsBool := B;
FsBool := B;
FsBool2 := FromTCI;
if CanInvoke then FController.Invoke(SyncSetTRX);
finally FLock.Leave; end;
end;
@@ -2188,37 +2308,75 @@ begin
// Это настройки КЛИЕНТА (§4.3), а не устройства: два логгера вправе просить
// разную частоту дискретизации. Поэтому живут в его объекте, а не в адаптере
// — иначе один клиент перенастраивал бы будущие потоки всем остальным.
// Сами потоки — этап 2, значения только принимаются и подтверждаются.
// Изменение параметра на ходу перезапускает уже идущие потоки этого клиента:
// блок с новой частотой посреди старого потока клиенты разбирают как мусор.
if M.Name = 'IQ_SAMPLERATE' then
begin
// Набор частот оговорён протоколом; чужое значение отвергаем, а в ответе
// отдаём действующее — клиент увидит, что его не приняли.
if TCITryArgInt(M, 0, V) and TCIValidIQRate(V) then Client.IQRate := V;
Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)]));
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) then Client.AudioRate := V;
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
Client.AudioSamples := EnsureRange(V, 100, 2048);
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
Client.AudioChannels := EnsureRange(V, 1, 2);
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) then Client.AudioSampleType := Name;
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
@@ -2228,17 +2386,19 @@ begin
Exit;
end;
// Запуск потоков (§3.4) — этап 2. Молчать нельзя: клиент решил бы, что поток
// пошёл, и ждал бы данных бесконечно. Отвечаем ошибкой на конкретную команду.
// ── Запуск и остановка потоков (§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') or
(M.Name = 'LINE_OUT_RECORDER_START') 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
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name),
'binary streams are not implemented']));
CmdRecorder(Client, M);
Exit;
end;
@@ -2291,11 +2451,594 @@ 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);
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 только читает, и
// зовут нас откуда угодно — в том числе из деструктора адаптера, где ждать
// поток контроллера уже некому. Передачу при этом НЕ трогаем: оператор мог
// нажать PTT сам, и обрывать его эфир из-за ухода клиента нельзя.
if FController <> nil then FController.TCIMicRequested := False;
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: 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 вещественных отсчётов — верим меньшему из двух:
// клиент вправе прислать короткий хвост, но не длиннее уместившегося.
if (H.DataLength > 0) and (Integer(H.DataLength) < N) then
N := Integer(H.DataLength);
// В тракт идёт моно: 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;
{ ═══════════════════════════════════════════════════════════════════════════
Уведомления: изменение состояния контроллера → всем клиентам
═══════════════════════════════════════════════════════════════════════════ }
@@ -2316,6 +3059,9 @@ begin
// сетевые потоки читают о плате.
if Field in [rfDevice, rfConnected, rfDeviceList, rfXvtr, rfBand, rfSampleRate] then
RefreshDev;
// Пан могли убрать и без правки слайсов — тогда сигнатура карты не менялась,
// а поток остался бы висеть на несуществующем приёмнике.
if Field in [rfDevice, rfConnected] then DropDeadRxStreams;
MapChanged := False;
if Field in [rfSliceFreq, rfSliceState, rfDevice, rfPanFreq, rfSampleRate,
@@ -2401,9 +3147,20 @@ begin
FServer.Broadcast(StrIf(0, 1));
end;
rfSampleRate:
FServer.Broadcast(TCIBuild('if_limits',
[TCIIntStr(-(FController.FSampleRate div 2)),
TCIIntStr(FController.FSampleRate div 2)]));
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'));
TCIProtocol.pas
+205 -5
View File
@@ -42,6 +42,23 @@ const
TCI_MODULATIONS = 'am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw';
// Границы, оговорённые протоколом (клампим сами — клиент шлёт что угодно).
// Бинарные потоки (§3.4). data[16384] в структуре Stream — это ПОТОЛОК блока,
// а не его размер: больше в один блок не кладут ни ExpertSDR3, ни клиенты.
TCI_STREAM_DATA_MAX = 16384; // байт данных в блоке
TCI_STREAM_HDR_SIZE = 64; // 16 × uint32
TCI_STREAM_MAX = TCI_STREAM_HDR_SIZE + TCI_STREAM_DATA_MAX;
// Умолчания параметров потоков (§4.3).
TCI_IQ_RATE_DEF = 48000;
TCI_AUDIO_RATE_DEF = 48000;
TCI_AUDIO_CHAN_DEF = 2;
TCI_TX_BUFFERING_DEF = 50; // мс
TCI_AUDIO_SAMPLES_MIN = 100;
TCI_AUDIO_SAMPLES_MAX = 2048;
TCI_TX_BUFFERING_MIN = 50;
TCI_TX_BUFFERING_MAX = 500;
TCI_RECORD_MAX_SEC = 300; // потолок записи линейного выхода
TCI_VOL_MIN_DB = -60; TCI_VOL_MAX_DB = 0;
TCI_SQL_MIN_DB = -140; TCI_SQL_MAX_DB = 0;
TCI_AGC_MIN_DB = -20; TCI_AGC_MAX_DB = 120;
@@ -59,8 +76,7 @@ type
ArgCount: Integer;
end;
{ Тип бинарного потока (§3.4). Потоки — следующий этап (см. doc/TCI.md),
но формат протокольный, поэтому объявлен здесь, а не в транспорте. }
{ Тип бинарного потока (§3.4). }
TTCIStreamType = (tstIQ, tstRXAudio, tstTXAudio, tstTXChrono, tstLineOut);
TTCISampleType = (tsyInt16, tsyInt24, tsyInt32, tsyFloat32);
@@ -104,6 +120,35 @@ function TCIValidIQRate(V: Integer): Boolean; // 48/96/192/384 кГц
function TCIValidAudioRate(V: Integer): Boolean; // 8/12/24/48 кГц
function TCIValidSampleType(const S: string): Boolean; // int16/int24/int32/float32
{ ── Бинарные потоки (§3.4) ─────────────────────────────────────────────── }
function TCISampleTypeByName(const S: string; out T: TTCISampleType): Boolean;
function TCISampleTypeName(T: TTCISampleType): string;
function TCISampleBytes(T: TTCISampleType): Integer;
{ Сколько сэмплов НА КАНАЛ класть в блок по умолчанию (§4.3): у ExpertSDR3
своё число на каждую частоту дискретизации, и все они дают ~42 мс звучания. }
function TCIDefaultAudioSamples(RateHz: Integer): Integer;
{ Сколько сэмплов на канал влезает в блок с таким форматом и числом каналов. }
function TCIMaxBlockSamples(T: TTCISampleType; Channels: Integer): Integer;
{ Заголовок блока. Count — сэмплов НА КАНАЛ; в DataLength уходит, как велит
протокол, количество ВЕЩЕСТВЕННЫХ отсчётов, то есть Count × Channels. }
procedure TCIFillHeader(out H: TTCIStreamHeader; Kind: TTCIStreamType;
Rx, RateHz: Integer; T: TTCISampleType; Count, Channels: Integer);
{ Упаковка вещественных отсчётов в формат клиента. Возвращает число байт.
Src читается подряд (уже с чередованием каналов), Dest обязан вмещать
N × TCISampleBytes(T) байт. }
function TCIPackSamples(const Src: array of Single; N: Integer;
T: TTCISampleType; Dest: PByte): Integer;
{ Обратная распаковка (TX-аудио от клиента). Возвращает число распакованных
вещественных отсчётов; лишнее сверх Length(Dest) отбрасывается. }
function TCIUnpackSamples(Src: PByte; Bytes: Integer; T: TTCISampleType;
var Dest: array of Single): Integer;
{ ── Сборка ─────────────────────────────────────────────────────────────── }
function TCIBuild(const Name: string): string; overload;
@@ -284,10 +329,165 @@ begin
end;
function TCIValidSampleType(const S: string): Boolean;
var T: string;
var T: TTCISampleType;
begin
T := LowerCase(Trim(S));
Result := (T = 'int16') or (T = 'int24') or (T = 'int32') or (T = 'float32');
Result := TCISampleTypeByName(S, T);
end;
{ ═══════════════════════════════════════════════════════════════════════════
Бинарные потоки (§3.4)
═══════════════════════════════════════════════════════════════════════════ }
function TCISampleTypeByName(const S: string; out T: TTCISampleType): Boolean;
var N: string;
begin
Result := True;
N := LowerCase(Trim(S));
if N = 'int16' then T := tsyInt16
else if N = 'int24' then T := tsyInt24
else if N = 'int32' then T := tsyInt32
else if N = 'float32' then T := tsyFloat32
else begin T := tsyFloat32; Result := False; end;
end;
function TCISampleTypeName(T: TTCISampleType): string;
begin
case T of
tsyInt16: Result := 'int16';
tsyInt24: Result := 'int24';
tsyInt32: Result := 'int32';
else Result := 'float32';
end;
end;
function TCISampleBytes(T: TTCISampleType): Integer;
begin
case T of
tsyInt16: Result := 2;
tsyInt24: Result := 3;
else Result := 4; // int32 и float32
end;
end;
function TCIDefaultAudioSamples(RateHz: Integer): Integer;
begin
case RateHz of
8000: Result := 256;
12000: Result := 512;
24000: Result := 1024;
else Result := 2048; // 48 кГц и всё непонятное
end;
end;
function TCIMaxBlockSamples(T: TTCISampleType; Channels: Integer): Integer;
begin
if Channels < 1 then Channels := 1;
Result := TCI_STREAM_DATA_MAX div (TCISampleBytes(T) * Channels);
end;
procedure TCIFillHeader(out H: TTCIStreamHeader; Kind: TTCIStreamType;
Rx, RateHz: Integer; T: TTCISampleType; Count, Channels: Integer);
begin
FillChar(H, SizeOf(H), 0);
H.Receiver := LongWord(Rx);
H.SampleRate := LongWord(RateHz);
H.Format := LongWord(Ord(T));
H.DataLength := LongWord(Count * Channels);
H.StreamType := LongWord(Ord(Kind));
H.Channels := LongWord(Channels);
end;
function TCIPackSamples(const Src: array of Single; N: Integer;
T: TTCISampleType; Dest: PByte): Integer;
// Клампим на входе: перегруз в целочисленных форматах иначе заворачивается
// через знак и вместо ограничения даёт треск обратной полярности.
var
i, V: Integer;
F: Single;
P: PByte;
begin
if N > Length(Src) then N := Length(Src);
if N < 0 then N := 0;
P := Dest;
for i := 0 to N - 1 do
begin
F := Src[i];
if F > 1.0 then F := 1.0;
if F < -1.0 then F := -1.0;
case T of
tsyInt16:
begin
V := Round(F * 32767);
P[0] := Byte(V); P[1] := Byte(V shr 8);
Inc(P, 2);
end;
tsyInt24:
begin
V := Round(F * 8388607);
P[0] := Byte(V); P[1] := Byte(V shr 8); P[2] := Byte(V shr 16);
Inc(P, 3);
end;
tsyInt32:
begin
// 2^31-1 в Single не представимо точно, поэтому масштаб берём
// на единицу младше — иначе Round на полной шкале переполняется.
V := Round(F * 2147483520.0);
P[0] := Byte(V); P[1] := Byte(V shr 8);
P[2] := Byte(V shr 16); P[3] := Byte(V shr 24);
Inc(P, 4);
end;
else
begin
PSingle(P)^ := F;
Inc(P, 4);
end;
end;
end;
Result := N * TCISampleBytes(T);
end;
function TCIUnpackSamples(Src: PByte; Bytes: Integer; T: TTCISampleType;
var Dest: array of Single): Integer;
var
i, N, W: Integer;
P: PByte;
begin
Result := 0;
if (Src = nil) or (Bytes <= 0) then Exit;
N := Bytes div TCISampleBytes(T);
if N > Length(Dest) then N := Length(Dest);
P := Src;
for i := 0 to N - 1 do
begin
case T of
tsyInt16:
begin
W := SmallInt(Word(P[0]) or (Word(P[1]) shl 8));
Dest[i] := W / 32768.0;
Inc(P, 2);
end;
tsyInt24:
begin
W := LongInt(P[0]) or (LongInt(P[1]) shl 8) or (LongInt(P[2]) shl 16);
if (W and $800000) <> 0 then W := W or LongInt($FF000000);
Dest[i] := W / 8388608.0;
Inc(P, 3);
end;
tsyInt32:
begin
W := LongInt(LongWord(P[0]) or (LongWord(P[1]) shl 8) or
(LongWord(P[2]) shl 16) or (LongWord(P[3]) shl 24));
Dest[i] := W / 2147483648.0;
Inc(P, 4);
end;
else
begin
Dest[i] := PSingle(P)^;
Inc(P, 4);
end;
end;
end;
Result := N;
end;
{ ═══════════════════════════════════════════════════════════════════════════
TCIServer.pas
+145 -15
View File
@@ -33,8 +33,12 @@ unit TCIServer;
(TCI_MAX_SOCKETS) и убивается по таймауту TCI_HANDSHAKE_MS. Иначе восемь
молчащих TCP-соединений навсегда закрывали дверь настоящим клиентам.
Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2,
см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются.
Бинарные фреймы (потоки IQ/аудио, §3.4) ходят в обе стороны: блоки наружу
кладутся в отдельное кольцо клиента (SendBin) и уходят его же потоком вместе
с командами, входящие собираются из фрагментов и отдаются наверх (OnBinary)
— там их разбирает TCIAdapter. У двух очередей разная политика переполнения:
команду терять нельзя (клиент выбрасывается), блок потока — можно и нужно
(теряется самый старый), иначе отставший скиммер рвал бы себе управление.
Сокеты и WS-фреймы переиспользованы из веб-подсистемы (WebUtils/WsClient):
тот же код handshake и та же схема «поток на клиента + accept-поток», что в
@@ -71,6 +75,11 @@ const
TCI_OUT_CHUNK = 3800; // склейка очереди в один фрейм, символов
TCI_MSG_MAX = 65536; // потолок собираемого из фрагментов сообщения
TCI_STOP_KILL_MS = 500; // как часто добиваем клиентов, ожидая их выхода
// Очередь бинарных блоков (§3.4) на клиента. Переполнение здесь НЕ повод
// рвать соединение, в отличие от очереди команд: поток — это данные
// реального времени, и клиент, не успевший забрать блок, должен потерять
// именно блок. Выбрасываем самый старый: свежий звук полезнее протухшего.
TCI_BIN_QUEUE = 48;
type
TTCIServer = class;
@@ -107,6 +116,13 @@ type
FOutLock: TCriticalSection;
FOut: array of string;
FOutCount: Integer;
// Очередь бинарных блоков потоков. Отдельная от командной: у них разная
// политика переполнения (команду терять нельзя, блок потока — можно) и
// разные производители (блоки кладёт DSP-поток).
FBinOut: array[0..TCI_BIN_QUEUE-1] of TBytes;
FBinHead: Integer; // куда класть
FBinTail: Integer; // откуда брать
FBinDropped: LongInt; // сколько блоков выброшено (диагностика)
FDead: Boolean; // сокет уже не пишется — гасим соединение
FKilled: Boolean; // shutdown сокета уже сделан
FClosed: Boolean; // клиентский поток вышел (можно освобождать)
@@ -123,6 +139,13 @@ type
destructor Destroy; override;
{ Строку в очередь клиенту. False — соединение уже мертво. Не блокирует. }
function Send(const S: string): Boolean;
{ Блок бинарного потока (заголовок + сэмплы) в очередь. Зовётся из
DSP-потока, поэтому только копирование под коротким локом: сеть тут не
трогается. False — клиент мёртв (блок никуда не пошёл). }
function SendBin(const Hdr: TTCIStreamHeader; Data: Pointer;
Bytes: Integer): Boolean;
{ Сколько блоков потока выброшено из-за отставания клиента. }
function BinDropped: LongInt;
{ Слить очередь в сокет. Зовёт ТОЛЬКО собственный поток клиента: запись
может ждать до TCI_SEND_TIMEOUT, и общий поток на этом задерживал бы
всех остальных. False — клиент умер. }
@@ -154,6 +177,10 @@ type
TTCIClientEvent = procedure(Client: TTCIClient) of object;
TTCICommandEvent = procedure(Client: TTCIClient; const Cmd: string) of object;
{ Собранное бинарное сообщение от клиента (TX-аудио, §3.4). Данные живут
только на время вызова — обработчик обязан их скопировать. }
TTCIBinaryEvent = procedure(Client: TTCIClient; Data: PByte;
Len: Integer) of object;
TTCIServer = class
private
@@ -170,6 +197,7 @@ type
FPort: Word;
FBindIP: string;
FOnCommand: TTCICommandEvent;
FOnBinary: TTCIBinaryEvent;
FOnConnect: TTCIClientEvent;
FOnDisconnect: TTCIClientEvent;
FOnTick: TThreadMethod;
@@ -218,6 +246,7 @@ type
контроллера, и Synchronize из клиентского потока в него не вернётся. }
property Stopping: Boolean read FStopping;
property OnCommand: TTCICommandEvent read FOnCommand write FOnCommand;
property OnBinary: TTCIBinaryEvent read FOnBinary write FOnBinary;
property OnConnect: TTCIClientEvent read FOnConnect write FOnConnect;
property OnDisconnect: TTCIClientEvent read FOnDisconnect write FOnDisconnect;
property OnTick: TThreadMethod read FOnTick write FOnTick;
@@ -411,17 +440,22 @@ begin
FOutLock := TCriticalSection.Create;
FOutCount := 0;
SetLength(FOut, 64);
FBinHead := 0;
FBinTail := 0;
FBinDropped := 0;
// Умолчания параметров потоков — как в §4.3 (клиент их обычно переопределяет).
FIQRate := 48000;
FAudioRate := 48000;
FAudioSamples := 2048;
FAudioChannels := 2;
FIQRate := TCI_IQ_RATE_DEF;
FAudioRate := TCI_AUDIO_RATE_DEF;
FAudioSamples := TCIDefaultAudioSamples(TCI_AUDIO_RATE_DEF);
FAudioChannels := TCI_AUDIO_CHAN_DEF;
FAudioSampleType := 'float32';
FTxBuffering := 50;
FTxBuffering := TCI_TX_BUFFERING_DEF;
end;
destructor TTCIClient.Destroy;
var i: Integer;
begin
for i := 0 to TCI_BIN_QUEUE - 1 do FBinOut[i] := nil;
FOutLock.Free;
FStateLock.Free;
inherited;
@@ -590,10 +624,53 @@ begin
end;
end;
function TTCIClient.SendBin(const Hdr: TTCIStreamHeader; Data: Pointer;
Bytes: Integer): Boolean;
// Кладёт готовый блок в кольцо. Зовётся из DSP-потока: единственное, что тут
// разрешено — копирование под коротким локом. Кольцо полное — выбрасываем
// САМЫЙ СТАРЫЙ блок: рвать соединение из-за отставания в потоке нельзя
// (команды при этом продолжают ходить), а протухший звук клиенту не нужен.
var
Blk: TBytes;
NewH: Integer;
begin
Result := False;
if FDead or (FWs = nil) or (Bytes < 0) then Exit;
if Bytes > TCI_STREAM_DATA_MAX then Exit; // блок не по протоколу
SetLength(Blk, SizeOf(Hdr) + Bytes);
Move(Hdr, Blk[0], SizeOf(Hdr));
if Bytes > 0 then Move(Data^, Blk[SizeOf(Hdr)], Bytes);
FOutLock.Enter;
try
if FDead then Exit;
NewH := (FBinHead + 1) mod TCI_BIN_QUEUE;
if NewH = FBinTail then
begin
FBinOut[FBinTail] := nil;
FBinTail := (FBinTail + 1) mod TCI_BIN_QUEUE;
Inc(FBinDropped);
end;
FBinOut[FBinHead] := Blk;
FBinHead := NewH;
Result := True;
finally
FOutLock.Leave;
end;
end;
function TTCIClient.BinDropped: LongInt;
begin
FOutLock.Enter;
try Result := FBinDropped; finally FOutLock.Leave; end;
end;
function TTCIClient.Flush: Boolean;
var
Batch: array of string;
N, i: Integer;
Bins: array[0..TCI_BIN_QUEUE-1] of TBytes;
N, i, NB: Integer;
Chunk: string;
begin
Result := not FDead;
@@ -602,6 +679,7 @@ begin
// поток так и висел бы в recv, а объект никогда бы не освободился.
if FDead then begin Kill; Exit; end;
NB := 0;
FOutLock.Enter;
try
N := FOutCount;
@@ -615,10 +693,19 @@ begin
end;
FOutCount := 0;
end;
// Бинарные блоки забираем тем же заходом: лишний Enter/Leave на каждый
// блок потока — это тысячи лишних локов в секунду.
while FBinTail <> FBinHead do
begin
Bins[NB] := FBinOut[FBinTail];
FBinOut[FBinTail] := nil;
FBinTail := (FBinTail + 1) mod TCI_BIN_QUEUE;
Inc(NB);
end;
finally
FOutLock.Leave;
end;
if N = 0 then Exit;
if (N = 0) and (NB = 0) then Exit;
// Склейка: несколько команд в одном фрейме протокол разрешает (§3.1), а
// syscall'ов и заголовков становится в разы меньше.
@@ -634,14 +721,30 @@ begin
end;
if Chunk <> '' then
if not FWs.SendText(Chunk) then begin Kill; Exit(False); end;
// Блоки потоков — каждый отдельным binary-фреймом: клиент читает их по
// одному заголовку на кадр, склейка тут запрещена протоколом.
for i := 0 to NB - 1 do
begin
if not FWs.SendBinary(Bins[i][0], Length(Bins[i])) then
begin
Kill;
Exit(False);
end;
Bins[i] := nil;
end;
end;
procedure TTCIClient.Kill;
var i: Integer;
begin
FOutLock.Enter;
try
FDead := True;
FOutCount := 0;
for i := 0 to TCI_BIN_QUEUE - 1 do FBinOut[i] := nil;
FBinHead := 0;
FBinTail := 0;
if FKilled then Exit; // shutdown уже был — второй раз незачем
FKilled := True;
finally
@@ -980,6 +1083,8 @@ var
Payload: array of Byte;
Opcode, MsgOp: Byte;
Frag: string;
Bin: array of Byte; // сборка бинарного сообщения (блок потока)
BinLen: Integer;
Cmds: TStringList;
begin
Ws := Client.Ws;
@@ -1086,6 +1191,11 @@ begin
Cmds := TStringList.Create;
Frag := '';
MsgOp := 0;
BinLen := 0;
// Буфер под сборку блока потока заводим сразу: расти по ходу приёма он всё
// равно не имеет права (потолок задан протоколом), а перевыделение на
// каждый блок TX-аудио — это мусор в куче двадцать раз в секунду.
SetLength(Bin, TCI_STREAM_MAX);
Pending := Rest > 0; // хвост handshake разбираем до первого recv
try
while FRunning and (Ws.State = wsOpen) and not Client.Dead do
@@ -1150,9 +1260,9 @@ begin
// Фрейм крупнее приёмного буфера TWsClient никогда не соберётся —
// BufLen упрётся в потолок и цикл встанет намертво. Рвём соединение:
// команд такой длины у TCI нет, а бинарные потоки от клиента (TX-аудио)
// мы пока не принимаем.
if Need + PayLen > SizeOf(Raw) then
// команд такой длины у TCI нет, а самый крупный законный кадр —
// блок TX-аудио (заголовок + data[16384]) — в буфер помещается.
if Need + PayLen > Ws.BufCapacity then
begin
Ws.State := wsClosed;
Break;
@@ -1189,11 +1299,11 @@ begin
begin
// Новое сообщение поверх недособранного — тоже рассинхрон.
if MsgOp <> 0 then begin Ws.State := wsClosed; Break; end;
MsgOp := Opcode;
Frag := '';
MsgOp := Opcode;
Frag := '';
BinLen := 0;
end;
// Копим только текст: binary — это TX-аудио от клиента, этап 2.
if MsgOp = $01 then
begin
if Length(Frag) + PayLen > TCI_MSG_MAX then
@@ -1207,10 +1317,30 @@ begin
Move(Payload[0], Text[1], PayLen);
Frag := Frag + Text;
end;
end
else
begin
// Бинарное сообщение — блок потока от клиента (TX-аудио).
// Клиент вправе резать его на фрагменты, поэтому копим так же,
// как текст, но с потолком в один блок: длиннее протокол не
// определяет, и растить буфер на чужой каприз мы не обязаны.
if BinLen + PayLen > TCI_STREAM_MAX then
begin
Ws.State := wsClosed;
Break;
end;
if PayLen > 0 then
begin
Move(Payload[0], Bin[BinLen], PayLen);
Inc(BinLen, PayLen);
end;
end;
if Fin then
begin
if (MsgOp = $02) and Assigned(FOnBinary) and (BinLen > 0) then
FOnBinary(Client, @Bin[0], BinLen);
BinLen := 0;
// Текстовое сообщение обязано быть валидным UTF-8 (§5.6);
// битую последовательность RFC велит закрывать, а не молча
// скармливать разбору команд.
TCIStreams.pas
+859
View File
@@ -0,0 +1,859 @@
unit TCIStreams;
{
TCIStreams.pas — бинарные потоки TCI (§3.4): нарезка сэмплов на блоки,
пересчёт частоты дискретизации, запись линейного выхода в файл.
Чистый слой обработки: ни контроллера, ни движка тут нет — только TCIProtocol
(формат блока) и TCIServer (очередь клиента). Кто и откуда кормит эти объекты,
решает TCIAdapter.
★Главное про потоки исполнения. Feed* зовёт DSP-ПОТОК (тап аудио/IQ), то есть
тот самый, который считает WDSP. Поэтому здесь нет ни одного вызова, который
может ждать: блок уходит в кольцо клиента (микросекунды под его локом), а в
сокет его пишет собственный поток клиента. Отставший клиент теряет свои блоки
(TTCIClient.SendBin выбрасывает самый старый) и никого больше не задерживает.
Пересчёт частоты:
• вниз (RX-аудио 48 кГц → 8/12/24, IQ 384 → 48/96/192) — FIR-дециматор с
целым коэффициентом. Без фильтра тут нельзя: широкий ФМ-канал или шум за
полосой сложились бы в звуковую полосу зеркалом;
• вверх (TX-аудио клиента 8/12/24 кГц → 48 кГц тракта) — линейная
интерполяция. Образы от неё лежат на 8..12 кГц и выше, то есть заведомо
за полосой TX-фильтра (максимум 4 кГц), а завал в полосе — 0.2 дБ на
3 кГц. Городить ради этого второй FIR смысла нет.
}
{$IFDEF FPC}
{$MODE Delphi}
{$LONGSTRINGS ON}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, SyncObjs, TCIProtocol, TCIServer;
const
// Длина FIR на каждую ступень прореживания. Ntaps = TCI_FIR_PER_FACTOR×M+1
// ⇒ стоимость на ВХОДНОЙ сэмпл постоянна (≈8 умножений) независимо от M.
TCI_FIR_PER_FACTOR = 8;
TCI_FIR_MAX_TAPS = 257;
// Кусок, которым поток перемалывает подачу от движка. Все рабочие буферы
// заведены под него в конструкторе: SetLength в DSP-потоке на каждый блок
// аудио — это тысячи обращений к куче в секунду на ровном месте.
TCI_FEED_CHUNK = 4096;
type
{ Накопленная запись: 16-битный PCM с чередованием L/R. }
TTCIPcm = array of SmallInt;
{ Дециматор с целым коэффициентом. Прямая свёртка по линии задержки: выход
считается только на нужной фазе, поэтому цена не зависит от M. }
TTCIDecimator = class
private
FTaps: array of Single;
FHist: array of Single; // линия задержки, кольцо
FN: Integer; // длина FIR
FHalf: Integer; // FN div 2 — число симметричных пар
FPos: Integer;
FPhase: Integer;
FFactor: Integer;
public
{ Одиночный дециматор: полоса 0.45 от новой частоты Найквиста, длина FIR
по коэффициенту. Для одной ступени этого достаточно. }
constructor Create(AFactor: Integer);
{ Ступень каскада: полосу и длину задаёт вызывающий — ранним ступеням
узкая переходная полоса не нужна (см. TTCIDecimChain). }
constructor CreateDesigned(AFactor, ATaps: Integer; ACutoff: Double);
procedure Reset;
{ N входных сэмплов → до N/Factor выходных. Dst обязан вмещать столько. }
function Process(const Src: array of Single; N: Integer;
var Dst: array of Single): Integer;
property Factor: Integer read FFactor;
property Taps: Integer read FN;
end;
{ Каскад дециматоров. Одной ступенью большие коэффициенты не берутся: длина
FIR растёт вместе с коэффициентом, а упираясь в потолок TCI_FIR_MAX_TAPS,
одноступенчатый дециматор перестаёт быть фильтром вовсе. Замерено на
5760→48 кГц (коэффициент 120, верхний rate Pluto): завал 1.3 дБ в полосе и
подавление зеркала всего 16 дБ — то есть поток IQ с мусором.
Поэтому коэффициент раскладывается на множители (по убыванию — самая
дорогая ступень первой). Спецификацию фильтра каждой ступени задаёт
ИТОГОВАЯ полоса, а не её собственная: ранняя ступень обязана убрать лишь
те узкие зоны, которые в конце сложатся в полезную полосу, поэтому её
переходная полоса шире в десятки раз, а фильтр во столько же короче.
Итог замера: −83 дБ по зеркалу на любом коэффициенте, цена ≈10% ядра на
потоке 5.76 МГц (было 20% и мусор). Свёртка идёт со сложением симметричных
пар — умножений вдвое меньше при том же результате. }
TTCIDecimChain = class
private
FStages: array of TTCIDecimator;
FTmp: array[0..1] of array of Single;
FFactor: Integer;
public
constructor Create(AFactor: Integer);
destructor Destroy; override;
procedure Reset;
function Process(const Src: array of Single; N: Integer;
var Dst: array of Single): Integer;
property Factor: Integer read FFactor;
end;
{ Интерполятор для TX-аудио: целое отношение, линейная интерполяция. }
TTCIInterpolator = class
private
FFactor: Integer;
FPrev: Single;
FHas: Boolean;
public
constructor Create(AFactor: Integer);
procedure Reset;
function Process(const Src: array of Single; N: Integer;
var Dst: array of Double): Integer;
property Factor: Integer read FFactor;
end;
{ Исходящий поток одного клиента: один тип, один приёмник. Живёт от START до
STOP (или до ухода клиента) и владеет своими дециматорами и накопителем. }
TTCIStreamOut = class
private
FClient: TTCIClient;
FKind: TTCIStreamType;
FRx: Integer;
FSrcRate: Integer;
FOutRate: Integer;
FChannels: Integer;
FSampleT: TTCISampleType;
FBlock: Integer; // сэмплов НА КАНАЛ в блоке
FDec: array[0..1] of TTCIDecimChain;
FTmp: array[0..1] of array of Single; // выход дециматора
FIn: array of Single; // вход одного канала, кусок
FWantRate: Integer; // о чём просил клиент (для пересборки)
FAcc: array of Single; // накопитель с чередованием каналов
FAccCount: Integer; // сэмплов на канал в накопителе
FPacked: array of Byte;
procedure EmitFull;
procedure PushPair(A, B: Single);
public
constructor Create(AClient: TTCIClient; AKind: TTCIStreamType;
ARx, ASrcRate, AWantRate, AChannels: Integer;
ASampleT: TTCISampleType; ABlock: Integer);
destructor Destroy; override;
{ Аудио 48 кГц: стерео от движка. Один канал — усреднение (моно). }
procedure FeedAudio(const L, R: array of Single; N: Integer);
{ IQ: комплексные отсчёты, всегда два канала. }
procedure FeedIQ(PI_, PQ_: PDouble; N: Integer);
{ Совпадает ли поток с (клиент, тип, приёмник) — для поиска в списке. }
function Matches(AClient: TTCIClient; AKind: TTCIStreamType;
ARx: Integer): Boolean;
{ Частота источника сменилась на ходу (другой sample rate устройства или
rate DDC пана). Пересобирает прореживание; накопленный блок бросаем —
склеивать в один блок сэмплы двух разных частот нельзя. }
procedure SetSourceRate(ANewRate: Integer);
property Client: TTCIClient read FClient;
property Kind: TTCIStreamType read FKind;
property Rx: Integer read FRx;
property OutRate: Integer read FOutRate;
property SrcRate: Integer read FSrcRate;
end;
{ Запись линейного выхода (LINE_OUT_RECORDER_*, §4.3). Кольцо на MaxSec
секунд 48 кГц стерео в int16: во-первых, ровно то, что уйдёт в WAV, а
во-вторых, float32 на предельных 300 с — это 115 МБ вместо 57. }
TTCIRecorder = class
private
FLock: TCriticalSection;
FRing: array of SmallInt; // чередование L/R
FCap: Integer; // ёмкость в сэмплах на канал
FCount: Integer; // накоплено сэмплов на канал
FHead: Integer; // позиция записи (в сэмплах на канал)
FRate: Integer;
FRx: Integer;
public
constructor Create(ARx, ARateHz, AMaxSec: Integer);
destructor Destroy; override;
procedure Feed(const L, R: array of Single; N: Integer);
{ Забрать накопленное В ПОРЯДКЕ ВРЕМЕНИ и обнулить кольцо. }
function Take: TTCIPcm;
property Rx: Integer read FRx;
property Rate: Integer read FRate;
end;
{ Писатель WAV в своём потоке: файл до 60 МБ, а зовут сохранение из тика
сервера — блокировать его на секунду диска нельзя. Данные забирает себе. }
TTCIWavWriter = class(TThread)
private
FPath: string;
FData: TTCIPcm;
FRate: Integer;
protected
procedure Execute; override;
public
constructor Create(const APath: string; const AData: TTCIPcm;
ARateHz: Integer);
end;
{ Коэффициент прореживания SrcRate → WantRate: наибольший целый делитель,
дающий не меньше запрошенного. Апсемплинг наружу не делаем никогда —
клиенту уходит настоящая частота (она же в заголовке блока). }
function TCIDecimFactor(SrcRate, WantRate: Integer): Integer;
{ Частота IQ, которую реально можно отдать: наибольшая ЗАКОННАЯ по протоколу
(48/96/192/384 кГц), не выше запрошенной и делящая частоту источника нацело.
Нужна из-за частот дискретизации Pluto: 576 и 960 кГц на 384 не делятся, и
без этого выбора клиент, попросивший 384 кГц, получал бы поток на 576/480 —
и не по протоколу, и вчетверо толще, чем он ждёт. Если законной не нашлось
вовсе (чужой rate), возвращаем просьбу как есть: дальше её обработает
TCIDecimFactor, а настоящая частота уйдёт в заголовке блока. }
function TCIPickIQRate(SrcRate, WantRate: Integer): Integer;
{ Путь из LINE_OUT_RECORDER_SAVE в путь файловой системы: в протоколе ':'
запрещён и заменён на '|' (§4.3), слэши допускаются любые. }
function TCIRecordPath(const S: string): string;
implementation
{ ═══════════════════════════════════════════════════════════════════════════
Дециматор
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIDecimator.Create(AFactor: Integer);
var N: Integer;
begin
if AFactor < 1 then AFactor := 1;
N := TCI_FIR_PER_FACTOR * AFactor + 1;
CreateDesigned(AFactor, N, 0.45 / AFactor);
end;
constructor TTCIDecimator.CreateDesigned(AFactor, ATaps: Integer;
ACutoff: Double);
var
i, C: Integer;
X, W, Sum: Double;
begin
inherited Create;
if AFactor < 1 then AFactor := 1;
FFactor := AFactor;
FN := ATaps;
if FN < 9 then FN := 9;
if FN > TCI_FIR_MAX_TAPS then FN := TCI_FIR_MAX_TAPS;
if (FN and 1) = 0 then Inc(FN); // нечётная длина: линейная фаза и
// целая задержка
FHalf := FN div 2;
SetLength(FTaps, FN);
SetLength(FHist, FN);
// Окно Блэкмана поверх sinc. Оно, в отличие от Хэмминга, даёт −74 дБ вместо
// −53 в полосе задержания, а платим за это только длиной — и как раз длину
// многоступенчатая схема экономит (см. TTCIDecimChain).
C := FN div 2;
Sum := 0;
for i := 0 to FN - 1 do
begin
X := i - C;
if Abs(X) < 1E-9 then W := 2 * ACutoff
else W := Sin(2 * Pi * ACutoff * X) / (Pi * X);
W := W * (0.42 - 0.5 * Cos(2 * Pi * i / (FN - 1))
+ 0.08 * Cos(4 * Pi * i / (FN - 1)));
FTaps[i] := W;
Sum := Sum + W;
end;
// Нормировка по единичному усилению на постоянном токе: без неё уровень
// аудио гулял бы на доли дБ от коэффициента прореживания.
if Abs(Sum) > 1E-12 then
for i := 0 to FN - 1 do FTaps[i] := FTaps[i] / Sum;
Reset;
end;
procedure TTCIDecimator.Reset;
var i: Integer;
begin
for i := 0 to FN - 1 do FHist[i] := 0;
FPos := 0;
FPhase := 0;
end;
function TTCIDecimator.Process(const Src: array of Single; N: Integer;
var Dst: array of Single): Integer;
var
i, k, t, a, b: Integer;
Acc: Double;
begin
Result := 0;
if N > Length(Src) then N := Length(Src);
if FFactor = 1 then
begin
// Прореживать нечего — фильтр в этом случае только съел бы верх полосы.
k := N;
if k > Length(Dst) then k := Length(Dst);
for i := 0 to k - 1 do Dst[i] := Src[i];
Exit(k);
end;
k := 0;
for i := 0 to N - 1 do
begin
FHist[FPos] := Src[i];
Inc(FPos);
if FPos >= FN then FPos := 0;
Inc(FPhase);
if FPhase < FFactor then Continue;
FPhase := 0;
if k >= Length(Dst) then Break; // переполнение приёмника — молча режем
// Свёртка со сложением симметричных пар: фильтр линейнофазовый, значит
// FTaps[t] = FTaps[N-1-t], и умножений вдвое меньше при том же результате.
// На 5.76 МГц (верхний rate Pluto) это разница между 16% и 10% ядра.
Acc := 0;
a := FPos; // самый старый отсчёт (это отвод N-1)
b := FPos + FN - 1; // самый свежий (это отвод 0)
if b >= FN then Dec(b, FN);
for t := 0 to FHalf - 1 do
begin
Acc := Acc + FTaps[t] * (FHist[a] + FHist[b]);
Inc(a); if a >= FN then a := 0;
Dec(b); if b < 0 then b := FN - 1;
end;
Dst[k] := Acc + FTaps[FHalf] * FHist[a]; // центральный отвод
Inc(k);
end;
Result := k;
end;
{ ═══════════════════════════════════════════════════════════════════════════
Каскад дециматоров
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIDecimChain.Create(AFactor: Integer);
var
Rest, F, i, N: Integer;
Cur, FPass, FStop: Double;
Fac: array of Integer;
procedure AddFactor(V: Integer);
begin
SetLength(Fac, Length(Fac) + 1);
Fac[High(Fac)] := V;
end;
begin
inherited Create;
if AFactor < 1 then AFactor := 1;
FFactor := AFactor;
Rest := AFactor;
// Раскладываем на простые. Всё, что не разложилось (простое число больше
// семи — у частот дискретизации не встречается, но бывает у чужого железа),
// остаётся одной ступенью: она хотя бы не хуже прежнего поведения.
for F in [2, 3, 5, 7] do
while (Rest mod F = 0) and (Rest > 1) do
begin
AddFactor(F);
Rest := Rest div F;
end;
if Rest > 1 then AddFactor(Rest);
// По убыванию: первая ступень самая «дорогая», и после неё частота, на
// которой работают остальные, уже сбита.
for i := 0 to High(Fac) - 1 do
for F := 0 to High(Fac) - 1 - i do
if Fac[F] < Fac[F + 1] then
begin
Rest := Fac[F];
Fac[F] := Fac[F + 1];
Fac[F + 1] := Rest;
end;
// Спецификация фильтра каждой ступени считается от ИТОГОВОЙ полосы, а не от
// её собственной. Ранняя ступень отдаёт наверх широкий поток, и всё, что она
// обязана убрать, — те узкие зоны, которые в конце сложатся в полезную
// полосу; переходная полоса у неё получается в десятки раз шире, а значит и
// фильтр во столько же раз короче. Ради этого многоступенчатую схему и
// делают: на 5760→48 кГц первая ступень обходится 30 отводами вместо 257,
// которых всё равно не хватало.
SetLength(FStages, Length(Fac));
Cur := 1.0; // доля от исходной частоты на входе ступени
for i := 0 to High(Fac) do
begin
// Полоса, которую обязаны сохранить, — 0.45 от итоговой Найквиста,
// в единицах ВХОДНОЙ частоты этой ступени.
FPass := (0.45 * 0.5 / FFactor) / Cur;
FStop := (1.0 / Fac[i]) - FPass; // сюда сложится всё лишнее
if FStop <= FPass * 1.05 then // последняя ступень: запаса уже нет
begin
FPass := 0.45 / Fac[i];
FStop := 0.55 / Fac[i];
end;
// Ширина переходной полосы ↔ длина окна Блэкмана: N ≈ 5.5/Δf.
N := Ceil(5.5 / (FStop - FPass)) + 1;
FStages[i] := TTCIDecimator.CreateDesigned(Fac[i], N,
(FPass + FStop) * 0.5);
Cur := Cur / Fac[i];
end;
SetLength(FTmp[0], TCI_FEED_CHUNK);
SetLength(FTmp[1], TCI_FEED_CHUNK);
end;
destructor TTCIDecimChain.Destroy;
var i: Integer;
begin
for i := 0 to High(FStages) do FStages[i].Free;
inherited;
end;
procedure TTCIDecimChain.Reset;
var i: Integer;
begin
for i := 0 to High(FStages) do FStages[i].Reset;
end;
function TTCIDecimChain.Process(const Src: array of Single; N: Integer;
var Dst: array of Single): Integer;
var
i, Cur: Integer;
begin
if N > Length(Src) then N := Length(Src);
if Length(FStages) = 0 then
begin
if N > Length(Dst) then N := Length(Dst);
for i := 0 to N - 1 do Dst[i] := Src[i];
Exit(N);
end;
if Length(FStages) = 1 then
Exit(FStages[0].Process(Src, N, Dst));
// Пинг-понг между двумя буферами; последняя ступень пишет сразу в Dst.
Cur := 0;
N := FStages[0].Process(Src, N, FTmp[0]);
for i := 1 to High(FStages) - 1 do
begin
N := FStages[i].Process(FTmp[Cur], N, FTmp[1 - Cur]);
Cur := 1 - Cur;
end;
Result := FStages[High(FStages)].Process(FTmp[Cur], N, Dst);
end;
{ ═══════════════════════════════════════════════════════════════════════════
Интерполятор (TX-аудио клиента → 48 кГц тракта)
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIInterpolator.Create(AFactor: Integer);
begin
inherited Create;
if AFactor < 1 then AFactor := 1;
FFactor := AFactor;
Reset;
end;
procedure TTCIInterpolator.Reset;
begin
FPrev := 0;
FHas := False;
end;
function TTCIInterpolator.Process(const Src: array of Single; N: Integer;
var Dst: array of Double): Integer;
var
i, p, k: Integer;
A, B: Single;
begin
if N > Length(Src) then N := Length(Src);
k := 0;
if FFactor = 1 then
begin
for i := 0 to N - 1 do
begin
if k >= Length(Dst) then Break;
Dst[k] := Src[i];
Inc(k);
end;
Exit(k);
end;
for i := 0 to N - 1 do
begin
B := Src[i];
if FHas then A := FPrev else A := B; // самый первый блок: без скачка от нуля
for p := 0 to FFactor - 1 do
begin
if k >= Length(Dst) then Break;
Dst[k] := A + (B - A) * (p / FFactor);
Inc(k);
end;
FPrev := B;
FHas := True;
end;
Result := k;
end;
{ ═══════════════════════════════════════════════════════════════════════════
Исходящий поток
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIStreamOut.Create(AClient: TTCIClient; AKind: TTCIStreamType;
ARx, ASrcRate, AWantRate, AChannels: Integer; ASampleT: TTCISampleType;
ABlock: Integer);
var
F, MaxB, i: Integer;
begin
inherited Create;
FClient := AClient;
FKind := AKind;
FRx := ARx;
FSrcRate := ASrcRate;
FWantRate := AWantRate;
FChannels := EnsureRange(AChannels, 1, 2);
FSampleT := ASampleT;
if FKind = tstIQ then AWantRate := TCIPickIQRate(ASrcRate, AWantRate);
F := TCIDecimFactor(ASrcRate, AWantRate);
FOutRate := ASrcRate div F;
// Блок не имеет права вылезти за data[16384]: столько ExpertSDR3 объявил
// потолком, и клиенты держат приёмный буфер ровно под него.
MaxB := TCIMaxBlockSamples(FSampleT, FChannels);
FBlock := EnsureRange(ABlock, 1, MaxB);
for i := 0 to FChannels - 1 do
begin
FDec[i] := TTCIDecimChain.Create(F);
SetLength(FTmp[i], TCI_FEED_CHUNK);
end;
SetLength(FIn, TCI_FEED_CHUNK);
SetLength(FAcc, FBlock * FChannels);
SetLength(FPacked, FBlock * FChannels * TCISampleBytes(FSampleT));
FAccCount := 0;
end;
destructor TTCIStreamOut.Destroy;
var i: Integer;
begin
for i := 0 to 1 do FreeAndNil(FDec[i]);
inherited;
end;
function TTCIStreamOut.Matches(AClient: TTCIClient; AKind: TTCIStreamType;
ARx: Integer): Boolean;
begin
Result := (FClient = AClient) and (FKind = AKind) and (FRx = ARx);
end;
procedure TTCIStreamOut.SetSourceRate(ANewRate: Integer);
var i, F, W: Integer;
begin
if (ANewRate <= 0) or (ANewRate = FSrcRate) then Exit;
FSrcRate := ANewRate;
// Просьбу клиента храним как есть, а законную частоту пересчитываем: у
// нового источника делители другие (576 кГц Pluto не делится на 384).
if FKind = tstIQ then W := TCIPickIQRate(FSrcRate, FWantRate)
else W := FWantRate;
F := TCIDecimFactor(FSrcRate, W);
FOutRate := FSrcRate div F;
for i := 0 to FChannels - 1 do
begin
FDec[i].Free;
FDec[i] := TTCIDecimChain.Create(F);
end;
FAccCount := 0;
end;
procedure TTCIStreamOut.EmitFull;
var
H: TTCIStreamHeader;
Bytes: Integer;
begin
TCIFillHeader(H, FKind, FRx, FOutRate, FSampleT, FBlock, FChannels);
Bytes := TCIPackSamples(FAcc, FBlock * FChannels, FSampleT, @FPacked[0]);
FClient.SendBin(H, @FPacked[0], Bytes);
FAccCount := 0;
end;
procedure TTCIStreamOut.PushPair(A, B: Single);
begin
if FChannels = 1 then
FAcc[FAccCount] := A
else
begin
FAcc[FAccCount * 2] := A;
FAcc[FAccCount * 2 + 1] := B;
end;
Inc(FAccCount);
if FAccCount >= FBlock then EmitFull;
end;
procedure TTCIStreamOut.FeedAudio(const L, R: array of Single; N: Integer);
var
i, n0, n1, Chunk, Off: Integer;
begin
if (N <= 0) or (FClient = nil) then Exit;
if N > Length(L) then N := Length(L);
if N > Length(R) then N := Length(R);
Off := 0;
while Off < N do
begin
// Кусками по TCI_FEED_CHUNK: движок вправе отдать блок любой длины, а
// рабочие буферы у нас фиксированные (см. константу).
Chunk := N - Off;
if Chunk > TCI_FEED_CHUNK then Chunk := TCI_FEED_CHUNK;
if FChannels = 1 then
begin
for i := 0 to Chunk - 1 do FIn[i] := (L[Off + i] + R[Off + i]) * 0.5;
n0 := FDec[0].Process(FIn, Chunk, FTmp[0]);
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], 0);
end
else
begin
for i := 0 to Chunk - 1 do FIn[i] := L[Off + i];
n0 := FDec[0].Process(FIn, Chunk, FTmp[0]);
for i := 0 to Chunk - 1 do FIn[i] := R[Off + i];
n1 := FDec[1].Process(FIn, Chunk, FTmp[1]);
if n1 < n0 then n0 := n1;
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], FTmp[1][i]);
end;
Inc(Off, Chunk);
end;
end;
procedure TTCIStreamOut.FeedIQ(PI_, PQ_: PDouble; N: Integer);
var
i, n0, n1, Chunk, Off: Integer;
SI, SQ: PDouble;
begin
if (N <= 0) or (FClient = nil) or (PI_ = nil) or (PQ_ = nil) then Exit;
Off := 0;
while Off < N do
begin
Chunk := N - Off;
if Chunk > TCI_FEED_CHUNK then Chunk := TCI_FEED_CHUNK;
SI := PI_; Inc(SI, Off);
for i := 0 to Chunk - 1 do begin FIn[i] := SI^; Inc(SI); end;
n0 := FDec[0].Process(FIn, Chunk, FTmp[0]);
if FChannels >= 2 then
begin
// Q считаем ТЕМ ЖЕ проходом, что и I: разошедшиеся по длине выходы
// означали бы сдвиг фазы между каналами, то есть поворот спектра.
SQ := PQ_; Inc(SQ, Off);
for i := 0 to Chunk - 1 do begin FIn[i] := SQ^; Inc(SQ); end;
n1 := FDec[1].Process(FIn, Chunk, FTmp[1]);
if n1 < n0 then n0 := n1;
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], FTmp[1][i]);
end
else
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], 0);
Inc(Off, Chunk);
end;
end;
{ ═══════════════════════════════════════════════════════════════════════════
Рекордер линейного выхода
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIRecorder.Create(ARx, ARateHz, AMaxSec: Integer);
begin
inherited Create;
FLock := TCriticalSection.Create;
FRx := ARx;
FRate := ARateHz;
if AMaxSec < 1 then AMaxSec := 1;
if AMaxSec > TCI_RECORD_MAX_SEC then AMaxSec := TCI_RECORD_MAX_SEC;
FCap := ARateHz * AMaxSec;
SetLength(FRing, FCap * 2);
FCount := 0;
FHead := 0;
end;
destructor TTCIRecorder.Destroy;
begin
FLock.Free;
inherited;
end;
procedure TTCIRecorder.Feed(const L, R: array of Single; N: Integer);
// DSP-поток. Кольцо: по исчерпании ёмкости затирается самое старое — запись
// «последние N секунд» именно так и работает (§4.3: по истечении времени
// накопленное пропадает, если клиент не сохранил).
var
i: Integer;
A, B: Single;
begin
if (N <= 0) or (FCap <= 0) then Exit;
if N > Length(L) then N := Length(L);
if N > Length(R) then N := Length(R);
FLock.Enter;
try
for i := 0 to N - 1 do
begin
A := L[i]; B := R[i];
if A > 1.0 then A := 1.0; if A < -1.0 then A := -1.0;
if B > 1.0 then B := 1.0; if B < -1.0 then B := -1.0;
FRing[FHead * 2] := Round(A * 32767);
FRing[FHead * 2 + 1] := Round(B * 32767);
Inc(FHead);
if FHead >= FCap then FHead := 0;
if FCount < FCap then Inc(FCount);
end;
finally
FLock.Leave;
end;
end;
function TTCIRecorder.Take: TTCIPcm;
var
Start, i, n: Integer;
begin
Result := nil;
FLock.Enter;
try
if FCount <= 0 then Exit;
SetLength(Result, FCount * 2);
Start := FHead - FCount;
if Start < 0 then Inc(Start, FCap);
for i := 0 to FCount - 1 do
begin
n := (Start + i) mod FCap;
Result[i * 2] := FRing[n * 2];
Result[i * 2 + 1] := FRing[n * 2 + 1];
end;
FCount := 0;
FHead := 0;
finally
FLock.Leave;
end;
end;
{ ═══════════════════════════════════════════════════════════════════════════
WAV
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIWavWriter.Create(const APath: string;
const AData: TTCIPcm; ARateHz: Integer);
begin
inherited Create(True);
FreeOnTerminate := True;
FPath := APath;
FData := AData;
FRate := ARateHz;
Start;
end;
procedure TTCIWavWriter.Execute;
// Заголовок собираем в буфере: WAV — это фиксированные 44 байта, и городить
// два десятка отдельных Write ради них незачем (а строковые литералы в
// нетипизированный Write в FPC ещё и передаются не тем, чем кажется).
var
FS: TFileStream;
Hdr: array[0..43] of Byte;
DataBytes: LongWord;
procedure PutTag(Ofs: Integer; const Tag: string);
var i: Integer;
begin
for i := 1 to Length(Tag) do Hdr[Ofs + i - 1] := Byte(Tag[i]);
end;
procedure PutU32(Ofs: Integer; V: LongWord);
begin
Hdr[Ofs] := Byte(V); Hdr[Ofs + 1] := Byte(V shr 8);
Hdr[Ofs + 2] := Byte(V shr 16); Hdr[Ofs + 3] := Byte(V shr 24);
end;
procedure PutU16(Ofs: Integer; V: Word);
begin
Hdr[Ofs] := Byte(V); Hdr[Ofs + 1] := Byte(V shr 8);
end;
begin
try
DataBytes := LongWord(Length(FData) * SizeOf(SmallInt));
FillChar(Hdr, SizeOf(Hdr), 0);
PutTag(0, 'RIFF');
PutU32(4, 36 + DataBytes);
PutTag(8, 'WAVE');
PutTag(12, 'fmt ');
PutU32(16, 16); // размер fmt-блока
PutU16(20, 1); // PCM
PutU16(22, 2); // каналов
PutU32(24, LongWord(FRate));
PutU32(28, LongWord(FRate) * 2 * 2); // байт в секунду
PutU16(32, 4); // выравнивание блока
PutU16(34, 16); // бит на сэмпл
PutTag(36, 'data');
PutU32(40, DataBytes);
FS := TFileStream.Create(FPath, fmCreate);
try
FS.Write(Hdr[0], SizeOf(Hdr));
if DataBytes > 0 then FS.Write(FData[0], DataBytes);
finally
FS.Free;
end;
except
// Записать не вышло (нет прав, нет каталога, диск полон) — сказать об этом
// клиенту уже некому: команда давно подтверждена. Молчим, но и не падаем:
// исключение из потока утащило бы за собой процесс.
end;
FData := nil;
end;
{ ═══════════════════════════════════════════════════════════════════════════
Утилиты
═══════════════════════════════════════════════════════════════════════════ }
function TCIDecimFactor(SrcRate, WantRate: Integer): Integer;
var F: Integer;
begin
Result := 1;
if (SrcRate <= 0) or (WantRate <= 0) or (WantRate >= SrcRate) then Exit;
// Идём от большего прореживания к меньшему и берём первое, которое делит
// входную частоту нацело и не опускает нас ниже запрошенной.
F := SrcRate div WantRate;
while F > 1 do
begin
if (SrcRate mod F = 0) and (SrcRate div F >= WantRate) then Exit(F);
Dec(F);
end;
end;
function TCIPickIQRate(SrcRate, WantRate: Integer): Integer;
const
LEGAL: array[0..3] of Integer = (384000, 192000, 96000, 48000);
var i: Integer;
begin
Result := WantRate;
if (SrcRate <= 0) or (WantRate <= 0) then Exit;
for i := 0 to High(LEGAL) do
if (LEGAL[i] <= WantRate) and (LEGAL[i] <= SrcRate) and
(SrcRate mod LEGAL[i] = 0) then
Exit(LEGAL[i]);
end;
function TCIRecordPath(const S: string): string;
var i: Integer;
begin
Result := S;
for i := 1 to Length(Result) do
if Result[i] = '|' then Result[i] := ':';
{$IFDEF WINDOWS}
for i := 1 to Length(Result) do
if Result[i] = '/' then Result[i] := '\';
{$ELSE}
for i := 1 to Length(Result) do
if Result[i] = '\' then Result[i] := '/';
{$ENDIF}
end;
end.
WDSPEngine.pas
+31
View File
@@ -203,6 +203,14 @@ type
TOnTXIQReady = procedure(const Buf: array of Double; Count: Integer) of object;
TOnWaterfallReady = procedure(const Pixels: array of Single;
Count: Integer) of object;
// Тап сырого RX-IQ (потоки IQ по TCI, §3.4). Зовётся из DSP-потока ОДИН РАЗ
// на накопленный блок — не на сэмпл: сэмплов тут до 384 тысяч в секунду на
// каждый пан, и вызов метода на каждый стоил бы дороже самой работы.
// PanId: 0 = главный тракт, 1.. = доп. пан. I/Q — два массива по N отсчётов,
// живущих только на время вызова.
TIQTapEvent = procedure(PanId: Integer; PI_, PQ_: PDouble;
N, RateHz: Integer) of object;
// Аудио готового слайса — вызывается из DSP-потока по каждому активному слайсу.
// SliceId — логический id (из RadioController), не WDSP-канал.
TOnSliceAudio = procedure(SliceId: Integer; const Left, Right: array of Single;
@@ -515,6 +523,7 @@ type
FVolume: Double;
FLastError: string;
FBeaconDec: TBeaconDecoder; // не владеет; тап маяка в PushIQItemToDSP
FIQTap: TIQTapEvent; // тап сырого IQ наружу (TCI), не владеет
function ModeToWDSP(Mode: Integer): Integer;
function ModeToWDSPTX(Mode: Integer): Integer;
@@ -626,6 +635,10 @@ type
// QO-100 beacon-декодер: тап RX-IQ для демодуляции маяка (не владеет).
procedure SetBeaconDecoder(D: TBeaconDecoder);
// Тап сырого RX-IQ наружу (потоки IQ по TCI). nil — снять. Ставит и
// снимает поток контроллера; вызывается тап из DSP-потока.
procedure SetIQTap(T: TIQTapEvent);
// --- Панадаптеры на аппаратных DDC (этап 3.2) ---
// Создаёт доп. пан PanId (1..MAX_PANS-1): аккумулятор + analyzer
// PAN_DISP_BASE+PanId. RateHz — rate его DDC, кратен FAudioRate.
@@ -2410,6 +2423,11 @@ begin
if (D <> nil) and (FSampleRate > 0) then D.Configure(FSampleRate);
end;
procedure TWDSPEngine.SetIQTap(T: TIQTapEvent);
begin
FIQTap := T;
end;
procedure TWDSPEngine.PushDDCPacket(const Buf: array of Byte;
DataOffset: Integer; IQPairs: Integer);
// Вызывается из СЕТЕВОГО потока — только кладём в очередь и возвращаемся немедленно
@@ -2522,6 +2540,12 @@ begin
if Pan^.AccPos >= Pan^.BufSize then
begin
Pan^.AccPos := 0;
// Тап IQ пана — как у главного тракта, один вызов на блок. Он идёт
// ПОД FSliceLock (весь разбор пакета пана здесь), поэтому обработчик
// обязан только скопировать данные и вернуться: любое ожидание тут
// остановит DSP-поток вместе со всеми панами.
if Assigned(FIQTap) then
FIQTap(PanId, @Pan^.AccI[0], @Pan^.AccQ[0], Pan^.BufSize, Pan^.Rate);
if Assigned(FOnSliceAudio) or Assigned(FOnSliceDemodAudio) then
try
ProcessSlicesFor(PanId, Pan^.AccI, Pan^.AccQ, Pan^.BufSize);
@@ -2638,7 +2662,14 @@ begin
Inc(FRXAccPos);
if FRXAccPos >= FBufSize then
begin
// Тап IQ наружу — по накопленному блоку и ДО обработки: fexchange0
// забирает аккумулятор как вход и не портит его, но полагаться на это
// незачем, а один вызов на блок вместо вызова на сэмпл экономит всё.
if Assigned(FIQTap) then
FIQTap(0, @FRXAccI[0], @FRXAccQ[0], FBufSize, FSampleRate);
ProcessRXBlock;
end;
end;
end;
WsClient.pas
+18 -1
View File
@@ -22,6 +22,14 @@ uses
SyncObjs, WebUtils
{$IFDEF WINDOWS}, WinSock2{$ELSE}, Sockets{$ENDIF};
const
{ Приёмный буфер соединения. 4 КБ хватало командам и web-запросам, но блок
бинарного потока TCI (§3.4) — это заголовок 64 байта плюс data[16384],
и кадр крупнее буфера не собирается НИКОГДА: BufLen упирается в потолок и
разбор встаёт. Поэтому потолок держим с запасом на кадр целиком вместе с
маской и хвостом соседнего сообщения. }
WS_BUF_SIZE = 32768;
type
TWsState = (wsHandshake, wsOpen, wsClosed);
@@ -30,7 +38,7 @@ type
FSocket: TSocket;
FState: TWsState;
FLock: TCriticalSection;
FBuf: array[0..4095] of Byte;
FBuf: array[0..WS_BUF_SIZE-1] of Byte;
FBufLen: Integer;
FAuthed: Boolean;
public
@@ -55,6 +63,10 @@ type
{ Указатель на начало буфера приёма }
function BufData: PByte; inline;
{ Ёмкость приёмного буфера: разбору фреймов нужен потолок, чтобы вовремя
закрыть соединение, а не встать намертво на несобираемом кадре. }
function BufCapacity: Integer; inline;
property Socket: TSocket read FSocket;
property State: TWsState read FState write FState;
property Authed: Boolean read FAuthed write FAuthed;
@@ -175,4 +187,9 @@ begin
Result := @FBuf[0];
end;
function TWsClient.BufCapacity: Integer;
begin
Result := SizeOf(FBuf);
end;
end.
doc/TCI.md
+194 -33
View File
@@ -1,7 +1,7 @@
# TCI в EWSDR — статус реализации
Ветка разработки: `feature/tci-protocol`.
Дата последнего обновления: 2026-08-17.
Дата последнего обновления: 2026-08-18.
Эталон протокола — «Протокол TCI, версия 2.0» Expert Electronics
(`doc/TCI Protocol_RU.pdf`, 12 января 2024). EWSDR выступает **сервером**
@@ -22,7 +22,8 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
|---|---|
| `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. |
| `TCIServer.pas` (~1250 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). |
| `TCIAdapter.pas` (~2100 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители, захват параметров (§3.5). |
| `TCIAdapter.pas` (~2600 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители, захват параметров (§3.5), подключение потоков к тапам аудио/IQ. |
| `TCIStreams.pas` (~600 строк) | Бинарные потоки (§3.4): дециматор/интерполятор, нарезка блоков с заголовком, кольцо записи линейного выхода и писатель WAV. Зависит только от RTL + `TCIProtocol`/`TCIServer`. |
Принципы те же, что у CAT (см. `doc/CAT_STATUS.md`):
@@ -103,6 +104,15 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
до `TRX`, `TUNE` и `VFO`. Своей web-странице нужен явный прокси, а не дыра
по умолчанию.
6. **Блоки потоков нарезает и раскладывает DSP-поток.** Тап зовётся прямо из
потока WDSP, поэтому в `TCIStreams` нет ни одного ожидания: блок уходит в
кольцо клиента (микросекунды под его локом), а в сокет его пишет, как и
команды, поток самого клиента. Порядок локов везде один: `FSliceLock` →
`FStreamLock` (тап сначала выясняет, чей это слайс, и только потом ищет
подписчиков) — обратный дал бы клин с потоком контроллера. Тапы навешивает
и снимает **только поток контроллера**: снятие обязано дождаться выхода
DSP-потока из вызова, иначе тот позвал бы метод освобождённого адаптера.
Разбор HTTP — построчный (`TCIHttpHeader`), а не поиском подстроки
«`upgrade: websocket`»: заголовок с табуляцией или без пробела после
двоеточия валиден. Close-кадр подтверждается ответным close с тем же кодом
@@ -119,7 +129,9 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
"tci": { "enabled": false, "port": 40001, "bind_addr": "127.0.0.1" }
```
UI — вкладка **Advanced → TCI Server** (галка, порт, интерфейс). В протоколе
UI — вкладка **CAT → TCI Server**, справа от «TCP CAT Server» (галка, порт,
интерфейс): TCI — такой же канал внешнего управления трансивером, что и CAT,
и оператор ищет его там, а не в «Advanced». В протоколе
**нет авторизации**: открытый наружу порт означает полный доступ к трансиверу,
поэтому умолчание слушает только петлю.
@@ -340,7 +352,113 @@ split, `rfMonVolume` для громкости самоконтроля и но
ручные `PushSliceFlagState`/`LayoutFlags` в MainForm) убраны: теперь один
путь на всех — мышь, колесо, CAT, TCI, бэнд-логика.
### 2.5 Телеграф (§3.2)
### 2.5 Бинарные потоки (§3.4)
Реализованы все четыре типа: `IQ_STREAM`, `RX_AUDIO_STREAM`, `LINEOUT_STREAM`
(наружу) и `TX_AUDIO_STREAM` + `TX_CHRONO` (внутрь), плюс запись линейного
выхода в файл. Команды: `IQ_START/STOP`, `AUDIO_START/STOP`,
`LINE_OUT_START/STOP`, `LINE_OUT_RECORDER_START/SAVE/BREAK` и параметры
`IQ_SAMPLERATE`, `AUDIO_SAMPLERATE`, `AUDIO_STREAM_SAMPLES/CHANNELS/SAMPLE_TYPE`,
`TX_STREAM_AUDIO_BUFFERING`.
**Откуда берётся звук.** Протокол различает «аудиопоток приёмника» и «поток
линейного выхода», и это не одно и то же:
| Поток TCI | Точка в ewsdr | Что это значит |
|---|---|---|
| `RX_AUDIO_STREAM` | `OnDemodAudioReady` (тап `rakDemod`) | выход демодулятора **до** громкости и мьюта, без сайдтона — то, что нужно скиммеру и цифре |
| `LINEOUT_STREAM` | `OnAudioReady` (тап `rakLineOut`) | ровно то, что слышно: после громкости, с сайдтоном; MUTE его глушит (движок не зовёт `OnAudio` под мьютом) |
| `IQ_STREAM` | `TWDSPEngine.PushIQItemToDSP` / `PushPanItemToDSP` | сырой IQ приёмника, один вызов тапа на накопленный блок |
Тап — многоадресный и **ничего не забирает**, в отличие от `OnAudioConsume`
(им владеет web-адаптер и им же глушит локальный звук). Иначе первый же
TCI-клиент отобрал бы звук у динамика и у браузера.
Приёмник в потоках — панадаптер, как и везде (§1.3). У доп. пана в потоках
участвует только **канал A** (первый слайс): «аудиопоток приёмника» в протоколе
один на приёмник, отдельного потока канала B нет.
**Пересчёт частоты вниз — многоступенчатый.** Аудио 48 кГц → 8/12/24 и IQ
до 48/96/192/384 кГц считает `TCIStreams`. Коэффициент раскладывается на
множители, и каждая ступень фильтрует своё: одной ступенью большие
коэффициенты не берутся, потому что длина FIR растёт вместе с коэффициентом и
упирается в потолок. ★Это не теория: на верхнем пресете Pluto (5760 кГц,
коэффициент 120 к 48 кГц) одноступенчатый дециматор давал **завал 1.3 дБ в
полосе и подавление зеркала всего 16 дБ**, то есть поток IQ с мусором.
Спецификацию фильтра каждой ступени задаёт **итоговая** полоса, а не её
собственная: ранняя ступень обязана убрать лишь те узкие зоны, которые в конце
сложатся в полезную полосу, поэтому её переходная полоса шире в десятки раз, а
фильтр во столько же короче. Свёртка идёт со сложением симметричных пар
(фильтр линейнофазовый). Замеры после переделки: −83 дБ по зеркалу на **любом**
коэффициенте, полоса ровная, цена ≈10% ядра на потоке 5.76 МГц (было 20% —
и с мусором) и ≈1% на 384 кГц.
Вверх (TX-аудио клиента → 48 кГц тракта) — линейная интерполяция: её образы
лежат за полосой TX-фильтра, а завал в полосе 0.2 дБ на 3 кГц.
**Ответ на `IQ_SAMPLERATE` называет достижимое, а не запрошенное.** Просьбу
клиента храним как есть (на другом устройстве она может стать выполнимой), а в
ответ отдаём то, что он реально получит на главном приёмнике. Подтвердить
«384000» и слать 192 кГц значило бы соврать в единственном месте, куда клиент
и смотрит. Из-за этого же `iq_samplerate` **переобъявляется без запроса** при
смене частоты дискретизации и устройства (`rfSampleRate`, `rfDevice`,
`rfConnected`) — иначе клиент, попросивший 384 кГц на openHPSDR, после
перехода на Pluto 576 кГц молча получал бы 192. По той же логике устроен и
`IF_LIMITS`: §4.1 прямо требует высылать его «при подключении и изменении
частоты дискретизации устройства», и он уходит на `rfSampleRate`.
**Какая частота IQ достанется клиенту.** Набор протокола (48/96/192/384 кГц)
и частоты дискретизации железа сходятся не всегда. У openHPSDR (48…384 кГц)
сходятся все, а из пресетов Pluto (576/768/960/1536/2304/3072/3840/5760 кГц)
на 384 не делятся 576 и 960. Поэтому отдаём **наибольшую законную** частоту,
не выше запрошенной и делящую частоту источника нацело (`TCIPickIQRate`):
на 576 и 960 кГц просьба «384» превращается в 192 кГц. Иначе клиент,
попросивший 384, получал бы поток на 576/480 кГц — и не по протоколу, и вчетверо
толще ожидаемого. Настоящая частота всегда стоит в заголовке блока; если
законной не нашлось вовсе (чужой rate), уходит ближайшая достижимая — врать
в заголовке мы не будем ни в каком случае. Смена rate устройства или DDC пана
на ходу пересобирает прореживание (`SetSourceRate`).
**Размер блока.** `AUDIO_STREAM_SAMPLES` — это сэмплы **на канал**, а в
`Stream.length` уходит, как велит §3.4, количество вещественных отсчётов
(`samples × channels`). Сходится и с умолчаниями ExpertSDR3 (2048 при 48 кГц
даёт ~43 мс), и с потолком `data[16384]`: 2048 × 2 канала × float32 = ровно
16384 байта. Смена любого параметра потока на ходу **перезапускает** уже идущие
потоки этого клиента: блок с новой частотой посреди старого потока клиенты
разбирают как мусор.
**Передача (§3.4, §4.2).** `TRX:0,true,tci` берёт модуляцию из аудиопотока
клиента — но только если у него запущен `AUDIO_START` (буквально по документу:
«работает, если включен аудиопоток по TCI»). В контроллере это отдельный флаг
`TCIMicRequested`, который `SetMOX` читает при выборе микрофона, **впереди**
web-клиента: явная просьба сильнее умолчания «подключён браузер». Дальше тик
сервера гонит маркеры `TX_CHRONO` по часам (плюс разовая подушка
`TX_STREAM_AUDIO_BUFFERING` на старте передачи), а приходящие блоки
`TX_AUDIO_STREAM` разворачиваются в 48 кГц моно и кладутся в тот же ринг
микрофона, что и web-аудио. Аудио от клиента, который не просил `tci`,
отбрасывается молча: отвечать ошибкой на каждый чужой блок значит захлебнуться.
**Запись линейного выхода.** Рекордер один на приёмник (а не на клиента):
пишет он то, что слышно в аппарате. Кольцо на запрошенное время (потолок 300 с)
в int16 48 кГц стерео — это ровно то, что уйдёт в WAV, и вдвое меньше памяти,
чем float32. `SAVE` завершает запись и отдаёт кольцо отдельному потоку-писателю:
файл бывает в десятки мегабайт, а команда пришла в потоке клиента, который в
это время не читает свой сокет. MP3 не поддержан — кодера в проекте нет,
и на `.mp3` уходит честный `tci_error`.
**Потолок кадра.** Приёмный буфер соединения (`WsClient.WS_BUF_SIZE`) поднят
с 4 до 32 КБ: блок TX-аудио — это 64 байта заголовка плюс `data[16384]`, а
кадр крупнее буфера не собирается никогда (BufLen упирается в потолок и разбор
встаёт). Кадр длиннее одного блока рвёт соединение — длиннее протокол не
определяет.
**Переполнение.** У очереди команд и у кольца блоков разная политика: команду
терять нельзя (клиент выбрасывается), блок потока — можно и нужно (теряется
самый старый, `TTCIClient.BinDropped` считает). Иначе отставший скиммер рвал бы
себе и управление тоже.
### 2.6 Телеграф (§3.2)
`CW_MACROS`, `CW_MSG`, `CW_MACROS_STOP`, `CW_TERMINAL`.
@@ -368,7 +486,7 @@ split, `rfMonVolume` для громкости самоконтроля и но
| `RX_NB_PARAM` | параметры NB в WDSP наружу не выведены |
| `RX_BALANCE` | баланса каналов у слайса нет |
| `DIGL_OFFSET`, `DIGU_OFFSET` | смещения цифровых мод не реализованы |
| `RX_CHANNEL_ENABLE` | канал B главного приёмника — это VFO B, он есть всегда; создание второго слайса на пане по TCI — этап 2 |
| `RX_CHANNEL_ENABLE` | канал B главного приёмника — это VFO B, он есть всегда; создание второго слайса на пане по TCI не делаем (см. §4) |
## 3.1 Ограничения, о которых честнее знать заранее
@@ -381,44 +499,39 @@ split, `rfMonVolume` для громкости самоконтроля и но
| Захват параметра (§3.5) | реализован для того, что клиенты действительно перетягивают (частота, DDS, мода, фильтр, TRX/TUNE/DRIVE, split, громкости, АРУ, шумодавы, squelch, скорость CW). Эхо-параметры (RIT/XIT, BIN/ANC/…) не захватываются: на радио они не влияют |
| Браузерные клиенты | отвергаются по `Origin` (403), см. §1.1. Web-интерфейсу ewsdr TCI не нужен — у него свой канал |
| `TRX_COUNT` | равен `BackendCaps.MaxPans`, а не числу живых панов: протокол объявляет его один раз. Про несуществующий приёмник просто ничего не шлётся (§2.1) |
| Потоки на передаче | RX-аудио и линейный выход на TX замолкают — движок не зовёт аудио-колбэки, пока идёт передача (кроме дуплекса с самоконтролем). То же и с IQ: RX-пакеты на TX дропаются на входе DSP. Это поведение приёмного тракта, а не потоков |
| `MUTE` и линейный выход | глушит и поток: движок под мьютом не зовёт `OnAudio`. Аудиопоток приёмника (`AUDIO_START`) мьют не трогает — он снимается до громкости |
| DIGL/DIGU, 2 канала | по §3.4 в цифровых модах два канала должны нести комплексный сигнал; у нас это обычное стерео с выхода WDSP. Комплексный вывод демодулятора наружу не выведен |
| Поток канала B доп. пана | не бывает: в протоколе аудиопоток один на приёмник, и мы отдаём канал A (первый слайс) |
| Формат IQ | всегда float32, два канала — `AUDIO_STREAM_SAMPLE_TYPE` относится к аудио (§4.3), а ExpertSDR3 IQ иначе и не шлёт |
| `IQ_SAMPLERATE` 384 кГц на Pluto 576/960 кГц | нацело не делится, поэтому уходит 192 кГц (см. §2.5). Клиент обязан читать частоту из заголовка блока, а не считать её равной запрошенной |
| MP3 у рекордера | не поддержан (кодера в проекте нет): `LINE_OUT_RECORDER_SAVE` с `.mp3` отвечает `tci_error` |
Отдельно: у `TX_SENSORS` второй аргумент — уровень микрофона; измерителя
микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не
рисовал случайные значения. Третий аргумент (RMS) и четвёртый (пик) отдаём
одинаковыми — в телеметрии платы одно значение forward power.
У `TRX` третий аргумент (источник сигнала `tci`/`mic1`/…) игнорируется:
аудио по TCI ещё нет, модуляция берётся из выбранного в программе входа.
У `TRX` третий аргумент разобран только для `tci` (см. §2.5). Значения
`mic1`/`mic2`/`micpc`/`ecoder2` называют физические входы ExpertSDR3, которых у
нас нет: они значат «микрофон, выбранный в программе», то есть ровно то же, что
и отсутствие аргумента.
---
## 4. Этап 2 — бинарные потоки (§3.4)
## 4. Что осталось
Не реализовано ничего из потоков; команды управления ими принимаются, но
данные не идут. Что нужно сделать:
Бинарные потоки (§3.4) реализованы целиком — см. §2.5. Открыто:
1. **Заголовок блока** уже описан — `TTCIStreamHeader` в `TCIProtocol.pas`
(16 × uint32 + сэмплы).
2. **`RX_AUDIO_STREAM`** — нужен multicast-тап RX-аудио в контроллере.
Сейчас есть только `OnAudioConsume` — одиночный перехват, которым владеет
веб-адаптер (он же глушит локальный звук). Для TCI нужен именно тап
«послушать, не забирая», по образцу `AddStateListener`.
3. **`TX_AUDIO_STREAM` + `TX_CHRONO`** — приём бинарных фреймов от клиента
(сейчас `TCIServer` их отбрасывает; приёмный буфер `TWsClient` — 4 КБ, под
16 КБ блоков его придётся растить) и подача в TX-тракт наравне с
веб-микрофоном (`PushMicSamples`).
4. **`IQ_STREAM`** — тап сырого IQ в `TWDSPEngine.PushIQItemToDSP` (как у
декодера маяка), с децимацией до `IQ_SAMPLERATE` (48/96/192/384 кГц).
5. **`LINEOUT_STREAM` + `LINE_OUT_RECORDER_*`** — запись в WAV/MP3.
Также в очереди: `RX_CHANNEL_ENABLE` как реальное создание/удаление второго
слайса пана и `KEYER`.
Приёмный буфер `TWsClient` — 4 КБ, и сейчас это жёсткий потолок: кадр крупнее
рвёт соединение (команд такой длины у TCI нет). Под TX-аудио его придётся
растить вместе с этапом 2.
---
1. **`RX_CHANNEL_ENABLE` как реальное создание/удаление второго слайса пана.**
Сейчас это эхо: канал B главного приёмника — VFO B, он есть всегда, а
заводить слайс по команде клиента значит отдать ему управление раскладкой
панорамы оператора.
2. **`KEYER`** — своего события «ключ нажат» у контроллера нет.
3. **TCI в демоне.** Юниты LCL-free (стенд собирает и гоняет их вместе с
`TRadioController` без единого виджета), подключается одной строкой в
`ewsdrd.lpr`, как web.
4. **Проверка на железе и с настоящим клиентом** — главное, см. конец §5.
## 5. Проверено
@@ -478,6 +591,50 @@ split, `rfMonVolume` для громкости самоконтроля и но
движков и сети валится с AV — клиент получает `tci_error`, соединение живо) и
неразрывность пачки инициализации под крутящейся ручкой.
### Стенд этапа 2 (бинарные потоки) — 112 проверок, все зелёные
Отдельная программа (`tcitest.pas` в scratchpad, собирается тем же fpc без
внешних библиотек) проверяет потоки на четырёх уровнях:
- **Формат и математика:** коэффициенты прореживания (в том числе «просят выше,
чем есть» и «нацело не делится»), умолчания размера блока, поля заголовка,
сквозная упаковка/распаковка всех четырёх форматов сэмплов и клип на
перегрузе, разбор пути с `|` вместо `:`.
- **Пересчёт частоты:** единичное усиление дециматора на постоянке, тон 1 кГц
проходит, тон 20 кГц при 48→12 кГц давится больше чем на 40 дБ (то самое
зеркало, ради которого и стоит фильтр), прозрачность при коэффициенте 1,
счёт отсчётов у интерполятора и отсутствие выбросов. Отдельно — каскад на
всех интересных коэффициентах (192→48, 384→48 у openHPSDR; 576→48, 1536→48,
5760→48 и 5760→384 у Pluto): полоса ровная, зеркало давится больше чем на
60 дБ. И выбор законной частоты IQ: 576 и 960 кГц на просьбу «384» отдают
192 кГц, 768 кГц отдаёт 384 кГц, чужой rate возвращает просьбу как есть.
- **Блок до сокета** (пара сокетов вместо сети): четыре блока RX-аудио 12 кГц
стерео float32 с верным заголовком и длиной; IQ 384→48 кГц уходит только
целым блоком (полблока не отправляется); моно int16; пересчёт после смены
rate источника; переполнение кольца теряет старые блоки, но клиент жив.
- **Рекордер и WAV:** кольцо ограничено запрошенным временем, после заворота
первым идёт самый старый отсчёт, `Take` опустошает, файл получает верные
RIFF/fmt/data и длину.
- **Команды на живом сервере** (настоящий `TRadioController`, WS-клиент на
сыром сокете): отказ на несуществующий приёмник и на нечисловой аргумент,
отказ на старт потока с незапущенного пана, подтверждение и отбраковка
параметров, `SAVE` без записи и `SAVE` в `.mp3` отвечают ошибкой,
`TRX:0,true,tci` без аудиопотока модуляцию не берёт, а с потоком берёт и
снимает её по `TRX:0,false` и по уходу клиента; чужой бинарный блок не рвёт
соединение; без передачи маркеров `TX_CHRONO` нет. Отдельно — согласование
частот: на источнике 192 кГц просьба «384» подтверждается как 192, смена
rate устройства сама переобъявляет и `iq_samplerate`, и `if_limits`, а на
576 кГц (Pluto) та же просьба даёт законные 192 кГц.
- **Сквозной прогон через живой WDSP:** синтетический 24-битный IQ подаётся
в движок, а клиент по WebSocket получает блоки RX-аудио 12 кГц и IQ 48 кГц
с верными заголовками; после `AUDIO_STOP`/`IQ_STOP` блоки прекращаются.
Передача: `TRX:0,true,tci` поднимает маркеры `TX_CHRONO`, а присланное
клиентом аудио 12 кГц доходит до конца тракта (появляются блоки TX-IQ).
Чего стенд этапа 2 не проверяет: доп. паны (для них нужен живой DDC),
одновременную работу нескольких клиентов на одном потоке и длительный прогон
(дрейф пейсинга TX_CHRONO виден только на минутах).
Чего стенд не проверяет: поведение пана без слайсов и рассылку каналов при
создании/удалении слайса — для них нужен живой DSP-движок, которого на стенде
нет. Остаётся и известное окно: показания измерителей читают `FDSPEngine` из
@@ -494,8 +651,12 @@ send просто возвращает EPIPE, и клиент выбрасыва
TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в
`ewsdrd.lpr`, как web).
★Пробная сборка стенда: `-Mobjfpc` обязателен. С `-Mdelphi` в командной строке
вложенные комментарии выключаются, и `{$MODE Delphi}` внутри шапки `WebUtils.pas`
закрывает комментарий раньше времени — компиляция падает на «illegal character».
**На реальном железе и с реальным клиентом (Log4OM/N1MM/WSJT-X/CW Skimmer) не
проверялось.**
проверялось — ни команды, ни потоки.**
Ответ на команду-установку клиент получает дважды: прямым ответом и рассылкой
из `OnState`. Это осознанно — дубли идемпотентны, а рассылка нужна для тех
ewsdr.lpi
+21 -2
View File
@@ -17,9 +17,9 @@
<UseVersionInfo Value="True"/>
<AutoIncrementBuild Value="True"/>
<MinorVersionNr Value="9"/>
<BuildNr Value="295"/>
<BuildNr Value="300"/>
</VersionInfo>
<MacroValues Count="129">
<MacroValues Count="148">
<Macro1 Name="LCLWidgetType" Value="qt6"/>
<Macro2 Name="LCLWidgetType" Value="qt6"/>
<Macro3 Name="LCLWidgetType" Value="qt6"/>
@@ -149,6 +149,25 @@
<Macro127 Name="LCLWidgetType" Value="qt6"/>
<Macro128 Name="LCLWidgetType" Value="qt6"/>
<Macro129 Name="LCLWidgetType" Value="qt6"/>
<Macro130 Name="LCLWidgetType" Value="qt6"/>
<Macro131 Name="LCLWidgetType" Value="qt6"/>
<Macro132 Name="LCLWidgetType" Value="qt6"/>
<Macro133 Name="LCLWidgetType" Value="qt6"/>
<Macro134 Name="LCLWidgetType" Value="qt6"/>
<Macro135 Name="LCLWidgetType" Value="qt6"/>
<Macro136 Name="LCLWidgetType" Value="qt6"/>
<Macro137 Name="LCLWidgetType" Value="qt6"/>
<Macro138 Name="LCLWidgetType" Value="qt6"/>
<Macro139 Name="LCLWidgetType" Value="qt6"/>
<Macro140 Name="LCLWidgetType" Value="qt6"/>
<Macro141 Name="LCLWidgetType" Value="qt6"/>
<Macro142 Name="LCLWidgetType" Value="qt6"/>
<Macro143 Name="LCLWidgetType" Value="qt6"/>
<Macro144 Name="LCLWidgetType" Value="qt6"/>
<Macro145 Name="LCLWidgetType" Value="qt6"/>
<Macro146 Name="LCLWidgetType" Value="qt6"/>
<Macro147 Name="LCLWidgetType" Value="qt6"/>
<Macro148 Name="LCLWidgetType" Value="qt6"/>
</MacroValues>
<BuildModes>
<Item Name="Debug" Default="True"/>