feat(tci): TCI 2.0 — EWSDR как сервер (команды и уведомления)

Протокол Expert Electronics поверх WebSocket, порт 40001. EWSDR слушает, клиенты — логгеры, скиммеры, цифровые программы. - TCIProtocol.pas — чистый слой протокола: разбор/сборка `имя:арг;`, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости в дБ. - TCIServer.pas — WS-сервер поверх WebUtils/WsClient: accept-поток, поток на клиента, HTTP-Upgrade, фреймы, рассылка, тик 20 мс. - TCIAdapter.pas — мост к TRadioController по схеме CAT: геттеры читают поля напрямую, сеттеры через Invoke, уведомления через AddStateListener. Маппинг: приёмник TCI = панадаптер, канал A/B = VFO A/B (пан 0) либо первый/второй слайс (паны 1..). Попутно: TRadioController.RemoveStateListener (адаптер умирает раньше контроллера) и TDXSpotStore.RemoveCall (spot_delete). Настройки — секция "tci" в settings.json (умолчание: выключено, 127.0.0.1, так как авторизации в протоколе нет) и вкладка Advanced → TCI Server. Бинарные потоки (IQ/аудио) — этап 2. Статус, таблица команд и список осознанных эхо-заглушек — в doc/TCI.md. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-08-25 18:43:51 +00:00 · 2026-08-17 16:22:49 +03:00
parent 92c01fa2c6
commit 82f0e4f771
10 changed files with 3208 additions and 0 deletions
@@ -0,0 +1,379 @@
+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.