mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
feat(dxcluster): споты DX-кластера на панадаптере
Telnet-клиент DX-кластера, база спотов и подписи позывных прямо на спектре на своих частотах. Разложено на три слоя, как бэндплан и лупа маяка. DXClusterClient.pas — один рабочий поток: резолв, неблокирующий connect с select квантами по 200 мс (Stop не ждёт таймаут соединения), логин позывным, чтение строк, реконнект с backoff. Приглашения логина И пароля ловятся в незавершённом хвосте буфера — типичный telnet-prompt приходит без CR/LF. Ошибки recv отличаются от таймаута кванта (EAGAIN/EINTR/WSAETIMEDOUT), иначе на ECONNRESET поток крутился бы в пустом цикле вместо реконнекта. Отправка дописывает частичный send. LCL-free. DXSpotStore.pas — потокобезопасная база: дедуп по позывному, TTL, потолок записей, монотонный Version. Единственная точка обмена потока с UI: никакого Synchronize, UI сам замечает правки по Version, как оверлеи — по ключам кэша. DXSpotOverlay.pas — рендер по модели BandPlanOverlay/VfoOverlay: кэшируется только полоса подписей (W × BandH) в key-color битмап, пересборка строго по dirty-ключу, на кадр — один keyed-композит. Штрихи от полосы до низа спектра рисует вызывающая сторона теми же примитивами, что и прочие маркеры: CPU — RawVLine внутри RawBegin/RawEnd, GL — DrawLine по готовому списку X/цвет. GL берёт тот же битмап текстурой и заливает её только при смене RenderVersion. Пересекающиеся подписи раскладываются лесенкой, цвет гаснет с возрастом, свой позывной выделен; палитра парная под тёмную и светлую тему. DXClusterForm.pas — окно списка: споты, лог соединения, строка команды кластеру (диалект set/filter у всех свой — не угадываем). Двойной клик или Enter = QSY. Данные тянутся поллингом по Version/LogVersion. Интеграция: кнопка DX в тулбаре (ЛКМ — подписи на спектре, ПКМ — окно), клик по подписи спота = QSY с автовыбором моды по комментарию кластера, страница SETUP → DX Cluster с персистом в секции "dxcluster". Правки SETUP прилетают посимвольно, поэтому запись конфига, TTL стора и переподключение откладываются до паузы в наборе — иначе набор позывного стоил бы шесть реконнектов, а промежуточный TTL «3» необратимо выбросил бы споты. Частота спота кладётся как есть и сравнивается с GetViewWindow: на QO-100 кластеры постят downlink 10489.xxx, что совпадает со шкалой пана само собой. Побочно в общих юнитах: WebUtils.SockSetRcvTimeout, FlatMemo.OnChange, FlatListBox.OnKeyDown, BlendBitmapKey вынесен в interface VfoOverlay (одна копия дворд-блендера на проект). Проверено на локальном фейковом кластере: логин и пароль по prompt без CR/LF, разбор спотов (включая QO-100), уход в RETRY по RST, Stop за 200 мс на висящем connect. На железе рендер не проверялся. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
@@ -0,0 +1,459 @@
|
||||
unit DXClusterForm;
|
||||
|
||||
{
|
||||
TDXClusterForm — окно DX-кластера: список принятых спотов, лог соединения и
|
||||
строка команды в кластер (sh/dx, set/filter — диалект у каждого кластера свой,
|
||||
поэтому команды не угадываем, а даём отправить руками).
|
||||
|
||||
Данные тянутся ПОЛЛИНГОМ: сетевой поток кладёт споты в TDXSpotStore и строки в
|
||||
лог клиента, а форма раз в секунду сравнивает Version/LogVersion и перечитывает
|
||||
только при изменении. Никакого Synchronize из потока в UI — та же схема, что у
|
||||
оверлея спектра.
|
||||
|
||||
Двойной клик по споту (или Enter) — QSY: наружу через OnTuneSpot.
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math,
|
||||
Forms, Controls, Graphics, StdCtrls, ExtCtrls,
|
||||
FlatButton, FlatEdit, FlatListBox, FlatMemo,
|
||||
AppTheme, DpiUtils, DXSpotStore, DXClusterClient;
|
||||
|
||||
type
|
||||
// QSY по споту: частота в display-Гц + мода (dxmUnknown — не трогать моду).
|
||||
TDXTuneEvent = procedure(FreqHz: Double; Mode: TDXMode) of object;
|
||||
|
||||
TDXClusterForm = class(TForm)
|
||||
private
|
||||
FStore: TDXSpotStore; // не владеет
|
||||
FClient: TDXClusterClient; // не владеет
|
||||
FTheme: TAppTheme;
|
||||
|
||||
FTitle: TLabel;
|
||||
FStatus: TLabel;
|
||||
FBtnConn: TFlatButton;
|
||||
FBtnClear: TFlatButton;
|
||||
FBtnSort: TFlatButton;
|
||||
FBtnClose: TFlatButton;
|
||||
FList: TFlatListBox;
|
||||
FLog: TFlatMemo;
|
||||
FEdCmd: TFlatEdit;
|
||||
FBtnSend: TFlatButton;
|
||||
FTimer: TTimer;
|
||||
|
||||
FSpots: TDXSpotArray; // снимок, параллельный строкам FList
|
||||
FSortFreq: Boolean; // False = по времени (свежие сверху)
|
||||
FLastVer: Int64;
|
||||
FLastLogVer: Int64;
|
||||
FOnTune: TDXTuneEvent;
|
||||
|
||||
procedure BuildUI;
|
||||
procedure StyleBtn(B: TFlatButton);
|
||||
function FormatSpotLine(const S: TDXSpot): string;
|
||||
procedure RefreshSpots;
|
||||
procedure RefreshLog;
|
||||
procedure RefreshStatus;
|
||||
procedure TuneSelected;
|
||||
|
||||
procedure OnTimerTick(Sender: TObject);
|
||||
procedure OnConnClick(Sender: TObject);
|
||||
procedure OnClearClick(Sender: TObject);
|
||||
procedure OnSortClick(Sender: TObject);
|
||||
procedure OnCloseClick(Sender: TObject);
|
||||
procedure OnSendClick(Sender: TObject);
|
||||
procedure OnListDblClick(Sender: TObject);
|
||||
procedure OnListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure OnCmdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
protected
|
||||
procedure DoShow; override;
|
||||
procedure DoHide; override;
|
||||
public
|
||||
constructor CreateWith(AOwner: TComponent; AStore: TDXSpotStore;
|
||||
AClient: TDXClusterClient); reintroduce;
|
||||
procedure ApplyTheme(const T: TAppTheme);
|
||||
property OnTuneSpot: TDXTuneEvent read FOnTune write FOnTune;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
FORM_W = 860;
|
||||
FORM_H = 560;
|
||||
MARGIN = 12;
|
||||
BTN_H = 26;
|
||||
LOG_H = 130;
|
||||
|
||||
constructor TDXClusterForm.CreateWith(AOwner: TComponent; AStore: TDXSpotStore;
|
||||
AClient: TDXClusterClient);
|
||||
var
|
||||
WorkArea: TRect;
|
||||
begin
|
||||
inherited CreateNew(AOwner);
|
||||
FStore := AStore;
|
||||
FClient := AClient;
|
||||
FTheme := DarkTheme;
|
||||
FSortFreq := False;
|
||||
FLastVer := -1;
|
||||
FLastLogVer := -1;
|
||||
|
||||
Scaled := False;
|
||||
Caption := 'DX Cluster';
|
||||
BorderStyle := bsSizeable;
|
||||
if AOwner is TCustomForm then
|
||||
begin
|
||||
WorkArea := Screen.MonitorFromRect(TCustomForm(AOwner).BoundsRect).WorkareaRect;
|
||||
Position := poOwnerFormCenter;
|
||||
end
|
||||
else
|
||||
begin
|
||||
WorkArea := Screen.PrimaryMonitor.WorkareaRect;
|
||||
Position := poScreenCenter;
|
||||
end;
|
||||
Width := Min(DpiScale(FORM_W), WorkArea.Right - WorkArea.Left - DpiScale(48));
|
||||
Height := Min(DpiScale(FORM_H), WorkArea.Bottom - WorkArea.Top - DpiScale(48));
|
||||
Constraints.MinWidth := Min(DpiScale(620), Width);
|
||||
Constraints.MinHeight := Min(DpiScale(380), Height);
|
||||
OnClose := @OnFormClose;
|
||||
|
||||
BuildUI;
|
||||
ApplyTheme(DarkTheme);
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.BuildUI;
|
||||
var
|
||||
BtnW, Y: Integer;
|
||||
begin
|
||||
BtnW := DpiScale(96);
|
||||
|
||||
FTitle := TLabel.Create(Self);
|
||||
FTitle.Parent := Self;
|
||||
FTitle.SetBounds(DpiScale(MARGIN), DpiScale(10), DpiScale(300), DpiScale(22));
|
||||
FTitle.Caption := 'DX CLUSTER';
|
||||
FTitle.Font.Size := 9;
|
||||
FTitle.Font.Style := [fsBold];
|
||||
|
||||
FStatus := TLabel.Create(Self);
|
||||
FStatus.Parent := Self;
|
||||
FStatus.SetBounds(DpiScale(MARGIN), DpiScale(31), DpiScale(520), DpiScale(18));
|
||||
FStatus.Font.Size := 8;
|
||||
FStatus.Anchors := [akLeft, akTop, akRight];
|
||||
|
||||
Y := DpiScale(10);
|
||||
FBtnClose := TFlatButton.Create(Self);
|
||||
FBtnClose.Parent := Self;
|
||||
FBtnClose.SetBounds(ClientWidth - DpiScale(MARGIN) - BtnW, Y, BtnW, DpiScale(BTN_H));
|
||||
FBtnClose.Caption := 'Close';
|
||||
FBtnClose.Anchors := [akTop, akRight];
|
||||
FBtnClose.OnClick := @OnCloseClick;
|
||||
|
||||
FBtnSort := TFlatButton.Create(Self);
|
||||
FBtnSort.Parent := Self;
|
||||
FBtnSort.SetBounds(FBtnClose.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
|
||||
FBtnSort.Caption := 'BY TIME';
|
||||
FBtnSort.Anchors := [akTop, akRight];
|
||||
FBtnSort.OnClick := @OnSortClick;
|
||||
|
||||
FBtnClear := TFlatButton.Create(Self);
|
||||
FBtnClear.Parent := Self;
|
||||
FBtnClear.SetBounds(FBtnSort.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
|
||||
FBtnClear.Caption := 'CLEAR';
|
||||
FBtnClear.Anchors := [akTop, akRight];
|
||||
FBtnClear.OnClick := @OnClearClick;
|
||||
|
||||
FBtnConn := TFlatButton.Create(Self);
|
||||
FBtnConn.Parent := Self;
|
||||
FBtnConn.SetBounds(FBtnClear.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
|
||||
FBtnConn.Caption := 'CONNECT';
|
||||
FBtnConn.Anchors := [akTop, akRight];
|
||||
FBtnConn.OnClick := @OnConnClick;
|
||||
|
||||
// Строка команды — внизу, над логом.
|
||||
FBtnSend := TFlatButton.Create(Self);
|
||||
FBtnSend.Parent := Self;
|
||||
FBtnSend.SetBounds(ClientWidth - DpiScale(MARGIN) - BtnW,
|
||||
ClientHeight - DpiScale(MARGIN + BTN_H), BtnW, DpiScale(BTN_H));
|
||||
FBtnSend.Caption := 'SEND';
|
||||
FBtnSend.Anchors := [akRight, akBottom];
|
||||
FBtnSend.OnClick := @OnSendClick;
|
||||
|
||||
FEdCmd := TFlatEdit.Create(Self);
|
||||
FEdCmd.Parent := Self;
|
||||
FEdCmd.SetBounds(DpiScale(MARGIN), ClientHeight - DpiScale(MARGIN + BTN_H),
|
||||
FBtnSend.Left - DpiScale(MARGIN + 6), DpiScale(BTN_H));
|
||||
FEdCmd.TextHint := 'command to cluster (sh/dx, set/filter …)';
|
||||
FEdCmd.Anchors := [akLeft, akRight, akBottom];
|
||||
FEdCmd.OnKeyDown := @OnCmdKeyDown;
|
||||
|
||||
FLog := TFlatMemo.Create(Self);
|
||||
FLog.Parent := Self;
|
||||
FLog.SetBounds(DpiScale(MARGIN),
|
||||
FEdCmd.Top - DpiScale(LOG_H + 6),
|
||||
ClientWidth - DpiScale(MARGIN * 2), DpiScale(LOG_H));
|
||||
FLog.Anchors := [akLeft, akRight, akBottom];
|
||||
FLog.ReadOnly := True;
|
||||
FLog.WordWrap := False;
|
||||
FLog.Font.Name := 'Courier New';
|
||||
FLog.Font.Size := 8;
|
||||
|
||||
FList := TFlatListBox.Create(Self);
|
||||
FList.Parent := Self;
|
||||
FList.SetBounds(DpiScale(MARGIN), DpiScale(56),
|
||||
ClientWidth - DpiScale(MARGIN * 2),
|
||||
FLog.Top - DpiScale(56 + 6));
|
||||
FList.Anchors := [akLeft, akTop, akRight, akBottom];
|
||||
FList.Font.Name := 'Courier New';
|
||||
FList.Font.Size := 9;
|
||||
FList.TabStop := True;
|
||||
FList.OnDblClick := @OnListDblClick;
|
||||
FList.OnKeyDown := @OnListKeyDown;
|
||||
|
||||
FTimer := TTimer.Create(Self);
|
||||
FTimer.Interval := 1000;
|
||||
FTimer.Enabled := False;
|
||||
FTimer.OnTimer := @OnTimerTick;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.StyleBtn(B: TFlatButton);
|
||||
begin
|
||||
// TFlatButton темы не знает — цвета выставляются вручную, как в ChannelsForm.
|
||||
if B = nil then Exit;
|
||||
B.Font.Assign(Font);
|
||||
B.Font.Size := 8;
|
||||
B.Font.Style := [];
|
||||
B.ClrNorm := FTheme.BtnNorm;
|
||||
B.ClrActive := FTheme.BtnActive;
|
||||
B.ClrHot := FTheme.BtnHot;
|
||||
B.ClrBorder := FTheme.BtnBorderNorm;
|
||||
B.ClrText := FTheme.BtnText;
|
||||
B.ClrTextAct := FTheme.BtnTextActive;
|
||||
B.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.ApplyTheme(const T: TAppTheme);
|
||||
begin
|
||||
FTheme := T;
|
||||
Color := T.BG;
|
||||
FTitle.Font.Color := T.Text;
|
||||
FStatus.Font.Color := T.TextDim;
|
||||
FList.SetAppTheme(T);
|
||||
FLog.SetAppTheme(T);
|
||||
FEdCmd.SetAppTheme(T);
|
||||
StyleBtn(FBtnConn);
|
||||
StyleBtn(FBtnClear);
|
||||
StyleBtn(FBtnSort);
|
||||
StyleBtn(FBtnClose);
|
||||
StyleBtn(FBtnSend);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
{ ── Наполнение ───────────────────────────────────────────────────────────── }
|
||||
|
||||
function TDXClusterForm.FormatSpotLine(const S: TDXSpot): string;
|
||||
// Моноширинные колонки: частота | позывной | мода | UTC | спотер | комментарий.
|
||||
var
|
||||
FreqStr, Md: string;
|
||||
begin
|
||||
FreqStr := FormatFloat('0.0', S.FreqHz / 1000.0); // кГц, как в кластере
|
||||
while Length(FreqStr) < 10 do FreqStr := ' ' + FreqStr;
|
||||
Md := DXModeName(S.Mode);
|
||||
while Length(Md) < 4 do Md := Md + ' ';
|
||||
Result := Format('%s %-12s %s %-5s %-10s %s',
|
||||
[FreqStr, S.Call, Md, S.TimeUTC, S.Spotter, S.Comment]);
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.RefreshSpots;
|
||||
var
|
||||
i, j, Keep: Integer;
|
||||
T: TDXSpot;
|
||||
Sel: string;
|
||||
begin
|
||||
if FStore = nil then Exit;
|
||||
Keep := FList.ItemIndex;
|
||||
Sel := '';
|
||||
if (Keep >= 0) and (Keep < Length(FSpots)) then Sel := FSpots[Keep].Call;
|
||||
|
||||
FStore.Snapshot(FSpots); // приходит отсортированным по частоте
|
||||
if not FSortFreq then
|
||||
// по времени, свежие сверху (вставками — список короткий, TTL его держит)
|
||||
for i := 1 to High(FSpots) do
|
||||
begin
|
||||
T := FSpots[i];
|
||||
j := i - 1;
|
||||
while (j >= 0) and (FSpots[j].Stamp < T.Stamp) do
|
||||
begin
|
||||
FSpots[j + 1] := FSpots[j];
|
||||
Dec(j);
|
||||
end;
|
||||
FSpots[j + 1] := T;
|
||||
end;
|
||||
|
||||
FList.Items.BeginUpdate;
|
||||
try
|
||||
FList.Items.Clear;
|
||||
for i := 0 to High(FSpots) do
|
||||
FList.Items.Add(FormatSpotLine(FSpots[i]));
|
||||
finally
|
||||
FList.Items.EndUpdate;
|
||||
end;
|
||||
|
||||
// Держим выделение на том же позывном, если он ещё в списке.
|
||||
if Sel <> '' then
|
||||
for i := 0 to High(FSpots) do
|
||||
if SameText(FSpots[i].Call, Sel) then
|
||||
begin
|
||||
FList.ItemIndex := i;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.RefreshLog;
|
||||
var
|
||||
L: TStringList;
|
||||
begin
|
||||
if FClient = nil then Exit;
|
||||
L := TStringList.Create;
|
||||
try
|
||||
FClient.GetLog(L);
|
||||
FLog.Lines.BeginUpdate;
|
||||
try
|
||||
FLog.Lines.Assign(L);
|
||||
finally
|
||||
FLog.Lines.EndUpdate;
|
||||
end;
|
||||
// прокрутка в конец — свежие строки внизу
|
||||
FLog.SelStart := Length(FLog.Text);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.RefreshStatus;
|
||||
var
|
||||
St: TDXClusterState;
|
||||
S: string;
|
||||
begin
|
||||
if FClient = nil then Exit;
|
||||
St := FClient.State;
|
||||
S := DXStateName(St);
|
||||
if FClient.StatusMessage <> '' then S := S + ' — ' + FClient.StatusMessage;
|
||||
S := S + Format(' | spots stored: %d received this session: %d',
|
||||
[FStore.Count, FClient.SpotsReceived]);
|
||||
FStatus.Caption := S;
|
||||
if FClient.Running then FBtnConn.Caption := 'DISCONNECT'
|
||||
else FBtnConn.Caption := 'CONNECT';
|
||||
end;
|
||||
|
||||
{ ── События ──────────────────────────────────────────────────────────────── }
|
||||
|
||||
procedure TDXClusterForm.OnTimerTick(Sender: TObject);
|
||||
begin
|
||||
if (FStore <> nil) and (FStore.Version <> FLastVer) then
|
||||
begin
|
||||
FLastVer := FStore.Version;
|
||||
RefreshSpots;
|
||||
end;
|
||||
if (FClient <> nil) and (FClient.LogVersion <> FLastLogVer) then
|
||||
begin
|
||||
FLastLogVer := FClient.LogVersion;
|
||||
RefreshLog;
|
||||
RefreshStatus;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnConnClick(Sender: TObject);
|
||||
begin
|
||||
if FClient = nil then Exit;
|
||||
if FClient.Running then FClient.Stop else FClient.Start;
|
||||
RefreshStatus;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnClearClick(Sender: TObject);
|
||||
begin
|
||||
if FStore <> nil then FStore.Clear;
|
||||
FLastVer := -1;
|
||||
RefreshSpots;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnSortClick(Sender: TObject);
|
||||
begin
|
||||
FSortFreq := not FSortFreq;
|
||||
if FSortFreq then FBtnSort.Caption := 'BY FREQ'
|
||||
else FBtnSort.Caption := 'BY TIME';
|
||||
RefreshSpots;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnCloseClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnSendClick(Sender: TObject);
|
||||
begin
|
||||
if (FClient = nil) or (Trim(FEdCmd.Text) = '') then Exit;
|
||||
FClient.SendCommand(Trim(FEdCmd.Text));
|
||||
FEdCmd.Text := '';
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnCmdKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if Key = 13 then
|
||||
begin
|
||||
Key := 0;
|
||||
OnSendClick(nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.TuneSelected;
|
||||
var i: Integer;
|
||||
begin
|
||||
i := FList.ItemIndex;
|
||||
if (i < 0) or (i > High(FSpots)) then Exit;
|
||||
if Assigned(FOnTune) then FOnTune(FSpots[i].FreqHz, FSpots[i].Mode);
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnListDblClick(Sender: TObject);
|
||||
begin
|
||||
TuneSelected;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnListKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
// Enter по выделенной строке = то же, что двойной клик (QSY на спот).
|
||||
begin
|
||||
if (Key = 13) or (Key = 10) then
|
||||
begin
|
||||
Key := 0;
|
||||
TuneSelected;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caHide;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.DoShow;
|
||||
begin
|
||||
inherited DoShow;
|
||||
// Поллинг живёт только пока окно видимо (как анализатор лупы маяка).
|
||||
FLastVer := -1;
|
||||
FLastLogVer := -1;
|
||||
RefreshSpots;
|
||||
RefreshLog;
|
||||
RefreshStatus;
|
||||
FTimer.Enabled := True;
|
||||
end;
|
||||
|
||||
procedure TDXClusterForm.DoHide;
|
||||
begin
|
||||
FTimer.Enabled := False;
|
||||
inherited DoHide;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user