mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 19:45:09 +00:00
ew8bakandClaude Opus 5
bb48f5d3fa
Модель приёмников переделана: приёмник TCI — это СЛОТ СЛАЙСА, а не панадаптер.
rx0 — главный тракт (каналы A/B = VFO A/B), rx N — слайс слота N−1, то есть
буквы B..G с флага, на каком бы пане он ни стоял. Панорама стала свойством
приёмника: от неё берутся DDS (у слайса только чтение) и поток IQ.
Почему: у Pluto панорама ровно одна (MaxPans = 1), и второй приёмник там
существует ТОЛЬКО как слайс главного пана — при нумерации по панам он был
недоступен вовсе, а TRX_COUNT навсегда равнялся единице. С другого конца —
клиенты: у MSHV в настройках всего «TCI Client rx1/rx2», то есть приёмники 0 и
1, третьего номера ввести некуда. Со слотами правило «первый созданный слайс =
приёмник 1» держится на любом железе: на openHPSDR слайс второго пана и на
Pluto слайс главного одинаково занимают слот B. Номер совпадает с буквой на
экране и с портом слайс-CAT. Цена: панорама без слайсов из TCI пропала, а
второй слайс пана перестал быть «каналом B» и стал своим приёмником — у канала
B в протоколе только частота, IF и громкость, у приёмника же всё.
TRX/TUNE раньше игнорировали arg1 (номер передатчика) целиком: клиент доп.
приёмника уводил в эфир слайс ОПЕРАТОРА — чужая частота, а с кросс-бандовым
мультислайс-TX и чужой диапазон, с чужими антенной и фильтрами; trx:9,true жал
PTT. Теперь номер разбирается и проверяется, приёмник N > 0 идёт через
RequestSliceTx (та же дверь, что у CAT-порта слайса: «в эфире только один» и
Auto TX), у контроллера появился параметр Tune для TUN тем же путём. Чужую
передачу не трогаем вовсе — ни источник модуляции, ни тон: SetMOX(True) поверх
идущей передачи не выходит рано, а заново выбирает микрофон. Хозяином эфира
клиент становится, только если передача началась именно от его команды, и
решает это Sync-метод в потоке контроллера (снимок «шла ли передача», взятый в
потоке клиента, врал: между разбором и исполнением влезает PTT оператора).
Разбор исходников MSHV (он фильтрует ВСЕ строки и бинарные блоки по номеру
приёмника) дал ещё три правки:
* ответ на TRX/TUNE адресуется номером АВТОРА, состояние в нём — «в эфире
именно твой слайс»; в рассылку идёт номер реально передающего;
* tx_enable рассылается каждому живому приёмнику со своим номером и входит в
картину нового приёмника — без этого у MSHV молча мёртвая PTT
(set_ptt начинается с `if (!tci_tx_enable) return;`);
* про несуществующий приёмник молчим целиком (LiveRx), в том числе на чтение:
ответ «vfo:1,0,0» MSHV принимал бы за конец инициализации.
Попутно, вне TCI: SendDUCSpecificFromSettings трогала FNetwork без Assigned, а
зовут её по любому PTT/TUN (SetMOX → SyncCWKeyer → она) — до подключения
устройства это была Access violation, у TCI её глотал обработчик команды.
Стенды: новый test/tci/mshv_sim.py — точная копия логики клиента MSHV, отвечает
на вопрос «почему он не подключается» одной строкой (на живом приложении
воспроизвёл ошибку инициализации для rx2 до правки). tcitest — 158/158, в
сквозном прогоне добавлено создание слайса на главном пане: он становится
приёмником 1, отвечает на vfo:1,0, слушается командой, отдаёт аудио с
receiver = 1 и замолкает после удаления.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
1447 lines
59 KiB
ObjectPascal
1447 lines
59 KiB
ObjectPascal
program tcitest;
|
||
|
||
{
|
||
Стенд этапа 2 TCI: бинарные потоки (§3.4). Запуск: test/tci/run.sh
|
||
|
||
Проверяет слои по отдельности и сквозным прогоном:
|
||
A. формат блока и математика — TCIProtocol;
|
||
A2. пересчёт частоты — дециматор, каскад, интерполятор;
|
||
B. исходящий блок до сокета — TTCIStreamOut → TTCIClient → socketpair;
|
||
C. рекордер и WAV;
|
||
D. команды потоков в живом сервере с настоящим TRadioController;
|
||
E. сквозной прогон через ЖИВОЙ WDSP: синтетический IQ в движок → блоки
|
||
RX-аудио и IQ у настоящего WS-клиента, и обратно TX-аудио клиента →
|
||
блоки TX-IQ.
|
||
|
||
Внешних библиотек не требует: WS-клиент написан на сыром сокете. Для части E
|
||
нужен libwdsp (тот же, что и приложению); если он не поднялся, эта часть
|
||
сообщает о пропуске, а не валит прогон.
|
||
|
||
★Собирать только с -Mobjfpc (см. run.sh): в режиме Delphi выключаются
|
||
вложенные комментарии, и {$MODE Delphi} внутри шапки WebUtils.pas закрывает
|
||
комментарий раньше времени — компиляция падает на «illegal character».
|
||
}
|
||
|
||
{$MODE Delphi}
|
||
{$LONGSTRINGS ON}
|
||
|
||
uses
|
||
cthreads, Classes, SysUtils, Math, SyncObjs, Sockets, BaseUnix,
|
||
TCIProtocol, TCIStreams, TCIServer, TCIAdapter, RadioController,
|
||
WsClient, WebUtils, WDSPEngine, Settings;
|
||
|
||
var
|
||
Passed, Failed: Integer;
|
||
|
||
procedure Check(const Name: string; OK: Boolean; const Detail: string = '');
|
||
begin
|
||
if OK then
|
||
begin
|
||
Inc(Passed);
|
||
WriteLn(' ok ', Name);
|
||
end
|
||
else
|
||
begin
|
||
Inc(Failed);
|
||
WriteLn(' FAIL ', Name, ' ', Detail);
|
||
end;
|
||
end;
|
||
|
||
function Near(A, B, Eps: Double): Boolean;
|
||
begin
|
||
Result := Abs(A - B) <= Eps;
|
||
end;
|
||
|
||
function RMS(const A: array of Single; N: Integer): Double;
|
||
var i: Integer; S: Double;
|
||
begin
|
||
S := 0;
|
||
for i := 0 to N - 1 do S := S + A[i] * A[i];
|
||
if N = 0 then Result := 0 else Result := Sqrt(S / N);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
A. Протокол и математика
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TestProtocol;
|
||
var
|
||
H: TTCIStreamHeader;
|
||
Src: array[0..7] of Single;
|
||
Dst: array[0..7] of Single;
|
||
Buf: array[0..63] of Byte;
|
||
N, i: Integer;
|
||
T: TTCISampleType;
|
||
begin
|
||
WriteLn('A. Протокол потоков');
|
||
|
||
Check('decim 48k→12k = 4', TCIDecimFactor(48000, 12000) = 4);
|
||
Check('decim 48k→8k = 6', TCIDecimFactor(48000, 8000) = 6);
|
||
Check('decim 48k→48k = 1', TCIDecimFactor(48000, 48000) = 1);
|
||
Check('decim 384k→48k = 8', TCIDecimFactor(384000, 48000) = 8);
|
||
Check('decim 192k→48k = 4', TCIDecimFactor(192000, 48000) = 4);
|
||
// Запрошено больше, чем есть, — вверх не тянем, отдаём как есть.
|
||
Check('decim 48k→96k = 1', TCIDecimFactor(48000, 96000) = 1);
|
||
// Нацело не делится: берём ближайший делитель, не опускаясь ниже просьбы.
|
||
Check('decim 50k→12k = 4', TCIDecimFactor(50000, 12000) = 4,
|
||
IntToStr(TCIDecimFactor(50000, 12000)));
|
||
|
||
Check('samples@48k = 2048', TCIDefaultAudioSamples(48000) = 2048);
|
||
Check('samples@12k = 512', TCIDefaultAudioSamples(12000) = 512);
|
||
Check('block float32×2', TCIMaxBlockSamples(tsyFloat32, 2) = 2048);
|
||
Check('block int16×1', TCIMaxBlockSamples(tsyInt16, 1) = 8192);
|
||
Check('bytes int24 = 3', TCISampleBytes(tsyInt24) = 3);
|
||
|
||
Check('type by name int24', TCISampleTypeByName('INT24', T) and (T = tsyInt24));
|
||
Check('type by name мусор', not TCISampleTypeByName('int8', T));
|
||
Check('type name float32', TCISampleTypeName(tsyFloat32) = 'float32');
|
||
|
||
TCIFillHeader(H, tstRXAudio, 2, 12000, tsyInt16, 512, 2);
|
||
Check('header receiver', H.Receiver = 2);
|
||
Check('header rate', H.SampleRate = 12000);
|
||
Check('header format', H.Format = LongWord(Ord(tsyInt16)));
|
||
// ★Аудио: length — сэмплы НА КАНАЛ, ровно то число, что назвал
|
||
// AUDIO_STREAM_SAMPLES (§4.3). Раньше сюда уходило вдвое больше.
|
||
Check('header length аудио = на канал', H.DataLength = 512);
|
||
Check('header type', H.StreamType = LongWord(Ord(tstRXAudio)));
|
||
Check('header channels', H.Channels = 2);
|
||
Check('header codec/crc', (H.Codec = 0) and (H.CRC = 0));
|
||
Check('header size 64', SizeOf(H) = TCI_STREAM_HDR_SIZE);
|
||
// ★IQ: а тут length — вещественные отсчёты, то есть вдвое больше
|
||
// комплексных (§3.4 прямо: комплексных = length/channels).
|
||
TCIFillHeader(H, tstIQ, 0, 48000, tsyFloat32, 512, 2);
|
||
Check('header length IQ = ×каналы', H.DataLength = 1024);
|
||
// Маркер времени TX_CHRONO живёт по правилам аудио: он называет клиенту
|
||
// размер блока, который тот пришлёт (§3.4).
|
||
TCIFillHeader(H, tstTXChrono, 0, 12000, tsyFloat32, 256, 2);
|
||
Check('header length chrono = на канал', H.DataLength = 256);
|
||
|
||
// Упаковка/распаковка: сквозной проход по всем форматам.
|
||
for i := 0 to 7 do Src[i] := (i - 4) / 8.0; // −0.5 … +0.375
|
||
for T := tsyInt16 to tsyFloat32 do
|
||
begin
|
||
N := TCIPackSamples(Src, 8, T, @Buf[0]);
|
||
Check('pack размер ' + TCISampleTypeName(T), N = 8 * TCISampleBytes(T));
|
||
N := TCIUnpackSamples(@Buf[0], N, T, Dst);
|
||
Check('unpack счёт ' + TCISampleTypeName(T), N = 8);
|
||
Check('round-trip ' + TCISampleTypeName(T),
|
||
Near(Dst[0], Src[0], 1E-4) and Near(Dst[7], Src[7], 1E-4),
|
||
Format('%.6f vs %.6f', [Dst[0], Src[0]]));
|
||
end;
|
||
|
||
// Клип: перегруз обязан упереться в шкалу, а не завернуться через знак.
|
||
Src[0] := 2.0;
|
||
Src[1] := -2.0;
|
||
TCIPackSamples(Src, 2, tsyInt16, @Buf[0]);
|
||
Check('клип int16 +', SmallInt(Word(Buf[0]) or (Word(Buf[1]) shl 8)) = 32767);
|
||
Check('клип int16 −', SmallInt(Word(Buf[2]) or (Word(Buf[3]) shl 8)) = -32767);
|
||
|
||
Check('путь | → :', TCIRecordPath('home|user/rec.wav') = 'home:user/rec.wav');
|
||
|
||
// Частоты Pluto (576…5760 кГц) на 384 делятся не все: клиенту обязана
|
||
// достаться ЗАКОННАЯ частота из набора протокола, а не 576/480 кГц.
|
||
Check('IQ rate 576к, просят 384к → 192к',
|
||
TCIPickIQRate(576000, 384000) = 192000,
|
||
IntToStr(TCIPickIQRate(576000, 384000)));
|
||
Check('IQ rate 960к, просят 384к → 192к',
|
||
TCIPickIQRate(960000, 384000) = 192000,
|
||
IntToStr(TCIPickIQRate(960000, 384000)));
|
||
Check('IQ rate 768к, просят 384к → 384к',
|
||
TCIPickIQRate(768000, 384000) = 384000);
|
||
Check('IQ rate 5760к, просят 48к → 48к',
|
||
TCIPickIQRate(5760000, 48000) = 48000);
|
||
Check('IQ rate 192к, просят 384к → 192к',
|
||
TCIPickIQRate(192000, 384000) = 192000);
|
||
Check('IQ rate чужой 50к → просьба как есть',
|
||
TCIPickIQRate(50000, 48000) = 48000);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
A2. Дециматор и интерполятор
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
{ Прогон каскада: тон в полосе обязан пройти без потерь, тон за новой границей
|
||
Найквиста — исчезнуть. Кормим кусками по 4096, как это делает поток. }
|
||
procedure TestChain(M: Integer; SrcRate, PassHz, StopHz: Double;
|
||
const What: string);
|
||
const
|
||
NTOT = 65536;
|
||
var
|
||
C: TTCIDecimChain;
|
||
Src: array[0..4095] of Single;
|
||
Dst: array[0..4095] of Single;
|
||
i, off, n: Integer;
|
||
Acc: Double;
|
||
|
||
function RunTone(ToneHz: Double): Double;
|
||
var j: Integer;
|
||
begin
|
||
C := TTCIDecimChain.Create(M);
|
||
try
|
||
Acc := 0;
|
||
n := 0;
|
||
off := 0;
|
||
while off + 4096 <= NTOT do
|
||
begin
|
||
for j := 0 to 4095 do
|
||
Src[j] := Sin(2 * Pi * ToneHz * (off + j) / SrcRate);
|
||
i := C.Process(Src, 4096, Dst);
|
||
// Первую половину прогона пропускаем: там переходный процесс фильтра.
|
||
if off >= NTOT div 2 then
|
||
for j := 0 to i - 1 do
|
||
begin
|
||
Acc := Acc + Dst[j] * Dst[j];
|
||
Inc(n);
|
||
end;
|
||
Inc(off, 4096);
|
||
end;
|
||
if n = 0 then Result := 0 else Result := Sqrt(Acc / n);
|
||
finally
|
||
C.Free;
|
||
end;
|
||
end;
|
||
|
||
var
|
||
Pass, Stop: Double;
|
||
begin
|
||
Pass := RunTone(PassHz);
|
||
Stop := RunTone(StopHz);
|
||
Check(What + ': полоса цела', Abs(Pass - 0.707) < 0.03,
|
||
Format('%.4f', [Pass]));
|
||
Check(What + ': зеркало давится (>60 дБ)', Stop < 0.0007,
|
||
Format('%.6f', [Stop]));
|
||
end;
|
||
|
||
procedure TestResampling;
|
||
const
|
||
NIN = 8192;
|
||
var
|
||
D: TTCIDecimator;
|
||
I_: TTCIInterpolator;
|
||
Src: array[0..NIN-1] of Single;
|
||
Dst: array[0..NIN-1] of Single;
|
||
Out_: array[0..NIN*8-1] of Double;
|
||
i, n: Integer;
|
||
Ph, Lo, Hi: Double;
|
||
begin
|
||
WriteLn('A2. Пересчёт частоты');
|
||
|
||
// Постоянка: усиление на нуле обязано быть единичным, иначе поток тише/громче
|
||
// ровно на коэффициент прореживания.
|
||
D := TTCIDecimator.Create(4);
|
||
try
|
||
for i := 0 to NIN - 1 do Src[i] := 1.0;
|
||
n := D.Process(Src, NIN, Dst);
|
||
Check('децим счёт = N/M', n = NIN div 4, IntToStr(n));
|
||
Check('децим усиление 1.0', Near(Dst[n - 1], 1.0, 0.01),
|
||
Format('%.4f', [Dst[n - 1]]));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
// Тон в полосе проходит, тон за новой границей Найквиста — давится.
|
||
D := TTCIDecimator.Create(4); // 48к → 12к, Найквист 6 кГц
|
||
try
|
||
Ph := 0;
|
||
for i := 0 to NIN - 1 do
|
||
begin
|
||
Src[i] := Sin(2 * Pi * 1000 * i / 48000);
|
||
Ph := Ph;
|
||
end;
|
||
n := D.Process(Src, NIN, Dst);
|
||
Check('децим 1 кГц проходит', Near(RMS(Dst, n), 0.707, 0.05),
|
||
Format('%.4f', [RMS(Dst, n)]));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
D := TTCIDecimator.Create(4);
|
||
try
|
||
for i := 0 to NIN - 1 do Src[i] := Sin(2 * Pi * 20000 * i / 48000);
|
||
n := D.Process(Src, NIN, Dst);
|
||
Check('децим 20 кГц давится (>40 дБ)', RMS(Dst, n) < 0.007,
|
||
Format('%.5f', [RMS(Dst, n)]));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
// Коэффициент 1 — сквозной проход без фильтра (иначе теряли бы верх полосы).
|
||
D := TTCIDecimator.Create(1);
|
||
try
|
||
for i := 0 to 15 do Src[i] := i / 16.0;
|
||
n := D.Process(Src, 16, Dst);
|
||
Check('децим ×1 прозрачен', (n = 16) and Near(Dst[15], 15 / 16.0, 1E-6));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
// ★Каскад на коэффициентах Pluto. Одной ступенью это не берётся: замер до
|
||
// каскада дал на M=120 завал 1.3 дБ в полосе и подавление зеркала 16 дБ.
|
||
TestChain(4, 192000, 12000, 40000, 'HPSDR 192→48');
|
||
TestChain(8, 384000, 12000, 40000, 'HPSDR 384→48');
|
||
TestChain(12, 576000, 12000, 40000, 'Pluto 576→48');
|
||
TestChain(32, 1536000, 12000, 40000, 'Pluto 1536→48');
|
||
TestChain(120,5760000, 12000, 40000, 'Pluto 5760→48');
|
||
TestChain(15, 5760000, 100000, 300000, 'Pluto 5760→384');
|
||
|
||
// Интерполятор: счёт и отсутствие выбросов за пределы соседних отсчётов.
|
||
I_ := TTCIInterpolator.Create(4);
|
||
try
|
||
for i := 0 to 99 do Src[i] := Sin(2 * Pi * i / 25);
|
||
n := I_.Process(Src, 100, Out_);
|
||
Check('интерп счёт = N×M', n = 400, IntToStr(n));
|
||
// Смотрим ТОЛЬКО заполненную часть: хвост буфера — мусор со стека, и
|
||
// MaxValue по нему ловит сигнальный NaN (проверено: с -O2 прогон падал
|
||
// с EInvalidOp ровно здесь).
|
||
Lo := Out_[0];
|
||
Hi := Out_[0];
|
||
for i := 1 to n - 1 do
|
||
begin
|
||
if Out_[i] < Lo then Lo := Out_[i];
|
||
if Out_[i] > Hi then Hi := Out_[i];
|
||
end;
|
||
Check('интерп без выбросов', (Hi <= 1.0001) and (Lo >= -1.0001),
|
||
Format('%.4f..%.4f', [Lo, Hi]));
|
||
finally
|
||
I_.Free;
|
||
end;
|
||
|
||
I_ := TTCIInterpolator.Create(1);
|
||
try
|
||
for i := 0 to 9 do Src[i] := i;
|
||
n := I_.Process(Src, 10, Out_);
|
||
Check('интерп ×1 прозрачен', (n = 10) and Near(Out_[9], 9, 1E-9));
|
||
finally
|
||
I_.Free;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
B. Блок до сокета: TTCIStreamOut → TTCIClient → socketpair
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
type
|
||
{ Приёмник кадров с другого конца socketpair: разбирает WS-кадры сервера
|
||
(немаскированные, FIN=1) и отдаёт полезную нагрузку. }
|
||
TFrameSink = record
|
||
Fd: Integer;
|
||
Buf: array[0..262143] of Byte;
|
||
Len: Integer;
|
||
end;
|
||
|
||
procedure SinkDrain(var S: TFrameSink);
|
||
var R: Integer;
|
||
begin
|
||
repeat
|
||
R := fpRecv(S.Fd, @S.Buf[S.Len], SizeOf(S.Buf) - S.Len, MSG_DONTWAIT);
|
||
if R > 0 then Inc(S.Len, R);
|
||
until R <= 0;
|
||
end;
|
||
|
||
{ Достаёт следующий кадр. False — кадров больше нет. }
|
||
function SinkNext(var S: TFrameSink; out Opcode: Byte; out Payload: TBytes): Boolean;
|
||
var
|
||
PayLen, Need, i: Integer;
|
||
begin
|
||
Result := False;
|
||
Payload := nil;
|
||
if S.Len < 2 then Exit;
|
||
Opcode := S.Buf[0] and $0F;
|
||
PayLen := S.Buf[1] and $7F;
|
||
Need := 2;
|
||
if PayLen = 126 then
|
||
begin
|
||
if S.Len < 4 then Exit;
|
||
PayLen := (S.Buf[2] shl 8) or S.Buf[3];
|
||
Need := 4;
|
||
end
|
||
else if PayLen = 127 then
|
||
begin
|
||
if S.Len < 10 then Exit;
|
||
PayLen := (S.Buf[6] shl 24) or (S.Buf[7] shl 16) or (S.Buf[8] shl 8) or S.Buf[9];
|
||
Need := 10;
|
||
end;
|
||
if S.Len < Need + PayLen then Exit;
|
||
SetLength(Payload, PayLen);
|
||
for i := 0 to PayLen - 1 do Payload[i] := S.Buf[Need + i];
|
||
if S.Len > Need + PayLen then
|
||
Move(S.Buf[Need + PayLen], S.Buf[0], S.Len - Need - PayLen);
|
||
Dec(S.Len, Need + PayLen);
|
||
Result := True;
|
||
end;
|
||
|
||
procedure TestStreamOut;
|
||
var
|
||
Fds: array[0..1] of Integer;
|
||
Ws: TWsClient;
|
||
C: TTCIClient;
|
||
S: TTCIStreamOut;
|
||
Sink: TFrameSink;
|
||
L, R: array[0..8191] of Single;
|
||
i, Blocks: Integer;
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
H: TTCIStreamHeader;
|
||
IQI, IQQ: array[0..8191] of Double;
|
||
OkHdr: Boolean;
|
||
begin
|
||
WriteLn('B. Исходящий блок до сокета');
|
||
|
||
if fpSocketPair(AF_UNIX, SOCK_STREAM, 0, @Fds[0]) <> 0 then
|
||
begin
|
||
Check('socketpair', False, 'создать пару не удалось');
|
||
Exit;
|
||
end;
|
||
FillChar(Sink, SizeOf(Sink), 0);
|
||
Sink.Fd := Fds[1];
|
||
|
||
Ws := TWsClient.Create(Fds[0]);
|
||
Ws.State := wsOpen;
|
||
C := TTCIClient.Create(Ws);
|
||
try
|
||
// 48 кГц стерео → 12 кГц стерео float32, блок 512 сэмплов на канал.
|
||
S := TTCIStreamOut.Create(C, tstRXAudio, 0, 48000, 12000, 2, tsyFloat32, 512);
|
||
try
|
||
for i := 0 to 8191 do
|
||
begin
|
||
L[i] := Sin(2 * Pi * 1000 * i / 48000);
|
||
R[i] := L[i] * 0.5;
|
||
end;
|
||
S.FeedAudio(L, R, 8192); // 8192/4 = 2048 выходных = 4 блока по 512
|
||
Check('поток: частота на выходе', S.OutRate = 12000, IntToStr(S.OutRate));
|
||
finally
|
||
S.Free;
|
||
end;
|
||
OkHdr := C.Flush;
|
||
Check('аудио: flush socketpair', OkHdr,
|
||
'dead=' + BoolToStr(C.Dead, True) + ', errno=' + IntToStr(fpGetErrno) +
|
||
', txfd=' + IntToStr(Fds[0]) + ', rxfd=' + IntToStr(Fds[1]));
|
||
SinkDrain(Sink);
|
||
|
||
Blocks := 0;
|
||
OkHdr := True;
|
||
while SinkNext(Sink, Op, Pay) do
|
||
begin
|
||
if Op <> $02 then begin OkHdr := False; Continue; end;
|
||
if Length(Pay) < SizeOf(H) then begin OkHdr := False; Continue; end;
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if (H.SampleRate <> 12000) or (H.Channels <> 2) or
|
||
(H.DataLength <> 512) or // сэмплов НА КАНАЛ
|
||
(H.StreamType <> LongWord(Ord(tstRXAudio))) or
|
||
(H.Format <> LongWord(Ord(tsyFloat32))) or
|
||
(Length(Pay) <> SizeOf(H) + 512 * 2 * 4) then OkHdr := False;
|
||
Inc(Blocks);
|
||
end;
|
||
Check('аудио: 4 блока', Blocks = 4, IntToStr(Blocks));
|
||
Check('аудио: заголовок и размер', OkHdr);
|
||
|
||
// IQ: 384 кГц → 48 кГц, блок 2048 комплексных.
|
||
S := TTCIStreamOut.Create(C, tstIQ, 1, 384000, 48000, 2, tsyFloat32, 2048);
|
||
try
|
||
Check('IQ: частота на выходе', S.OutRate = 48000, IntToStr(S.OutRate));
|
||
for i := 0 to 8191 do
|
||
begin
|
||
IQI[i] := Cos(2 * Pi * 1000 * i / 384000);
|
||
IQQ[i] := Sin(2 * Pi * 1000 * i / 384000);
|
||
end;
|
||
// 8192/8 = 1024 выходных — половина блока, отправки быть не должно.
|
||
S.FeedIQ(@IQI[0], @IQQ[0], 8192);
|
||
C.Flush;
|
||
SinkDrain(Sink);
|
||
Check('IQ: полблока не уходит', not SinkNext(Sink, Op, Pay));
|
||
S.FeedIQ(@IQI[0], @IQQ[0], 8192); // ещё половина — теперь блок целый
|
||
C.Flush;
|
||
SinkDrain(Sink);
|
||
OkHdr := SinkNext(Sink, Op, Pay);
|
||
if OkHdr then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
OkHdr := (H.Receiver = 1) and (H.SampleRate = 48000) and
|
||
(H.DataLength = 4096) and
|
||
(H.StreamType = LongWord(Ord(tstIQ))) and
|
||
(Length(Pay) = SizeOf(H) + 4096 * 4);
|
||
end;
|
||
Check('IQ: блок целиком и по формату', OkHdr);
|
||
|
||
// Смена частоты источника на ходу (сменили rate DDC).
|
||
S.SetSourceRate(192000);
|
||
Check('IQ: пересчёт после смены rate', S.OutRate = 48000);
|
||
finally
|
||
S.Free;
|
||
end;
|
||
|
||
// Моно: 1 канал = среднее двух.
|
||
S := TTCIStreamOut.Create(C, tstRXAudio, 0, 48000, 48000, 1, tsyInt16, 100);
|
||
try
|
||
for i := 0 to 199 do begin L[i] := 0.5; R[i] := -0.5; end;
|
||
S.FeedAudio(L, R, 200);
|
||
C.Flush;
|
||
SinkDrain(Sink);
|
||
OkHdr := SinkNext(Sink, Op, Pay);
|
||
if OkHdr then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
OkHdr := (H.Channels = 1) and (H.DataLength = 100) and
|
||
(H.Format = LongWord(Ord(tsyInt16))) and
|
||
(Length(Pay) = SizeOf(H) + 100 * 2);
|
||
end;
|
||
Check('моно int16: заголовок и размер', OkHdr);
|
||
finally
|
||
S.Free;
|
||
end;
|
||
|
||
// Переполнение кольца блоков: клиент не читает — теряем старые блоки,
|
||
// но соединение живо и команды по нему ходят.
|
||
S := TTCIStreamOut.Create(C, tstRXAudio, 0, 48000, 48000, 2, tsyFloat32, 100);
|
||
try
|
||
for i := 0 to 8191 do begin L[i] := 0.1; R[i] := 0.1; end;
|
||
for i := 0 to 99 do S.FeedAudio(L, R, 8192); // много блоков без Flush
|
||
Check('переполнение: блоки теряются', C.BinDropped > 0,
|
||
IntToStr(C.BinDropped));
|
||
Check('переполнение: клиент жив', not C.Dead);
|
||
finally
|
||
S.Free;
|
||
end;
|
||
finally
|
||
C.Free;
|
||
Ws.Free;
|
||
fpClose(Fds[1]);
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
C. Рекордер и WAV
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TestRecorder;
|
||
var
|
||
Rec: TTCIRecorder;
|
||
L, R: array[0..8191] of Single;
|
||
Data: TTCIPcm;
|
||
i, Total: Integer;
|
||
Path: string;
|
||
FS: TFileStream;
|
||
Hdr: array[0..43] of Byte;
|
||
Sz: LongWord;
|
||
W: TTCIWavWriter;
|
||
Waited: Integer;
|
||
begin
|
||
WriteLn('C. Рекордер линейного выхода');
|
||
|
||
// Максимум записи — 1 секунда: подаём полторы, лишнее не берём. ★Именно НЕ
|
||
// берём: окно записи по §4.3 начинается со START, а не «последняя секунда».
|
||
Rec := TTCIRecorder.Create(0, 48000, 1);
|
||
try
|
||
Total := 0;
|
||
for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end;
|
||
while Total < 72000 do
|
||
begin
|
||
Rec.Feed(L, R, 8192);
|
||
Inc(Total, 8192);
|
||
end;
|
||
Data := Rec.Take;
|
||
Check('рекордер: длина по максимуму', Length(Data) = 48000 * 2,
|
||
IntToStr(Length(Data)));
|
||
Check('рекордер: уровень сохранён',
|
||
(Data[0] = Round(0.25 * 32767)) and (Data[1] = -Round(0.25 * 32767)));
|
||
Check('рекордер: Take завершает запись', Length(Rec.Take) = 0);
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
|
||
// Порядок отсчётов: первым обязан идти самый ПЕРВЫЙ записанный.
|
||
Rec := TTCIRecorder.Create(0, 1000, 1); // ёмкость 1000 отсчётов
|
||
try
|
||
for i := 0 to 1499 do
|
||
begin
|
||
L[0] := i / 4000.0;
|
||
R[0] := 0;
|
||
Rec.Feed(L, R, 1);
|
||
end;
|
||
Data := Rec.Take;
|
||
Check('рекордер: с начала записи, а не с конца',
|
||
(Length(Data) = 2000) and (Data[0] = 0) and
|
||
(Abs(Data[1998] - Round((999 / 4000.0) * 32767)) <= 1),
|
||
IntToStr(Data[1998]));
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
|
||
// ★Истечение срока: по документу «по истечении времени запись удаляется».
|
||
// Секунду ждать незачем — окно берём минимальное и смотрим на часы.
|
||
Rec := TTCIRecorder.Create(0, 48000, 1);
|
||
try
|
||
for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end;
|
||
Rec.Feed(L, R, 8192);
|
||
Check('рекордер: до срока запись есть', Length(Rec.Take) > 0);
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
Rec := TTCIRecorder.Create(0, 48000, 1);
|
||
try
|
||
Rec.Feed(L, R, 8192);
|
||
Sleep(1100); // окно закрылось
|
||
Check('рекордер: после срока запись удалена', Length(Rec.Take) = 0);
|
||
Rec.Feed(L, R, 8192); // и новое аудио уже не принимает
|
||
Check('рекордер: истёкший не оживает', Length(Rec.Take) = 0);
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
|
||
// WAV: заголовок и длина.
|
||
Path := GetTempDir + 'tcitest_rec.wav';
|
||
DeleteFile(Path);
|
||
SetLength(Data, 2000);
|
||
for i := 0 to 1999 do Data[i] := i * 8;
|
||
W := TTCIWavWriter.Create(Path, Data, 48000);
|
||
Waited := 0;
|
||
while (not FileExists(Path)) and (Waited < 2000) do
|
||
begin
|
||
Sleep(10);
|
||
Inc(Waited, 10);
|
||
end;
|
||
Sleep(50);
|
||
if not FileExists(Path) then
|
||
Check('WAV: файл создан', False)
|
||
else
|
||
begin
|
||
FS := TFileStream.Create(Path, fmOpenRead);
|
||
try
|
||
Check('WAV: размер', FS.Size = 44 + 2000 * 2, IntToStr(FS.Size));
|
||
FS.Read(Hdr[0], 44);
|
||
Check('WAV: RIFF/WAVE',
|
||
(Hdr[0] = Ord('R')) and (Hdr[1] = Ord('I')) and
|
||
(Hdr[8] = Ord('W')) and (Hdr[9] = Ord('A')));
|
||
Sz := LongWord(Hdr[24]) or (LongWord(Hdr[25]) shl 8) or
|
||
(LongWord(Hdr[26]) shl 16) or (LongWord(Hdr[27]) shl 24);
|
||
Check('WAV: частота 48000', Sz = 48000, IntToStr(Sz));
|
||
Check('WAV: 2 канала, 16 бит',
|
||
(Hdr[22] = 2) and (Hdr[34] = 16));
|
||
Sz := LongWord(Hdr[40]) or (LongWord(Hdr[41]) shl 8) or
|
||
(LongWord(Hdr[42]) shl 16) or (LongWord(Hdr[43]) shl 24);
|
||
Check('WAV: длина данных', Sz = 4000, IntToStr(Sz));
|
||
finally
|
||
FS.Free;
|
||
end;
|
||
DeleteFile(Path);
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
D. Живой сервер: команды потоков
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
type
|
||
{ Минимальный WS-клиент на сыром сокете: handshake, отправка команд с
|
||
маской (как обязан клиент), приём текста и бинарных блоков. }
|
||
TRawClient = class
|
||
private
|
||
FSock: Integer;
|
||
FIn: array[0..262143] of Byte;
|
||
FLen: Integer;
|
||
public
|
||
function Connect(Port: Word): Boolean;
|
||
procedure SendText(const S: string);
|
||
procedure SendBinary(const Data; Len: Integer);
|
||
{ Штатное прощание по RFC 6455: close-кадр с кодом 1000. Второй путь
|
||
отключения — просто закрыть сокет (Close_), и сервер обязан отпускать
|
||
слот в обоих. }
|
||
procedure SendClose;
|
||
procedure Pump(Ms: Integer);
|
||
function NextFrame(out Opcode: Byte; out Payload: TBytes): Boolean;
|
||
{ Ждать строку с подстрокой Needle не дольше Ms. }
|
||
function WaitText(const Needle: string; Ms: Integer): string;
|
||
function Alive: Boolean;
|
||
procedure Close_;
|
||
end;
|
||
|
||
function TRawClient.Connect(Port: Word): Boolean;
|
||
var
|
||
Addr: TInetSockAddr;
|
||
Req: string;
|
||
begin
|
||
Result := False;
|
||
FLen := 0;
|
||
FSock := fpSocket(AF_INET, SOCK_STREAM, 0);
|
||
if FSock < 0 then Exit;
|
||
FillChar(Addr, SizeOf(Addr), 0);
|
||
Addr.sin_family := AF_INET;
|
||
Addr.sin_port := htons(Port);
|
||
Addr.sin_addr.s_addr := htonl($7F000001);
|
||
if fpConnect(FSock, @Addr, SizeOf(Addr)) <> 0 then Exit;
|
||
Req := 'GET / HTTP/1.1'#13#10 +
|
||
'Host: 127.0.0.1'#13#10 +
|
||
'Upgrade: websocket'#13#10 +
|
||
'Connection: Upgrade'#13#10 +
|
||
'Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ=='#13#10 +
|
||
'Sec-WebSocket-Version: 13'#13#10#13#10;
|
||
fpSend(FSock, @Req[1], Length(Req), 0);
|
||
// Ответ handshake: ждём конца заголовков и выкидываем их из буфера.
|
||
Pump(1000);
|
||
Result := FLen > 0;
|
||
if Result then
|
||
begin
|
||
Req := '';
|
||
SetLength(Req, FLen);
|
||
Move(FIn[0], Req[1], FLen);
|
||
if Pos(#13#10#13#10, Req) = 0 then Exit(False);
|
||
Result := Pos('101', Copy(Req, 1, 20)) > 0;
|
||
FLen := FLen - (Pos(#13#10#13#10, Req) + 3);
|
||
if FLen > 0 then Move(FIn[Pos(#13#10#13#10, Req) + 3], FIn[0], FLen);
|
||
end;
|
||
end;
|
||
|
||
procedure TRawClient.SendText(const S: string);
|
||
var
|
||
Frame: array of Byte;
|
||
i, HLen, N: Integer;
|
||
Mask: array[0..3] of Byte;
|
||
begin
|
||
N := Length(S);
|
||
if N <= 125 then HLen := 2 else HLen := 4;
|
||
SetLength(Frame, HLen + 4 + N);
|
||
Frame[0] := $81;
|
||
if N <= 125 then Frame[1] := $80 or Byte(N)
|
||
else
|
||
begin
|
||
Frame[1] := $80 or 126;
|
||
Frame[2] := Byte(N shr 8);
|
||
Frame[3] := Byte(N);
|
||
end;
|
||
for i := 0 to 3 do Mask[i] := Byte(Random(256));
|
||
for i := 0 to 3 do Frame[HLen + i] := Mask[i];
|
||
for i := 0 to N - 1 do
|
||
Frame[HLen + 4 + i] := Byte(S[i + 1]) xor Mask[i and 3];
|
||
fpSend(FSock, @Frame[0], Length(Frame), 0);
|
||
end;
|
||
|
||
procedure TRawClient.SendClose;
|
||
var
|
||
Frame: array[0..7] of Byte;
|
||
i: Integer;
|
||
Mask: array[0..3] of Byte;
|
||
Code: array[0..1] of Byte;
|
||
begin
|
||
Code[0] := $03; Code[1] := $E8; // 1000 — normal closure
|
||
for i := 0 to 3 do Mask[i] := Byte(Random(256));
|
||
Frame[0] := $88;
|
||
Frame[1] := $80 or 2;
|
||
for i := 0 to 3 do Frame[2 + i] := Mask[i];
|
||
for i := 0 to 1 do Frame[6 + i] := Code[i] xor Mask[i];
|
||
fpSend(FSock, @Frame[0], SizeOf(Frame), 0);
|
||
end;
|
||
|
||
procedure TRawClient.SendBinary(const Data; Len: Integer);
|
||
var
|
||
Frame: array of Byte;
|
||
P: PByte;
|
||
i, HLen: Integer;
|
||
Mask: array[0..3] of Byte;
|
||
begin
|
||
if Len <= 125 then HLen := 2
|
||
else if Len <= 65535 then HLen := 4
|
||
else HLen := 10;
|
||
SetLength(Frame, HLen + 4 + Len);
|
||
Frame[0] := $82;
|
||
if Len <= 125 then Frame[1] := $80 or Byte(Len)
|
||
else if Len <= 65535 then
|
||
begin
|
||
Frame[1] := $80 or 126;
|
||
Frame[2] := Byte(Len shr 8);
|
||
Frame[3] := Byte(Len);
|
||
end
|
||
else
|
||
begin
|
||
Frame[1] := $80 or 127;
|
||
Frame[2] := 0; Frame[3] := 0; Frame[4] := 0; Frame[5] := 0;
|
||
Frame[6] := Byte(Len shr 24); Frame[7] := Byte(Len shr 16);
|
||
Frame[8] := Byte(Len shr 8); Frame[9] := Byte(Len);
|
||
end;
|
||
for i := 0 to 3 do Mask[i] := Byte(Random(256));
|
||
for i := 0 to 3 do Frame[HLen + i] := Mask[i];
|
||
P := @Data;
|
||
for i := 0 to Len - 1 do Frame[HLen + 4 + i] := P[i] xor Mask[i and 3];
|
||
fpSend(FSock, @Frame[0], Length(Frame), 0);
|
||
end;
|
||
|
||
procedure TRawClient.Pump(Ms: Integer);
|
||
var
|
||
R, Waited: Integer;
|
||
begin
|
||
Waited := 0;
|
||
repeat
|
||
R := fpRecv(FSock, @FIn[FLen], SizeOf(FIn) - FLen, MSG_DONTWAIT);
|
||
if R > 0 then Inc(FLen, R)
|
||
else
|
||
begin
|
||
Sleep(10);
|
||
Inc(Waited, 10);
|
||
end;
|
||
until Waited >= Ms;
|
||
end;
|
||
|
||
function TRawClient.NextFrame(out Opcode: Byte; out Payload: TBytes): Boolean;
|
||
var PayLen, Need, i: Integer;
|
||
begin
|
||
Result := False;
|
||
Payload := nil;
|
||
if FLen < 2 then Exit;
|
||
Opcode := FIn[0] and $0F;
|
||
PayLen := FIn[1] and $7F;
|
||
Need := 2;
|
||
if PayLen = 126 then
|
||
begin
|
||
if FLen < 4 then Exit;
|
||
PayLen := (FIn[2] shl 8) or FIn[3];
|
||
Need := 4;
|
||
end
|
||
else if PayLen = 127 then
|
||
begin
|
||
if FLen < 10 then Exit;
|
||
PayLen := (FIn[6] shl 24) or (FIn[7] shl 16) or (FIn[8] shl 8) or FIn[9];
|
||
Need := 10;
|
||
end;
|
||
if FLen < Need + PayLen then Exit;
|
||
SetLength(Payload, PayLen);
|
||
for i := 0 to PayLen - 1 do Payload[i] := FIn[Need + i];
|
||
if FLen > Need + PayLen then Move(FIn[Need + PayLen], FIn[0], FLen - Need - PayLen);
|
||
Dec(FLen, Need + PayLen);
|
||
Result := True;
|
||
end;
|
||
|
||
function TRawClient.WaitText(const Needle: string; Ms: Integer): string;
|
||
var
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
S: string;
|
||
Waited: Integer;
|
||
begin
|
||
Result := '';
|
||
Waited := 0;
|
||
repeat
|
||
while NextFrame(Op, Pay) do
|
||
if Op = $01 then
|
||
begin
|
||
S := '';
|
||
SetLength(S, Length(Pay));
|
||
if Length(Pay) > 0 then Move(Pay[0], S[1], Length(Pay));
|
||
if Pos(Needle, LowerCase(S)) > 0 then Exit(S);
|
||
end;
|
||
Pump(50);
|
||
Inc(Waited, 50);
|
||
until Waited >= Ms;
|
||
end;
|
||
|
||
function TRawClient.Alive: Boolean;
|
||
var R: Integer;
|
||
begin
|
||
R := fpSend(FSock, @R, 0, MSG_NOSIGNAL);
|
||
Result := R >= 0;
|
||
end;
|
||
|
||
procedure TRawClient.Close_;
|
||
begin
|
||
if FSock >= 0 then fpClose(FSock);
|
||
FSock := -1;
|
||
end;
|
||
|
||
type
|
||
{ Хост: маршалинг Invoke в наш поток не нужен — исполняем на месте, как
|
||
делает демон (у него тоже нет очереди главного потока в этом смысле). }
|
||
THost = class
|
||
procedure DoInvoke(M: TThreadMethod);
|
||
procedure OnTXIQ(const Buf: array of Double; Count: Integer);
|
||
end;
|
||
|
||
var
|
||
TXIQBlocks: Integer = 0;
|
||
|
||
procedure THost.DoInvoke(M: TThreadMethod);
|
||
begin
|
||
M();
|
||
end;
|
||
|
||
procedure THost.OnTXIQ(const Buf: array of Double; Count: Integer);
|
||
// Готовый блок TX-IQ: единственный наблюдаемый признак того, что аудио
|
||
// клиента прошло весь тракт (ринг микрофона вычерпывается быстрее, чем его
|
||
// успевает увидеть опрос).
|
||
begin
|
||
if Count > 0 then Inc(TXIQBlocks);
|
||
end;
|
||
|
||
procedure TestServer;
|
||
const
|
||
PORT = 40099;
|
||
var
|
||
Ctrl: TRadioController;
|
||
Ad: TTCIAdapter;
|
||
Host: THost;
|
||
Cfg: TTCISettings;
|
||
C, C2: TRawClient;
|
||
S: string;
|
||
Blk: array[0..1023] of Byte;
|
||
H: TTCIStreamHeader;
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
GotBinary, GotClose: Boolean;
|
||
begin
|
||
WriteLn('D. Команды потоков на живом сервере');
|
||
|
||
Host := THost.Create;
|
||
Ctrl := TRadioController.Create;
|
||
Ctrl.LocalAudioEnabled := False;
|
||
Ctrl.OnInvoke := Host.DoInvoke;
|
||
Ad := TTCIAdapter.Create(Ctrl, nil);
|
||
C := TRawClient.Create;
|
||
try
|
||
Cfg.Enabled := True;
|
||
Cfg.Port := PORT;
|
||
Cfg.BindAddr := '127.0.0.1';
|
||
if not Ad.ApplySettings(Cfg) then
|
||
begin
|
||
Check('сервер поднялся', False, 'порт занят?');
|
||
Exit;
|
||
end;
|
||
Check('сервер поднялся', Ad.Active);
|
||
|
||
if not C.Connect(PORT) then
|
||
begin
|
||
Check('клиент подключился', False);
|
||
Exit;
|
||
end;
|
||
Check('клиент подключился', True);
|
||
Check('пришёл ready', C.WaitText('ready;', 2000) <> '');
|
||
|
||
// Приёмник вне диапазона — отказ, а не молчание.
|
||
C.SendText('audio_start:9;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('audio_start:9 → ошибка', Pos('bad receiver', S) > 0, S);
|
||
|
||
C.SendText('iq_start:abc;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('iq_start:abc → ошибка', Pos('bad receiver', S) > 0, S);
|
||
|
||
// Пан 1: без подключённого радио его нет ни в потолке (TRX_COUNT=1), ни
|
||
// живьём — в обоих случаях клиент обязан получить отказ, а не тишину.
|
||
C.SendText('audio_start:1;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('audio_start на несуществующий пан → ошибка',
|
||
(Pos('not running', S) > 0) or (Pos('bad receiver', S) > 0), S);
|
||
|
||
// Главный тракт живой: старт обязан пройти молча.
|
||
C.SendText('audio_start:0;');
|
||
S := C.WaitText('tci_error', 400);
|
||
Check('audio_start:0 без ошибок', S = '', S);
|
||
|
||
// Параметры потока принимаются и подтверждаются.
|
||
C.SendText('audio_samplerate:12000;');
|
||
S := C.WaitText('audio_samplerate', 1500);
|
||
Check('audio_samplerate:12000 подтверждён', Pos('12000', S) > 0, S);
|
||
C.SendText('audio_samplerate:44100;');
|
||
S := C.WaitText('audio_samplerate', 1500);
|
||
Check('audio_samplerate:44100 отвергнут', Pos('12000', S) > 0, S);
|
||
C.SendText('iq_samplerate:96000;');
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('iq_samplerate:96000 подтверждён', Pos('96000', S) > 0, S);
|
||
|
||
// ★Ответ обязан называть частоту, которую клиент РЕАЛЬНО получит.
|
||
// Контроллер сейчас на 192 кГц: просьба «384» невыполнима.
|
||
C.SendText('iq_samplerate:384000;');
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('iq_samplerate:384к при 192к источника → 192к',
|
||
Pos('192000', S) > 0, S);
|
||
|
||
// Сменился rate устройства — та же просьба стала выполнимой, и клиенту
|
||
// обязано прийти переобъявление без всякого запроса.
|
||
Ctrl.SetSampleRate(384000);
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('смена rate переобъявляет iq_samplerate', Pos('384000', S) > 0, S);
|
||
|
||
// Частоты Pluto: 576 кГц на 384 не делится — отдаём законные 192 кГц.
|
||
Ctrl.SetSampleRate(576000);
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('Pluto 576к: просьба 384к → 192к', Pos('192000', S) > 0, S);
|
||
Ctrl.SetSampleRate(192000);
|
||
C.WaitText('iq_samplerate', 1000);
|
||
|
||
// IF_LIMITS привязаны к rate устройства (§4.1: «высылается при подключении
|
||
// и изменении частоты дискретизации»).
|
||
Ctrl.SetSampleRate(96000);
|
||
S := C.WaitText('if_limits', 1500);
|
||
Check('смена rate переобъявляет if_limits',
|
||
(Pos('-48000', S) > 0) and (Pos('48000', S) > 0), S);
|
||
Ctrl.SetSampleRate(192000);
|
||
C.WaitText('if_limits', 1000);
|
||
|
||
// Рекордер: сохранять нечего — честная ошибка вместо пустого файла.
|
||
C.SendText('line_out_recorder_save:0,' +
|
||
StringReplace(GetTempDir + 'tcitest_none.wav', ':', '|', [rfReplaceAll]) + ';');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('save без записи → ошибка', Pos('nothing recorded', S) > 0, S);
|
||
|
||
C.SendText('line_out_recorder_start:0,10;');
|
||
C.SendText('line_out_recorder_save:0,' +
|
||
StringReplace(GetTempDir + 'tcitest_none.mp3', ':', '|', [rfReplaceAll]) + ';');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('save в mp3 → ошибка', Pos('only wav', S) > 0, S);
|
||
C.SendText('line_out_recorder_break:0;');
|
||
|
||
// TRX с источником tci: без запущенного аудиопотока просьба не действует.
|
||
C.SendText('audio_stop:0;');
|
||
C.SendText('trx:0,true,tci;');
|
||
C.WaitText('trx:', 1000);
|
||
Check('trx tci без потока не берёт модуляцию',
|
||
not Ctrl.TCIMicRequested);
|
||
C.SendText('trx:0,false;');
|
||
C.WaitText('trx:', 1000);
|
||
|
||
C.SendText('audio_start:0;');
|
||
C.SendText('trx:0,true,tci;');
|
||
C.Pump(300);
|
||
Check('trx tci с потоком берёт модуляцию', Ctrl.TCIMicRequested);
|
||
// ★Проверяем и сам эфир, а не только флаг источника: раньше SetMOX по этой
|
||
// дороге падал в Access violation (SyncCWKeyer → SendDUCSpecificFromSettings
|
||
// при FNetwork = nil), ошибку глотал обработчик команды, и «передача» жила
|
||
// только в ответе клиенту.
|
||
Check('trx:0,true поднял передачу', Ctrl.FTransmitting);
|
||
|
||
// Второй TCI-клиент не должен перехватывать ни аудио, ни
|
||
// владение уже идущей TCI-передачей. Ждём истечения hold,
|
||
// иначе вторая команда будет отклонена ещё до этой проверки.
|
||
C2 := TRawClient.Create;
|
||
try
|
||
Check('конкурирующий клиент подключился', C2.Connect(PORT));
|
||
Check('конкурирующему пришёл ready', C2.WaitText('ready;', 2000) <> '');
|
||
C2.SendText('audio_start:0;');
|
||
Sleep(300);
|
||
C2.SendText('trx:0,true,tci;');
|
||
C2.Pump(300);
|
||
GotBinary := False;
|
||
while C2.NextFrame(Op, Pay) do
|
||
if Op = $02 then GotBinary := True;
|
||
Check('конкурирующий клиент не получил TX_CHRONO', not GotBinary);
|
||
C2.Close_;
|
||
Sleep(600);
|
||
Check('уход второго TCI-клиента не снял эфир первого',
|
||
Ctrl.FTransmitting);
|
||
Check('после ухода второго остался один клиент',
|
||
Ad.ClientCount = 1, IntToStr(Ad.ClientCount));
|
||
finally
|
||
C2.Close_;
|
||
C2.Free;
|
||
end;
|
||
|
||
C.SendText('trx:0,false;');
|
||
C.Pump(300);
|
||
Check('снятие TRX снимает источник', not Ctrl.TCIMicRequested);
|
||
Check('снятие TRX сняло передачу', not Ctrl.FTransmitting);
|
||
|
||
// ★arg1 у TRX/TUNE — номер передатчика, и он обязан разбираться, как всюду:
|
||
// раньше он игнорировался целиком, и клиент доп. приёмника уводил в эфир
|
||
// слайс оператора (чужая частота, а с кросс-бандом — чужой диапазон).
|
||
C.SendText('trx:9,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('trx:9 → ошибка, а не эфир', Pos('bad receiver', S) > 0, S);
|
||
Check('trx:9 не поднял передачу', not Ctrl.FTransmitting);
|
||
|
||
C.SendText('trx:abc,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('trx:abc → ошибка', Pos('bad receiver', S) > 0, S);
|
||
Check('trx:abc не поднял передачу', not Ctrl.FTransmitting);
|
||
|
||
// Приёмник 1 без подключённого радио: либо вне потолка, либо не запущен —
|
||
// но в эфир по нему уходить нельзя ни в каком случае.
|
||
C.SendText('trx:1,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('trx на несуществующий приёмник → ошибка',
|
||
(Pos('not running', S) > 0) or (Pos('bad receiver', S) > 0), S);
|
||
Check('trx на несуществующий приёмник не поднял передачу',
|
||
not Ctrl.FTransmitting);
|
||
|
||
C.SendText('tune:9,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('tune:9 → ошибка', Pos('bad receiver', S) > 0, S);
|
||
Check('tune:9 не включил TUN', not Ctrl.FTuning);
|
||
|
||
// Ответ называет приёмник, чей слайс реально в эфире. Без радио источник
|
||
// передачи — главный VFO, то есть 0.
|
||
C.SendText('trx:0;');
|
||
S := C.WaitText('trx:', 1000);
|
||
Check('ответ trx называет передающий приёмник', Pos('trx:0,', S) > 0, S);
|
||
C.SendText('tune:0;');
|
||
S := C.WaitText('tune:', 1000);
|
||
Check('ответ tune называет передающий приёмник', Pos('tune:0,', S) > 0, S);
|
||
|
||
// TUN через TCI: включается и гасится, и снятие возвращает всё на место.
|
||
// Ждём временем, а не WaitText: на каждую смену состояния уходит ДВА
|
||
// сообщения (ответ автору + рассылка по rfTuning), и WaitText поймал бы
|
||
// хвост предыдущей команды, не дождавшись текущей.
|
||
C.SendText('tune:0,true;');
|
||
C.Pump(300);
|
||
Check('tune:0,true включил TUN', Ctrl.FTuning);
|
||
C.SendText('tune:0,false;');
|
||
C.Pump(300);
|
||
Check('tune:0,false выключил TUN', not Ctrl.FTuning);
|
||
Check('после TUN передача снята', not Ctrl.FTransmitting);
|
||
|
||
// ★Передача, начатая ОПЕРАТОРОМ: клиент не вправе ни увести из неё
|
||
// микрофон, ни подмешать в неё настроечный тон. SetMOX(True) поверх уже
|
||
// идущей передачи не выходит рано — он заново выбирает источник модуляции,
|
||
// и «trx:0,true,tci» посреди чужой передачи уводил её в ринг TCI, не
|
||
// становясь при этом хозяином эфира.
|
||
// Пауза перед командой обязательна: смену состояния оператором адаптер
|
||
// тоже захватывает (§3.5, 200 мс), и без неё команду отклонили бы по
|
||
// совсем другой причине — проверка прошла бы вхолостую.
|
||
Ctrl.SetMOX(True);
|
||
Check('оператор в эфире', Ctrl.FTransmitting);
|
||
Sleep(300);
|
||
C.SendText('trx:0,true,tci;');
|
||
C.Pump(300);
|
||
Check('trx поверх чужой передачи не уводит микрофон',
|
||
not Ctrl.TCIMicRequested);
|
||
Check('trx поверх чужой передачи её не трогает', Ctrl.FTransmitting);
|
||
Sleep(300);
|
||
C.SendText('tune:0,true;');
|
||
C.Pump(300);
|
||
Check('tune поверх чужой передачи не включает тон', not Ctrl.FTuning);
|
||
Ctrl.SetMOX(False);
|
||
Check('передачу оператора снимает оператор', not Ctrl.FTransmitting);
|
||
|
||
// Бинарный блок не нашего типа обязан быть проигнорирован, а соединение —
|
||
// остаться рабочим (клиент шлёт их пачками, рвать связь нельзя).
|
||
TCIFillHeader(H, tstIQ, 0, 48000, tsyFloat32, 4, 2);
|
||
Move(H, Blk[0], SizeOf(H));
|
||
C.SendBinary(Blk[0], SizeOf(H) + 32);
|
||
C.SendText('iq_samplerate:48000;');
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('чужой бинарный блок не рвёт связь', Pos('48000', S) > 0, S);
|
||
|
||
// Маркеров TX_CHRONO без передачи быть не должно.
|
||
C.Pump(200);
|
||
GotBinary := False;
|
||
while C.NextFrame(Op, Pay) do
|
||
if Op = $02 then GotBinary := True;
|
||
Check('без передачи маркеров нет', not GotBinary);
|
||
|
||
// ★Уход клиента снимает только ЕГО передачу. Ставим в эфир оператора,
|
||
// клиент безуспешно просит TRX поверх — и уходит: передача обязана остаться.
|
||
Ctrl.SetMOX(True);
|
||
Sleep(300);
|
||
C.SendText('trx:0,true,tci;');
|
||
C.Pump(300);
|
||
|
||
// ★Обычный TCP-разрыв БЕЗ close-кадра: так уходит и упавший клиент, и
|
||
// выдернутый кабель. recv отдаёт 0, и это EOF, а не таймаут — errno при
|
||
// нём не трогается и вполне может нести EAGAIN от прошлого истёкшего
|
||
// TCI_POLL_MS. Пока сервер спрашивал errno, слот не освобождался вовсе:
|
||
// после нескольких аварийных отключений новые клиенты не подключались.
|
||
C.Close_;
|
||
Sleep(300);
|
||
Check('уход клиента не снял чужую передачу', Ctrl.FTransmitting);
|
||
Ctrl.SetMOX(False);
|
||
Check('после ухода клиента источник снят', not Ctrl.TCIMicRequested);
|
||
Check('TCP-разрыв без close-кадра освобождает слот', Ad.ClientCount = 0,
|
||
IntToStr(Ad.ClientCount));
|
||
|
||
// Второй путь — штатное прощание по RFC: тоже слот, но через close-кадр.
|
||
C2 := TRawClient.Create;
|
||
try
|
||
Check('второй клиент подключился', C2.Connect(PORT));
|
||
Check('второму пришёл ready', C2.WaitText('ready;', 2000) <> '');
|
||
C2.SendClose;
|
||
// Сервер обязан ответить своим close-кадром (§5.5.1) и уйти.
|
||
GotClose := False;
|
||
C2.Pump(300);
|
||
while C2.NextFrame(Op, Pay) do
|
||
if Op = $08 then GotClose := True;
|
||
Check('на close-кадр отвечает close-кадром', GotClose);
|
||
Sleep(200);
|
||
Check('close-кадр освобождает слот', Ad.ClientCount = 0,
|
||
IntToStr(Ad.ClientCount));
|
||
finally
|
||
C2.Close_;
|
||
C2.Free;
|
||
end;
|
||
finally
|
||
C.Free;
|
||
Ad.Free;
|
||
Ctrl.Free;
|
||
Host.Free;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
E. Сквозной прогон: живой движок → тап → блоки клиенту
|
||
|
||
Единственная часть, где проверяется сам маршрут данных: синтетический
|
||
24-битный IQ подаётся в WDSP, а на другом конце WebSocket ожидаются блоки
|
||
RX-аудио и IQ с верными заголовками.
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TestEndToEnd;
|
||
const
|
||
PORT = 40098;
|
||
RATE = 48000;
|
||
PAIRS = 238; // как в пакете DDC openHPSDR
|
||
var
|
||
Ctrl: TRadioController;
|
||
Ad: TTCIAdapter;
|
||
Host: THost;
|
||
Cfg: TTCISettings;
|
||
C: TRawClient;
|
||
Pkt: array[0..PAIRS * 6 - 1] of Byte;
|
||
i, k, n, Phase: Integer;
|
||
V: LongInt;
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
H: TTCIStreamHeader;
|
||
AudioBlocks, IQBlocks, BadHdr: Integer;
|
||
SliceId: Integer;
|
||
SV: TSliceView;
|
||
S: string;
|
||
begin
|
||
WriteLn('E. Сквозной прогон через движок');
|
||
|
||
Host := THost.Create;
|
||
Ctrl := TRadioController.Create;
|
||
Ctrl.LocalAudioEnabled := False;
|
||
Ctrl.OnInvoke := Host.DoInvoke;
|
||
Ctrl.FSampleRate := RATE;
|
||
Ctrl.CreateEngines(RATE);
|
||
// Линейный выход навешивает хост (в GUI и демоне — тоже он).
|
||
Ctrl.FDSPEngine.OnAudio := Ctrl.OnAudioReady;
|
||
Ctrl.FDSPEngine.OnTXIQ := Host.OnTXIQ;
|
||
C := nil;
|
||
Ad := nil;
|
||
try
|
||
if not Ctrl.FDSPEngine.Open then
|
||
begin
|
||
WriteLn(' -- движок не поднялся (', Ctrl.FDSPEngine.LastError,
|
||
') — сквозной прогон пропущен');
|
||
Exit;
|
||
end;
|
||
Ad := TTCIAdapter.Create(Ctrl, nil);
|
||
Cfg.Enabled := True;
|
||
Cfg.Port := PORT;
|
||
Cfg.BindAddr := '127.0.0.1';
|
||
if not Ad.ApplySettings(Cfg) then
|
||
begin
|
||
Check('сквозной: сервер поднялся', False);
|
||
Exit;
|
||
end;
|
||
|
||
C := TRawClient.Create;
|
||
if not C.Connect(PORT) then
|
||
begin
|
||
Check('сквозной: клиент подключился', False);
|
||
Exit;
|
||
end;
|
||
C.WaitText('ready;', 2000);
|
||
|
||
C.SendText('audio_samplerate:12000;');
|
||
C.WaitText('audio_samplerate', 1000);
|
||
C.SendText('audio_stream_samples:256;');
|
||
C.SendText('audio_start:0;');
|
||
C.SendText('iq_samplerate:48000;');
|
||
C.SendText('iq_start:0;');
|
||
C.Pump(200);
|
||
|
||
// Полсекунды тона 1 кГц пакетами по 238 пар.
|
||
Phase := 0;
|
||
for k := 0 to (RATE div 2) div PAIRS do
|
||
begin
|
||
for i := 0 to PAIRS - 1 do
|
||
begin
|
||
V := Round(Cos(2 * Pi * 1000 * Phase / RATE) * 4000000);
|
||
Pkt[i * 6] := Byte(V shr 16);
|
||
Pkt[i * 6 + 1] := Byte(V shr 8);
|
||
Pkt[i * 6 + 2] := Byte(V);
|
||
V := Round(Sin(2 * Pi * 1000 * Phase / RATE) * 4000000);
|
||
Pkt[i * 6 + 3] := Byte(V shr 16);
|
||
Pkt[i * 6 + 4] := Byte(V shr 8);
|
||
Pkt[i * 6 + 5] := Byte(V);
|
||
Inc(Phase);
|
||
end;
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
// Реальный темп: 238 пар при 48 кГц — это ~5 мс.
|
||
if (k mod 10) = 0 then Sleep(5);
|
||
end;
|
||
C.Pump(500);
|
||
|
||
AudioBlocks := 0;
|
||
IQBlocks := 0;
|
||
BadHdr := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
begin
|
||
if Op <> $02 then Continue;
|
||
if Length(Pay) < SizeOf(H) then begin Inc(BadHdr); Continue; end;
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if H.StreamType = LongWord(Ord(tstRXAudio)) then
|
||
begin
|
||
Inc(AudioBlocks);
|
||
// В аудиопотоке length — сэмплы НА КАНАЛ (AUDIO_STREAM_SAMPLES), то
|
||
// есть ровно то, что просили, а байт в блоке length × channels × 4.
|
||
if (H.SampleRate <> 12000) or (H.Receiver <> 0) or
|
||
(H.DataLength <> 256) or
|
||
(Length(Pay) <> SizeOf(H) +
|
||
Integer(H.DataLength) * Integer(H.Channels) * 4) then
|
||
Inc(BadHdr);
|
||
end
|
||
else if H.StreamType = LongWord(Ord(tstIQ)) then
|
||
begin
|
||
Inc(IQBlocks);
|
||
// А в IQ — вещественные отсчёты (комплексных вдвое меньше, §3.4).
|
||
if (H.SampleRate <> 48000) or (H.Channels <> 2) or
|
||
(Length(Pay) <> SizeOf(H) + Integer(H.DataLength) * 4) then Inc(BadHdr);
|
||
end;
|
||
end;
|
||
Check('сквозной: блоки RX-аудио пришли', AudioBlocks > 0, IntToStr(AudioBlocks));
|
||
Check('сквозной: блоки IQ пришли', IQBlocks > 0, IntToStr(IQBlocks));
|
||
Check('сквозной: заголовки верны', BadHdr = 0, IntToStr(BadHdr));
|
||
|
||
// ── ★Слайс главного пана = приёмник 1 ────────────────────────────────
|
||
// Ровно случай Pluto: панов больше одного там не бывает, и «второй
|
||
// приёмник» существует только как слайс. Приёмник = слот слайса, поэтому
|
||
// первый созданный слайс (слот 0, буква B) обязан стать приёмником 1 —
|
||
// единственным номером сверх нулевого, который умеют клиенты вроде MSHV.
|
||
SliceId := Ctrl.AddSlice(Ctrl.FCenterFreq + 3000, MODE_USB, 200, 2800,
|
||
agcMedium, 0.5, -1, '', 0);
|
||
Check('слайс на главном пане создан', SliceId > 0, IntToStr(SliceId));
|
||
C.Pump(300);
|
||
while C.NextFrame(Op, Pay) do ; // выгребаем рассылку о появлении
|
||
|
||
// Инициализация MSHV — это ровно один запрос и ровно один ответ
|
||
// (network.cpp, Network::initAll: `vfo:<rx>,0;` пять раз, потом
|
||
// «Error To Initialize TCI Server»).
|
||
C.SendText('vfo:1,0;');
|
||
S := C.WaitText('vfo:1,0,', 1500);
|
||
Check('слайс отвечает на vfo:1,0 (инициализация MSHV)', S <> '', S);
|
||
Check('слайс отдаёт свою частоту',
|
||
Pos(IntToStr(Round(Ctrl.FCenterFreq + 3000)), S) > 0, S);
|
||
|
||
// Управление: то, чего от слайса и хотят.
|
||
C.SendText('vfo:1,0,' + IntToStr(Round(Ctrl.FCenterFreq + 5000)) + ';');
|
||
C.Pump(300);
|
||
Check('слайсом можно управлять по TCI',
|
||
Ctrl.GetSliceView(SliceId, SV) and
|
||
(Abs(SV.TargetHz - (Ctrl.FCenterFreq + 5000)) < 2),
|
||
FloatToStr(SV.TargetHz));
|
||
|
||
// Аудиопоток приёмника 1 — это звук слайса, и в заголовке стоит его номер
|
||
// (MSHV отбрасывает блоки с чужим receiver: network.cpp:231).
|
||
C.SendText('audio_start:1;');
|
||
C.Pump(100);
|
||
for k := 0 to 40 do
|
||
begin
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
Sleep(2);
|
||
end;
|
||
C.Pump(400);
|
||
n := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if (Op = $02) and (Length(Pay) >= SizeOf(H)) then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if (H.StreamType = LongWord(Ord(tstRXAudio))) and (H.Receiver = 1) then
|
||
Inc(n);
|
||
end;
|
||
Check('аудио слайса идёт под номером 1', n > 0, IntToStr(n));
|
||
C.SendText('audio_stop:1;');
|
||
C.Pump(200);
|
||
|
||
// Удалили слайс — приёмник исчез, и врать про его частоту нельзя.
|
||
Ctrl.RemoveSlice(SliceId);
|
||
C.Pump(300);
|
||
while C.NextFrame(Op, Pay) do ;
|
||
C.SendText('vfo:1,0;');
|
||
S := C.WaitText('vfo:1,0,', 800);
|
||
Check('после удаления слайса приёмник 1 молчит', S = '', S);
|
||
|
||
// Остановка потока обязана прекратить подачу.
|
||
C.SendText('audio_stop:0;');
|
||
C.SendText('iq_stop:0;');
|
||
C.Pump(200);
|
||
while C.NextFrame(Op, Pay) do ; // выгребаем хвост
|
||
for k := 0 to 40 do
|
||
begin
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
Sleep(1);
|
||
end;
|
||
C.Pump(300);
|
||
n := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if Op = $02 then Inc(n);
|
||
Check('сквозной: после STOP блоков нет', n = 0, IntToStr(n));
|
||
|
||
// ── TX: маркеры времени и приём аудио клиента ──
|
||
// Радио не подключено, поэтому передачу поднимаем «на движке»: нам важен
|
||
// маршрут TCI → ринг микрофона, а не сама излучающая часть.
|
||
Ctrl.FWDSPReady := True;
|
||
C.SendText('audio_samplerate:12000;');
|
||
C.WaitText('audio_samplerate', 1000);
|
||
C.SendText('audio_stream_samples:256;');
|
||
C.SendText('audio_start:0;');
|
||
C.SendText('trx:0,true,tci;');
|
||
C.WaitText('trx:', 1000);
|
||
Check('TX: модуляция из TCI взята', Ctrl.TCIMicActive);
|
||
|
||
C.Pump(400);
|
||
n := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if (Op = $02) and (Length(Pay) >= SizeOf(H)) then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if H.StreamType = LongWord(Ord(tstTXChrono)) then
|
||
begin
|
||
Inc(n);
|
||
if (H.SampleRate <> 12000) or (H.DataLength <> 256) then
|
||
Inc(BadHdr);
|
||
end;
|
||
end;
|
||
Check('TX: маркеры TX_CHRONO идут', n > 0, IntToStr(n));
|
||
|
||
// Блок TX-аудио 12 кГц float32 моно: в ринг микрофона должно попасть
|
||
// вчетверо больше отсчётов (12 → 48 кГц).
|
||
TCIFillHeader(H, tstTXAudio, 0, 12000, tsyFloat32, 256, 1);
|
||
Move(H, Pkt[0], SizeOf(H));
|
||
for i := 0 to 255 do
|
||
PSingle(@Pkt[SizeOf(H) + i * 4])^ := Sin(2 * Pi * 700 * i / 12000) * 0.5;
|
||
C.SendBinary(Pkt[0], SizeOf(H) + 256 * 4);
|
||
// Наблюдаем не ринг (его вычерпывает TX-поток быстрее опроса), а выход
|
||
// тракта: блоки TX-IQ появляются только если аудио клиента дошло.
|
||
for i := 0 to 7 do C.SendBinary(Pkt[0], SizeOf(H) + 256 * 4);
|
||
Sleep(400);
|
||
Check('TX: аудио клиента прошло тракт', TXIQBlocks > 0, IntToStr(TXIQBlocks));
|
||
|
||
// Обрыв прямо во время клиентской TRX: здесь движок и FNetwork
|
||
// созданы, но радиобэкенд не подключён — RF-выхода нет.
|
||
Check('перед обрывом TRX активен', Ctrl.FTransmitting);
|
||
C.Close_;
|
||
Sleep(300);
|
||
Check('после ухода клиента источник снят', not Ctrl.TCIMicRequested);
|
||
Check('после ухода клиента MOX снят', not Ctrl.FTransmitting);
|
||
Ctrl.FWDSPReady := False;
|
||
finally
|
||
if C <> nil then begin C.Close_; C.Free; end;
|
||
Ad.Free;
|
||
Ctrl.Free;
|
||
Host.Free;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Randomize;
|
||
Passed := 0;
|
||
Failed := 0;
|
||
WriteLn('=== Стенд TCI, этап 2 (бинарные потоки) ===');
|
||
TestProtocol;
|
||
TestResampling;
|
||
TestStreamOut;
|
||
TestRecorder;
|
||
TestServer;
|
||
TestEndToEnd;
|
||
WriteLn;
|
||
WriteLn(Format('Итого: %d проверок, провалено %d', [Passed + Failed, Failed]));
|
||
if Failed > 0 then Halt(1);
|
||
end.
|