mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
Два дефекта уровня P1 в LINE_OUT_RECORDER_*. Авторизации в протоколе нет
(§3.1), bind наружу разрешён — значит «сколько стоит одна строка из сети»
это вопрос живучести процесса, а не аккуратности.
1. Неограниченное выделение памяти. CmdRecorder проверял только ValidRx
(номер в потолке), а конструктор выделял буфер целиком: 300 с × 48 кГц
× 2 канала × int16 = 57.6 МБ на команду, приёмников 1+MAX_SLICES=7, то
есть 403 МБ семью строками. У мёртвого приёмника Feed не зовут — значит
срок записи никто не проверял; уход клиента рекордеры не трогал вовсе;
DropDeadRxStreams бежит только на rfDevice/rfConnected и смене карты
слайсов, в покое не срабатывает. Память жила до остановки сервера.
Лечение тремя замками:
- память набирается кусками по секунде, START не стоит ни байта;
куски не перевыделяются (никакого realloc в DSP-потоке) и склеиваются
один раз в Take — уже после того, как рекордер вынут из таблицы;
- общий бюджет TCI_RECORD_MAX_BYTES (128 МБ) на все рекордеры сразу,
спрашивается на каждый кусок; отказ не рушит запись, набранное
остаётся сохраняемым;
- освобождение по трём событиям: START требует живого приёмника
(RxActive, ответ receiver is not running), тик сервера подметает
истёкшие окна по часам (SweepRecorders — окно закрывается от START
и без единого блока звука), уход клиента забирает его записи
(DropClientRecorders; рекордер живёт на приёмнике, но платит за него
тот, кто нажал START).
2. Перезапись произвольного файла. Путь из сети уходил в fmCreate почти
как пришёл — вместе с '..' и абсолютными путями. Теперь TCIRecordPath
берёт из строки ТОЛЬКО имя файла, каталог — настроенный tci.record_dir
(пусто = <каталог конфигурации>/records). Каталог из просьбы
отбрасывается молча: полный путь на сервере клиенту всё равно
бесполезен, файл ложится не на его машину. Имя валидируется (пусто,
'.', '..', управляющие, ':', длиннее 120, расширение не .wav →
bad file name); после ExtractFileName выйти за каталог нечем. Файл
создаётся эксклюзивно (TCICreateNewFile: O_EXCL|O_NOFOLLOW на Unix,
CREATE_NEW на Windows) — ни перезаписи, ни симлинка, без окна между
FileExists и созданием; клиенту заранее file exists.
Попутно: MainForm.ApplyTCISettings собирал TTCISettings по полям с
чистого листа — новое поле RecordDir обнулялось бы при каждом применении
вкладки CAT. В uses TCIStreams Windows стоит первым намеренно: иначе его
TCriticalSection перекрыл бы SyncObjs (та же грабля, что в DX-кластере).
Стенд 189/189 (было 169): 11 проверок имени файла (/etc/passwd.wav,
../../.., D|\rec\a.wav), бюджет (START не выделяет, растёт кусками,
потолок, отказ не рушит запись, срок истекает без Feed), существующий WAV
не перезаписывается, START на мёртвом приёмнике и с чужим номером, и
сквозная проверка в части E — клиент стартует запись, набирает память
живым звуком через WDSP, рвёт TCP, бюджет возвращается к нулю. Без фиксов
новые проверки краснеют. GUI (--ws=qt6) и демон зелёные.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
680 lines
29 KiB
ObjectPascal
680 lines
29 KiB
ObjectPascal
unit TCIProtocol;
|
||
|
||
{
|
||
TCIProtocol.pas — протокол TCI 2.0 (Expert Electronics), чистый слой.
|
||
|
||
Только разбор/сборка строк и словари протокола: ни сокетов, ни контроллера.
|
||
Роль та же, что у CATEngine в CAT-подсистеме, но парсер тут тривиальный, и
|
||
вся логика команд живёт в TCIAdapter — команд у TCI мало, а аргументы у них
|
||
типизированы (номер приёмника/канала), поэтому таблица команд вырождается в
|
||
case по имени.
|
||
|
||
Формат (док, §3.1):
|
||
<имя>:<арг1>,<арг2>,…; команда с аргументами
|
||
<имя>; команда без аргументов
|
||
Зарезервированные символы: ':' ',' ';' — внутри аргументов запрещены и
|
||
заменяются на '^' '~' '*' (§3.2.1), обратная подстановка — TCIUnescape.
|
||
|
||
Регистр значения не имеет. ExpertSDR3 шлёт всё в нижнем регистре, и часть
|
||
клиентов сравнивает строки как есть — поэтому наружу тоже пишем строчными,
|
||
а внутрь принимаем любой.
|
||
}
|
||
|
||
{$IFDEF FPC}
|
||
{$MODE Delphi}
|
||
{$LONGSTRINGS ON}
|
||
{$ENDIF}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, Math, RadioModes;
|
||
|
||
const
|
||
TCI_VERSION = '2.0'; // версия протокола, отдаётся в PROTOCOL
|
||
TCI_APP_NAME = 'EWSDR';
|
||
TCI_DEFAULT_PORT = 40001; // порт TCI-сервера ExpertSDR3
|
||
TCI_CHANNELS = 2; // каналов приёма на приёмник (A/B)
|
||
|
||
// Список видов связи для MODULATIONS_LIST. Первые десять — словарь
|
||
// ExpertSDR3 (клиенты сверяются именно с ними), dmr/fmraw — наше
|
||
// расширение: протокол расширяемый по замыслу (§1.4).
|
||
TCI_MODULATIONS = 'am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw';
|
||
|
||
// Границы, оговорённые протоколом (клампим сами — клиент шлёт что угодно).
|
||
// Бинарные потоки (§3.4). data[16384] в структуре Stream — это ПОТОЛОК блока,
|
||
// а не его размер: больше в один блок не кладут ни ExpertSDR3, ни клиенты.
|
||
TCI_STREAM_DATA_MAX = 16384; // байт данных в блоке
|
||
TCI_STREAM_HDR_SIZE = 64; // 16 × uint32
|
||
TCI_STREAM_MAX = TCI_STREAM_HDR_SIZE + TCI_STREAM_DATA_MAX;
|
||
|
||
// Умолчания параметров потоков (§4.3).
|
||
TCI_IQ_RATE_DEF = 48000;
|
||
TCI_AUDIO_RATE_DEF = 48000;
|
||
TCI_AUDIO_CHAN_DEF = 2;
|
||
TCI_TX_BUFFERING_DEF = 50; // мс
|
||
TCI_AUDIO_SAMPLES_MIN = 100;
|
||
TCI_AUDIO_SAMPLES_MAX = 2048;
|
||
TCI_TX_BUFFERING_MIN = 50;
|
||
TCI_TX_BUFFERING_MAX = 500;
|
||
TCI_RECORD_MAX_SEC = 300; // потолок записи линейного выхода
|
||
// ★Общий потолок памяти ВСЕХ рекордеров сразу. Приёмников у нас
|
||
// 1 + MAX_SLICES, и предельные 300 с на каждом — это 57.6 МБ × 7 ≈ 403 МБ,
|
||
// которые неавторизованный клиент выпрашивал бы семью строками. Бюджет
|
||
// общий на адаптер, спрашивается при выделении КАЖДОГО куска (см.
|
||
// TTCIRecorder): 128 МБ — это две полных записи предельной длины, больше
|
||
// одновременно не нужно никому.
|
||
TCI_RECORD_MAX_BYTES = Int64(128) * 1024 * 1024;
|
||
// Кусок кольца записи — секунда звука (48000 × 2 канала × int16 = 192 КБ).
|
||
// Выделяем их по мере набора: команда START больше не стоит ни байта, а
|
||
// молчащий или мёртвый приёмник не стоит ничего вовсе.
|
||
TCI_RECORD_CHUNK_SEC = 1;
|
||
|
||
TCI_VOL_MIN_DB = -60; TCI_VOL_MAX_DB = 0;
|
||
TCI_SQL_MIN_DB = -140; TCI_SQL_MAX_DB = 0;
|
||
TCI_AGC_MIN_DB = -20; TCI_AGC_MAX_DB = 120;
|
||
TCI_SENSOR_MIN_MS = 30; TCI_SENSOR_MAX_MS = 1000;
|
||
|
||
type
|
||
TTCIArgs = array of string;
|
||
|
||
{ Разобранная команда. Name — в ВЕРХНЕМ регистре (сравнивать в case),
|
||
аргументы — как пришли, с уже снятым экранированием только там, где это
|
||
нужно вызывающему (текст CW), поэтому здесь их не трогаем. }
|
||
TTCIMessage = record
|
||
Name: string;
|
||
Args: TTCIArgs;
|
||
ArgCount: Integer;
|
||
end;
|
||
|
||
{ Тип бинарного потока (§3.4). }
|
||
TTCIStreamType = (tstIQ, tstRXAudio, tstTXAudio, tstTXChrono, tstLineOut);
|
||
TTCISampleType = (tsyInt16, tsyInt24, tsyInt32, tsyFloat32);
|
||
|
||
{ Заголовок блока потока: 16 × uint32 перед сэмплами. }
|
||
TTCIStreamHeader = packed record
|
||
Receiver: LongWord;
|
||
SampleRate: LongWord;
|
||
Format: LongWord; // TTCISampleType
|
||
Codec: LongWord; // всегда 0 (сжатие не реализовано)
|
||
CRC: LongWord; // всегда 0
|
||
DataLength: LongWord; // вещественных отсчётов всего блока
|
||
// (комплексных/на канал = length/channels)
|
||
StreamType: LongWord; // TTCIStreamType
|
||
Channels: LongWord;
|
||
Reserv: array[0..7] of LongWord;
|
||
end;
|
||
|
||
{ ── Разбор ─────────────────────────────────────────────────────────────── }
|
||
|
||
{ Разбирает ОДНУ команду (без завершающей ';' или с ней). False — мусор. }
|
||
function TCIParse(const S: string; out M: TTCIMessage): Boolean;
|
||
|
||
{ Режет полученный текстовый фрейм на отдельные команды по ';'. Клиенты
|
||
склеивают команды в один фрейм, и это законно. }
|
||
function TCISplit(const Payload: string; Lines: TStrings): Integer;
|
||
|
||
function TCIArg(const M: TTCIMessage; Idx: Integer): string;
|
||
function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer;
|
||
function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double;
|
||
function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean;
|
||
|
||
{ Строгий разбор аргумента: False — аргумента нет или он не число/не Boolean.
|
||
Всё, что ставит параметр радио, обязано ходить через эти функции: варианты с
|
||
умолчанием превращали «vfo^0~0~abc;» в честный ноль и перестраивали приёмник
|
||
на 0 Гц. Умолчания остаются только там, где значение необязательно. }
|
||
function TCITryArgInt(const M: TTCIMessage; Idx: Integer; out V: Integer): Boolean;
|
||
function TCITryArgFloat(const M: TTCIMessage; Idx: Integer; out V: Double): Boolean;
|
||
function TCITryArgBool(const M: TTCIMessage; Idx: Integer; out V: Boolean): Boolean;
|
||
|
||
{ Наборы значений, оговорённые протоколом для параметров потоков (§4.3). }
|
||
function TCIValidIQRate(V: Integer): Boolean; // 48/96/192/384 кГц
|
||
function TCIValidAudioRate(V: Integer): Boolean; // 8/12/24/48 кГц
|
||
function TCIValidSampleType(const S: string): Boolean; // int16/int24/int32/float32
|
||
|
||
{ ── Бинарные потоки (§3.4) ─────────────────────────────────────────────── }
|
||
|
||
function TCISampleTypeByName(const S: string; out T: TTCISampleType): Boolean;
|
||
function TCISampleTypeName(T: TTCISampleType): string;
|
||
function TCISampleBytes(T: TTCISampleType): Integer;
|
||
|
||
{ Сколько сэмплов НА КАНАЛ класть в блок по умолчанию (§4.3): у ExpertSDR3
|
||
своё число на каждую частоту дискретизации, и все они дают ~42 мс звучания. }
|
||
function TCIDefaultAudioSamples(RateHz: Integer): Integer;
|
||
|
||
{ Сколько сэмплов на канал влезает в блок с таким форматом и числом каналов. }
|
||
function TCIMaxBlockSamples(T: TTCISampleType; Channels: Integer): Integer;
|
||
|
||
{ Заголовок блока. Count — сэмплов НА КАНАЛ, а в DataLength всегда уходит
|
||
Count × Channels: length измеряется ВЕЩЕСТВЕННЫМИ ОТСЧЁТАМИ всего блока, и
|
||
для IQ, и для аудио.
|
||
|
||
Для IQ так прямо написано в §3.4 («количество комплексных вычисляется как
|
||
Stream.length/Stream.channels»), а для аудио формулировка §4.3 про
|
||
AUDIO_STREAM_SAMPLES («arg1 — количество сэмплов, указываемое в поле
|
||
Stream.length») однажды уже увела нас в «сэмплы на канал». ★Так делать
|
||
нельзя, и вот доказательство из живого клиента — MSHV, network.cpp:
|
||
|
||
int cr2 = (int)pStream->length*bit_s; // сколько БАЙТ разбирать
|
||
for (int i = 0; i < cr2; i+=chan*bit_s) // шаг = кадр всех каналов
|
||
...
|
||
quint32 cr3 = pStream->length*bit_s; //plength = plength*channels*4-bytes
|
||
|
||
То есть клиент считает по length число байт блока. Стоит объявить length «на
|
||
канал» — и у стерео он разбирает ровно половину блока, а вторую выбрасывает:
|
||
звук идёт с дырами в 50%, водопад становится шире и грязнее, FT4/FT8 не
|
||
декодируются вовсе. Замерено стендом test/tci/ft4_bench.py: 50% темпа набора
|
||
звука и 1649 не до конца разобранных блоков за минуту.
|
||
|
||
Размер блока при этом остаётся прежним: AUDIO_STREAM_SAMPLES — сэмплы НА
|
||
КАНАЛ (2048 при 48 кГц = 42.7 мс, как у ExpertSDR3), и потолок data[16384]
|
||
сходится ровно: 2048 × 2 канала × float32. }
|
||
procedure TCIFillHeader(out H: TTCIStreamHeader; Kind: TTCIStreamType;
|
||
Rx, RateHz: Integer; T: TTCISampleType; Count, Channels: Integer);
|
||
|
||
{ Упаковка вещественных отсчётов в формат клиента. Возвращает число байт.
|
||
Src читается подряд (уже с чередованием каналов), Dest обязан вмещать
|
||
N × TCISampleBytes(T) байт. }
|
||
function TCIPackSamples(const Src: array of Single; N: Integer;
|
||
T: TTCISampleType; Dest: PByte): Integer;
|
||
|
||
{ Обратная распаковка (TX-аудио от клиента). Возвращает число распакованных
|
||
вещественных отсчётов; лишнее сверх Length(Dest) отбрасывается. }
|
||
function TCIUnpackSamples(Src: PByte; Bytes: Integer; T: TTCISampleType;
|
||
var Dest: array of Single): Integer;
|
||
|
||
{ ── Сборка ─────────────────────────────────────────────────────────────── }
|
||
|
||
function TCIBuild(const Name: string): string; overload;
|
||
function TCIBuild(const Name: string; const Args: array of string): string; overload;
|
||
|
||
function TCIBoolStr(B: Boolean): string;
|
||
function TCIIntStr(V: Int64): string;
|
||
function TCIFloatStr(V: Double; Digits: Integer = 1): string;
|
||
|
||
{ ── Экранирование текстовых аргументов (§3.2.1) ────────────────────────── }
|
||
|
||
function TCIUnescape(const S: string): string;
|
||
function TCIEscape(const S: string): string;
|
||
|
||
{ ── Виды связи ─────────────────────────────────────────────────────────── }
|
||
|
||
{ Имя вида связи для TCI по индексу RadioModes (CWL/CWU схлопываются в 'cw'). }
|
||
function TCIModeName(ModeIdx: Integer): string;
|
||
|
||
{ Индекс RadioModes по имени TCI. 'cw' сам по себе боковую не задаёт:
|
||
оставляем текущую, если уже телеграф, иначе выбираем по частоте (ниже
|
||
10 МГц — CWL, выше — CWU, общепринятая конвенция). -1 = имя неизвестно. }
|
||
function TCIModeIndex(const Name: string; CurMode: Integer; FreqHz: Double): Integer;
|
||
|
||
{ ── Пересчёт величин ───────────────────────────────────────────────────── }
|
||
|
||
function TCIVolumeToDb(V: Integer): Double; // громкость 0..100 → -60..0 дБ
|
||
function TCIDbToVolume(Db: Double): Integer; // и обратно
|
||
function TCISqlToLevel(Db: Double): Integer; // порог -140..0 дБ → 0..100
|
||
function TCILevelToSql(V: Integer): Double;
|
||
|
||
implementation
|
||
|
||
var
|
||
// Числа протокола — только с точкой, независимо от локали хоста.
|
||
TCIFormatSettings: TFormatSettings;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Разбор
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TCIParse(const S: string; out M: TTCIMessage): Boolean;
|
||
var
|
||
Body, ArgStr: string;
|
||
P, Start, i: Integer;
|
||
begin
|
||
Result := False;
|
||
M.Name := '';
|
||
M.ArgCount := 0;
|
||
SetLength(M.Args, 0);
|
||
|
||
Body := Trim(S);
|
||
// Хвостовая ';' необязательна: транспорт мог её уже срезать при нарезке.
|
||
if (Body <> '') and (Body[Length(Body)] = ';') then
|
||
Body := Copy(Body, 1, Length(Body) - 1);
|
||
Body := Trim(Body);
|
||
if Body = '' then Exit;
|
||
|
||
P := Pos(':', Body);
|
||
if P = 0 then
|
||
begin
|
||
M.Name := UpperCase(Body);
|
||
Result := M.Name <> '';
|
||
Exit;
|
||
end;
|
||
|
||
M.Name := UpperCase(Trim(Copy(Body, 1, P - 1)));
|
||
if M.Name = '' then Exit;
|
||
|
||
ArgStr := Copy(Body, P + 1, MaxInt);
|
||
Start := 1;
|
||
for i := 1 to Length(ArgStr) + 1 do
|
||
if (i > Length(ArgStr)) or (ArgStr[i] = ',') then
|
||
begin
|
||
SetLength(M.Args, M.ArgCount + 1);
|
||
M.Args[M.ArgCount] := Trim(Copy(ArgStr, Start, i - Start));
|
||
Inc(M.ArgCount);
|
||
Start := i + 1;
|
||
end;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
function TCISplit(const Payload: string; Lines: TStrings): Integer;
|
||
var
|
||
i, Start: Integer;
|
||
Piece: string;
|
||
begin
|
||
Lines.Clear;
|
||
Start := 1;
|
||
for i := 1 to Length(Payload) do
|
||
if Payload[i] = ';' then
|
||
begin
|
||
Piece := Trim(Copy(Payload, Start, i - Start));
|
||
if Piece <> '' then Lines.Add(Piece);
|
||
Start := i + 1;
|
||
end;
|
||
// Хвост без ';' — недоприехавшая команда; протокол её игнорирует (§3.1).
|
||
Result := Lines.Count;
|
||
end;
|
||
|
||
function TCIArg(const M: TTCIMessage; Idx: Integer): string;
|
||
begin
|
||
if (Idx >= 0) and (Idx < M.ArgCount) then Result := M.Args[Idx] else Result := '';
|
||
end;
|
||
|
||
function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer;
|
||
var
|
||
D: Double;
|
||
begin
|
||
// Клиенты шлют и «7100000», и «7100000.0» — берём через Float и округляем.
|
||
if not TryStrToFloat(StringReplace(TCIArg(M, Idx), ',', '.', [rfReplaceAll]),
|
||
D, TCIFormatSettings) then
|
||
Result := Def
|
||
else
|
||
Result := Round(D);
|
||
end;
|
||
|
||
function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double;
|
||
begin
|
||
if not TryStrToFloat(StringReplace(TCIArg(M, Idx), ',', '.', [rfReplaceAll]),
|
||
Result, TCIFormatSettings) then
|
||
Result := Def;
|
||
end;
|
||
|
||
function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean;
|
||
var
|
||
S: string;
|
||
begin
|
||
S := LowerCase(TCIArg(M, Idx));
|
||
if (S = 'true') or (S = '1') then Result := True
|
||
else if (S = 'false') or (S = '0') then Result := False
|
||
else Result := Def;
|
||
end;
|
||
|
||
function TCITryArgFloat(const M: TTCIMessage; Idx: Integer; out V: Double): Boolean;
|
||
var S: string;
|
||
begin
|
||
V := 0;
|
||
S := Trim(TCIArg(M, Idx));
|
||
if S = '' then Exit(False);
|
||
Result := TryStrToFloat(StringReplace(S, ',', '.', [rfReplaceAll]), V,
|
||
TCIFormatSettings);
|
||
end;
|
||
|
||
function TCITryArgInt(const M: TTCIMessage; Idx: Integer; out V: Integer): Boolean;
|
||
var D: Double;
|
||
begin
|
||
V := 0;
|
||
Result := TCITryArgFloat(M, Idx, D);
|
||
// Величины протокола целочисленные, но клиенты шлют и «100.0»; за пределами
|
||
// Integer округлять нечего — это не значение, а мусор.
|
||
if Result then
|
||
begin
|
||
Result := (D >= -2147483648.0) and (D <= 2147483647.0);
|
||
if Result then V := Round(D);
|
||
end;
|
||
end;
|
||
|
||
function TCITryArgBool(const M: TTCIMessage; Idx: Integer; out V: Boolean): Boolean;
|
||
var S: string;
|
||
begin
|
||
V := False;
|
||
S := LowerCase(Trim(TCIArg(M, Idx)));
|
||
if (S = 'true') or (S = '1') then begin V := True; Result := True; end
|
||
else if (S = 'false') or (S = '0') then begin V := False; Result := True; end
|
||
else Result := False;
|
||
end;
|
||
|
||
function TCIValidIQRate(V: Integer): Boolean;
|
||
begin
|
||
Result := (V = 48000) or (V = 96000) or (V = 192000) or (V = 384000);
|
||
end;
|
||
|
||
function TCIValidAudioRate(V: Integer): Boolean;
|
||
begin
|
||
Result := (V = 8000) or (V = 12000) or (V = 24000) or (V = 48000);
|
||
end;
|
||
|
||
function TCIValidSampleType(const S: string): Boolean;
|
||
var T: TTCISampleType;
|
||
begin
|
||
Result := TCISampleTypeByName(S, T);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Бинарные потоки (§3.4)
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TCISampleTypeByName(const S: string; out T: TTCISampleType): Boolean;
|
||
var N: string;
|
||
begin
|
||
Result := True;
|
||
N := LowerCase(Trim(S));
|
||
if N = 'int16' then T := tsyInt16
|
||
else if N = 'int24' then T := tsyInt24
|
||
else if N = 'int32' then T := tsyInt32
|
||
else if N = 'float32' then T := tsyFloat32
|
||
else begin T := tsyFloat32; Result := False; end;
|
||
end;
|
||
|
||
function TCISampleTypeName(T: TTCISampleType): string;
|
||
begin
|
||
case T of
|
||
tsyInt16: Result := 'int16';
|
||
tsyInt24: Result := 'int24';
|
||
tsyInt32: Result := 'int32';
|
||
else Result := 'float32';
|
||
end;
|
||
end;
|
||
|
||
function TCISampleBytes(T: TTCISampleType): Integer;
|
||
begin
|
||
case T of
|
||
tsyInt16: Result := 2;
|
||
tsyInt24: Result := 3;
|
||
else Result := 4; // int32 и float32
|
||
end;
|
||
end;
|
||
|
||
function TCIDefaultAudioSamples(RateHz: Integer): Integer;
|
||
begin
|
||
case RateHz of
|
||
8000: Result := 256;
|
||
12000: Result := 512;
|
||
24000: Result := 1024;
|
||
else Result := 2048; // 48 кГц и всё непонятное
|
||
end;
|
||
end;
|
||
|
||
function TCIMaxBlockSamples(T: TTCISampleType; Channels: Integer): Integer;
|
||
begin
|
||
if Channels < 1 then Channels := 1;
|
||
Result := TCI_STREAM_DATA_MAX div (TCISampleBytes(T) * Channels);
|
||
end;
|
||
|
||
procedure TCIFillHeader(out H: TTCIStreamHeader; Kind: TTCIStreamType;
|
||
Rx, RateHz: Integer; T: TTCISampleType; Count, Channels: Integer);
|
||
begin
|
||
FillChar(H, SizeOf(H), 0);
|
||
H.Receiver := LongWord(Rx);
|
||
H.SampleRate := LongWord(RateHz);
|
||
H.Format := LongWord(Ord(T));
|
||
// ★length — вещественные отсчёты всего блока, у всех типов потока одинаково
|
||
// (см. шапку объявления: «на канал» ломает реальных клиентов).
|
||
H.DataLength := LongWord(Count * Channels);
|
||
H.StreamType := LongWord(Ord(Kind));
|
||
H.Channels := LongWord(Channels);
|
||
end;
|
||
|
||
function TCIPackSamples(const Src: array of Single; N: Integer;
|
||
T: TTCISampleType; Dest: PByte): Integer;
|
||
// Клампим на входе: перегруз в целочисленных форматах иначе заворачивается
|
||
// через знак и вместо ограничения даёт треск обратной полярности.
|
||
var
|
||
i, V: Integer;
|
||
F: Single;
|
||
P: PByte;
|
||
begin
|
||
if N > Length(Src) then N := Length(Src);
|
||
if N < 0 then N := 0;
|
||
P := Dest;
|
||
for i := 0 to N - 1 do
|
||
begin
|
||
F := Src[i];
|
||
if F > 1.0 then F := 1.0;
|
||
if F < -1.0 then F := -1.0;
|
||
case T of
|
||
tsyInt16:
|
||
begin
|
||
V := Round(F * 32767);
|
||
P[0] := Byte(V); P[1] := Byte(V shr 8);
|
||
Inc(P, 2);
|
||
end;
|
||
tsyInt24:
|
||
begin
|
||
V := Round(F * 8388607);
|
||
P[0] := Byte(V); P[1] := Byte(V shr 8); P[2] := Byte(V shr 16);
|
||
Inc(P, 3);
|
||
end;
|
||
tsyInt32:
|
||
begin
|
||
// 2^31-1 в Single не представимо точно, поэтому масштаб берём
|
||
// на единицу младше — иначе Round на полной шкале переполняется.
|
||
V := Round(F * 2147483520.0);
|
||
P[0] := Byte(V); P[1] := Byte(V shr 8);
|
||
P[2] := Byte(V shr 16); P[3] := Byte(V shr 24);
|
||
Inc(P, 4);
|
||
end;
|
||
else
|
||
begin
|
||
PSingle(P)^ := F;
|
||
Inc(P, 4);
|
||
end;
|
||
end;
|
||
end;
|
||
Result := N * TCISampleBytes(T);
|
||
end;
|
||
|
||
function TCIUnpackSamples(Src: PByte; Bytes: Integer; T: TTCISampleType;
|
||
var Dest: array of Single): Integer;
|
||
var
|
||
i, N, W: Integer;
|
||
P: PByte;
|
||
begin
|
||
Result := 0;
|
||
if (Src = nil) or (Bytes <= 0) then Exit;
|
||
N := Bytes div TCISampleBytes(T);
|
||
if N > Length(Dest) then N := Length(Dest);
|
||
P := Src;
|
||
for i := 0 to N - 1 do
|
||
begin
|
||
case T of
|
||
tsyInt16:
|
||
begin
|
||
W := SmallInt(Word(P[0]) or (Word(P[1]) shl 8));
|
||
Dest[i] := W / 32768.0;
|
||
Inc(P, 2);
|
||
end;
|
||
tsyInt24:
|
||
begin
|
||
W := LongInt(P[0]) or (LongInt(P[1]) shl 8) or (LongInt(P[2]) shl 16);
|
||
if (W and $800000) <> 0 then W := W or LongInt($FF000000);
|
||
Dest[i] := W / 8388608.0;
|
||
Inc(P, 3);
|
||
end;
|
||
tsyInt32:
|
||
begin
|
||
W := LongInt(LongWord(P[0]) or (LongWord(P[1]) shl 8) or
|
||
(LongWord(P[2]) shl 16) or (LongWord(P[3]) shl 24));
|
||
Dest[i] := W / 2147483648.0;
|
||
Inc(P, 4);
|
||
end;
|
||
else
|
||
begin
|
||
Dest[i] := PSingle(P)^;
|
||
Inc(P, 4);
|
||
end;
|
||
end;
|
||
end;
|
||
Result := N;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Сборка
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TCIBuild(const Name: string): string;
|
||
begin
|
||
Result := LowerCase(Name) + ';';
|
||
end;
|
||
|
||
function TCIBuild(const Name: string; const Args: array of string): string;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if Length(Args) = 0 then begin Result := TCIBuild(Name); Exit; end;
|
||
Result := LowerCase(Name) + ':';
|
||
for i := 0 to High(Args) do
|
||
begin
|
||
if i > 0 then Result := Result + ',';
|
||
Result := Result + Args[i];
|
||
end;
|
||
Result := Result + ';';
|
||
end;
|
||
|
||
function TCIBoolStr(B: Boolean): string;
|
||
begin
|
||
if B then Result := 'true' else Result := 'false';
|
||
end;
|
||
|
||
function TCIIntStr(V: Int64): string;
|
||
begin
|
||
Result := IntToStr(V);
|
||
end;
|
||
|
||
function TCIFloatStr(V: Double; Digits: Integer): string;
|
||
begin
|
||
if IsNan(V) or IsInfinite(V) then V := 0;
|
||
Result := FloatToStrF(V, ffFixed, 15, Digits, TCIFormatSettings);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Экранирование
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TCIUnescape(const S: string): string;
|
||
begin
|
||
Result := StringReplace(S, '^', ':', [rfReplaceAll]);
|
||
Result := StringReplace(Result, '~', ',', [rfReplaceAll]);
|
||
Result := StringReplace(Result, '*', ';', [rfReplaceAll]);
|
||
end;
|
||
|
||
function TCIEscape(const S: string): string;
|
||
begin
|
||
Result := StringReplace(S, ':', '^', [rfReplaceAll]);
|
||
Result := StringReplace(Result, ',', '~', [rfReplaceAll]);
|
||
Result := StringReplace(Result, ';', '*', [rfReplaceAll]);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Виды связи
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TCIModeName(ModeIdx: Integer): string;
|
||
begin
|
||
case ModeIdx of
|
||
MODE_LSB: Result := 'lsb';
|
||
MODE_USB: Result := 'usb';
|
||
MODE_DSB: Result := 'dsb';
|
||
MODE_CWL,
|
||
MODE_CWU: Result := 'cw';
|
||
MODE_FM: Result := 'nfm';
|
||
MODE_AM: Result := 'am';
|
||
MODE_SAM: Result := 'sam';
|
||
MODE_DIGU: Result := 'digu';
|
||
MODE_DIGL: Result := 'digl';
|
||
MODE_WFM: Result := 'wfm';
|
||
MODE_DMR: Result := 'dmr';
|
||
MODE_FMRAW: Result := 'fmraw';
|
||
else
|
||
Result := 'usb';
|
||
end;
|
||
end;
|
||
|
||
function TCIModeIndex(const Name: string; CurMode: Integer; FreqHz: Double): Integer;
|
||
var
|
||
S: string;
|
||
begin
|
||
S := LowerCase(Trim(Name));
|
||
if S = 'lsb' then Result := MODE_LSB
|
||
else if S = 'usb' then Result := MODE_USB
|
||
else if S = 'dsb' then Result := MODE_DSB
|
||
else if S = 'am' then Result := MODE_AM
|
||
else if S = 'sam' then Result := MODE_SAM
|
||
else if (S = 'nfm') or (S = 'fm') then Result := MODE_FM
|
||
else if S = 'wfm' then Result := MODE_WFM
|
||
else if S = 'digu' then Result := MODE_DIGU
|
||
else if S = 'digl' then Result := MODE_DIGL
|
||
else if S = 'dmr' then Result := MODE_DMR
|
||
else if S = 'fmraw' then Result := MODE_FMRAW
|
||
else if S = 'cwl' then Result := MODE_CWL
|
||
else if S = 'cwu' then Result := MODE_CWU
|
||
else if S = 'cw' then
|
||
begin
|
||
if (CurMode = MODE_CWL) or (CurMode = MODE_CWU) then
|
||
Result := CurMode // боковую телеграфа не трогаем
|
||
else if FreqHz < 10000000 then
|
||
Result := MODE_CWL
|
||
else
|
||
Result := MODE_CWU;
|
||
end
|
||
else
|
||
Result := -1; // 'drm' и всё незнакомое — молча игнорируем (§3.1)
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Пересчёт величин
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TCIVolumeToDb(V: Integer): Double;
|
||
begin
|
||
if V <= 0 then Result := TCI_VOL_MIN_DB
|
||
else if V >= 100 then Result := 0
|
||
else Result := TCI_VOL_MIN_DB + (TCI_VOL_MIN_DB * -1) * (V / 100.0);
|
||
end;
|
||
|
||
function TCIDbToVolume(Db: Double): Integer;
|
||
begin
|
||
if Db <= TCI_VOL_MIN_DB then Result := 0
|
||
else if Db >= 0 then Result := 100
|
||
else Result := Round((Db - TCI_VOL_MIN_DB) / (TCI_VOL_MIN_DB * -1) * 100.0);
|
||
end;
|
||
|
||
function TCISqlToLevel(Db: Double): Integer;
|
||
begin
|
||
// Порог шумоподавителя: у нас 0..100 (FM squelch), у TCI — dBm -140..0.
|
||
if Db <= TCI_SQL_MIN_DB then Result := 0
|
||
else if Db >= 0 then Result := 100
|
||
else Result := Round((Db - TCI_SQL_MIN_DB) / (TCI_SQL_MIN_DB * -1) * 100.0);
|
||
end;
|
||
|
||
function TCILevelToSql(V: Integer): Double;
|
||
begin
|
||
if V <= 0 then Result := TCI_SQL_MIN_DB
|
||
else if V >= 100 then Result := 0
|
||
else Result := TCI_SQL_MIN_DB + (TCI_SQL_MIN_DB * -1) * (V / 100.0);
|
||
end;
|
||
|
||
initialization
|
||
TCIFormatSettings := DefaultFormatSettings;
|
||
TCIFormatSettings.DecimalSeparator := '.';
|
||
|
||
end.
|