diff --git a/RadioController.pas b/RadioController.pas
index 5b8881f..4e086e1 100644
--- a/RadioController.pas
+++ b/RadioController.pas
@@ -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: пока шёл приём, ринг
diff --git a/SettingsForm.pas b/SettingsForm.pas
index 2e8abde..3a3e4a9 100644
--- a/SettingsForm.pas
+++ b/SettingsForm.pas
@@ -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;
// ---------------------------------------------------------------------------
diff --git a/TCIAdapter.pas b/TCIAdapter.pas
index 4370b8a..452dd21 100644
--- a/TCIAdapter.pas
+++ b/TCIAdapter.pas
@@ -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'));
diff --git a/TCIProtocol.pas b/TCIProtocol.pas
index d2d2dd3..2ed3761 100644
--- a/TCIProtocol.pas
+++ b/TCIProtocol.pas
@@ -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;
{ ═══════════════════════════════════════════════════════════════════════════
diff --git a/TCIServer.pas b/TCIServer.pas
index e2e4d74..e2c8c7b 100644
--- a/TCIServer.pas
+++ b/TCIServer.pas
@@ -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 велит закрывать, а не молча
// скармливать разбору команд.
diff --git a/TCIStreams.pas b/TCIStreams.pas
new file mode 100644
index 0000000..de81a0a
--- /dev/null
+++ b/TCIStreams.pas
@@ -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.
diff --git a/WDSPEngine.pas b/WDSPEngine.pas
index 0f34f4d..9b8546b 100644
--- a/WDSPEngine.pas
+++ b/WDSPEngine.pas
@@ -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;
diff --git a/WsClient.pas b/WsClient.pas
index 57a8f8b..eea7ac2 100644
--- a/WsClient.pas
+++ b/WsClient.pas
@@ -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.
diff --git a/doc/TCI.md b/doc/TCI.md
index 3ab8305..8661079 100644
--- a/doc/TCI.md
+++ b/doc/TCI.md
@@ -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`. Это осознанно — дубли идемпотентны, а рассылка нужна для тех
diff --git a/ewsdr.lpi b/ewsdr.lpi
index 358b700..d173129 100644
--- a/ewsdr.lpi
+++ b/ewsdr.lpi
@@ -17,9 +17,9 @@
-
+
-
+
@@ -149,6 +149,25 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+