mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
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>
This commit is contained in:
Claude Opus 5
@@ -73,6 +73,8 @@ type
|
||||
|
||||
// Добавить/обновить спот (вызывается из потока кластера).
|
||||
procedure Add(const S: TDXSpot);
|
||||
// Убрать все споты позывного (SPOT_DELETE в TCI; регистр не важен).
|
||||
procedure RemoveCall(const Call: string);
|
||||
procedure Clear;
|
||||
// Выбросить просроченное прямо сейчас. Нужен тому, кто следит за временем
|
||||
// снаружи: сам стор чистится только на Add и снимках, а когда споты никто
|
||||
@@ -364,6 +366,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXSpotStore.RemoveCall(const Call: string);
|
||||
var i, j: Integer; Up: string;
|
||||
begin
|
||||
Up := UpperCase(Trim(Call));
|
||||
if Up = '' then Exit;
|
||||
FLock.Enter;
|
||||
try
|
||||
i := 0;
|
||||
while i < FCount do
|
||||
if UpperCase(FSpots[i].Call) = Up then
|
||||
begin
|
||||
for j := i to FCount - 2 do FSpots[j] := FSpots[j + 1];
|
||||
Dec(FCount);
|
||||
Inc(FVersion);
|
||||
end
|
||||
else
|
||||
Inc(i);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CompareSpotFreq(const A, B: TDXSpot): Integer;
|
||||
begin
|
||||
if A.FreqHz < B.FreqHz then Result := -1
|
||||
|
||||
@@ -35,6 +35,7 @@ uses
|
||||
Settings,
|
||||
WebServer, WebAdapter,
|
||||
CATAdapter,
|
||||
TCIAdapter,
|
||||
SpectrumView, SpectrumViewOpengl,
|
||||
PanZoomBar, PanafallPanel, PanDisplayPopup, PureSignalPopup, FlatPopupMenu,
|
||||
WidebandView,
|
||||
@@ -246,6 +247,8 @@ type
|
||||
FWebSpecPixels: Integer; // потолок точек кадра спектра/водопада для web
|
||||
// --- CAT ---
|
||||
FCATAdapter: TCATAdapter; // адаптер CAT поверх контроллера (движок+транспорты+контекст)
|
||||
FTCIAdapter: TTCIAdapter; // адаптер TCI (WebSocket-сервер Expert Electronics)
|
||||
FTCICfg: TTCISettings; // текущие настройки TCI (UI/persist)
|
||||
FCATLastGlobal: TGlobalSettings; // текущие CAT-настройки (UI/persist; ApplySettings → адаптер)
|
||||
// Виджеты построены (конец FormCreate). До этого рендер состояния запрещён:
|
||||
// адаптеры (CAT/web), создаваемые по ходу FormCreate, могут дёрнуть
|
||||
@@ -835,6 +838,12 @@ type
|
||||
procedure ApplyADCSettings(Dither, Random: Boolean);
|
||||
procedure ApplyWebSettings(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr, User, Pass: string; SpecPixels: Integer);
|
||||
procedure ApplyTCISettings(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr: string);
|
||||
// Фокус главного окна → APP_FOCUS клиентам TCI (логгеры так решают, кому
|
||||
// отдавать клавиатуру).
|
||||
procedure TCIFormActivate(Sender: TObject);
|
||||
procedure TCIFormDeactivate(Sender: TObject);
|
||||
procedure ApplyGridParams(RefLevel, Range, GridStep: Double);
|
||||
// Пушит активные grid-параметры (RX или TX в зависимости от FTransmitting)
|
||||
// в FSpecView и сбрасывает кэш сетки. Вызывается при смене RX↔TX и при
|
||||
@@ -1447,6 +1456,7 @@ begin
|
||||
FreeAndNil(FWebAdapter); // адаптер не владеет сервером — освобождаем после Stop
|
||||
FWebServer.Free;
|
||||
FreeAndNil(FCATAdapter); // его Destroy останавливает+освобождает CAT движок/транспорты
|
||||
FreeAndNil(FTCIAdapter); // Destroy останавливает TCI-сервер и его потоки
|
||||
// Ядро освобождаем последним — его Destroy закрывает и освобождает движки
|
||||
// (FreeEngines) и FSettings.
|
||||
FreeAndNil(FController);
|
||||
@@ -2705,6 +2715,14 @@ begin
|
||||
// DX-кластер: база спотов + сетевой поток + оверлей подписей.
|
||||
InitDXCluster;
|
||||
|
||||
// TCI-сервер — равноправный фронтенд рядом с CAT и web. Создаём после
|
||||
// InitDXCluster: споты от TCI-клиентов кладутся в тот же стор.
|
||||
FController.FSettings.LoadTCISettings(FTCICfg);
|
||||
FTCIAdapter := TTCIAdapter.Create(FController, FDXStore);
|
||||
FTCIAdapter.ApplySettings(FTCICfg);
|
||||
OnActivate := TCIFormActivate;
|
||||
OnDeactivate := TCIFormDeactivate;
|
||||
|
||||
// S-метр — внутри PanelToolbar, справа
|
||||
PanelSMeterRight := TPanel.Create(Self);
|
||||
PanelSMeterRight.Parent := PanelToolbar;
|
||||
@@ -5633,6 +5651,9 @@ begin
|
||||
FDXSpotOverlay.SpotAtPixel(X, Y, DXSpot) then
|
||||
begin
|
||||
OnDXTuneSpot(DXSpot.FreqHz, DXSpot.Mode);
|
||||
// Клик по споту — уведомление TCI-клиентам (логгер открывает QSO-карточку).
|
||||
if FTCIAdapter <> nil then
|
||||
FTCIAdapter.NotifySpotClicked(DXSpot.Call, DXSpot.FreqHz, 0, FController.FActiveVfo);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
@@ -6548,6 +6569,26 @@ begin
|
||||
FController.FSettings.SaveWebSettings(W);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ApplyTCISettings(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr: string);
|
||||
begin
|
||||
FTCICfg.Enabled := Enabled;
|
||||
FTCICfg.Port := Port;
|
||||
FTCICfg.BindAddr := BindAddr;
|
||||
FController.FSettings.SaveTCISettings(FTCICfg);
|
||||
if FTCIAdapter <> nil then FTCIAdapter.ApplySettings(FTCICfg);
|
||||
end;
|
||||
|
||||
procedure TMainForm.TCIFormActivate(Sender: TObject);
|
||||
begin
|
||||
if FTCIAdapter <> nil then FTCIAdapter.NotifyAppFocus(True);
|
||||
end;
|
||||
|
||||
procedure TMainForm.TCIFormDeactivate(Sender: TObject);
|
||||
begin
|
||||
if FTCIAdapter <> nil then FTCIAdapter.NotifyAppFocus(False);
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnSampleRateHidePanel;
|
||||
begin
|
||||
FPanelHidden := not FPanelHidden;
|
||||
@@ -7937,6 +7978,8 @@ begin
|
||||
P.DXOverlay.SpotAtPixel(X, Y, DXSpot) then
|
||||
begin
|
||||
DXTuneSpotOnPan(P, DXSpot.FreqHz, DXSpot.Mode);
|
||||
if FTCIAdapter <> nil then
|
||||
FTCIAdapter.NotifySpotClicked(DXSpot.Call, DXSpot.FreqHz, P.PanId, 0);
|
||||
Exit;
|
||||
end;
|
||||
W := TControl(Sender).Width;
|
||||
@@ -9634,6 +9677,7 @@ begin
|
||||
SF.OnWfAGCNFChange := ApplyWfAGCNF;
|
||||
SF.OnADCChange := ApplyADCSettings;
|
||||
SF.OnWebSettingsChange := ApplyWebSettings;
|
||||
SF.OnTCISettingsChange := ApplyTCISettings;
|
||||
SF.OnDXClusterChange := OnDXClusterSettingsChange;
|
||||
end;
|
||||
SF := TSettingsForm(FSettingsForm);
|
||||
@@ -9689,6 +9733,7 @@ begin
|
||||
SF.LoadADCSettings(FController.FDitherEnabled, FController.FRandomEnabled);
|
||||
SF.LoadWebSettings(FWebEnabled, FWebPort, FWebBindAddr, FWebUser, FWebPass,
|
||||
FWebSpecPixels);
|
||||
SF.LoadTCISettings(FTCICfg.Enabled, FTCICfg.Port, FTCICfg.BindAddr);
|
||||
SF.LoadDXClusterSettings(FDXCfg);
|
||||
SF.LoadFPS(FDisplayFPS);
|
||||
SF.LoadLightTheme(FLightTheme);
|
||||
|
||||
@@ -1185,6 +1185,9 @@ type
|
||||
// Доп. наблюдатели состояния (помимо единственного OnStateChanged, который
|
||||
// занимает MainForm). Нужны CAT/Andromeda для push индикаторов панели.
|
||||
procedure AddStateListener(L: TRadioStateEvent);
|
||||
// Снять наблюдателя. Обязателен для тех, кто умирает раньше контроллера
|
||||
// (TCI-адаптер): иначе Changed() позовёт метод освобождённого объекта.
|
||||
procedure RemoveStateListener(L: TRadioStateEvent);
|
||||
// Пост-тюн хук: вызывается в КОНЦЕ SetVfoA (после Changed(rfVfoA), т.е. вне
|
||||
// рендера) — сюда вешается канальная оркестрация (ChannelController.OnVfoTuned),
|
||||
// чтобы любой путь тюнинга (desktop/web/CAT/энкодер) был канал-aware headless.
|
||||
@@ -1447,6 +1450,21 @@ begin
|
||||
FStateListeners[High(FStateListeners)] := L;
|
||||
end;
|
||||
|
||||
procedure TRadioController.RemoveStateListener(L: TRadioStateEvent);
|
||||
var i, j: Integer;
|
||||
begin
|
||||
if not Assigned(L) then Exit;
|
||||
for i := 0 to High(FStateListeners) do
|
||||
if (TMethod(FStateListeners[i]).Code = TMethod(L).Code) and
|
||||
(TMethod(FStateListeners[i]).Data = TMethod(L).Data) then
|
||||
begin
|
||||
for j := i to High(FStateListeners) - 1 do
|
||||
FStateListeners[j] := FStateListeners[j + 1];
|
||||
SetLength(FStateListeners, Length(FStateListeners) - 1);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRadioController.PushNetworkState;
|
||||
// Полный HP-кадр в радио: RX/TX частоты (через трансвертор), drive, состояние
|
||||
// MOX. Вызывается командами, которые меняют центр/частоту/репитер-сдвиг.
|
||||
|
||||
@@ -459,6 +459,15 @@ type
|
||||
SpecPixels: Integer;
|
||||
end;
|
||||
|
||||
// TCI-сервер (протокол Expert Electronics поверх WebSocket). Авторизации в
|
||||
// протоколе нет, поэтому умолчание слушает только петлю: логгеры и цифровые
|
||||
// программы обычно живут на том же ПК, а наружу порт открывается осознанно.
|
||||
TTCISettings = record
|
||||
Enabled: Boolean;
|
||||
Port: Integer; // 1..65535, умолчание 40001 (как у ExpertSDR3)
|
||||
BindAddr: string; // '127.0.0.1' или '0.0.0.0'
|
||||
end;
|
||||
|
||||
// Transverter (XVTR) entry — один трансвертер.
|
||||
// Видимая частота VFO в [FreqBegin..FreqEnd] транслируется в IF-частоту,
|
||||
// которую слышит трансивер: f_IF = f_visible - LOOffset + LOError.
|
||||
@@ -779,6 +788,10 @@ type
|
||||
class procedure DefaultWeb(out W: TWebSettings);
|
||||
procedure LoadWebSettings(out W: TWebSettings);
|
||||
procedure SaveWebSettings(const W: TWebSettings);
|
||||
// TCI-сервер — глобальные настройки (секция "tci" в корне JSON).
|
||||
class procedure DefaultTCI(out T: TTCISettings);
|
||||
procedure LoadTCISettings(out T: TTCISettings);
|
||||
procedure SaveTCISettings(const T: TTCISettings);
|
||||
// Тема — глобальная настройка, не привязана к устройству
|
||||
procedure SaveTheme(ALightTheme: Boolean);
|
||||
function LoadTheme: Boolean;
|
||||
@@ -2981,6 +2994,34 @@ begin
|
||||
Save;
|
||||
end;
|
||||
|
||||
class procedure TSettingsManager.DefaultTCI(out T: TTCISettings);
|
||||
begin
|
||||
T.Enabled := False; // включается осознанно, как CAT-транспорты
|
||||
T.Port := 40001;
|
||||
T.BindAddr := '127.0.0.1';
|
||||
end;
|
||||
|
||||
procedure TSettingsManager.LoadTCISettings(out T: TTCISettings);
|
||||
var O: TJSONObject;
|
||||
begin
|
||||
DefaultTCI(T);
|
||||
if FRoot.Find('tci') = nil then Exit;
|
||||
O := EnsureObj(FRoot, 'tci');
|
||||
T.Enabled := JB(O, 'enabled', False);
|
||||
T.Port := EnsureRange(JI(O, 'port', 40001), 1, 65535);
|
||||
T.BindAddr := JS(O, 'bind_addr', '127.0.0.1');
|
||||
end;
|
||||
|
||||
procedure TSettingsManager.SaveTCISettings(const T: TTCISettings);
|
||||
var O: TJSONObject;
|
||||
begin
|
||||
O := EnsureObj(FRoot, 'tci');
|
||||
JW(O, 'enabled', T.Enabled);
|
||||
JW(O, 'port', T.Port);
|
||||
JWS(O, 'bind_addr', T.BindAddr);
|
||||
Save;
|
||||
end;
|
||||
|
||||
procedure TSettingsManager.SaveTheme(ALightTheme: Boolean);
|
||||
var O: TJSONObject;
|
||||
begin
|
||||
|
||||
@@ -92,6 +92,8 @@ type
|
||||
|
||||
TOnWebSettingsChange = procedure(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr, User, Pass: string; SpecPixels: Integer) of object;
|
||||
TOnTCISettingsChange = procedure(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr: string) of object;
|
||||
TOnCATChange = procedure(
|
||||
const SerEnabled: array of Boolean;
|
||||
const SerPort: array of string;
|
||||
@@ -470,6 +472,9 @@ type
|
||||
FEdWebUser: TFlatEdit;
|
||||
FEdWebPass: TFlatEdit;
|
||||
FCmbWebRes: TFlatComboBox;
|
||||
FChkTCIEnabled: TFlatCheckBox;
|
||||
FEdTCIPort: TFlatSpinEdit;
|
||||
FEdTCIBind: TFlatEdit;
|
||||
|
||||
// ---- Close button ----
|
||||
FBtnClose: TFlatButton;
|
||||
@@ -483,6 +488,7 @@ type
|
||||
FOnVHFCalChange: TOnVHFCalChange;
|
||||
FOnADCChange: TOnADCChange;
|
||||
FOnWebSettingsChange: TOnWebSettingsChange;
|
||||
FOnTCISettingsChange: TOnTCISettingsChange;
|
||||
FOnDXClusterChange: TOnDXClusterChange;
|
||||
FOnDisplayChange: TOnDisplayParamChange;
|
||||
FOnWaterfallChange: TOnWaterfallParamChange;
|
||||
@@ -535,6 +541,7 @@ type
|
||||
procedure BuildAdvancedTab;
|
||||
procedure OnADCChkChange(Sender: TObject);
|
||||
procedure OnWebAnyChange(Sender: TObject);
|
||||
procedure OnTCIAnyChange(Sender: TObject);
|
||||
procedure CollectAlexFromUI;
|
||||
procedure FireAlexChange;
|
||||
procedure OnAlexAnyChange(Sender: TObject);
|
||||
@@ -720,6 +727,8 @@ type
|
||||
procedure LoadDXClusterSettings(const D: TDXClusterSettings);
|
||||
procedure LoadWebSettings(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr, User, Pass: string; SpecPixels: Integer);
|
||||
procedure LoadTCISettings(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr: string);
|
||||
|
||||
property OnCATChange: TOnCATChange read FOnCATChange write FOnCATChange;
|
||||
property OnSliceCATChange: TOnSliceCATChange read FOnSliceCATChange write FOnSliceCATChange;
|
||||
@@ -756,6 +765,7 @@ type
|
||||
property OnWfAGCNFChange: TOnWfAGCNFChange read FOnWfAGCNFChange write FOnWfAGCNFChange;
|
||||
property OnADCChange: TOnADCChange read FOnADCChange write FOnADCChange;
|
||||
property OnWebSettingsChange: TOnWebSettingsChange read FOnWebSettingsChange write FOnWebSettingsChange;
|
||||
property OnTCISettingsChange: TOnTCISettingsChange read FOnTCISettingsChange write FOnTCISettingsChange;
|
||||
property OnDXClusterChange: TOnDXClusterChange read FOnDXClusterChange write FOnDXClusterChange;
|
||||
end;
|
||||
|
||||
@@ -3441,6 +3451,52 @@ begin
|
||||
Lbl := MakeLbl(Grp, '1024 px ~160 KB/s, 4096 px ~650 KB/s per client',
|
||||
GRP_PAD + LBL_W + 12, Y + ROW_H - 8, 320);
|
||||
Lbl.Font.Size := 8;
|
||||
|
||||
// ── TCI Server ────────────────────────────────────────────────────────────
|
||||
// Протокол Expert Electronics поверх WebSocket: логгеры, скиммеры, цифра.
|
||||
Grp := MakeGroupPanel(FPageAdvanced, 'TCI Server', MARGIN, 564, SETTINGS_CARD_W, 190);
|
||||
|
||||
Y := R1;
|
||||
Chk := TFlatCheckBox.Create(Self);
|
||||
Chk.Parent := Grp;
|
||||
Chk.Caption := 'Enabled';
|
||||
Chk.SetBounds(DpiScale(GRP_PAD), DpiScale(Y), DpiScale(260), DpiScale(22));
|
||||
Chk.Font.Size := 9;
|
||||
Chk.Font.Color := CLR_TEXT;
|
||||
Chk.Checked := False;
|
||||
Chk.OnChange := OnTCIAnyChange;
|
||||
FChkTCIEnabled := Chk;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Port:', GRP_PAD, Y + 4, LBL_W);
|
||||
Spin := TFlatSpinEdit.Create(Self);
|
||||
Spin.Parent := Grp;
|
||||
Spin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(90), DpiScale(BTN_H));
|
||||
Spin.Color := CLR_INPUT;
|
||||
Spin.Font.Color := CLR_INPUT_TEXT;
|
||||
Spin.Font.Size := 9;
|
||||
Spin.MinValue := 1;
|
||||
Spin.MaxValue := 65535;
|
||||
Spin.Value := 40001;
|
||||
Spin.OnChange := OnTCIAnyChange;
|
||||
FEdTCIPort := Spin;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Interface:', GRP_PAD, Y + 4, LBL_W);
|
||||
Ed := TFlatEdit.Create(Self);
|
||||
Ed.Parent := Grp;
|
||||
Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(ED_W), DpiScale(BTN_H));
|
||||
Ed.Color := CLR_INPUT;
|
||||
Ed.Font.Color := CLR_INPUT_TEXT;
|
||||
Ed.Font.Size := 9;
|
||||
Ed.Text := '127.0.0.1';
|
||||
Ed.OnChange := OnTCIAnyChange;
|
||||
FEdTCIBind := Ed;
|
||||
|
||||
// Авторизации в протоколе нет: открытый наружу порт = полный доступ к трансиверу.
|
||||
Lbl := MakeLbl(Grp, 'No authentication in TCI — keep 127.0.0.1 unless the network is trusted',
|
||||
GRP_PAD, Y + ROW_H, 460);
|
||||
Lbl.Font.Size := 8;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.BuildDXClusterTab;
|
||||
@@ -3689,6 +3745,26 @@ begin
|
||||
Res);
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.OnTCIAnyChange(Sender: TObject);
|
||||
begin
|
||||
if FLoading then Exit;
|
||||
if not Assigned(FOnTCISettingsChange) then Exit;
|
||||
FOnTCISettingsChange(FChkTCIEnabled.Checked, FEdTCIPort.Value, FEdTCIBind.Text);
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.LoadTCISettings(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr: string);
|
||||
begin
|
||||
FLoading := True;
|
||||
try
|
||||
FChkTCIEnabled.Checked := Enabled;
|
||||
FEdTCIPort.Value := EnsureRange(Port, 1, 65535);
|
||||
FEdTCIBind.Text := BindAddr;
|
||||
finally
|
||||
FLoading := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.LoadADCSettings(Dither, Random: Boolean);
|
||||
begin
|
||||
FLoading := True;
|
||||
|
||||
+1716
File diff suppressed because it is too large
Load Diff
+379
@@ -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.
|
||||
+688
@@ -0,0 +1,688 @@
|
||||
unit TCIServer;
|
||||
|
||||
{
|
||||
TCIServer.pas — транспорт TCI: WebSocket-сервер (роль сервера играем мы,
|
||||
как ExpertSDR3; клиенты — логгеры, скиммеры, программы цифровых видов).
|
||||
|
||||
Что делает:
|
||||
• слушает TCP-порт (умолчание 40001), принимает HTTP-Upgrade на WebSocket
|
||||
по любому пути (клиенты ходят на ws://host:40001/);
|
||||
• режет входящие текстовые фреймы на команды и отдаёт их наверх
|
||||
(OnCommand) прямо в потоке клиента — маршалинг в поток контроллера
|
||||
делает TCIAdapter, как это устроено у CAT;
|
||||
• рассылает строки всем клиентам (Broadcast) — сервер TCI обязан
|
||||
синхронизировать всех подключённых (§3.5);
|
||||
• тикает OnTick (умолчание 20 мс) — по нему адаптер шлёт показания
|
||||
измерителей с индивидуальным для каждого клиента периодом.
|
||||
|
||||
Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2,
|
||||
см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются.
|
||||
|
||||
Сокеты и WS-фреймы переиспользованы из веб-подсистемы (WebUtils/WsClient):
|
||||
тот же код handshake и та же схема «поток на клиента + accept-поток», что в
|
||||
WebServer.
|
||||
|
||||
Авторизации у TCI нет by design. Порт слушается там, где сказано в
|
||||
настройках; умолчание — 127.0.0.1, чтобы наружу он не торчал без спроса.
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$LONGSTRINGS ON}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
WebUtils, WsClient, TCIProtocol
|
||||
{$IFDEF WINDOWS}, Windows, WinSock2{$ELSE}, Sockets{$ENDIF},
|
||||
SyncObjs; // ← после платформенных юнитов (конфликт идентификатора Create)
|
||||
|
||||
const
|
||||
TCI_MAX_CLIENTS = 8;
|
||||
TCI_TICK_MS = 20; // период OnTick (сенсоры троттлятся адаптером)
|
||||
TCI_WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
|
||||
TCI_SEND_TIMEOUT = 1000; // мс на SockSend, иначе клиент считается мёртвым
|
||||
|
||||
type
|
||||
TTCIServer = class;
|
||||
|
||||
{ Один подключённый клиент: WS-сокет + его личные подписки. Подписки на
|
||||
сенсоры в TCI индивидуальны (RX_SENSORS_ENABLE «отправляется только
|
||||
клиентом»), поэтому живут здесь, а не в адаптере. }
|
||||
TTCIClient = class
|
||||
private
|
||||
FWs: TWsClient;
|
||||
FReady: Boolean; // пачка инициализации отправлена
|
||||
FRxSensors: Boolean;
|
||||
FRxSensorsMs: Integer;
|
||||
FRxSensorsAt: QWord; // тик последней отправки
|
||||
FTxSensors: Boolean;
|
||||
FTxSensorsMs: Integer;
|
||||
FTxSensorsAt: QWord;
|
||||
public
|
||||
constructor Create(AWs: TWsClient);
|
||||
{ Текстовый фрейм клиенту. False — соединение уже мертво. }
|
||||
function Send(const S: string): Boolean;
|
||||
property Ws: TWsClient read FWs;
|
||||
property Ready: Boolean read FReady write FReady;
|
||||
property RxSensors: Boolean read FRxSensors write FRxSensors;
|
||||
property RxSensorsMs: Integer read FRxSensorsMs write FRxSensorsMs;
|
||||
property RxSensorsAt: QWord read FRxSensorsAt write FRxSensorsAt;
|
||||
property TxSensors: Boolean read FTxSensors write FTxSensors;
|
||||
property TxSensorsMs: Integer read FTxSensorsMs write FTxSensorsMs;
|
||||
property TxSensorsAt: QWord read FTxSensorsAt write FTxSensorsAt;
|
||||
end;
|
||||
|
||||
TTCIClientEvent = procedure(Client: TTCIClient) of object;
|
||||
TTCICommandEvent = procedure(Client: TTCIClient; const Cmd: string) of object;
|
||||
|
||||
TTCIServer = class
|
||||
private
|
||||
FListenSock: TSocket;
|
||||
FClients: array[0..TCI_MAX_CLIENTS-1] of TTCIClient;
|
||||
FClientCount: Integer;
|
||||
FClientLock: TCriticalSection;
|
||||
FAcceptThread: TThread;
|
||||
FTickThread: TThread;
|
||||
FThreadCount: LongInt; // живых клиентских потоков (Interlocked*)
|
||||
FRunning: Boolean;
|
||||
FPort: Word;
|
||||
FBindIP: string;
|
||||
FOnCommand: TTCICommandEvent;
|
||||
FOnConnect: TTCIClientEvent;
|
||||
FOnDisconnect: TTCIClientEvent;
|
||||
FOnTick: TThreadMethod;
|
||||
function InitListen: Boolean;
|
||||
procedure RemoveClient(Client: TTCIClient);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
{ Настройка слушателя. Применяется при следующем Start. }
|
||||
procedure Configure(APort: Word; const ABindIP: string);
|
||||
|
||||
function Start: Boolean;
|
||||
procedure Stop;
|
||||
function Running: Boolean;
|
||||
|
||||
{ Всем клиентам, прошедшим инициализацию. Skip — кого пропустить
|
||||
(обычно автора изменения не пропускаем: сервер отвечает и ему тоже,
|
||||
это и есть подтверждение установки). }
|
||||
procedure Broadcast(const S: string; Skip: TTCIClient = nil);
|
||||
|
||||
{ Обход клиентов под локом — для рассылки с индивидуальным периодом. }
|
||||
procedure EnumClients(Proc: TTCIClientEvent);
|
||||
|
||||
function ClientCount: Integer;
|
||||
|
||||
{ Внутреннее (зовётся потоками сервера). }
|
||||
procedure AcceptLoop;
|
||||
procedure TickLoop;
|
||||
procedure HandleClient(Client: TTCIClient);
|
||||
procedure ThreadDone; // клиентский поток отработал
|
||||
|
||||
property Port: Word read FPort;
|
||||
property BindIP: string read FBindIP;
|
||||
property OnCommand: TTCICommandEvent read FOnCommand write FOnCommand;
|
||||
property OnConnect: TTCIClientEvent read FOnConnect write FOnConnect;
|
||||
property OnDisconnect: TTCIClientEvent read FOnDisconnect write FOnDisconnect;
|
||||
property OnTick: TThreadMethod read FOnTick write FOnTick;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TTCIAcceptThread = class(TThread)
|
||||
private FServer: TTCIServer;
|
||||
protected procedure Execute; override;
|
||||
public constructor Create(AServer: TTCIServer);
|
||||
end;
|
||||
|
||||
TTCITickThread = class(TThread)
|
||||
private FServer: TTCIServer;
|
||||
protected procedure Execute; override;
|
||||
public constructor Create(AServer: TTCIServer);
|
||||
end;
|
||||
|
||||
TTCIClientThread = class(TThread)
|
||||
private FServer: TTCIServer; FClient: TTCIClient;
|
||||
protected procedure Execute; override;
|
||||
public constructor Create(AServer: TTCIServer; AClient: TTCIClient);
|
||||
end;
|
||||
|
||||
constructor TTCIAcceptThread.Create(AServer: TTCIServer);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FServer := AServer;
|
||||
FreeOnTerminate := False;
|
||||
end;
|
||||
|
||||
procedure TTCIAcceptThread.Execute;
|
||||
begin
|
||||
FServer.AcceptLoop;
|
||||
end;
|
||||
|
||||
constructor TTCITickThread.Create(AServer: TTCIServer);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FServer := AServer;
|
||||
FreeOnTerminate := False;
|
||||
end;
|
||||
|
||||
procedure TTCITickThread.Execute;
|
||||
begin
|
||||
FServer.TickLoop;
|
||||
end;
|
||||
|
||||
constructor TTCIClientThread.Create(AServer: TTCIServer; AClient: TTCIClient);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FServer := AServer;
|
||||
FClient := AClient;
|
||||
FreeOnTerminate := True;
|
||||
end;
|
||||
|
||||
procedure TTCIClientThread.Execute;
|
||||
begin
|
||||
try
|
||||
FServer.HandleClient(FClient);
|
||||
finally
|
||||
FServer.ThreadDone; // Stop ждёт обнуления счётчика перед зачисткой
|
||||
end;
|
||||
end;
|
||||
|
||||
{ IPv4 из строки в сетевом порядке. Свой, потому что WebServer держит такой же
|
||||
в implementation и наружу не отдаёт. }
|
||||
function TCIParseIPv4(const S: string): LongWord;
|
||||
var
|
||||
Oct: array[0..3] of LongWord;
|
||||
N, i, Start: Integer;
|
||||
Part: string;
|
||||
begin
|
||||
Result := 0; // INADDR_ANY
|
||||
if (S = '') or (S = '0.0.0.0') then Exit;
|
||||
N := 0;
|
||||
Start := 1;
|
||||
for i := 1 to Length(S) + 1 do
|
||||
if (i > Length(S)) or (S[i] = '.') then
|
||||
begin
|
||||
if N > 3 then Exit;
|
||||
Part := Copy(S, Start, i - Start);
|
||||
Oct[N] := LongWord(StrToIntDef(Part, 0)) and $FF;
|
||||
Inc(N);
|
||||
Start := i + 1;
|
||||
end;
|
||||
if N <> 4 then Exit;
|
||||
// Сетевой порядок байт: первый октет — младший байт in_addr.
|
||||
Result := Oct[0] or (Oct[1] shl 8) or (Oct[2] shl 16) or (Oct[3] shl 24);
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
TTCIClient
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIClient.Create(AWs: TWsClient);
|
||||
begin
|
||||
inherited Create;
|
||||
FWs := AWs;
|
||||
FReady := False;
|
||||
FRxSensors := False;
|
||||
FRxSensorsMs := 200;
|
||||
FTxSensors := False;
|
||||
FTxSensorsMs := 200;
|
||||
end;
|
||||
|
||||
function TTCIClient.Send(const S: string): Boolean;
|
||||
begin
|
||||
Result := (FWs <> nil) and (FWs.State = wsOpen) and FWs.SendText(S);
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
TTCIServer — жизненный цикл
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
constructor TTCIServer.Create;
|
||||
{$IFDEF WINDOWS}
|
||||
var WSAData: TWSAData;
|
||||
{$ENDIF}
|
||||
begin
|
||||
inherited Create;
|
||||
{$IFDEF WINDOWS}
|
||||
WSAStartup($0202, WSAData); // refcounted: свой вызов на каждый сервер
|
||||
{$ENDIF}
|
||||
FListenSock := SOCK_INVALID;
|
||||
FClientCount := 0;
|
||||
FClientLock := TCriticalSection.Create;
|
||||
FPort := TCI_DEFAULT_PORT;
|
||||
FBindIP := '127.0.0.1';
|
||||
end;
|
||||
|
||||
destructor TTCIServer.Destroy;
|
||||
begin
|
||||
Stop;
|
||||
FClientLock.Free;
|
||||
{$IFDEF WINDOWS}
|
||||
WSACleanup;
|
||||
{$ENDIF}
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTCIServer.Configure(APort: Word; const ABindIP: string);
|
||||
begin
|
||||
FPort := APort;
|
||||
FBindIP := ABindIP;
|
||||
end;
|
||||
|
||||
function TTCIServer.Running: Boolean;
|
||||
begin
|
||||
Result := FRunning;
|
||||
end;
|
||||
|
||||
function TTCIServer.InitListen: Boolean;
|
||||
var
|
||||
Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
|
||||
One: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
{$IFDEF WINDOWS}
|
||||
FListenSock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||||
{$ELSE}
|
||||
FListenSock := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||||
{$ENDIF}
|
||||
if FListenSock = SOCK_INVALID then Exit;
|
||||
|
||||
One := 1;
|
||||
{$IFDEF WINDOWS}
|
||||
setsockopt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One));
|
||||
FillChar(Addr, SizeOf(Addr), 0);
|
||||
Addr.sin_family := AF_INET;
|
||||
Addr.sin_port := htons(FPort);
|
||||
Addr.sin_addr.S_addr := TCIParseIPv4(FBindIP);
|
||||
if bind(FListenSock, @Addr, SizeOf(Addr)) = SOCKET_ERROR then Exit;
|
||||
if listen(FListenSock, 5) = SOCKET_ERROR then Exit;
|
||||
{$ELSE}
|
||||
fpSetSockOpt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One));
|
||||
FillChar(Addr, SizeOf(Addr), 0);
|
||||
Addr.sin_family := AF_INET;
|
||||
Addr.sin_port := htons(FPort);
|
||||
Addr.sin_addr.s_addr := TCIParseIPv4(FBindIP);
|
||||
if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then Exit;
|
||||
if fpListen(FListenSock, 5) <> 0 then Exit;
|
||||
{$ENDIF}
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TTCIServer.Start: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if FRunning then Exit;
|
||||
if not InitListen then
|
||||
begin
|
||||
if FListenSock <> SOCK_INVALID then
|
||||
begin
|
||||
SockClose(FListenSock);
|
||||
FListenSock := SOCK_INVALID;
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
FRunning := True;
|
||||
FAcceptThread := TTCIAcceptThread.Create(Self);
|
||||
TTCIAcceptThread(FAcceptThread).Start;
|
||||
FTickThread := TTCITickThread.Create(Self);
|
||||
TTCITickThread(FTickThread).Start;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TTCIServer.Stop;
|
||||
var i, Waited: Integer;
|
||||
begin
|
||||
if not FRunning then Exit;
|
||||
FRunning := False;
|
||||
|
||||
// Шаг 1: гасим listen-сокет. SockShutdown обязателен до close — иначе
|
||||
// fpAccept в accept-потоке не разблокируется (см. WebServer.Stop).
|
||||
if FListenSock <> SOCK_INVALID then
|
||||
begin
|
||||
SockShutdown(FListenSock);
|
||||
SockClose(FListenSock);
|
||||
FListenSock := SOCK_INVALID;
|
||||
end;
|
||||
|
||||
// Шаг 2: будим клиентские потоки, висящие в recv.
|
||||
FClientLock.Enter;
|
||||
try
|
||||
for i := 0 to FClientCount - 1 do
|
||||
if FClients[i] <> nil then
|
||||
begin
|
||||
FClients[i].Ws.State := wsClosed;
|
||||
SockShutdown(FClients[i].Ws.Socket);
|
||||
end;
|
||||
finally
|
||||
FClientLock.Leave;
|
||||
end;
|
||||
|
||||
// Шаг 3: свои потоки (клиентские — FreeOnTerminate, ждём их отдельно).
|
||||
if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end;
|
||||
if FTickThread <> nil then begin FTickThread.WaitFor; FreeAndNil(FTickThread); end;
|
||||
|
||||
// Шаг 4: даём клиентским потокам выйти самим. Освобождает клиента ТОТ,
|
||||
// кто вынул его из массива (RemoveClient в клиентском потоке), — иначе
|
||||
// Stop освободил бы объект из-под работающего потока.
|
||||
Waited := 0;
|
||||
while (FThreadCount > 0) and (Waited < 2000) do
|
||||
begin
|
||||
Sleep(10);
|
||||
Inc(Waited, 10);
|
||||
end;
|
||||
|
||||
// Вырожденный случай: поток завис (не должно случаться — сокеты закрыты).
|
||||
// Чистим остатки, чтобы не течь; объекты уже никем не используются.
|
||||
FClientLock.Enter;
|
||||
try
|
||||
for i := 0 to FClientCount - 1 do
|
||||
if FClients[i] <> nil then
|
||||
begin
|
||||
FClients[i].Ws.Free;
|
||||
FreeAndNil(FClients[i]);
|
||||
end;
|
||||
FClientCount := 0;
|
||||
finally
|
||||
FClientLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Приём соединений
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
procedure TTCIServer.AcceptLoop;
|
||||
var
|
||||
CSock: TSocket;
|
||||
Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
|
||||
ALen: {$IFDEF WINDOWS}Integer{$ELSE}TSockLen{$ENDIF};
|
||||
Client: TTCIClient;
|
||||
T: TTCIClientThread;
|
||||
begin
|
||||
while FRunning do
|
||||
begin
|
||||
ALen := SizeOf(Addr);
|
||||
{$IFDEF WINDOWS}
|
||||
CSock := accept(FListenSock, @Addr, @ALen);
|
||||
{$ELSE}
|
||||
CSock := fpAccept(FListenSock, @Addr, @ALen);
|
||||
{$ENDIF}
|
||||
if CSock = SOCK_INVALID then
|
||||
begin
|
||||
if FRunning then Sleep(10);
|
||||
Continue;
|
||||
end;
|
||||
if FClientCount >= TCI_MAX_CLIENTS then
|
||||
begin
|
||||
SockClose(CSock);
|
||||
Continue;
|
||||
end;
|
||||
SockSetSndTimeout(CSock, TCI_SEND_TIMEOUT);
|
||||
Client := TTCIClient.Create(TWsClient.Create(CSock));
|
||||
FClientLock.Enter;
|
||||
try
|
||||
FClients[FClientCount] := Client;
|
||||
Inc(FClientCount);
|
||||
finally
|
||||
FClientLock.Leave;
|
||||
end;
|
||||
InterLockedIncrement(FThreadCount);
|
||||
T := TTCIClientThread.Create(Self, Client);
|
||||
T.Start;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTCIServer.RemoveClient(Client: TTCIClient);
|
||||
var i, j: Integer;
|
||||
begin
|
||||
if Client = nil then Exit;
|
||||
if Assigned(FOnDisconnect) then FOnDisconnect(Client);
|
||||
FClientLock.Enter;
|
||||
try
|
||||
for i := 0 to FClientCount - 1 do
|
||||
if FClients[i] = Client then
|
||||
begin
|
||||
for j := i to FClientCount - 2 do FClients[j] := FClients[j + 1];
|
||||
FClients[FClientCount - 1] := nil;
|
||||
Dec(FClientCount);
|
||||
Break;
|
||||
end;
|
||||
finally
|
||||
FClientLock.Leave;
|
||||
end;
|
||||
Client.Ws.Free; // закрывает сокет
|
||||
Client.Free;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Клиентский поток: handshake + разбор WS-фреймов
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
procedure TTCIServer.HandleClient(Client: TTCIClient);
|
||||
var
|
||||
Ws: TWsClient;
|
||||
R, HeaderEnd: Integer;
|
||||
Header, HeaderLC, Key, AcceptKey, Response, Text: string;
|
||||
Raw: array[0..4095] of Byte;
|
||||
RawLen: Integer;
|
||||
B0, B1: Byte;
|
||||
Masked: Boolean;
|
||||
PayLen, Need, i, j, Consumed, KPos, KEnd: Integer;
|
||||
Mask: array[0..3] of Byte;
|
||||
Payload: array of Byte;
|
||||
Opcode: Byte;
|
||||
Cmds: TStringList;
|
||||
begin
|
||||
Ws := Client.Ws;
|
||||
RawLen := 0;
|
||||
|
||||
// ── HTTP-запрос: ждём конца заголовков ───────────────────────────────────
|
||||
Header := '';
|
||||
HeaderEnd := 0;
|
||||
repeat
|
||||
R := SockRecv(Ws.Socket, @Raw[RawLen], SizeOf(Raw) - RawLen, 0);
|
||||
if R <= 0 then begin Ws.State := wsClosed; Break; end;
|
||||
Inc(RawLen, R);
|
||||
SetLength(Header, RawLen);
|
||||
Move(Raw[0], Header[1], RawLen);
|
||||
HeaderEnd := System.Pos(#13#10#13#10, Header);
|
||||
until (HeaderEnd > 0) or (RawLen >= SizeOf(Raw));
|
||||
|
||||
if (Ws.State = wsClosed) or (HeaderEnd = 0) then
|
||||
begin
|
||||
RemoveClient(Client); Exit;
|
||||
end;
|
||||
|
||||
Header := Copy(Header, 1, HeaderEnd + 3);
|
||||
HeaderLC := LowerCase(Header);
|
||||
|
||||
// Путь не проверяем: клиенты ходят на '/', но протокол его не оговаривает.
|
||||
if System.Pos('upgrade: websocket', HeaderLC) = 0 then
|
||||
begin
|
||||
Response := 'HTTP/1.1 426 Upgrade Required'#13#10 +
|
||||
'Content-Length: 0'#13#10'Connection: close'#13#10#13#10;
|
||||
Ws.SendRaw(Response[1], Length(Response));
|
||||
RemoveClient(Client); Exit;
|
||||
end;
|
||||
|
||||
Key := '';
|
||||
KPos := System.Pos('sec-websocket-key: ', HeaderLC);
|
||||
if KPos > 0 then
|
||||
begin
|
||||
Key := Copy(Header, KPos + 19, 100);
|
||||
KEnd := System.Pos(#13, Key);
|
||||
if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1);
|
||||
Key := Trim(Key);
|
||||
end;
|
||||
AcceptKey := Base64EncodeBytes(SHA1(Key + TCI_WS_GUID), 20);
|
||||
Response := 'HTTP/1.1 101 Switching Protocols'#13#10 +
|
||||
'Upgrade: websocket'#13#10 +
|
||||
'Connection: Upgrade'#13#10 +
|
||||
'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10;
|
||||
if not Ws.SendRaw(Response[1], Length(Response)) then
|
||||
begin
|
||||
RemoveClient(Client); Exit;
|
||||
end;
|
||||
Ws.State := wsOpen;
|
||||
|
||||
// Пачка инициализации + текущее состояние (§3.1) — дело адаптера.
|
||||
if Assigned(FOnConnect) then FOnConnect(Client);
|
||||
|
||||
// ── Цикл WS-сообщений ────────────────────────────────────────────────────
|
||||
Cmds := TStringList.Create;
|
||||
try
|
||||
Ws.BufLen := 0;
|
||||
while FRunning and (Ws.State = wsOpen) do
|
||||
begin
|
||||
R := Ws.Recv;
|
||||
if R <= 0 then Break;
|
||||
|
||||
while Ws.BufLen >= 2 do
|
||||
begin
|
||||
B0 := Ws.BufData[0];
|
||||
B1 := Ws.BufData[1];
|
||||
Opcode := B0 and $0F;
|
||||
Masked := (B1 and $80) <> 0;
|
||||
PayLen := B1 and $7F;
|
||||
|
||||
Need := 2;
|
||||
if PayLen = 126 then Inc(Need, 2)
|
||||
else if PayLen = 127 then Inc(Need, 8);
|
||||
if Masked then Inc(Need, 4);
|
||||
if Ws.BufLen < Need then Break;
|
||||
|
||||
i := 2;
|
||||
if PayLen = 126 then
|
||||
begin
|
||||
PayLen := (Ws.BufData[2] shl 8) or Ws.BufData[3];
|
||||
Inc(i, 2);
|
||||
end
|
||||
else if PayLen = 127 then
|
||||
begin
|
||||
PayLen := (Ws.BufData[6] shl 24) or (Ws.BufData[7] shl 16) or
|
||||
(Ws.BufData[8] shl 8) or Ws.BufData[9];
|
||||
Inc(i, 8);
|
||||
end;
|
||||
|
||||
// Фрейм крупнее приёмного буфера TWsClient никогда не соберётся —
|
||||
// BufLen упрётся в потолок и цикл встанет намертво. Рвём соединение:
|
||||
// команд такой длины у TCI нет, а бинарные потоки от клиента (TX-аудио)
|
||||
// мы пока не принимаем.
|
||||
if Need + PayLen > 4096 then
|
||||
begin
|
||||
Ws.State := wsClosed;
|
||||
Break;
|
||||
end;
|
||||
|
||||
if Ws.BufLen < Need + PayLen then Break;
|
||||
|
||||
if Masked then
|
||||
begin
|
||||
Mask[0] := Ws.BufData[i]; Mask[1] := Ws.BufData[i+1];
|
||||
Mask[2] := Ws.BufData[i+2]; Mask[3] := Ws.BufData[i+3];
|
||||
Inc(i, 4);
|
||||
end;
|
||||
|
||||
SetLength(Payload, PayLen);
|
||||
if PayLen > 0 then
|
||||
begin
|
||||
Move(Ws.BufData[i], Payload[0], PayLen);
|
||||
if Masked then
|
||||
for j := 0 to PayLen - 1 do
|
||||
Payload[j] := Payload[j] xor Mask[j and 3];
|
||||
end;
|
||||
|
||||
Consumed := i + PayLen;
|
||||
if Ws.BufLen > Consumed then
|
||||
Move(Ws.BufData[Consumed], Ws.BufData[0], Ws.BufLen - Consumed);
|
||||
Ws.BufLen := Ws.BufLen - Consumed;
|
||||
|
||||
case Opcode of
|
||||
$01: // текст — одна или несколько команд в одном фрейме
|
||||
begin
|
||||
SetLength(Text, PayLen);
|
||||
if PayLen > 0 then Move(Payload[0], Text[1], PayLen);
|
||||
if Assigned(FOnCommand) then
|
||||
begin
|
||||
TCISplit(Text, Cmds);
|
||||
for j := 0 to Cmds.Count - 1 do
|
||||
FOnCommand(Client, Cmds[j]);
|
||||
end;
|
||||
end;
|
||||
$02: ; // binary: TX-аудио от клиента — этап 2, пока игнорируем
|
||||
$08: // close
|
||||
begin
|
||||
Ws.State := wsClosed;
|
||||
Break;
|
||||
end;
|
||||
$09: // ping → pong
|
||||
if PayLen > 0 then Ws.SendWsFrame($0A, Payload[0], PayLen)
|
||||
else Ws.SendWsFrame($0A, PayLen, 0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Cmds.Free;
|
||||
end;
|
||||
|
||||
RemoveClient(Client);
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Рассылка и обход
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
procedure TTCIServer.Broadcast(const S: string; Skip: TTCIClient);
|
||||
var i: Integer;
|
||||
begin
|
||||
if S = '' then Exit;
|
||||
FClientLock.Enter;
|
||||
try
|
||||
for i := 0 to FClientCount - 1 do
|
||||
if (FClients[i] <> nil) and (FClients[i] <> Skip) and FClients[i].Ready then
|
||||
FClients[i].Send(S);
|
||||
finally
|
||||
FClientLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTCIServer.EnumClients(Proc: TTCIClientEvent);
|
||||
var i: Integer;
|
||||
begin
|
||||
if not Assigned(Proc) then Exit;
|
||||
FClientLock.Enter;
|
||||
try
|
||||
for i := 0 to FClientCount - 1 do
|
||||
if FClients[i] <> nil then Proc(FClients[i]);
|
||||
finally
|
||||
FClientLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTCIServer.ThreadDone;
|
||||
begin
|
||||
InterLockedDecrement(FThreadCount);
|
||||
end;
|
||||
|
||||
function TTCIServer.ClientCount: Integer;
|
||||
begin
|
||||
Result := FClientCount;
|
||||
end;
|
||||
|
||||
procedure TTCIServer.TickLoop;
|
||||
begin
|
||||
while FRunning do
|
||||
begin
|
||||
Sleep(TCI_TICK_MS);
|
||||
if not FRunning then Break;
|
||||
if (FClientCount > 0) and Assigned(FOnTick) then FOnTick;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Binary file not shown.
+221
@@ -0,0 +1,221 @@
|
||||
# TCI в EWSDR — статус реализации
|
||||
|
||||
Ветка разработки: `feature/tci-protocol`.
|
||||
Дата последнего обновления: 2026-08-17.
|
||||
|
||||
Эталон протокола — «Протокол TCI, версия 2.0» Expert Electronics
|
||||
(`doc/TCI Protocol_RU.pdf`, 12 января 2024). EWSDR выступает **сервером**
|
||||
(как ExpertSDR3): порт слушаем мы, клиенты — логгеры, скиммеры, программы
|
||||
цифровых видов, внешние усилители и коммутаторы.
|
||||
|
||||
---
|
||||
|
||||
## 1. Архитектура
|
||||
|
||||
```
|
||||
TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ──► TRadioController
|
||||
логгер/скиммер/цифра транспорт команды + ядро
|
||||
уведомления
|
||||
```
|
||||
|
||||
| Файл | Назначение |
|
||||
|---|---|
|
||||
| `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. |
|
||||
| `TCIServer.pas` (~660 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). |
|
||||
| `TCIAdapter.pas` (~1100 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители. |
|
||||
|
||||
Принципы те же, что у CAT (см. `doc/CAT_STATUS.md`):
|
||||
|
||||
- **TCI — равноправный клиент контроллера.** Никаких обращений к `MainForm`;
|
||||
единственное исключение — стор спотов `TDXSpotStore`, который передаётся
|
||||
адаптеру ссылкой (команды `SPOT`/`SPOT_DELETE`/`SPOT_CLEAR` кладут споты в
|
||||
ту же базу, что и DX-кластер).
|
||||
- **Потоки.** Геттеры читают поля контроллера напрямую из потока клиента;
|
||||
сеттеры пишут параметр в scratch-поля под `FLock` и зовут
|
||||
`FController.Invoke(SyncXxx)` — исполнение в потоке контроллера
|
||||
(GUI = `TThread.Synchronize`).
|
||||
- **Синхронизация клиентов.** Изменение любого поля контроллера приходит в
|
||||
`OnState` (multicast-подписка `AddStateListener`) и рассылается всем
|
||||
подключённым — как того требует §3.5 спецификации. Отвечающий на команду
|
||||
клиент дополнительно получает прямой ответ.
|
||||
|
||||
### 1.1 Настройки
|
||||
|
||||
Секция `tci` в корне `settings.json`:
|
||||
|
||||
```json
|
||||
"tci": { "enabled": false, "port": 40001, "bind_addr": "127.0.0.1" }
|
||||
```
|
||||
|
||||
UI — вкладка **Advanced → TCI Server** (галка, порт, интерфейс). В протоколе
|
||||
**нет авторизации**: открытый наружу порт означает полный доступ к трансиверу,
|
||||
поэтому умолчание слушает только петлю.
|
||||
|
||||
### 1.2 Маппинг модели
|
||||
|
||||
| TCI | EWSDR |
|
||||
|---|---|
|
||||
| приёмник (`TRX_COUNT`) | панадаптер: 0 = главный тракт, 1.. = доп. DDC-паны. Число = `BackendCaps.MaxPans` |
|
||||
| канал A/B (`CHANNEL_COUNT` = 2) | у приёмника 0 — VFO A / VFO B; у панов 1.. — первый и второй слайс пана |
|
||||
| `DDS` | центр панадаптера (`SetCenter` / `SetPanDDCFreq`) |
|
||||
| `IF` | смещение канала от центра панорамы |
|
||||
| `VFO` | абсолютная частота канала |
|
||||
| передатчик (`arg1` у TRX/TUNE/DRIVE) | всегда один — главный тракт |
|
||||
|
||||
---
|
||||
|
||||
## 2. Что реализовано
|
||||
|
||||
### 2.1 Инициализация (§4.1)
|
||||
|
||||
`PROTOCOL`, `DEVICE`, `RECEIVE_ONLY`, `TRX_COUNT`, `CHANNEL_COUNT`,
|
||||
`VFO_LIMITS`, `IF_LIMITS`, `MODULATIONS_LIST`, `READY`.
|
||||
|
||||
`READY` шлётся **после** полного дампа состояния: клиент, дождавшийся его,
|
||||
уже знает всё. Границы частот берутся из `BackendCaps`; пока устройство не
|
||||
подключено — 10 кГц…30 МГц. `IF_LIMITS` = ±sample rate/2, пересылается при
|
||||
смене частоты дискретизации.
|
||||
|
||||
Список видов связи: `am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw`.
|
||||
`dmr`/`fmraw` — наше расширение (протокол расширяемый, §1.4). `CWL`/`CWU`
|
||||
схлопываются в `cw`; при установке `cw` боковая сохраняется, если уже
|
||||
телеграф, иначе выбирается по частоте (ниже 10 МГц — CWL).
|
||||
|
||||
### 2.2 Двунаправленное управление (§4.2)
|
||||
|
||||
Полностью проведено в контроллер:
|
||||
|
||||
| Команда | Куда легло |
|
||||
|---|---|
|
||||
| `START` / `STOP` | `SetRun` |
|
||||
| `DDS` | `SetCenter` / `SetPanDDCFreq` |
|
||||
| `IF`, `VFO` | `SetVfoA/B`, `SetSliceTarget` |
|
||||
| `MODULATION` | `SetMode` / `SetSliceMode` |
|
||||
| `TRX` | `SetMOX` |
|
||||
| `TUNE` | `SetTune` |
|
||||
| `DRIVE` | `SetDrive` |
|
||||
| `TUNE_DRIVE` | `FTXSettings.TUNLevel` через `SetTXSettings` |
|
||||
| `SPLIT_ENABLE` | `SetSplit` |
|
||||
| `RX_FILTER_BAND` | `SetFilterEdges` / `SetSliceFilter` |
|
||||
| `VOLUME`, `MUTE` | `SetVolume`, `SetMute` (дБ ↔ 0..100) |
|
||||
| `RX_MUTE`, `RX_VOLUME` | громкость/мьют слайса |
|
||||
| `MON_VOLUME`, `MON_ENABLE` | `SetTXMonVolume`, `SetRxMuteOnTx` |
|
||||
| `AGC_MODE` | `off`→Off, `fast`→Fast, `normal`→Medium |
|
||||
| `AGC_GAIN` | `SetAGCTop` (AGC-T) |
|
||||
| `RX_NR_ENABLE`, `RX_NB_ENABLE`, `RX_ANF_ENABLE` | `SetNR/SetNB/SetANF`, для панов — `SetSliceDSP` |
|
||||
| `LOCK` | `SetVfoLock` |
|
||||
| `SQL_ENABLE`, `SQL_LEVEL` | FM-шумоподавитель; дБ (-140..0) ↔ порог 0..100 |
|
||||
| `CW_MACROS_SPEED`, `CW_KEYER_SPEED` | `TCWSettings.Speed` |
|
||||
| `CW_MACROS_DELAY` | `TCWSettings.RFDelayMS` |
|
||||
|
||||
### 2.3 Однонаправленное управление (§4.3)
|
||||
|
||||
`TX_ENABLE` (по `BackendCaps.HasTX` + `TXProhibited`), `CW_MACROS_SPEED_UP/DOWN`,
|
||||
`SPOT`, `SPOT_DELETE`, `SPOT_CLEAR` (в `TDXSpotStore`, спот виден на всех
|
||||
панадаптерах), `RX_SENSORS_ENABLE`, `TX_SENSORS_ENABLE` (период — на клиента),
|
||||
`IQ_SAMPLERATE`, `AUDIO_SAMPLERATE`, `AUDIO_STREAM_*`, `TX_STREAM_AUDIO_BUFFERING`
|
||||
(значения принимаются и подтверждаются; сами потоки — этап 2).
|
||||
|
||||
### 2.4 Уведомления (§4.4, §4.5)
|
||||
|
||||
`RX_CHANNEL_SENSORS` + устаревшая `RX_SENSORS` (S-метр в дБм, период 30…1000 мс
|
||||
на клиента), `TX_SENSORS`, `TX_FREQUENCY`, `VFO_LOCK`, `APP_FOCUS`
|
||||
(активация/деактивация главного окна), `RX_CLICKED_ON_SPOT` + устаревшая
|
||||
`CLICKED_ON_SPOT` (клик по подписи спота на любом панадаптере),
|
||||
`CALLSIGN_SEND` (после `CW_MSG`).
|
||||
|
||||
### 2.5 Телеграф (§3.2)
|
||||
|
||||
`CW_MACROS`, `CW_MSG`, `CW_MACROS_STOP`, `CW_TERMINAL`.
|
||||
|
||||
Текст приводится к тому, что понимает передатчик текста ewsdr (`CWXSend`):
|
||||
экранирование `^ ~ *` снимается, `CALL$N` разворачивается в N повторов
|
||||
позывного, префикс/суффикс `_` считаются пустыми. **Не поддержано:** шаг
|
||||
скорости внутри текста (`<` / `>`) и слитная передача аббревиатур (`|SK|`) —
|
||||
эти символы просто снимаются, потому что `TCWSender` работает на одной
|
||||
скорости и не знает прос-знаков. Доотправка позывного (`cw_msg:arg1;`)
|
||||
игнорируется: уже отданный в очередь текст не редактируется.
|
||||
|
||||
---
|
||||
|
||||
## 3. Осознанные заглушки («эхо»)
|
||||
|
||||
Значения принимаются, хранятся в адаптере и рассылаются клиентам — так
|
||||
синхронизация между несколькими клиентами остаётся честной, но на радио они
|
||||
не влияют, потому что соответствующего тракта в EWSDR нет:
|
||||
|
||||
| Команда | Причина |
|
||||
|---|---|
|
||||
| `RIT_ENABLE`, `RIT_OFFSET`, `XIT_ENABLE`, `XIT_OFFSET` | расстройки RX/TX в контроллере нет вообще |
|
||||
| `RX_BIN_ENABLE` | псевдостерео не реализовано |
|
||||
| `RX_ANC_ENABLE`, `RX_APF_ENABLE`, `RX_DSE_ENABLE`, `RX_NF_ENABLE` | таких блоков в тракте нет |
|
||||
| `RX_NB_PARAM` | параметры NB в WDSP наружу не выведены |
|
||||
| `RX_BALANCE` | баланса каналов у слайса нет |
|
||||
| `DIGL_OFFSET`, `DIGU_OFFSET` | смещения цифровых мод не реализованы |
|
||||
| `RX_CHANNEL_ENABLE` | канал B главного приёмника — это VFO B, он есть всегда; создание второго слайса на пане по TCI — этап 2 |
|
||||
| `SET_IN_FOCUS` | окно программы не поднимаем |
|
||||
|
||||
Отдельно: у `TX_SENSORS` второй аргумент — уровень микрофона; измерителя
|
||||
микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не
|
||||
рисовал случайные значения. Третий аргумент (RMS) и четвёртый (пик) отдаём
|
||||
одинаковыми — в телеметрии платы одно значение forward power.
|
||||
|
||||
У `TRX` третий аргумент (источник сигнала `tci`/`mic1`/…) игнорируется:
|
||||
аудио по TCI ещё нет, модуляция берётся из выбранного в программе входа.
|
||||
|
||||
---
|
||||
|
||||
## 4. Этап 2 — бинарные потоки (§3.4)
|
||||
|
||||
Не реализовано ничего из потоков; команды управления ими принимаются, но
|
||||
данные не идут. Что нужно сделать:
|
||||
|
||||
1. **Заголовок блока** уже описан — `TTCIStreamHeader` в `TCIProtocol.pas`
|
||||
(16 × uint32 + сэмплы).
|
||||
2. **`RX_AUDIO_STREAM`** — нужен multicast-тап RX-аудио в контроллере.
|
||||
Сейчас есть только `OnAudioConsume` — одиночный перехват, которым владеет
|
||||
веб-адаптер (он же глушит локальный звук). Для TCI нужен именно тап
|
||||
«послушать, не забирая», по образцу `AddStateListener`.
|
||||
3. **`TX_AUDIO_STREAM` + `TX_CHRONO`** — приём бинарных фреймов от клиента
|
||||
(сейчас `TCIServer` их отбрасывает; приёмный буфер `TWsClient` — 4 КБ, под
|
||||
16 КБ блоков его придётся растить) и подача в TX-тракт наравне с
|
||||
веб-микрофоном (`PushMicSamples`).
|
||||
4. **`IQ_STREAM`** — тап сырого IQ в `TWDSPEngine.PushIQItemToDSP` (как у
|
||||
декодера маяка), с децимацией до `IQ_SAMPLERATE` (48/96/192/384 кГц).
|
||||
5. **`LINEOUT_STREAM` + `LINE_OUT_RECORDER_*`** — запись в WAV/MP3.
|
||||
|
||||
Также в очереди: `RX_CHANNEL_ENABLE` как реальное создание/удаление второго
|
||||
слайса пана и `SET_IN_FOCUS`.
|
||||
|
||||
---
|
||||
|
||||
## 5. Проверено
|
||||
|
||||
Стендом (WS-клиент на сыром сокете, без внешних библиотек):
|
||||
|
||||
- **Транспорт:** handshake, маска входящих фреймов, несколько команд в одном
|
||||
фрейме, регистронезависимость, экранированный текст, ping/pong, игнорирование
|
||||
бинарных фреймов, рассылка всем клиентам, чистая остановка сервера с живым
|
||||
клиентом (потоки дренируются, зависаний нет).
|
||||
- **Сквозной прогон** с настоящим `TRadioController` (движки созданы, железо не
|
||||
подключено): пачка инициализации из 57 строк со всеми обязательными
|
||||
командами и `READY` в конце; `VFO`, `MODULATION` (`cw` на 7 МГц дал CWL),
|
||||
`RX_FILTER_BAND`, `DRIVE`, `VOLUME`, `MUTE`, `AGC_GAIN`, `LOCK`,
|
||||
`CW_MACROS_SPEED`, `SPOT`, `RIT_*` — состояние контроллера после прогона
|
||||
совпало с посланным; чтение (`vfo:0,1;`) отвечает; `RX_SENSORS_ENABLE:true,100`
|
||||
даёт поток `rx_channel_sensors` с заданным периодом.
|
||||
- **Устойчивость:** исключение в обработке команды не рвёт соединение — клиенту
|
||||
уходит `tci_error:<команда>,<сообщение>;`, остальные команды продолжают
|
||||
работать (проверено на контроллере без движков, где `SetMode`/`SetCWSettings`
|
||||
падают с AV на неинициализированном `FNetwork`).
|
||||
|
||||
Сборка: `lazbuild -B --ws=qt6 ewsdr.lpr` и `./build-ewsdrd.sh` (демон собирается,
|
||||
TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в
|
||||
`ewsdrd.lpr`, как web).
|
||||
|
||||
**На реальном железе и с реальным клиентом (Log4OM/N1MM/WSJT-X/CW Skimmer) не
|
||||
проверялось.**
|
||||
|
||||
Ответ на команду-установку клиент получает дважды: прямым ответом и рассылкой
|
||||
из `OnState`. Это осознанно — дубли идемпотентны, а рассылка нужна для тех
|
||||
случаев, когда значение поменял не клиент, а оператор.
|
||||
Reference in New Issue
Block a user