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'; // Границы, оговорённые протоколом (клампим сами — клиент шлёт что угодно). 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). Потоки — следующий этап (см. doc/TCI.md), но формат протокольный, поэтому объявлен здесь, а не в транспорте. } 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; // количество вещественных отсчётов в data[] 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; { ── Сборка ─────────────────────────────────────────────────────────────── } 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 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.