ewsdr/TCIProtocol.pas

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;

{ Строгий разбор аргумента: 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

{ ── Сборка ─────────────────────────────────────────────────────────────── }

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: string;
begin
  T := LowerCase(Trim(S));
  Result := (T = 'int16') or (T = 'int24') or (T = 'int32') or (T = 'float32');
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.