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; // потолок записи линейного выхода 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.