mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
Последняя невыполненная команда протокола. Ключ к ней в том, что arg3 — длительность интервала, который ТОЛЬКО ЧТО кончился, а не начинающегося. Документ задаёт это алгоритмом: первое нажатие keyer:0,true,0, отпускание keyer:0,false,142 («посылка длилась 142 мс»), следующее нажатие keyer:0,true,58 («пауза длилась 58 мс»). Отсюда перевод: тип элемента — это состояние ключа ДО фронта, то есть обратное пришедшему; arg3 = 0 играть нечего. Почему не дёргать ключ по приходу пакета: приход говорит, что интервал кончился, а не сколько он длился, и манипуляция «по приходу» — это сетевой джиттер прямо в эфир, тот самый «пьяный матрос», ради которого третий аргумент в протоколе и появился. Новый TCWElemPlayer (CWMorse.pas) держит очередь элементов и играет их подряд по абсолютным дедлайнам: сумма длительностей равна времени у клиента, значит отставание постоянно (сеть + один элемент) и не накапливается. Очередь опустела — ключ отпускается и следующая пачка начинается с чистого дедлайна: элементы чередуются, искажения нет, зато оборвавшийся клиент не оставляет в эфире несущую. Контроллер: CWKeyerElement(Mark, Ms) ставит элемент в очередь, CWElemKey раздаёт фронты — чужая манипуляция это прямой ключ с точными длительностями, поэтому у Pluto она идёт во вход прямого ключа локального генератора (он сам поднимает сессию, рисует огибающую и сайдтон), а у openHPSDR в бит CWX прошивки (тем же путём идёт передача текста). Гейт CWTXActive, как у CWXSend; обрыв общий с текстом — касание манипулятора, снятие MOX и уход из телеграфа гасят чужую манипуляцию тем же CWXAbort. Передачу KEYER не поднимает: при break-in PTT даёт прошивка (или сессия генератора), без него оператор держит MOX сам. Адаптер: номер передатчика разбирается как у TRX (bad receiver / receiver is not running), захват §3.5 общий с TRX — передатчик один, и ключ держит тот же, кто держит эфир. Паузы обрезаются TCI_KEYER_GAP_MAX_MS = 1 с (пауза целиком прибавляется к отставанию от клиента, а дольше секунды — это «оператор задумался», и честнее догнать реальное время), посылки — 5 с. Стенд test/tci: 238 проверок (было 219). Новая часть C2 меряет ДЛИТЕЛЬНОСТИ по фронтам ключа (посылка 150 / пауза 60 / посылка 150, допуск 30 мс), проверяет отпускание на пустой очереди, старт следующей пачки без «догона» дедлайна, обрыв и нулевую длительность; в части D — разбор аргументов команды и сквозная проверка, что keyer:0,true,<мс> ключ не замыкает (это пауза), а keyer:0,false,<мс> замыкает. Негативный контроль на инверсию перевода. ★Локальный генератор вооружается только при живом устройстве, поэтому сквозная проверка подставляет FDevConnected/FRunning на время. doc/TCI.md: §2.6 описывает команду целиком, §3.1 и §4 переписаны под то, что из пары KEYER/TX_FOOTSWITCH остался только второй; попутно убран устаревший абзац §2.3 про «потоки — этап 2». На железе с настоящим ключом по сети ещё не гонялось. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
687 lines
30 KiB
ObjectPascal
687 lines
30 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; // потолок записи линейного выхода
|
||
// Потолки длительностей у KEYER (§4.3). Посылка длиннее пяти секунд — это
|
||
// уже не телеграф, а залипший ключ; паузу же обрезаем куда жёстче: она
|
||
// прибавляется к отставанию проигрывателя от клиента, а всё, что дольше
|
||
// секунды, — это «оператор задумался», и после такой паузы честнее
|
||
// догнать реальное время, чем тащить его дальше.
|
||
TCI_KEYER_MARK_MAX_MS = 5000;
|
||
TCI_KEYER_GAP_MAX_MS = 1000;
|
||
// ★Общий потолок памяти ВСЕХ рекордеров сразу. Приёмников у нас
|
||
// 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.
|