Files
ewsdr/DeviceForm.pas
T
ew8bakandClaude Opus 4.8 a988849d3e feat: Pluto/AD936x SDR backend (discovery, RX, VHF band plan)
Add ADALM-Pluto / AD9361 support as a second hardware backend alongside
openHPSDR, sharing the WDSP DSP pipeline and the existing controller API
(UI stays decoupled from logic).

- RadioBackend.pas: abstract TRadioBackend + TBackendCaps + TRadioDevice
  (Kind/URI/Serial). THPSDRNetwork now derives from it (state via virtual
  getters); TRadioController.FNetwork is the base type.
- IIOBindings.pas: dynamic libiio loader (runs without libiio present).
- PlutoBackend.pas: scan/probe-by-URI, connect, LO/rate/bandwidth/gain
  control, RX streaming thread (int16->24bit BE -> OnDDCIQ), Q conjugated
  to match WDSP IQ convention. Verified on LibreSDR (AD9361) over network.
- Unified discovery: TDiscoverThread scans both backends; network Plutos
  found via direct ProbeURI (no mDNS needed). ConnectDevice dispatches by
  Dev.Kind (EnsureBackend swaps backend, preserving callbacks).
- DeviceStore/DeviceForm: persist Kind/URI/Serial; save Pluto via
  AddSavedPluto so saved/autostart devices reconnect across restarts.
- VHF/UHF band plan (BoardUtils, kind-aware): 6m..ADS-B for Pluto; fixes
  HF clamps (band detect, mouse-wheel 60 MHz cap, freq-display max).
- SampleRateOverlay: configurable presets (Pluto 576k..5760k, >520 ksps),
  auto-width to fit.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-06-16 18:55:20 +03:00

