ewsdr/test/tci/tcitest.pas

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;
  Base: string;
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 — вещественные отсчёты ВСЕГО блока, и у аудио тоже: клиенты
  // считают по нему число байт (MSHV: `cr2 = length*bit_s`). Объявишь «на
  // канал» — у стерео разберётся половина блока, и звук пойдёт с дырами.
  Check('header length аудио = ×каналы', H.DataLength = 1024);
  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 = 512);
  // Моно: отсчётов столько же, сколько сэмплов на канал.
  TCIFillHeader(H, tstRXAudio, 0, 12000, tsyInt16, 512, 1);
  Check('header length моно = сэмплы', H.DataLength = 512);

  // Упаковка/распаковка: сквозной проход по всем форматам.
  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);

  // ★Имя файла записи: каталог из просьбы клиента не берётся НИКОГДА —
  // авторизации в TCI нет, и полный путь из сети означал бы запись в любой
  // доступный процессу файл. Берём одно имя и кладём в свой каталог.
  Base := IncludeTrailingPathDelimiter(GetTempDir) + 'tcirec';
  Check('путь: простое имя',
        TCIRecordPath(Base, 'rec.wav') =
        IncludeTrailingPathDelimiter(Base) + 'rec.wav',
        TCIRecordPath(Base, 'rec.wav'));
  Check('путь: каталог из просьбы отброшен',
        TCIRecordPath(Base, 'home/user/rec_dir/a.wav') =
        IncludeTrailingPathDelimiter(Base) + 'a.wav',
        TCIRecordPath(Base, 'home/user/rec_dir/a.wav'));
  Check('путь: абсолютный не выводит наружу',
        TCIRecordPath(Base, '/etc/passwd.wav') =
        IncludeTrailingPathDelimiter(Base) + 'passwd.wav',
        TCIRecordPath(Base, '/etc/passwd.wav'));
  Check('путь: .. не выводит наружу',
        TCIRecordPath(Base, '../../../home/vladimir/.bashrc.wav') =
        IncludeTrailingPathDelimiter(Base) + '.bashrc.wav',
        TCIRecordPath(Base, '../../../home/vladimir/.bashrc.wav'));
  Check('путь: буква диска (| → :) не выводит наружу',
        TCIRecordPath(Base, 'D|\\rec\\a.wav') =
        IncludeTrailingPathDelimiter(Base) + 'a.wav',
        TCIRecordPath(Base, 'D|\\rec\\a.wav'));
  Check('путь: пусто — отказ',        TCIRecordPath(Base, '') = '');
  Check('путь: только каталог — отказ', TCIRecordPath(Base, 'a/b/') = '');
  Check('путь: «..» — отказ',         TCIRecordPath(Base, '..') = '');
  Check('путь: не .wav — отказ',      TCIRecordPath(Base, 'a.mp3') = '');
  Check('путь: управляющий символ — отказ',
        TCIRecordPath(Base, 'a' + #10 + 'b.wav') = '');
  Check('путь: без каталога — отказ', TCIRecordPath('', 'a.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 <> 1024) or       // вещественных отсчётов = 512 × 2
         (H.StreamType <> LongWord(Ord(tstRXAudio))) or
         (H.Format <> LongWord(Ord(tsyFloat32))) or
         // ★Правило, по которому живут клиенты: байт данных = length × размер
         // отсчёта. Ровно так считает MSHV (`cr2 = length*bit_s`).
         (Length(Pay) <> SizeOf(H) + Integer(H.DataLength) * 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
  ═══════════════════════════════════════════════════════════════════════════ }

function FlatTake(const T: TTCIRecTake): TTCIPcm;
// Склейка кусков записи в один буфер. Живёт ТОЛЬКО в стенде: продовый путь
// сплошной копии не делает вовсе — писатель пишет куски подряд, иначе на
// полном бюджете рядом жили бы куски и их копия, то есть двойной пик.
var C, n, Left: Integer;
begin
  Result := nil;
  if T.Count <= 0 then Exit;
  SetLength(Result, T.Count * 2);
  Left := T.Count;
  for C := 0 to High(T.Chunks) do
  begin
    if Left <= 0 then Break;
    n := T.Chunk;
    if n > Left then n := Left;
    Move(T.Chunks[C][0], Result[(T.Count - Left) * 2], n * 2 * SizeOf(SmallInt));
    Dec(Left, n);
  end;
end;

function MakeTake(const Data: TTCIPcm; Reserved: Int64): TTCIRecTake;
// Одно задание писателю из готового куска: в проде куски приносит Take.
begin
  Result.Chunks := nil;
  SetLength(Result.Chunks, 1);
  Result.Chunks[0] := Data;
  Result.Chunk     := Length(Data) div 2;
  Result.Count     := Result.Chunk;
  Result.Reserved  := Reserved;
end;

function Drained(W: TTCIWavWriter; TimeoutMs: Integer): Boolean;
// Ограниченное ожидание очереди — ТОЛЬКО для стенда: у писателя WaitDrained
// срока не имеет (см. TCIStopWriter), а зависший стенд ничего не сообщает.
var Waited: Integer;
begin
  Waited := 0;
  while (W.Pending > 0) and (Waited < TimeoutMs) do
  begin
    Sleep(5);
    Inc(Waited, 5);
  end;
  Result := W.Pending = 0;
end;

function PartFiles(const Path: string): Integer;
// Сколько временных файлов писателя осталось рядом с целью.
var SR: TSearchRec;
begin
  Result := 0;
  if FindFirst(Path + '.*', faAnyFile, SR) = 0 then
  begin
    repeat
      Inc(Result);
    until FindNext(SR) <> 0;
  end;
  FindClose(SR);
end;

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;
  Was: Int64;
  Tk: TTCIRecTake;
  Big: TTCIPcm;
  Refused, k, Bad: Integer;
  Path2: string;
begin
  WriteLn('C. Рекордер линейного выхода');

  // Максимум записи — 1 секунда: подаём полторы, лишнее не берём. ★Именно НЕ
  // берём: окно записи по §4.3 начинается со START, а не «последняя секунда».
  Was := TCIRecBudgetUsed;              // счёт бюджета ДО записи
  Rec := TTCIRecorder.Create(0, 48000, 1, nil);
  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;
    Tk := Rec.Take; Data := FlatTake(Tk);
    Check('рекордер: длина по максимуму', Length(Data) = 48000 * 2,
          IntToStr(Length(Data)));
    // ★Take отдаёт данные ВМЕСТЕ с их местом в бюджете: копия живёт дальше в
    // писателе, и до конца записи она обязана оставаться учтённой. Иначе SAVE
    // был бы дырой в потолке — куски вернулись бы сразу, а копия висела бы
    // неучтённой, и очередь сохранений на медленном диске росла бы без границ.
    // ★Куски отдаются КАК ЕСТЬ: сплошной копии нет ни на миг, поэтому и пика
    // в два бюджета нет. Резерв переезжает вместе с ними — целиком.
    Check('рекордер: Take отдаёт сами куски, не копию',
          (Length(Tk.Chunks) > 0) and (Tk.Count = Length(Data) div 2),
          IntToStr(Length(Tk.Chunks)));
    Check('рекордер: резерв переехал целиком, счёт не изменился',
          TCIRecBudgetUsed = Was + Tk.Reserved,
          IntToStr(TCIRecBudgetUsed - Was) + '/' + IntToStr(Tk.Reserved));
    Check('рекордер: резерва хватает на отданные куски',
          Tk.Reserved >= Int64(Length(Data)) * SizeOf(SmallInt),
          IntToStr(Tk.Reserved));
    TCIRecBudgetFree(Tk.Reserved);        // как это сделает писатель
    Tk.Chunks := nil;
    Check('рекордер: возврат резерва закрывает счёт',
          TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was));
    Check('рекордер: уровень сохранён',
          (Data[0] = Round(0.25 * 32767)) and (Data[1] = -Round(0.25 * 32767)));
    Check('рекордер: Take завершает запись', Length(FlatTake(Rec.Take)) = 0);
  finally
    Rec.Free;
  end;

  // ★Отдаются именно куски, а не свёрнутая в один буфер копия: 2.5 секунды
  // при куске в секунду — это ТРИ куска. Если бы Take собирал сплошную копию
  // (как было), кусок пришёл бы один, а пик памяти на полном бюджете вырос бы
  // вдвое: 128 МБ кусков и 128 МБ копии рядом, при счётчике в 128.
  Was := TCIRecBudgetUsed;
  Rec := TTCIRecorder.Create(0, 48000, 3, nil);
  try
    for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end;
    Total := 0;
    while Total < 120000 do            // 2.5 с при 48 кГц
    begin
      Rec.Feed(L, R, 8192);
      Inc(Total, 8192);
    end;
    Tk := Rec.Take;
    Check('рекордер: кусков ровно по секундам записи',
          (Tk.Chunk = 48000) and (Length(Tk.Chunks) = 3) and
          (Tk.Count >= 120000),
          IntToStr(Length(Tk.Chunks)) + ' × ' + IntToStr(Tk.Chunk));
    Check('рекордер: сплошной копии не появилось',
          TCIRecBudgetUsed = Was + Tk.Reserved,
          IntToStr(TCIRecBudgetUsed - Was));
    Data := FlatTake(Tk);
    Check('рекордер: куски склеиваются в непрерывный звук',
          (Length(Data) = Tk.Count * 2) and
          (Data[0] = Round(0.25 * 32767)) and
          (Data[Length(Data) - 2] = Round(0.25 * 32767)));
    Tk.Chunks := nil;
    TCIRecBudgetFree(Tk.Reserved);
  finally
    Rec.Free;
  end;
  Check('рекордер: счёт закрыт', TCIRecBudgetUsed = Was);

  // Порядок отсчётов: первым обязан идти самый ПЕРВЫЙ записанный.
  Rec := TTCIRecorder.Create(0, 1000, 1, nil);   // ёмкость 1000 отсчётов
  try
    for i := 0 to 1499 do
    begin
      L[0] := i / 4000.0;
      R[0] := 0;
      Rec.Feed(L, R, 1);
    end;
    Tk := Rec.Take; Data := FlatTake(Tk);
    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, nil);
  try
    for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end;
    Rec.Feed(L, R, 8192);
    Check('рекордер: до срока запись есть', Length(FlatTake(Rec.Take)) > 0);
  finally
    Rec.Free;
  end;
  Rec := TTCIRecorder.Create(0, 48000, 1, nil);
  try
    Rec.Feed(L, R, 8192);
    Sleep(1100);                         // окно закрылось
    Check('рекордер: после срока запись удалена', Length(FlatTake(Rec.Take)) = 0);
    Rec.Feed(L, R, 8192);                // и новое аудио уже не принимает
    Check('рекордер: истёкший не оживает', Length(FlatTake(Rec.Take)) = 0);
  finally
    Rec.Free;
  end;

  // ★Бюджет памяти. Раньше конструктор выделял MaxSec × 48 кГц × 2 × int16
  // СРАЗУ — 57.6 МБ на строку из сети, 403 МБ на семь приёмников, и держать их
  // мог кто угодно (авторизации в TCI нет). Теперь START не стоит ни байта.
  Was := TCIRecBudgetUsed;
  Rec := TTCIRecorder.Create(0, 48000, TCI_RECORD_MAX_SEC, nil);
  try
    Check('бюджет: START не выделяет памяти', TCIRecBudgetUsed = Was,
          IntToStr(TCIRecBudgetUsed - Was));
    for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end;
    Rec.Feed(L, R, 8192);
    Check('бюджет: растёт по мере записи', TCIRecBudgetUsed > Was);
    Check('бюджет: кусками, а не всей ёмкостью',
          TCIRecBudgetUsed - Was <= 4 * 48000 * 2 * 2,
          IntToStr(TCIRecBudgetUsed - Was));
  finally
    Rec.Free;
  end;
  Check('бюджет: возвращается по Free', TCIRecBudgetUsed = Was);

  // Потолок общий на все рекордеры сразу — иначе семь живых приёмников по
  // 300 с всё равно дали бы 403 МБ.
  Check('бюджет: потолок берётся целиком',
        TCIRecBudgetTake(TCI_RECORD_MAX_BYTES - TCIRecBudgetUsed));
  Check('бюджет: сверх потолка отказ', not TCIRecBudgetTake(1));
  Rec := TTCIRecorder.Create(0, 48000, 10, nil);
  try
    Rec.Feed(L, R, 8192);
    Check('бюджет: при отказе запись не рушится, а стоит пустой',
          Length(FlatTake(Rec.Take)) = 0);
  finally
    Rec.Free;
  end;
  TCIRecBudgetFree(TCI_RECORD_MAX_BYTES - Was);
  Check('бюджет: после возврата снова можно брать', TCIRecBudgetTake(1));
  TCIRecBudgetFree(1);

  // ★Срок по ЧАСАМ спрашивает тик сервера: у мёртвого, молчащего или
  // замьюченного приёмника Feed не зовут вовсе, и без этого вопроса память
  // жила бы до остановки сервера.
  Rec := TTCIRecorder.Create(0, 48000, 1, nil);
  try
    Rec.Feed(L, R, 8192);
    Check('срок: до истечения окно открыто', not Rec.Expired);
    Check('срок: память занята', TCIRecBudgetUsed > Was);
    Sleep(1100);
    Check('срок: истекло без единого Feed', Rec.Expired);
    Check('срок: память отдана без Take и Free', TCIRecBudgetUsed = Was,
          IntToStr(TCIRecBudgetUsed - Was));
  finally
    Rec.Free;
  end;

  // ═══ WAV и писатель ═══════════════════════════════════════════════════
  // ★Писатель — ОДИН поток с очередью, которым владеет адаптер. Поток на
  // каждый SAVE с FreeOnTerminate не держал никто: штатный выход из программы
  // обрывал запись на полуслове (из 100000044 байт на диске оставалось
  // 40960), а медленный каталог плодил сотни потоков мимо бюджета.
  Path  := GetTempDir + 'tcitest_rec.wav';
  Path2 := GetTempDir + 'tcitest_rec2.wav';
  DeleteFile(Path);
  DeleteFile(Path2);
  SetLength(Data, 2000);
  for i := 0 to 1999 do Data[i] := i * 8;
  W := TTCIWavWriter.Create;

  Check('WAV: задание принято', W.Enqueue(Path, MakeTake(Data, 0), 48000));
  Check('WAV: очередь дописана', Drained(W, 5000));
  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;
    // ★Данные пишутся во временный файл и переименовываются поверх занятого
    // имени: по имени файла клиент считает запись готовой, и незаконченного
    // содержимого он там видеть не должен. После удачи «.part» не остаётся.
    Check('WAV: временный файл убран', PartFiles(Path) = 0,
          IntToStr(PartFiles(Path)));

    // ★Писатель отпускает резерв, когда данные ему больше не нужны — иначе
    // потолок памяти держал бы только сами записи, а очередь сохранений на
    // медленном диске росла бы мимо него.
    Was := TCIRecBudgetUsed;
    Check('WAV: резерв под писателя взят', TCIRecBudgetTake(4096));
    DeleteFile(Path);
    W.Enqueue(Path, MakeTake(Data, 4096), 48000);
    Drained(W, 5000);
    Check('WAV: писатель вернул резерв по окончании',
          TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was));

    // ★Существующий файл не трогаем: имя приходит из сети, и fmCreate затирал
    // бы любой доступный процессу файл. Пишем поверх заведомо другой длиной —
    // файл обязан остаться прежним.
    Tk := MakeTake(Copy(Data, 0, 10), 0);
    W.Enqueue(Path, Tk, 48000);
    Drained(W, 5000);
    FS := TFileStream.Create(Path, fmOpenRead);
    try
      // Публикация идёт link(2)/MoveFileW без замены: занятое имя = отказ.
    Check('WAV: существующий файл не перезаписан',
            FS.Size = 44 + 2000 * 2, IntToStr(FS.Size));
    finally
      FS.Free;
    end;
    Check('WAV: отказ не оставил временного файла', PartFiles(Path) = 0);
    DeleteFile(Path);
  end;

  // ★Запись не удалась на полпути — по имени не остаётся НИЧЕГО. Прежний код
  // не смотрел на результат записи вовсе (FileWrite и THandleStream.Write при
  // ошибке возвращают 0 и не поднимают исключения), и на полном диске
  // оставался огрызок с заголовком на полную длину. Здесь тот же путь:
  // счётчик обещает больше, чем есть в кусках.
  Tk := MakeTake(Data, 0);
  Tk.Count := Tk.Count * 3;             // кусков под это нет
  W.Enqueue(Path, Tk, 48000);
  Drained(W, 5000);
  Check('WAV: неудачная запись не оставила файла', not FileExists(Path));
  Check('WAV: неудачная запись не оставила «.part»', PartFiles(Path) = 0);

  // ★Целевого имени не существует, ПОКА запись не готова. Раньше по нему
  // сразу появлялась пустышка на 0 байт (имя занималось эксклюзивно, а данные
  // шли во временный файл), и на медленном диске клиент видел её всю запись —
  // а по имени файла он вправе считать запись готовой. Пишем 32 МБ и всё это
  // время следим за именем: увидели его непустым, но не полным, или пустым —
  // проверка красная.
  SetLength(Big, 16 * 1024 * 1024);     // 32 МБ: заведомо дольше, чем цикл ниже
  FillChar(Big[0], Length(Big) * SizeOf(SmallInt), 0);
  DeleteFile(Path2);
  W.Enqueue(Path2, MakeTake(Big, 0), 48000);
  Bad := 0;
  while W.Pending > 0 do
    if FileExists(Path2) then
    begin
      FS := TFileStream.Create(Path2, fmOpenRead or fmShareDenyNone);
      try
        if FS.Size <> 44 + Int64(Length(Big)) * SizeOf(SmallInt) then Inc(Bad);
      finally
        FS.Free;
      end;
    end;
  Check('WAV: незаконченной записи под целевым именем не видно', Bad = 0,
        IntToStr(Bad));
  Check('WAV: 32 МБ дописаны', Drained(W, 20000));
  DeleteFile(Path2);

  // ★Очередь ограничена. Раньше «сохранить» было равно «создать поток», и
  // зависший сетевой каталог давал их сотни — память стеков в бюджет не
  // входит. Занимаем писателя большой записью и стучимся сверх потолка.
  W.Enqueue(Path2, MakeTake(Big, 0), 48000);
  Refused := 0;
  for k := 0 to TCI_RECORD_MAX_JOBS + 3 do
    if not W.Enqueue(GetTempDir + Format('tcitest_q%d.wav', [k]),
                     MakeTake(Data, 0), 48000) then
      Inc(Refused);
  Check('очередь: сверх потолка заданий отказ', Refused > 0,
        IntToStr(Refused));
  Check('очередь: дописалась', Drained(W, 20000));
  for k := 0 to TCI_RECORD_MAX_JOBS + 3 do
    DeleteFile(GetTempDir + Format('tcitest_q%d.wav', [k]));

  // Гасят — новых заданий не принимаем: место в бюджете остаётся на
  // вызывающем, и он обязан его вернуть сам (так и делает CmdRecorder).
  W.Close;
  Check('очередь: после Close заданий не берём',
        not W.Enqueue(Path, MakeTake(Data, 0), 48000));
  TCIStopWriter(W);
  Check('очередь: TCIStopWriter обнуляет ссылку', W = nil);

  // ★★Главная проверка P1: закрытие программы ДОЖИДАЕТСЯ записи. Раньше
  // FreeOnTerminate-поток никто не ждал, и файл обрывался там, где его застал
  // выход. Здесь сразу после остановки писателя файл обязан быть целым.
  // ★И не только первый: за хвостом очереди клиенту тоже сказано «сохранено»,
  // поэтому ждём ВСЮ очередь (срок остановки считается от последнего
  // продвижения, а не от её начала).
  DeleteFile(Path2);
  for k := 0 to 1 do DeleteFile(GetTempDir + Format('tcitest_tail%d.wav', [k]));
  W := TTCIWavWriter.Create;
  Check('выход: задание принято', W.Enqueue(Path2, MakeTake(Big, 0), 48000));
  for k := 0 to 1 do
    W.Enqueue(GetTempDir + Format('tcitest_tail%d.wav', [k]),
              MakeTake(Data, 0), 48000);
  TCIStopWriter(W);
  Bad := 0;
  for k := 0 to 1 do
  begin
    Path := GetTempDir + Format('tcitest_tail%d.wav', [k]);
    if not FileExists(Path) then Inc(Bad)
    else
    begin
      FS := TFileStream.Create(Path, fmOpenRead);
      try
        if FS.Size <> 44 + 2000 * 2 then Inc(Bad);
      finally
        FS.Free;
      end;
      DeleteFile(Path);
    end;
  end;
  Check('выход: хвост очереди тоже дописан', Bad = 0, IntToStr(Bad));
  if not FileExists(Path2) then
    Check('выход: файл дописан до конца', False)
  else
  begin
    FS := TFileStream.Create(Path2, fmOpenRead);
    try
      Check('выход: файл дописан до конца',
            FS.Size = 44 + Int64(Length(Big)) * SizeOf(SmallInt),
            IntToStr(FS.Size));
    finally
      FS.Free;
    end;
    DeleteFile(Path2);
  end;
  Big := nil;
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;
  Was: Int64;
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);

    // ★Рекордер только на ЖИВОМ приёмнике. Раньше хватало номера в потолке, и
    // семь строк подряд занимали 403 МБ, которые никто не освобождал: у
    // мёртвого приёмника Feed не зовут, значит и срок никто не проверял.
    Was := TCIRecBudgetUsed;
    C.SendText('line_out_recorder_start:3,300;');
    S := C.WaitText('tci_error', 1500);
    Check('recorder start на мёртвом приёмнике → ошибка',
          Pos('receiver is not running', S) > 0, S);
    C.SendText('line_out_recorder_start:99,300;');
    S := C.WaitText('tci_error', 1500);
    Check('recorder start с чужим номером → ошибка',
          Pos('bad receiver', S) > 0, S);
    Check('recorder: отказ не стоил памяти', TCIRecBudgetUsed = Was,
          IntToStr(TCIRecBudgetUsed - Was));

    // Имя файла из сети: каталог из просьбы игнорируется целиком, наружу
    // записи не выходят (подробный разбор имён — в части A).
    C.SendText('line_out_recorder_start:0,10;');
    C.SendText('line_out_recorder_save:0,..' + '/' + '..' + '/etc/passwd;');
    S := C.WaitText('tci_error', 1500);
    Check('save с чужим путём → отказ по имени', Pos('bad file name', S) > 0, S);

    // Рекордер: сохранять нечего — честная ошибка вместо пустого файла.
    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, BadRx: Integer;
  SliceId: Integer;
  SV: TSliceView;
  S: string;
  Was: Int64;
  C2: TRawClient;
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 — вещественные отсчёты всего блока: просили 256 сэмплов на
        // канал, каналов 2, значит 512 отсчётов и столько же × 4 байта.
        if (H.SampleRate <> 12000) or (H.Receiver <> 0) or
           (H.DataLength <> 256 * Integer(H.Channels)) or
           (Length(Pay) <> SizeOf(H) + Integer(H.DataLength) * 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));

    // ── ★Запись линейного выхода и уход клиента ──────────────────────────
    // Рекордер живёт на приёмнике, но платит за него тот, кто нажал START.
    // Раньше уход клиента его не трогал вовсе: пары «подключился, START,
    // отключился» набивали память до потолка, и вернуть её было некому до
    // остановки сервера. Тут это видно насквозь — по общему бюджету.
    Was := TCIRecBudgetUsed;
    C2 := TRawClient.Create;
    try
      Check('запись: второй клиент подключился', C2.Connect(PORT));
      C2.WaitText('ready;', 2000);
      C2.SendText('line_out_recorder_start:0,300;');
      C2.Pump(100);
      for k := 0 to 40 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);
        Sleep(2);
      end;
      C2.Pump(200);
      Check('запись: набирает память по мере звука', TCIRecBudgetUsed > Was,
            IntToStr(TCIRecBudgetUsed - Was));
    finally
      C2.Close_;                    // уход без close-кадра, как при обрыве
      C2.Free;
    end;
    Sleep(400);
    Check('запись: уход клиента освобождает её память',
          TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was));

    // ── ★Слайс главного пана = приёмник 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));

    // ── ★TX со слайса: маркер обязан нести НОМЕР ЭТОГО приёмника ─────────
    // MSHV шлёт TX-аудио только в ответ на маркер TX_CHRONO и отбрасывает
    // ЛЮБОЙ входящий блок с чужим receiver (network.cpp:231 — `if
    // (pStream->receiver != tci_trx) return;`, ветка TxChrono — network.cpp:288
    // и далее). С жёстким нулём в заголовке клиент, сидящий на втором слайсе
    // (tci_trx = 1), поднимал эфир и молчал: маркеры до него не доходили, а
    // без них он не отправляет ни одного блока. Ровно это и наблюдалось на
    // живом железе с MSHV.
    Ctrl.FWDSPReady := True;
    Ctrl.SetSliceSlotAutoTx(Ctrl.SliceSlotOf(SliceId), True);
    C.SendText('trx:1,true,tci;');
    C.WaitText('trx:', 1500);
    Check('TX слайса: модуляция из TCI взята', Ctrl.TCIMicActive);
    C.Pump(400);
    n := 0;
    BadRx := 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.Receiver <> 1 then Inc(BadRx);
        end;
      end;
    Check('TX слайса: маркеры TX_CHRONO идут', n > 0, IntToStr(n));
    Check('TX слайса: маркер назван номером приёмника (MSHV фильтрует)',
          (n > 0) and (BadRx = 0), IntToStr(BadRx));
    C.SendText('trx:1,false;');
    C.WaitText('trx:', 1000);
    Ctrl.SetSliceSlotAutoTx(Ctrl.SliceSlotOf(SliceId), False);

    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 * Integer(H.Channels)) 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.