mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-26 22:17:32 +00:00
feat(tci): этап 2 — бинарные потоки IQ/аудио, TX-аудио и запись линейного выхода
Реализованы все четыре потока §3.4 и рекордер:
• RX_AUDIO_STREAM — тап ДО громкости и мьюта (OnDemodAudioReady): скиммеру
и цифре нужен звук приёмника, а не то, что осталось после ручки;
• LINEOUT_STREAM — тап ПОСЛЕ (OnAudioReady), то есть что слышно;
• IQ_STREAM — тап сырого IQ в движке, ОДИН вызов на накопленный блок;
• TX_AUDIO_STREAM + TX_CHRONO — TRX:0,true,tci берёт модуляцию из потока
клиента (флаг TCIMicRequested впереди web в SetMOX), маркеры времени идут
из тика по часам, аудио клиента разворачивается в 48 кГц моно в тот же
ринг, что и web-микрофон;
• LINE_OUT_RECORDER_* — кольцо int16 на приёмник, WAV пишет отдельный поток.
Тапы аудио в контроллере многоадресные (AddAudioTap): слушают, ничего не
забирая, в отличие от OnAudioConsume, которым владеет web. Блоки нарезает и
раскладывает по кольцам клиентов сам DSP-поток, в сокет пишет поток клиента —
та же дисциплина, что у команд. Порядок локов везде FSliceLock → FStreamLock.
У очереди команд и кольца блоков разная политика переполнения: команду терять
нельзя, блок потока — можно (теряется самый старый).
Пересчёт частоты многоступенчатый (TCIStreams). Одноступенчатый FIR на верхнем
пресете Pluto (5760 кГц, коэффициент 120) упирался в потолок отводов и давал
завал 1.3 дБ в полосе при подавлении зеркала 16 дБ — то есть поток IQ с
мусором. Теперь коэффициент раскладывается на множители, спецификацию фильтра
каждой ступени задаёт ИТОГОВАЯ полоса, а свёртка идёт со сложением
симметричных пар: −83 дБ на любом коэффициенте, ≈10% ядра на 5.76 МГц.
Согласование частот с железом: из пресетов Pluto 576 и 960 кГц на 384 не
делятся, поэтому отдаём наибольшую ЗАКОННУЮ частоту, делящую источник нацело
(576/960 → 192 кГц). Ответ на IQ_SAMPLERATE называет достижимое, а не просьбу
клиента, и переобъявляется без запроса при смене rate и устройства.
Приёмный буфер соединения 4 → 32 КБ: блок TX-аудио это 64 байта заголовка плюс
data[16384], а кадр крупнее буфера не собирается никогда.
Настройки TCI переехали из Advanced на вкладку CAT, справа от TCP CAT Server:
это такой же канал внешнего управления трансивером.
Стенд (scratchpad, tcitest.pas): 112 проверок, все зелёные — включая сквозной
прогон через живой WDSP (синтетический IQ → блоки RX-аудио и IQ у настоящего
WS-клиента, и обратно TX-аудио клиента → блоки TX-IQ).
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
+146
-4
@@ -47,7 +47,7 @@ unit RadioController;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, Math,
|
Classes, SysUtils, Math, SyncObjs,
|
||||||
HPSDRProtocol, HPSDRNetwork, RadioBackend, PlutoBackend, IIOBindings,
|
HPSDRProtocol, HPSDRNetwork, RadioBackend, PlutoBackend, IIOBindings,
|
||||||
WDSPEngine, AudioOutput, AudioInput, BeaconDecoder, BeaconFEC, DMRDecoder,
|
WDSPEngine, AudioOutput, AudioInput, BeaconDecoder, BeaconFEC, DMRDecoder,
|
||||||
Settings, ChannelStore, FMRepeater, BoardUtils, DeviceStore, CWMorse, CWKeyer,
|
Settings, ChannelStore, FMRepeater, BoardUtils, DeviceStore, CWMorse, CWKeyer,
|
||||||
@@ -105,6 +105,19 @@ type
|
|||||||
TAudioConsumeEvent = function(const Left, Right: array of Single;
|
TAudioConsumeEvent = function(const Left, Right: array of Single;
|
||||||
Count: Integer): Boolean of object;
|
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-потока.
|
// Сырьё спектра/водопада наружу (фронтенды рисуют). Вызывается из DSP-потока.
|
||||||
TPixelDataEvent = procedure(const Pixels: array of Single; Count: Integer) of object;
|
TPixelDataEvent = procedure(const Pixels: array of Single; Count: Integer) of object;
|
||||||
|
|
||||||
@@ -230,7 +243,15 @@ type
|
|||||||
FLocalAudio: Boolean; // локальный звук (динамик/мик ПК): GUI=True, демон=False
|
FLocalAudio: Boolean; // локальный звук (динамик/мик ПК): GUI=True, демон=False
|
||||||
FOnSpectrumData: TPixelDataEvent; // сырьё спектра наружу (UI рисует FSpecView)
|
FOnSpectrumData: TPixelDataEvent; // сырьё спектра наружу (UI рисует FSpecView)
|
||||||
FOnWaterfallData: TPixelDataEvent; // сырьё водопада наружу (UI: децимация+рендер)
|
FOnWaterfallData: TPixelDataEvent; // сырьё водопада наружу (UI: децимация+рендер)
|
||||||
|
// Тапы RX-аудио (TCI-потоки). Список короткий и меняется редко, но пишет
|
||||||
|
// его поток контроллера, а читает DSP — отсюда лок: снять тап на лету
|
||||||
|
// (клиент ушёл) иначе означало бы вызов метода освобождённого объекта.
|
||||||
|
FAudioTaps: array of TRadioAudioTapEvent;
|
||||||
|
FAudioTapLock: TCriticalSection;
|
||||||
|
FAudioTapCount: LongInt; // быстрый гейт: без тапов не берём и лок
|
||||||
procedure Changed(Field: TRadioField);
|
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 если нет
|
function FindSliceIndex(Id: Integer): Integer; // -1 если нет
|
||||||
procedure OnSliceAudioReady(SliceId: Integer;
|
procedure OnSliceAudioReady(SliceId: Integer;
|
||||||
@@ -422,6 +443,8 @@ type
|
|||||||
FHWPTTStartedTX: Boolean;
|
FHWPTTStartedTX: Boolean;
|
||||||
FWebClientActive: Boolean; // выставляет web-слой (connect/disconnect клиента)
|
FWebClientActive: Boolean; // выставляет web-слой (connect/disconnect клиента)
|
||||||
FWebMicActive: Boolean; // True если текущий TX идёт через txmsWeb
|
FWebMicActive: Boolean; // True если текущий TX идёт через txmsWeb
|
||||||
|
FTCIMicRequested: Boolean; // TCI-клиент попросил TRX:…,tci
|
||||||
|
FTCIMicActive: Boolean; // True если текущий TX модулируется из TCI
|
||||||
FSendAudioToRadio: Boolean;
|
FSendAudioToRadio: Boolean;
|
||||||
FAudioOutDevName: string;
|
FAudioOutDevName: string;
|
||||||
FAudioInDevName: string;
|
FAudioInDevName: string;
|
||||||
@@ -1233,9 +1256,27 @@ type
|
|||||||
property OnAfterTune: TThreadMethod read FOnAfterTune write FOnAfterTune;
|
property OnAfterTune: TThreadMethod read FOnAfterTune write FOnAfterTune;
|
||||||
property OnBeforeStop: TThreadMethod read FOnBeforeStop write FOnBeforeStop;
|
property OnBeforeStop: TThreadMethod read FOnBeforeStop write FOnBeforeStop;
|
||||||
property OnAudioConsume: TAudioConsumeEvent read FOnAudioConsume write FOnAudioConsume;
|
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: аудио
|
// Локальный звук ПК (динамик RX / микрофон TX). Демон ставит False: аудио
|
||||||
// только через web (OnAudioConsume), локальная звуковая карта не трогается.
|
// только через web (OnAudioConsume), локальная звуковая карта не трогается.
|
||||||
property LocalAudioEnabled: Boolean read FLocalAudio write FLocalAudio;
|
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 OnSpectrumData: TPixelDataEvent read FOnSpectrumData write FOnSpectrumData;
|
||||||
property OnWaterfallData: TPixelDataEvent read FOnWaterfallData write FOnWaterfallData;
|
property OnWaterfallData: TPixelDataEvent read FOnWaterfallData write FOnWaterfallData;
|
||||||
end;
|
end;
|
||||||
@@ -1307,6 +1348,8 @@ begin
|
|||||||
inherited Create;
|
inherited Create;
|
||||||
FSettings := TSettingsManager.Create; // владелец настроек (GUI и демон)
|
FSettings := TSettingsManager.Create; // владелец настроек (GUI и демон)
|
||||||
FDeviceStore := TDeviceStore.Create; // общий список устройств (desktop+web)
|
FDeviceStore := TDeviceStore.Create; // общий список устройств (desktop+web)
|
||||||
|
FAudioTapLock := TCriticalSection.Create;
|
||||||
|
FAudioTapCount := 0;
|
||||||
// Дефолты (дублируют TMainForm.FormCreate; в GUI перезапишутся, в демоне нужны).
|
// Дефолты (дублируют TMainForm.FormCreate; в GUI перезапишутся, в демоне нужны).
|
||||||
FVfoA := 14200000; FVfoB := 7100000; FActiveVfo := 0;
|
FVfoA := 14200000; FVfoB := 7100000; FActiveVfo := 0;
|
||||||
FMode := MODE_USB; FFilter := 5;
|
FMode := MODE_USB; FFilter := 5;
|
||||||
@@ -1471,6 +1514,8 @@ begin
|
|||||||
if Assigned(FCWDec) then FreeAndNil(FCWDec);
|
if Assigned(FCWDec) then FreeAndNil(FCWDec);
|
||||||
FreeAndNil(FDeviceStore);
|
FreeAndNil(FDeviceStore);
|
||||||
FreeAndNil(FSettings);
|
FreeAndNil(FSettings);
|
||||||
|
// Лок тапов — последним: до FreeEngines по нему ходит DSP-поток.
|
||||||
|
FreeAndNil(FAudioTapLock);
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -1489,6 +1534,75 @@ begin
|
|||||||
FStateListeners[High(FStateListeners)] := L;
|
FStateListeners[High(FStateListeners)] := L;
|
||||||
end;
|
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);
|
procedure TRadioController.RemoveStateListener(L: TRadioStateEvent);
|
||||||
var i, j: Integer;
|
var i, j: Integer;
|
||||||
begin
|
begin
|
||||||
@@ -1831,6 +1945,10 @@ begin
|
|||||||
begin
|
begin
|
||||||
if FSendAudioToRadio then
|
if FSendAudioToRadio then
|
||||||
FNetwork.SendSpeakerAudio(FCWSTBufL, FCWSTBufR, Count);
|
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
|
if Assigned(FOnAudioConsume) and FOnAudioConsume(FCWSTBufL, FCWSTBufR, Count) then
|
||||||
Exit;
|
Exit;
|
||||||
if FLocalAudio then
|
if FLocalAudio then
|
||||||
@@ -1840,6 +1958,7 @@ begin
|
|||||||
|
|
||||||
if FSendAudioToRadio then
|
if FSendAudioToRadio then
|
||||||
FNetwork.SendSpeakerAudio(Left, Right, Count);
|
FNetwork.SendSpeakerAudio(Left, Right, Count);
|
||||||
|
FireAudioTap(rakLineOut, 0, 0, Left, Right, Count);
|
||||||
if Assigned(FOnAudioConsume) and FOnAudioConsume(Left, Right, Count) then
|
if Assigned(FOnAudioConsume) and FOnAudioConsume(Left, Right, Count) then
|
||||||
Exit;
|
Exit;
|
||||||
// Без локального звука (демон) на этом маршрут заканчивается: если web-клиент
|
// Без локального звука (демон) на этом маршрут заканчивается: если web-клиент
|
||||||
@@ -1852,6 +1971,10 @@ procedure TRadioController.OnDemodAudioReady(const Left, Right: array of Single;
|
|||||||
Count: Integer);
|
Count: Integer);
|
||||||
// DSP thread, pre-volume/pre-mute. FeedAudio only copies into a bounded ring.
|
// DSP thread, pre-volume/pre-mute. FeedAudio only copies into a bounded ring.
|
||||||
begin
|
begin
|
||||||
|
// Аудиопоток приёмника для TCI (§3.4) — именно отсюда: скиммеру и цифре
|
||||||
|
// нужен звук приёмника, а не то, что осталось после ручки громкости и
|
||||||
|
// мьюта. Линейный выход у TCI отдельным потоком (см. OnAudioReady).
|
||||||
|
FireAudioTap(rakDemod, 0, 0, Left, Right, Count);
|
||||||
if FMode = MODE_DMR then
|
if FMode = MODE_DMR then
|
||||||
begin
|
begin
|
||||||
if not Assigned(FDMRDec) then Exit;
|
if not Assigned(FDMRDec) then Exit;
|
||||||
@@ -1905,6 +2028,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
if FSendAudioToRadio and Assigned(FNetwork) then
|
if FSendAudioToRadio and Assigned(FNetwork) then
|
||||||
FNetwork.SendSpeakerAudio(Left, Right, OutPos);
|
FNetwork.SendSpeakerAudio(Left, Right, OutPos);
|
||||||
|
FireAudioTap(rakLineOut, 0, 0, Left, Right, OutPos);
|
||||||
if Assigned(FOnAudioConsume) and FOnAudioConsume(Left, Right, OutPos) then Exit;
|
if Assigned(FOnAudioConsume) and FOnAudioConsume(Left, Right, OutPos) then Exit;
|
||||||
if FLocalAudio and Assigned(FAudioOut) then FAudioOut.Write(Left, Right, OutPos);
|
if FLocalAudio and Assigned(FAudioOut) then FAudioOut.Write(Left, Right, OutPos);
|
||||||
end;
|
end;
|
||||||
@@ -1927,9 +2051,12 @@ procedure TRadioController.OnSliceAudioReady(SliceId: Integer;
|
|||||||
const Left, Right: array of Single; Count: Integer);
|
const Left, Right: array of Single; Count: Integer);
|
||||||
var idx: Integer;
|
var idx: Integer;
|
||||||
begin
|
begin
|
||||||
if not FLocalAudio then Exit;
|
|
||||||
idx := FindSliceIndex(SliceId);
|
idx := FindSliceIndex(SliceId);
|
||||||
if idx < 0 then Exit;
|
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 FSlices[idx].Mode in [MODE_DMR, MODE_FMRAW] then Exit;
|
||||||
if SliceMutedByTx(idx) then Exit;
|
if SliceMutedByTx(idx) then Exit;
|
||||||
if FSlices[idx].Audio <> nil then
|
if FSlices[idx].Audio <> nil then
|
||||||
@@ -1952,6 +2079,7 @@ var idx: Integer;
|
|||||||
begin
|
begin
|
||||||
idx := FindSliceIndex(SliceId);
|
idx := FindSliceIndex(SliceId);
|
||||||
if idx < 0 then Exit;
|
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
|
if (FSlices[idx].Mode = MODE_DMR) and Assigned(FSlices[idx].DMR) then
|
||||||
FSlices[idx].DMR.FeedAudio(Left, Right, Count);
|
FSlices[idx].DMR.FeedAudio(Left, Right, Count);
|
||||||
if (FSlices[idx].Mode = MODE_FMRAW) and FLocalAudio and
|
if (FSlices[idx].Mode = MODE_FMRAW) and FLocalAudio and
|
||||||
@@ -2594,7 +2722,11 @@ begin
|
|||||||
FDSPEngine.SetTXMode(ActiveTXMode);
|
FDSPEngine.SetTXMode(ActiveTXMode);
|
||||||
if (Mode = MODE_FMRAW) or (OldMode = MODE_FMRAW) then
|
if (Mode = MODE_FMRAW) or (OldMode = MODE_FMRAW) then
|
||||||
begin
|
begin
|
||||||
if Mode = MODE_FMRAW then FWebMicActive := False;
|
if Mode = MODE_FMRAW then
|
||||||
|
begin
|
||||||
|
FWebMicActive := False;
|
||||||
|
FTCIMicActive := False;
|
||||||
|
end;
|
||||||
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
||||||
if Assigned(ActiveMicInput) and ActiveMicInput.IsOpen then
|
if Assigned(ActiveMicInput) and ActiveMicInput.IsOpen then
|
||||||
ActiveMicInput.Flush;
|
ActiveMicInput.Flush;
|
||||||
@@ -4602,6 +4734,7 @@ begin
|
|||||||
if FTransmitting and (ActiveTXMode = MODE_FMRAW) then
|
if FTransmitting and (ActiveTXMode = MODE_FMRAW) then
|
||||||
begin
|
begin
|
||||||
FWebMicActive := False;
|
FWebMicActive := False;
|
||||||
|
FTCIMicActive := False;
|
||||||
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
||||||
if Assigned(ActiveMicInput) and ActiveMicInput.IsOpen then
|
if Assigned(ActiveMicInput) and ActiveMicInput.IsOpen then
|
||||||
ActiveMicInput.Flush;
|
ActiveMicInput.Flush;
|
||||||
@@ -6131,6 +6264,14 @@ begin
|
|||||||
begin
|
begin
|
||||||
if ActiveTXMode = MODE_FMRAW then
|
if ActiveTXMode = MODE_FMRAW then
|
||||||
FDSPEngine.SetTXMicSource(DefaultMicSource)
|
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
|
else if FWebClientActive then
|
||||||
begin
|
begin
|
||||||
FWebMicActive := True;
|
FWebMicActive := True;
|
||||||
@@ -6141,9 +6282,10 @@ begin
|
|||||||
else
|
else
|
||||||
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
||||||
end
|
end
|
||||||
else if FWebMicActive then
|
else if FWebMicActive or FTCIMicActive then
|
||||||
begin
|
begin
|
||||||
FWebMicActive := False;
|
FWebMicActive := False;
|
||||||
|
FTCIMicActive := False;
|
||||||
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
FDSPEngine.SetTXMicSource(DefaultMicSource);
|
||||||
end;
|
end;
|
||||||
// Сброс бэклога sound-card микрофона на RX→TX: пока шёл приём, ринг
|
// Сброс бэклога sound-card микрофона на RX→TX: пока шёл приём, ринг
|
||||||
|
|||||||
+61
-53
@@ -3457,55 +3457,8 @@ begin
|
|||||||
GRP_PAD + LBL_W + 12, Y + ROW_H - 8, 320);
|
GRP_PAD + LBL_W + 12, Y + ROW_H - 8, 320);
|
||||||
Lbl.Font.Size := 8;
|
Lbl.Font.Size := 8;
|
||||||
|
|
||||||
// ── TCI Server ────────────────────────────────────────────────────────────
|
// TCI Server живёт на вкладке CAT (см. BuildCATTab): это такой же канал
|
||||||
// Протокол Expert Electronics поверх WebSocket: логгеры, скиммеры, цифра.
|
// внешнего управления трансивером, что и CAT, и оператор ищет его там.
|
||||||
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;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSettingsForm.BuildDXClusterTab;
|
procedure TSettingsForm.BuildDXClusterTab;
|
||||||
@@ -4639,6 +4592,8 @@ const
|
|||||||
EDT_W = 160;
|
EDT_W = 160;
|
||||||
R1 = 42;
|
R1 = 42;
|
||||||
STEP = 32;
|
STEP = 32;
|
||||||
|
// Высота сетевых карточек (TCP CAT и TCI) — общая: стоят они в одной строке.
|
||||||
|
NET_GRP_H = 176;
|
||||||
var
|
var
|
||||||
i, col, row, gx, gy, j: Integer;
|
i, col, row, gx, gy, j: Integer;
|
||||||
Grp: TPanel;
|
Grp: TPanel;
|
||||||
@@ -4646,9 +4601,10 @@ var
|
|||||||
Ed: TFlatEdit;
|
Ed: TFlatEdit;
|
||||||
Cmb: TFlatComboBox;
|
Cmb: TFlatComboBox;
|
||||||
Spin: TFlatSpinEdit;
|
Spin: TFlatSpinEdit;
|
||||||
|
Lbl: TLabel;
|
||||||
begin
|
begin
|
||||||
MakePageHeader(FPageCAT, 'CAT',
|
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
|
for i := 0 to 3 do
|
||||||
begin
|
begin
|
||||||
@@ -4727,10 +4683,12 @@ begin
|
|||||||
FCATSerialAndromeda[i] := Chk;
|
FCATSerialAndromeda[i] := Chk;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// TCP server group below the two rows of serial port panels
|
// Два сетевых канала управления — рядом, одной строкой под последовательными
|
||||||
|
// портами: TCP CAT слева, TCI справа. Высота у обоих одна, иначе нижняя
|
||||||
|
// кромка страницы получается рваной.
|
||||||
gy := 86 + 2 * (GRP_H + GRP_GAP);
|
gy := 86 + 2 * (GRP_H + GRP_GAP);
|
||||||
Grp := MakeGroupPanel(FPageCAT, 'TCP CAT Server', MARGIN, gy, GRP_W * 2 + GRP_GAP, 116);
|
Grp := MakeGroupPanel(FPageCAT, 'TCP CAT Server', MARGIN, gy, GRP_W, NET_GRP_H);
|
||||||
Grp.Tag := TAG_RESPONSIVE_CARD;
|
Grp.Tag := TAG_RESPONSIVE_HALF_LEFT;
|
||||||
|
|
||||||
FCATTcpEn := TFlatCheckBox.Create(Self);
|
FCATTcpEn := TFlatCheckBox.Create(Self);
|
||||||
FCATTcpEn.Parent := Grp;
|
FCATTcpEn.Parent := Grp;
|
||||||
@@ -4750,6 +4708,56 @@ begin
|
|||||||
Spin.Value := 19090;
|
Spin.Value := 19090;
|
||||||
Spin.OnChange := OnCATTcpChange;
|
Spin.OnChange := OnCATTcpChange;
|
||||||
FCATTcpPort := Spin;
|
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;
|
end;
|
||||||
|
|
||||||
// ---------------------------------------------------------------------------
|
// ---------------------------------------------------------------------------
|
||||||
|
|||||||
+783
-26
@@ -27,8 +27,11 @@ unit TCIAdapter;
|
|||||||
так синхронизация между несколькими клиентами остаётся честной, а поведение
|
так синхронизация между несколькими клиентами остаётся честной, а поведение
|
||||||
радио не выдумывается. Всё такое помечено «эхо» и перечислено в doc/TCI.md.
|
радио не выдумывается. Всё такое помечено «эхо» и перечислено в doc/TCI.md.
|
||||||
|
|
||||||
Потоки IQ/аудио (§3.4) — следующий этап: команды управления потоками
|
Бинарные потоки (§3.4) живут в TCIStreams; здесь — только их подключение к
|
||||||
принимаются и подтверждаются, но сами потоки не идут.
|
контроллеру: тап RX-аудио (два вида: до громкости — «аудиопоток приёмника»,
|
||||||
|
после неё — «линейный выход»), тап сырого IQ в движке, приём TX-аудио от
|
||||||
|
клиента и маркеры TX_CHRONO. Данные перемалывает DSP-поток, поэтому вся
|
||||||
|
работа с потоками — под FStreamLock и без единого ожидания.
|
||||||
}
|
}
|
||||||
|
|
||||||
{$IFDEF FPC}
|
{$IFDEF FPC}
|
||||||
@@ -41,10 +44,16 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes, SysUtils, DateUtils, Math, SyncObjs,
|
Classes, SysUtils, DateUtils, Math, SyncObjs,
|
||||||
RadioController, RadioBackend, WDSPEngine, Settings,
|
RadioController, RadioBackend, WDSPEngine, Settings,
|
||||||
DXSpotStore, TCIProtocol, TCIServer;
|
DXSpotStore, TCIProtocol, TCIServer, TCIStreams;
|
||||||
|
|
||||||
const
|
const
|
||||||
TCI_MAX_RX = MAX_PANS; // приёмник TCI = панадаптер
|
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): пока владелец его крутит, остальные
|
// Захват параметра клиентом (§3.5): пока владелец его крутит, остальные
|
||||||
// могут только слушать. Без этого два логгера перетягивают частоту друг у
|
// могут только слушать. Без этого два логгера перетягивают частоту друг у
|
||||||
// друга бесконечно.
|
// друга бесконечно.
|
||||||
@@ -120,6 +129,31 @@ type
|
|||||||
FHolds: array[0..TCI_HOLD_SLOTS-1] of TTCIHold;
|
FHolds: array[0..TCI_HOLD_SLOTS-1] of TTCIHold;
|
||||||
FHoldCount: Integer;
|
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 (поток контроллера)
|
FLastLimLo: Double; // последние разосланные VFO_LIMITS (поток контроллера)
|
||||||
FLastLimHi: Double;
|
FLastLimHi: Double;
|
||||||
@@ -134,6 +168,7 @@ type
|
|||||||
FsInt2: Integer;
|
FsInt2: Integer;
|
||||||
FsInt3: Integer;
|
FsInt3: Integer;
|
||||||
FsBool: Boolean;
|
FsBool: Boolean;
|
||||||
|
FsBool2: Boolean;
|
||||||
FsStr: string;
|
FsStr: string;
|
||||||
|
|
||||||
// ── Sync-методы (поток контроллера) ──
|
// ── Sync-методы (поток контроллера) ──
|
||||||
@@ -166,6 +201,30 @@ type
|
|||||||
procedure SyncCWSend;
|
procedure SyncCWSend;
|
||||||
procedure SyncCWStop;
|
procedure SyncCWStop;
|
||||||
procedure SyncFocus;
|
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;
|
function CanInvoke: Boolean;
|
||||||
@@ -307,8 +366,16 @@ begin
|
|||||||
FHoldLock := TCriticalSection.Create;
|
FHoldLock := TCriticalSection.Create;
|
||||||
FHoldCount := 0;
|
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 := TTCIServer.Create;
|
||||||
FServer.OnCommand := HandleCommand;
|
FServer.OnCommand := HandleCommand;
|
||||||
|
FServer.OnBinary := HandleBinary;
|
||||||
FServer.OnConnect := HandleConnect;
|
FServer.OnConnect := HandleConnect;
|
||||||
FServer.OnDisconnect := HandleDisconnect;
|
FServer.OnDisconnect := HandleDisconnect;
|
||||||
FServer.OnTick := HandleTick;
|
FServer.OnTick := HandleTick;
|
||||||
@@ -326,18 +393,25 @@ end;
|
|||||||
destructor TTCIAdapter.Destroy;
|
destructor TTCIAdapter.Destroy;
|
||||||
begin
|
begin
|
||||||
// Сначала отписка: контроллер живёт дольше адаптера, и Changed() после
|
// Сначала отписка: контроллер живёт дольше адаптера, и Changed() после
|
||||||
// нашей смерти позвал бы метод освобождённого объекта.
|
// нашей смерти позвал бы метод освобождённого объекта. По той же причине
|
||||||
|
// ПЕРВЫМИ снимаем тапы аудио/IQ — их зовёт DSP-поток, который переживёт нас.
|
||||||
|
SetTaps(False);
|
||||||
if FController <> nil then FController.RemoveStateListener(OnState);
|
if FController <> nil then FController.RemoveStateListener(OnState);
|
||||||
if FServer <> nil then
|
if FServer <> nil then
|
||||||
begin
|
begin
|
||||||
FServer.Stop;
|
FServer.Stop;
|
||||||
FreeAndNil(FServer);
|
FreeAndNil(FServer);
|
||||||
end;
|
end;
|
||||||
|
// Потоки — уже после остановки сервера: их объекты ссылаются на клиентов.
|
||||||
|
StopAllStreams;
|
||||||
|
FreeAndNil(FTxInterp);
|
||||||
FLock.Free;
|
FLock.Free;
|
||||||
FEchoLock.Free;
|
FEchoLock.Free;
|
||||||
FDevLock.Free;
|
FDevLock.Free;
|
||||||
FSliceLock.Free;
|
FSliceLock.Free;
|
||||||
FHoldLock.Free;
|
FHoldLock.Free;
|
||||||
|
FStreamLock.Free;
|
||||||
|
FTxLock.Free;
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -359,6 +433,10 @@ begin
|
|||||||
|
|
||||||
OldPort := FServer.Port;
|
OldPort := FServer.Port;
|
||||||
FServer.Stop;
|
FServer.Stop;
|
||||||
|
// Сервер остановлен — клиентов больше нет, значит и потоки чужие: снимаем
|
||||||
|
// тапы, иначе DSP-поток продолжал бы носить аудио в никуда.
|
||||||
|
StopAllStreams;
|
||||||
|
SetTaps(False);
|
||||||
if not T.Enabled then
|
if not T.Enabled then
|
||||||
begin
|
begin
|
||||||
FCfg := T;
|
FCfg := T;
|
||||||
@@ -369,11 +447,13 @@ begin
|
|||||||
if Result then
|
if Result then
|
||||||
begin
|
begin
|
||||||
FCfg := T;
|
FCfg := T;
|
||||||
|
SetTaps(True);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
// Порт занят (или отобран правами) — поднимаем то, что работало.
|
// Порт занят (или отобран правами) — поднимаем то, что работало.
|
||||||
if FCfg.Enabled and TTCIServer.ValidSettings(OldPort, FCfg.BindAddr) then
|
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;
|
end;
|
||||||
|
|
||||||
function TTCIAdapter.CanInvoke: Boolean;
|
function TTCIAdapter.CanInvoke: Boolean;
|
||||||
@@ -577,6 +657,10 @@ procedure TTCIAdapter.PushChannelMap;
|
|||||||
// полную картину каждого живого приёмника — клиент перезаливает её целиком.
|
// полную картину каждого живого приёмника — клиент перезаливает её целиком.
|
||||||
var Rx, Ch, N: Integer;
|
var Rx, Ch, N: Integer;
|
||||||
begin
|
begin
|
||||||
|
// Потоки пропавших приёмников гасим ВСЕГДА, даже если рассылать некому:
|
||||||
|
// объект потока пережил бы свой пан и молча копил тишину, а клиент ждал бы
|
||||||
|
// блоков, которых больше не будет.
|
||||||
|
DropDeadRxStreams;
|
||||||
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
if (FServer = nil) or (FServer.ClientCount = 0) then Exit;
|
||||||
for Rx := 1 to RxCount - 1 do
|
for Rx := 1 to RxCount - 1 do
|
||||||
begin
|
begin
|
||||||
@@ -1168,9 +1252,13 @@ end;
|
|||||||
|
|
||||||
procedure TTCIAdapter.HandleDisconnect(Client: TTCIClient);
|
procedure TTCIAdapter.HandleDisconnect(Client: TTCIClient);
|
||||||
// Клиент ушёл — снимаем его захваты параметров, иначе следующий, кому достанется
|
// Клиент ушёл — снимаем его захваты параметров, иначе следующий, кому достанется
|
||||||
// тот же адрес объекта, унаследовал бы чужие права (§3.5).
|
// тот же адрес объекта, унаследовал бы чужие права (§3.5). По той же причине
|
||||||
|
// гасим его потоки: объект клиента вот-вот освободят, а на него смотрит
|
||||||
|
// DSP-поток. Порядок обязателен — сначала потоки, потом возврат в сервер.
|
||||||
begin
|
begin
|
||||||
DropHolds(Client);
|
DropHolds(Client);
|
||||||
|
DropClientStreams(Client);
|
||||||
|
ClearTxClient(Client);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ ═══════════════════════════════════════════════════════════════════════════
|
{ ═══════════════════════════════════════════════════════════════════════════
|
||||||
@@ -1224,9 +1312,28 @@ end;
|
|||||||
|
|
||||||
procedure TTCIAdapter.SyncSetTRX;
|
procedure TTCIAdapter.SyncSetTRX;
|
||||||
begin
|
begin
|
||||||
|
// Источник модуляции ставим ДО SetMOX — именно он его и читает при выборе
|
||||||
|
// микрофона. Выключение передачи флаг снимает всегда: следующий раз оператор
|
||||||
|
// может нажать PTT сам, и тогда в эфир должен идти его микрофон.
|
||||||
|
FController.TCIMicRequested := FsBool and FsBool2;
|
||||||
FController.SetMOX(FsBool);
|
FController.SetMOX(FsBool);
|
||||||
end;
|
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;
|
procedure TTCIAdapter.SyncSetTune;
|
||||||
begin
|
begin
|
||||||
FController.SetTune(FsBool);
|
FController.SetTune(FsBool);
|
||||||
@@ -1557,7 +1664,7 @@ procedure TTCIAdapter.DispatchCommand(Client: TTCIClient; const M: TTCIMessage);
|
|||||||
var
|
var
|
||||||
Rx, Ch, V: Integer;
|
Rx, Ch, V: Integer;
|
||||||
Lo, Hi: Integer;
|
Lo, Hi: Integer;
|
||||||
B: Boolean;
|
B, FromTCI: Boolean;
|
||||||
D: Double;
|
D: Double;
|
||||||
Name: string;
|
Name: string;
|
||||||
begin
|
begin
|
||||||
@@ -1642,13 +1749,26 @@ begin
|
|||||||
// ── Передача ──
|
// ── Передача ──
|
||||||
if M.Name = 'TRX' then
|
if M.Name = 'TRX' then
|
||||||
begin
|
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
|
if TCITryArgBool(M, 1, B) and Claim(HoldKey('TRX', 0, 0), Client) then
|
||||||
begin
|
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;
|
FLock.Enter;
|
||||||
try
|
try
|
||||||
FsBool := B;
|
FsBool := B;
|
||||||
|
FsBool2 := FromTCI;
|
||||||
if CanInvoke then FController.Invoke(SyncSetTRX);
|
if CanInvoke then FController.Invoke(SyncSetTRX);
|
||||||
finally FLock.Leave; end;
|
finally FLock.Leave; end;
|
||||||
end;
|
end;
|
||||||
@@ -2188,37 +2308,75 @@ begin
|
|||||||
// Это настройки КЛИЕНТА (§4.3), а не устройства: два логгера вправе просить
|
// Это настройки КЛИЕНТА (§4.3), а не устройства: два логгера вправе просить
|
||||||
// разную частоту дискретизации. Поэтому живут в его объекте, а не в адаптере
|
// разную частоту дискретизации. Поэтому живут в его объекте, а не в адаптере
|
||||||
// — иначе один клиент перенастраивал бы будущие потоки всем остальным.
|
// — иначе один клиент перенастраивал бы будущие потоки всем остальным.
|
||||||
// Сами потоки — этап 2, значения только принимаются и подтверждаются.
|
// Изменение параметра на ходу перезапускает уже идущие потоки этого клиента:
|
||||||
|
// блок с новой частотой посреди старого потока клиенты разбирают как мусор.
|
||||||
if M.Name = 'IQ_SAMPLERATE' then
|
if M.Name = 'IQ_SAMPLERATE' then
|
||||||
begin
|
begin
|
||||||
// Набор частот оговорён протоколом; чужое значение отвергаем, а в ответе
|
// Набор частот оговорён протоколом; чужое значение отвергаем, а в ответе
|
||||||
// отдаём действующее — клиент увидит, что его не приняли.
|
// отдаём действующее — клиент увидит, что его не приняли.
|
||||||
if TCITryArgInt(M, 0, V) and TCIValidIQRate(V) then Client.IQRate := V;
|
if TCITryArgInt(M, 0, V) and TCIValidIQRate(V) and (V <> Client.IQRate) then
|
||||||
Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)]));
|
begin
|
||||||
|
Client.IQRate := V;
|
||||||
|
RestartStreams(Client, tstIQ);
|
||||||
|
end;
|
||||||
|
// ★В ответе — та частота, которую клиент РЕАЛЬНО получит, а не его
|
||||||
|
// просьба: на 576 и 960 кГц Pluto просьба «384» невыполнима (не делится
|
||||||
|
// нацело), и подтвердить её значило бы соврать. Сама просьба остаётся
|
||||||
|
// сохранённой — на другом устройстве она может стать выполнимой.
|
||||||
|
Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(EffIQRate(Client))]));
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if M.Name = 'AUDIO_SAMPLERATE' then
|
if M.Name = 'AUDIO_SAMPLERATE' then
|
||||||
begin
|
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)]));
|
Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)]));
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if M.Name = 'AUDIO_STREAM_SAMPLES' then
|
if M.Name = 'AUDIO_STREAM_SAMPLES' then
|
||||||
begin
|
begin
|
||||||
if TCITryArgInt(M, 0, V) then
|
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;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if M.Name = 'AUDIO_STREAM_CHANNELS' then
|
if M.Name = 'AUDIO_STREAM_CHANNELS' then
|
||||||
begin
|
begin
|
||||||
if TCITryArgInt(M, 0, V) then
|
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;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then
|
if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then
|
||||||
begin
|
begin
|
||||||
Name := LowerCase(Trim(TCIArg(M, 0)));
|
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;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then
|
if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then
|
||||||
@@ -2228,17 +2386,19 @@ begin
|
|||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// Запуск потоков (§3.4) — этап 2. Молчать нельзя: клиент решил бы, что поток
|
// ── Запуск и остановка потоков (§3.4) ──
|
||||||
// пошёл, и ждал бы данных бесконечно. Отвечаем ошибкой на конкретную команду.
|
|
||||||
if (M.Name = 'IQ_START') or (M.Name = 'IQ_STOP') or
|
if (M.Name = 'IQ_START') or (M.Name = 'IQ_STOP') or
|
||||||
(M.Name = 'AUDIO_START') or (M.Name = 'AUDIO_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_START') or (M.Name = 'LINE_OUT_STOP') then
|
||||||
(M.Name = 'LINE_OUT_RECORDER_START') or
|
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_SAVE') or
|
||||||
(M.Name = 'LINE_OUT_RECORDER_BREAK') then
|
(M.Name = 'LINE_OUT_RECORDER_BREAK') then
|
||||||
begin
|
begin
|
||||||
Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name),
|
CmdRecorder(Client, M);
|
||||||
'binary streams are not implemented']));
|
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -2291,11 +2451,594 @@ begin
|
|||||||
// измерители у ВСЕХ клиентов до перезапуска сервера.
|
// измерители у ВСЕХ клиентов до перезапуска сервера.
|
||||||
try
|
try
|
||||||
FServer.EnumClients(PushSensors);
|
FServer.EnumClients(PushSensors);
|
||||||
|
PushTxChrono;
|
||||||
except
|
except
|
||||||
// молча: следующий тик через 20 мс попробует снова
|
// молча: следующий тик через 20 мс попробует снова
|
||||||
end;
|
end;
|
||||||
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
|
if Field in [rfDevice, rfConnected, rfDeviceList, rfXvtr, rfBand, rfSampleRate] then
|
||||||
RefreshDev;
|
RefreshDev;
|
||||||
|
// Пан могли убрать и без правки слайсов — тогда сигнатура карты не менялась,
|
||||||
|
// а поток остался бы висеть на несуществующем приёмнике.
|
||||||
|
if Field in [rfDevice, rfConnected] then DropDeadRxStreams;
|
||||||
|
|
||||||
MapChanged := False;
|
MapChanged := False;
|
||||||
if Field in [rfSliceFreq, rfSliceState, rfDevice, rfPanFreq, rfSampleRate,
|
if Field in [rfSliceFreq, rfSliceState, rfDevice, rfPanFreq, rfSampleRate,
|
||||||
@@ -2401,9 +3147,20 @@ begin
|
|||||||
FServer.Broadcast(StrIf(0, 1));
|
FServer.Broadcast(StrIf(0, 1));
|
||||||
end;
|
end;
|
||||||
rfSampleRate:
|
rfSampleRate:
|
||||||
FServer.Broadcast(TCIBuild('if_limits',
|
begin
|
||||||
[TCIIntStr(-(FController.FSampleRate div 2)),
|
FServer.Broadcast(TCIBuild('if_limits',
|
||||||
TCIIntStr(FController.FSampleRate div 2)]));
|
[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:
|
rfRunning:
|
||||||
if FController.FRunning then FServer.Broadcast(TCIBuild('start'))
|
if FController.FRunning then FServer.Broadcast(TCIBuild('start'))
|
||||||
else FServer.Broadcast(TCIBuild('stop'));
|
else FServer.Broadcast(TCIBuild('stop'));
|
||||||
|
|||||||
+205
-5
@@ -42,6 +42,23 @@ const
|
|||||||
TCI_MODULATIONS = 'am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw';
|
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_VOL_MIN_DB = -60; TCI_VOL_MAX_DB = 0;
|
||||||
TCI_SQL_MIN_DB = -140; TCI_SQL_MAX_DB = 0;
|
TCI_SQL_MIN_DB = -140; TCI_SQL_MAX_DB = 0;
|
||||||
TCI_AGC_MIN_DB = -20; TCI_AGC_MAX_DB = 120;
|
TCI_AGC_MIN_DB = -20; TCI_AGC_MAX_DB = 120;
|
||||||
@@ -59,8 +76,7 @@ type
|
|||||||
ArgCount: Integer;
|
ArgCount: Integer;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ Тип бинарного потока (§3.4). Потоки — следующий этап (см. doc/TCI.md),
|
{ Тип бинарного потока (§3.4). }
|
||||||
но формат протокольный, поэтому объявлен здесь, а не в транспорте. }
|
|
||||||
TTCIStreamType = (tstIQ, tstRXAudio, tstTXAudio, tstTXChrono, tstLineOut);
|
TTCIStreamType = (tstIQ, tstRXAudio, tstTXAudio, tstTXChrono, tstLineOut);
|
||||||
TTCISampleType = (tsyInt16, tsyInt24, tsyInt32, tsyFloat32);
|
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 TCIValidAudioRate(V: Integer): Boolean; // 8/12/24/48 кГц
|
||||||
function TCIValidSampleType(const S: string): Boolean; // int16/int24/int32/float32
|
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;
|
function TCIBuild(const Name: string): string; overload;
|
||||||
@@ -284,10 +329,165 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function TCIValidSampleType(const S: string): Boolean;
|
function TCIValidSampleType(const S: string): Boolean;
|
||||||
var T: string;
|
var T: TTCISampleType;
|
||||||
begin
|
begin
|
||||||
T := LowerCase(Trim(S));
|
Result := TCISampleTypeByName(S, T);
|
||||||
Result := (T = 'int16') or (T = 'int24') or (T = 'int32') or (T = 'float32');
|
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;
|
end;
|
||||||
|
|
||||||
{ ═══════════════════════════════════════════════════════════════════════════
|
{ ═══════════════════════════════════════════════════════════════════════════
|
||||||
|
|||||||
+145
-15
@@ -33,8 +33,12 @@ unit TCIServer;
|
|||||||
(TCI_MAX_SOCKETS) и убивается по таймауту TCI_HANDSHAKE_MS. Иначе восемь
|
(TCI_MAX_SOCKETS) и убивается по таймауту TCI_HANDSHAKE_MS. Иначе восемь
|
||||||
молчащих TCP-соединений навсегда закрывали дверь настоящим клиентам.
|
молчащих TCP-соединений навсегда закрывали дверь настоящим клиентам.
|
||||||
|
|
||||||
Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2,
|
Бинарные фреймы (потоки IQ/аудио, §3.4) ходят в обе стороны: блоки наружу
|
||||||
см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются.
|
кладутся в отдельное кольцо клиента (SendBin) и уходят его же потоком вместе
|
||||||
|
с командами, входящие собираются из фрагментов и отдаются наверх (OnBinary)
|
||||||
|
— там их разбирает TCIAdapter. У двух очередей разная политика переполнения:
|
||||||
|
команду терять нельзя (клиент выбрасывается), блок потока — можно и нужно
|
||||||
|
(теряется самый старый), иначе отставший скиммер рвал бы себе управление.
|
||||||
|
|
||||||
Сокеты и WS-фреймы переиспользованы из веб-подсистемы (WebUtils/WsClient):
|
Сокеты и WS-фреймы переиспользованы из веб-подсистемы (WebUtils/WsClient):
|
||||||
тот же код handshake и та же схема «поток на клиента + accept-поток», что в
|
тот же код handshake и та же схема «поток на клиента + accept-поток», что в
|
||||||
@@ -71,6 +75,11 @@ const
|
|||||||
TCI_OUT_CHUNK = 3800; // склейка очереди в один фрейм, символов
|
TCI_OUT_CHUNK = 3800; // склейка очереди в один фрейм, символов
|
||||||
TCI_MSG_MAX = 65536; // потолок собираемого из фрагментов сообщения
|
TCI_MSG_MAX = 65536; // потолок собираемого из фрагментов сообщения
|
||||||
TCI_STOP_KILL_MS = 500; // как часто добиваем клиентов, ожидая их выхода
|
TCI_STOP_KILL_MS = 500; // как часто добиваем клиентов, ожидая их выхода
|
||||||
|
// Очередь бинарных блоков (§3.4) на клиента. Переполнение здесь НЕ повод
|
||||||
|
// рвать соединение, в отличие от очереди команд: поток — это данные
|
||||||
|
// реального времени, и клиент, не успевший забрать блок, должен потерять
|
||||||
|
// именно блок. Выбрасываем самый старый: свежий звук полезнее протухшего.
|
||||||
|
TCI_BIN_QUEUE = 48;
|
||||||
|
|
||||||
type
|
type
|
||||||
TTCIServer = class;
|
TTCIServer = class;
|
||||||
@@ -107,6 +116,13 @@ type
|
|||||||
FOutLock: TCriticalSection;
|
FOutLock: TCriticalSection;
|
||||||
FOut: array of string;
|
FOut: array of string;
|
||||||
FOutCount: Integer;
|
FOutCount: Integer;
|
||||||
|
// Очередь бинарных блоков потоков. Отдельная от командной: у них разная
|
||||||
|
// политика переполнения (команду терять нельзя, блок потока — можно) и
|
||||||
|
// разные производители (блоки кладёт DSP-поток).
|
||||||
|
FBinOut: array[0..TCI_BIN_QUEUE-1] of TBytes;
|
||||||
|
FBinHead: Integer; // куда класть
|
||||||
|
FBinTail: Integer; // откуда брать
|
||||||
|
FBinDropped: LongInt; // сколько блоков выброшено (диагностика)
|
||||||
FDead: Boolean; // сокет уже не пишется — гасим соединение
|
FDead: Boolean; // сокет уже не пишется — гасим соединение
|
||||||
FKilled: Boolean; // shutdown сокета уже сделан
|
FKilled: Boolean; // shutdown сокета уже сделан
|
||||||
FClosed: Boolean; // клиентский поток вышел (можно освобождать)
|
FClosed: Boolean; // клиентский поток вышел (можно освобождать)
|
||||||
@@ -123,6 +139,13 @@ type
|
|||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
{ Строку в очередь клиенту. False — соединение уже мертво. Не блокирует. }
|
{ Строку в очередь клиенту. False — соединение уже мертво. Не блокирует. }
|
||||||
function Send(const S: string): Boolean;
|
function Send(const S: string): Boolean;
|
||||||
|
{ Блок бинарного потока (заголовок + сэмплы) в очередь. Зовётся из
|
||||||
|
DSP-потока, поэтому только копирование под коротким локом: сеть тут не
|
||||||
|
трогается. False — клиент мёртв (блок никуда не пошёл). }
|
||||||
|
function SendBin(const Hdr: TTCIStreamHeader; Data: Pointer;
|
||||||
|
Bytes: Integer): Boolean;
|
||||||
|
{ Сколько блоков потока выброшено из-за отставания клиента. }
|
||||||
|
function BinDropped: LongInt;
|
||||||
{ Слить очередь в сокет. Зовёт ТОЛЬКО собственный поток клиента: запись
|
{ Слить очередь в сокет. Зовёт ТОЛЬКО собственный поток клиента: запись
|
||||||
может ждать до TCI_SEND_TIMEOUT, и общий поток на этом задерживал бы
|
может ждать до TCI_SEND_TIMEOUT, и общий поток на этом задерживал бы
|
||||||
всех остальных. False — клиент умер. }
|
всех остальных. False — клиент умер. }
|
||||||
@@ -154,6 +177,10 @@ type
|
|||||||
|
|
||||||
TTCIClientEvent = procedure(Client: TTCIClient) of object;
|
TTCIClientEvent = procedure(Client: TTCIClient) of object;
|
||||||
TTCICommandEvent = procedure(Client: TTCIClient; const Cmd: string) 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
|
TTCIServer = class
|
||||||
private
|
private
|
||||||
@@ -170,6 +197,7 @@ type
|
|||||||
FPort: Word;
|
FPort: Word;
|
||||||
FBindIP: string;
|
FBindIP: string;
|
||||||
FOnCommand: TTCICommandEvent;
|
FOnCommand: TTCICommandEvent;
|
||||||
|
FOnBinary: TTCIBinaryEvent;
|
||||||
FOnConnect: TTCIClientEvent;
|
FOnConnect: TTCIClientEvent;
|
||||||
FOnDisconnect: TTCIClientEvent;
|
FOnDisconnect: TTCIClientEvent;
|
||||||
FOnTick: TThreadMethod;
|
FOnTick: TThreadMethod;
|
||||||
@@ -218,6 +246,7 @@ type
|
|||||||
контроллера, и Synchronize из клиентского потока в него не вернётся. }
|
контроллера, и Synchronize из клиентского потока в него не вернётся. }
|
||||||
property Stopping: Boolean read FStopping;
|
property Stopping: Boolean read FStopping;
|
||||||
property OnCommand: TTCICommandEvent read FOnCommand write FOnCommand;
|
property OnCommand: TTCICommandEvent read FOnCommand write FOnCommand;
|
||||||
|
property OnBinary: TTCIBinaryEvent read FOnBinary write FOnBinary;
|
||||||
property OnConnect: TTCIClientEvent read FOnConnect write FOnConnect;
|
property OnConnect: TTCIClientEvent read FOnConnect write FOnConnect;
|
||||||
property OnDisconnect: TTCIClientEvent read FOnDisconnect write FOnDisconnect;
|
property OnDisconnect: TTCIClientEvent read FOnDisconnect write FOnDisconnect;
|
||||||
property OnTick: TThreadMethod read FOnTick write FOnTick;
|
property OnTick: TThreadMethod read FOnTick write FOnTick;
|
||||||
@@ -411,17 +440,22 @@ begin
|
|||||||
FOutLock := TCriticalSection.Create;
|
FOutLock := TCriticalSection.Create;
|
||||||
FOutCount := 0;
|
FOutCount := 0;
|
||||||
SetLength(FOut, 64);
|
SetLength(FOut, 64);
|
||||||
|
FBinHead := 0;
|
||||||
|
FBinTail := 0;
|
||||||
|
FBinDropped := 0;
|
||||||
// Умолчания параметров потоков — как в §4.3 (клиент их обычно переопределяет).
|
// Умолчания параметров потоков — как в §4.3 (клиент их обычно переопределяет).
|
||||||
FIQRate := 48000;
|
FIQRate := TCI_IQ_RATE_DEF;
|
||||||
FAudioRate := 48000;
|
FAudioRate := TCI_AUDIO_RATE_DEF;
|
||||||
FAudioSamples := 2048;
|
FAudioSamples := TCIDefaultAudioSamples(TCI_AUDIO_RATE_DEF);
|
||||||
FAudioChannels := 2;
|
FAudioChannels := TCI_AUDIO_CHAN_DEF;
|
||||||
FAudioSampleType := 'float32';
|
FAudioSampleType := 'float32';
|
||||||
FTxBuffering := 50;
|
FTxBuffering := TCI_TX_BUFFERING_DEF;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TTCIClient.Destroy;
|
destructor TTCIClient.Destroy;
|
||||||
|
var i: Integer;
|
||||||
begin
|
begin
|
||||||
|
for i := 0 to TCI_BIN_QUEUE - 1 do FBinOut[i] := nil;
|
||||||
FOutLock.Free;
|
FOutLock.Free;
|
||||||
FStateLock.Free;
|
FStateLock.Free;
|
||||||
inherited;
|
inherited;
|
||||||
@@ -590,10 +624,53 @@ begin
|
|||||||
end;
|
end;
|
||||||
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;
|
function TTCIClient.Flush: Boolean;
|
||||||
var
|
var
|
||||||
Batch: array of string;
|
Batch: array of string;
|
||||||
N, i: Integer;
|
Bins: array[0..TCI_BIN_QUEUE-1] of TBytes;
|
||||||
|
N, i, NB: Integer;
|
||||||
Chunk: string;
|
Chunk: string;
|
||||||
begin
|
begin
|
||||||
Result := not FDead;
|
Result := not FDead;
|
||||||
@@ -602,6 +679,7 @@ begin
|
|||||||
// поток так и висел бы в recv, а объект никогда бы не освободился.
|
// поток так и висел бы в recv, а объект никогда бы не освободился.
|
||||||
if FDead then begin Kill; Exit; end;
|
if FDead then begin Kill; Exit; end;
|
||||||
|
|
||||||
|
NB := 0;
|
||||||
FOutLock.Enter;
|
FOutLock.Enter;
|
||||||
try
|
try
|
||||||
N := FOutCount;
|
N := FOutCount;
|
||||||
@@ -615,10 +693,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
FOutCount := 0;
|
FOutCount := 0;
|
||||||
end;
|
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
|
finally
|
||||||
FOutLock.Leave;
|
FOutLock.Leave;
|
||||||
end;
|
end;
|
||||||
if N = 0 then Exit;
|
if (N = 0) and (NB = 0) then Exit;
|
||||||
|
|
||||||
// Склейка: несколько команд в одном фрейме протокол разрешает (§3.1), а
|
// Склейка: несколько команд в одном фрейме протокол разрешает (§3.1), а
|
||||||
// syscall'ов и заголовков становится в разы меньше.
|
// syscall'ов и заголовков становится в разы меньше.
|
||||||
@@ -634,14 +721,30 @@ begin
|
|||||||
end;
|
end;
|
||||||
if Chunk <> '' then
|
if Chunk <> '' then
|
||||||
if not FWs.SendText(Chunk) then begin Kill; Exit(False); end;
|
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;
|
end;
|
||||||
|
|
||||||
procedure TTCIClient.Kill;
|
procedure TTCIClient.Kill;
|
||||||
|
var i: Integer;
|
||||||
begin
|
begin
|
||||||
FOutLock.Enter;
|
FOutLock.Enter;
|
||||||
try
|
try
|
||||||
FDead := True;
|
FDead := True;
|
||||||
FOutCount := 0;
|
FOutCount := 0;
|
||||||
|
for i := 0 to TCI_BIN_QUEUE - 1 do FBinOut[i] := nil;
|
||||||
|
FBinHead := 0;
|
||||||
|
FBinTail := 0;
|
||||||
if FKilled then Exit; // shutdown уже был — второй раз незачем
|
if FKilled then Exit; // shutdown уже был — второй раз незачем
|
||||||
FKilled := True;
|
FKilled := True;
|
||||||
finally
|
finally
|
||||||
@@ -980,6 +1083,8 @@ var
|
|||||||
Payload: array of Byte;
|
Payload: array of Byte;
|
||||||
Opcode, MsgOp: Byte;
|
Opcode, MsgOp: Byte;
|
||||||
Frag: string;
|
Frag: string;
|
||||||
|
Bin: array of Byte; // сборка бинарного сообщения (блок потока)
|
||||||
|
BinLen: Integer;
|
||||||
Cmds: TStringList;
|
Cmds: TStringList;
|
||||||
begin
|
begin
|
||||||
Ws := Client.Ws;
|
Ws := Client.Ws;
|
||||||
@@ -1086,6 +1191,11 @@ begin
|
|||||||
Cmds := TStringList.Create;
|
Cmds := TStringList.Create;
|
||||||
Frag := '';
|
Frag := '';
|
||||||
MsgOp := 0;
|
MsgOp := 0;
|
||||||
|
BinLen := 0;
|
||||||
|
// Буфер под сборку блока потока заводим сразу: расти по ходу приёма он всё
|
||||||
|
// равно не имеет права (потолок задан протоколом), а перевыделение на
|
||||||
|
// каждый блок TX-аудио — это мусор в куче двадцать раз в секунду.
|
||||||
|
SetLength(Bin, TCI_STREAM_MAX);
|
||||||
Pending := Rest > 0; // хвост handshake разбираем до первого recv
|
Pending := Rest > 0; // хвост handshake разбираем до первого recv
|
||||||
try
|
try
|
||||||
while FRunning and (Ws.State = wsOpen) and not Client.Dead do
|
while FRunning and (Ws.State = wsOpen) and not Client.Dead do
|
||||||
@@ -1150,9 +1260,9 @@ begin
|
|||||||
|
|
||||||
// Фрейм крупнее приёмного буфера TWsClient никогда не соберётся —
|
// Фрейм крупнее приёмного буфера TWsClient никогда не соберётся —
|
||||||
// BufLen упрётся в потолок и цикл встанет намертво. Рвём соединение:
|
// BufLen упрётся в потолок и цикл встанет намертво. Рвём соединение:
|
||||||
// команд такой длины у TCI нет, а бинарные потоки от клиента (TX-аудио)
|
// команд такой длины у TCI нет, а самый крупный законный кадр —
|
||||||
// мы пока не принимаем.
|
// блок TX-аудио (заголовок + data[16384]) — в буфер помещается.
|
||||||
if Need + PayLen > SizeOf(Raw) then
|
if Need + PayLen > Ws.BufCapacity then
|
||||||
begin
|
begin
|
||||||
Ws.State := wsClosed;
|
Ws.State := wsClosed;
|
||||||
Break;
|
Break;
|
||||||
@@ -1189,11 +1299,11 @@ begin
|
|||||||
begin
|
begin
|
||||||
// Новое сообщение поверх недособранного — тоже рассинхрон.
|
// Новое сообщение поверх недособранного — тоже рассинхрон.
|
||||||
if MsgOp <> 0 then begin Ws.State := wsClosed; Break; end;
|
if MsgOp <> 0 then begin Ws.State := wsClosed; Break; end;
|
||||||
MsgOp := Opcode;
|
MsgOp := Opcode;
|
||||||
Frag := '';
|
Frag := '';
|
||||||
|
BinLen := 0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// Копим только текст: binary — это TX-аудио от клиента, этап 2.
|
|
||||||
if MsgOp = $01 then
|
if MsgOp = $01 then
|
||||||
begin
|
begin
|
||||||
if Length(Frag) + PayLen > TCI_MSG_MAX then
|
if Length(Frag) + PayLen > TCI_MSG_MAX then
|
||||||
@@ -1207,10 +1317,30 @@ begin
|
|||||||
Move(Payload[0], Text[1], PayLen);
|
Move(Payload[0], Text[1], PayLen);
|
||||||
Frag := Frag + Text;
|
Frag := Frag + Text;
|
||||||
end;
|
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;
|
end;
|
||||||
|
|
||||||
if Fin then
|
if Fin then
|
||||||
begin
|
begin
|
||||||
|
if (MsgOp = $02) and Assigned(FOnBinary) and (BinLen > 0) then
|
||||||
|
FOnBinary(Client, @Bin[0], BinLen);
|
||||||
|
BinLen := 0;
|
||||||
// Текстовое сообщение обязано быть валидным UTF-8 (§5.6);
|
// Текстовое сообщение обязано быть валидным UTF-8 (§5.6);
|
||||||
// битую последовательность RFC велит закрывать, а не молча
|
// битую последовательность RFC велит закрывать, а не молча
|
||||||
// скармливать разбору команд.
|
// скармливать разбору команд.
|
||||||
|
|||||||
+859
@@ -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.
|
||||||
@@ -203,6 +203,14 @@ type
|
|||||||
TOnTXIQReady = procedure(const Buf: array of Double; Count: Integer) of object;
|
TOnTXIQReady = procedure(const Buf: array of Double; Count: Integer) of object;
|
||||||
TOnWaterfallReady = procedure(const Pixels: array of Single;
|
TOnWaterfallReady = procedure(const Pixels: array of Single;
|
||||||
Count: Integer) of object;
|
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-потока по каждому активному слайсу.
|
// Аудио готового слайса — вызывается из DSP-потока по каждому активному слайсу.
|
||||||
// SliceId — логический id (из RadioController), не WDSP-канал.
|
// SliceId — логический id (из RadioController), не WDSP-канал.
|
||||||
TOnSliceAudio = procedure(SliceId: Integer; const Left, Right: array of Single;
|
TOnSliceAudio = procedure(SliceId: Integer; const Left, Right: array of Single;
|
||||||
@@ -515,6 +523,7 @@ type
|
|||||||
FVolume: Double;
|
FVolume: Double;
|
||||||
FLastError: string;
|
FLastError: string;
|
||||||
FBeaconDec: TBeaconDecoder; // не владеет; тап маяка в PushIQItemToDSP
|
FBeaconDec: TBeaconDecoder; // не владеет; тап маяка в PushIQItemToDSP
|
||||||
|
FIQTap: TIQTapEvent; // тап сырого IQ наружу (TCI), не владеет
|
||||||
|
|
||||||
function ModeToWDSP(Mode: Integer): Integer;
|
function ModeToWDSP(Mode: Integer): Integer;
|
||||||
function ModeToWDSPTX(Mode: Integer): Integer;
|
function ModeToWDSPTX(Mode: Integer): Integer;
|
||||||
@@ -626,6 +635,10 @@ type
|
|||||||
// QO-100 beacon-декодер: тап RX-IQ для демодуляции маяка (не владеет).
|
// QO-100 beacon-декодер: тап RX-IQ для демодуляции маяка (не владеет).
|
||||||
procedure SetBeaconDecoder(D: TBeaconDecoder);
|
procedure SetBeaconDecoder(D: TBeaconDecoder);
|
||||||
|
|
||||||
|
// Тап сырого RX-IQ наружу (потоки IQ по TCI). nil — снять. Ставит и
|
||||||
|
// снимает поток контроллера; вызывается тап из DSP-потока.
|
||||||
|
procedure SetIQTap(T: TIQTapEvent);
|
||||||
|
|
||||||
// --- Панадаптеры на аппаратных DDC (этап 3.2) ---
|
// --- Панадаптеры на аппаратных DDC (этап 3.2) ---
|
||||||
// Создаёт доп. пан PanId (1..MAX_PANS-1): аккумулятор + analyzer
|
// Создаёт доп. пан PanId (1..MAX_PANS-1): аккумулятор + analyzer
|
||||||
// PAN_DISP_BASE+PanId. RateHz — rate его DDC, кратен FAudioRate.
|
// PAN_DISP_BASE+PanId. RateHz — rate его DDC, кратен FAudioRate.
|
||||||
@@ -2410,6 +2423,11 @@ begin
|
|||||||
if (D <> nil) and (FSampleRate > 0) then D.Configure(FSampleRate);
|
if (D <> nil) and (FSampleRate > 0) then D.Configure(FSampleRate);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TWDSPEngine.SetIQTap(T: TIQTapEvent);
|
||||||
|
begin
|
||||||
|
FIQTap := T;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TWDSPEngine.PushDDCPacket(const Buf: array of Byte;
|
procedure TWDSPEngine.PushDDCPacket(const Buf: array of Byte;
|
||||||
DataOffset: Integer; IQPairs: Integer);
|
DataOffset: Integer; IQPairs: Integer);
|
||||||
// Вызывается из СЕТЕВОГО потока — только кладём в очередь и возвращаемся немедленно
|
// Вызывается из СЕТЕВОГО потока — только кладём в очередь и возвращаемся немедленно
|
||||||
@@ -2522,6 +2540,12 @@ begin
|
|||||||
if Pan^.AccPos >= Pan^.BufSize then
|
if Pan^.AccPos >= Pan^.BufSize then
|
||||||
begin
|
begin
|
||||||
Pan^.AccPos := 0;
|
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
|
if Assigned(FOnSliceAudio) or Assigned(FOnSliceDemodAudio) then
|
||||||
try
|
try
|
||||||
ProcessSlicesFor(PanId, Pan^.AccI, Pan^.AccQ, Pan^.BufSize);
|
ProcessSlicesFor(PanId, Pan^.AccI, Pan^.AccQ, Pan^.BufSize);
|
||||||
@@ -2638,7 +2662,14 @@ begin
|
|||||||
Inc(FRXAccPos);
|
Inc(FRXAccPos);
|
||||||
|
|
||||||
if FRXAccPos >= FBufSize then
|
if FRXAccPos >= FBufSize then
|
||||||
|
begin
|
||||||
|
// Тап IQ наружу — по накопленному блоку и ДО обработки: fexchange0
|
||||||
|
// забирает аккумулятор как вход и не портит его, но полагаться на это
|
||||||
|
// незачем, а один вызов на блок вместо вызова на сэмпл экономит всё.
|
||||||
|
if Assigned(FIQTap) then
|
||||||
|
FIQTap(0, @FRXAccI[0], @FRXAccQ[0], FBufSize, FSampleRate);
|
||||||
ProcessRXBlock;
|
ProcessRXBlock;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|||||||
+18
-1
@@ -22,6 +22,14 @@ uses
|
|||||||
SyncObjs, WebUtils
|
SyncObjs, WebUtils
|
||||||
{$IFDEF WINDOWS}, WinSock2{$ELSE}, Sockets{$ENDIF};
|
{$IFDEF WINDOWS}, WinSock2{$ELSE}, Sockets{$ENDIF};
|
||||||
|
|
||||||
|
const
|
||||||
|
{ Приёмный буфер соединения. 4 КБ хватало командам и web-запросам, но блок
|
||||||
|
бинарного потока TCI (§3.4) — это заголовок 64 байта плюс data[16384],
|
||||||
|
и кадр крупнее буфера не собирается НИКОГДА: BufLen упирается в потолок и
|
||||||
|
разбор встаёт. Поэтому потолок держим с запасом на кадр целиком вместе с
|
||||||
|
маской и хвостом соседнего сообщения. }
|
||||||
|
WS_BUF_SIZE = 32768;
|
||||||
|
|
||||||
type
|
type
|
||||||
TWsState = (wsHandshake, wsOpen, wsClosed);
|
TWsState = (wsHandshake, wsOpen, wsClosed);
|
||||||
|
|
||||||
@@ -30,7 +38,7 @@ type
|
|||||||
FSocket: TSocket;
|
FSocket: TSocket;
|
||||||
FState: TWsState;
|
FState: TWsState;
|
||||||
FLock: TCriticalSection;
|
FLock: TCriticalSection;
|
||||||
FBuf: array[0..4095] of Byte;
|
FBuf: array[0..WS_BUF_SIZE-1] of Byte;
|
||||||
FBufLen: Integer;
|
FBufLen: Integer;
|
||||||
FAuthed: Boolean;
|
FAuthed: Boolean;
|
||||||
public
|
public
|
||||||
@@ -55,6 +63,10 @@ type
|
|||||||
{ Указатель на начало буфера приёма }
|
{ Указатель на начало буфера приёма }
|
||||||
function BufData: PByte; inline;
|
function BufData: PByte; inline;
|
||||||
|
|
||||||
|
{ Ёмкость приёмного буфера: разбору фреймов нужен потолок, чтобы вовремя
|
||||||
|
закрыть соединение, а не встать намертво на несобираемом кадре. }
|
||||||
|
function BufCapacity: Integer; inline;
|
||||||
|
|
||||||
property Socket: TSocket read FSocket;
|
property Socket: TSocket read FSocket;
|
||||||
property State: TWsState read FState write FState;
|
property State: TWsState read FState write FState;
|
||||||
property Authed: Boolean read FAuthed write FAuthed;
|
property Authed: Boolean read FAuthed write FAuthed;
|
||||||
@@ -175,4 +187,9 @@ begin
|
|||||||
Result := @FBuf[0];
|
Result := @FBuf[0];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TWsClient.BufCapacity: Integer;
|
||||||
|
begin
|
||||||
|
Result := SizeOf(FBuf);
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|||||||
+194
-33
@@ -1,7 +1,7 @@
|
|||||||
# TCI в EWSDR — статус реализации
|
# TCI в EWSDR — статус реализации
|
||||||
|
|
||||||
Ветка разработки: `feature/tci-protocol`.
|
Ветка разработки: `feature/tci-protocol`.
|
||||||
Дата последнего обновления: 2026-08-17.
|
Дата последнего обновления: 2026-08-18.
|
||||||
|
|
||||||
Эталон протокола — «Протокол TCI, версия 2.0» Expert Electronics
|
Эталон протокола — «Протокол TCI, версия 2.0» Expert Electronics
|
||||||
(`doc/TCI Protocol_RU.pdf`, 12 января 2024). EWSDR выступает **сервером**
|
(`doc/TCI Protocol_RU.pdf`, 12 января 2024). EWSDR выступает **сервером**
|
||||||
@@ -22,7 +22,8 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
|
|||||||
|---|---|
|
|---|---|
|
||||||
| `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. |
|
| `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. |
|
||||||
| `TCIServer.pas` (~1250 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). |
|
| `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`):
|
Принципы те же, что у CAT (см. `doc/CAT_STATUS.md`):
|
||||||
|
|
||||||
@@ -103,6 +104,15 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
|
|||||||
до `TRX`, `TUNE` и `VFO`. Своей web-странице нужен явный прокси, а не дыра
|
до `TRX`, `TUNE` и `VFO`. Своей web-странице нужен явный прокси, а не дыра
|
||||||
по умолчанию.
|
по умолчанию.
|
||||||
|
|
||||||
|
6. **Блоки потоков нарезает и раскладывает DSP-поток.** Тап зовётся прямо из
|
||||||
|
потока WDSP, поэтому в `TCIStreams` нет ни одного ожидания: блок уходит в
|
||||||
|
кольцо клиента (микросекунды под его локом), а в сокет его пишет, как и
|
||||||
|
команды, поток самого клиента. Порядок локов везде один: `FSliceLock` →
|
||||||
|
`FStreamLock` (тап сначала выясняет, чей это слайс, и только потом ищет
|
||||||
|
подписчиков) — обратный дал бы клин с потоком контроллера. Тапы навешивает
|
||||||
|
и снимает **только поток контроллера**: снятие обязано дождаться выхода
|
||||||
|
DSP-потока из вызова, иначе тот позвал бы метод освобождённого адаптера.
|
||||||
|
|
||||||
Разбор HTTP — построчный (`TCIHttpHeader`), а не поиском подстроки
|
Разбор HTTP — построчный (`TCIHttpHeader`), а не поиском подстроки
|
||||||
«`upgrade: websocket`»: заголовок с табуляцией или без пробела после
|
«`upgrade: websocket`»: заголовок с табуляцией или без пробела после
|
||||||
двоеточия валиден. Close-кадр подтверждается ответным close с тем же кодом
|
двоеточия валиден. Close-кадр подтверждается ответным close с тем же кодом
|
||||||
@@ -119,7 +129,9 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
|
|||||||
"tci": { "enabled": false, "port": 40001, "bind_addr": "127.0.0.1" }
|
"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) убраны: теперь один
|
ручные `PushSliceFlagState`/`LayoutFlags` в MainForm) убраны: теперь один
|
||||||
путь на всех — мышь, колесо, CAT, TCI, бэнд-логика.
|
путь на всех — мышь, колесо, 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`.
|
`CW_MACROS`, `CW_MSG`, `CW_MACROS_STOP`, `CW_TERMINAL`.
|
||||||
|
|
||||||
@@ -368,7 +486,7 @@ split, `rfMonVolume` для громкости самоконтроля и но
|
|||||||
| `RX_NB_PARAM` | параметры NB в WDSP наружу не выведены |
|
| `RX_NB_PARAM` | параметры NB в WDSP наружу не выведены |
|
||||||
| `RX_BALANCE` | баланса каналов у слайса нет |
|
| `RX_BALANCE` | баланса каналов у слайса нет |
|
||||||
| `DIGL_OFFSET`, `DIGU_OFFSET` | смещения цифровых мод не реализованы |
|
| `DIGL_OFFSET`, `DIGU_OFFSET` | смещения цифровых мод не реализованы |
|
||||||
| `RX_CHANNEL_ENABLE` | канал B главного приёмника — это VFO B, он есть всегда; создание второго слайса на пане по TCI — этап 2 |
|
| `RX_CHANNEL_ENABLE` | канал B главного приёмника — это VFO B, он есть всегда; создание второго слайса на пане по TCI не делаем (см. §4) |
|
||||||
|
|
||||||
## 3.1 Ограничения, о которых честнее знать заранее
|
## 3.1 Ограничения, о которых честнее знать заранее
|
||||||
|
|
||||||
@@ -381,44 +499,39 @@ split, `rfMonVolume` для громкости самоконтроля и но
|
|||||||
| Захват параметра (§3.5) | реализован для того, что клиенты действительно перетягивают (частота, DDS, мода, фильтр, TRX/TUNE/DRIVE, split, громкости, АРУ, шумодавы, squelch, скорость CW). Эхо-параметры (RIT/XIT, BIN/ANC/…) не захватываются: на радио они не влияют |
|
| Захват параметра (§3.5) | реализован для того, что клиенты действительно перетягивают (частота, DDS, мода, фильтр, TRX/TUNE/DRIVE, split, громкости, АРУ, шумодавы, squelch, скорость CW). Эхо-параметры (RIT/XIT, BIN/ANC/…) не захватываются: на радио они не влияют |
|
||||||
| Браузерные клиенты | отвергаются по `Origin` (403), см. §1.1. Web-интерфейсу ewsdr TCI не нужен — у него свой канал |
|
| Браузерные клиенты | отвергаются по `Origin` (403), см. §1.1. Web-интерфейсу ewsdr TCI не нужен — у него свой канал |
|
||||||
| `TRX_COUNT` | равен `BackendCaps.MaxPans`, а не числу живых панов: протокол объявляет его один раз. Про несуществующий приёмник просто ничего не шлётся (§2.1) |
|
| `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` второй аргумент — уровень микрофона; измерителя
|
Отдельно: у `TX_SENSORS` второй аргумент — уровень микрофона; измерителя
|
||||||
микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не
|
микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не
|
||||||
рисовал случайные значения. Третий аргумент (RMS) и четвёртый (пик) отдаём
|
рисовал случайные значения. Третий аргумент (RMS) и четвёртый (пик) отдаём
|
||||||
одинаковыми — в телеметрии платы одно значение forward power.
|
одинаковыми — в телеметрии платы одно значение forward power.
|
||||||
|
|
||||||
У `TRX` третий аргумент (источник сигнала `tci`/`mic1`/…) игнорируется:
|
У `TRX` третий аргумент разобран только для `tci` (см. §2.5). Значения
|
||||||
аудио по TCI ещё нет, модуляция берётся из выбранного в программе входа.
|
`mic1`/`mic2`/`micpc`/`ecoder2` называют физические входы ExpertSDR3, которых у
|
||||||
|
нас нет: они значат «микрофон, выбранный в программе», то есть ровно то же, что
|
||||||
|
и отсутствие аргумента.
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
## 4. Этап 2 — бинарные потоки (§3.4)
|
## 4. Что осталось
|
||||||
|
|
||||||
Не реализовано ничего из потоков; команды управления ими принимаются, но
|
Бинарные потоки (§3.4) реализованы целиком — см. §2.5. Открыто:
|
||||||
данные не идут. Что нужно сделать:
|
|
||||||
|
|
||||||
1. **Заголовок блока** уже описан — `TTCIStreamHeader` в `TCIProtocol.pas`
|
1. **`RX_CHANNEL_ENABLE` как реальное создание/удаление второго слайса пана.**
|
||||||
(16 × uint32 + сэмплы).
|
Сейчас это эхо: канал B главного приёмника — VFO B, он есть всегда, а
|
||||||
2. **`RX_AUDIO_STREAM`** — нужен multicast-тап RX-аудио в контроллере.
|
заводить слайс по команде клиента значит отдать ему управление раскладкой
|
||||||
Сейчас есть только `OnAudioConsume` — одиночный перехват, которым владеет
|
панорамы оператора.
|
||||||
веб-адаптер (он же глушит локальный звук). Для TCI нужен именно тап
|
2. **`KEYER`** — своего события «ключ нажат» у контроллера нет.
|
||||||
«послушать, не забирая», по образцу `AddStateListener`.
|
3. **TCI в демоне.** Юниты LCL-free (стенд собирает и гоняет их вместе с
|
||||||
3. **`TX_AUDIO_STREAM` + `TX_CHRONO`** — приём бинарных фреймов от клиента
|
`TRadioController` без единого виджета), подключается одной строкой в
|
||||||
(сейчас `TCIServer` их отбрасывает; приёмный буфер `TWsClient` — 4 КБ, под
|
`ewsdrd.lpr`, как web.
|
||||||
16 КБ блоков его придётся растить) и подача в TX-тракт наравне с
|
4. **Проверка на железе и с настоящим клиентом** — главное, см. конец §5.
|
||||||
веб-микрофоном (`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.
|
|
||||||
|
|
||||||
---
|
|
||||||
|
|
||||||
## 5. Проверено
|
## 5. Проверено
|
||||||
|
|
||||||
@@ -478,6 +591,50 @@ split, `rfMonVolume` для громкости самоконтроля и но
|
|||||||
движков и сети валится с AV — клиент получает `tci_error`, соединение живо) и
|
движков и сети валится с 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-движок, которого на стенде
|
создании/удалении слайса — для них нужен живой DSP-движок, которого на стенде
|
||||||
нет. Остаётся и известное окно: показания измерителей читают `FDSPEngine` из
|
нет. Остаётся и известное окно: показания измерителей читают `FDSPEngine` из
|
||||||
@@ -494,8 +651,12 @@ send просто возвращает EPIPE, и клиент выбрасыва
|
|||||||
TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в
|
TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в
|
||||||
`ewsdrd.lpr`, как web).
|
`ewsdrd.lpr`, как web).
|
||||||
|
|
||||||
|
★Пробная сборка стенда: `-Mobjfpc` обязателен. С `-Mdelphi` в командной строке
|
||||||
|
вложенные комментарии выключаются, и `{$MODE Delphi}` внутри шапки `WebUtils.pas`
|
||||||
|
закрывает комментарий раньше времени — компиляция падает на «illegal character».
|
||||||
|
|
||||||
**На реальном железе и с реальным клиентом (Log4OM/N1MM/WSJT-X/CW Skimmer) не
|
**На реальном железе и с реальным клиентом (Log4OM/N1MM/WSJT-X/CW Skimmer) не
|
||||||
проверялось.**
|
проверялось — ни команды, ни потоки.**
|
||||||
|
|
||||||
Ответ на команду-установку клиент получает дважды: прямым ответом и рассылкой
|
Ответ на команду-установку клиент получает дважды: прямым ответом и рассылкой
|
||||||
из `OnState`. Это осознанно — дубли идемпотентны, а рассылка нужна для тех
|
из `OnState`. Это осознанно — дубли идемпотентны, а рассылка нужна для тех
|
||||||
|
|||||||
@@ -17,9 +17,9 @@
|
|||||||
<UseVersionInfo Value="True"/>
|
<UseVersionInfo Value="True"/>
|
||||||
<AutoIncrementBuild Value="True"/>
|
<AutoIncrementBuild Value="True"/>
|
||||||
<MinorVersionNr Value="9"/>
|
<MinorVersionNr Value="9"/>
|
||||||
<BuildNr Value="295"/>
|
<BuildNr Value="300"/>
|
||||||
</VersionInfo>
|
</VersionInfo>
|
||||||
<MacroValues Count="129">
|
<MacroValues Count="148">
|
||||||
<Macro1 Name="LCLWidgetType" Value="qt6"/>
|
<Macro1 Name="LCLWidgetType" Value="qt6"/>
|
||||||
<Macro2 Name="LCLWidgetType" Value="qt6"/>
|
<Macro2 Name="LCLWidgetType" Value="qt6"/>
|
||||||
<Macro3 Name="LCLWidgetType" Value="qt6"/>
|
<Macro3 Name="LCLWidgetType" Value="qt6"/>
|
||||||
@@ -149,6 +149,25 @@
|
|||||||
<Macro127 Name="LCLWidgetType" Value="qt6"/>
|
<Macro127 Name="LCLWidgetType" Value="qt6"/>
|
||||||
<Macro128 Name="LCLWidgetType" Value="qt6"/>
|
<Macro128 Name="LCLWidgetType" Value="qt6"/>
|
||||||
<Macro129 Name="LCLWidgetType" Value="qt6"/>
|
<Macro129 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro130 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro131 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro132 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro133 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro134 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro135 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro136 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro137 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro138 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro139 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro140 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro141 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro142 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro143 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro144 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro145 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro146 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro147 Name="LCLWidgetType" Value="qt6"/>
|
||||||
|
<Macro148 Name="LCLWidgetType" Value="qt6"/>
|
||||||
</MacroValues>
|
</MacroValues>
|
||||||
<BuildModes>
|
<BuildModes>
|
||||||
<Item Name="Debug" Default="True"/>
|
<Item Name="Debug" Default="True"/>
|
||||||
|
|||||||
Reference in New Issue
Block a user