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,883 @@
|
||||
unit DXClusterClient;
|
||||
|
||||
{
|
||||
DXClusterClient.pas — telnet-клиент DX-кластера (одно соединение).
|
||||
|
||||
Один рабочий поток: резолв → connect (неблокирующий + select, чтобы не висеть
|
||||
минуту на мёртвом хосте) → логин позывным → чтение строк. Разобранные споты
|
||||
кладутся ПРЯМО в TDXSpotStore (он потокобезопасен), лог соединения — во
|
||||
внутреннее кольцо. В главный поток ничего не маршалим: UI сам замечает
|
||||
изменения по Version стора и по LogVersion — как оверлеи замечают смену вида
|
||||
по ключам кэша. Никаких LCL-зависимостей.
|
||||
|
||||
Разрыв → реконнект с backoff (RECONNECT_MIN..RECONNECT_MAX). Stop() делает
|
||||
SockShutdown, что разблокирует recv в потоке (на Linux одного close мало —
|
||||
см. WebUtils.SockShutdown).
|
||||
|
||||
Формат спота (общий для DXSpider / AR-Cluster / CC Cluster):
|
||||
DX de UA3XYZ: 14025.0 DL1ABC CW 599 tnx qso 1832Z
|
||||
Всё, что не начинается с 'DX de ', в стор не идёт — только в лог.
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$LONGSTRINGS ON}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, SyncObjs, StrUtils, DateUtils,
|
||||
WebUtils, // SockClose/SockShutdown/SockRecv/SockSend/SOCK_INVALID
|
||||
DXSpotStore
|
||||
{$IFDEF MSWINDOWS}
|
||||
, Windows, WinSock2
|
||||
{$ELSE}
|
||||
, BaseUnix, Sockets, netdb
|
||||
{$ENDIF};
|
||||
|
||||
const
|
||||
DX_DEFAULT_HOST = 'cluster.dxfun.com';
|
||||
DX_DEFAULT_PORT = 8000;
|
||||
DX_CONNECT_MS = 8000; // потолок ожидания connect
|
||||
DX_CONNECT_SLICE_MS = 200; // квант ожидания connect (чтобы Stop не ждал 8 с)
|
||||
DX_RECV_MS = 1000; // квант recv: просыпаемся проверить Terminated/очередь
|
||||
DX_RECONNECT_MIN = 5; // с
|
||||
DX_RECONNECT_MAX = 60; // с
|
||||
DX_LOGIN_GRACE_S = 6; // не увидели приглашение — шлём позывной сами
|
||||
DX_POSTLOGIN_S = 2; // пауза после позывного перед post-login командами
|
||||
DX_LOG_LINES = 300; // кольцо лога соединения
|
||||
DX_SEND_RETRIES = 20; // повторов send по таймауту буфера, потом разрыв
|
||||
|
||||
type
|
||||
TDXClusterState = (dxsOff, dxsConnecting, dxsLogin, dxsOnline, dxsRetry, dxsError);
|
||||
|
||||
TDXClusterClient = class
|
||||
private
|
||||
FThread: TThread;
|
||||
FLock: TCriticalSection; // защищает конфиг, лог, очередь, состояние
|
||||
FStopEvent: TEvent;
|
||||
|
||||
// конфиг (копия под FLock — поток читает её через GetConfig)
|
||||
FHost: string;
|
||||
FPort: Integer;
|
||||
FLogin: string;
|
||||
FPassword: string;
|
||||
FPostLogin: string; // строки через LineEnding
|
||||
|
||||
FStore: TDXSpotStore; // не владеет
|
||||
|
||||
FState: TDXClusterState;
|
||||
FStatusMsg: string;
|
||||
FSpotCount: Int64; // сколько спотов принято за сессию
|
||||
|
||||
FLog: array[0..DX_LOG_LINES-1] of string;
|
||||
FLogHead: Integer; // индекс следующей записи
|
||||
FLogCount: Integer;
|
||||
FLogVer: Int64;
|
||||
|
||||
FOutQueue: TStringList; // строки на отправку в кластер
|
||||
|
||||
procedure SetState(St: TDXClusterState; const Msg: string);
|
||||
public
|
||||
constructor Create(AStore: TDXSpotStore);
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Configure(const AHost: string; APort: Integer;
|
||||
const ALogin, APassword, APostLogin: string);
|
||||
procedure Start;
|
||||
procedure Stop;
|
||||
function Running: Boolean;
|
||||
|
||||
// Отправить сырую строку в кластер (окно списка: sh/dx, set/filter, …).
|
||||
procedure SendCommand(const S: string);
|
||||
|
||||
// Лог соединения — снимок в порядке приёма (старые → новые).
|
||||
procedure GetLog(Dst: TStrings);
|
||||
function LogVersion: Int64;
|
||||
procedure AddLog(const S: string);
|
||||
|
||||
function State: TDXClusterState;
|
||||
function StateText: string;
|
||||
function StatusMessage: string;
|
||||
function SpotsReceived: Int64;
|
||||
|
||||
property Store: TDXSpotStore read FStore;
|
||||
end;
|
||||
|
||||
// Разбор строки кластера. True — это спот (Spot заполнен).
|
||||
function ParseDXSpot(const Line: string; out Spot: TDXSpot): Boolean;
|
||||
function DXStateName(St: TDXClusterState): string;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TDXClusterThread = class(TThread)
|
||||
private
|
||||
FOwner: TDXClusterClient;
|
||||
FSocket: TSocket;
|
||||
FRxBuf: string; // хвост неполной строки
|
||||
|
||||
// конфиг сессии (снимок на время соединения)
|
||||
FHost: string;
|
||||
FPort: Integer;
|
||||
FLogin: string;
|
||||
FPassword: string;
|
||||
FPostLogin: string;
|
||||
|
||||
FLoginSent: Boolean;
|
||||
FPassSent: Boolean;
|
||||
FPostSent: Boolean;
|
||||
FLoginAt: TDateTime;
|
||||
FConnectAt: TDateTime;
|
||||
|
||||
function Resolve(const Host: string; out Addr: LongWord): Boolean;
|
||||
function ConnectSock: Boolean;
|
||||
procedure CloseSock;
|
||||
function SendAll(const Data: string): Boolean;
|
||||
function SendLine(const S: string): Boolean;
|
||||
procedure FlushOutQueue;
|
||||
procedure HandleChunk(const Data: string);
|
||||
procedure HandleLine(const Line: string);
|
||||
procedure CheckPrompts(const Tail: string);
|
||||
function Session: Boolean; // одно соединение; False — выйти совсем
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(AOwner: TDXClusterClient);
|
||||
end;
|
||||
|
||||
function DXStateName(St: TDXClusterState): string;
|
||||
begin
|
||||
case St of
|
||||
dxsOff: Result := 'OFF';
|
||||
dxsConnecting: Result := 'CONNECTING';
|
||||
dxsLogin: Result := 'LOGIN';
|
||||
dxsOnline: Result := 'ONLINE';
|
||||
dxsRetry: Result := 'RETRY';
|
||||
else Result := 'ERROR';
|
||||
end;
|
||||
end;
|
||||
|
||||
function SockWouldBlock: Boolean;
|
||||
// Последняя ошибка сокета означает «данных пока нет / истёк SO_RCVTIMEO /
|
||||
// прерван сигналом» — соединение живо. Всё остальное (ECONNRESET, ENOTCONN,
|
||||
// EPIPE…) — разрыв: без этой проверки поток крутил бы recv в пустом цикле,
|
||||
// вместо того чтобы уйти на реконнект.
|
||||
var E: Integer;
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
E := WSAGetLastError;
|
||||
Result := (E = WSAEWOULDBLOCK) or (E = WSAETIMEDOUT) or (E = WSAEINTR);
|
||||
{$ELSE}
|
||||
E := fpgeterrno;
|
||||
Result := (E = ESysEAGAIN) or (E = ESysEWOULDBLOCK) or (E = ESysEINTR);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{ ── Разбор строки спота ──────────────────────────────────────────────────── }
|
||||
|
||||
function ParseDXSpot(const Line: string; out Spot: TDXSpot): Boolean;
|
||||
// 'DX de <spotter>: <кГц> <позывной> <комментарий> <HHMM>Z [грид]'
|
||||
var
|
||||
S, Rest, FreqStr, TimeTok: string;
|
||||
P, i: Integer;
|
||||
KHz: Double;
|
||||
FS: TFormatSettings;
|
||||
begin
|
||||
Result := False;
|
||||
FillChar(Spot, SizeOf(Spot), 0);
|
||||
Spot.Call := ''; Spot.Spotter := ''; Spot.Comment := ''; Spot.TimeUTC := '';
|
||||
|
||||
S := Trim(Line);
|
||||
if Length(S) < 12 then Exit;
|
||||
if not SameText(Copy(S, 1, 6), 'DX de ') then Exit;
|
||||
|
||||
Rest := Copy(S, 7, MaxInt);
|
||||
P := Pos(':', Rest);
|
||||
if P <= 1 then Exit;
|
||||
Spot.Spotter := Trim(Copy(Rest, 1, P - 1));
|
||||
Rest := Trim(Copy(Rest, P + 1, MaxInt));
|
||||
|
||||
// частота (кГц) — первый токен
|
||||
P := Pos(' ', Rest);
|
||||
if P <= 1 then Exit;
|
||||
FreqStr := Copy(Rest, 1, P - 1);
|
||||
Rest := TrimLeft(Copy(Rest, P + 1, MaxInt));
|
||||
|
||||
FS := DefaultFormatSettings;
|
||||
FS.DecimalSeparator := '.';
|
||||
FreqStr := StringReplace(FreqStr, ',', '.', [rfReplaceAll]);
|
||||
if not TryStrToFloat(FreqStr, KHz, FS) then Exit;
|
||||
if (KHz <= 0) or (KHz > 100000000.0) then Exit; // мусор/битая строка
|
||||
Spot.FreqHz := KHz * 1000.0;
|
||||
|
||||
// позывной DX — второй токен
|
||||
P := Pos(' ', Rest);
|
||||
if P > 0 then
|
||||
begin
|
||||
Spot.Call := Copy(Rest, 1, P - 1);
|
||||
Rest := TrimLeft(Copy(Rest, P + 1, MaxInt));
|
||||
end
|
||||
else
|
||||
begin
|
||||
Spot.Call := Rest;
|
||||
Rest := '';
|
||||
end;
|
||||
if Spot.Call = '' then Exit;
|
||||
|
||||
// Время: последний токен вида HHMMZ. Всё до него — комментарий, всё после
|
||||
// (обычно грид спотера) приклеиваем к комментарию — терять жалко.
|
||||
Rest := TrimRight(Rest);
|
||||
P := 0;
|
||||
for i := Length(Rest) - 4 downto 1 do
|
||||
if (Rest[i] in ['0'..'9']) and (Rest[i+1] in ['0'..'9']) and
|
||||
(Rest[i+2] in ['0'..'9']) and (Rest[i+3] in ['0'..'9']) and
|
||||
(UpCase(Rest[i+4]) = 'Z') and
|
||||
((i = 1) or (Rest[i-1] = ' ')) then
|
||||
begin
|
||||
P := i;
|
||||
Break;
|
||||
end;
|
||||
if P > 0 then
|
||||
begin
|
||||
TimeTok := Copy(Rest, P, 4);
|
||||
Spot.TimeUTC := TimeTok;
|
||||
Spot.Comment := Trim(Copy(Rest, 1, P - 1));
|
||||
Rest := Trim(Copy(Rest, P + 5, MaxInt));
|
||||
if Rest <> '' then Spot.Comment := Trim(Spot.Comment + ' ' + Rest);
|
||||
end
|
||||
else
|
||||
Spot.Comment := Trim(Rest);
|
||||
|
||||
Spot.Mode := DXModeFromComment(Spot.Comment);
|
||||
Spot.Stamp := Now;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{ ── TDXClusterClient ─────────────────────────────────────────────────────── }
|
||||
|
||||
constructor TDXClusterClient.Create(AStore: TDXSpotStore);
|
||||
{$IFDEF MSWINDOWS}
|
||||
var wsa: TWSAData;
|
||||
{$ENDIF}
|
||||
begin
|
||||
inherited Create;
|
||||
FStore := AStore;
|
||||
FLock := TCriticalSection.Create;
|
||||
FStopEvent := TEvent.Create(nil, True, False, '');
|
||||
FOutQueue := TStringList.Create;
|
||||
FHost := DX_DEFAULT_HOST;
|
||||
FPort := DX_DEFAULT_PORT;
|
||||
FState := dxsOff;
|
||||
FLogHead := 0;
|
||||
FLogCount := 0;
|
||||
FLogVer := 0;
|
||||
FSpotCount := 0;
|
||||
{$IFDEF MSWINDOWS}
|
||||
WSAStartup($0202, wsa);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
destructor TDXClusterClient.Destroy;
|
||||
begin
|
||||
Stop;
|
||||
FOutQueue.Free;
|
||||
FStopEvent.Free;
|
||||
FLock.Free;
|
||||
{$IFDEF MSWINDOWS}
|
||||
WSACleanup;
|
||||
{$ENDIF}
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDXClusterClient.Configure(const AHost: string; APort: Integer;
|
||||
const ALogin, APassword, APostLogin: string);
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
// Смена адреса/учётки — команды, набранные для ПРЕЖНЕГО кластера, теряют
|
||||
// смысл (и ушли бы на новый). Чистим очередь.
|
||||
if (FHost <> Trim(AHost)) or (FPort <> APort) or (FLogin <> Trim(ALogin)) then
|
||||
FOutQueue.Clear;
|
||||
FHost := Trim(AHost);
|
||||
FPort := APort;
|
||||
FLogin := Trim(ALogin);
|
||||
FPassword := APassword;
|
||||
FPostLogin := APostLogin;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterClient.Start;
|
||||
begin
|
||||
if FThread <> nil then Exit;
|
||||
FLock.Enter;
|
||||
try
|
||||
if (FHost = '') or (FLogin = '') then
|
||||
begin
|
||||
FState := dxsError;
|
||||
FStatusMsg := 'host or callsign not set';
|
||||
Exit;
|
||||
end;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
FStopEvent.ResetEvent;
|
||||
SetState(dxsConnecting, '');
|
||||
FThread := TDXClusterThread.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TDXClusterClient.Stop;
|
||||
var T: TThread;
|
||||
begin
|
||||
// Всё, что не успели отправить, к следующему соединению уже неактуально.
|
||||
FLock.Enter;
|
||||
try
|
||||
FOutQueue.Clear;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
|
||||
T := FThread;
|
||||
if T = nil then
|
||||
begin
|
||||
SetState(dxsOff, '');
|
||||
Exit;
|
||||
end;
|
||||
FThread := nil;
|
||||
T.Terminate;
|
||||
FStopEvent.SetEvent;
|
||||
// Сокет закрывает сам поток (TDXClusterThread.CloseSock из Execute);
|
||||
// FStopEvent + Terminate выводят его из ожиданий, а recv рвётся по таймауту.
|
||||
T.WaitFor;
|
||||
T.Free;
|
||||
SetState(dxsOff, '');
|
||||
end;
|
||||
|
||||
function TDXClusterClient.Running: Boolean;
|
||||
begin
|
||||
Result := FThread <> nil;
|
||||
end;
|
||||
|
||||
procedure TDXClusterClient.SetState(St: TDXClusterState; const Msg: string);
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
FState := St;
|
||||
FStatusMsg := Msg;
|
||||
Inc(FLogVer); // UI перечитает и статус тоже
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXClusterClient.State: TDXClusterState;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FState;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXClusterClient.StateText: string;
|
||||
begin
|
||||
Result := DXStateName(State);
|
||||
end;
|
||||
|
||||
function TDXClusterClient.StatusMessage: string;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FStatusMsg;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXClusterClient.SpotsReceived: Int64;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FSpotCount;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterClient.SendCommand(const S: string);
|
||||
begin
|
||||
if Trim(S) = '' then Exit;
|
||||
FLock.Enter;
|
||||
try
|
||||
FOutQueue.Add(S);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterClient.AddLog(const S: string);
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
FLog[FLogHead] := S;
|
||||
FLogHead := (FLogHead + 1) mod DX_LOG_LINES;
|
||||
if FLogCount < DX_LOG_LINES then Inc(FLogCount);
|
||||
Inc(FLogVer);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterClient.GetLog(Dst: TStrings);
|
||||
var i, Start: Integer;
|
||||
begin
|
||||
if Dst = nil then Exit;
|
||||
FLock.Enter;
|
||||
try
|
||||
Start := (FLogHead - FLogCount + DX_LOG_LINES) mod DX_LOG_LINES;
|
||||
for i := 0 to FLogCount - 1 do
|
||||
Dst.Add(FLog[(Start + i) mod DX_LOG_LINES]);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXClusterClient.LogVersion: Int64;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FLogVer;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ── TDXClusterThread ─────────────────────────────────────────────────────── }
|
||||
|
||||
constructor TDXClusterThread.Create(AOwner: TDXClusterClient);
|
||||
begin
|
||||
FOwner := AOwner;
|
||||
FSocket := SOCK_INVALID;
|
||||
FreeOnTerminate := False;
|
||||
inherited Create(False);
|
||||
end;
|
||||
|
||||
function TDXClusterThread.Resolve(const Host: string; out Addr: LongWord): Boolean;
|
||||
// Возвращает адрес в СЕТЕВОМ порядке байт (готов для sin_addr).
|
||||
{$IFNDEF MSWINDOWS}
|
||||
var HE: THostEntry; HA: THostAddr;
|
||||
{$ELSE}
|
||||
var PH: PHostEnt; L: LongWord;
|
||||
{$ENDIF}
|
||||
begin
|
||||
Result := False;
|
||||
Addr := 0;
|
||||
if Host = '' then Exit;
|
||||
{$IFDEF MSWINDOWS}
|
||||
L := inet_addr(PChar(Host));
|
||||
if L <> INADDR_NONE then // литеральный IP (уже в сетевом порядке)
|
||||
begin
|
||||
Addr := L;
|
||||
Exit(True);
|
||||
end;
|
||||
PH := gethostbyname(PChar(Host));
|
||||
if (PH = nil) or (PH^.h_addr_list = nil) or (PH^.h_addr_list^ = nil) then Exit;
|
||||
Move(PH^.h_addr_list^^, Addr, 4); // hostent отдаёт сетевой порядок
|
||||
Result := True;
|
||||
{$ELSE}
|
||||
// Литеральный IP: TryStrToHostAddr отдаёт ХОСТОВЫЙ порядок — разворачиваем.
|
||||
if TryStrToHostAddr(Host, HA) then
|
||||
begin
|
||||
Addr := htonl(HA.s_addr);
|
||||
Exit(True);
|
||||
end;
|
||||
// DNS (netdb читает /etc/resolv.conf и /etc/hosts). Здесь адрес приходит
|
||||
// прямо из DNS-ответа, т.е. УЖЕ в сетевом порядке — второй раз не вертим.
|
||||
if ResolveHostByName(Host, HE) then
|
||||
begin
|
||||
Addr := HE.Addr.s_addr;
|
||||
Exit(True);
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TDXClusterThread.ConnectSock: Boolean;
|
||||
// Неблокирующий connect + select: мёртвый хост не держит поток минуту на
|
||||
// системном таймауте TCP, и Stop() отрабатывает быстро.
|
||||
var
|
||||
Addr: {$IFDEF MSWINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
|
||||
IP: LongWord;
|
||||
R, SoErr: Integer;
|
||||
FDS: TFDSet;
|
||||
TV: TTimeVal;
|
||||
One, Waited: Integer;
|
||||
{$IFDEF MSWINDOWS}ErrLen: Integer;{$ELSE}ErrLen: TSockLen;{$ENDIF}
|
||||
begin
|
||||
Result := False;
|
||||
if not Resolve(FHost, IP) then
|
||||
begin
|
||||
FOwner.SetState(dxsRetry, 'cannot resolve ' + FHost);
|
||||
FOwner.AddLog('*** DNS: cannot resolve ' + FHost);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
FSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||||
{$ELSE}
|
||||
FSocket := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||||
{$ENDIF}
|
||||
if FSocket = SOCK_INVALID then
|
||||
begin
|
||||
FOwner.SetState(dxsRetry, 'cannot create socket');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
FillChar(Addr, SizeOf(Addr), 0);
|
||||
Addr.sin_family := AF_INET;
|
||||
Addr.sin_port := htons(FPort);
|
||||
Addr.sin_addr.s_addr := IP;
|
||||
|
||||
SockSetNonBlock(FSocket, True);
|
||||
{$IFDEF MSWINDOWS}
|
||||
R := WinSock2.connect(FSocket, @Addr, SizeOf(Addr));
|
||||
{$ELSE}
|
||||
R := fpConnect(FSocket, @Addr, SizeOf(Addr));
|
||||
{$ENDIF}
|
||||
if R <> 0 then
|
||||
begin
|
||||
// ожидаемо: EINPROGRESS / WSAEWOULDBLOCK — ждём готовности на запись.
|
||||
// Ждём НЕ одним select на 8 с, а квантами по DX_CONNECT_SLICE_MS: иначе
|
||||
// Stop() (закрытие программы) висел бы до конца таймаута соединения.
|
||||
Waited := 0;
|
||||
R := 0;
|
||||
while (Waited < DX_CONNECT_MS) and (not Terminated) do
|
||||
begin
|
||||
TV.tv_sec := DX_CONNECT_SLICE_MS div 1000;
|
||||
TV.tv_usec := (DX_CONNECT_SLICE_MS mod 1000) * 1000;
|
||||
{$IFDEF MSWINDOWS}
|
||||
FD_ZERO(FDS);
|
||||
FD_SET(FSocket, FDS);
|
||||
R := select(0, nil, @FDS, nil, @TV);
|
||||
{$ELSE}
|
||||
fpFD_ZERO(FDS);
|
||||
fpFD_SET(FSocket, FDS);
|
||||
R := fpSelect(FSocket + 1, nil, @FDS, nil, @TV);
|
||||
{$ENDIF}
|
||||
if R <> 0 then Break; // готов или ошибка select
|
||||
Inc(Waited, DX_CONNECT_SLICE_MS);
|
||||
end;
|
||||
if Terminated then
|
||||
begin
|
||||
CloseSock;
|
||||
Exit;
|
||||
end;
|
||||
if R <= 0 then
|
||||
begin
|
||||
CloseSock;
|
||||
FOwner.SetState(dxsRetry, 'connect timeout: ' + FHost);
|
||||
FOwner.AddLog('*** no answer from ' + FHost + ':' + IntToStr(FPort));
|
||||
Exit;
|
||||
end;
|
||||
SoErr := 0; ErrLen := SizeOf(SoErr);
|
||||
{$IFDEF MSWINDOWS}
|
||||
getsockopt(FSocket, SOL_SOCKET, SO_ERROR, PChar(@SoErr), ErrLen);
|
||||
{$ELSE}
|
||||
fpGetSockOpt(FSocket, SOL_SOCKET, SO_ERROR, @SoErr, @ErrLen);
|
||||
{$ENDIF}
|
||||
if SoErr <> 0 then
|
||||
begin
|
||||
CloseSock;
|
||||
FOwner.SetState(dxsRetry, 'connection refused');
|
||||
FOwner.AddLog('*** refused: ' + FHost + ':' + IntToStr(FPort));
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
SockSetNonBlock(FSocket, False);
|
||||
SockSetRcvTimeout(FSocket, DX_RECV_MS);
|
||||
SockSetSndTimeout(FSocket, 5000);
|
||||
One := 1;
|
||||
{$IFDEF MSWINDOWS}
|
||||
setsockopt(FSocket, SOL_SOCKET, SO_KEEPALIVE, PChar(@One), SizeOf(One));
|
||||
{$ELSE}
|
||||
fpSetSockOpt(FSocket, SOL_SOCKET, SO_KEEPALIVE, @One, SizeOf(One));
|
||||
{$ENDIF}
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TDXClusterThread.CloseSock;
|
||||
begin
|
||||
if FSocket <> SOCK_INVALID then
|
||||
begin
|
||||
SockShutdown(FSocket);
|
||||
SockClose(FSocket);
|
||||
FSocket := SOCK_INVALID;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXClusterThread.SendAll(const Data: string): Boolean;
|
||||
// TCP вправе отправить меньше запрошенного — дописываем остаток. Таймаут
|
||||
// (SO_SNDTIMEO) и EINTR — не ошибка соединения, пробуем ещё, но не бесконечно.
|
||||
var
|
||||
Sent, N, Tries: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
if (FSocket = SOCK_INVALID) or (Data = '') then Exit;
|
||||
Sent := 0;
|
||||
Tries := 0;
|
||||
while Sent < Length(Data) do
|
||||
begin
|
||||
if Terminated then Exit;
|
||||
N := SockSend(FSocket, @Data[Sent + 1], Length(Data) - Sent, 0);
|
||||
if N > 0 then
|
||||
begin
|
||||
Inc(Sent, N);
|
||||
Tries := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not SockWouldBlock then Exit; // настоящая ошибка сокета
|
||||
Inc(Tries);
|
||||
if Tries > DX_SEND_RETRIES then Exit; // не отдаёт буфер — считаем разрывом
|
||||
end;
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TDXClusterThread.SendLine(const S: string): Boolean;
|
||||
begin
|
||||
Result := SendAll(S + #13#10);
|
||||
if not Result then
|
||||
FOwner.AddLog('*** send failed, dropping connection');
|
||||
end;
|
||||
|
||||
procedure TDXClusterThread.FlushOutQueue;
|
||||
var
|
||||
Pending: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
Pending := nil;
|
||||
FOwner.FLock.Enter;
|
||||
try
|
||||
if FOwner.FOutQueue.Count > 0 then
|
||||
begin
|
||||
Pending := TStringList.Create;
|
||||
Pending.Assign(FOwner.FOutQueue);
|
||||
FOwner.FOutQueue.Clear;
|
||||
end;
|
||||
finally
|
||||
FOwner.FLock.Leave;
|
||||
end;
|
||||
if Pending = nil then Exit;
|
||||
try
|
||||
for i := 0 to Pending.Count - 1 do
|
||||
begin
|
||||
if not SendLine(Pending[i]) then Break; // сокет умер — остальное на реконнект
|
||||
FOwner.AddLog('> ' + Pending[i]);
|
||||
end;
|
||||
finally
|
||||
Pending.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterThread.CheckPrompts(const Tail: string);
|
||||
// Приглашения логина И пароля обычно приходят БЕЗ перевода строки, поэтому
|
||||
// ищем их и в незавершённом хвосте буфера, а не только в целых строках.
|
||||
// Флаги FLoginSent/FPassSent держат отправку однократной: хвост проверяется
|
||||
// заново с каждым пришедшим куском.
|
||||
var U: string;
|
||||
begin
|
||||
if Tail = '' then Exit;
|
||||
U := LowerCase(Tail);
|
||||
|
||||
if not FLoginSent then
|
||||
begin
|
||||
if (Pos('login:', U) > 0) or (Pos('call:', U) > 0) or
|
||||
(Pos('callsign', U) > 0) or (Pos('your call', U) > 0) or
|
||||
(Pos('enter your', U) > 0) then
|
||||
begin
|
||||
if not SendLine(FLogin) then Exit;
|
||||
FOwner.AddLog('> ' + FLogin);
|
||||
FLoginSent := True;
|
||||
FLoginAt := Now;
|
||||
FOwner.SetState(dxsLogin, '');
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (FPassword <> '') and (not FPassSent) and (Pos('password', U) > 0) then
|
||||
begin
|
||||
if not SendLine(FPassword) then Exit;
|
||||
FOwner.AddLog('> ********');
|
||||
FPassSent := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXClusterThread.HandleLine(const Line: string);
|
||||
var
|
||||
Spot: TDXSpot;
|
||||
begin
|
||||
if Line = '' then Exit;
|
||||
FOwner.AddLog(Line);
|
||||
|
||||
if ParseDXSpot(Line, Spot) then
|
||||
begin
|
||||
FOwner.FStore.Add(Spot);
|
||||
FOwner.FLock.Enter;
|
||||
try
|
||||
Inc(FOwner.FSpotCount);
|
||||
finally
|
||||
FOwner.FLock.Leave;
|
||||
end;
|
||||
if FOwner.State <> dxsOnline then FOwner.SetState(dxsOnline, '');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
CheckPrompts(Line);
|
||||
end;
|
||||
|
||||
procedure TDXClusterThread.HandleChunk(const Data: string);
|
||||
var
|
||||
P: Integer;
|
||||
Line: string;
|
||||
begin
|
||||
FRxBuf := FRxBuf + Data;
|
||||
while True do
|
||||
begin
|
||||
P := 1;
|
||||
while (P <= Length(FRxBuf)) and not (FRxBuf[P] in [#10, #13]) do Inc(P);
|
||||
if P > Length(FRxBuf) then Break; // перевода строки ещё нет
|
||||
Line := Copy(FRxBuf, 1, P - 1);
|
||||
// съедаем весь конец строки (CR, LF или CRLF)
|
||||
while (P <= Length(FRxBuf)) and (FRxBuf[P] in [#10, #13]) do Inc(P);
|
||||
Delete(FRxBuf, 1, P - 1);
|
||||
HandleLine(TrimRight(Line));
|
||||
end;
|
||||
|
||||
// Хвост без перевода строки — возможно, это приглашение логина или пароля.
|
||||
if FRxBuf <> '' then CheckPrompts(FRxBuf);
|
||||
// Защита от мусора без переводов строк.
|
||||
if Length(FRxBuf) > 8192 then FRxBuf := '';
|
||||
end;
|
||||
|
||||
function TDXClusterThread.Session: Boolean;
|
||||
var
|
||||
Buf: array[0..4095] of Byte;
|
||||
N: Integer;
|
||||
Chunk: string;
|
||||
PL: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := True;
|
||||
FRxBuf := '';
|
||||
FLoginSent := False;
|
||||
FPassSent := False;
|
||||
FPostSent := False;
|
||||
FConnectAt := Now;
|
||||
|
||||
FOwner.SetState(dxsConnecting, FHost + ':' + IntToStr(FPort));
|
||||
FOwner.AddLog('*** connecting to ' + FHost + ':' + IntToStr(FPort));
|
||||
if not ConnectSock then Exit;
|
||||
|
||||
FOwner.AddLog('*** connected');
|
||||
FOwner.SetState(dxsLogin, '');
|
||||
|
||||
while not Terminated do
|
||||
begin
|
||||
N := SockRecv(FSocket, @Buf[0], SizeOf(Buf), 0);
|
||||
if N > 0 then
|
||||
begin
|
||||
SetLength(Chunk, N);
|
||||
Move(Buf[0], Chunk[1], N);
|
||||
HandleChunk(Chunk);
|
||||
end
|
||||
else if N = 0 then
|
||||
begin
|
||||
FOwner.AddLog('*** connection closed by peer');
|
||||
Break;
|
||||
end
|
||||
else if not SockWouldBlock then
|
||||
begin
|
||||
// Не таймаут кванта recv, а настоящая ошибка сокета — уходим на реконнект.
|
||||
FOwner.AddLog('*** connection lost (socket error)');
|
||||
Break;
|
||||
end;
|
||||
|
||||
if Terminated then Break;
|
||||
|
||||
// Приглашения не дождались — шлём позывной сами (часть кластеров молчит).
|
||||
if (not FLoginSent) and (SecondsBetween(Now, FConnectAt) >= DX_LOGIN_GRACE_S) then
|
||||
begin
|
||||
if not SendLine(FLogin) then Break; // сокет умер — на реконнект
|
||||
FOwner.AddLog('> ' + FLogin + ' (no prompt seen)');
|
||||
FLoginSent := True;
|
||||
FLoginAt := Now;
|
||||
end;
|
||||
|
||||
// Post-login команды — один раз, чуть погодя после позывного.
|
||||
if FLoginSent and (not FPostSent) and
|
||||
(SecondsBetween(Now, FLoginAt) >= DX_POSTLOGIN_S) then
|
||||
begin
|
||||
FPostSent := True;
|
||||
if Trim(FPostLogin) <> '' then
|
||||
begin
|
||||
PL := TStringList.Create;
|
||||
try
|
||||
PL.Text := FPostLogin;
|
||||
for i := 0 to PL.Count - 1 do
|
||||
if Trim(PL[i]) <> '' then
|
||||
begin
|
||||
if not SendLine(Trim(PL[i])) then Break;
|
||||
FOwner.AddLog('> ' + Trim(PL[i]));
|
||||
end;
|
||||
finally
|
||||
PL.Free;
|
||||
end;
|
||||
end;
|
||||
if FOwner.State <> dxsOnline then FOwner.SetState(dxsOnline, '');
|
||||
end;
|
||||
|
||||
FlushOutQueue;
|
||||
end;
|
||||
|
||||
CloseSock;
|
||||
Result := not Terminated;
|
||||
end;
|
||||
|
||||
procedure TDXClusterThread.Execute;
|
||||
var
|
||||
Backoff: Integer;
|
||||
begin
|
||||
Backoff := DX_RECONNECT_MIN;
|
||||
// Снимок конфига на всю жизнь потока: Configure во время работы применяется
|
||||
// следующим Start (так же ведёт себя веб-сервер при смене порта).
|
||||
FOwner.FLock.Enter;
|
||||
try
|
||||
FHost := FOwner.FHost;
|
||||
FPort := FOwner.FPort;
|
||||
FLogin := FOwner.FLogin;
|
||||
FPassword := FOwner.FPassword;
|
||||
FPostLogin := FOwner.FPostLogin;
|
||||
finally
|
||||
FOwner.FLock.Leave;
|
||||
end;
|
||||
|
||||
while not Terminated do
|
||||
begin
|
||||
if not Session then Break;
|
||||
if Terminated then Break;
|
||||
|
||||
FOwner.SetState(dxsRetry, 'reconnecting in ' + IntToStr(Backoff) + ' s');
|
||||
FOwner.AddLog('*** reconnecting in ' + IntToStr(Backoff) + ' s');
|
||||
if FOwner.FStopEvent.WaitFor(Backoff * 1000) = wrSignaled then Break;
|
||||
Backoff := Backoff * 2;
|
||||
if Backoff > DX_RECONNECT_MAX then Backoff := DX_RECONNECT_MAX;
|
||||
end;
|
||||
CloseSock;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -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.
|
||||
@@ -0,0 +1,507 @@
|
||||
unit DXSpotOverlay;
|
||||
|
||||
{
|
||||
Оверлей DX-спотов на спектре: позывной в «чипе» + вертикальный штрих к своей
|
||||
частоте. Пересекающиеся подписи раскладываются лесенкой по рядам сверху вниз.
|
||||
|
||||
Производительность — ровно модель BandPlanOverlay/VfoOverlay, ничего нового:
|
||||
|
||||
• Кэшируется ТОЛЬКО полоса подписей (W × FBandH, вверху спектра) в key-color
|
||||
битмап; пересборка идёт исключительно по dirty-ключу (версия стора / вид /
|
||||
ширина / тема / фильтры / тик затухания), а каждый кадр — один композит
|
||||
W × FBandH с постоянной альфой (BlendBitmapKey, тот же дворд-блендинг).
|
||||
Полноэкранный кэш W × H на кадр стоил бы в разы дороже — поэтому штрихи
|
||||
ниже полосы в кэш НЕ входят.
|
||||
• Штрихи от полосы до низа спектра рисует вызывающая сторона теми же
|
||||
примитивами, что и все прочие маркеры: CPU — RawVLine внутри RawBegin/
|
||||
RawEnd (никакого Canvas на битмапе кадра), GL — DrawLine. Оверлей отдаёт
|
||||
только готовый список X/цвет (TickCount/Tick), посчитанный при пересборке
|
||||
кэша, — на кадр никакой арифметики по спотам.
|
||||
• GL-путь берёт ТОТ ЖЕ битмап текстурой (DrawOverlayBitmap + UploadBitmap с
|
||||
color-key), заливка — только при dirty. Вид CPU и GL совпадает.
|
||||
|
||||
Домен частот — display-Гц, как их видит спектр (GetViewWindow). Частота спота
|
||||
кладётся как есть: на QO-100 кластеры постят downlink 10489.xxx, что совпадает
|
||||
со шкалой панадаптера само собой.
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, Types, Math, Forms,
|
||||
VfoOverlay, // BlendBitmapKey — общий keyed-композит (одна копия на проект)
|
||||
DXSpotStore;
|
||||
|
||||
const
|
||||
DXSPOT_ALPHA = 225; // альфа композита полосы подписей
|
||||
DXSPOT_ROW_BASE_H = 15; // базовая высота ряда @96dpi
|
||||
DXSPOT_MAX_ROWS = 6; // потолок рядов лесенки (настройка кладётся сюда)
|
||||
|
||||
type
|
||||
// Один разложенный спот: где чип, где штрих, каким цветом.
|
||||
TDXSpotItem = record
|
||||
X: Integer; // X штриха (пиксель частоты)
|
||||
Chip: TRect; // прямоугольник подписи (для хит-теста)
|
||||
Color: TColor; // цвет с учётом возраста/своего позывного
|
||||
Spot: TDXSpot;
|
||||
end;
|
||||
|
||||
TDXSpotOverlay = class(TComponent)
|
||||
private
|
||||
FStore: TDXSpotStore; // не владеет
|
||||
FCenterFreq: Double;
|
||||
FSpanHz: Double;
|
||||
FEnabled: Boolean;
|
||||
FLightTheme: Boolean;
|
||||
FOwnCall: string;
|
||||
|
||||
// фильтры
|
||||
FModes: TDXModeSet;
|
||||
FMaxAgeMin: Integer;
|
||||
FMaxRows: Integer;
|
||||
|
||||
FCache: TBitmap;
|
||||
FCacheW: Integer;
|
||||
FCacheDirty: Boolean;
|
||||
FBandH: Integer; // высота полосы подписей (px, масштаб по DPI)
|
||||
FRowH: Integer;
|
||||
|
||||
// ключ кэша
|
||||
FKeyCenter: Double;
|
||||
FKeySpan: Double;
|
||||
FKeyW: Integer;
|
||||
FKeyEnabled: Boolean;
|
||||
FKeyVersion: Int64;
|
||||
FKeyLight: Boolean;
|
||||
FKeyRows: Integer;
|
||||
FKeyAgeTick: Int64;
|
||||
FAgeTick: Int64; // бампается таймером UI — обновить затухание
|
||||
|
||||
FRenderVer: Int64; // ++ на каждую пересборку кэша — ключ GL-текстуры
|
||||
FLayoutTTL: Integer; // горизонт затухания, снят один раз на раскладку
|
||||
FItems: array of TDXSpotItem;
|
||||
FItemCount: Integer;
|
||||
FHidden: Integer; // сколько спотов не влезло в лесенку
|
||||
|
||||
function FreqToX(FreqHz: Double; W: Integer): Integer;
|
||||
function AgeColor(const S: TDXSpot): TColor;
|
||||
procedure Layout(C: TCanvas; W: Integer);
|
||||
procedure DrawSelf(C: TCanvas; W: Integer);
|
||||
procedure RebuildCache(W: Integer);
|
||||
function NeedsRebuild(W: Integer): Boolean;
|
||||
procedure SetMaxRows(V: Integer);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Attach(AStore: TDXSpotStore);
|
||||
procedure SetView(ACenterHz, ASpanHz: Double);
|
||||
procedure SetEnabled(En: Boolean);
|
||||
procedure SetLightTheme(Light: Boolean);
|
||||
procedure SetOwnCall(const ACall: string);
|
||||
procedure SetFilters(AModes: TDXModeSet; AMaxAgeMin: Integer);
|
||||
// Тик затухания: дёргается редко (раз в десятки секунд) — только чтобы
|
||||
// старые споты потускнели и ушедшие по TTL исчезли.
|
||||
procedure TickAge;
|
||||
procedure Invalidate;
|
||||
|
||||
function Active: Boolean;
|
||||
|
||||
// Пересобрать кэш+раскладку, если протух ключ. Вызывается В НАЧАЛЕ кадра:
|
||||
// штрихи рисуются РАНЬШЕ композита полосы, а список штрихов рождается
|
||||
// именно при пересборке — иначе первый кадр после нового спота рисовал бы
|
||||
// старую раскладку.
|
||||
procedure EnsureRendered(W: Integer);
|
||||
|
||||
// CPU-путь: композит полосы подписей вверху Target.
|
||||
procedure DrawOverlay(Target: TBitmap; W, H: Integer);
|
||||
// GL-путь: полоса подписей в Target-битмап (W × BandHeight) под текстуру.
|
||||
procedure DrawOverlayBitmap(Target: TBitmap; W: Integer);
|
||||
|
||||
// Штрихи ниже полосы — рисует вызывающая сторона (RawVLine / GL DrawLine).
|
||||
function TickCount: Integer;
|
||||
procedure Tick(Idx: Integer; out X: Integer; out Color: TColor);
|
||||
|
||||
// Хит-тест по подписи (клик = настроиться на спот).
|
||||
function SpotAtPixel(X, Y: Integer; out Spot: TDXSpot): Boolean;
|
||||
|
||||
property BandHeight: Integer read FBandH;
|
||||
property CenterFreq: Double read FCenterFreq; // для GL-инвалидизации
|
||||
property SpanHz: Double read FSpanHz;
|
||||
property MaxRows: Integer read FMaxRows write SetMaxRows;
|
||||
property Hidden: Integer read FHidden;
|
||||
property CacheDirty: Boolean read FCacheDirty;
|
||||
// Меняется ровно тогда, когда картинка полосы стала другой. GL-путь по нему
|
||||
// решает, перезаливать ли текстуру: он не зависит от того, кто первым
|
||||
// дёрнул пересборку в этом кадре (штрихи или композит).
|
||||
property RenderVersion: Int64 read FRenderVer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
KEY_COLOR = TColor($00FF00FF); // тот же ключ прозрачности, что у VfoOverlay
|
||||
|
||||
// Палитра (TColor = $00BBGGRR). Своя пара на тему: на тёмном спектре чип
|
||||
// тёмный со светлой подписью, на светлом — наоборот, иначе подписи спотов
|
||||
// на светлой теме сливались бы в грязное пятно.
|
||||
// тёмная тема светлая тема
|
||||
CLR_CHIP_BG: array[Boolean] of TColor = ($00202018, $00F2F2EC);
|
||||
CLR_CHIP_TEXT: array[Boolean] of TColor = ($00F0F0F0, $00181818);
|
||||
CLR_FRESH: array[Boolean] of TColor = ($00E0C040, $00A05800); // свежий
|
||||
CLR_STALE: array[Boolean] of TColor = ($00706850, $00B0A898); // на исходе TTL
|
||||
CLR_OWN: array[Boolean] of TColor = ($0040D0FF, $000060C8); // свой позывной
|
||||
|
||||
CHIP_PAD_X = 3;
|
||||
CHIP_GAP = 3; // минимальный зазор между чипами в одном ряду
|
||||
|
||||
function Mix(A, B: TColor; Num, Den: Integer): TColor;
|
||||
// A→B на Num/Den (0 = A, Den = B).
|
||||
var ra, ga, ba, rb, gb, bb: Integer;
|
||||
begin
|
||||
if Den <= 0 then Exit(A);
|
||||
ra := A and $FF; ga := (A shr 8) and $FF; ba := (A shr 16) and $FF;
|
||||
rb := B and $FF; gb := (B shr 8) and $FF; bb := (B shr 16) and $FF;
|
||||
ra := ra + (rb - ra) * Num div Den;
|
||||
ga := ga + (gb - ga) * Num div Den;
|
||||
ba := ba + (bb - ba) * Num div Den;
|
||||
Result := TColor((ba shl 16) or (ga shl 8) or ra);
|
||||
end;
|
||||
|
||||
{ ── Создание / параметры ─────────────────────────────────────────────────── }
|
||||
|
||||
constructor TDXSpotOverlay.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FRowH := Round(DXSPOT_ROW_BASE_H * Screen.PixelsPerInch / 96);
|
||||
if FRowH < DXSPOT_ROW_BASE_H then FRowH := DXSPOT_ROW_BASE_H;
|
||||
FMaxRows := 4;
|
||||
FBandH := FRowH * FMaxRows + 4;
|
||||
FCenterFreq := 0;
|
||||
FSpanHz := 0;
|
||||
FEnabled := False;
|
||||
FModes := [];
|
||||
FMaxAgeMin := 0;
|
||||
FCache := TBitmap.Create;
|
||||
FCache.PixelFormat := pf32bit;
|
||||
FCacheW := 0;
|
||||
FCacheDirty := True;
|
||||
FKeyCenter := -1; FKeySpan := -1; FKeyW := -1; FKeyVersion := -1;
|
||||
FKeyEnabled := False; FKeyLight := False; FKeyRows := -1; FKeyAgeTick := -1;
|
||||
FAgeTick := 0;
|
||||
FRenderVer := 0;
|
||||
end;
|
||||
|
||||
destructor TDXSpotOverlay.Destroy;
|
||||
begin
|
||||
FCache.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.Attach(AStore: TDXSpotStore);
|
||||
begin
|
||||
FStore := AStore;
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.SetView(ACenterHz, ASpanHz: Double);
|
||||
begin
|
||||
if (Abs(ACenterHz - FCenterFreq) < 1.0) and (Abs(ASpanHz - FSpanHz) < 1.0) then Exit;
|
||||
FCenterFreq := ACenterHz;
|
||||
FSpanHz := ASpanHz;
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.SetEnabled(En: Boolean);
|
||||
begin
|
||||
if FEnabled = En then Exit;
|
||||
FEnabled := En;
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.SetLightTheme(Light: Boolean);
|
||||
begin
|
||||
if FLightTheme = Light then Exit;
|
||||
FLightTheme := Light;
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.SetOwnCall(const ACall: string);
|
||||
begin
|
||||
if SameText(FOwnCall, ACall) then Exit;
|
||||
FOwnCall := UpperCase(Trim(ACall));
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.SetFilters(AModes: TDXModeSet; AMaxAgeMin: Integer);
|
||||
begin
|
||||
if (FModes = AModes) and (FMaxAgeMin = AMaxAgeMin) then Exit;
|
||||
FModes := AModes;
|
||||
FMaxAgeMin := AMaxAgeMin;
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.SetMaxRows(V: Integer);
|
||||
begin
|
||||
V := EnsureRange(V, 1, DXSPOT_MAX_ROWS);
|
||||
if V = FMaxRows then Exit;
|
||||
FMaxRows := V;
|
||||
FBandH := FRowH * FMaxRows + 4;
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.TickAge;
|
||||
begin
|
||||
Inc(FAgeTick);
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.Invalidate;
|
||||
begin
|
||||
FCacheDirty := True;
|
||||
end;
|
||||
|
||||
function TDXSpotOverlay.Active: Boolean;
|
||||
begin
|
||||
Result := FEnabled and (FStore <> nil);
|
||||
end;
|
||||
|
||||
function TDXSpotOverlay.FreqToX(FreqHz: Double; W: Integer): Integer;
|
||||
begin
|
||||
if FSpanHz <= 0 then Result := -1
|
||||
else Result := Round((FreqHz - (FCenterFreq - FSpanHz / 2)) / FSpanHz * W);
|
||||
end;
|
||||
|
||||
function TDXSpotOverlay.AgeColor(const S: TDXSpot): TColor;
|
||||
// Свежий → CLR_FRESH, к концу окна TTL плавно уходит в CLR_STALE. Свой
|
||||
// позывной выделен цветом (и тоже гаснет — иначе старый спот кричал бы
|
||||
// громче свежих). TTL берётся из FLayoutTTL: он посчитан один раз на
|
||||
// раскладку, чтобы не дёргать лок стора на каждый спот.
|
||||
var
|
||||
AgeMin, K: Integer;
|
||||
Base: TColor;
|
||||
begin
|
||||
Base := CLR_FRESH[FLightTheme];
|
||||
if (FOwnCall <> '') and SameText(S.Call, FOwnCall) then
|
||||
Base := CLR_OWN[FLightTheme];
|
||||
if FLayoutTTL <= 0 then Exit(Base);
|
||||
AgeMin := Round((Now - S.Stamp) * 24 * 60);
|
||||
K := EnsureRange(AgeMin * 100 div Max(FLayoutTTL, 1), 0, 100);
|
||||
Result := Mix(Base, CLR_STALE[FLightTheme], K, 100);
|
||||
end;
|
||||
|
||||
{ ── Раскладка лесенки ────────────────────────────────────────────────────── }
|
||||
|
||||
procedure TDXSpotOverlay.Layout(C: TCanvas; W: Integer);
|
||||
// Споты приходят из стора отсортированными по частоте; каждому даём ПЕРВЫЙ
|
||||
// ряд сверху, где подпись не наезжает на предыдущую. Не нашлось ряда —
|
||||
// спот скрыт (считаем в FHidden), в лесенке дырок не оставляем.
|
||||
var
|
||||
Arr: TDXSpotArray;
|
||||
N, i, r, TW, ChipW, ChipX, Row: Integer;
|
||||
RowRight: array[0..DXSPOT_MAX_ROWS-1] of Integer;
|
||||
LoHz, HiHz: Double;
|
||||
begin
|
||||
FItemCount := 0;
|
||||
FHidden := 0;
|
||||
if (FStore = nil) or (FSpanHz <= 0) or (W <= 0) then Exit;
|
||||
|
||||
// Горизонт затухания: явный фильтр по возрасту, иначе TTL стора (чтение
|
||||
// под локом — поэтому один раз на раскладку, а не на каждый спот).
|
||||
FLayoutTTL := FMaxAgeMin;
|
||||
if FLayoutTTL <= 0 then FLayoutTTL := FStore.TTLMinutes;
|
||||
|
||||
LoHz := FCenterFreq - FSpanHz / 2;
|
||||
HiHz := FCenterFreq + FSpanHz / 2;
|
||||
N := FStore.SnapshotRange(LoHz, HiHz, FModes, FMaxAgeMin, Arr);
|
||||
if N = 0 then Exit;
|
||||
|
||||
for r := 0 to FMaxRows - 1 do RowRight[r] := -CHIP_GAP - 1;
|
||||
SetLength(FItems, N);
|
||||
|
||||
for i := 0 to N - 1 do
|
||||
begin
|
||||
TW := C.TextWidth(Arr[i].Call);
|
||||
ChipW := TW + CHIP_PAD_X * 2;
|
||||
ChipX := FreqToX(Arr[i].FreqHz, W) - ChipW div 2;
|
||||
if ChipX < 0 then ChipX := 0;
|
||||
if ChipX + ChipW > W then ChipX := W - ChipW;
|
||||
if ChipX < 0 then Continue; // подпись шире окна — не рисуем
|
||||
|
||||
Row := -1;
|
||||
for r := 0 to FMaxRows - 1 do
|
||||
if ChipX > RowRight[r] + CHIP_GAP then
|
||||
begin
|
||||
Row := r;
|
||||
Break;
|
||||
end;
|
||||
if Row < 0 then
|
||||
begin
|
||||
Inc(FHidden);
|
||||
Continue;
|
||||
end;
|
||||
RowRight[Row] := ChipX + ChipW;
|
||||
|
||||
FItems[FItemCount].X := FreqToX(Arr[i].FreqHz, W);
|
||||
FItems[FItemCount].Chip := Rect(ChipX, Row * FRowH + 2,
|
||||
ChipX + ChipW, Row * FRowH + FRowH);
|
||||
FItems[FItemCount].Color := AgeColor(Arr[i]);
|
||||
FItems[FItemCount].Spot := Arr[i];
|
||||
Inc(FItemCount);
|
||||
end;
|
||||
SetLength(FItems, FItemCount);
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.DrawSelf(C: TCanvas; W: Integer);
|
||||
// Рендер полосы подписей в канвас W × FBandH. Фон — KEY_COLOR (прозрачный
|
||||
// при композите и в GL-текстуре).
|
||||
var
|
||||
i: Integer;
|
||||
R: TRect;
|
||||
Col: TColor;
|
||||
begin
|
||||
C.Brush.Color := KEY_COLOR;
|
||||
C.Brush.Style := bsSolid;
|
||||
C.Pen.Style := psClear;
|
||||
C.FillRect(Rect(0, 0, W, FBandH));
|
||||
|
||||
// Шрифт привязан к высоте ряда (а не к point-size) — подпись влезает при
|
||||
// любом DPI-масштабе, как в бэндплане.
|
||||
C.Font.Name := 'Courier New';
|
||||
C.Font.Style := [fsBold];
|
||||
C.Font.Height := -Max(8, Round(FRowH * 0.62));
|
||||
|
||||
Layout(C, W);
|
||||
|
||||
for i := 0 to FItemCount - 1 do
|
||||
begin
|
||||
R := FItems[i].Chip;
|
||||
Col := FItems[i].Color;
|
||||
|
||||
// Штрих от низа чипа до низа полосы (дальше его продолжает вызывающая
|
||||
// сторона по TickCount/Tick — уже прямо в кадре).
|
||||
if (FItems[i].X >= 0) and (FItems[i].X < W) then
|
||||
begin
|
||||
C.Pen.Style := psSolid; C.Pen.Color := Col; C.Pen.Width := 1;
|
||||
C.MoveTo(FItems[i].X, R.Bottom);
|
||||
C.LineTo(FItems[i].X, FBandH);
|
||||
end;
|
||||
|
||||
// Чип: тёмная подложка + кромка цветом спота + позывной.
|
||||
C.Brush.Color := CLR_CHIP_BG[FLightTheme]; C.Brush.Style := bsSolid;
|
||||
C.Pen.Style := psSolid; C.Pen.Color := Col; C.Pen.Width := 1;
|
||||
C.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
|
||||
|
||||
C.Brush.Style := bsClear;
|
||||
C.Font.Color := CLR_CHIP_TEXT[FLightTheme];
|
||||
C.TextOut(R.Left + CHIP_PAD_X,
|
||||
R.Top + (R.Bottom - R.Top - C.TextHeight('W')) div 2,
|
||||
FItems[i].Spot.Call);
|
||||
end;
|
||||
C.Pen.Style := psSolid;
|
||||
end;
|
||||
|
||||
{ ── Кэш ──────────────────────────────────────────────────────────────────── }
|
||||
|
||||
function TDXSpotOverlay.NeedsRebuild(W: Integer): Boolean;
|
||||
var HalfPxHz: Double;
|
||||
begin
|
||||
if FStore = nil then Exit(False);
|
||||
// Порог по центру/спану — полпикселя (как в бэндплане): суб-пиксельный
|
||||
// дрейф центра при QO-100 decoder-lock не должен гонять полную пересборку.
|
||||
HalfPxHz := 0.5 * FSpanHz / Max(W, 1);
|
||||
if HalfPxHz < 1.0 then HalfPxHz := 1.0;
|
||||
Result := FCacheDirty or (FCacheW <> W) or (FKeyW <> W)
|
||||
or (FKeyEnabled <> FEnabled)
|
||||
or (FKeyVersion <> FStore.Version)
|
||||
or (FKeyLight <> FLightTheme)
|
||||
or (FKeyRows <> FMaxRows)
|
||||
or (FKeyAgeTick <> FAgeTick)
|
||||
or (Abs(FKeyCenter - FCenterFreq) >= HalfPxHz)
|
||||
or (Abs(FKeySpan - FSpanHz) >= HalfPxHz);
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.RebuildCache(W: Integer);
|
||||
begin
|
||||
if (W <= 0) or (FStore = nil) then
|
||||
begin
|
||||
FCacheW := 0; FCacheDirty := False; FItemCount := 0;
|
||||
Inc(FRenderVer);
|
||||
Exit;
|
||||
end;
|
||||
if (FCache.Width <> W) or (FCache.Height <> FBandH) then
|
||||
FCache.SetSize(W, FBandH);
|
||||
DrawSelf(FCache.Canvas, W);
|
||||
Inc(FRenderVer);
|
||||
FCacheW := W;
|
||||
FKeyCenter := FCenterFreq;
|
||||
FKeySpan := FSpanHz;
|
||||
FKeyW := W;
|
||||
FKeyEnabled := FEnabled;
|
||||
FKeyVersion := FStore.Version;
|
||||
FKeyLight := FLightTheme;
|
||||
FKeyRows := FMaxRows;
|
||||
FKeyAgeTick := FAgeTick;
|
||||
FCacheDirty := False;
|
||||
end;
|
||||
|
||||
{ ── Рисование ────────────────────────────────────────────────────────────── }
|
||||
|
||||
procedure TDXSpotOverlay.EnsureRendered(W: Integer);
|
||||
begin
|
||||
if (not Active) or (W <= 0) then Exit;
|
||||
if NeedsRebuild(W) then RebuildCache(W);
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.DrawOverlay(Target: TBitmap; W, H: Integer);
|
||||
begin
|
||||
if (not Active) or (Target = nil) or (W <= 0) or (H <= FBandH) then Exit;
|
||||
EnsureRendered(W);
|
||||
if FCacheW <= 0 then Exit;
|
||||
BlendBitmapKey(Target, FCache, 0, 0, DXSPOT_ALPHA);
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.DrawOverlayBitmap(Target: TBitmap; W: Integer);
|
||||
begin
|
||||
if (Target = nil) or (W <= 0) then Exit;
|
||||
// Раскладка/список штрихов должны быть свежими и в GL-пути.
|
||||
EnsureRendered(W);
|
||||
Target.PixelFormat := pf32bit;
|
||||
Target.SetSize(W, FBandH);
|
||||
Target.Canvas.Draw(0, 0, FCache);
|
||||
end;
|
||||
|
||||
function TDXSpotOverlay.TickCount: Integer;
|
||||
begin
|
||||
if not Active then Result := 0 else Result := FItemCount;
|
||||
end;
|
||||
|
||||
procedure TDXSpotOverlay.Tick(Idx: Integer; out X: Integer; out Color: TColor);
|
||||
begin
|
||||
if (Idx < 0) or (Idx >= FItemCount) then
|
||||
begin
|
||||
X := -1; Color := clNone;
|
||||
Exit;
|
||||
end;
|
||||
X := FItems[Idx].X;
|
||||
Color := FItems[Idx].Color;
|
||||
end;
|
||||
|
||||
function TDXSpotOverlay.SpotAtPixel(X, Y: Integer; out Spot: TDXSpot): Boolean;
|
||||
// Хит только по полосе подписей: ниже неё живут тюнинг/маркеры/слайсы, и
|
||||
// перехватывать там клик было бы поперёк привычного поведения спектра.
|
||||
var i: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
if (not Active) or (Y < 0) or (Y > FBandH) then Exit;
|
||||
for i := 0 to FItemCount - 1 do
|
||||
if (X >= FItems[i].Chip.Left - 2) and (X <= FItems[i].Chip.Right + 2) and
|
||||
(Y >= FItems[i].Chip.Top - 2) and (Y <= FItems[i].Chip.Bottom + 2) then
|
||||
begin
|
||||
Spot := FItems[i].Spot;
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
+382
@@ -0,0 +1,382 @@
|
||||
unit DXSpotStore;
|
||||
|
||||
{
|
||||
DXSpotStore.pas — потокобезопасное хранилище DX-спотов.
|
||||
|
||||
Единственная точка обмена между сетевым потоком кластера (TDXClusterClient,
|
||||
пишет) и UI (оверлей спектра + окно списка, читают). Поэтому здесь НЕТ ни
|
||||
Synchronize, ни очередей в главный поток: поток кластера кладёт спот прямо
|
||||
сюда под критической секцией, а UI замечает изменение по монотонному
|
||||
счётчику Version — ровно так же, как оверлеи замечают смену вида по своим
|
||||
ключам кэша. Никаких LCL-зависимостей (юнит компилируется и в headless).
|
||||
|
||||
Дедуп: спот с тем же позывным в пределах DEDUP_HZ считается тем же самым —
|
||||
обновляем частоту/время/комментарий, а не плодим строки. Тот же позывной на
|
||||
другом диапазоне — отдельная запись.
|
||||
|
||||
TTL: споты старше FTTLMinutes выбрасываются при каждой правке/снимке.
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$LONGSTRINGS ON}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, SyncObjs, DateUtils, StrUtils; // StrUtils — PosEx
|
||||
|
||||
const
|
||||
DX_DEDUP_HZ = 5000.0; // тот же позывной в этом окне = тот же спот
|
||||
DX_DEFAULT_TTL = 30; // мин
|
||||
DX_DEFAULT_MAX = 500; // потолок записей
|
||||
|
||||
type
|
||||
// Мода спота. Определяется по комментарию кластера (FT8/CW/…), при неудаче —
|
||||
// остаётся dxmUnknown: гадать по частоте не пытаемся, бэндпланы разные.
|
||||
TDXMode = (dxmUnknown, dxmCW, dxmSSB, dxmDigi, dxmFT8, dxmFT4, dxmRTTY,
|
||||
dxmPSK, dxmFM, dxmSSTV);
|
||||
|
||||
TDXModeSet = set of TDXMode;
|
||||
|
||||
TDXSpot = record
|
||||
FreqHz: Double; // частота DX-станции, Гц (кластер отдаёт кГц)
|
||||
Call: string; // позывной DX
|
||||
Spotter: string; // кто заспотил
|
||||
Comment: string; // комментарий кластера (уже без времени)
|
||||
TimeUTC: string; // 'HHMM' как пришло от кластера
|
||||
Stamp: TDateTime; // локальное время приёма — для TTL и затухания
|
||||
Mode: TDXMode;
|
||||
end;
|
||||
|
||||
TDXSpotArray = array of TDXSpot;
|
||||
|
||||
TDXSpotStore = class
|
||||
private
|
||||
FLock: TCriticalSection;
|
||||
FSpots: TDXSpotArray;
|
||||
FCount: Integer;
|
||||
FVersion: Int64;
|
||||
FTTLMinutes: Integer;
|
||||
FMaxSpots: Integer;
|
||||
procedure PurgeLocked;
|
||||
procedure DropOldestLocked;
|
||||
function GetTTLMinutes: Integer;
|
||||
procedure SetTTLMinutes(V: Integer);
|
||||
function GetMaxSpots: Integer;
|
||||
procedure SetMaxSpots(V: Integer);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
// Добавить/обновить спот (вызывается из потока кластера).
|
||||
procedure Add(const S: TDXSpot);
|
||||
procedure Clear;
|
||||
|
||||
// Снимок всех спотов, отсортированный по частоте.
|
||||
function Snapshot(out Arr: TDXSpotArray): Integer;
|
||||
// Снимок окна [LoHz..HiHz] с фильтром по моде (Modes = [] — без фильтра)
|
||||
// и по возрасту (MaxAgeMin <= 0 — только общий TTL). Для оверлея.
|
||||
function SnapshotRange(LoHz, HiHz: Double; Modes: TDXModeSet;
|
||||
MaxAgeMin: Integer; out Arr: TDXSpotArray): Integer;
|
||||
|
||||
// Монотонный счётчик правок — ключ инвалидации кэша оверлея/списка.
|
||||
function Version: Int64;
|
||||
function Count: Integer;
|
||||
|
||||
// Читаются сетевым потоком (PurgeLocked/Add), пишутся из UI — только через
|
||||
// критическую секцию, как и всё остальное состояние стора.
|
||||
property TTLMinutes: Integer read GetTTLMinutes write SetTTLMinutes;
|
||||
property MaxSpots: Integer read GetMaxSpots write SetMaxSpots;
|
||||
end;
|
||||
|
||||
// Мода по комментарию кластера ('FT8 -12 dB' → dxmFT8). Пусто/непонятно —
|
||||
// dxmUnknown.
|
||||
function DXModeFromComment(const Comment: string): TDXMode;
|
||||
function DXModeName(M: TDXMode): string;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
MODE_NAMES: array[TDXMode] of string =
|
||||
('', 'CW', 'SSB', 'DIGI', 'FT8', 'FT4', 'RTTY', 'PSK', 'FM', 'SSTV');
|
||||
|
||||
function DXModeName(M: TDXMode): string;
|
||||
begin
|
||||
Result := MODE_NAMES[M];
|
||||
end;
|
||||
|
||||
function DXModeFromComment(const Comment: string): TDXMode;
|
||||
// Ищем маркер моды как ОТДЕЛЬНОЕ слово: 'CW' внутри 'CWOPS' или позывного
|
||||
// модой не является. Порядок проверки — от длинных/специфичных к общим.
|
||||
var
|
||||
U: string;
|
||||
|
||||
function HasWord(const W: string): Boolean;
|
||||
var P, L, N: Integer; OkL, OkR: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
L := Length(W); N := Length(U);
|
||||
P := Pos(W, U);
|
||||
while P > 0 do
|
||||
begin
|
||||
OkL := (P = 1) or not (U[P-1] in ['A'..'Z', '0'..'9', '/', '-']);
|
||||
OkR := (P + L > N) or not (U[P+L] in ['A'..'Z', '0'..'9', '/', '-']);
|
||||
if OkL and OkR then Exit(True);
|
||||
P := PosEx(W, U, P + 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := dxmUnknown;
|
||||
if Comment = '' then Exit;
|
||||
U := UpperCase(Comment);
|
||||
if HasWord('FT8') then Result := dxmFT8
|
||||
else if HasWord('FT4') then Result := dxmFT4
|
||||
else if HasWord('RTTY') then Result := dxmRTTY
|
||||
else if HasWord('PSK') or HasWord('PSK31') or HasWord('BPSK') then Result := dxmPSK
|
||||
else if HasWord('SSTV') then Result := dxmSSTV
|
||||
else if HasWord('CW') then Result := dxmCW
|
||||
else if HasWord('SSB') or HasWord('USB') or HasWord('LSB') then Result := dxmSSB
|
||||
else if HasWord('FM') then Result := dxmFM
|
||||
else if HasWord('JT65') or HasWord('JT9') or HasWord('JS8') or
|
||||
HasWord('MSK144') or HasWord('OLIVIA') or HasWord('DIGI') then
|
||||
Result := dxmDigi;
|
||||
end;
|
||||
|
||||
{ ── TDXSpotStore ─────────────────────────────────────────────────────────── }
|
||||
|
||||
constructor TDXSpotStore.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FLock := TCriticalSection.Create;
|
||||
FCount := 0;
|
||||
FVersion := 0;
|
||||
FTTLMinutes := DX_DEFAULT_TTL;
|
||||
FMaxSpots := DX_DEFAULT_MAX;
|
||||
SetLength(FSpots, DX_DEFAULT_MAX);
|
||||
end;
|
||||
|
||||
destructor TDXSpotStore.Destroy;
|
||||
begin
|
||||
FLock.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDXSpotStore.PurgeLocked;
|
||||
// Выбрасывает споты старше TTL, уплотняя массив на месте.
|
||||
var
|
||||
i, Dst: Integer;
|
||||
Cutoff: TDateTime;
|
||||
begin
|
||||
if FTTLMinutes <= 0 then Exit;
|
||||
Cutoff := IncMinute(Now, -FTTLMinutes);
|
||||
Dst := 0;
|
||||
for i := 0 to FCount - 1 do
|
||||
if FSpots[i].Stamp >= Cutoff then
|
||||
begin
|
||||
if Dst <> i then FSpots[Dst] := FSpots[i];
|
||||
Inc(Dst);
|
||||
end;
|
||||
if Dst <> FCount then
|
||||
begin
|
||||
FCount := Dst;
|
||||
Inc(FVersion);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXSpotStore.DropOldestLocked;
|
||||
var i, Oldest: Integer;
|
||||
begin
|
||||
if FCount <= 0 then Exit;
|
||||
Oldest := 0;
|
||||
for i := 1 to FCount - 1 do
|
||||
if FSpots[i].Stamp < FSpots[Oldest].Stamp then Oldest := i;
|
||||
for i := Oldest to FCount - 2 do FSpots[i] := FSpots[i + 1];
|
||||
Dec(FCount);
|
||||
end;
|
||||
|
||||
procedure TDXSpotStore.Add(const S: TDXSpot);
|
||||
var
|
||||
i: Integer;
|
||||
UCall: string;
|
||||
begin
|
||||
if S.Call = '' then Exit;
|
||||
FLock.Enter;
|
||||
try
|
||||
PurgeLocked;
|
||||
UCall := UpperCase(S.Call);
|
||||
for i := 0 to FCount - 1 do
|
||||
if (UpperCase(FSpots[i].Call) = UCall) and
|
||||
(Abs(FSpots[i].FreqHz - S.FreqHz) <= DX_DEDUP_HZ) then
|
||||
begin
|
||||
FSpots[i] := S; // тот же спот — обновляем целиком
|
||||
Inc(FVersion);
|
||||
Exit;
|
||||
end;
|
||||
if Length(FSpots) < FMaxSpots then SetLength(FSpots, FMaxSpots);
|
||||
while FCount >= FMaxSpots do DropOldestLocked;
|
||||
FSpots[FCount] := S;
|
||||
Inc(FCount);
|
||||
Inc(FVersion);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXSpotStore.Clear;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
if FCount = 0 then Exit;
|
||||
FCount := 0;
|
||||
Inc(FVersion);
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CompareSpotFreq(const A, B: TDXSpot): Integer;
|
||||
begin
|
||||
if A.FreqHz < B.FreqHz then Result := -1
|
||||
else if A.FreqHz > B.FreqHz then Result := 1
|
||||
else Result := 0;
|
||||
end;
|
||||
|
||||
procedure SortByFreq(var Arr: TDXSpotArray; N: Integer);
|
||||
// Вставками: N здесь десятки-сотни и массив почти всегда уже почти
|
||||
// отсортирован (споты приходят вперемешку, но окно узкое).
|
||||
var i, j: Integer; T: TDXSpot;
|
||||
begin
|
||||
for i := 1 to N - 1 do
|
||||
begin
|
||||
T := Arr[i];
|
||||
j := i - 1;
|
||||
while (j >= 0) and (CompareSpotFreq(Arr[j], T) > 0) do
|
||||
begin
|
||||
Arr[j + 1] := Arr[j];
|
||||
Dec(j);
|
||||
end;
|
||||
Arr[j + 1] := T;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXSpotStore.Snapshot(out Arr: TDXSpotArray): Integer;
|
||||
var i: Integer;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
PurgeLocked;
|
||||
SetLength(Arr, FCount);
|
||||
for i := 0 to FCount - 1 do Arr[i] := FSpots[i];
|
||||
Result := FCount;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
SortByFreq(Arr, Result);
|
||||
end;
|
||||
|
||||
function TDXSpotStore.SnapshotRange(LoHz, HiHz: Double; Modes: TDXModeSet;
|
||||
MaxAgeMin: Integer; out Arr: TDXSpotArray): Integer;
|
||||
var
|
||||
i, N: Integer;
|
||||
Cutoff: TDateTime;
|
||||
UseAge: Boolean;
|
||||
begin
|
||||
N := 0;
|
||||
UseAge := MaxAgeMin > 0;
|
||||
Cutoff := 0;
|
||||
if UseAge then Cutoff := IncMinute(Now, -MaxAgeMin);
|
||||
FLock.Enter;
|
||||
try
|
||||
PurgeLocked;
|
||||
SetLength(Arr, FCount);
|
||||
for i := 0 to FCount - 1 do
|
||||
begin
|
||||
if (FSpots[i].FreqHz < LoHz) or (FSpots[i].FreqHz > HiHz) then Continue;
|
||||
if (Modes <> []) and not (FSpots[i].Mode in Modes) then Continue;
|
||||
if UseAge and (FSpots[i].Stamp < Cutoff) then Continue;
|
||||
Arr[N] := FSpots[i];
|
||||
Inc(N);
|
||||
end;
|
||||
SetLength(Arr, N);
|
||||
Result := N;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
SortByFreq(Arr, Result);
|
||||
end;
|
||||
|
||||
function TDXSpotStore.GetTTLMinutes: Integer;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FTTLMinutes;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXSpotStore.SetTTLMinutes(V: Integer);
|
||||
begin
|
||||
if V < 1 then V := 1;
|
||||
FLock.Enter;
|
||||
try
|
||||
if FTTLMinutes = V then Exit;
|
||||
FTTLMinutes := V;
|
||||
PurgeLocked; // укоротили TTL — лишнее выбрасываем сразу
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXSpotStore.GetMaxSpots: Integer;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FMaxSpots;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDXSpotStore.SetMaxSpots(V: Integer);
|
||||
begin
|
||||
if V < 16 then V := 16;
|
||||
FLock.Enter;
|
||||
try
|
||||
if FMaxSpots = V then Exit;
|
||||
FMaxSpots := V;
|
||||
if Length(FSpots) < FMaxSpots then SetLength(FSpots, FMaxSpots);
|
||||
while FCount > FMaxSpots do
|
||||
begin
|
||||
DropOldestLocked;
|
||||
Inc(FVersion);
|
||||
end;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXSpotStore.Version: Int64;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FVersion;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDXSpotStore.Count: Integer;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FCount;
|
||||
finally
|
||||
FLock.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -69,6 +69,10 @@ type
|
||||
property Visible;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
// Клавиатура: собственный KeyDown обрабатывает стрелки/PgUp/Home, а
|
||||
// необработанные клавиши (Enter и прочее) достаются владельцу через
|
||||
// inherited — поэтому событие имеет смысл публиковать.
|
||||
property OnKeyDown;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
@@ -23,6 +23,7 @@ type
|
||||
FScrollBar: TOverlayScrollBar;
|
||||
FTheme: TAppTheme;
|
||||
FSyncing: Boolean;
|
||||
FOnChange: TNotifyEvent;
|
||||
function GetLines: TStrings;
|
||||
function GetReadOnly: Boolean;
|
||||
procedure SetReadOnly(AValue: Boolean);
|
||||
@@ -65,6 +66,8 @@ type
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Visible;
|
||||
// Правка текста пользователем (проброс OnChange внутреннего TMemo).
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -192,6 +195,7 @@ end;
|
||||
procedure TFlatMemo.MemoChange(Sender: TObject);
|
||||
begin
|
||||
UpdateScrollBar;
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
end;
|
||||
|
||||
procedure TFlatMemo.MemoKeyUp(Sender: TObject; var Key: Word;
|
||||
|
||||
+254
-3
@@ -22,8 +22,9 @@ unit MainForm;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, FilterPopup,
|
||||
Classes, SysUtils, StrUtils, DateUtils, FreqDisplay, DeviceForm, FilterPopup,
|
||||
VfoOverlay, SampleRateOverlay, BandPlanOverlay,
|
||||
DXSpotStore, DXClusterClient, DXSpotOverlay, DXClusterForm,
|
||||
FlatButton, FlatSlider, FlatDropDown, OverlayScrollBar, AppTheme,
|
||||
Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls, Buttons, Menus, Math, Types, SyncObjs,
|
||||
@@ -139,7 +140,18 @@ type
|
||||
FSliceDrag: Boolean; // тащим маркер несущей слайса по спектру
|
||||
FSliceDragId: Integer; // какой слайс тащим
|
||||
FSampleRateOverlay: TSampleRateOverlay; // оверлей span/hide слева вверху спектра
|
||||
FBandPlanOverlay: TBandPlanOverlay; // полоска бэндплана QO-100 внизу спектра
|
||||
FBandPlanOverlay: TBandPlanOverlay; // полоска бэндплана QO-100
|
||||
// ── DX-кластер ────────────────────────────────────────────────────────
|
||||
FDXStore: TDXSpotStore; // общая база спотов (поток кластера пишет)
|
||||
FDXClient: TDXClusterClient; // telnet-соединение (свой поток)
|
||||
FDXSpotOverlay: TDXSpotOverlay; // подписи спотов на спектре
|
||||
FDXClusterForm: TDXClusterForm; // окно списка (ПКМ по кнопке DX)
|
||||
FDXCfg: TDXClusterSettings;
|
||||
FDXConnCfg: TDXClusterSettings; // параметры, с которыми поднят клиент
|
||||
FDXPendingCfg: TDXClusterSettings; // правки SETUP, ждущие тишины
|
||||
FDXPending: Boolean;
|
||||
FDXPendingAt: TDateTime;
|
||||
FDXAgeTickAt: TDateTime; // когда последний раз гасили старые споты внизу спектра
|
||||
FPanelHidden: Boolean; // True = левая панель скрыта
|
||||
FLeftPanelW: Integer; // ширина панели до скрытия (DPI-safe restore)
|
||||
FPendingBoardType: Integer; // BoardType устройства для подключения
|
||||
@@ -263,6 +275,7 @@ type
|
||||
BtnDiscover: TFlatButton;
|
||||
BtnStartStop: TFlatButton;
|
||||
BtnSettings: TFlatButton;
|
||||
BtnDXCluster: TFlatButton; // ЛКМ — споты на спектре, ПКМ — окно кластера
|
||||
|
||||
// ---- Left panel ----
|
||||
PanelLeft: TPanel;
|
||||
@@ -497,6 +510,19 @@ type
|
||||
procedure BtnRxMuteClick(Sender: TObject);
|
||||
procedure UpdateRxMuteButton; // видимость (Pluto+full-duplex) + стиль кнопки RX MUTE
|
||||
procedure UpdateBandPlanOverlay; // вкл/выкл полоски бэндплана QO-100 по InQO100
|
||||
// ── DX-кластер ────────────────────────────────────────────────────────
|
||||
procedure InitDXCluster; // стор+клиент+оверлей, чтение настроек
|
||||
procedure ServiceDXCluster; // тик затухания спотов (редкий)
|
||||
procedure ApplyDXClusterSettings(const D: TDXClusterSettings);
|
||||
procedure UpdateDXClusterButton;
|
||||
procedure BtnDXClusterClick(Sender: TObject);
|
||||
procedure BtnDXClusterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure ShowDXClusterForm;
|
||||
procedure ApplyDXConnection(const D: TDXClusterSettings);
|
||||
procedure OnDXClusterSettingsChange(const D: TDXClusterSettings);
|
||||
procedure CommitDXClusterSettings;
|
||||
procedure OnDXTuneSpot(FreqHz: Double; Mode: TDXMode);
|
||||
procedure BtnTUNClick(Sender: TObject);
|
||||
procedure ApplyTUN(Active: Boolean);
|
||||
// PureSignal: ЛКМ по PS = вкл/выкл, ПКМ = поповер настроек.
|
||||
@@ -1373,6 +1399,17 @@ begin
|
||||
PanelSplitter := nil;
|
||||
PbWaterfall := nil;
|
||||
PbPanZoom := nil;
|
||||
// DX-кластер: незакоммиченную правку SETUP дописываем в конфиг (соединение
|
||||
// при этом не трогаем — программа закрывается), гасим сетевой поток (его
|
||||
// Stop делает shutdown сокета и ждёт поток), потом базу спотов — оверлей
|
||||
// к этому моменту уже мёртв вместе с view пана.
|
||||
if FDXPending then
|
||||
begin
|
||||
FDXPending := False;
|
||||
FController.FSettings.SaveDXClusterSettings(FDXPendingCfg);
|
||||
end;
|
||||
FreeAndNil(FDXClient);
|
||||
FreeAndNil(FDXStore);
|
||||
DestroyAllExtraPans; // доп. паны (DDC/движок/панели) — до пана 0
|
||||
FreeAndNil(FPan);
|
||||
FPans[0] := nil;
|
||||
@@ -1976,6 +2013,10 @@ begin
|
||||
BtnDiscover := MakeBtn(PanelToolbar, 'DISCOVER', X, 3, 80, BTN_H, BtnDiscoverClick);
|
||||
BtnStartStop := MakeBtn(PanelToolbar, 'START', X+84, 3, 76, BTN_H, BtnStartStopClick);
|
||||
BtnSettings := MakeBtn(PanelToolbar, 'SETUP', X+164, 3, 66, BTN_H, BtnSettingsClick);
|
||||
// DX — споты кластера: ЛКМ включает/выключает подписи на спектре, ПКМ
|
||||
// открывает окно списка (та же семантика, что у BEACON → окно констелляции).
|
||||
BtnDXCluster := MakeBtn(PanelToolbar, 'DX', X+234, 3, 46, BTN_H, BtnDXClusterClick);
|
||||
BtnDXCluster.OnMouseDown := BtnDXClusterMouseDown;
|
||||
|
||||
// DISCOVER — синеватый акцент
|
||||
BtnDiscover.ClrNorm := TColor($00101828);
|
||||
@@ -2641,6 +2682,9 @@ begin
|
||||
FBandPlanOverlay.SetView(FController.FCenterFreq, FController.FSpanHz);
|
||||
FSpecView.BandPlanOverlay := FBandPlanOverlay;
|
||||
|
||||
// DX-кластер: база спотов + сетевой поток + оверлей подписей.
|
||||
InitDXCluster;
|
||||
|
||||
// S-метр — внутри PanelToolbar, справа
|
||||
PanelSMeterRight := TPanel.Create(Self);
|
||||
PanelSMeterRight.Parent := PanelToolbar;
|
||||
@@ -2763,6 +2807,9 @@ begin
|
||||
SafeLeft := MARGIN;
|
||||
if BtnSettings <> nil then
|
||||
SafeLeft := BtnSettings.Left + BtnSettings.Width + SETTINGS_GAP;
|
||||
// Кнопка DX стоит правее SETUP — группа VFO начинается уже за ней.
|
||||
if (BtnDXCluster <> nil) and BtnDXCluster.Visible then
|
||||
SafeLeft := Max(SafeLeft, BtnDXCluster.Left + BtnDXCluster.Width + SETTINGS_GAP);
|
||||
SafeRight := ClientWidth - MARGIN;
|
||||
if PanelLeft <> nil then
|
||||
begin
|
||||
@@ -3301,6 +3348,9 @@ begin
|
||||
BtnStartStop.ClrTextAct:= T.TbStartText;
|
||||
BtnStartStop.Invalidate;
|
||||
StyleButton(BtnSettings, False);
|
||||
// DX — тумблер подписей спотов: состояние берём из самой кнопки, как у
|
||||
// прочих тумблеров ниже (BtnCTun/BtnBeacon).
|
||||
if BtnDXCluster <> nil then StyleButton(BtnDXCluster, BtnDXCluster.Active);
|
||||
|
||||
// Обычные кнопки — все массивы
|
||||
for i := 0 to BAND_COUNT-1 do StyleButton(BtnBand[i], BtnBand[i].Active);
|
||||
@@ -3451,6 +3501,8 @@ begin
|
||||
if FCWMsgForm <> nil then TCWMessagesForm(FCWMsgForm).ApplyTheme(T);
|
||||
if FCWTermForm <> nil then TCWTerminalForm(FCWTermForm).ApplyTheme(T);
|
||||
if FBeaconScopeForm <> nil then FBeaconScopeForm.ApplyTheme(T);
|
||||
if FDXClusterForm <> nil then FDXClusterForm.ApplyTheme(T);
|
||||
if FDXSpotOverlay <> nil then FDXSpotOverlay.SetLightTheme(FLightTheme);
|
||||
FController.FSettings.SaveTheme(V);
|
||||
FController.FSettings.Save;
|
||||
if (FSettingsForm <> nil) and TSettingsForm(FSettingsForm).Visible then
|
||||
@@ -3690,6 +3742,9 @@ begin
|
||||
// отсекает неизменное → пересборки кэша на каждый вызов нет.
|
||||
if Assigned(FBandPlanOverlay) then
|
||||
FBandPlanOverlay.SetView(ViewCenter, ViewSpan);
|
||||
// Подписи спотов — тот же видимый домен, что у бэндплана.
|
||||
if Assigned(FDXSpotOverlay) then
|
||||
FDXSpotOverlay.SetView(ViewCenter, ViewSpan);
|
||||
if UpdateWidebandFrequencyView and FController.FShowWideband and (PbWideband <> nil) then
|
||||
PbWideband.Invalidate;
|
||||
UpdatePanZoomBar; // линейка пана следует за частотой/зумом (no-op если без изменений)
|
||||
@@ -3714,6 +3769,9 @@ var
|
||||
PeakDiff, MinDiff: Double;
|
||||
PeakAlpha, MinAlpha: Double;
|
||||
begin
|
||||
// Затухание спотов не зависит от того, крутится ли приём.
|
||||
ServiceDXCluster;
|
||||
|
||||
if not FController.FRunning then
|
||||
begin
|
||||
if PbSMeterRight <> nil then PbSMeterRight.Invalidate;
|
||||
@@ -4947,6 +5005,186 @@ begin
|
||||
StyleButton(BtnRxMute, FController.FRxMuteOnTx);
|
||||
end;
|
||||
|
||||
// ═══════════════════════════════════════════════════════════════════════════
|
||||
// DX-кластер: база спотов + telnet-клиент + оверлей подписей на спектре
|
||||
// ═══════════════════════════════════════════════════════════════════════════
|
||||
|
||||
function DXModeSetFromMask(Mask: LongWord): TDXModeSet;
|
||||
// Маска настроек → множество мод. 0 = без фильтра (показываем всё).
|
||||
var M: TDXMode;
|
||||
begin
|
||||
Result := [];
|
||||
if Mask = 0 then Exit;
|
||||
for M := Low(TDXMode) to High(TDXMode) do
|
||||
if (Mask and (LongWord(1) shl Ord(M))) <> 0 then Include(Result, M);
|
||||
end;
|
||||
|
||||
procedure TMainForm.InitDXCluster;
|
||||
begin
|
||||
FDXStore := TDXSpotStore.Create;
|
||||
FDXClient := TDXClusterClient.Create(FDXStore);
|
||||
|
||||
FDXSpotOverlay := TDXSpotOverlay.Create(Self);
|
||||
FDXSpotOverlay.Attach(FDXStore);
|
||||
FDXSpotOverlay.SetLightTheme(FLightTheme);
|
||||
FDXSpotOverlay.SetView(FController.FCenterFreq, FController.FSpanHz);
|
||||
FSpecView.DXSpotOverlay := FDXSpotOverlay;
|
||||
|
||||
FDXAgeTickAt := Now;
|
||||
FController.FSettings.LoadDXClusterSettings(FDXCfg);
|
||||
FDXStore.TTLMinutes := FDXCfg.TTLMinutes;
|
||||
ApplyDXClusterSettings(FDXCfg);
|
||||
// FDXConnCfg пуст → ApplyDXConnection увидит смену параметров и поднимет
|
||||
// соединение, если оно включено и позывной задан.
|
||||
ApplyDXConnection(FDXCfg);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ApplyDXClusterSettings(const D: TDXClusterSettings);
|
||||
// Вид: оверлей + кнопка. Применяется сразу на каждую правку в SETUP — это
|
||||
// дёшево, обратимо и даёт живой отклик. Всё, что МЕНЯЕТ ДАННЫЕ (TTL стора) или
|
||||
// трогает соединение, откладывается до CommitDXClusterSettings: набирая «30» в
|
||||
// поле TTL, пользователь на миг проходит через «3», а это выбросило бы из базы
|
||||
// все споты старше трёх минут — необратимо.
|
||||
begin
|
||||
FDXCfg := D;
|
||||
if FDXSpotOverlay <> nil then
|
||||
begin
|
||||
FDXSpotOverlay.MaxRows := D.MaxRows;
|
||||
FDXSpotOverlay.SetOwnCall(D.Login);
|
||||
FDXSpotOverlay.SetFilters(DXModeSetFromMask(D.ModeMask), D.TTLMinutes);
|
||||
FDXSpotOverlay.SetEnabled(D.ShowSpots);
|
||||
FDXSpotOverlay.Invalidate;
|
||||
end;
|
||||
UpdateDXClusterButton;
|
||||
FSpectrumDirty := True;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ApplyDXConnection(const D: TDXClusterSettings);
|
||||
// Соединение: конфиг в клиент + поднять/положить/переподнять. Поток снимает
|
||||
// конфиг один раз на сессию, поэтому смена адреса/учётки требует рестарта —
|
||||
// как у веб-сервера при смене порта.
|
||||
var Reconnect: Boolean;
|
||||
begin
|
||||
if FDXClient = nil then Exit;
|
||||
Reconnect := (D.Host <> FDXConnCfg.Host) or (D.Port <> FDXConnCfg.Port) or
|
||||
(D.Login <> FDXConnCfg.Login) or
|
||||
(D.Password <> FDXConnCfg.Password) or
|
||||
(D.PostLogin <> FDXConnCfg.PostLogin);
|
||||
FDXConnCfg := D;
|
||||
FDXClient.Configure(D.Host, D.Port, D.Login, D.Password, D.PostLogin);
|
||||
|
||||
// Без позывного логиниться нечем — не поднимаем соединение вообще.
|
||||
if (not D.Enabled) or (Trim(D.Login) = '') then
|
||||
begin
|
||||
if FDXClient.Running then FDXClient.Stop;
|
||||
Exit;
|
||||
end;
|
||||
if FDXClient.Running then
|
||||
begin
|
||||
if not Reconnect then Exit;
|
||||
FDXClient.Stop;
|
||||
end;
|
||||
FDXClient.Start;
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnDXClusterSettingsChange(const D: TDXClusterSettings);
|
||||
// Каждая правка в SETUP прилетает сюда ПОСИМВОЛЬНО (OnChange поля). Вид
|
||||
// применяем сразу, а запись в конфиг и переподключение откладываем: иначе
|
||||
// набор позывного «UA3XYZ» дёргал бы шесть реконнектов и шесть записей JSON.
|
||||
begin
|
||||
ApplyDXClusterSettings(D);
|
||||
FDXPendingCfg := D;
|
||||
FDXPendingAt := Now;
|
||||
FDXPending := True;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CommitDXClusterSettings;
|
||||
// Отложенный коммит правок SETUP: пользователь перестал печатать.
|
||||
begin
|
||||
FDXPending := False;
|
||||
FController.FSettings.SaveDXClusterSettings(FDXPendingCfg);
|
||||
if FDXStore <> nil then FDXStore.TTLMinutes := FDXPendingCfg.TTLMinutes;
|
||||
ApplyDXConnection(FDXPendingCfg);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ServiceDXCluster;
|
||||
// Раз в DX_AGE_TICK_SEC подталкиваем оверлей пересобраться: споты тускнеют с
|
||||
// возрастом и уходят по TTL, а без нового спота версия стора не меняется и
|
||||
// повода для пересборки бы не было. Реже — незаметно, чаще — впустую.
|
||||
const
|
||||
DX_AGE_TICK_SEC = 30;
|
||||
DX_SETTINGS_QUIET_MS = 1200; // тишина в SETUP, после которой коммитим
|
||||
begin
|
||||
// Отложенный коммит настроек: пользователь перестал печатать в SETUP.
|
||||
if FDXPending and (MilliSecondsBetween(Now, FDXPendingAt) >= DX_SETTINGS_QUIET_MS) then
|
||||
CommitDXClusterSettings;
|
||||
|
||||
if FDXSpotOverlay = nil then Exit;
|
||||
if SecondsBetween(Now, FDXAgeTickAt) < DX_AGE_TICK_SEC then Exit;
|
||||
FDXAgeTickAt := Now;
|
||||
if not FDXSpotOverlay.Active then Exit;
|
||||
FDXSpotOverlay.TickAge;
|
||||
FSpectrumDirty := True;
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdateDXClusterButton;
|
||||
begin
|
||||
if BtnDXCluster = nil then Exit;
|
||||
StyleButton(BtnDXCluster,
|
||||
(FDXSpotOverlay <> nil) and FDXSpotOverlay.Active);
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnDXClusterClick(Sender: TObject);
|
||||
// ЛКМ — показывать/не показывать подписи спотов на спектре (настройка живёт
|
||||
// в конфиге, чтобы состояние пережило перезапуск).
|
||||
begin
|
||||
if FDXSpotOverlay = nil then Exit;
|
||||
FDXCfg.ShowSpots := not FDXCfg.ShowSpots;
|
||||
FDXSpotOverlay.SetEnabled(FDXCfg.ShowSpots);
|
||||
FController.FSettings.SaveDXClusterSettings(FDXCfg);
|
||||
UpdateDXClusterButton;
|
||||
FSpectrumDirty := True;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnDXClusterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if Button = mbRight then ShowDXClusterForm;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ShowDXClusterForm;
|
||||
begin
|
||||
if FDXClusterForm = nil then
|
||||
begin
|
||||
FDXClusterForm := TDXClusterForm.CreateWith(Self, FDXStore, FDXClient);
|
||||
FDXClusterForm.OnTuneSpot := OnDXTuneSpot;
|
||||
end;
|
||||
FDXClusterForm.ApplyTheme(CurrentAppTheme);
|
||||
if FDXClusterForm.Visible then FDXClusterForm.Hide
|
||||
else FDXClusterForm.Show;
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnDXTuneSpot(FreqHz: Double; Mode: TDXMode);
|
||||
// QSY по споту: клик по подписи на спектре или двойной клик в окне списка.
|
||||
// Мода ставится только когда она однозначна из комментария кластера; при
|
||||
// dxmUnknown текущую не трогаем — гадать хуже, чем не менять.
|
||||
var NewMode: Integer;
|
||||
begin
|
||||
if FreqHz <= 0 then Exit;
|
||||
ApplyVfoA(Round(FreqHz));
|
||||
NewMode := -1;
|
||||
case Mode of
|
||||
dxmCW: NewMode := MODE_CWU;
|
||||
// Боковая по общепринятому правилу: ниже 10 МГц — LSB, выше — USB.
|
||||
dxmSSB: if FreqHz < 10000000.0 then NewMode := MODE_LSB else NewMode := MODE_USB;
|
||||
dxmFT8, dxmFT4, dxmDigi, dxmRTTY, dxmPSK: NewMode := MODE_DIGU;
|
||||
dxmSSTV: NewMode := MODE_USB;
|
||||
dxmFM: NewMode := MODE_FM;
|
||||
end;
|
||||
if (NewMode >= 0) and (NewMode <> FController.FMode) then
|
||||
FController.SetMode(NewMode);
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdateBandPlanOverlay;
|
||||
// Полоска бэндплана видна только в QO-100 (Pluto + full-duplex транспондер).
|
||||
begin
|
||||
@@ -5251,7 +5489,9 @@ end;
|
||||
// Спектр
|
||||
procedure TMainForm.PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
var VC, VS: Double;
|
||||
var
|
||||
VC, VS: Double;
|
||||
DXSpot: TDXSpot;
|
||||
begin
|
||||
if FPan.DispatchFlagsMouseDown(Button, X, Y) then
|
||||
begin
|
||||
@@ -5261,6 +5501,15 @@ begin
|
||||
if Assigned(FSampleRateOverlay) and
|
||||
FSampleRateOverlay.HandleMouseDown(Button, X, Y) then Exit;
|
||||
|
||||
// ЛКМ по подписи DX-спота — QSY на него. Проверяется до тюнинга/драга, но
|
||||
// только в полосе подписей вверху: ниже неё поведение спектра прежнее.
|
||||
if (Button = mbLeft) and Assigned(FDXSpotOverlay) and
|
||||
FDXSpotOverlay.SpotAtPixel(X, Y, DXSpot) then
|
||||
begin
|
||||
OnDXTuneSpot(DXSpot.FreqHz, DXSpot.Mode);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Ctrl+ЛКМ по спектру — добавить софт-слайс на этой частоте (в пределах захвата).
|
||||
if (Button = mbLeft) and (ssCtrl in Shift) and (PbSpectrum.Width > 0) then
|
||||
begin
|
||||
@@ -9286,6 +9535,7 @@ begin
|
||||
SF.OnWfAGCNFChange := ApplyWfAGCNF;
|
||||
SF.OnADCChange := ApplyADCSettings;
|
||||
SF.OnWebSettingsChange := ApplyWebSettings;
|
||||
SF.OnDXClusterChange := OnDXClusterSettingsChange;
|
||||
end;
|
||||
SF := TSettingsForm(FSettingsForm);
|
||||
PushTXProfilesToSettings;
|
||||
@@ -9340,6 +9590,7 @@ begin
|
||||
SF.LoadADCSettings(FController.FDitherEnabled, FController.FRandomEnabled);
|
||||
SF.LoadWebSettings(FWebEnabled, FWebPort, FWebBindAddr, FWebUser, FWebPass,
|
||||
FWebSpecPixels);
|
||||
SF.LoadDXClusterSettings(FDXCfg);
|
||||
SF.LoadFPS(FDisplayFPS);
|
||||
SF.LoadLightTheme(FLightTheme);
|
||||
SF.LoadFreqMhzDigits(FFreqMhzDigits);
|
||||
|
||||
@@ -427,6 +427,25 @@ type
|
||||
end;
|
||||
|
||||
// Web-сервер — глобальные настройки (не привязаны к устройству, секция "web").
|
||||
// DX-кластер: телнет-соединение + вид спотов на панадаптере.
|
||||
// Хранится глобально (секция "dxcluster"), не per-device: кластер и позывной
|
||||
// от железа не зависят.
|
||||
TDXClusterSettings = record
|
||||
Enabled: Boolean; // подключаться при старте
|
||||
ShowSpots: Boolean; // рисовать оверлей на спектре
|
||||
Host: string;
|
||||
Port: Integer; // 1..65535
|
||||
Login: string; // позывной для логина в кластер (он же «свой» в оверлее)
|
||||
Password: string; // редкий кластер спрашивает — обычно пусто
|
||||
PostLogin: string; // команды после логина (по строке; сюда же set/filter)
|
||||
TTLMinutes: Integer; // сколько держать спот (он же горизонт затухания)
|
||||
MaxRows: Integer; // рядов лесенки подписей (1..DXSPOT_MAX_ROWS)
|
||||
// Фильтр по модам. Пустая маска = показывать все (в т.ч. неопознанные).
|
||||
// Биты соответствуют TDXMode: 1=CW,2=SSB,3=DIGI,4=FT8,5=FT4,6=RTTY,7=PSK,
|
||||
// 8=FM,9=SSTV; бит 0 = споты без распознанной моды.
|
||||
ModeMask: LongWord;
|
||||
end;
|
||||
|
||||
TWebSettings = record
|
||||
Enabled: Boolean;
|
||||
Port: Integer; // 1..65535
|
||||
@@ -754,6 +773,9 @@ type
|
||||
function LoadPans(const MAC: array of Byte; const Ctx: string; out P: TPansConfig): Boolean;
|
||||
procedure SavePans(const MAC: array of Byte; const Ctx: string; const P: TPansConfig);
|
||||
// Web-сервер — глобальные настройки (секция "web" в корне JSON).
|
||||
class procedure DefaultDXCluster(out D: TDXClusterSettings);
|
||||
procedure LoadDXClusterSettings(out D: TDXClusterSettings);
|
||||
procedure SaveDXClusterSettings(const D: TDXClusterSettings);
|
||||
class procedure DefaultWeb(out W: TWebSettings);
|
||||
procedure LoadWebSettings(out W: TWebSettings);
|
||||
procedure SaveWebSettings(const W: TWebSettings);
|
||||
@@ -2873,6 +2895,55 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TSettingsManager.DefaultDXCluster(out D: TDXClusterSettings);
|
||||
begin
|
||||
D.Enabled := False; // без позывного подключаться всё равно нечем
|
||||
D.ShowSpots := True;
|
||||
D.Host := 'cluster.dxfun.com';
|
||||
D.Port := 8000;
|
||||
D.Login := '';
|
||||
D.Password := '';
|
||||
D.PostLogin := '';
|
||||
D.TTLMinutes := 30;
|
||||
D.MaxRows := 4;
|
||||
D.ModeMask := 0; // 0 = без фильтра по модам
|
||||
end;
|
||||
|
||||
procedure TSettingsManager.LoadDXClusterSettings(out D: TDXClusterSettings);
|
||||
var O: TJSONObject;
|
||||
begin
|
||||
DefaultDXCluster(D);
|
||||
if FRoot.Find('dxcluster') = nil then Exit;
|
||||
O := EnsureObj(FRoot, 'dxcluster');
|
||||
D.Enabled := JB(O, 'enabled', False);
|
||||
D.ShowSpots := JB(O, 'show_spots', True);
|
||||
D.Host := JS(O, 'host', 'cluster.dxfun.com');
|
||||
D.Port := EnsureRange(JI(O, 'port', 8000), 1, 65535);
|
||||
D.Login := JS(O, 'login', '');
|
||||
D.Password := JS(O, 'password', '');
|
||||
D.PostLogin := JS(O, 'post_login', '');
|
||||
D.TTLMinutes := EnsureRange(JI(O, 'ttl_minutes', 30), 1, 1440);
|
||||
D.MaxRows := EnsureRange(JI(O, 'max_rows', 4), 1, 6);
|
||||
D.ModeMask := LongWord(JI(O, 'mode_mask', 0));
|
||||
end;
|
||||
|
||||
procedure TSettingsManager.SaveDXClusterSettings(const D: TDXClusterSettings);
|
||||
var O: TJSONObject;
|
||||
begin
|
||||
O := EnsureObj(FRoot, 'dxcluster');
|
||||
JW(O, 'enabled', D.Enabled);
|
||||
JW(O, 'show_spots', D.ShowSpots);
|
||||
JWS(O, 'host', D.Host);
|
||||
JW(O, 'port', D.Port);
|
||||
JWS(O, 'login', D.Login);
|
||||
JWS(O, 'password', D.Password);
|
||||
JWS(O, 'post_login', D.PostLogin);
|
||||
JW(O, 'ttl_minutes', D.TTLMinutes);
|
||||
JW(O, 'max_rows', D.MaxRows);
|
||||
JW(O, 'mode_mask', Integer(D.ModeMask));
|
||||
Save;
|
||||
end;
|
||||
|
||||
class procedure TSettingsManager.DefaultWeb(out W: TWebSettings);
|
||||
begin
|
||||
W.Enabled := True;
|
||||
|
||||
+258
-1
@@ -28,7 +28,7 @@ uses
|
||||
Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls, LCLType,
|
||||
FlatButton, FlatCheckBox, FlatComboBox, FlatEdit, FlatSpinEdit, FlatFloatSpinEdit,
|
||||
FlatRadioButton,
|
||||
FlatRadioButton, FlatMemo,
|
||||
EqualizerControl, OverlayScrollBar, AudioOutput, AudioInput, AppTheme, Settings,
|
||||
BoardUtils, DpiUtils;
|
||||
|
||||
@@ -86,6 +86,10 @@ type
|
||||
TOnThemeChange = procedure(LightTheme: Boolean) of object;
|
||||
TOnWfAGCNFChange = procedure(WfAGC, WfNF: Boolean) of object;
|
||||
TOnADCChange = procedure(Dither, Random: Boolean) of object;
|
||||
// Настройки DX-кластера уезжают наружу целиком записью: полей много и
|
||||
// добавлять их по одному в сигнатуру (как у веб-сервера) уже неудобно.
|
||||
TOnDXClusterChange = procedure(const D: TDXClusterSettings) of object;
|
||||
|
||||
TOnWebSettingsChange = procedure(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr, User, Pass: string; SpecPixels: Integer) of object;
|
||||
TOnCATChange = procedure(
|
||||
@@ -124,6 +128,19 @@ type
|
||||
FPageWaterfall: TScrollBox;
|
||||
FPagePA: TScrollBox;
|
||||
FPageAdvanced: TScrollBox;
|
||||
FPageDXCluster: TScrollBox;
|
||||
// DX-кластер
|
||||
FChkDXEnabled: TFlatCheckBox;
|
||||
FChkDXShow: TFlatCheckBox;
|
||||
FEdDXHost: TFlatEdit;
|
||||
FEdDXPort: TFlatSpinEdit;
|
||||
FEdDXLogin: TFlatEdit;
|
||||
FEdDXPass: TFlatEdit;
|
||||
FEdDXPostLogin: TFlatMemo;
|
||||
FEdDXTTL: TFlatSpinEdit;
|
||||
FEdDXRows: TFlatSpinEdit;
|
||||
FChkDXMode: array[0..9] of TFlatCheckBox; // индекс = Ord(TDXMode)
|
||||
FDXCfg: TDXClusterSettings;
|
||||
FPageCAT: TScrollBox;
|
||||
FPageSlices: TScrollBox;
|
||||
FPageTransmit: TScrollBox;
|
||||
@@ -133,6 +150,7 @@ type
|
||||
FNavWaterfall: TFlatButton;
|
||||
FNavPA: TFlatButton;
|
||||
FNavAdvanced: TFlatButton;
|
||||
FNavDXCluster: TFlatButton;
|
||||
FNavCAT: TFlatButton;
|
||||
FNavSlices: TFlatButton;
|
||||
FNavTransmit: TFlatButton;
|
||||
@@ -465,6 +483,7 @@ type
|
||||
FOnVHFCalChange: TOnVHFCalChange;
|
||||
FOnADCChange: TOnADCChange;
|
||||
FOnWebSettingsChange: TOnWebSettingsChange;
|
||||
FOnDXClusterChange: TOnDXClusterChange;
|
||||
FOnDisplayChange: TOnDisplayParamChange;
|
||||
FOnWaterfallChange: TOnWaterfallParamChange;
|
||||
FOnWfRenderChange: TOnWfRenderChange;
|
||||
@@ -572,6 +591,8 @@ type
|
||||
OnChange: TNotifyEvent): TFlatComboBox;
|
||||
function MakeGroupPanel(AParent: TWinControl; const Cap: string;
|
||||
ALeft, ATop, AW, AH: Integer): TPanel;
|
||||
procedure BuildDXClusterTab;
|
||||
procedure OnDXAnyChange(Sender: TObject);
|
||||
function MakeScrollPage: TScrollBox;
|
||||
procedure AddPageBottomSpace(APage: TScrollBox);
|
||||
procedure UpdatePageBottomSpace(APage: TScrollBox);
|
||||
@@ -696,6 +717,7 @@ type
|
||||
ResLimit, SpeedDiv: Integer);
|
||||
procedure LoadSpecMSAA(Samples: Integer);
|
||||
procedure LoadADCSettings(Dither, Random: Boolean);
|
||||
procedure LoadDXClusterSettings(const D: TDXClusterSettings);
|
||||
procedure LoadWebSettings(Enabled: Boolean; Port: Integer;
|
||||
const BindAddr, User, Pass: string; SpecPixels: Integer);
|
||||
|
||||
@@ -734,6 +756,7 @@ type
|
||||
property OnWfAGCNFChange: TOnWfAGCNFChange read FOnWfAGCNFChange write FOnWfAGCNFChange;
|
||||
property OnADCChange: TOnADCChange read FOnADCChange write FOnADCChange;
|
||||
property OnWebSettingsChange: TOnWebSettingsChange read FOnWebSettingsChange write FOnWebSettingsChange;
|
||||
property OnDXClusterChange: TOnDXClusterChange read FOnDXClusterChange write FOnDXClusterChange;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -1113,6 +1136,7 @@ begin
|
||||
FNavCAT := MakeNavButton('CAT', 496);
|
||||
FNavSlices := MakeNavButton('Slices', 528);
|
||||
FNavAdvanced := MakeNavButton('Advanced', 560);
|
||||
FNavDXCluster := MakeNavButton('DX Cluster', 592);
|
||||
|
||||
FContentPanel := TPanel.Create(Self);
|
||||
FContentPanel.Parent := Self;
|
||||
@@ -1135,6 +1159,7 @@ begin
|
||||
FPagePA := MakeScrollPage;
|
||||
FPageCalib := MakeScrollPage;
|
||||
FPageAdvanced := MakeScrollPage;
|
||||
FPageDXCluster := MakeScrollPage;
|
||||
FPageCAT := MakeScrollPage;
|
||||
FPageSlices := MakeScrollPage;
|
||||
FPageAlex := MakeScrollPage;
|
||||
@@ -1154,6 +1179,7 @@ begin
|
||||
BuildPATab;
|
||||
BuildCalibrationTab;
|
||||
BuildAdvancedTab;
|
||||
BuildDXClusterTab;
|
||||
BuildCATTab;
|
||||
BuildSlicesTab;
|
||||
BuildAlexTab;
|
||||
@@ -1168,6 +1194,7 @@ begin
|
||||
AddPageBottomSpace(FPageWaterfall);
|
||||
AddPageBottomSpace(FPageCalib);
|
||||
AddPageBottomSpace(FPageCAT);
|
||||
AddPageBottomSpace(FPageDXCluster);
|
||||
AddPageBottomSpace(FPageOC);
|
||||
|
||||
FBtnClose := TFlatButton.Create(Self);
|
||||
@@ -1390,6 +1417,7 @@ begin
|
||||
ResizePage(FPagePA, CardWidth);
|
||||
ResizePage(FPageCalib, CardWidth);
|
||||
ResizePage(FPageAdvanced, CardWidth);
|
||||
ResizePage(FPageDXCluster, CardWidth);
|
||||
ResizePage(FPageCAT, CardWidth);
|
||||
ResizePage(FPageSlices, CardWidth);
|
||||
ResizePage(FPageAlex, CardWidth);
|
||||
@@ -1408,6 +1436,7 @@ begin
|
||||
else if Sender = FNavPA then SelectPage(FPagePA, FNavPA)
|
||||
else if Sender = FNavCalib then SelectPage(FPageCalib, FNavCalib)
|
||||
else if Sender = FNavAdvanced then SelectPage(FPageAdvanced, FNavAdvanced)
|
||||
else if Sender = FNavDXCluster then SelectPage(FPageDXCluster, FNavDXCluster)
|
||||
else if Sender = FNavCAT then SelectPage(FPageCAT, FNavCAT)
|
||||
else if Sender = FNavSlices then SelectPage(FPageSlices, FNavSlices)
|
||||
else if Sender = FNavAlex then SelectPage(FPageAlex, FNavAlex)
|
||||
@@ -1429,6 +1458,7 @@ begin
|
||||
FPagePA.Visible := APage = FPagePA;
|
||||
FPageCalib.Visible := APage = FPageCalib;
|
||||
FPageAdvanced.Visible := APage = FPageAdvanced;
|
||||
FPageDXCluster.Visible := APage = FPageDXCluster;
|
||||
FPageCAT.Visible := APage = FPageCAT;
|
||||
FPageSlices.Visible := APage = FPageSlices;
|
||||
FPageAlex.Visible := APage = FPageAlex;
|
||||
@@ -1444,6 +1474,7 @@ begin
|
||||
FNavPA.Active := ANav = FNavPA;
|
||||
FNavCalib.Active := ANav = FNavCalib;
|
||||
FNavAdvanced.Active := ANav = FNavAdvanced;
|
||||
FNavDXCluster.Active := ANav = FNavDXCluster;
|
||||
FNavCAT.Active := ANav = FNavCAT;
|
||||
FNavSlices.Active := ANav = FNavSlices;
|
||||
FNavAlex.Active := ANav = FNavAlex;
|
||||
@@ -3412,6 +3443,227 @@ begin
|
||||
Lbl.Font.Size := 8;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.BuildDXClusterTab;
|
||||
const
|
||||
MARGIN = 22;
|
||||
GRP_PAD = 18;
|
||||
LBL_W = 110;
|
||||
ED_W = 220;
|
||||
ROW_H = 42;
|
||||
R1 = 42;
|
||||
// Подписи для чекбоксов фильтра мод. Порядок = Ord(TDXMode), включая
|
||||
// dxmUnknown («без моды») — иначе фильтр молча съедал бы такие споты.
|
||||
MODE_CAPS: array[0..9] of string =
|
||||
('no mode', 'CW', 'SSB', 'DIGI', 'FT8', 'FT4', 'RTTY', 'PSK', 'FM', 'SSTV');
|
||||
var
|
||||
Grp: TPanel;
|
||||
Chk: TFlatCheckBox;
|
||||
Ed: TFlatEdit;
|
||||
Spin: TFlatSpinEdit;
|
||||
Lbl: TLabel;
|
||||
Y, i, CX, CY: Integer;
|
||||
begin
|
||||
TSettingsManager.DefaultDXCluster(FDXCfg);
|
||||
|
||||
MakePageHeader(FPageDXCluster, 'DX Cluster',
|
||||
'Telnet connection to a DX cluster and how spots look on the panadapter.');
|
||||
|
||||
// ── Соединение ────────────────────────────────────────────────────────────
|
||||
Grp := MakeGroupPanel(FPageDXCluster, 'Connection', MARGIN, 86, SETTINGS_CARD_W, 366);
|
||||
|
||||
Y := R1;
|
||||
Chk := TFlatCheckBox.Create(Self);
|
||||
Chk.Parent := Grp;
|
||||
Chk.Caption := 'Connect at startup';
|
||||
Chk.SetBounds(DpiScale(GRP_PAD), DpiScale(Y), DpiScale(300), DpiScale(22));
|
||||
Chk.Font.Size := 9;
|
||||
Chk.Font.Color := CLR_TEXT;
|
||||
Chk.OnChange := OnDXAnyChange;
|
||||
FChkDXEnabled := Chk;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Host:', 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 := FDXCfg.Host;
|
||||
Ed.OnChange := OnDXAnyChange;
|
||||
FEdDXHost := Ed;
|
||||
|
||||
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 := FDXCfg.Port;
|
||||
Spin.OnChange := OnDXAnyChange;
|
||||
FEdDXPort := Spin;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Callsign:', GRP_PAD, Y + 4, LBL_W);
|
||||
Ed := TFlatEdit.Create(Self);
|
||||
Ed.Parent := Grp;
|
||||
Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(140), DpiScale(BTN_H));
|
||||
Ed.Color := CLR_INPUT;
|
||||
Ed.Font.Color := CLR_INPUT_TEXT;
|
||||
Ed.Font.Size := 9;
|
||||
Ed.OnChange := OnDXAnyChange;
|
||||
FEdDXLogin := Ed;
|
||||
Lbl := MakeLbl(Grp, 'used to log in; spots for this call are highlighted',
|
||||
GRP_PAD + LBL_W + 12 + 150, Y + 4, 340);
|
||||
Lbl.Font.Size := 8;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Password:', GRP_PAD, Y + 4, LBL_W);
|
||||
Ed := TFlatEdit.Create(Self);
|
||||
Ed.Parent := Grp;
|
||||
Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(140), DpiScale(BTN_H));
|
||||
Ed.Color := CLR_INPUT;
|
||||
Ed.Font.Color := CLR_INPUT_TEXT;
|
||||
Ed.Font.Size := 9;
|
||||
Ed.PasswordChar := '*';
|
||||
Ed.OnChange := OnDXAnyChange;
|
||||
FEdDXPass := Ed;
|
||||
Lbl := MakeLbl(Grp, 'usually not needed', GRP_PAD + LBL_W + 12 + 150, Y + 4, 200);
|
||||
Lbl.Font.Size := 8;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'After login:', GRP_PAD, Y + 4, LBL_W);
|
||||
FEdDXPostLogin := TFlatMemo.Create(Self);
|
||||
FEdDXPostLogin.Parent := Grp;
|
||||
FEdDXPostLogin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y),
|
||||
DpiScale(ED_W + 120), DpiScale(70));
|
||||
FEdDXPostLogin.Color := CLR_INPUT;
|
||||
FEdDXPostLogin.Font.Color := CLR_INPUT_TEXT;
|
||||
FEdDXPostLogin.Font.Size := 9;
|
||||
FEdDXPostLogin.WordWrap := False;
|
||||
FEdDXPostLogin.OnChange := OnDXAnyChange;
|
||||
Lbl := MakeLbl(Grp, 'one command per line (set/filter, sh/dx …) — dialects differ between clusters',
|
||||
GRP_PAD, Y + 76, 520);
|
||||
Lbl.Font.Size := 8;
|
||||
|
||||
// ── Отображение ───────────────────────────────────────────────────────────
|
||||
Grp := MakeGroupPanel(FPageDXCluster, 'Spots on panadapter', MARGIN, 468,
|
||||
SETTINGS_CARD_W, 292);
|
||||
|
||||
Y := R1;
|
||||
Chk := TFlatCheckBox.Create(Self);
|
||||
Chk.Parent := Grp;
|
||||
Chk.Caption := 'Show spots on the spectrum';
|
||||
Chk.SetBounds(DpiScale(GRP_PAD), DpiScale(Y), DpiScale(300), DpiScale(22));
|
||||
Chk.Font.Size := 9;
|
||||
Chk.Font.Color := CLR_TEXT;
|
||||
Chk.OnChange := OnDXAnyChange;
|
||||
FChkDXShow := Chk;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Keep for, min:', 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 := 1440;
|
||||
Spin.Value := FDXCfg.TTLMinutes;
|
||||
Spin.OnChange := OnDXAnyChange;
|
||||
FEdDXTTL := Spin;
|
||||
Lbl := MakeLbl(Grp, 'also the fade horizon: a spot dims and then disappears',
|
||||
GRP_PAD + LBL_W + 114, Y + 4, 360);
|
||||
Lbl.Font.Size := 8;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Label rows:', 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 := 6;
|
||||
Spin.Value := FDXCfg.MaxRows;
|
||||
Spin.OnChange := OnDXAnyChange;
|
||||
FEdDXRows := Spin;
|
||||
Lbl := MakeLbl(Grp, 'ladder height: more rows means fewer hidden spots',
|
||||
GRP_PAD + LBL_W + 114, Y + 4, 360);
|
||||
Lbl.Font.Size := 8;
|
||||
|
||||
Y := Y + ROW_H;
|
||||
MakeLbl(Grp, 'Modes:', GRP_PAD, Y + 4, LBL_W);
|
||||
CX := GRP_PAD + LBL_W + 12;
|
||||
CY := Y;
|
||||
for i := 0 to High(FChkDXMode) do
|
||||
begin
|
||||
Chk := TFlatCheckBox.Create(Self);
|
||||
Chk.Parent := Grp;
|
||||
Chk.Caption := MODE_CAPS[i];
|
||||
Chk.SetBounds(DpiScale(CX), DpiScale(CY), DpiScale(90), DpiScale(22));
|
||||
Chk.Font.Size := 9;
|
||||
Chk.Font.Color := CLR_TEXT;
|
||||
Chk.OnChange := OnDXAnyChange;
|
||||
FChkDXMode[i] := Chk;
|
||||
CX := CX + 96;
|
||||
if CX > 480 then begin CX := GRP_PAD + LBL_W + 12; CY := CY + 26; end;
|
||||
end;
|
||||
Lbl := MakeLbl(Grp, 'none checked — every spot is shown',
|
||||
GRP_PAD + LBL_W + 12, CY + 28, 360);
|
||||
Lbl.Font.Size := 8;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.OnDXAnyChange(Sender: TObject);
|
||||
var i: Integer;
|
||||
begin
|
||||
if FLoading then Exit;
|
||||
if not Assigned(FOnDXClusterChange) then Exit;
|
||||
FDXCfg.Enabled := FChkDXEnabled.Checked;
|
||||
FDXCfg.ShowSpots := FChkDXShow.Checked;
|
||||
FDXCfg.Host := Trim(FEdDXHost.Text);
|
||||
FDXCfg.Port := FEdDXPort.Value;
|
||||
FDXCfg.Login := Trim(FEdDXLogin.Text);
|
||||
FDXCfg.Password := FEdDXPass.Text;
|
||||
FDXCfg.PostLogin := FEdDXPostLogin.Text;
|
||||
FDXCfg.TTLMinutes := FEdDXTTL.Value;
|
||||
FDXCfg.MaxRows := FEdDXRows.Value;
|
||||
FDXCfg.ModeMask := 0;
|
||||
for i := 0 to High(FChkDXMode) do
|
||||
if (FChkDXMode[i] <> nil) and FChkDXMode[i].Checked then
|
||||
FDXCfg.ModeMask := FDXCfg.ModeMask or (LongWord(1) shl i);
|
||||
FOnDXClusterChange(FDXCfg);
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.LoadDXClusterSettings(const D: TDXClusterSettings);
|
||||
var i: Integer;
|
||||
begin
|
||||
FLoading := True;
|
||||
try
|
||||
FDXCfg := D;
|
||||
FChkDXEnabled.Checked := D.Enabled;
|
||||
FChkDXShow.Checked := D.ShowSpots;
|
||||
FEdDXHost.Text := D.Host;
|
||||
FEdDXPort.Value := EnsureRange(D.Port, 1, 65535);
|
||||
FEdDXLogin.Text := D.Login;
|
||||
FEdDXPass.Text := D.Password;
|
||||
FEdDXPostLogin.Text := D.PostLogin;
|
||||
FEdDXTTL.Value := EnsureRange(D.TTLMinutes, 1, 1440);
|
||||
FEdDXRows.Value := EnsureRange(D.MaxRows, 1, 6);
|
||||
for i := 0 to High(FChkDXMode) do
|
||||
if FChkDXMode[i] <> nil then
|
||||
FChkDXMode[i].Checked := (D.ModeMask and (LongWord(1) shl i)) <> 0;
|
||||
finally
|
||||
FLoading := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.OnADCChkChange(Sender: TObject);
|
||||
begin
|
||||
if FLoading then Exit;
|
||||
@@ -3540,6 +3792,11 @@ procedure TSettingsForm.ApplyTheme(const T: TAppTheme);
|
||||
TFlatFloatSpinEdit(Ctrl).SetAppTheme(T)
|
||||
else if Ctrl is TFlatRadioButton then
|
||||
TFlatRadioButton(Ctrl).SetAppTheme(T)
|
||||
// TFlatMemo — обёртка над TMemo со своим scrollbar: тему знает сама,
|
||||
// рекурсивный обход внутрь ей только навредил бы (внутренний TMemo не
|
||||
// подходит ни под одну ветку и остался бы серым).
|
||||
else if Ctrl is TFlatMemo then
|
||||
TFlatMemo(Ctrl).SetAppTheme(T)
|
||||
else if Ctrl is TListBox then
|
||||
begin
|
||||
TListBox(Ctrl).Color := T.BG;
|
||||
|
||||
+32
-1
@@ -20,7 +20,7 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, Graphics, GraphType, ExtCtrls, Controls, Math,
|
||||
AppTheme,
|
||||
AlertOverlay, SampleRateOverlay, VfoOverlay, BandPlanOverlay,
|
||||
AlertOverlay, SampleRateOverlay, VfoOverlay, BandPlanOverlay, DXSpotOverlay,
|
||||
WaterfallView, SMeterView, RulerView, RadioModes,
|
||||
Settings; // FilterEdgesFromBW — единственная таблица знака боковой
|
||||
|
||||
@@ -106,6 +106,7 @@ type
|
||||
FVfoOverlay: TVfoOverlay;
|
||||
FSliceOverlays: TFPList; // доп. слайс-флаги (B+); не владеет (владелец MainForm)
|
||||
FBandPlanOverlay: TBandPlanOverlay;
|
||||
FDXSpotOverlay: TDXSpotOverlay; // споты DX-кластера (полоса подписей + штрихи)
|
||||
// ── Marker ────────────────────────────────────────────────────────────────
|
||||
FMarkerActive: Boolean;
|
||||
FMarkerX: Integer;
|
||||
@@ -172,6 +173,9 @@ type
|
||||
procedure DrawSliceFilterLinesRaw(W, H: Integer);
|
||||
procedure DrawBandLetterRaw(X1, X2: Integer; L: Char; Clr: TColor);
|
||||
procedure DrawBeaconMarkersRaw(W, H: Integer);
|
||||
// Штрихи DX-спотов ниже полосы подписей. Раскладка уже посчитана оверлеем
|
||||
// при пересборке кэша — здесь только N вертикальных линий.
|
||||
procedure DrawDXSpotTicksRaw(W, H: Integer);
|
||||
// 2TON/IMD: замер пиков по TX-буферу (общий для CPU/GL рендеров).
|
||||
// Возвращает число валидных маркеров в M (0 если измерять нечего):
|
||||
// [0..1] тона, [2..3] IMD3 (2f1−f2, 2f2−f1). Обновляет FIMDSummary.
|
||||
@@ -318,6 +322,7 @@ type
|
||||
function SliceOverlayCount: Integer;
|
||||
function SliceOverlayAt(Index: Integer): TVfoOverlay;
|
||||
property BandPlanOverlay: TBandPlanOverlay read FBandPlanOverlay write FBandPlanOverlay;
|
||||
property DXSpotOverlay: TDXSpotOverlay read FDXSpotOverlay write FDXSpotOverlay;
|
||||
|
||||
// ── Данные от DSP ─────────────────────────────────────────────────────────
|
||||
procedure SetSpectrumData(const Pixels: array of Single; Count: Integer); virtual;
|
||||
@@ -669,6 +674,23 @@ begin
|
||||
FBeaconDecHalf := HalfHz;
|
||||
end;
|
||||
|
||||
procedure TSpectrumView.DrawDXSpotTicksRaw(W, H: Integer);
|
||||
// Штрих от низа полосы подписей до низа спектра — по одному на видимый спот.
|
||||
// Пунктиром, чтобы не спорить с кривой сигнала и краями фильтра. Раскладка
|
||||
// готова (EnsureRendered в начале кадра), здесь только N линий.
|
||||
var
|
||||
i, X: Integer;
|
||||
Col: TColor;
|
||||
begin
|
||||
if (FDXSpotOverlay = nil) or (not FDXSpotOverlay.Active) then Exit;
|
||||
for i := 0 to FDXSpotOverlay.TickCount - 1 do
|
||||
begin
|
||||
FDXSpotOverlay.Tick(i, X, Col);
|
||||
if (X < 0) or (X >= W) then Continue;
|
||||
RawVLine(X, FDXSpotOverlay.BandHeight, H - 1, Col, 1, 2, 3);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSpectrumView.DrawBeaconMarkersRaw(W, H: Integer);
|
||||
// Две вертикали: опорная частота маяка (зелёная пунктир) и отслеживаемый
|
||||
// центроид (оранжевая сплошная). Расхождение видно глазом → понятно, сел ли
|
||||
@@ -1705,6 +1727,10 @@ begin
|
||||
FSpPts[W] := Point(W-1, H); FSpPts[W+1] := Point(0, H);
|
||||
|
||||
|
||||
// Раскладка спотов — ДО RawBegin: штрихи в фазе raw берут из неё готовые X,
|
||||
// а сама пересборка идёт на своём кэш-битмапе и только по dirty-ключу.
|
||||
if Assigned(FDXSpotOverlay) then FDXSpotOverlay.EnsureRendered(W);
|
||||
|
||||
// ═══ Фаза 1: raw — весь кадр одним локом ═════════════════════════════════
|
||||
{$IFDEF DARWIN}
|
||||
// Cocoa-вариант CopyGridToSpectrum идёт через Canvas.Draw — до RawBegin.
|
||||
@@ -1794,6 +1820,8 @@ begin
|
||||
|
||||
if FMarkerActive then DrawMarkerLineRaw(W, H);
|
||||
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersRaw(W, H);
|
||||
// Штрихи DX-спотов — под маркерами наведения, но над кривой.
|
||||
DrawDXSpotTicksRaw(W, H);
|
||||
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
|
||||
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
|
||||
if FIMDActive then DrawIMDMarkersRaw(W, H, DBmax, InvRange);
|
||||
@@ -1809,6 +1837,9 @@ begin
|
||||
// Бэндплан QO-100 — полоска внизу спектра, под панелями оверлеев.
|
||||
if Assigned(FBandPlanOverlay) then
|
||||
FBandPlanOverlay.DrawOverlay(FSpectrumBitmap, W, H);
|
||||
// Полоса подписей DX-спотов — вверху спектра, под флагами VFO.
|
||||
if Assigned(FDXSpotOverlay) then
|
||||
FDXSpotOverlay.DrawOverlay(FSpectrumBitmap, W, H);
|
||||
if Assigned(FSampleRateOverlay) then
|
||||
FSampleRateOverlay.DrawOverlay(FSpectrumBitmap, C, W, H);
|
||||
if Assigned(FVfoOverlay) then
|
||||
|
||||
@@ -18,6 +18,7 @@ uses
|
||||
Classes, SysUtils, Graphics, Controls, Math, Types,
|
||||
OpenGLContextEx, GL,
|
||||
AppTheme, AlertOverlay, SpectrumView, VfoOverlay, BandPlanOverlay,
|
||||
DXSpotOverlay,
|
||||
WaterfallView, WaterfallViewOpengl;
|
||||
|
||||
type
|
||||
@@ -36,6 +37,7 @@ type
|
||||
FSampleOverlayDirty: Boolean;
|
||||
FVfoOverlayDirty: Boolean;
|
||||
FBandOverlayDirty: Boolean;
|
||||
FDXOverlayDirty: Boolean;
|
||||
FGridLabelTex: TGLTextureCache;
|
||||
FAGCLabelTex: TGLTextureCache;
|
||||
FAGCHangLabelTex: TGLTextureCache;
|
||||
@@ -44,6 +46,7 @@ type
|
||||
FSampleOverlayTex: TGLTextureCache;
|
||||
FVfoOverlayTex: TGLTextureCache;
|
||||
FBandOverlayTex: TGLTextureCache;
|
||||
FDXOverlayTex: TGLTextureCache;
|
||||
// Текстуры флагов слайсов (B+), привязка по указателю оверлея.
|
||||
FSliceTex: array of record
|
||||
Overlay: TVfoOverlay;
|
||||
@@ -72,6 +75,8 @@ type
|
||||
FLastBandW: Integer;
|
||||
FLastBandCenter: Double;
|
||||
FLastBandSpan: Double;
|
||||
FLastDXW: Integer;
|
||||
FLastDXRender: Int64;
|
||||
FGLSpectrumW: Integer;
|
||||
FGLSpectrumH: Integer;
|
||||
FSpY: array of Integer;
|
||||
@@ -93,6 +98,7 @@ type
|
||||
procedure DrawSpectrumCurve(W, H: Integer; DBmax, InvRange: Double);
|
||||
procedure DrawMarker(W, H: Integer);
|
||||
procedure DrawBeaconMarkersGL(W, H: Integer);
|
||||
procedure DrawDXSpotTicksGL(W, H: Integer);
|
||||
procedure DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
|
||||
procedure DrawIMDMarkersGL(W, H: Integer; DBmax, InvRange: Double);
|
||||
procedure DrawADCOverlay(W, H: Integer);
|
||||
@@ -152,8 +158,10 @@ begin
|
||||
FSampleOverlayDirty := True;
|
||||
FVfoOverlayDirty := True;
|
||||
FBandOverlayDirty := True;
|
||||
FDXOverlayDirty := True;
|
||||
FLastBandW := -MaxInt;
|
||||
FLastBandCenter := -1; FLastBandSpan := -1;
|
||||
FLastDXW := -MaxInt; FLastDXRender := -1;
|
||||
FLastAGCY := -MaxInt;
|
||||
FLastAGCHangY := -MaxInt;
|
||||
FLastMarkerX := -MaxInt;
|
||||
@@ -173,6 +181,7 @@ begin
|
||||
DeleteTexture(FSampleOverlayTex);
|
||||
DeleteTexture(FVfoOverlayTex);
|
||||
DeleteTexture(FBandOverlayTex);
|
||||
DeleteTexture(FDXOverlayTex);
|
||||
for i := 0 to High(FSliceTex) do DeleteTexture(FSliceTex[i].Tex);
|
||||
for i := 0 to High(FLetterTex) do DeleteTexture(FLetterTex[i]);
|
||||
for i := 0 to High(FIMDLabelTex) do DeleteTexture(FIMDLabelTex[i]);
|
||||
@@ -454,6 +463,7 @@ begin
|
||||
Zap(FADCOverlayTex);
|
||||
Zap(FSampleOverlayTex);
|
||||
Zap(FVfoOverlayTex);
|
||||
Zap(FDXOverlayTex);
|
||||
Zap(FBandOverlayTex);
|
||||
for i := 0 to High(FSliceTex) do Zap(FSliceTex[i].Tex);
|
||||
for i := 0 to High(FLetterTex) do Zap(FLetterTex[i]);
|
||||
@@ -469,6 +479,7 @@ begin
|
||||
FSampleOverlayDirty := True;
|
||||
FVfoOverlayDirty := True;
|
||||
FBandOverlayDirty := True;
|
||||
FDXOverlayDirty := True;
|
||||
FGLSpectrumW := 0;
|
||||
FGLSpectrumH := 0;
|
||||
// Водопад — свой контекст/текстуры (история + маркер). При reparent (pop-out)
|
||||
@@ -820,6 +831,25 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSpectrumViewOpenGL.DrawDXSpotTicksGL(W, H: Integer);
|
||||
// GL-двойник DrawDXSpotTicksRaw: те же X и цвета из раскладки оверлея, только
|
||||
// линиями GL. EnsureRendered здесь и держит раскладку свежей — текстуру полосы
|
||||
// DrawCachedOverlays перезальёт по RenderVersion, кто бы ни пересобрал кэш.
|
||||
var
|
||||
i, X, Y0: Integer;
|
||||
Col: TColor;
|
||||
begin
|
||||
if (FDXSpotOverlay = nil) or (not FDXSpotOverlay.Active) then Exit;
|
||||
FDXSpotOverlay.EnsureRendered(W);
|
||||
Y0 := FDXSpotOverlay.BandHeight;
|
||||
for i := 0 to FDXSpotOverlay.TickCount - 1 do
|
||||
begin
|
||||
FDXSpotOverlay.Tick(i, X, Col);
|
||||
if (X < 0) or (X >= W) then Continue;
|
||||
DrawLine(X, Y0, X, H, Col, 1, True); // пунктир — как в CPU-пути
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSpectrumViewOpenGL.DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
|
||||
// Залитый кружок (triangle fan, 20 сегментов) — маркер пика 2TON/IMD.
|
||||
var
|
||||
@@ -947,6 +977,28 @@ begin
|
||||
DrawTexture(FBandOverlayTex, 0, H - FBandOverlayTex.H);
|
||||
end;
|
||||
|
||||
// Полоса подписей DX-спотов — вверху спектра. Тот же битмап, что в CPU-пути,
|
||||
// заливается текстурой ТОЛЬКО при dirty (новый спот меняет CacheDirty
|
||||
// оверлея, вид — центр/спан/ширину).
|
||||
if Assigned(FDXSpotOverlay) and FDXSpotOverlay.Active then
|
||||
begin
|
||||
if FOverlayDirty or FDXOverlayDirty or FDXOverlayTex.Dirty or
|
||||
(FLastDXW <> W) or (FLastDXRender <> FDXSpotOverlay.RenderVersion) then
|
||||
begin
|
||||
B := TBitmap.Create;
|
||||
try
|
||||
FDXSpotOverlay.DrawOverlayBitmap(B, W);
|
||||
UploadBitmap(FDXOverlayTex, B, True, DXSPOT_ALPHA);
|
||||
finally
|
||||
B.Free;
|
||||
end;
|
||||
FLastDXW := W;
|
||||
FLastDXRender := FDXSpotOverlay.RenderVersion;
|
||||
FDXOverlayDirty := False;
|
||||
end;
|
||||
DrawTexture(FDXOverlayTex, 0, 0);
|
||||
end;
|
||||
|
||||
if Assigned(FSampleRateOverlay) then
|
||||
begin
|
||||
OW := Min(FSampleRateOverlay.Width, W - FSampleRateOverlay.Left);
|
||||
@@ -1098,6 +1150,7 @@ begin
|
||||
DrawSpectrumCurve(W, H, DBmax, InvRange);
|
||||
DrawMarker(W, H);
|
||||
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersGL(W, H);
|
||||
DrawDXSpotTicksGL(W, H);
|
||||
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
|
||||
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
|
||||
if FIMDActive then DrawIMDMarkersGL(W, H, DBmax, InvRange);
|
||||
|
||||
@@ -283,6 +283,12 @@ type
|
||||
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
|
||||
end;
|
||||
|
||||
{ BlendBitmapKey — общий keyed-композит кэш-битмапа оверлея в кадр (дворд-
|
||||
блендинг, магента = прозрачность). Живёт здесь исторически; вынесен в
|
||||
interface, чтобы другие оверлеи той же модели (DXSpotOverlay) не заводили
|
||||
вторую копию этого же цикла. }
|
||||
procedure BlendBitmapKey(Target, Source: TBitmap; DstX, DstY: Integer; Alpha: Byte);
|
||||
|
||||
implementation
|
||||
|
||||
function SliceColor(L: Char): TColor;
|
||||
|
||||
@@ -59,6 +59,11 @@ procedure SockSetNonBlock(S: TSocket; NB: Boolean);
|
||||
если буфер клиента переполнен, держа при этом FClientLock и блокируя Stop(). }
|
||||
procedure SockSetSndTimeout(S: TSocket; Ms: Integer);
|
||||
|
||||
{ SockSetRcvTimeout — ограничивает время блокирующего SockRecv. Нужен клиентам,
|
||||
которым между пакетами надо просыпаться самим (проверить Terminated, отдать
|
||||
накопившиеся команды): recv возвращает -1 по таймауту, соединение живо. }
|
||||
procedure SockSetRcvTimeout(S: TSocket; Ms: Integer);
|
||||
|
||||
{ ── SHA-1 ─────────────────────────────────────────────────────────────────── }
|
||||
|
||||
type
|
||||
@@ -123,6 +128,13 @@ begin
|
||||
setsockopt(S, SOL_SOCKET, SO_SNDTIMEO, @T, SizeOf(T));
|
||||
end;
|
||||
|
||||
procedure SockSetRcvTimeout(S: TSocket; Ms: Integer);
|
||||
var T: DWORD;
|
||||
begin
|
||||
T := Ms;
|
||||
setsockopt(S, SOL_SOCKET, SO_RCVTIMEO, @T, SizeOf(T));
|
||||
end;
|
||||
|
||||
{$ELSE}
|
||||
|
||||
function SockClose(S: TSocket): Integer;
|
||||
@@ -165,6 +177,14 @@ begin
|
||||
fpSetSockOpt(S, SOL_SOCKET, SO_SNDTIMEO, @TV, SizeOf(TV));
|
||||
end;
|
||||
|
||||
procedure SockSetRcvTimeout(S: TSocket; Ms: Integer);
|
||||
var TV: TTimeVal;
|
||||
begin
|
||||
TV.tv_sec := Ms div 1000;
|
||||
TV.tv_usec := (Ms mod 1000) * 1000;
|
||||
fpSetSockOpt(S, SOL_SOCKET, SO_RCVTIMEO, @TV, SizeOf(TV));
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
|
||||
Reference in New Issue
Block a user