Phase 3 (batch 33+34): web device discovery/connect parity

Move discovery into the controller and add a full web device overlay
(discovery + connect + saved-device CRUD), reaching parity with the
desktop device dialog.

- RadioController: OnDeviceFound/Discover/DiscoverFinishedNone +
  rfDeviceList; TDiscoverThread moved in from MainForm.
- WebServer: device protocol (discover/connect/disconnect/dev_add/
  dev_remove/dev_autostart) + "devices" in BuildStateJson.
- MainForm: web handlers (marshalled), PushDeviceListToWeb, extracted
  DoStopAndDisconnect, detached WebOnRun from BtnStartStopClick;
  web connect resolves board type from discovered then saved by IP.
- DeviceForm: RefreshFound renders the found list from the store.
- WebPageHtml: DEV overlay; START opens it, STOP disconnects.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Uladzimir Karpenka
2026-06-08 15:30:03 +03:00
co-authored by Claude Opus 4.8
parent 9dec47a6ca
commit c4981fcb19
5 changed files with 488 additions and 135 deletions
+18 -12
View File
@@ -76,9 +76,8 @@ type
procedure SetTheme(const T: TAppTheme);
// Добавить найденное устройство (вызывается из MainForm при discovery)
procedure AddDiscovered(const IP, DisplayName: string; BoardType: Integer;
const MAC: array of Byte);
// Перерисовать список найденных из store (вызывается по rfDeviceList)
procedure RefreshFound;
procedure ClearDiscovered;
procedure NoDevicesFound; // UI-сообщение «нет устройств» в список найденных
@@ -383,22 +382,29 @@ begin
LstFound.Items.Clear;
end;
procedure TDeviceDialog.AddDiscovered(const IP, DisplayName: string; BoardType: Integer;
const MAC: array of Byte);
procedure TDeviceDialog.RefreshFound;
// Рендер списка найденных из store. Пустой store во время поиска → 'Searching...'.
var
I: Integer;
S: string;
D: TDiscoveredDevice;
begin
if FStore = nil then Exit;
if (LstFound.Items.Count = 1) and (LstFound.Items[0] = 'Searching...') then
LstFound.Items.Clear;
FStore.AddDiscovered(IP, DisplayName, BoardType, MAC);
S := DisplayName;
if BoardType > 0 then
S := S + ' ' + BoardTypeName(BoardType);
if FStore.DiscoveredCount = 0 then
begin
LstFound.Items.Add('Searching...');
Exit;
end;
for I := 0 to FStore.DiscoveredCount - 1 do
begin
D := FStore.Discovered(I);
S := D.DisplayName;
if D.BoardType > 0 then
S := S + ' ' + BoardTypeName(D.BoardType);
LstFound.Items.Add(S);
end;
end;
procedure TDeviceDialog.NoDevicesFound;
begin
+222 -114
View File
@@ -185,6 +185,8 @@ type
FWebSyncFreq: Double;
FWebSyncInt: Integer;
FWebSyncBool: Boolean;
FWebSyncStr1: string; // для web-команд с текстом (IP/имя)
FWebSyncStr2: string;
FWebSyncM: TThreadMethod;
FSettingsForm: TObject; // TSettingsForm (cast при использовании)
FPendingDev: THPSDRDevice; // устройство ожидающее открытия WDSP
@@ -325,7 +327,6 @@ type
function EnsureWDSPWisdom: Boolean;
// Network callbacks
procedure OnDeviceFound(const Dev: THPSDRDevice);
procedure OnWidebandCB(ADCIndex: Integer; const Samples: array of SmallInt;
Count: Integer);
procedure OnWDSPOpenDone(Success: Boolean);
@@ -333,6 +334,9 @@ type
// Старт с уже выбранным устройством (preload rate + WDSP open + connect).
// Переиспользуется десктоп-диалогом и web-оверлеем — без модального диалога.
procedure StartWithDevice(const Dev: THPSDRDevice);
// STOP-teardown: persistence + graceful Run=0 + Disconnect + offline-статус.
// Общий для десктоп-STOP и web-disconnect.
procedure DoStopAndDisconnect;
// DSP/Audio callbacks (вызываются из рабочих потоков)
procedure OnAudioReady(const Left, Right: array of Single; Count: Integer);
@@ -340,10 +344,8 @@ type
procedure OnWaterfallReady(const Pixels: array of Single; Count: Integer);
// Public UI update (called from sync objects)
procedure DoAddDevice(const Dev: THPSDRDevice; const Entry: string);
procedure UpdateTXMeters;
procedure DoUpdateDDCSeq(DDCIdx: Integer; Seq: LongWord);
procedure DoUpdateDDCSeqOrNoDevice(DDCIdx: Integer; Seq: LongWord);
// Event handlers
procedure BtnDiscoverClick(Sender: TObject);
@@ -462,6 +464,20 @@ type
procedure WebOnFMStep(Idx: Integer);
procedure WebOnMic(Samples: PSingle; Count: Integer);
procedure WebOnXvtrBand(Idx: Integer);
// Discovery / connect / saved-CRUD из web (маршалятся в UI)
procedure WebOnConnect(const IP: string);
procedure WebOnDiscover;
procedure WebOnDisconnect;
procedure WebOnDevAdd(const AName, IP: string);
procedure WebOnDevRemove(Idx: Integer);
procedure WebOnDevAutoStart(Idx: Integer);
procedure SyncWebConnect;
procedure SyncWebDiscover;
procedure SyncWebDisconnect;
procedure SyncWebDevAdd;
procedure SyncWebDevRemove;
procedure SyncWebDevAutoStart;
procedure PushDeviceListToWeb; // store → FWebServer.SetDeviceList
// Synchronize-обёртки (выполняются в UI-потоке)
procedure SyncWebFreq;
procedure SyncWebMode;
@@ -997,11 +1013,18 @@ begin
FWebServer.OnFMStep := WebOnFMStep;
FWebServer.OnWebMic := WebOnMic;
FWebServer.OnXvtrBand := WebOnXvtrBand;
FWebServer.OnConnect := WebOnConnect;
FWebServer.OnDiscoverDev := WebOnDiscover;
FWebServer.OnDisconnectDev := WebOnDisconnect;
FWebServer.OnDevAdd := WebOnDevAdd;
FWebServer.OnDevRemove := WebOnDevRemove;
FWebServer.OnDevAutoStart := WebOnDevAutoStart;
// Web-слой держит FController.FWebClientActive актуальным (выбор mic-source
// при TX, в т.ч. для HWPTT из контроллера) — больше не зеркалим лениво.
FWebServer.OnClientActiveChanged := WebOnClientActiveChanged;
if FWebEnabled then FWebServer.Start;
PushXvtrToWeb;
PushDeviceListToWeb; // saved-устройства сразу видны web-overlay
FillChar(FCATLastGlobal, SizeOf(FCATLastGlobal), 0);
FCATLastGlobal.CATTcpPort := 19090;
for i := 0 to 3 do
@@ -1107,7 +1130,7 @@ begin
// лишь навешиваем колбэки на методы MainForm. FSampleRate уже загружен из
// startup-preview выше, поэтому FDSPEngine рождается с нужной частотой.
FController.CreateEngines(FController.FSampleRate);
FController.FNetwork.OnDeviceFound := OnDeviceFound;
FController.FNetwork.OnDeviceFound := FController.OnDeviceFound;
FController.FNetwork.OnHPStatus := FController.OnHPStatus;
FController.FNetwork.OnDDCIQ := FController.OnDDCIQ;
FController.FNetwork.OnMicPacket := FController.OnMicPacket;
@@ -1466,6 +1489,28 @@ begin
InvalidateGridCache;
end;
end;
rfDeviceList:
begin
// Discovery обновил список устройств (или завершился без них).
if Assigned(FDeviceDialog) then
begin
if FController.FDiscoverNoneFound then
begin
FDeviceDialog.NoDevicesFound;
SetStatusText(2, 'No hardware found');
end
else
begin
FDeviceDialog.RefreshFound;
if FController.FDeviceStore.DiscoveredCount > 0 then
SetStatusText(2, Format('Found: %s',
[FController.FDeviceStore.Discovered(
FController.FDeviceStore.DiscoveredCount - 1).IPAddress]));
end;
end;
PushDeviceListToWeb; // web-overlay тоже получает обновлённый список
end;
end;
finally
FSyncingFromController := False;
@@ -3263,34 +3308,8 @@ end;
// Network callbacks → sync helpers
// ===========================================================================
procedure TMainForm.OnDeviceFound(const Dev: THPSDRDevice);
var
BoardName, Entry: string;
Sync: TDeviceFoundSync;
M: TThreadMethod;
begin
BoardName := BoardTypeName(Dev.BoardType);
Entry := Format('%s %s FW:%d DDC:%d',
[Dev.IPAddress, BoardName,
Dev.FirmwareVersion, Dev.NumDDCs]);
Sync := TDeviceFoundSync.Create(DoAddDevice, Dev, Entry);
try
M := Sync.Execute;
TThread.Synchronize(nil, M);
finally
Sync.Free;
end;
end;
procedure TMainForm.DoAddDevice(const Dev: THPSDRDevice; const Entry: string);
begin
// Найденное устройство → общий store (через диалог, который пишет store +
// рендерит список). MAC нужен для preload-rate lookup в BtnStartStopClick.
if Assigned(FDeviceDialog) then
FDeviceDialog.AddDiscovered(Dev.IPAddress, Entry, Dev.BoardType, Dev.MAC);
SetStatusText(2, Format('Found: %s', [Dev.IPAddress]));
end;
// OnDeviceFound / discovery теперь в TRadioController (сетевой поток → store +
// rfDeviceList). UI слушает rfDeviceList в OnControllerState.
procedure TMainForm.UpdateTXMeters;
// Вызывается из MeterTimerTick (10 Гц). FController.FLastFwdW/FLastSWR/
@@ -3402,58 +3421,7 @@ begin
FForm.OnWDSPOpenDone(FResult);
end;
type
TDiscoverThread = class(TThread)
private
FNet: THPSDRNetwork;
FForm: TMainForm;
protected
procedure Execute; override;
public
constructor Create(ANet: THPSDRNetwork; AForm: TMainForm);
end;
constructor TDiscoverThread.Create(ANet: THPSDRNetwork; AForm: TMainForm);
begin
FNet := ANet;
FForm := AForm;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TDiscoverThread.Execute;
var
Devs: THPSDRDeviceArray;
Sync: TDDCSeqSync;
M: TThreadMethod;
begin
Devs := FNet.Discover(2000);
if Length(Devs) = 0 then
begin
// DDCIdx = -1 is the sentinel for "no device found"
Sync := TDDCSeqSync.Create(FForm.DoUpdateDDCSeqOrNoDevice, -1, 0);
try
M := Sync.Execute;
TThread.Synchronize(nil, M);
finally
Sync.Free;
end;
end;
// Devices found are signalled via OnDeviceFound callback during Discover()
end;
{ Перегруженный DoUpdateDDCSeq принимает -1 как «нет устройств» }
procedure TMainForm.DoUpdateDDCSeqOrNoDevice(DDCIdx: Integer; Seq: LongWord);
begin
if DDCIdx = -1 then
begin
if Assigned(FDeviceDialog) then
FDeviceDialog.NoDevicesFound;
SetStatusText(2, 'No hardware found');
end
else
SetStatusText(4, 'RX running');
end;
// TDiscoverThread / no-device-сигнал переехали в TRadioController.Discover.
procedure TMainForm.RecreateDSPEngine(ASampleRate: Integer);
begin
@@ -3554,12 +3522,11 @@ begin
end;
procedure TMainForm.BtnDiscoverFromDialog(Sender: TObject);
// Запускается когда пользователь нажимает DISCOVER внутри диалога
// Запускается когда пользователь нажимает DISCOVER внутри диалога.
// Контроллер чистит список и стартует поток; UI слушает rfDeviceList.
begin
FController.FDeviceStore.ClearDiscovered;
SetStatusText(2, 'Discovering...');
FController.FNetwork.DirectIP := '';
TDiscoverThread.Create(FController.FNetwork, Self);
FController.Discover;
end;
procedure TMainForm.BtnStartStopClick(Sender: TObject);
@@ -3570,29 +3537,7 @@ begin
if FController.FNetwork.Connected then
begin
// --- STOP ---
// Движок (graceful Run=0, сброс TX/телеметрии) + рендер run-кнопки/MOX/sleep
// — в контроллере (StopRunning + OnControllerState rfRunning/rfTransmitting).
FController.StopRunning;
// Сохраняем текущую частоту/настройки чтобы следующий START восстановил их
if FController.FDevConnected then
begin
SaveCurrentBand;
FController.FSettings.SaveGlobal(FController.FDevMAC, MakeGlobalSettings);
FController.FSettings.SaveAlex(FController.FDevMAC, FController.FAlexSettings);
// XVTR LastFreq → актуальная видимая частота в момент остановки
if (FController.FCurrentXvtr >= 0) and (FController.FCurrentXvtr < CFG_XVTR_COUNT) then
FController.FXvtrSettings.Entries[FController.FCurrentXvtr].LastFreq := FController.FVfoA;
FController.FSettings.SaveXvtr(FController.FDevMAC, FController.FXvtrSettings);
end;
FController.FSettings.SaveStartupPreview(FController.FVfoA, FController.FVfoB, FController.FSampleRate);
FController.FSettings.Save;
FSpecView.ResetSpectrumBuf;
FSpecView.DrawSpectrum;
PbSpectrum.Invalidate;
FController.FNetwork.Disconnect;
// Run-кнопка/MOX уже перерисованы StopRunning (rfRunning); здесь только
// контекстный offline-статус.
SetRadioOfflineStatus('Disconnected', True);
DoStopAndDisconnect;
Exit;
end;
@@ -3642,6 +3587,34 @@ begin
StartWithDevice(Dev);
end;
procedure TMainForm.DoStopAndDisconnect;
// STOP-teardown, общий для десктоп-STOP и web-disconnect. Движок (graceful Run=0,
// сброс TX/телеметрии) + рендер run-кнопки/MOX/sleep — в контроллере (StopRunning
// + OnControllerState). Здесь: persistence + сеть Disconnect + offline-статус.
begin
FController.StopRunning;
// Сохраняем текущую частоту/настройки чтобы следующий START восстановил их
if FController.FDevConnected then
begin
SaveCurrentBand;
FController.FSettings.SaveGlobal(FController.FDevMAC, MakeGlobalSettings);
FController.FSettings.SaveAlex(FController.FDevMAC, FController.FAlexSettings);
// XVTR LastFreq → актуальная видимая частота в момент остановки
if (FController.FCurrentXvtr >= 0) and (FController.FCurrentXvtr < CFG_XVTR_COUNT) then
FController.FXvtrSettings.Entries[FController.FCurrentXvtr].LastFreq := FController.FVfoA;
FController.FSettings.SaveXvtr(FController.FDevMAC, FController.FXvtrSettings);
end;
FController.FSettings.SaveStartupPreview(FController.FVfoA, FController.FVfoB, FController.FSampleRate);
FController.FSettings.Save;
FSpecView.ResetSpectrumBuf;
FSpecView.DrawSpectrum;
PbSpectrum.Invalidate;
FController.FNetwork.Disconnect;
// Run-кнопка/MOX уже перерисованы StopRunning (rfRunning); здесь только
// контекстный offline-статус.
SetRadioOfflineStatus('Disconnected', True);
end;
procedure TMainForm.StartWithDevice(const Dev: THPSDRDevice);
// Запуск с уже выбранным устройством — общий путь для десктоп-диалога и
// web-оверлея (без модального диалога). Подбор sample rate до WDSP, открытие
@@ -5227,9 +5200,144 @@ end;
procedure TMainForm.SyncWebRun;
begin
// Toggle only if state differs
if FWebSyncBool <> FController.FRunning then
BtnStartStopClick(nil);
// set_run отвязан от десктопного модального диалога: web стартует через connect
// (overlay), а set_run:true без выбранного устройства бессмысленно. Здесь только
// STOP-путь (set_run:false), симметрично web-disconnect.
if (not FWebSyncBool) and FController.FNetwork.Connected then
DoStopAndDisconnect;
end;
// ── Web discovery / connect / disconnect / saved-CRUD ───────────────────────
procedure TMainForm.WebOnConnect(const IP: string);
begin
FWebSyncStr1 := IP;
FWebSyncM := SyncWebConnect;
TThread.Synchronize(nil, FWebSyncM);
end;
procedure TMainForm.SyncWebConnect;
var
Dev: THPSDRDevice;
i: Integer;
begin
if FController.FNetwork.Connected then Exit; // уже подключены
FillChar(Dev, SizeOf(Dev), 0);
Dev.IPAddress := FWebSyncStr1;
// BoardType (тип платы не определяется при Connect — только из discovery/saved):
// сначала найденное устройство (есть и MAC для preload), иначе сохранённое по IP
// — как десктоп берёт FPendingBoardType из GetSavedBoardType.
i := FController.FDeviceStore.FindDiscoveredByIP(FWebSyncStr1);
if i >= 0 then
Dev.BoardType := FController.FDeviceStore.Discovered(i).BoardType
else
for i := 0 to FController.FDeviceStore.SavedCount - 1 do
if FController.FDeviceStore.Saved(i).IPAddress = FWebSyncStr1 then
begin
Dev.BoardType := FController.FDeviceStore.Saved(i).BoardType;
Break;
end;
StartWithDevice(Dev);
end;
procedure TMainForm.WebOnDiscover;
begin
FWebSyncM := SyncWebDiscover;
TThread.Synchronize(nil, FWebSyncM);
end;
procedure TMainForm.SyncWebDiscover;
begin
SetStatusText(2, 'Discovering...');
FController.Discover; // rfDeviceList-рендер запушит обновлённый список в web
end;
procedure TMainForm.WebOnDisconnect;
begin
FWebSyncM := SyncWebDisconnect;
TThread.Synchronize(nil, FWebSyncM);
end;
procedure TMainForm.SyncWebDisconnect;
begin
if FController.FNetwork.Connected then
DoStopAndDisconnect;
end;
procedure TMainForm.WebOnDevAdd(const AName, IP: string);
begin
FWebSyncStr1 := AName;
FWebSyncStr2 := IP;
FWebSyncM := SyncWebDevAdd;
TThread.Synchronize(nil, FWebSyncM);
end;
procedure TMainForm.SyncWebDevAdd;
begin
FController.FDeviceStore.AddSaved(FWebSyncStr1, FWebSyncStr2, 0);
PushDeviceListToWeb;
end;
procedure TMainForm.WebOnDevRemove(Idx: Integer);
begin
FWebSyncInt := Idx;
FWebSyncM := SyncWebDevRemove;
TThread.Synchronize(nil, FWebSyncM);
end;
procedure TMainForm.SyncWebDevRemove;
begin
FController.FDeviceStore.RemoveSaved(FWebSyncInt);
PushDeviceListToWeb;
end;
procedure TMainForm.WebOnDevAutoStart(Idx: Integer);
begin
FWebSyncInt := Idx;
FWebSyncM := SyncWebDevAutoStart;
TThread.Synchronize(nil, FWebSyncM);
end;
procedure TMainForm.SyncWebDevAutoStart;
begin
FController.FDeviceStore.SetAutoStart(FWebSyncInt);
PushDeviceListToWeb;
end;
procedure TMainForm.PushDeviceListToWeb;
// store (saved+discovered) → FWebServer.SetDeviceList. Saved идут первыми, поэтому
// их позиция в массиве == saved-индекс (web шлёт его в dev_remove/dev_autostart).
var
Arr: TWebDeviceArray;
i, k: Integer;
D: TDiscoveredDevice;
Sv: TSavedDevice;
begin
if FWebServer = nil then Exit;
SetLength(Arr, FController.FDeviceStore.SavedCount +
FController.FDeviceStore.DiscoveredCount);
k := 0;
for i := 0 to FController.FDeviceStore.SavedCount - 1 do
begin
Sv := FController.FDeviceStore.Saved(i);
Arr[k].Name := Sv.Name;
Arr[k].IP := Sv.IPAddress;
Arr[k].BoardType := Sv.BoardType;
Arr[k].IsSaved := True;
Arr[k].AutoStart := Sv.AutoStart;
Inc(k);
end;
for i := 0 to FController.FDeviceStore.DiscoveredCount - 1 do
begin
D := FController.FDeviceStore.Discovered(i);
Arr[k].Name := D.DisplayName;
Arr[k].IP := D.IPAddress;
Arr[k].BoardType := D.BoardType;
Arr[k].IsSaved := False;
Arr[k].AutoStart := False;
Inc(k);
end;
FWebServer.SetDeviceList(Arr);
end;
// ── Mute ───────────────────────────────────────────────────────────────────
+79 -2
View File
@@ -70,7 +70,8 @@ type
rfChannel,
rfSMeter, rfPower, rfSWR, rfSupply, rfPLL, // телеметрия
rfADCOverload, // ADC overload (рендер индикатора)
rfDevice // подключённое устройство сменилось
rfDevice, // подключённое устройство сменилось
rfDeviceList // список discovered устройств обновился
);
TRadioStateEvent = procedure(Sender: TObject; Field: TRadioField) of object;
@@ -167,6 +168,7 @@ type
FAudioOutDevName: string;
FAudioInDevName: string;
FDevConnected: Boolean;
FDiscoverNoneFound: Boolean; // discovery завершился без устройств (для рендера)
// ---- DSP-фильтры шума / водопад ----
FNRMode, FNBMode: Integer; // источник истины (раньше Btn*.Tag)
@@ -244,6 +246,10 @@ type
FHPpFwdW, FHPpSWR, FHPpSupplyV, FHPpSupplyA: Double;
FHPpPLL, FHPpHWPTT: Boolean;
FHPpOverload: Byte;
// Pending discovered-устройство (сетевой поток discovery → ApplyDeviceFound
// через Invoke; Synchronize блокирующий — устройства приходят по одному).
FPendingFoundDev: THPSDRDevice;
FPendingFoundEntry: string;
constructor Create;
destructor Destroy; override;
@@ -264,6 +270,9 @@ type
procedure OnHPStatus(const Status: THighPriorityStatus);
procedure ApplyHPStatus; // маршалится из OnHPStatus (сглаживание/overload/HWPTT)
procedure OnTXIQ(const Buf: array of Double; Count: Integer);
procedure OnDeviceFound(const Dev: THPSDRDevice); // сетевой поток discovery
procedure ApplyDeviceFound; // маршалится из OnDeviceFound (store + rfDeviceList)
procedure DiscoverFinishedNone; // маршалится из discover-потока: устройств нет
// Маршалинг команды в поток контроллера (GUI: TThread.Synchronize).
procedure Invoke(M: TThreadMethod);
@@ -2162,7 +2171,75 @@ begin
Changed(rfDevice); // UI: полная синхронизация device-виджетов из состояния
end;
// ---------------------------------------------------------------------------
// Discovery — поиск устройств в фоновом потоке. Найденные приходят через
// FNetwork.OnDeviceFound (=OnDeviceFound) и копятся в FDeviceStore.Discovered;
// по завершении без устройств — DiscoverFinishedNone. UI слушает rfDeviceList.
// ---------------------------------------------------------------------------
type
TDiscoverThread = class(TThread)
private
FCtrl: TRadioController;
protected
procedure Execute; override;
public
constructor Create(ACtrl: TRadioController);
end;
constructor TDiscoverThread.Create(ACtrl: TRadioController);
begin
FCtrl := ACtrl;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TDiscoverThread.Execute;
var
Devs: THPSDRDeviceArray;
begin
Devs := FCtrl.FNetwork.Discover(2000);
// Найденные устройства сигналятся колбэком OnDeviceFound во время Discover().
if Length(Devs) = 0 then
FCtrl.Invoke(FCtrl.DiscoverFinishedNone);
end;
procedure TRadioController.OnDeviceFound(const Dev: THPSDRDevice);
// Сетевой поток: строим строку для списка → pending → маршалинг в ApplyDeviceFound.
var
BoardName: string;
begin
BoardName := BoardTypeName(Dev.BoardType);
FPendingFoundDev := Dev;
FPendingFoundEntry := Format('%s %s FW:%d DDC:%d',
[Dev.IPAddress, BoardName,
Dev.FirmwareVersion, Dev.NumDDCs]);
Invoke(ApplyDeviceFound);
end;
procedure TRadioController.ApplyDeviceFound;
// Маршалится из OnDeviceFound (Synchronize). Дописываем в store и уведомляем UI.
begin
FDiscoverNoneFound := False;
FDeviceStore.AddDiscovered(FPendingFoundDev.IPAddress, FPendingFoundEntry,
FPendingFoundDev.BoardType, FPendingFoundDev.MAC);
Changed(rfDeviceList);
end;
procedure TRadioController.DiscoverFinishedNone;
// Маршалится из discover-потока, когда устройств не найдено.
begin
FDiscoverNoneFound := True;
Changed(rfDeviceList);
end;
procedure TRadioController.Discover;
begin { TODO wiring: FNetwork.Discover } end;
// Старт поиска: чистим прошлый список, сбрасываем direct-IP, запускаем поток.
begin
FDeviceStore.ClearDiscovered;
FDiscoverNoneFound := False;
FNetwork.DirectIP := '';
Changed(rfDeviceList);
TDiscoverThread.Create(Self);
end;
end.
+76 -2
View File
@@ -7,7 +7,9 @@ unit WebPageHtml;
HTML-страницу (одним файлом) для отправки клиенту по HTTP GET /.
ИСПРАВЛЕНИЯ:
- Кнопка START/STOP добавлена в тулбар 1 (шлёт set_run, зелёная/красная)
- Device-overlay (DEV): discovery/connect/saved-CRUD, паритет с десктоп-диалогом.
START теперь открывает overlay (если не подключены); STOP шлёт disconnect.
- Кнопка START/STOP добавлена в тулбар 1 (зелёная/красная)
- Кнопка RX/TX удалена из тулбара 2
- NR/NB/ANF: cur обновляется локально сразу при клике (иначе повторный
клик инвертировал уже отправленное значение)
@@ -202,6 +204,7 @@ begin
'<button id="anfBtn">ANF</button>' +
'<button id="nrBtn">NR</button>' +
'<span class="sl-sep">|</span>' +
'<button id="devBtn" title="Devices">DEV</button>' +
'<button id="startStopBtn" class="on">START</button>' +
'</div>' +
@@ -352,6 +355,74 @@ begin
'}' +
'q("fnpBtn").onclick=showFnp;' +
// ── Device discovery / connect / saved-CRUD overlay (паритет с десктоп-диалогом) ──
'var devOv=null,devList=null;' +
'function closeDev(){if(devOv){devOv.remove();devOv=null;devList=null;}}' +
'function devBtnS(bg,fg,bd){return "background:"+bg+";color:"+fg+";border:1px solid "+bd+";border-radius:4px;padding:4px 8px;font-family:monospace;font-size:11px;cursor:pointer;margin-left:4px;";}' +
'function renderDevList(){if(!devList)return;devList.innerHTML="";' +
'var devs=cur.devices||[];var conn=!!cur.connected;' +
'function mkRow(d,sIdx){' +
'var row=document.createElement("div");' +
'row.style.cssText="display:flex;align-items:center;justify-content:space-between;gap:6px;padding:5px 6px;border:1px solid rgba(55,95,55,0.4);border-radius:4px;margin-bottom:4px;background:rgba(12,28,12,0.7);";' +
'var lbl=document.createElement("span");' +
'lbl.textContent=d.saved?((d.autostart?"★ ":"")+(d.name||"HPSDR")+" "+d.ip):d.name;' +
'lbl.style.cssText="color:#9cc99c;font-family:monospace;font-size:11px;white-space:nowrap;overflow:hidden;text-overflow:ellipsis;";' +
'var btns=document.createElement("span");btns.style.cssText="display:flex;flex:none;";' +
'var cb=document.createElement("button");cb.textContent="Connect";' +
'cb.style.cssText=devBtnS("rgba(25,70,25,0.95)","#b0ffb0","rgba(120,220,120,0.7)");' +
'cb.onclick=function(){ws2({cmd:"connect",ip:d.ip});closeDev();};if(conn)cb.disabled=true;' +
'btns.appendChild(cb);' +
'if(d.saved){' +
'var ab=document.createElement("button");ab.textContent="★";ab.title="Auto-start";' +
'ab.style.cssText=devBtnS("rgba(12,28,12,0.85)",d.autostart?"#ffd060":"#7aaa7a","rgba(55,95,55,0.45)");' +
'ab.onclick=function(){ws2({cmd:"dev_autostart",idx:sIdx});};' +
'var rb=document.createElement("button");rb.textContent="✕";rb.title="Remove";' +
'rb.style.cssText=devBtnS("rgba(40,12,12,0.85)","#cc8080","rgba(95,55,55,0.45)");' +
'rb.onclick=function(){ws2({cmd:"dev_remove",idx:sIdx});};' +
'btns.appendChild(ab);btns.appendChild(rb);' +
'}else{' +
'var sv=document.createElement("button");sv.textContent="Save";' +
'sv.style.cssText=devBtnS("rgba(12,28,12,0.85)","#7aaa7a","rgba(55,95,55,0.45)");' +
'sv.onclick=function(){ws2({cmd:"dev_add",name:d.name||"",ip:d.ip});};' +
'btns.appendChild(sv);' +
'}' +
'row.appendChild(lbl);row.appendChild(btns);return row;' +
'}' +
'var si=-1,hasSaved=false,hasFound=false;' +
'devs.forEach(function(d){if(!d.saved)return;si++;' +
'if(!hasSaved){var h=document.createElement("div");h.textContent="Saved";h.style.cssText="color:#6a9a6a;font-size:10px;margin:2px 0 4px;letter-spacing:1px;";devList.appendChild(h);hasSaved=true;}' +
'devList.appendChild(mkRow(d,si));});' +
'devs.forEach(function(d){if(d.saved)return;' +
'if(!hasFound){var h=document.createElement("div");h.textContent="Discovered";h.style.cssText="color:#6a9a6a;font-size:10px;margin:8px 0 4px;letter-spacing:1px;";devList.appendChild(h);hasFound=true;}' +
'devList.appendChild(mkRow(d,-1));});' +
'if(!hasSaved&&!hasFound){var e=document.createElement("div");e.textContent="No devices — Discover or add manually";e.style.cssText="color:#6a8a6a;font-size:11px;font-style:italic;padding:6px 2px;";devList.appendChild(e);}' +
'}' +
'function showDev(){' +
'if(devOv){closeDev();return;}' +
'devOv=document.createElement("div");' +
'devOv.style.cssText="position:fixed;top:50%;left:50%;transform:translate(-50%,-50%);background:rgba(6,14,6,0.95);border:1px solid rgba(70,120,70,0.65);border-radius:8px;padding:14px 16px;z-index:2000;backdrop-filter:blur(6px);box-shadow:0 4px 24px rgba(0,0,0,0.7);width:340px;max-width:92vw;max-height:80vh;overflow:auto;";' +
'var hd=document.createElement("div");hd.style.cssText="display:flex;justify-content:space-between;align-items:center;margin-bottom:10px;";' +
'var tl=document.createElement("span");tl.textContent="Devices";tl.style.cssText="color:#80b880;font-family:monospace;font-size:12px;letter-spacing:1px;";' +
'var xb=document.createElement("button");xb.textContent="×";xb.style.cssText="background:none;border:none;color:#6a9a6a;font-size:16px;cursor:pointer;padding:0 2px;line-height:1;";xb.onclick=closeDev;' +
'hd.appendChild(tl);hd.appendChild(xb);devOv.appendChild(hd);' +
'var ar=document.createElement("div");ar.style.cssText="display:flex;gap:6px;margin-bottom:10px;";' +
'var db=document.createElement("button");db.textContent="Discover";db.style.cssText=devBtnS("rgba(25,55,80,0.95)","#a0d0ff","rgba(90,150,210,0.7)")+"margin-left:0;flex:1;";db.onclick=function(){ws2({cmd:"discover"});};ar.appendChild(db);' +
'var dc=document.createElement("button");dc.textContent="Disconnect";dc.style.cssText=devBtnS("rgba(60,20,20,0.9)","#e0a0a0","rgba(150,80,80,0.6)")+"margin-left:0;flex:1;";dc.onclick=function(){ws2({cmd:"disconnect"});closeDev();};if(!cur.connected)dc.disabled=true;ar.appendChild(dc);' +
'devOv.appendChild(ar);' +
'devList=document.createElement("div");devOv.appendChild(devList);' +
'var mf=document.createElement("div");mf.style.cssText="margin-top:12px;border-top:1px solid rgba(55,95,55,0.35);padding-top:10px;display:flex;flex-direction:column;gap:6px;";' +
'var inS="background:rgba(0,0,0,0.4);border:1px solid rgba(55,95,55,0.5);border-radius:4px;color:#b0e0b0;font-family:monospace;font-size:11px;padding:5px 6px;width:100%;box-sizing:border-box;";' +
'var nm=document.createElement("input");nm.placeholder="Name (optional)";nm.style.cssText=inS;' +
'var ip=document.createElement("input");ip.placeholder="IP address";ip.style.cssText=inS;' +
'mf.appendChild(nm);mf.appendChild(ip);' +
'var mb=document.createElement("div");mb.style.cssText="display:flex;gap:6px;";' +
'var cob=document.createElement("button");cob.textContent="Connect";cob.style.cssText=devBtnS("rgba(25,70,25,0.95)","#b0ffb0","rgba(120,220,120,0.7)")+"margin-left:0;flex:1;";cob.onclick=function(){var v=ip.value.trim();if(v){ws2({cmd:"connect",ip:v});closeDev();}};' +
'var svb=document.createElement("button");svb.textContent="Save";svb.style.cssText=devBtnS("rgba(12,28,12,0.85)","#7aaa7a","rgba(55,95,55,0.45)")+"margin-left:0;flex:1;";svb.onclick=function(){var v=ip.value.trim();if(v){ws2({cmd:"dev_add",name:nm.value.trim(),ip:v});nm.value="";ip.value="";}};' +
'mb.appendChild(cob);mb.appendChild(svb);mf.appendChild(mb);devOv.appendChild(mf);' +
'renderDevList();document.body.appendChild(devOv);' +
'}' +
'q("devBtn").onclick=showDev;' +
'q("volSl").oninput=function(e){ws2({cmd:"volume",v:+e.target.value});var v=q("volVal");if(v)v.textContent=e.target.value;};' +
'q("rfSl").oninput=function(e){ws2({cmd:"agctop",db:+e.target.value});var v=q("rfVal");if(v)v.textContent=e.target.value+"dB";};' +
'q("txSl").oninput=function(e){var v=+e.target.value;var lbl=q("txVal");if(lbl)lbl.textContent=v;pend("drive");ws2({cmd:"drive",v:v});};' +
@@ -375,7 +446,9 @@ begin
// START/STOP
'function updRunBtn(r){var b=q("startStopBtn");if(!b)return;b.textContent=r?"STOP":"START";b.classList.toggle("rx-tx",!!r);b.classList.toggle("on",!r);}' +
'q("startStopBtn").onclick=function(){audioKick();cur.running=!cur.running;pend("run");updRunBtn(cur.running);cmd("set_run",cur.running);};' +
// Подключённы → STOP (disconnect). Иначе → device-overlay (выбор/подключение).
// set_run:true больше не открывает устройство (web стартует через connect).
'q("startStopBtn").onclick=function(){audioKick();if(cur.connected||cur.running){ws2({cmd:"disconnect"});cur.running=false;pend("run");updRunBtn(false);}else{showDev();}};' +
'function updMuteIc(){var mi=q("muteIc");if(mi)mi.textContent=cur.mute?"\uD83D\uDD07":"\uD83D\uDD0A";}' +
'q("muteIc").onclick=()=>{cur.mute=!cur.mute;updMuteIc();pend("mute");cmd("set_mute",cur.mute);};' +
@@ -645,6 +718,7 @@ begin
'updBand(activeVfo==="A"?(cur.vfo_a_hz||0):(vfoB||0));updSpan(cur.span_hz||192000);' +
'paintSM(Number(cur.smeter_dbm||-130));' +
'updStatusBar();' +
'if(devList)renderDevList();' +
'const nowTx=!!cur.transmitting;if(nowTx!==prevTx){prevTx=nowTx;if(nowTx)startTXMic();else stopTXMic();}}' +
'function pal(db){const v=Math.round(cl((db-wfLo)/Math.max(1,wfHi-wfLo),0,1)*255);const c=PAL[v]|0;return[(c>>16)&255,(c>>8)&255,c&255];}' +
+91 -3
View File
@@ -162,6 +162,21 @@ type
TWebXvtrArray = array of TWebXvtrInfo;
TWebMicCB = procedure(Samples: PSingle; Count: Integer) of object;
// ── Discovery / connect / saved-CRUD (паритет с десктоп-диалогом) ──────────
TWebCmdConnect = procedure(const IP: string) of object; // подключиться к IP
TWebCmdSimple = procedure of object; // discover / disconnect
TWebCmdDevAdd = procedure(const AName, IP: string) of object;
TWebCmdDevIdx = procedure(Idx: Integer) of object; // dev_remove / dev_autostart
// Элемент списка устройств для web-overlay (saved или discovered).
TWebDeviceInfo = record
Name: string; // имя (saved) или display-строка (discovered)
IP: string;
BoardType: Integer;
IsSaved: Boolean; // true=сохранённое (с именем), false=найденное
AutoStart: Boolean; // только для saved
end;
TWebDeviceArray = array of TWebDeviceInfo;
// ── Главный класс сервера ─────────────────────────────────────────────────
TWebServer = class
private
@@ -281,6 +296,7 @@ type
FDuplex: Boolean;
FFreqMhzDigits: Integer; // 3=999MHz, 4=9.999GHz, 5=99.999GHz
FXvtrBands: TWebXvtrArray; // список enabled XVTR (для web-UI)
FDevices: TWebDeviceArray; // saved+discovered устройства (для web-overlay)
FCurrentXvtr: Integer; // -1 = HF, иначе индекс активного XVTR
FOnXvtrBand: TWebCmdXvtrBand;
@@ -299,6 +315,14 @@ type
FWebClientActive: Boolean;
FOnClientActiveChanged: TWebClientActiveEvent;
// Discovery / connect / saved-CRUD callbacks (маршалятся хозяином в GUI).
FOnConnect: TWebCmdConnect;
FOnDiscoverDev: TWebCmdSimple;
FOnDisconnectDev: TWebCmdSimple;
FOnDevAdd: TWebCmdDevAdd;
FOnDevRemove: TWebCmdDevIdx;
FOnDevAutoStart: TWebCmdDevIdx;
// Обновляет FWebClientActive и при изменении уведомляет хозяина. Вызывать
// под уже взятой блокировкой поля (FStateLock/FClientLock) — сам не лочит.
procedure SetClientActive(Value: Boolean);
@@ -367,6 +391,7 @@ type
property OnBand: TWebCmdBand read FOnBand write FOnBand;
property OnXvtrBand: TWebCmdXvtrBand read FOnXvtrBand write FOnXvtrBand;
procedure SetXvtrBands(const ABands: TWebXvtrArray; ACurrent: Integer);
procedure SetDeviceList(const ADevices: TWebDeviceArray);
property OnSpan: TWebCmdSpan read FOnSpan write FOnSpan;
property OnVolume: TWebCmdVolume read FOnVolume write FOnVolume;
property OnWfAGC: TWebCmdWfAGC read FOnWfAGC write FOnWfAGC;
@@ -388,6 +413,12 @@ type
property OnTun: TWebCmdTun read FOnTun write FOnTun;
property OnFMStep: TWebCmdFMStep read FOnFMStep write FOnFMStep;
property OnWebMic: TWebMicCB read FOnWebMic write FOnWebMic;
property OnConnect: TWebCmdConnect read FOnConnect write FOnConnect;
property OnDiscoverDev: TWebCmdSimple read FOnDiscoverDev write FOnDiscoverDev;
property OnDisconnectDev: TWebCmdSimple read FOnDisconnectDev write FOnDisconnectDev;
property OnDevAdd: TWebCmdDevAdd read FOnDevAdd write FOnDevAdd;
property OnDevRemove: TWebCmdDevIdx read FOnDevRemove write FOnDevRemove;
property OnDevAutoStart: TWebCmdDevIdx read FOnDevAutoStart write FOnDevAutoStart;
end;
implementation
@@ -520,6 +551,19 @@ begin
end;
end;
procedure TWebServer.SetDeviceList(const ADevices: TWebDeviceArray);
var i: Integer;
begin
FStateLock.Enter;
try
SetLength(FDevices, Length(ADevices));
for i := 0 to High(ADevices) do
FDevices[i] := ADevices[i];
finally
FStateLock.Leave;
end;
end;
destructor TWebServer.Destroy;
begin
Stop;
@@ -1171,6 +1215,7 @@ var
HzF: Double;
HzI, ModeValue, BW, DB, Idx, V: Integer;
On_: Boolean;
S1, S2: string;
begin
Cmd := JsonGetStr(Json, 'cmd');
@@ -1361,6 +1406,36 @@ begin
if Idx > 3 then Idx := 3;
FStateLock.Enter; FFMStepIdx := Idx; FStateLock.Leave;
if Assigned(FOnFMStep) then FOnFMStep(Idx);
end
// ── Discovery / connect / saved-CRUD ──────────────────────────────────────
else if Cmd = 'discover' then
begin
if Assigned(FOnDiscoverDev) then FOnDiscoverDev;
end
else if Cmd = 'connect' then
begin
S1 := JsonGetStr(Json, 'ip');
if (S1 <> '') and Assigned(FOnConnect) then FOnConnect(S1);
end
else if Cmd = 'disconnect' then
begin
if Assigned(FOnDisconnectDev) then FOnDisconnectDev;
end
else if Cmd = 'dev_add' then
begin
S1 := JsonGetStr(Json, 'name');
S2 := JsonGetStr(Json, 'ip');
if (S2 <> '') and Assigned(FOnDevAdd) then FOnDevAdd(S1, S2);
end
else if Cmd = 'dev_remove' then
begin
Idx := JsonGetInt(Json, 'idx', -1);
if (Idx >= 0) and Assigned(FOnDevRemove) then FOnDevRemove(Idx);
end
else if Cmd = 'dev_autostart' then
begin
Idx := JsonGetInt(Json, 'idx', -1);
if (Idx >= 0) and Assigned(FOnDevAutoStart) then FOnDevAutoStart(Idx);
end;
end;
@@ -1467,7 +1542,7 @@ const
('LSB','USB','DSB','CWL','CWU','FM','AM','SAM');
var
FS: TFormatSettings;
XvtrJson: string;
XvtrJson, DevJson: string;
i: Integer;
begin
FS := DefaultFormatSettings;
@@ -1484,6 +1559,19 @@ begin
[FXvtrBands[i].Idx, FXvtrBands[i].Name], FS);
end;
XvtrJson := XvtrJson + ']';
// Сборка списка устройств (saved+discovered) для overlay-диалога.
DevJson := '[';
for i := 0 to High(FDevices) do
begin
if i > 0 then DevJson := DevJson + ',';
DevJson := DevJson +
Format('{"name":"%s","ip":"%s","board":%d,"saved":%s,"autostart":%s}',
[JsonEscape(FDevices[i].Name), JsonEscape(FDevices[i].IP),
FDevices[i].BoardType,
BoolToStr(FDevices[i].IsSaved, 'true', 'false'),
BoolToStr(FDevices[i].AutoStart, 'true', 'false')], FS);
end;
DevJson := DevJson + ']';
Result := Format(
'{"vfo_a_hz":%.0f,"vfo_b_hz":%.0f,"active_vfo":%d,' +
'"mode":%d,"mode_name":"%s",' +
@@ -1498,7 +1586,7 @@ begin
'"status_text":"%s","board_text":"%s","ip_text":"%s","supply_text":"%s",' +
'"pll_text":"%s","rx_text":"%s","tx_text":"%s","seq_text":"%s",' +
'"xvtr_current":%d,"xvtr_bands":%s,"freq_mhz_digits":%d,' +
'"fmstep_idx":%d}',
'"fmstep_idx":%d,"devices":%s}',
[FFreq, FVfoB, FActiveVfo,
FMode, MODE_N[FMode mod 8],
FFilterIdx, FFilterBW,
@@ -1527,7 +1615,7 @@ begin
JsonEscape(FSupplyText), JsonEscape(FPLLText), JsonEscape(FRXText),
JsonEscape(FTXText), JsonEscape(FSeqText),
FCurrentXvtr, XvtrJson, FFreqMhzDigits,
FFMStepIdx
FFMStepIdx, DevJson
], FS);
finally
FStateLock.Leave;