mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
feat(tci): этап 2 — бинарные потоки IQ/аудио, TX-аудио и запись линейного выхода
Реализованы все четыре потока §3.4 и рекордер:
• RX_AUDIO_STREAM — тап ДО громкости и мьюта (OnDemodAudioReady): скиммеру
и цифре нужен звук приёмника, а не то, что осталось после ручки;
• LINEOUT_STREAM — тап ПОСЛЕ (OnAudioReady), то есть что слышно;
• IQ_STREAM — тап сырого IQ в движке, ОДИН вызов на накопленный блок;
• TX_AUDIO_STREAM + TX_CHRONO — TRX:0,true,tci берёт модуляцию из потока
клиента (флаг TCIMicRequested впереди web в SetMOX), маркеры времени идут
из тика по часам, аудио клиента разворачивается в 48 кГц моно в тот же
ринг, что и web-микрофон;
• LINE_OUT_RECORDER_* — кольцо int16 на приёмник, WAV пишет отдельный поток.
Тапы аудио в контроллере многоадресные (AddAudioTap): слушают, ничего не
забирая, в отличие от OnAudioConsume, которым владеет web. Блоки нарезает и
раскладывает по кольцам клиентов сам DSP-поток, в сокет пишет поток клиента —
та же дисциплина, что у команд. Порядок локов везде FSliceLock → FStreamLock.
У очереди команд и кольца блоков разная политика переполнения: команду терять
нельзя, блок потока — можно (теряется самый старый).
Пересчёт частоты многоступенчатый (TCIStreams). Одноступенчатый FIR на верхнем
пресете Pluto (5760 кГц, коэффициент 120) упирался в потолок отводов и давал
завал 1.3 дБ в полосе при подавлении зеркала 16 дБ — то есть поток IQ с
мусором. Теперь коэффициент раскладывается на множители, спецификацию фильтра
каждой ступени задаёт ИТОГОВАЯ полоса, а свёртка идёт со сложением
симметричных пар: −83 дБ на любом коэффициенте, ≈10% ядра на 5.76 МГц.
Согласование частот с железом: из пресетов Pluto 576 и 960 кГц на 384 не
делятся, поэтому отдаём наибольшую ЗАКОННУЮ частоту, делящую источник нацело
(576/960 → 192 кГц). Ответ на IQ_SAMPLERATE называет достижимое, а не просьбу
клиента, и переобъявляется без запроса при смене rate и устройства.
Приёмный буфер соединения 4 → 32 КБ: блок TX-аудио это 64 байта заголовка плюс
data[16384], а кадр крупнее буфера не собирается никогда.
Настройки TCI переехали из Advanced на вкладку CAT, справа от TCP CAT Server:
это такой же канал внешнего управления трансивером.
Стенд (scratchpad, tcitest.pas): 112 проверок, все зелёные — включая сквозной
прогон через живой WDSP (синтетический IQ → блоки RX-аудио и IQ у настоящего
WS-клиента, и обратно TX-аудио клиента → блоки TX-IQ).
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
+859
@@ -0,0 +1,859 @@
|
||||
unit TCIStreams;
|
||||
|
||||
{
|
||||
TCIStreams.pas — бинарные потоки TCI (§3.4): нарезка сэмплов на блоки,
|
||||
пересчёт частоты дискретизации, запись линейного выхода в файл.
|
||||
|
||||
Чистый слой обработки: ни контроллера, ни движка тут нет — только TCIProtocol
|
||||
(формат блока) и TCIServer (очередь клиента). Кто и откуда кормит эти объекты,
|
||||
решает TCIAdapter.
|
||||
|
||||
★Главное про потоки исполнения. Feed* зовёт DSP-ПОТОК (тап аудио/IQ), то есть
|
||||
тот самый, который считает WDSP. Поэтому здесь нет ни одного вызова, который
|
||||
может ждать: блок уходит в кольцо клиента (микросекунды под его локом), а в
|
||||
сокет его пишет собственный поток клиента. Отставший клиент теряет свои блоки
|
||||
(TTCIClient.SendBin выбрасывает самый старый) и никого больше не задерживает.
|
||||
|
||||
Пересчёт частоты:
|
||||
• вниз (RX-аудио 48 кГц → 8/12/24, IQ 384 → 48/96/192) — FIR-дециматор с
|
||||
целым коэффициентом. Без фильтра тут нельзя: широкий ФМ-канал или шум за
|
||||
полосой сложились бы в звуковую полосу зеркалом;
|
||||
• вверх (TX-аудио клиента 8/12/24 кГц → 48 кГц тракта) — линейная
|
||||
интерполяция. Образы от неё лежат на 8..12 кГц и выше, то есть заведомо
|
||||
за полосой TX-фильтра (максимум 4 кГц), а завал в полосе — 0.2 дБ на
|
||||
3 кГц. Городить ради этого второй FIR смысла нет.
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$LONGSTRINGS ON}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math, SyncObjs, TCIProtocol, TCIServer;
|
||||
|
||||
const
|
||||
// Длина FIR на каждую ступень прореживания. Ntaps = TCI_FIR_PER_FACTOR×M+1
|
||||
// ⇒ стоимость на ВХОДНОЙ сэмпл постоянна (≈8 умножений) независимо от M.
|
||||
TCI_FIR_PER_FACTOR = 8;
|
||||
TCI_FIR_MAX_TAPS = 257;
|
||||
// Кусок, которым поток перемалывает подачу от движка. Все рабочие буферы
|
||||
// заведены под него в конструкторе: SetLength в DSP-потоке на каждый блок
|
||||
// аудио — это тысячи обращений к куче в секунду на ровном месте.
|
||||
TCI_FEED_CHUNK = 4096;
|
||||
|
||||
type
|
||||
{ Накопленная запись: 16-битный PCM с чередованием L/R. }
|
||||
TTCIPcm = array of SmallInt;
|
||||
|
||||
{ Дециматор с целым коэффициентом. Прямая свёртка по линии задержки: выход
|
||||
считается только на нужной фазе, поэтому цена не зависит от M. }
|
||||
TTCIDecimator = class
|
||||
private
|
||||
FTaps: array of Single;
|
||||
FHist: array of Single; // линия задержки, кольцо
|
||||
FN: Integer; // длина FIR
|
||||
FHalf: Integer; // FN div 2 — число симметричных пар
|
||||
FPos: Integer;
|
||||
FPhase: Integer;
|
||||
FFactor: Integer;
|
||||
public
|
||||
{ Одиночный дециматор: полоса 0.45 от новой частоты Найквиста, длина FIR
|
||||
по коэффициенту. Для одной ступени этого достаточно. }
|
||||
constructor Create(AFactor: Integer);
|
||||
{ Ступень каскада: полосу и длину задаёт вызывающий — ранним ступеням
|
||||
узкая переходная полоса не нужна (см. TTCIDecimChain). }
|
||||
constructor CreateDesigned(AFactor, ATaps: Integer; ACutoff: Double);
|
||||
procedure Reset;
|
||||
{ N входных сэмплов → до N/Factor выходных. Dst обязан вмещать столько. }
|
||||
function Process(const Src: array of Single; N: Integer;
|
||||
var Dst: array of Single): Integer;
|
||||
property Factor: Integer read FFactor;
|
||||
property Taps: Integer read FN;
|
||||
end;
|
||||
|
||||
{ Каскад дециматоров. Одной ступенью большие коэффициенты не берутся: длина
|
||||
FIR растёт вместе с коэффициентом, а упираясь в потолок TCI_FIR_MAX_TAPS,
|
||||
одноступенчатый дециматор перестаёт быть фильтром вовсе. Замерено на
|
||||
5760→48 кГц (коэффициент 120, верхний rate Pluto): завал 1.3 дБ в полосе и
|
||||
подавление зеркала всего 16 дБ — то есть поток IQ с мусором.
|
||||
|
||||
Поэтому коэффициент раскладывается на множители (по убыванию — самая
|
||||
дорогая ступень первой). Спецификацию фильтра каждой ступени задаёт
|
||||
ИТОГОВАЯ полоса, а не её собственная: ранняя ступень обязана убрать лишь
|
||||
те узкие зоны, которые в конце сложатся в полезную полосу, поэтому её
|
||||
переходная полоса шире в десятки раз, а фильтр во столько же короче.
|
||||
Итог замера: −83 дБ по зеркалу на любом коэффициенте, цена ≈10% ядра на
|
||||
потоке 5.76 МГц (было 20% и мусор). Свёртка идёт со сложением симметричных
|
||||
пар — умножений вдвое меньше при том же результате. }
|
||||
TTCIDecimChain = class
|
||||
private
|
||||
FStages: array of TTCIDecimator;
|
||||
FTmp: array[0..1] of array of Single;
|
||||
FFactor: Integer;
|
||||
public
|
||||
constructor Create(AFactor: Integer);
|
||||
destructor Destroy; override;
|
||||
procedure Reset;
|
||||
function Process(const Src: array of Single; N: Integer;
|
||||
var Dst: array of Single): Integer;
|
||||
property Factor: Integer read FFactor;
|
||||
end;
|
||||
|
||||
{ Интерполятор для TX-аудио: целое отношение, линейная интерполяция. }
|
||||
TTCIInterpolator = class
|
||||
private
|
||||
FFactor: Integer;
|
||||
FPrev: Single;
|
||||
FHas: Boolean;
|
||||
public
|
||||
constructor Create(AFactor: Integer);
|
||||
procedure Reset;
|
||||
function Process(const Src: array of Single; N: Integer;
|
||||
var Dst: array of Double): Integer;
|
||||
property Factor: Integer read FFactor;
|
||||
end;
|
||||
|
||||
{ Исходящий поток одного клиента: один тип, один приёмник. Живёт от START до
|
||||
STOP (или до ухода клиента) и владеет своими дециматорами и накопителем. }
|
||||
TTCIStreamOut = class
|
||||
private
|
||||
FClient: TTCIClient;
|
||||
FKind: TTCIStreamType;
|
||||
FRx: Integer;
|
||||
FSrcRate: Integer;
|
||||
FOutRate: Integer;
|
||||
FChannels: Integer;
|
||||
FSampleT: TTCISampleType;
|
||||
FBlock: Integer; // сэмплов НА КАНАЛ в блоке
|
||||
FDec: array[0..1] of TTCIDecimChain;
|
||||
FTmp: array[0..1] of array of Single; // выход дециматора
|
||||
FIn: array of Single; // вход одного канала, кусок
|
||||
|
||||
FWantRate: Integer; // о чём просил клиент (для пересборки)
|
||||
FAcc: array of Single; // накопитель с чередованием каналов
|
||||
FAccCount: Integer; // сэмплов на канал в накопителе
|
||||
FPacked: array of Byte;
|
||||
procedure EmitFull;
|
||||
procedure PushPair(A, B: Single);
|
||||
public
|
||||
constructor Create(AClient: TTCIClient; AKind: TTCIStreamType;
|
||||
ARx, ASrcRate, AWantRate, AChannels: Integer;
|
||||
ASampleT: TTCISampleType; ABlock: Integer);
|
||||
destructor Destroy; override;
|
||||
|
||||
{ Аудио 48 кГц: стерео от движка. Один канал — усреднение (моно). }
|
||||
procedure FeedAudio(const L, R: array of Single; N: Integer);
|
||||
{ IQ: комплексные отсчёты, всегда два канала. }
|
||||
procedure FeedIQ(PI_, PQ_: PDouble; N: Integer);
|
||||
|
||||
{ Совпадает ли поток с (клиент, тип, приёмник) — для поиска в списке. }
|
||||
function Matches(AClient: TTCIClient; AKind: TTCIStreamType;
|
||||
ARx: Integer): Boolean;
|
||||
|
||||
{ Частота источника сменилась на ходу (другой sample rate устройства или
|
||||
rate DDC пана). Пересобирает прореживание; накопленный блок бросаем —
|
||||
склеивать в один блок сэмплы двух разных частот нельзя. }
|
||||
procedure SetSourceRate(ANewRate: Integer);
|
||||
|
||||
property Client: TTCIClient read FClient;
|
||||
property Kind: TTCIStreamType read FKind;
|
||||
property Rx: Integer read FRx;
|
||||
property OutRate: Integer read FOutRate;
|
||||
property SrcRate: Integer read FSrcRate;
|
||||
end;
|
||||
|
||||
{ Запись линейного выхода (LINE_OUT_RECORDER_*, §4.3). Кольцо на MaxSec
|
||||
секунд 48 кГц стерео в int16: во-первых, ровно то, что уйдёт в WAV, а
|
||||
во-вторых, float32 на предельных 300 с — это 115 МБ вместо 57. }
|
||||
TTCIRecorder = class
|
||||
private
|
||||
FLock: TCriticalSection;
|
||||
FRing: array of SmallInt; // чередование L/R
|
||||
FCap: Integer; // ёмкость в сэмплах на канал
|
||||
FCount: Integer; // накоплено сэмплов на канал
|
||||
FHead: Integer; // позиция записи (в сэмплах на канал)
|
||||
FRate: Integer;
|
||||
FRx: Integer;
|
||||
public
|
||||
constructor Create(ARx, ARateHz, AMaxSec: Integer);
|
||||
destructor Destroy; override;
|
||||
procedure Feed(const L, R: array of Single; N: Integer);
|
||||
{ Забрать накопленное В ПОРЯДКЕ ВРЕМЕНИ и обнулить кольцо. }
|
||||
function Take: TTCIPcm;
|
||||
property Rx: Integer read FRx;
|
||||
property Rate: Integer read FRate;
|
||||
end;
|
||||
|
||||
{ Писатель WAV в своём потоке: файл до 60 МБ, а зовут сохранение из тика
|
||||
сервера — блокировать его на секунду диска нельзя. Данные забирает себе. }
|
||||
TTCIWavWriter = class(TThread)
|
||||
private
|
||||
FPath: string;
|
||||
FData: TTCIPcm;
|
||||
FRate: Integer;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(const APath: string; const AData: TTCIPcm;
|
||||
ARateHz: Integer);
|
||||
end;
|
||||
|
||||
{ Коэффициент прореживания SrcRate → WantRate: наибольший целый делитель,
|
||||
дающий не меньше запрошенного. Апсемплинг наружу не делаем никогда —
|
||||
клиенту уходит настоящая частота (она же в заголовке блока). }
|
||||
function TCIDecimFactor(SrcRate, WantRate: Integer): Integer;
|
||||
|
||||
{ Частота IQ, которую реально можно отдать: наибольшая ЗАКОННАЯ по протоколу
|
||||
(48/96/192/384 кГц), не выше запрошенной и делящая частоту источника нацело.
|
||||
Нужна из-за частот дискретизации Pluto: 576 и 960 кГц на 384 не делятся, и
|
||||
без этого выбора клиент, попросивший 384 кГц, получал бы поток на 576/480 —
|
||||
и не по протоколу, и вчетверо толще, чем он ждёт. Если законной не нашлось
|
||||
вовсе (чужой rate), возвращаем просьбу как есть: дальше её обработает
|
||||
TCIDecimFactor, а настоящая частота уйдёт в заголовке блока. }
|
||||
function TCIPickIQRate(SrcRate, WantRate: Integer): Integer;
|
||||
|
||||
{ Путь из LINE_OUT_RECORDER_SAVE в путь файловой системы: в протоколе ':'
|
||||
запрещён и заменён на '|' (§4.3), слэши допускаются любые. }
|
||||
function TCIRecordPath(const S: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Дециматор
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIDecimator.Create(AFactor: Integer);
|
||||
var N: Integer;
|
||||
begin
|
||||
if AFactor < 1 then AFactor := 1;
|
||||
N := TCI_FIR_PER_FACTOR * AFactor + 1;
|
||||
CreateDesigned(AFactor, N, 0.45 / AFactor);
|
||||
end;
|
||||
|
||||
constructor TTCIDecimator.CreateDesigned(AFactor, ATaps: Integer;
|
||||
ACutoff: Double);
|
||||
var
|
||||
i, C: Integer;
|
||||
X, W, Sum: Double;
|
||||
begin
|
||||
inherited Create;
|
||||
if AFactor < 1 then AFactor := 1;
|
||||
FFactor := AFactor;
|
||||
FN := ATaps;
|
||||
if FN < 9 then FN := 9;
|
||||
if FN > TCI_FIR_MAX_TAPS then FN := TCI_FIR_MAX_TAPS;
|
||||
if (FN and 1) = 0 then Inc(FN); // нечётная длина: линейная фаза и
|
||||
// целая задержка
|
||||
FHalf := FN div 2;
|
||||
SetLength(FTaps, FN);
|
||||
SetLength(FHist, FN);
|
||||
|
||||
// Окно Блэкмана поверх sinc. Оно, в отличие от Хэмминга, даёт −74 дБ вместо
|
||||
// −53 в полосе задержания, а платим за это только длиной — и как раз длину
|
||||
// многоступенчатая схема экономит (см. TTCIDecimChain).
|
||||
C := FN div 2;
|
||||
Sum := 0;
|
||||
for i := 0 to FN - 1 do
|
||||
begin
|
||||
X := i - C;
|
||||
if Abs(X) < 1E-9 then W := 2 * ACutoff
|
||||
else W := Sin(2 * Pi * ACutoff * X) / (Pi * X);
|
||||
W := W * (0.42 - 0.5 * Cos(2 * Pi * i / (FN - 1))
|
||||
+ 0.08 * Cos(4 * Pi * i / (FN - 1)));
|
||||
FTaps[i] := W;
|
||||
Sum := Sum + W;
|
||||
end;
|
||||
// Нормировка по единичному усилению на постоянном токе: без неё уровень
|
||||
// аудио гулял бы на доли дБ от коэффициента прореживания.
|
||||
if Abs(Sum) > 1E-12 then
|
||||
for i := 0 to FN - 1 do FTaps[i] := FTaps[i] / Sum;
|
||||
Reset;
|
||||
end;
|
||||
|
||||
procedure TTCIDecimator.Reset;
|
||||
var i: Integer;
|
||||
begin
|
||||
for i := 0 to FN - 1 do FHist[i] := 0;
|
||||
FPos := 0;
|
||||
FPhase := 0;
|
||||
end;
|
||||
|
||||
function TTCIDecimator.Process(const Src: array of Single; N: Integer;
|
||||
var Dst: array of Single): Integer;
|
||||
var
|
||||
i, k, t, a, b: Integer;
|
||||
Acc: Double;
|
||||
begin
|
||||
Result := 0;
|
||||
if N > Length(Src) then N := Length(Src);
|
||||
if FFactor = 1 then
|
||||
begin
|
||||
// Прореживать нечего — фильтр в этом случае только съел бы верх полосы.
|
||||
k := N;
|
||||
if k > Length(Dst) then k := Length(Dst);
|
||||
for i := 0 to k - 1 do Dst[i] := Src[i];
|
||||
Exit(k);
|
||||
end;
|
||||
|
||||
k := 0;
|
||||
for i := 0 to N - 1 do
|
||||
begin
|
||||
FHist[FPos] := Src[i];
|
||||
Inc(FPos);
|
||||
if FPos >= FN then FPos := 0;
|
||||
|
||||
Inc(FPhase);
|
||||
if FPhase < FFactor then Continue;
|
||||
FPhase := 0;
|
||||
if k >= Length(Dst) then Break; // переполнение приёмника — молча режем
|
||||
|
||||
// Свёртка со сложением симметричных пар: фильтр линейнофазовый, значит
|
||||
// FTaps[t] = FTaps[N-1-t], и умножений вдвое меньше при том же результате.
|
||||
// На 5.76 МГц (верхний rate Pluto) это разница между 16% и 10% ядра.
|
||||
Acc := 0;
|
||||
a := FPos; // самый старый отсчёт (это отвод N-1)
|
||||
b := FPos + FN - 1; // самый свежий (это отвод 0)
|
||||
if b >= FN then Dec(b, FN);
|
||||
for t := 0 to FHalf - 1 do
|
||||
begin
|
||||
Acc := Acc + FTaps[t] * (FHist[a] + FHist[b]);
|
||||
Inc(a); if a >= FN then a := 0;
|
||||
Dec(b); if b < 0 then b := FN - 1;
|
||||
end;
|
||||
Dst[k] := Acc + FTaps[FHalf] * FHist[a]; // центральный отвод
|
||||
Inc(k);
|
||||
end;
|
||||
Result := k;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Каскад дециматоров
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIDecimChain.Create(AFactor: Integer);
|
||||
var
|
||||
Rest, F, i, N: Integer;
|
||||
Cur, FPass, FStop: Double;
|
||||
Fac: array of Integer;
|
||||
|
||||
procedure AddFactor(V: Integer);
|
||||
begin
|
||||
SetLength(Fac, Length(Fac) + 1);
|
||||
Fac[High(Fac)] := V;
|
||||
end;
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
if AFactor < 1 then AFactor := 1;
|
||||
FFactor := AFactor;
|
||||
Rest := AFactor;
|
||||
// Раскладываем на простые. Всё, что не разложилось (простое число больше
|
||||
// семи — у частот дискретизации не встречается, но бывает у чужого железа),
|
||||
// остаётся одной ступенью: она хотя бы не хуже прежнего поведения.
|
||||
for F in [2, 3, 5, 7] do
|
||||
while (Rest mod F = 0) and (Rest > 1) do
|
||||
begin
|
||||
AddFactor(F);
|
||||
Rest := Rest div F;
|
||||
end;
|
||||
if Rest > 1 then AddFactor(Rest);
|
||||
|
||||
// По убыванию: первая ступень самая «дорогая», и после неё частота, на
|
||||
// которой работают остальные, уже сбита.
|
||||
for i := 0 to High(Fac) - 1 do
|
||||
for F := 0 to High(Fac) - 1 - i do
|
||||
if Fac[F] < Fac[F + 1] then
|
||||
begin
|
||||
Rest := Fac[F];
|
||||
Fac[F] := Fac[F + 1];
|
||||
Fac[F + 1] := Rest;
|
||||
end;
|
||||
|
||||
// Спецификация фильтра каждой ступени считается от ИТОГОВОЙ полосы, а не от
|
||||
// её собственной. Ранняя ступень отдаёт наверх широкий поток, и всё, что она
|
||||
// обязана убрать, — те узкие зоны, которые в конце сложатся в полезную
|
||||
// полосу; переходная полоса у неё получается в десятки раз шире, а значит и
|
||||
// фильтр во столько же раз короче. Ради этого многоступенчатую схему и
|
||||
// делают: на 5760→48 кГц первая ступень обходится 30 отводами вместо 257,
|
||||
// которых всё равно не хватало.
|
||||
SetLength(FStages, Length(Fac));
|
||||
Cur := 1.0; // доля от исходной частоты на входе ступени
|
||||
for i := 0 to High(Fac) do
|
||||
begin
|
||||
// Полоса, которую обязаны сохранить, — 0.45 от итоговой Найквиста,
|
||||
// в единицах ВХОДНОЙ частоты этой ступени.
|
||||
FPass := (0.45 * 0.5 / FFactor) / Cur;
|
||||
FStop := (1.0 / Fac[i]) - FPass; // сюда сложится всё лишнее
|
||||
if FStop <= FPass * 1.05 then // последняя ступень: запаса уже нет
|
||||
begin
|
||||
FPass := 0.45 / Fac[i];
|
||||
FStop := 0.55 / Fac[i];
|
||||
end;
|
||||
// Ширина переходной полосы ↔ длина окна Блэкмана: N ≈ 5.5/Δf.
|
||||
N := Ceil(5.5 / (FStop - FPass)) + 1;
|
||||
FStages[i] := TTCIDecimator.CreateDesigned(Fac[i], N,
|
||||
(FPass + FStop) * 0.5);
|
||||
Cur := Cur / Fac[i];
|
||||
end;
|
||||
SetLength(FTmp[0], TCI_FEED_CHUNK);
|
||||
SetLength(FTmp[1], TCI_FEED_CHUNK);
|
||||
end;
|
||||
|
||||
destructor TTCIDecimChain.Destroy;
|
||||
var i: Integer;
|
||||
begin
|
||||
for i := 0 to High(FStages) do FStages[i].Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTCIDecimChain.Reset;
|
||||
var i: Integer;
|
||||
begin
|
||||
for i := 0 to High(FStages) do FStages[i].Reset;
|
||||
end;
|
||||
|
||||
function TTCIDecimChain.Process(const Src: array of Single; N: Integer;
|
||||
var Dst: array of Single): Integer;
|
||||
var
|
||||
i, Cur: Integer;
|
||||
begin
|
||||
if N > Length(Src) then N := Length(Src);
|
||||
if Length(FStages) = 0 then
|
||||
begin
|
||||
if N > Length(Dst) then N := Length(Dst);
|
||||
for i := 0 to N - 1 do Dst[i] := Src[i];
|
||||
Exit(N);
|
||||
end;
|
||||
if Length(FStages) = 1 then
|
||||
Exit(FStages[0].Process(Src, N, Dst));
|
||||
|
||||
// Пинг-понг между двумя буферами; последняя ступень пишет сразу в Dst.
|
||||
Cur := 0;
|
||||
N := FStages[0].Process(Src, N, FTmp[0]);
|
||||
for i := 1 to High(FStages) - 1 do
|
||||
begin
|
||||
N := FStages[i].Process(FTmp[Cur], N, FTmp[1 - Cur]);
|
||||
Cur := 1 - Cur;
|
||||
end;
|
||||
Result := FStages[High(FStages)].Process(FTmp[Cur], N, Dst);
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Интерполятор (TX-аудио клиента → 48 кГц тракта)
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIInterpolator.Create(AFactor: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
if AFactor < 1 then AFactor := 1;
|
||||
FFactor := AFactor;
|
||||
Reset;
|
||||
end;
|
||||
|
||||
procedure TTCIInterpolator.Reset;
|
||||
begin
|
||||
FPrev := 0;
|
||||
FHas := False;
|
||||
end;
|
||||
|
||||
function TTCIInterpolator.Process(const Src: array of Single; N: Integer;
|
||||
var Dst: array of Double): Integer;
|
||||
var
|
||||
i, p, k: Integer;
|
||||
A, B: Single;
|
||||
begin
|
||||
if N > Length(Src) then N := Length(Src);
|
||||
k := 0;
|
||||
if FFactor = 1 then
|
||||
begin
|
||||
for i := 0 to N - 1 do
|
||||
begin
|
||||
if k >= Length(Dst) then Break;
|
||||
Dst[k] := Src[i];
|
||||
Inc(k);
|
||||
end;
|
||||
Exit(k);
|
||||
end;
|
||||
|
||||
for i := 0 to N - 1 do
|
||||
begin
|
||||
B := Src[i];
|
||||
if FHas then A := FPrev else A := B; // самый первый блок: без скачка от нуля
|
||||
for p := 0 to FFactor - 1 do
|
||||
begin
|
||||
if k >= Length(Dst) then Break;
|
||||
Dst[k] := A + (B - A) * (p / FFactor);
|
||||
Inc(k);
|
||||
end;
|
||||
FPrev := B;
|
||||
FHas := True;
|
||||
end;
|
||||
Result := k;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Исходящий поток
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIStreamOut.Create(AClient: TTCIClient; AKind: TTCIStreamType;
|
||||
ARx, ASrcRate, AWantRate, AChannels: Integer; ASampleT: TTCISampleType;
|
||||
ABlock: Integer);
|
||||
var
|
||||
F, MaxB, i: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
FClient := AClient;
|
||||
FKind := AKind;
|
||||
FRx := ARx;
|
||||
FSrcRate := ASrcRate;
|
||||
FWantRate := AWantRate;
|
||||
FChannels := EnsureRange(AChannels, 1, 2);
|
||||
FSampleT := ASampleT;
|
||||
|
||||
if FKind = tstIQ then AWantRate := TCIPickIQRate(ASrcRate, AWantRate);
|
||||
F := TCIDecimFactor(ASrcRate, AWantRate);
|
||||
FOutRate := ASrcRate div F;
|
||||
|
||||
// Блок не имеет права вылезти за data[16384]: столько ExpertSDR3 объявил
|
||||
// потолком, и клиенты держат приёмный буфер ровно под него.
|
||||
MaxB := TCIMaxBlockSamples(FSampleT, FChannels);
|
||||
FBlock := EnsureRange(ABlock, 1, MaxB);
|
||||
|
||||
for i := 0 to FChannels - 1 do
|
||||
begin
|
||||
FDec[i] := TTCIDecimChain.Create(F);
|
||||
SetLength(FTmp[i], TCI_FEED_CHUNK);
|
||||
end;
|
||||
SetLength(FIn, TCI_FEED_CHUNK);
|
||||
SetLength(FAcc, FBlock * FChannels);
|
||||
SetLength(FPacked, FBlock * FChannels * TCISampleBytes(FSampleT));
|
||||
FAccCount := 0;
|
||||
end;
|
||||
|
||||
destructor TTCIStreamOut.Destroy;
|
||||
var i: Integer;
|
||||
begin
|
||||
for i := 0 to 1 do FreeAndNil(FDec[i]);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TTCIStreamOut.Matches(AClient: TTCIClient; AKind: TTCIStreamType;
|
||||
ARx: Integer): Boolean;
|
||||
begin
|
||||
Result := (FClient = AClient) and (FKind = AKind) and (FRx = ARx);
|
||||
end;
|
||||
|
||||
procedure TTCIStreamOut.SetSourceRate(ANewRate: Integer);
|
||||
var i, F, W: Integer;
|
||||
begin
|
||||
if (ANewRate <= 0) or (ANewRate = FSrcRate) then Exit;
|
||||
FSrcRate := ANewRate;
|
||||
// Просьбу клиента храним как есть, а законную частоту пересчитываем: у
|
||||
// нового источника делители другие (576 кГц Pluto не делится на 384).
|
||||
if FKind = tstIQ then W := TCIPickIQRate(FSrcRate, FWantRate)
|
||||
else W := FWantRate;
|
||||
F := TCIDecimFactor(FSrcRate, W);
|
||||
FOutRate := FSrcRate div F;
|
||||
for i := 0 to FChannels - 1 do
|
||||
begin
|
||||
FDec[i].Free;
|
||||
FDec[i] := TTCIDecimChain.Create(F);
|
||||
end;
|
||||
FAccCount := 0;
|
||||
end;
|
||||
|
||||
procedure TTCIStreamOut.EmitFull;
|
||||
var
|
||||
H: TTCIStreamHeader;
|
||||
Bytes: Integer;
|
||||
begin
|
||||
TCIFillHeader(H, FKind, FRx, FOutRate, FSampleT, FBlock, FChannels);
|
||||
Bytes := TCIPackSamples(FAcc, FBlock * FChannels, FSampleT, @FPacked[0]);
|
||||
FClient.SendBin(H, @FPacked[0], Bytes);
|
||||
FAccCount := 0;
|
||||
end;
|
||||
|
||||
procedure TTCIStreamOut.PushPair(A, B: Single);
|
||||
begin
|
||||
if FChannels = 1 then
|
||||
FAcc[FAccCount] := A
|
||||
else
|
||||
begin
|
||||
FAcc[FAccCount * 2] := A;
|
||||
FAcc[FAccCount * 2 + 1] := B;
|
||||
end;
|
||||
Inc(FAccCount);
|
||||
if FAccCount >= FBlock then EmitFull;
|
||||
end;
|
||||
|
||||
procedure TTCIStreamOut.FeedAudio(const L, R: array of Single; N: Integer);
|
||||
var
|
||||
i, n0, n1, Chunk, Off: Integer;
|
||||
begin
|
||||
if (N <= 0) or (FClient = nil) then Exit;
|
||||
if N > Length(L) then N := Length(L);
|
||||
if N > Length(R) then N := Length(R);
|
||||
|
||||
Off := 0;
|
||||
while Off < N do
|
||||
begin
|
||||
// Кусками по TCI_FEED_CHUNK: движок вправе отдать блок любой длины, а
|
||||
// рабочие буферы у нас фиксированные (см. константу).
|
||||
Chunk := N - Off;
|
||||
if Chunk > TCI_FEED_CHUNK then Chunk := TCI_FEED_CHUNK;
|
||||
|
||||
if FChannels = 1 then
|
||||
begin
|
||||
for i := 0 to Chunk - 1 do FIn[i] := (L[Off + i] + R[Off + i]) * 0.5;
|
||||
n0 := FDec[0].Process(FIn, Chunk, FTmp[0]);
|
||||
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], 0);
|
||||
end
|
||||
else
|
||||
begin
|
||||
for i := 0 to Chunk - 1 do FIn[i] := L[Off + i];
|
||||
n0 := FDec[0].Process(FIn, Chunk, FTmp[0]);
|
||||
for i := 0 to Chunk - 1 do FIn[i] := R[Off + i];
|
||||
n1 := FDec[1].Process(FIn, Chunk, FTmp[1]);
|
||||
if n1 < n0 then n0 := n1;
|
||||
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], FTmp[1][i]);
|
||||
end;
|
||||
|
||||
Inc(Off, Chunk);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTCIStreamOut.FeedIQ(PI_, PQ_: PDouble; N: Integer);
|
||||
var
|
||||
i, n0, n1, Chunk, Off: Integer;
|
||||
SI, SQ: PDouble;
|
||||
begin
|
||||
if (N <= 0) or (FClient = nil) or (PI_ = nil) or (PQ_ = nil) then Exit;
|
||||
Off := 0;
|
||||
while Off < N do
|
||||
begin
|
||||
Chunk := N - Off;
|
||||
if Chunk > TCI_FEED_CHUNK then Chunk := TCI_FEED_CHUNK;
|
||||
|
||||
SI := PI_; Inc(SI, Off);
|
||||
for i := 0 to Chunk - 1 do begin FIn[i] := SI^; Inc(SI); end;
|
||||
n0 := FDec[0].Process(FIn, Chunk, FTmp[0]);
|
||||
|
||||
if FChannels >= 2 then
|
||||
begin
|
||||
// Q считаем ТЕМ ЖЕ проходом, что и I: разошедшиеся по длине выходы
|
||||
// означали бы сдвиг фазы между каналами, то есть поворот спектра.
|
||||
SQ := PQ_; Inc(SQ, Off);
|
||||
for i := 0 to Chunk - 1 do begin FIn[i] := SQ^; Inc(SQ); end;
|
||||
n1 := FDec[1].Process(FIn, Chunk, FTmp[1]);
|
||||
if n1 < n0 then n0 := n1;
|
||||
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], FTmp[1][i]);
|
||||
end
|
||||
else
|
||||
for i := 0 to n0 - 1 do PushPair(FTmp[0][i], 0);
|
||||
|
||||
Inc(Off, Chunk);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Рекордер линейного выхода
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIRecorder.Create(ARx, ARateHz, AMaxSec: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
FLock := TCriticalSection.Create;
|
||||
FRx := ARx;
|
||||
FRate := ARateHz;
|
||||
if AMaxSec < 1 then AMaxSec := 1;
|
||||
if AMaxSec > TCI_RECORD_MAX_SEC then AMaxSec := TCI_RECORD_MAX_SEC;
|
||||
FCap := ARateHz * AMaxSec;
|
||||
SetLength(FRing, FCap * 2);
|
||||
FCount := 0;
|
||||
FHead := 0;
|
||||
end;
|
||||
|
||||
destructor TTCIRecorder.Destroy;
|
||||
begin
|
||||
FLock.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTCIRecorder.Feed(const L, R: array of Single; N: Integer);
|
||||
// DSP-поток. Кольцо: по исчерпании ёмкости затирается самое старое — запись
|
||||
// «последние N секунд» именно так и работает (§4.3: по истечении времени
|
||||
// накопленное пропадает, если клиент не сохранил).
|
||||
var
|
||||
i: Integer;
|
||||
A, B: Single;
|
||||
begin
|
||||
if (N <= 0) or (FCap <= 0) then Exit;
|
||||
if N > Length(L) then N := Length(L);
|
||||
if N > Length(R) then N := Length(R);
|
||||
FLock.Enter;
|
||||
try
|
||||
for i := 0 to N - 1 do
|
||||
begin
|
||||
A := L[i]; B := R[i];
|
||||
if A > 1.0 then A := 1.0; if A < -1.0 then A := -1.0;
|
||||
if B > 1.0 then B := 1.0; if B < -1.0 then B := -1.0;
|
||||
FRing[FHead * 2] := Round(A * 32767);
|
||||
FRing[FHead * 2 + 1] := Round(B * 32767);
|
||||
Inc(FHead);
|
||||
if FHead >= FCap then FHead := 0;
|
||||
if FCount < FCap then Inc(FCount);
|
||||
end;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTCIRecorder.Take: TTCIPcm;
|
||||
var
|
||||
Start, i, n: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
FLock.Enter;
|
||||
try
|
||||
if FCount <= 0 then Exit;
|
||||
SetLength(Result, FCount * 2);
|
||||
Start := FHead - FCount;
|
||||
if Start < 0 then Inc(Start, FCap);
|
||||
for i := 0 to FCount - 1 do
|
||||
begin
|
||||
n := (Start + i) mod FCap;
|
||||
Result[i * 2] := FRing[n * 2];
|
||||
Result[i * 2 + 1] := FRing[n * 2 + 1];
|
||||
end;
|
||||
FCount := 0;
|
||||
FHead := 0;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
WAV
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIWavWriter.Create(const APath: string;
|
||||
const AData: TTCIPcm; ARateHz: Integer);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FreeOnTerminate := True;
|
||||
FPath := APath;
|
||||
FData := AData;
|
||||
FRate := ARateHz;
|
||||
Start;
|
||||
end;
|
||||
|
||||
procedure TTCIWavWriter.Execute;
|
||||
// Заголовок собираем в буфере: WAV — это фиксированные 44 байта, и городить
|
||||
// два десятка отдельных Write ради них незачем (а строковые литералы в
|
||||
// нетипизированный Write в FPC ещё и передаются не тем, чем кажется).
|
||||
var
|
||||
FS: TFileStream;
|
||||
Hdr: array[0..43] of Byte;
|
||||
DataBytes: LongWord;
|
||||
|
||||
procedure PutTag(Ofs: Integer; const Tag: string);
|
||||
var i: Integer;
|
||||
begin
|
||||
for i := 1 to Length(Tag) do Hdr[Ofs + i - 1] := Byte(Tag[i]);
|
||||
end;
|
||||
|
||||
procedure PutU32(Ofs: Integer; V: LongWord);
|
||||
begin
|
||||
Hdr[Ofs] := Byte(V); Hdr[Ofs + 1] := Byte(V shr 8);
|
||||
Hdr[Ofs + 2] := Byte(V shr 16); Hdr[Ofs + 3] := Byte(V shr 24);
|
||||
end;
|
||||
|
||||
procedure PutU16(Ofs: Integer; V: Word);
|
||||
begin
|
||||
Hdr[Ofs] := Byte(V); Hdr[Ofs + 1] := Byte(V shr 8);
|
||||
end;
|
||||
|
||||
begin
|
||||
try
|
||||
DataBytes := LongWord(Length(FData) * SizeOf(SmallInt));
|
||||
FillChar(Hdr, SizeOf(Hdr), 0);
|
||||
PutTag(0, 'RIFF');
|
||||
PutU32(4, 36 + DataBytes);
|
||||
PutTag(8, 'WAVE');
|
||||
PutTag(12, 'fmt ');
|
||||
PutU32(16, 16); // размер fmt-блока
|
||||
PutU16(20, 1); // PCM
|
||||
PutU16(22, 2); // каналов
|
||||
PutU32(24, LongWord(FRate));
|
||||
PutU32(28, LongWord(FRate) * 2 * 2); // байт в секунду
|
||||
PutU16(32, 4); // выравнивание блока
|
||||
PutU16(34, 16); // бит на сэмпл
|
||||
PutTag(36, 'data');
|
||||
PutU32(40, DataBytes);
|
||||
|
||||
FS := TFileStream.Create(FPath, fmCreate);
|
||||
try
|
||||
FS.Write(Hdr[0], SizeOf(Hdr));
|
||||
if DataBytes > 0 then FS.Write(FData[0], DataBytes);
|
||||
finally
|
||||
FS.Free;
|
||||
end;
|
||||
except
|
||||
// Записать не вышло (нет прав, нет каталога, диск полон) — сказать об этом
|
||||
// клиенту уже некому: команда давно подтверждена. Молчим, но и не падаем:
|
||||
// исключение из потока утащило бы за собой процесс.
|
||||
end;
|
||||
FData := nil;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Утилиты
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
function TCIDecimFactor(SrcRate, WantRate: Integer): Integer;
|
||||
var F: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
if (SrcRate <= 0) or (WantRate <= 0) or (WantRate >= SrcRate) then Exit;
|
||||
// Идём от большего прореживания к меньшему и берём первое, которое делит
|
||||
// входную частоту нацело и не опускает нас ниже запрошенной.
|
||||
F := SrcRate div WantRate;
|
||||
while F > 1 do
|
||||
begin
|
||||
if (SrcRate mod F = 0) and (SrcRate div F >= WantRate) then Exit(F);
|
||||
Dec(F);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCIPickIQRate(SrcRate, WantRate: Integer): Integer;
|
||||
const
|
||||
LEGAL: array[0..3] of Integer = (384000, 192000, 96000, 48000);
|
||||
var i: Integer;
|
||||
begin
|
||||
Result := WantRate;
|
||||
if (SrcRate <= 0) or (WantRate <= 0) then Exit;
|
||||
for i := 0 to High(LEGAL) do
|
||||
if (LEGAL[i] <= WantRate) and (LEGAL[i] <= SrcRate) and
|
||||
(SrcRate mod LEGAL[i] = 0) then
|
||||
Exit(LEGAL[i]);
|
||||
end;
|
||||
|
||||
function TCIRecordPath(const S: string): string;
|
||||
var i: Integer;
|
||||
begin
|
||||
Result := S;
|
||||
for i := 1 to Length(Result) do
|
||||
if Result[i] = '|' then Result[i] := ':';
|
||||
{$IFDEF WINDOWS}
|
||||
for i := 1 to Length(Result) do
|
||||
if Result[i] = '/' then Result[i] := '\';
|
||||
{$ELSE}
|
||||
for i := 1 to Length(Result) do
|
||||
if Result[i] = '\' then Result[i] := '/';
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user