560 lines
16 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit DeviceForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ComCtrls,
BoardUtils, PlatformUtils, DeviceStore, RadioBackend;
type
// Результат диалога
TDeviceDialogResult = record
Accepted: Boolean;
IPAddress: string;
SavedIdx: Integer; // -1 если выбрали из discovery, иначе индекс в SavedDevices
end;
{ TDeviceDialog }
TDeviceDialog = class(TForm)
private
// Общее хранилище устройств (saved+discovered) — единый источник правды,
// владелец контроллер; диалог только рендерит и редактирует через него.
FStore: TDeviceStore;
FResult: TDeviceDialogResult;
// UI
PanelTop: TPanel;
PanelBottom: TPanel;
PanelLeft: TPanel;
PanelRight: TPanel;
LblSaved: TLabel;
LstSaved: TFlatListBox;
BtnAdd: TFlatButton;
BtnRemove: TFlatButton;
BtnSetAuto: TFlatButton;
EdName: TFlatEdit;
EdIP: TFlatEdit;
LblName: TLabel;
LblIP: TLabel;
LblFound: TLabel;
LstFound: TFlatListBox;
BtnDiscover: TFlatButton;
BtnAddFound: TFlatButton;
BtnConnect: TFlatButton;
BtnCancel: TFlatButton;
FOnDiscover: TNotifyEvent; // внешний callback для запуска discovery
procedure BuildUI;
procedure ApplyTheme;
procedure SetStore(AStore: TDeviceStore);
procedure RefreshSavedList;
procedure BtnDiscoverClick(Sender: TObject);
procedure BtnAddClick(Sender: TObject);
procedure BtnRemoveClick(Sender: TObject);
procedure BtnSetAutoClick(Sender: TObject);
procedure BtnAddFoundClick(Sender: TObject);
procedure BtnConnectClick(Sender: TObject);
procedure BtnCancelClick(Sender: TObject);
procedure LstSavedDblClick(Sender: TObject);
procedure LstFoundDblClick(Sender: TObject);
procedure LstSavedClick(Sender: TObject);
function MakeBtn(AParent: TWinControl; const Cap: string;
X, Y, W, H: Integer; AClick: TNotifyEvent): TFlatButton;
function MakeLbl(AParent: TWinControl; const Cap: string;
X, Y: Integer): TLabel;
public
constructor Create(AOwner: TComponent); override;
procedure SetTheme(const T: TAppTheme);
// Перерисовать список найденных из store (вызывается по rfDeviceList)
procedure RefreshFound;
procedure ClearDiscovered;
procedure NoDevicesFound; // UI-сообщение «нет устройств» в список найденных
// Автозапуск: возвращает IP если есть устройство с AutoStart=True
function GetAutoStartIP: string;
function GetAutoStartBoardType: Integer;
function GetSavedBoardType(Idx: Integer): Integer;
// Текст поля ручного ввода IP/URI (для probe сетевых Pluto при discovery).
function ManualIP: string;
// Получить/сбросить результат
procedure ClearResult;
// Общее хранилище устройств — назначается владельцем (MainForm/контроллер)
// до показа диалога; диалог рендерит и редактирует через него.
property Store: TDeviceStore read FStore write SetStore;
property DialogResult: TDeviceDialogResult read FResult;
property OnDiscover: TNotifyEvent read FOnDiscover write FOnDiscover;
end;
implementation
const
CLR_BG = TColor($00121212);
CLR_PANEL = TColor($001A1A1A);
CLR_TEXT = TColor($00E0E0E0);
CLR_TEXTDIM = TColor($00888888);
CLR_BORDER = TColor($00303030);
CLR_ACCENT = TColor($0040FF80);
CLR_AUTO = TColor($0000CCFF); // цвет авто-устройства
DLG_W = 760;
DLG_H = 500;
GAP = 12;
PAD = 14;
BTN_H = 28;
EDIT_H = 26;
PANEL_H = 412;
LEFT_W = 348;
RIGHT_W = 372;
{ TDeviceDialog }
constructor TDeviceDialog.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'Device Selection';
Width := DLG_W;
Height := DLG_H;
Position := poScreenCenter;
BorderStyle := bsDialog;
Color := CLR_BG;
Font.Name := 'Courier New';
Font.Size := 8;
Font.Color := CLR_TEXT;
FStore := nil; // назначается владельцем через property Store до показа
FResult.Accepted := False;
BuildUI;
SetTheme(DarkTheme);
end;
procedure TDeviceDialog.SetStore(AStore: TDeviceStore);
begin
FStore := AStore;
if FStore <> nil then RefreshSavedList;
end;
function TDeviceDialog.MakeBtn(AParent: TWinControl; const Cap: string;
X, Y, W, H: Integer; AClick: TNotifyEvent): TFlatButton;
begin
Result := MakeFlatBtn(AParent, Cap, X, Y, W, H, AClick);
end;
function TDeviceDialog.MakeLbl(AParent: TWinControl; const Cap: string;
X, Y: Integer): TLabel;
begin
Result := TLabel.Create(Self);
Result.Parent := AParent;
Result.Caption := Cap;
Result.Left := X; Result.Top := Y;
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := CLR_TEXTDIM;
end;
procedure TDeviceDialog.BuildUI;
const
LabelH = 18;
var
LblHint: TLabel;
FieldTop, ButtonsTop, BottomTop: Integer;
begin
// --- Левая панель: сохранённые устройства ---
PanelLeft := TPanel.Create(Self);
PanelLeft.Parent := Self;
PanelLeft.SetBounds(GAP, GAP, LEFT_W, PANEL_H);
PanelLeft.BevelOuter := bvNone;
PanelLeft.Color := CLR_PANEL;
MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD);
LstSaved := TFlatListBox.Create(Self);
LstSaved.Parent := PanelLeft;
LstSaved.SetBounds(PAD, PAD + LabelH, LEFT_W - PAD * 2, 174);
LstSaved.Color := CLR_BG;
LstSaved.Font.Color:= CLR_TEXT;
LstSaved.Font.Name := 'Courier New';
LstSaved.Font.Size := 8;
LstSaved.OnClick := @LstSavedClick;
LstSaved.OnDblClick := @LstSavedDblClick;
FieldTop := 212;
MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5);
EdName := TFlatEdit.Create(Self);
EdName.Parent := PanelLeft;
EdName.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H);
EdName.Color := CLR_BG;
EdName.Font.Color:= CLR_TEXT;
EdName.Font.Name := 'Courier New';
EdName.Font.Size := 8;
Inc(FieldTop, EDIT_H + 10);
MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5);
EdIP := TFlatEdit.Create(Self);
EdIP.Parent := PanelLeft;
EdIP.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H);
EdIP.Color := CLR_BG;
EdIP.Font.Color:= CLR_TEXT;
EdIP.Font.Name := 'Courier New';
EdIP.Font.Size := 8;
EdIP.TextHint := '192.168.1.x';
ButtonsTop := FieldTop + EDIT_H + 12;
BtnAdd := MakeBtn(PanelLeft, 'ADD', PAD, ButtonsTop, 94, BTN_H, @BtnAddClick);
BtnRemove := MakeBtn(PanelLeft, 'REMOVE', PAD + 102, ButtonsTop, 94, BTN_H, @BtnRemoveClick);
Inc(ButtonsTop, BTN_H + 8);
BtnSetAuto := MakeBtn(PanelLeft, 'SET AUTOSTART', PAD, ButtonsTop, 154, BTN_H, @BtnSetAutoClick);
LblHint := MakeLbl(PanelLeft, '* = autostart', PAD + 168, ButtonsTop + 6);
LblHint.Font.Color := CLR_AUTO;
BottomTop := PANEL_H - PAD - BTN_H - 6;
BtnConnect := MakeBtn(PanelLeft, 'CONNECT', PAD, BottomTop, LEFT_W - PAD * 2, BTN_H + 6, @BtnConnectClick);
BtnConnect.ClrText := CLR_ACCENT;
BtnConnect.ClrTextAct := CLR_ACCENT;
// --- Правая панель: discovery ---
PanelRight := TPanel.Create(Self);
PanelRight.Parent := Self;
PanelRight.SetBounds(GAP + LEFT_W + GAP, GAP, RIGHT_W, PANEL_H);
PanelRight.BevelOuter := bvNone;
PanelRight.Color := CLR_PANEL;
MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD);
LstFound := TFlatListBox.Create(Self);
LstFound.Parent := PanelRight;
LstFound.SetBounds(PAD, PAD + LabelH, RIGHT_W - PAD * 2, 250);
LstFound.Color := CLR_BG;
LstFound.Font.Color:= CLR_TEXT;
LstFound.Font.Name := 'Courier New';
LstFound.Font.Size := 8;
LstFound.OnDblClick := @LstFoundDblClick;
ButtonsTop := PAD + LabelH + 250 + 14;
BtnDiscover := MakeBtn(PanelRight, 'DISCOVER', PAD, ButtonsTop, 116, BTN_H, @BtnDiscoverClick);
BtnAddFound := MakeBtn(PanelRight, 'SAVE DEVICE', PAD + 128, ButtonsTop, 140, BTN_H, @BtnAddFoundClick);
BtnCancel := MakeBtn(PanelRight, 'CANCEL', RIGHT_W - PAD - 116, BottomTop, 116, BTN_H + 6, @BtnCancelClick);
end;
procedure TDeviceDialog.ApplyTheme;
begin
SetTheme(DarkTheme);
end;
procedure TDeviceDialog.SetTheme(const T: TAppTheme);
procedure StyleButton(B: TFlatButton; Active: Boolean);
begin
if B = nil then Exit;
B.Active := Active;
B.ClrNorm := T.BtnNorm;
B.ClrActive := T.BtnActive;
B.ClrHot := T.BtnHot;
if Active then B.ClrBorder := T.BtnBorderActive
else B.ClrBorder := T.BtnBorderNorm;
B.ClrText := T.BtnText;
B.ClrTextAct := T.BtnTextActive;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Font.Color := T.Text;
B.Invalidate;
end;
procedure StyleDiscoverButton(B: TFlatButton);
begin
if B = nil then Exit;
B.Active := False;
B.ClrNorm := T.TbDiscoverNorm;
B.ClrHot := T.TbDiscoverHot;
B.ClrActive := T.TbDiscoverHot;
B.ClrBorder := T.TbDiscoverBorder;
B.ClrText := T.TbDiscoverText;
B.ClrTextAct := T.TbDiscoverText;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Font.Color := T.TbDiscoverText;
B.Invalidate;
end;
procedure StyleConnectButton(B: TFlatButton);
begin
if B = nil then Exit;
B.Active := False;
B.ClrNorm := T.TbStartNorm;
B.ClrActive := T.BtnActive;
B.ClrHot := T.BtnHot;
B.ClrBorder := T.TbStartBorder;
B.ClrText := T.TbStartText;
B.ClrTextAct := T.TbStartText;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Font.Color := T.TbStartText;
B.Invalidate;
end;
procedure WalkLabels(C: TWinControl);
var i: Integer; Ctrl: TControl;
begin
for i := 0 to C.ControlCount - 1 do
begin
Ctrl := C.Controls[i];
if Ctrl is TLabel then
TLabel(Ctrl).Font.Color := T.TextDim
else if Ctrl is TWinControl then
WalkLabels(TWinControl(Ctrl));
end;
end;
begin
Color := T.BG;
Font.Color := T.Text;
if PanelLeft <> nil then PanelLeft.Color := T.Panel;
if PanelRight <> nil then PanelRight.Color := T.Panel;
if LstSaved <> nil then LstSaved.SetAppTheme(T);
if LstFound <> nil then LstFound.SetAppTheme(T);
StyleButton(BtnAdd, False);
StyleButton(BtnRemove, False);
StyleButton(BtnSetAuto, False);
StyleDiscoverButton(BtnDiscover);
StyleButton(BtnAddFound, False);
StyleButton(BtnCancel, False);
StyleConnectButton(BtnConnect);
if EdName <> nil then EdName.SetAppTheme(T);
if EdIP <> nil then EdIP.SetAppTheme(T);
WalkLabels(Self);
Invalidate;
end;
procedure TDeviceDialog.RefreshSavedList;
var
I: Integer;
begin
LstSaved.Items.Clear;
if FStore = nil then Exit;
for I := 0 to FStore.SavedCount - 1 do
LstSaved.Items.Add(FStore.SavedDisplay(I));
end;
procedure TDeviceDialog.LstSavedClick(Sender: TObject);
var
Idx: Integer;
Dev: TSavedDevice;
begin
Idx := LstSaved.ItemIndex;
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.SavedCount) then Exit;
Dev := FStore.Saved(Idx);
EdName.Text := Dev.Name;
EdIP.Text := Dev.IPAddress;
end;
procedure TDeviceDialog.LstSavedDblClick(Sender: TObject);
begin
BtnConnectClick(nil);
end;
procedure TDeviceDialog.LstFoundDblClick(Sender: TObject);
begin
BtnConnectClick(nil);
end;
procedure TDeviceDialog.BtnDiscoverClick(Sender: TObject);
begin
LstFound.Items.Clear;
LstFound.Items.Add('Searching...');
if Assigned(FOnDiscover) then
FOnDiscover(Self);
end;
procedure TDeviceDialog.ClearDiscovered;
begin
if FStore <> nil then FStore.ClearDiscovered;
LstFound.Items.Clear;
end;
procedure TDeviceDialog.RefreshFound;
// Рендер списка найденных из store. Пустой store во время поиска → 'Searching...'.
var
I: Integer;
S: string;
D: TDiscoveredDevice;
begin
if FStore = nil then Exit;
LstFound.Items.Clear;
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
ClearDiscovered;
LstFound.Items.Add('-- no device found --');
end;
procedure TDeviceDialog.BtnAddClick(Sender: TObject);
var
Idx: Integer;
begin
if FStore = nil then Exit;
if Trim(EdIP.Text) = '' then
begin
ShowMessage('Enter IP address');
Exit;
end;
Idx := FStore.AddSaved(EdName.Text, EdIP.Text, 0);
RefreshSavedList;
LstSaved.ItemIndex := Idx;
end;
procedure TDeviceDialog.BtnRemoveClick(Sender: TObject);
var
Idx: Integer;
begin
Idx := LstSaved.ItemIndex;
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.SavedCount) then Exit;
FStore.RemoveSaved(Idx);
RefreshSavedList;
EdName.Text := '';
EdIP.Text := '';
end;
procedure TDeviceDialog.BtnSetAutoClick(Sender: TObject);
var
Idx: Integer;
begin
Idx := LstSaved.ItemIndex;
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.SavedCount) then
begin
ShowMessage('Select a device first');
Exit;
end;
FStore.SetAutoStart(Idx);
RefreshSavedList;
LstSaved.ItemIndex := Idx;
end;
procedure TDeviceDialog.BtnAddFoundClick(Sender: TObject);
var
Idx, NewIdx: Integer;
D: TDiscoveredDevice;
begin
Idx := LstFound.ItemIndex;
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.DiscoveredCount) then
begin
ShowMessage('Select a discovered device first');
Exit;
end;
D := FStore.Discovered(Idx);
// Pluto сохраняем с Kind/URI/Serial (иначе после перезапуска резолвится как
// HPSDR по голому IP и не подключается).
if D.Kind = bkPluto then
NewIdx := FStore.AddSavedPluto('PlutoSDR', D.URI, D.Serial)
else
NewIdx := FStore.AddSaved(D.DisplayName, D.IPAddress, D.BoardType);
RefreshSavedList;
LstSaved.ItemIndex := NewIdx;
end;
procedure TDeviceDialog.BtnConnectClick(Sender: TObject);
var
IP: string;
Idx: Integer;
begin
IP := '';
if FStore = nil then Exit;
// Приоритет: выбранное сохранённое > выбранное найденное > ручной IP
Idx := LstSaved.ItemIndex;
if (Idx >= 0) and (Idx < FStore.SavedCount) then
begin
IP := FStore.Saved(Idx).IPAddress;
FResult.SavedIdx := Idx;
end
else
begin
Idx := LstFound.ItemIndex;
if (Idx >= 0) and (Idx < FStore.DiscoveredCount) then
begin
IP := FStore.Discovered(Idx).IPAddress;
FResult.SavedIdx := -1;
end
else if Trim(EdIP.Text) <> '' then
begin
IP := Trim(EdIP.Text);
FResult.SavedIdx := -1;
end;
end;
if IP = '' then
begin
ShowMessage('Select or enter a device to connect');
Exit;
end;
FResult.Accepted := True;
FResult.IPAddress := IP;
ModalResult := mrOk;
end;
procedure TDeviceDialog.BtnCancelClick(Sender: TObject);
begin
FResult.Accepted := False;
ModalResult := mrCancel;
end;
function TDeviceDialog.ManualIP: string;
begin
if EdIP <> nil then Result := Trim(EdIP.Text) else Result := '';
end;
procedure TDeviceDialog.ClearResult;
begin
FResult.Accepted := False;
FResult.IPAddress := '';
FResult.SavedIdx := -1;
end;
function TDeviceDialog.GetAutoStartIP: string;
begin
if FStore <> nil then Result := FStore.AutoStartIP
else Result := '';
end;
function TDeviceDialog.GetAutoStartBoardType: Integer;
begin
if FStore <> nil then Result := FStore.AutoStartBoardType
else Result := 0;
end;
function TDeviceDialog.GetSavedBoardType(Idx: Integer): Integer;
begin
if FStore <> nil then Result := FStore.SavedBoardType(Idx)
else Result := 0;
end;
end.