mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:27:33 +00:00
3.4 ADC-селектор: - Caps.NumADCs (HPSDR: 2 для ORION/ORION2/SATURN, как Pkt.NumADCs; Pluto: 1) - controller.PanADC/SetPanADC: пан 0 = FMainADCSrc + ConfigureDDCs (ADC прокинут и в штатные вызовы — смена rate не сбрасывает выбор), паны N = FPanADC[] + SetPanDDC (RebuildDDCSpecific) - Бейдж «A1/A2» в шапке каждого пана (виден при NumADCs>1), клик = тумблер; пан 0 на ADC2 закрывает сценарий rx2-support 3.5 Pop-out: - «⧉» в шапке панов N → PopOutPan: TForm.CreateNew + ReparentTo (перенос всех контролов панели), [×] окна = DockBackPan (возврат в стек), «×» шапки = закрыть пан; LayoutPanStack скипает плавающих; колесо окна = FormMouseWheel - GL: reparent пересоздаёт контексты → ResetGLCache обеих канв без glDelete (по прецеденту MSAA); TWaterfallViewOpenGL.ResetGLCache новый, история водопада перезаливается из CPU-буфера Проверено юзером на экране (беглый тест: селектор и pop-out работают). Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
1889 lines
66 KiB
ObjectPascal
1889 lines
66 KiB
ObjectPascal
unit HPSDRNetwork;
|
||
|
||
{
|
||
UDP network layer for openHPSDR Ethernet Protocol V4.3.
|
||
Pure FPC RTL - uses only the standard 'Sockets' unit.
|
||
No anonymous procedures, no inline var - compatible with FPC 3.2 / Lazarus 2.x
|
||
}
|
||
|
||
{$IFDEF FPC}
|
||
{$MODE Delphi}
|
||
{$ENDIF}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, Math,
|
||
{$IFDEF WINDOWS}
|
||
WinSock2, MMSystem,
|
||
{$ELSE}
|
||
Sockets, BaseUnix,
|
||
{$ENDIF}
|
||
HPSDRProtocol, SyncObjs, Settings, RadioBackend;
|
||
|
||
const
|
||
DUC_TX_QUEUE_SIZE = 256; // power of two, bounded latency on TX underrun/overrun
|
||
|
||
{$IFDEF WINDOWS}
|
||
// ---------------------------------------------------------------------------
|
||
// WinSock2 — type aliases и forward declarations
|
||
// ---------------------------------------------------------------------------
|
||
const
|
||
SOCK_INVALID = TSocket(INVALID_SOCKET);
|
||
INADDR_ANY = 0;
|
||
IPPROTO_UDP = 17;
|
||
SO_EXCLUSIVEADDRUSE = LongInt(not 5); // = $FFFFFFFB — исключительное владение портом
|
||
|
||
type
|
||
TInetSockAddr = WinSock2.TSockAddrIn;
|
||
TSockLen = Integer;
|
||
TFDSet = WinSock2.TFDSet;
|
||
TTimeVal = WinSock2.TTimeVal;
|
||
|
||
function fpSocket(Domain, SType, Proto: Integer): TSocket;
|
||
function fpBind(S: TSocket; Addr: PSockAddr; AddrLen: Integer): Integer;
|
||
function fpSetSockOpt(S: TSocket; Level, OptName: Integer;
|
||
OptVal: Pointer; OptLen: Integer): Integer;
|
||
function fpGetSockName(S: TSocket; Addr: PSockAddr;
|
||
AddrLen: PInteger): Integer;
|
||
function fpSendTo(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
|
||
ToAddr: PSockAddr; AddrLen: Integer): Integer;
|
||
function fpRecvFrom(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
|
||
FromAddr: PSockAddr; FromLen: PInteger): Integer;
|
||
procedure fpFD_ZERO(var FDS: TFDSet);
|
||
procedure fpFD_SET(S: TSocket; var FDS: TFDSet);
|
||
function fpSelect(Nfds: Integer; ReadFDS, WriteFDS, ExceptFDS: PFDSet;
|
||
Timeout: PTimeVal): Integer;
|
||
procedure CloseSocket(S: TSocket);
|
||
function htons(Host: Word): Word;
|
||
function ntohs(Net: Word): Word;
|
||
function StrToNetAddr(const IP: string): WinSock2.TInAddr;
|
||
function NetAddrToStr(const Addr: WinSock2.TInAddr): string;
|
||
|
||
{$ELSE}
|
||
// ---------------------------------------------------------------------------
|
||
// Unix — типы уже определены в Sockets/BaseUnix
|
||
// ---------------------------------------------------------------------------
|
||
const
|
||
SOCK_INVALID = TSocket(-1);
|
||
{$ENDIF}
|
||
|
||
|
||
type
|
||
// Запись устройства и типы колбэков теперь общие (RadioBackend) — здесь
|
||
// алиасы для обратной совместимости со старым кодом (THPSDRDevice и т.д.).
|
||
THPSDRDevice = RadioBackend.TRadioDevice;
|
||
PHPSDRDevice = RadioBackend.PRadioDevice;
|
||
THPSDRDeviceArray = RadioBackend.TRadioDeviceArray;
|
||
TOnDeviceFound = RadioBackend.TOnDeviceFound;
|
||
TOnDDCIQPacket = RadioBackend.TOnDDCIQPacket;
|
||
TOnMicPacket = RadioBackend.TOnMicPacket;
|
||
TOnHPStatus = RadioBackend.TOnHPStatus;
|
||
TOnWidebandFrame = RadioBackend.TOnWidebandFrame;
|
||
|
||
{ THPSDRNetwork — openHPSDR Ethernet protocol бэкенд }
|
||
THPSDRNetwork = class(TRadioBackend)
|
||
private
|
||
FSocket: TSocket;
|
||
FLocalPort: Word;
|
||
FDevice: THPSDRDevice;
|
||
FConnected: Boolean;
|
||
FRunning: Boolean;
|
||
|
||
FSeqGeneral: LongWord;
|
||
FLastError: string; // последняя ошибка сокета (для диагностики)
|
||
FSeqDDCSpec: LongWord;
|
||
FSeqDUCSpec: LongWord;
|
||
FSeqHP: LongWord;
|
||
FSeqAudio: LongWord;
|
||
FSeqDUCIQ: LongWord;
|
||
|
||
// Накопитель RX-аудио для встроенного динамика радио: DDC Audio пакет несёт
|
||
// ровно 64 L/R пары (128 SmallInt). Копим интерливом между вызовами, чтобы
|
||
// не вставлять тишину при некратном размере буфера WDSP.
|
||
FSpeakerBuf: array[0..127] of SmallInt;
|
||
FSpeakerCount: Integer;
|
||
// True = поток аудио шлётся И динамик радио включён (byte 1400 bit1 = 0);
|
||
// False = мьют динамика (bit1 = 1) и поток не накапливается.
|
||
FSpeakerAudioEnabled: Boolean;
|
||
|
||
FReceiveThread: TThread;
|
||
FKeepaliveThread: TThread;
|
||
FDUCIQThread: TThread;
|
||
|
||
// Колбэки данных (FOnDeviceFound/FOnDDCIQ/FOnMic/FOnHPStatus/FOnWideband)
|
||
// унаследованы из TRadioBackend (protected) — здесь не дублируем.
|
||
|
||
FPortDDCSpec: Word;
|
||
FPortDUCSpec: Word;
|
||
FPortHPFromPC: Word;
|
||
FPortDDCAudio: Word;
|
||
FPortDUCIQ: Word;
|
||
FDirectIP: string; // для unicast discovery
|
||
FWidebandADC: Integer;
|
||
FWidebandEnabled: Boolean;
|
||
FWBPacketsPerFrame: Integer;
|
||
FWBSamplesPerPacket: Integer;
|
||
FWBSampleBits: Integer;
|
||
FWBUpdateRateMS: Integer;
|
||
FWBFrame: array of SmallInt;
|
||
FWBFrameCount: Integer;
|
||
FWBLastSeq: LongWord;
|
||
FWBSeqValid: Boolean;
|
||
|
||
// Кэш DDC/DUC Specific — keepalive повторно шлёт первые 5 сек после старта.
|
||
// duc_specific_thread эмулятора биндится на 1026 только после HP Run=1,
|
||
// поэтому первый DUC Specific может прийти раньше bind() и быть потерян.
|
||
FCachedDDCSpec: TDDCSpecificPacket;
|
||
FCachedDDCValid: Boolean;
|
||
FCachedDUCSpec: TDUCSpecificPacket;
|
||
FCachedDUCValid: Boolean;
|
||
FResendCount: Integer;
|
||
|
||
// Панадаптеры на доп. аппаратных DDC (этап 3): состояние per-DDC.
|
||
// Пишется из потока контроллера (SetPanDDC*), читается в SendFullHP /
|
||
// RebuildDDCSpecific — та же дисциплина, что у FCurrentRXFreq (torn read
|
||
// одного HP-кадра чинится следующим же кадром).
|
||
FPanDDCEnabled: array[0..MAX_DDCS-1] of Boolean;
|
||
FPanDDCFreqHz: array[0..MAX_DDCS-1] of Double;
|
||
FPanDDCRateKHz: array[0..MAX_DDCS-1] of Word;
|
||
FPanDDCADC: array[0..MAX_DDCS-1] of Byte;
|
||
// Кэш параметров главного DDC для RebuildDDCSpecific (пере-сборка DDC
|
||
// Specific при добавлении/удалении пан-DDC без повторного знания rate).
|
||
FMainNumDDCs: Byte;
|
||
FMainRateKHz: Word;
|
||
FMainADC: Byte;
|
||
FMainDither: Boolean;
|
||
FMainRandom: Boolean;
|
||
|
||
// Текущее состояние для построения HP пакетов
|
||
FCurrentRXFreq: Double;
|
||
FCurrentTXFreq: Double;
|
||
FCurrentDrive: Byte;
|
||
FIsTransmitting: Boolean;
|
||
FPTTActive: Boolean; // фактический PTT в HP-пакете (отдельно от Alex T/R)
|
||
FPAEnabled: Boolean;
|
||
FAlexEnabled: Boolean;
|
||
FAlexConfig: TAlexSettings; // per-band antenna + routing config
|
||
FStepAtten: Byte; // ADC0 step attenuator 0-31 dB
|
||
// ---- XVTR (Transverter) state ----
|
||
// FXvtrEnable — True когда активен XVTR-диапазон. Используется как
|
||
// XvtrActive в CalcAlex0 и для управления byte 1400 bit 0.
|
||
FXvtrEnable: Boolean;
|
||
// FXvtrRxAntOverride — если 1..3, использовать эту антенну вместо
|
||
// Alex.RxAnt[band] (per-XVTR RX antenna). 0 = не переопределять.
|
||
FXvtrRxAntOverride: Byte;
|
||
// FXvtrDisablePA — при TX подавляет бит 27 Alex (T/R relay): внутренний
|
||
// PA остаётся в RX-положении, TX-сигнал идёт через XVTR-IF.
|
||
FXvtrDisablePA: Boolean;
|
||
FSendLock: TCriticalSection; // защита concurrent UDP sends (fpSendTo)
|
||
FHPSendLock: TCriticalSection; // защита seq+send в SendFullHP атомарно
|
||
|
||
// DUC IQ sender: WDSP отдаёт IQ блоками, а железу нужен равномерный UDP
|
||
// поток 240 IQ-пар/пакет @ 192 kS/s, то есть пакет каждые 1.25 ms.
|
||
FDUCIQLock: TCriticalSection;
|
||
FDUCIQSem: PRTLEvent;
|
||
FDUCIQQueue: array[0..DUC_TX_QUEUE_SIZE - 1] of TDUCIQPacket;
|
||
FDUCIQHead: Integer;
|
||
FDUCIQTail: Integer;
|
||
FDUCIQCount: Integer;
|
||
FDUCIQDrops: LongWord;
|
||
|
||
function DoCreateSocket: TSocket;
|
||
procedure DoCloseSocket(var S: TSocket);
|
||
function DoSendTo(S: TSocket; const Buf; BufLen: Integer;
|
||
const DestIP: string; DestPort: Word): Boolean;
|
||
function DoRecvFrom(S: TSocket; var Buf; BufLen: Integer;
|
||
var SrcIP: string; var SrcPort: Word;
|
||
TimeoutMs: Integer): Integer;
|
||
|
||
procedure HandleHPStatus(const Buf: array of Byte; Len: Integer);
|
||
procedure HandleDDCIQ(const Buf: array of Byte; Len: Integer; DDCIdx: Integer);
|
||
procedure HandleMicData(const Buf: array of Byte; Len: Integer);
|
||
procedure HandleWidebandData(const Buf: array of Byte; Len: Integer; ADCIdx: Integer);
|
||
procedure StartThreads;
|
||
procedure StopThreads;
|
||
procedure ResetDUCIQQueue;
|
||
procedure EnqueueDUCIQ(const Pkt: TDUCIQPacket);
|
||
function DequeueDUCIQ(var Pkt: TDUCIQPacket): Boolean;
|
||
function NextSeq(var S: LongWord): LongWord;
|
||
procedure PackSeqBytes(var B: array of Byte; Seq: LongWord);
|
||
// Первый пользовательский DDC платы: 2 на ANGELIA/ORION/ORION2/SATURN
|
||
// (DDC0/1 зарезервированы PureSignal), иначе 0.
|
||
function DDCBaseIndex: Integer;
|
||
// Сборка+отправка DDC Specific из кэша главного DDC + активных пан-DDC.
|
||
procedure RebuildDDCSpecific;
|
||
|
||
protected
|
||
// Полиморфные геттеры состояния (свойства Connected/Running/Device/LastError/
|
||
// DirectIP объявлены в TRadioBackend).
|
||
function GetConnected: Boolean; override;
|
||
function GetRunning: Boolean; override;
|
||
function GetDevice: TRadioDevice; override;
|
||
function GetLastError: string; override;
|
||
function GetDirectIP: string; override;
|
||
procedure SetDirectIP(const V: string); override;
|
||
public
|
||
constructor Create;
|
||
destructor Destroy; override;
|
||
|
||
function Caps: TBackendCaps; override;
|
||
|
||
function Discover(TimeoutMs: Integer = 3000): THPSDRDeviceArray; override;
|
||
function Connect(const Dev: THPSDRDevice): Boolean; override;
|
||
procedure Disconnect; override;
|
||
|
||
procedure SendGeneralPacket(const Pkt: TGeneralPacket); override;
|
||
procedure ConfigureWideband(ADCIndex: Integer; Enabled: Boolean;
|
||
SamplesPerPacket: Integer = 512; SampleBits: Integer = 16;
|
||
UpdateRateMS: Integer = 70; PacketsPerFrame: Integer = 32); override;
|
||
procedure SendDDCSpecific(const Pkt: TDDCSpecificPacket); override;
|
||
procedure ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; ADCSource: Byte = 0;
|
||
DitherEnabled: Boolean = True; RandomEnabled: Boolean = True); override;
|
||
procedure SetPanDDC(DDCIdx: Integer; Enabled: Boolean; FreqHz: Double;
|
||
RateKHz: Word; ADCSource: Byte); override;
|
||
procedure SetPanDDCFreq(DDCIdx: Integer; FreqHz: Double); override;
|
||
procedure SendDUCSpecific(const Pkt: TDUCSpecificPacket); override;
|
||
procedure SendHighPriority(const Pkt: THighPriorityPacket); override;
|
||
procedure SetRunAndFreq(Run: Boolean; DDC0FreqHz, DUCFreqHz: Double;
|
||
DriveLevel: Byte = 100); override;
|
||
procedure UpdateState(RXFreqHz, TXFreqHz: Double; DriveLevel: Byte;
|
||
Transmitting, PAEnabled, AlexEnabled: Boolean); override;
|
||
procedure SetStepAtten(dB: Byte); override;
|
||
procedure SetAlexConfig(const A: TAlexSettings); override;
|
||
// Включение/настройка XVTR-режима. Все параметры применяются мгновенно
|
||
// (отправляется HP-пакет). Когда AEnable=False, XVTR-bit гасится,
|
||
// антенна и Alex routing возвращаются к per-band дефолту.
|
||
procedure SetXvtrMode(AEnable, ADisablePA: Boolean; ARxAnt: Byte); override;
|
||
procedure SendFullHP; override;
|
||
// Отдельная отправка PTT: переключает реле (bit27) и drive ДО, потом PTT.
|
||
// Не меняет FIsTransmitting — вызывать после UpdateState+SendFullHP.
|
||
procedure SendPTT(Active: Boolean); override;
|
||
procedure SendDDCAudio(const LeftRight: array of SmallInt); override;
|
||
// Принимает RX-аудио (float [-1..1]) из DSP, конвертирует в 16-bit и
|
||
// отправляет на радио пакетами по 64 L/R пары. Хвост копится между вызовами.
|
||
procedure SendSpeakerAudio(const Left, Right: array of Single; Count: Integer); override;
|
||
// Единый переключатель встроенного динамика: True = слать аудио и снять мьют,
|
||
// False = замьютить динамик (byte 1400 bit1) и не накапливать поток.
|
||
// Применяется немедленно (шлёт HP-пакет, если подключены).
|
||
procedure SetSpeakerAudio(AEnabled: Boolean); override;
|
||
procedure SendDUCIQ(const IData, QData: array of Integer); override;
|
||
procedure ClearDUCIQQueue; override;
|
||
procedure PrimeDUCIQ(Pairs: Integer); override;
|
||
|
||
// LocalPort — HPSDR-специфично (локальный UDP-порт), не часть базы.
|
||
property LocalPort: Word read FLocalPort;
|
||
end;
|
||
|
||
implementation
|
||
|
||
{$IFDEF WINDOWS}
|
||
var
|
||
WSAData_: WinSock2.TWSAData;
|
||
|
||
function QueryPerformanceCounter(var lpPerformanceCount: Int64): LongBool; stdcall; external 'kernel32.dll';
|
||
function QueryPerformanceFrequency(var lpFrequency: Int64): LongBool; stdcall; external 'kernel32.dll';
|
||
{$ENDIF}
|
||
|
||
{$IFDEF WINDOWS}
|
||
// ---------------------------------------------------------------------------
|
||
// WinSock2 wrapper implementations
|
||
// ---------------------------------------------------------------------------
|
||
function fpSocket(Domain, SType, Proto: Integer): TSocket;
|
||
begin
|
||
Result := WinSock2.socket(Domain, SType, Proto);
|
||
end;
|
||
|
||
function fpBind(S: TSocket; Addr: PSockAddr; AddrLen: Integer): Integer;
|
||
begin
|
||
Result := WinSock2.bind(S, Addr^, AddrLen);
|
||
end;
|
||
|
||
function fpSetSockOpt(S: TSocket; Level, OptName: Integer;
|
||
OptVal: Pointer; OptLen: Integer): Integer;
|
||
begin
|
||
Result := WinSock2.setsockopt(S, Level, OptName, OptVal, OptLen);
|
||
end;
|
||
|
||
function fpGetSockName(S: TSocket; Addr: PSockAddr; AddrLen: PInteger): Integer;
|
||
begin
|
||
Result := WinSock2.getsockname(S, Addr^, AddrLen^);
|
||
end;
|
||
|
||
function fpSendTo(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
|
||
ToAddr: PSockAddr; AddrLen: Integer): Integer;
|
||
begin
|
||
Result := WinSock2.sendto(S, Buf^, BufLen, Flags, ToAddr^, AddrLen);
|
||
end;
|
||
|
||
function fpRecvFrom(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
|
||
FromAddr: PSockAddr; FromLen: PInteger): Integer;
|
||
begin
|
||
Result := WinSock2.recvfrom(S, Buf^, BufLen, Flags, FromAddr^, FromLen^);
|
||
end;
|
||
|
||
procedure fpFD_ZERO(var FDS: TFDSet);
|
||
begin
|
||
WinSock2.FD_ZERO(FDS);
|
||
end;
|
||
|
||
procedure fpFD_SET(S: TSocket; var FDS: TFDSet);
|
||
begin
|
||
WinSock2.FD_SET(S, FDS);
|
||
end;
|
||
|
||
function fpSelect(Nfds: Integer; ReadFDS, WriteFDS, ExceptFDS: PFDSet;
|
||
Timeout: PTimeVal): Integer;
|
||
begin
|
||
Result := WinSock2.select(Nfds, ReadFDS, WriteFDS, ExceptFDS, Timeout);
|
||
end;
|
||
|
||
procedure CloseSocket(S: TSocket);
|
||
begin
|
||
WinSock2.closesocket(S);
|
||
end;
|
||
|
||
function htons(Host: Word): Word;
|
||
begin
|
||
Result := WinSock2.htons(Host);
|
||
end;
|
||
|
||
function ntohs(Net: Word): Word;
|
||
begin
|
||
Result := WinSock2.ntohs(Net);
|
||
end;
|
||
|
||
function StrToNetAddr(const IP: string): WinSock2.TInAddr;
|
||
begin
|
||
Result.S_addr := WinSock2.inet_addr(PAnsiChar(AnsiString(IP)));
|
||
end;
|
||
|
||
function NetAddrToStr(const Addr: WinSock2.TInAddr): string;
|
||
begin
|
||
Result := string(WinSock2.inet_ntoa(Addr));
|
||
end;
|
||
{$ENDIF}
|
||
|
||
// ===========================================================================
|
||
// Receive thread
|
||
// ===========================================================================
|
||
type
|
||
TReceiveThread = class(TThread)
|
||
private
|
||
FNet: THPSDRNetwork;
|
||
protected
|
||
procedure Execute; override;
|
||
public
|
||
constructor Create(ANet: THPSDRNetwork);
|
||
end;
|
||
|
||
constructor TReceiveThread.Create(ANet: THPSDRNetwork);
|
||
begin
|
||
FNet := ANet;
|
||
FreeOnTerminate := False;
|
||
inherited Create(False);
|
||
end;
|
||
|
||
procedure TReceiveThread.Execute;
|
||
var
|
||
Buf: array[0..1500] of Byte;
|
||
Len: Integer;
|
||
SrcIP: string;
|
||
SrcPort: Word;
|
||
begin
|
||
FillChar(Buf, SizeOf(Buf), 0);
|
||
SrcIP := '';
|
||
SrcPort := 0;
|
||
while not Terminated do
|
||
begin
|
||
if FNet.FSocket = SOCK_INVALID then
|
||
begin
|
||
Sleep(50);
|
||
Continue;
|
||
end;
|
||
Len := FNet.DoRecvFrom(FNet.FSocket, Buf, SizeOf(Buf), SrcIP, SrcPort, 50);
|
||
if Terminated then Break;
|
||
if Len < 4 then Continue;
|
||
|
||
case SrcPort of
|
||
PORT_HP_TO_PC:
|
||
if Len >= SizeOf(THighPriorityStatus) then
|
||
FNet.HandleHPStatus(Buf, Len);
|
||
PORT_MIC_DATA:
|
||
if Len >= 132 then
|
||
FNet.HandleMicData(Buf, Len);
|
||
PORT_WIDEBAND_ADC0 .. PORT_WIDEBAND_ADC0 + MAX_ADCS - 1:
|
||
FNet.HandleWidebandData(Buf, Len, SrcPort - PORT_WIDEBAND_ADC0);
|
||
PORT_DDC0_IQ .. PORT_DDC0_IQ + MAX_DDCS - 1:
|
||
FNet.HandleDDCIQ(Buf, Len, SrcPort - PORT_DDC0_IQ);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// ===========================================================================
|
||
// DUC IQ paced sender thread
|
||
// ===========================================================================
|
||
type
|
||
TDUCIQSenderThread = class(TThread)
|
||
private
|
||
FNet: THPSDRNetwork;
|
||
protected
|
||
procedure Execute; override;
|
||
public
|
||
constructor Create(ANet: THPSDRNetwork);
|
||
end;
|
||
|
||
constructor TDUCIQSenderThread.Create(ANet: THPSDRNetwork);
|
||
begin
|
||
FNet := ANet;
|
||
FreeOnTerminate := False;
|
||
inherited Create(False);
|
||
end;
|
||
|
||
procedure TDUCIQSenderThread.Execute;
|
||
const
|
||
DUC_IQ_PAIRS_PER_PACKET = 240;
|
||
DUC_SAMPLE_RATE = 192000; // IQ pairs per second
|
||
// Пейсинг DUC-FIFO радио — модель dl1ycf pihpsdr (new_protocol_txiq_thread).
|
||
// Продюсер (TTXDSPThread) mic-клочит очередь: mic-пакеты радио идут на кварце
|
||
// радио, а mic-ADC и DUC-DAC на одном кристалле → темп прихода mic = темп
|
||
// расхода DAC. Значит очередь пополняется ровно радиоклоком, и sender должен
|
||
// просто ОТПРАВЛЯТЬ пакеты по мере готовности. THROTTLE — не «держатель
|
||
// уровня», а BURST-ЛИМИТЕР: один WDSP-блок = ~8.5 пакетов приходят пачкой;
|
||
// без ограничения пачка мгновенно вливается в FPGA-FIFO радио и может его
|
||
// переполнить. Пока виртуальная оценка уровня > THROTTLE — притормаживаем
|
||
// (только ЗАДЕРЖКА отправки, НИКОГДА не инжектируем данные). Дрейф PC↔радио
|
||
// тут даёт лишь ±1мс джиттера отправки (сглаживает FPGA-FIFO), а НЕ разрыв
|
||
// сэмплов. Пустая очередь → просто ждём следующий блок (как dl1ycf sem_wait):
|
||
// подушку на короткий разрыв держит pre-roll в FPGA-FIFO радио. Нулевые
|
||
// вставки УБРАНЫ — именно они (1.25мс тишины в потоке) рисовали всплески.
|
||
DUC_FIFO_THROTTLE = 2000;
|
||
DUC_PACKET_INTERVAL_US = 1250; // 240 / 192000 seconds
|
||
DUC_WIN_SPIN_US = 350; // final part of 1.25 ms interval: avoid Sleep jitter
|
||
var
|
||
Pkt: TDUCIQPacket;
|
||
{$IFDEF WINDOWS}
|
||
QPCFreq: Int64;
|
||
QPCValue: Int64;
|
||
NextDueUs: Int64;
|
||
NowUs: Int64;
|
||
WaitUs: Int64;
|
||
{$ELSE}
|
||
VirtualSamples: Integer;
|
||
LastTick: QWord;
|
||
NowTick: QWord;
|
||
ElapsedMs: QWord;
|
||
WaitMs: Integer;
|
||
{$ENDIF}
|
||
|
||
{$IFDEF WINDOWS}
|
||
function ClockUs: Int64;
|
||
begin
|
||
QueryPerformanceCounter(QPCValue);
|
||
Result := (QPCValue * 1000000) div QPCFreq;
|
||
end;
|
||
|
||
procedure WaitUntil(DueUs: Int64);
|
||
begin
|
||
while not Terminated do
|
||
begin
|
||
NowUs := ClockUs;
|
||
WaitUs := DueUs - NowUs;
|
||
if WaitUs <= 0 then Break;
|
||
if WaitUs > 2500 then
|
||
Sleep(1)
|
||
else if WaitUs > DUC_WIN_SPIN_US then
|
||
Sleep(0);
|
||
end;
|
||
end;
|
||
{$ELSE}
|
||
procedure DrainVirtualFIFO;
|
||
begin
|
||
NowTick := GetTickCount64;
|
||
if NowTick > LastTick then
|
||
begin
|
||
ElapsedMs := NowTick - LastTick;
|
||
Dec(VirtualSamples, Integer(ElapsedMs) * (DUC_SAMPLE_RATE div 1000));
|
||
if VirtualSamples < 0 then VirtualSamples := 0;
|
||
LastTick := NowTick;
|
||
end;
|
||
end;
|
||
|
||
{$ENDIF}
|
||
|
||
begin
|
||
{$IFDEF WINDOWS}
|
||
if not QueryPerformanceFrequency(QPCFreq) or (QPCFreq <= 0) then
|
||
QPCFreq := 1000;
|
||
NextDueUs := ClockUs;
|
||
|
||
while not Terminated do
|
||
begin
|
||
if not FNet.DequeueDUCIQ(Pkt) then
|
||
begin
|
||
RTLEventWaitFor(FNet.FDUCIQSem, 20);
|
||
NowUs := ClockUs;
|
||
if NextDueUs < NowUs - DUC_PACKET_INTERVAL_US then
|
||
NextDueUs := NowUs;
|
||
Continue;
|
||
end;
|
||
|
||
WaitUntil(NextDueUs);
|
||
if Terminated then Break;
|
||
if not FNet.FIsTransmitting then
|
||
Continue;
|
||
|
||
FNet.PackSeqBytes(Pkt.Seq, FNet.NextSeq(FNet.FSeqDUCIQ));
|
||
FNet.DoSendTo(FNet.FSocket, Pkt, SizeOf(Pkt), FNet.FDevice.IPAddress,
|
||
FNet.FPortDUCIQ);
|
||
|
||
Inc(NextDueUs, DUC_PACKET_INTERVAL_US);
|
||
NowUs := ClockUs;
|
||
if NextDueUs < NowUs - DUC_PACKET_INTERVAL_US then
|
||
NextDueUs := NowUs;
|
||
end;
|
||
{$ELSE}
|
||
VirtualSamples := 0;
|
||
LastTick := GetTickCount64;
|
||
|
||
while not Terminated do
|
||
begin
|
||
if not FNet.DequeueDUCIQ(Pkt) then
|
||
begin
|
||
DrainVirtualFIFO;
|
||
// Очередь пуста. НЕ инжектируем нулевые пакеты — 1.25мс тишины прямо
|
||
// в поток сэмплов = разрыв данных = всплеск на водопаде/в эфире. Как
|
||
// dl1ycf pihpsdr (txiq_thread: пустая очередь → просто sem_wait): ждём
|
||
// следующий WDSP-блок продюсера. Короткий разрыв покрывает подушка
|
||
// pre-roll в FPGA-FIFO радио; mic-клок продюсера держит очередь полной.
|
||
// На передаче ждём коротко (быстро подхватить пришедший блок), на приёме
|
||
// дольше (энергосбережение, всё равно ничего не шлём).
|
||
if FNet.FIsTransmitting then WaitMs := 1 else WaitMs := 20;
|
||
RTLEventWaitFor(FNet.FDUCIQSem, WaitMs);
|
||
DrainVirtualFIFO;
|
||
Continue;
|
||
end;
|
||
|
||
if Terminated then Break;
|
||
DrainVirtualFIFO;
|
||
if not FNet.FIsTransmitting then
|
||
Continue;
|
||
|
||
FNet.PackSeqBytes(Pkt.Seq, FNet.NextSeq(FNet.FSeqDUCIQ));
|
||
FNet.DoSendTo(FNet.FSocket, Pkt, SizeOf(Pkt), FNet.FDevice.IPAddress,
|
||
FNet.FPortDUCIQ);
|
||
Inc(VirtualSamples, DUC_IQ_PAIRS_PER_PACKET);
|
||
|
||
while (not Terminated) and (VirtualSamples > DUC_FIFO_THROTTLE) do
|
||
begin
|
||
Sleep(1);
|
||
DrainVirtualFIFO;
|
||
end;
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
// ===========================================================================
|
||
// Keepalive thread
|
||
// ===========================================================================
|
||
type
|
||
TKeepaliveThread = class(TThread)
|
||
private
|
||
FNet: THPSDRNetwork;
|
||
protected
|
||
procedure Execute; override;
|
||
public
|
||
constructor Create(ANet: THPSDRNetwork);
|
||
end;
|
||
|
||
constructor TKeepaliveThread.Create(ANet: THPSDRNetwork);
|
||
begin
|
||
FNet := ANet;
|
||
FreeOnTerminate := False;
|
||
inherited Create(False);
|
||
end;
|
||
|
||
procedure TKeepaliveThread.Execute;
|
||
begin
|
||
while not Terminated do
|
||
begin
|
||
Sleep(50);
|
||
if Terminated then Break;
|
||
if not FNet.FConnected then Continue;
|
||
// Отправляем полный HP с частотами и ALEX — как piHPSDR
|
||
FNet.SendFullHP;
|
||
// Повторно отправляем DDC/DUC Specific первые 5 сек после Run=1 (каждые 500 мс).
|
||
// ddc_specific_thread / duc_specific_thread на эмуляторе/железе стартуют
|
||
// ПОСЛЕ получения Run=1, поэтому первые ConfigureDDCs / SendDUCSpecific
|
||
// могут прийти раньше чем порты 1025/1026 откроются.
|
||
if FNet.FRunning then
|
||
begin
|
||
Inc(FNet.FResendCount);
|
||
if (FNet.FResendCount <= 100) and (FNet.FResendCount mod 10 = 2) then
|
||
begin
|
||
if FNet.FCachedDDCValid then FNet.SendDDCSpecific(FNet.FCachedDDCSpec);
|
||
if FNet.FCachedDUCValid then FNet.SendDUCSpecific(FNet.FCachedDUCSpec);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// ===========================================================================
|
||
// THPSDRNetwork
|
||
// ===========================================================================
|
||
|
||
// ---- Полиморфные геттеры состояния (TRadioBackend) ----
|
||
function THPSDRNetwork.GetConnected: Boolean;
|
||
begin
|
||
Result := FConnected;
|
||
end;
|
||
|
||
function THPSDRNetwork.GetRunning: Boolean;
|
||
begin
|
||
Result := FRunning;
|
||
end;
|
||
|
||
function THPSDRNetwork.GetDevice: TRadioDevice;
|
||
begin
|
||
Result := FDevice;
|
||
end;
|
||
|
||
function THPSDRNetwork.GetLastError: string;
|
||
begin
|
||
Result := FLastError;
|
||
end;
|
||
|
||
function THPSDRNetwork.GetDirectIP: string;
|
||
begin
|
||
Result := FDirectIP;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetDirectIP(const V: string);
|
||
begin
|
||
FDirectIP := V;
|
||
end;
|
||
|
||
// ---- Возможности HPSDR-бэкенда ----
|
||
function THPSDRNetwork.Caps: TBackendCaps;
|
||
begin
|
||
FillChar(Result, SizeOf(Result), 0);
|
||
Result.Kind := bkHPSDR;
|
||
Result.HasTX := True;
|
||
Result.HasPA := True;
|
||
Result.HasAlex := True;
|
||
Result.HasWideband := True;
|
||
Result.HasDitherRandom := True;
|
||
Result.HasHWMic := True;
|
||
Result.HasPLLStatus := True;
|
||
Result.HasHWGain := False;
|
||
Result.HasRFBandwidth := False;
|
||
Result.HasFullDuplex := True;
|
||
Result.MinSampleRate := 48000;
|
||
// Бэкенд — единственный источник своих рейтов (общий для desktop/web UI).
|
||
SetLength(Result.RatePresets, 6);
|
||
Result.RatePresets[0] := 48000;
|
||
Result.RatePresets[1] := 96000;
|
||
Result.RatePresets[2] := 192000;
|
||
Result.RatePresets[3] := 384000;
|
||
Result.RatePresets[4] := 768000;
|
||
Result.RatePresets[5] := 1536000;
|
||
Result.MinFreqHz := 0;
|
||
Result.MaxFreqHz := 61440000;
|
||
// Панадаптеры на аппаратных DDC: главный + до 3 доп. (кап по Ethernet/CPU,
|
||
// см. doc/SLICES_PLAN.md 3.1). Каждый DDC тюнится независимо.
|
||
Result.MaxPans := 4;
|
||
Result.IndependentPanFreq := True;
|
||
// Два АЦП у ANAN-100D/200D (ORION), 7000/8000 (ORION2) и Saturn/G2 —
|
||
// те же платы, что в RebuildDDCSpecific (Pkt.NumADCs).
|
||
if FDevice.BoardType in [4, 5, 10] then
|
||
Result.NumADCs := 2
|
||
else
|
||
Result.NumADCs := 1;
|
||
end;
|
||
|
||
constructor THPSDRNetwork.Create;
|
||
begin
|
||
inherited;
|
||
FSocket := SOCK_INVALID;
|
||
FConnected := False;
|
||
FRunning := False;
|
||
FLocalPort := 0;
|
||
FReceiveThread := nil;
|
||
FKeepaliveThread := nil;
|
||
FDUCIQThread := nil;
|
||
FPortDDCSpec := PORT_DDC_SPECIFIC;
|
||
FPortDUCSpec := PORT_DUC_SPECIFIC;
|
||
FPortHPFromPC := PORT_HP_FROM_PC;
|
||
FPortDDCAudio := PORT_DDC_AUDIO;
|
||
FPortDUCIQ := PORT_DUC_IQ;
|
||
FWidebandADC := 0;
|
||
FWidebandEnabled := False;
|
||
FWBPacketsPerFrame := 32;
|
||
FWBSamplesPerPacket := 512;
|
||
FWBSampleBits := 16;
|
||
FWBUpdateRateMS := 70;
|
||
FWBFrameCount := 0;
|
||
FWBSeqValid := False;
|
||
FCurrentRXFreq := 7100000;
|
||
FCurrentTXFreq := 7100000;
|
||
FCurrentDrive := 0;
|
||
FIsTransmitting := False;
|
||
FPAEnabled := True;
|
||
FAlexEnabled := True;
|
||
TSettingsManager.DefaultAlex(FAlexConfig);
|
||
FSendLock := TCriticalSection.Create;
|
||
FHPSendLock := TCriticalSection.Create;
|
||
FDUCIQLock := TCriticalSection.Create;
|
||
FDUCIQSem := RTLEventCreate;
|
||
ResetDUCIQQueue;
|
||
end;
|
||
|
||
destructor THPSDRNetwork.Destroy;
|
||
begin
|
||
Disconnect;
|
||
RTLEventDestroy(FDUCIQSem);
|
||
FDUCIQLock.Free;
|
||
FHPSendLock.Free;
|
||
FSendLock.Free;
|
||
inherited;
|
||
end;
|
||
|
||
function THPSDRNetwork.NextSeq(var S: LongWord): LongWord;
|
||
begin
|
||
Result := S;
|
||
Inc(S);
|
||
end;
|
||
|
||
procedure THPSDRNetwork.PackSeqBytes(var B: array of Byte; Seq: LongWord);
|
||
begin
|
||
B[0] := (Seq shr 24) and $FF;
|
||
B[1] := (Seq shr 16) and $FF;
|
||
B[2] := (Seq shr 8) and $FF;
|
||
B[3] := Seq and $FF;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.ResetDUCIQQueue;
|
||
begin
|
||
FDUCIQLock.Enter;
|
||
try
|
||
FDUCIQHead := 0;
|
||
FDUCIQTail := 0;
|
||
FDUCIQCount := 0;
|
||
FDUCIQDrops := 0;
|
||
finally
|
||
FDUCIQLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.ClearDUCIQQueue;
|
||
begin
|
||
ResetDUCIQQueue;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.EnqueueDUCIQ(const Pkt: TDUCIQPacket);
|
||
begin
|
||
FDUCIQLock.Enter;
|
||
try
|
||
if FDUCIQCount >= DUC_TX_QUEUE_SIZE then
|
||
begin
|
||
FDUCIQTail := (FDUCIQTail + 1) and (DUC_TX_QUEUE_SIZE - 1);
|
||
Dec(FDUCIQCount);
|
||
Inc(FDUCIQDrops);
|
||
end;
|
||
|
||
FDUCIQQueue[FDUCIQHead] := Pkt;
|
||
FDUCIQHead := (FDUCIQHead + 1) and (DUC_TX_QUEUE_SIZE - 1);
|
||
Inc(FDUCIQCount);
|
||
RTLEventSetEvent(FDUCIQSem);
|
||
finally
|
||
FDUCIQLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function THPSDRNetwork.DequeueDUCIQ(var Pkt: TDUCIQPacket): Boolean;
|
||
begin
|
||
Result := False;
|
||
FDUCIQLock.Enter;
|
||
try
|
||
if FDUCIQCount <= 0 then Exit;
|
||
Pkt := FDUCIQQueue[FDUCIQTail];
|
||
FDUCIQTail := (FDUCIQTail + 1) and (DUC_TX_QUEUE_SIZE - 1);
|
||
Dec(FDUCIQCount);
|
||
Result := True;
|
||
finally
|
||
FDUCIQLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
// ---------------------------------------------------------------------------
|
||
// Сокеты (только FPC RTL Sockets unit)
|
||
// ---------------------------------------------------------------------------
|
||
|
||
function THPSDRNetwork.DoCreateSocket: TSocket;
|
||
var
|
||
Addr: TInetSockAddr;
|
||
Opt: LongInt;
|
||
ALen: TSockLen;
|
||
begin
|
||
FillChar(Addr, SizeOf(Addr), 0);
|
||
Result := fpSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
|
||
if Result = SOCK_INVALID then
|
||
begin
|
||
FLastError := 'fpSocket failed';
|
||
Exit;
|
||
end;
|
||
|
||
// Broadcast
|
||
Opt := 1;
|
||
fpSetSockOpt(Result, SOL_SOCKET, SO_BROADCAST, @Opt, SizeOf(Opt));
|
||
|
||
{$IFDEF WINDOWS}
|
||
// На Windows SO_REUSEADDR позволяет перехватить порт другому процессу.
|
||
// Используем SO_EXCLUSIVEADDRUSE вместо SO_REUSEADDR.
|
||
Opt := 1;
|
||
fpSetSockOpt(Result, SOL_SOCKET, SO_EXCLUSIVEADDRUSE, @Opt, SizeOf(Opt));
|
||
{$ELSE}
|
||
Opt := 1;
|
||
fpSetSockOpt(Result, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(Opt));
|
||
{$ENDIF}
|
||
|
||
// Большой приёмный буфер
|
||
Opt := 4 * 1024 * 1024;
|
||
fpSetSockOpt(Result, SOL_SOCKET, SO_RCVBUF, @Opt, SizeOf(Opt));
|
||
|
||
FillChar(Addr, SizeOf(Addr), 0);
|
||
Addr.sin_family := AF_INET;
|
||
Addr.sin_port := htons(0); // случайный свободный порт
|
||
{$IFDEF WINDOWS}
|
||
Addr.sin_addr.S_addr := INADDR_ANY;
|
||
{$ELSE}
|
||
Addr.sin_addr.s_addr := INADDR_ANY;
|
||
{$ENDIF}
|
||
|
||
if fpBind(Result, @Addr, SizeOf(Addr)) <> 0 then
|
||
begin
|
||
{$IFDEF WINDOWS}
|
||
FLastError := 'fpBind failed, WSAError=' + IntToStr(WinSock2.WSAGetLastError);
|
||
{$ELSE}
|
||
FLastError := 'fpBind failed';
|
||
{$ENDIF}
|
||
CloseSocket(Result);
|
||
Result := SOCK_INVALID;
|
||
Exit;
|
||
end;
|
||
|
||
ALen := SizeOf(Addr);
|
||
if fpGetSockName(Result, @Addr, @ALen) = 0 then
|
||
FLocalPort := ntohs(Addr.sin_port);
|
||
|
||
FLastError := '';
|
||
end;
|
||
|
||
procedure THPSDRNetwork.DoCloseSocket(var S: TSocket);
|
||
begin
|
||
if S <> SOCK_INVALID then
|
||
begin
|
||
CloseSocket(S);
|
||
S := SOCK_INVALID;
|
||
end;
|
||
end;
|
||
|
||
function THPSDRNetwork.DoSendTo(S: TSocket; const Buf; BufLen: Integer;
|
||
const DestIP: string; DestPort: Word): Boolean;
|
||
var
|
||
Addr: TInetSockAddr;
|
||
begin
|
||
Result := False;
|
||
if S = SOCK_INVALID then Exit;
|
||
FillChar(Addr, SizeOf(Addr), 0);
|
||
Addr.sin_family := AF_INET;
|
||
Addr.sin_port := htons(DestPort);
|
||
Addr.sin_addr := StrToNetAddr(DestIP);
|
||
FSendLock.Enter;
|
||
try
|
||
Result := fpSendTo(S, @Buf, BufLen, 0, @Addr, SizeOf(Addr)) = BufLen;
|
||
finally
|
||
FSendLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
function THPSDRNetwork.DoRecvFrom(S: TSocket; var Buf; BufLen: Integer;
|
||
var SrcIP: string; var SrcPort: Word;
|
||
TimeoutMs: Integer): Integer;
|
||
var
|
||
FDS: TFDSet;
|
||
TV: TTimeVal;
|
||
Addr: TInetSockAddr;
|
||
ALen: TSockLen;
|
||
N: LongInt;
|
||
begin
|
||
Result := 0;
|
||
if S = SOCK_INVALID then Exit;
|
||
|
||
fpFD_ZERO(FDS);
|
||
fpFD_SET(S, FDS);
|
||
TV.tv_sec := TimeoutMs div 1000;
|
||
TV.tv_usec := (TimeoutMs mod 1000) * 1000;
|
||
|
||
N := fpSelect(S + 1, @FDS, nil, nil, @TV);
|
||
if N <= 0 then Exit;
|
||
|
||
ALen := SizeOf(Addr);
|
||
Result := fpRecvFrom(S, @Buf, BufLen, 0, @Addr, @ALen);
|
||
if Result > 0 then
|
||
begin
|
||
SrcIP := NetAddrToStr(Addr.sin_addr);
|
||
SrcPort := ntohs(Addr.sin_port);
|
||
end
|
||
else
|
||
Result := 0;
|
||
end;
|
||
|
||
// ---------------------------------------------------------------------------
|
||
// Discovery
|
||
// ---------------------------------------------------------------------------
|
||
|
||
function THPSDRNetwork.Discover(TimeoutMs: Integer): THPSDRDeviceArray;
|
||
var
|
||
S: TSocket;
|
||
Pkt: TDiscoveryPacket;
|
||
Buf: array[0..511] of Byte;
|
||
Len: Integer;
|
||
SrcIP: string;
|
||
SrcPort: Word;
|
||
Found: THPSDRDeviceArray;
|
||
Start: QWord;
|
||
LastSend: QWord;
|
||
Elapsed: QWord;
|
||
Remaining: Integer;
|
||
k: Integer;
|
||
Dup: Boolean;
|
||
begin
|
||
FillChar(Buf, SizeOf(Buf), 0);
|
||
SrcIP := '';
|
||
SrcPort := 0;
|
||
SetLength(Found, 0);
|
||
Result := Found;
|
||
|
||
S := DoCreateSocket;
|
||
if S = SOCK_INVALID then Exit;
|
||
try
|
||
FillChar(Pkt, SizeOf(Pkt), 0);
|
||
Pkt.Command := CMD_DISCOVERY;
|
||
|
||
// Отправляем broadcast (и unicast если задан FDirectIP)
|
||
DoSendTo(S, Pkt, SizeOf(Pkt), '255.255.255.255', PORT_COMMAND);
|
||
if FDirectIP <> '' then
|
||
DoSendTo(S, Pkt, SizeOf(Pkt), FDirectIP, PORT_COMMAND);
|
||
|
||
Start := GetTickCount64;
|
||
LastSend := Start;
|
||
repeat
|
||
Elapsed := GetTickCount64 - Start;
|
||
if Elapsed >= QWord(TimeoutMs) then Break;
|
||
|
||
// Повторяем broadcast каждые 500 мс
|
||
if GetTickCount64 - LastSend >= 500 then
|
||
begin
|
||
DoSendTo(S, Pkt, SizeOf(Pkt), '255.255.255.255', PORT_COMMAND);
|
||
if FDirectIP <> '' then
|
||
DoSendTo(S, Pkt, SizeOf(Pkt), FDirectIP, PORT_COMMAND);
|
||
LastSend := GetTickCount64;
|
||
end;
|
||
|
||
// Ждём ответ не дольше 100 мс за раз — чтобы успеть повторить отправку
|
||
Remaining := TimeoutMs - Integer(Elapsed);
|
||
if Remaining <= 0 then Break;
|
||
if Remaining > 100 then Remaining := 100;
|
||
|
||
Len := DoRecvFrom(S, Buf, SizeOf(Buf), SrcIP, SrcPort, Remaining);
|
||
if Len < 60 then Continue;
|
||
if not (Buf[4] in [$02, $03]) then Continue;
|
||
|
||
Dup := False;
|
||
for k := 0 to High(Found) do
|
||
if Found[k].IPAddress = SrcIP then
|
||
begin
|
||
Dup := True;
|
||
Break;
|
||
end;
|
||
if Dup then Continue;
|
||
|
||
SetLength(Found, Length(Found) + 1);
|
||
FillChar(Found[High(Found)], SizeOf(THPSDRDevice), 0);
|
||
with Found[High(Found)] do
|
||
begin
|
||
IPAddress := SrcIP;
|
||
Port := SrcPort;
|
||
Move(Buf[5], MAC[0], 6);
|
||
BoardType := Buf[11];
|
||
ProtocolVersion := Buf[12];
|
||
FirmwareVersion := Buf[13];
|
||
NumDDCs := Buf[20];
|
||
FreqOrPhase := Buf[21];
|
||
EndianModes := Buf[22];
|
||
InUse := Buf[4] = $03;
|
||
Valid := True;
|
||
end;
|
||
|
||
if Assigned(FOnDeviceFound) then
|
||
FOnDeviceFound(Found[High(Found)]);
|
||
until False;
|
||
|
||
Result := Found;
|
||
finally
|
||
DoCloseSocket(S);
|
||
end;
|
||
end;
|
||
|
||
function THPSDRNetwork.Connect(const Dev: THPSDRDevice): Boolean;
|
||
begin
|
||
Result := False;
|
||
if FConnected then Disconnect;
|
||
|
||
FDevice := Dev;
|
||
FSocket := DoCreateSocket;
|
||
if FSocket = SOCK_INVALID then Exit;
|
||
|
||
FConnected := True;
|
||
FPTTActive := False;
|
||
FSeqGeneral := 0;
|
||
FSeqDDCSpec := 0;
|
||
FSeqDUCSpec := 0;
|
||
FSeqHP := 0;
|
||
FSeqAudio := 0;
|
||
FSeqDUCIQ := 0;
|
||
// Пан-DDC не переживают сессию (контроллер гасит их в StopRunning; здесь —
|
||
// страховка от грязного завершения прошлой сессии).
|
||
FillChar(FPanDDCEnabled, SizeOf(FPanDDCEnabled), 0);
|
||
ResetDUCIQQueue;
|
||
|
||
StartThreads;
|
||
Result := True;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.Disconnect;
|
||
begin
|
||
if not FConnected then Exit;
|
||
|
||
if FRunning then
|
||
SetRunAndFreq(False, 7100000, 7100000, 0);
|
||
|
||
FRunning := False;
|
||
StopThreads;
|
||
DoCloseSocket(FSocket);
|
||
FConnected := False;
|
||
FPTTActive := False;
|
||
FDevice.Valid := False;
|
||
FCachedDDCValid := False;
|
||
FCachedDUCValid := False;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.StartThreads;
|
||
begin
|
||
{$IFDEF WINDOWS}
|
||
// Повышаем точность системного таймера — по умолчанию 15.6ms, делаем 1ms
|
||
// Это критично для Sleep() в потоках и PortAudio
|
||
timeBeginPeriod(1);
|
||
{$ENDIF}
|
||
FReceiveThread := TReceiveThread.Create(Self);
|
||
FReceiveThread.Priority := tpHighest; // Сетевой поток — критический
|
||
FDUCIQThread := TDUCIQSenderThread.Create(Self);
|
||
FDUCIQThread.Priority := tpHighest; // TX packet pacing is timing-sensitive
|
||
FKeepaliveThread := TKeepaliveThread.Create(Self);
|
||
FKeepaliveThread.Priority := tpNormal;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.StopThreads;
|
||
procedure WaitThreadDone(T: TThread);
|
||
begin
|
||
if T = nil then Exit;
|
||
if GetCurrentThreadId = MainThreadID then
|
||
begin
|
||
while not T.Finished do
|
||
CheckSynchronize(10);
|
||
end;
|
||
T.WaitFor;
|
||
end;
|
||
begin
|
||
if Assigned(FDUCIQThread) then
|
||
begin
|
||
FDUCIQThread.Terminate;
|
||
RTLEventSetEvent(FDUCIQSem);
|
||
WaitThreadDone(FDUCIQThread);
|
||
FreeAndNil(FDUCIQThread);
|
||
end;
|
||
|
||
if Assigned(FReceiveThread) then
|
||
begin
|
||
FReceiveThread.Terminate;
|
||
if FSocket <> SOCK_INVALID then
|
||
begin
|
||
CloseSocket(FSocket);
|
||
FSocket := SOCK_INVALID;
|
||
end;
|
||
WaitThreadDone(FReceiveThread);
|
||
FreeAndNil(FReceiveThread);
|
||
end;
|
||
if Assigned(FKeepaliveThread) then
|
||
begin
|
||
FKeepaliveThread.Terminate;
|
||
WaitThreadDone(FKeepaliveThread);
|
||
FreeAndNil(FKeepaliveThread);
|
||
end;
|
||
ResetDUCIQQueue;
|
||
{$IFDEF WINDOWS}
|
||
timeEndPeriod(1);
|
||
{$ENDIF}
|
||
end;
|
||
|
||
// ---------------------------------------------------------------------------
|
||
// Обработчики пакетов — синхронизация через объекты, без анонимных proc
|
||
// ---------------------------------------------------------------------------
|
||
|
||
procedure THPSDRNetwork.HandleHPStatus(const Buf: array of Byte; Len: Integer);
|
||
var
|
||
St: THighPriorityStatus;
|
||
begin
|
||
if not Assigned(FOnHPStatus) then Exit;
|
||
Move(Buf[0], St, SizeOf(St));
|
||
FOnHPStatus(St);
|
||
end;
|
||
|
||
procedure THPSDRNetwork.HandleDDCIQ(const Buf: array of Byte; Len: Integer;
|
||
DDCIdx: Integer);
|
||
var
|
||
Pkt: TDDCIQPacket;
|
||
begin
|
||
if not Assigned(FOnDDCIQ) then Exit;
|
||
FillChar(Pkt, SizeOf(Pkt), 0);
|
||
Move(Buf[0], Pkt, Min(Len, SizeOf(Pkt)));
|
||
FOnDDCIQ(DDCIdx, Pkt); // прямой вызов из потока — UI не трогает
|
||
end;
|
||
|
||
procedure THPSDRNetwork.HandleMicData(const Buf: array of Byte; Len: Integer);
|
||
var
|
||
Pkt: TMicDataPacket;
|
||
begin
|
||
if not Assigned(FOnMic) then Exit;
|
||
Move(Buf[0], Pkt, SizeOf(Pkt));
|
||
FOnMic(Pkt); // прямой вызов из receive thread — TX обработка не касается UI
|
||
end;
|
||
|
||
procedure THPSDRNetwork.HandleWidebandData(const Buf: array of Byte; Len: Integer;
|
||
ADCIdx: Integer);
|
||
var
|
||
Seq: LongWord;
|
||
I, SamplesInPacket, TargetCount, S: Integer;
|
||
begin
|
||
if (not FWidebandEnabled) or (ADCIdx <> FWidebandADC) or
|
||
(FWBSampleBits <> 16) or (Len < 6) then Exit;
|
||
|
||
SamplesInPacket := (Len - 4) div 2;
|
||
if SamplesInPacket <= 0 then Exit;
|
||
if FWBSamplesPerPacket > 0 then
|
||
SamplesInPacket := Min(SamplesInPacket, FWBSamplesPerPacket);
|
||
|
||
Seq := (LongWord(Buf[0]) shl 24) or (LongWord(Buf[1]) shl 16) or
|
||
(LongWord(Buf[2]) shl 8) or LongWord(Buf[3]);
|
||
if Seq = 0 then
|
||
begin
|
||
FWBFrameCount := 0;
|
||
FWBSeqValid := True;
|
||
end
|
||
else if FWBSeqValid and (Seq <> FWBLastSeq + 1) then
|
||
begin
|
||
FWBFrameCount := 0;
|
||
FWBSeqValid := False;
|
||
Exit;
|
||
end;
|
||
FWBLastSeq := Seq;
|
||
FWBSeqValid := True;
|
||
|
||
TargetCount := Max(1, FWBPacketsPerFrame) * Max(1, FWBSamplesPerPacket);
|
||
if Length(FWBFrame) <> TargetCount then
|
||
SetLength(FWBFrame, TargetCount);
|
||
|
||
for I := 0 to SamplesInPacket - 1 do
|
||
begin
|
||
if FWBFrameCount >= TargetCount then Break;
|
||
S := (SmallInt(ShortInt(Buf[4 + I * 2])) shl 8) or Buf[5 + I * 2];
|
||
FWBFrame[FWBFrameCount] := SmallInt(S);
|
||
Inc(FWBFrameCount);
|
||
end;
|
||
|
||
if (FWBFrameCount >= TargetCount) and Assigned(FOnWideband) then
|
||
begin
|
||
FOnWideband(ADCIdx, FWBFrame, FWBFrameCount);
|
||
FWBFrameCount := 0;
|
||
FWBSeqValid := False;
|
||
end;
|
||
end;
|
||
|
||
// ---------------------------------------------------------------------------
|
||
// Отправка пакетов
|
||
// ---------------------------------------------------------------------------
|
||
|
||
procedure THPSDRNetwork.SendGeneralPacket(const Pkt: TGeneralPacket);
|
||
var
|
||
B: TGeneralPacket;
|
||
begin
|
||
B := Pkt;
|
||
B.WBPort[0] := (PORT_WIDEBAND_ADC0 shr 8) and $FF;
|
||
B.WBPort[1] := PORT_WIDEBAND_ADC0 and $FF;
|
||
if FWidebandEnabled then
|
||
B.WBEnable := 1 shl EnsureRange(FWidebandADC, 0, 7)
|
||
else
|
||
B.WBEnable := 0;
|
||
B.WBSamplesPerPkt[0] := (FWBSamplesPerPacket shr 8) and $FF;
|
||
B.WBSamplesPerPkt[1] := FWBSamplesPerPacket and $FF;
|
||
B.WBSampleSize := FWBSampleBits;
|
||
B.WBUpdateRate := FWBUpdateRateMS;
|
||
B.WBPacketsPerFrame := FWBPacketsPerFrame;
|
||
PackSeqBytes(B.Seq, NextSeq(FSeqGeneral));
|
||
DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, PORT_COMMAND);
|
||
end;
|
||
|
||
procedure THPSDRNetwork.ConfigureWideband(ADCIndex: Integer; Enabled: Boolean;
|
||
SamplesPerPacket: Integer; SampleBits: Integer; UpdateRateMS: Integer;
|
||
PacketsPerFrame: Integer);
|
||
var
|
||
Gen: TGeneralPacket;
|
||
begin
|
||
FWidebandADC := EnsureRange(ADCIndex, 0, 7);
|
||
FWidebandEnabled := Enabled;
|
||
FWBSamplesPerPacket := EnsureRange(SamplesPerPacket, 1, 4096);
|
||
FWBSampleBits := EnsureRange(SampleBits, 1, 32);
|
||
FWBUpdateRateMS := EnsureRange(UpdateRateMS, 0, 255);
|
||
FWBPacketsPerFrame := EnsureRange(PacketsPerFrame, 1, 255);
|
||
FWBFrameCount := 0;
|
||
FWBSeqValid := False;
|
||
if FConnected then
|
||
begin
|
||
FillChar(Gen, SizeOf(Gen), 0);
|
||
Gen.Command := CMD_GENERAL;
|
||
Gen.Flags37 := $08;
|
||
Gen.Flags38 := $01;
|
||
Gen.PAConfig := $01;
|
||
if FDevice.BoardType = BOARD_ORION_MK2 then
|
||
Gen.AlexEnable := $03
|
||
else
|
||
Gen.AlexEnable := $01;
|
||
SendGeneralPacket(Gen);
|
||
SendFullHP;
|
||
end;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendDDCSpecific(const Pkt: TDDCSpecificPacket);
|
||
var
|
||
B: TDDCSpecificPacket;
|
||
begin
|
||
B := Pkt;
|
||
PackSeqBytes(B.Seq, NextSeq(FSeqDDCSpec));
|
||
DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortDDCSpec);
|
||
end;
|
||
|
||
// ---------------------------------------------------------------------------
|
||
// ALEX фильтры — логика из piHPSDR new_protocol.c
|
||
// Возвращает 32-bit ALEX0 register value
|
||
// RXFreqHz — частота приёма ADC0
|
||
// TXFreqHz — частота передачи (или = RXFreqHz при RX)
|
||
// Transmitting — режим передачи
|
||
// IsOrion2 — ANAN-7000/8000 (другие BPF)
|
||
// ---------------------------------------------------------------------------
|
||
// Преобразует частоту в индекс диапазона 0=160m..10=6m (Thetis-compatible).
|
||
function FreqToBandIndex(FreqHz: Double): Integer;
|
||
begin
|
||
if FreqHz >= 39850000 then Result := 10 // 6m
|
||
else if FreqHz >= 26465000 then Result := 9 // 10m
|
||
else if FreqHz >= 23170000 then Result := 8 // 12m
|
||
else if FreqHz >= 19584000 then Result := 7 // 15m
|
||
else if FreqHz >= 16209000 then Result := 6 // 17m
|
||
else if FreqHz >= 12075000 then Result := 5 // 20m
|
||
else if FreqHz >= 8700000 then Result := 4 // 30m
|
||
else if FreqHz >= 6202000 then Result := 3 // 40m
|
||
else if FreqHz >= 4665000 then Result := 2 // 60m
|
||
else if FreqHz >= 2750000 then Result := 1 // 80m
|
||
else Result := 0; // 160m
|
||
end;
|
||
|
||
// Строит 32-битное слово Alex0 для HP-пакета (байты 1432-1435).
|
||
// Протокол: openHPSDR Ethernet Protocol v4.3, Appendix D.
|
||
// Bit 27: T/R relay. Биты 24-26: ANT. Биты 20-23,29-31: TX LPF.
|
||
// Биты 1-12: HPF/BPF (по RX-частоте). Биты 8-14: вторичный RX вход.
|
||
//
|
||
// XvtrRxAnt — override антенны для RX (1..3) если активен трансвертер;
|
||
// 0 = не переопределять, использовать Alex.RxAnt[band].
|
||
// XvtrDisablePA — True: при TX НЕ устанавливать bit 27 (T/R relay):
|
||
// внутренний PA не активируется, IF-сигнал идёт по тракту
|
||
// XVTR без усиления.
|
||
// XvtrActive — True когда активен XVTR-диапазон; разрешает биты 8+11
|
||
// (стандарт) или 8+14 (Orion2) из Alex.RxOnly[IF_band]=3.
|
||
// WidebandBypass — True когда открыт raw ADC wideband. Как Thetis, раскрываем
|
||
// RX front-end через HF bypass, иначе видна только полоса
|
||
// текущего HPF/BPF, а не весь ADC span.
|
||
function CalcAlex0(RXFreqHz, TXFreqHz: Double;
|
||
Transmitting, IsOrion2: Boolean;
|
||
const Alex: TAlexSettings;
|
||
XvtrRxAnt: Byte = 0;
|
||
XvtrDisablePA: Boolean = False;
|
||
XvtrActive: Boolean = False;
|
||
WidebandBypass: Boolean = False): LongWord;
|
||
var
|
||
txf: Double;
|
||
BandIdx: Integer;
|
||
AntVal: Byte;
|
||
begin
|
||
Result := 0;
|
||
|
||
// Bit 27 = T/R relay (0=RX, 1=TX).
|
||
// Если XvtrDisablePA=True — НЕ устанавливаем bit 27 (PA остаётся в RX
|
||
// положении, TX-сигнал идёт через XVTR-IF без усиления).
|
||
// Bit 18 (PureSignal) не ставим — PureSignal не реализован.
|
||
if Transmitting then
|
||
if not XvtrDisablePA then
|
||
Result := Result or $08000000; // bit 27: T/R relay
|
||
|
||
// HPF (ANAN-100/200) или BPF (ANAN-7000/8000/Saturn/G2) — по RX-частоте.
|
||
if WidebandBypass and (not Transmitting) then
|
||
Result := Result or $00001000 // bit 12: HF/front-end bypass for WB
|
||
else if IsOrion2 then
|
||
begin
|
||
// Band-pass filters — Orion MkII 5.2, ANAN-7000DLE, Saturn, ANAN-G2
|
||
if RXFreqHz < 1500000 then Result := Result or $00001000 // bit 12: HF Bypass
|
||
else if RXFreqHz < 2100000 then Result := Result or $00000040 // bit 6: 160m BPF
|
||
else if RXFreqHz < 5500000 then Result := Result or $00000020 // bit 5: 80/60m BPF
|
||
else if RXFreqHz < 11000000 then Result := Result or $00000010 // bit 4: 40/30m BPF
|
||
else if RXFreqHz < 22000000 then Result := Result or $00000002 // bit 1: 20/15m BPF
|
||
else if RXFreqHz < 35600000 then Result := Result or $00000004 // bit 2: 12/10m BPF
|
||
else Result := Result or $00000008; // bit 3: 6m + preamp
|
||
end
|
||
else
|
||
begin
|
||
// High-pass filters — Atlas, Hermes, ANAN-10/10E/100/100B/100D/200D
|
||
if RXFreqHz < 1800000 then Result := Result or $00001000 // bit 12: HF Bypass
|
||
else if RXFreqHz < 6500000 then Result := Result or $00000040 // bit 6: 1.5 MHz HPF
|
||
else if RXFreqHz < 9500000 then Result := Result or $00000020 // bit 5: 6.5 MHz HPF
|
||
else if RXFreqHz < 13000000 then Result := Result or $00000010 // bit 4: 9.5 MHz HPF
|
||
else if RXFreqHz < 20000000 then Result := Result or $00000002 // bit 1: 13 MHz HPF
|
||
else if RXFreqHz < 50000000 then Result := Result or $00000004 // bit 2: 20 MHz HPF
|
||
else Result := Result or $00000008; // bit 3: 6m preamp
|
||
end;
|
||
|
||
// TX LPF — по TX-частоте. В RX-режиме для не-Orion2 плат RX-сигнал идёт
|
||
// через TX LPF (общий сигнальный путь), поэтому используем RX-частоту.
|
||
if not Transmitting and not IsOrion2 then
|
||
txf := RXFreqHz
|
||
else
|
||
txf := TXFreqHz;
|
||
|
||
if txf > 35600000 then Result := Result or $20000000 // bit 29: 6m bypass LPF
|
||
else if txf > 24000000 then Result := Result or $40000000 // bit 30: 12/10m LPF
|
||
else if txf > 16500000 then Result := Result or $80000000 // bit 31: 17/15m LPF
|
||
else if txf > 8000000 then Result := Result or $00100000 // bit 20: 30/20m LPF
|
||
else if txf > 5000000 then Result := Result or $00200000 // bit 21: 60/40m LPF
|
||
else if txf > 2500000 then Result := Result or $00400000 // bit 22: 80m LPF
|
||
else Result := Result or $00800000; // bit 23: 160m LPF
|
||
|
||
// Биты 24-26: ANT 1/2/3. Выбор зависит от диапазона и режима TX/RX.
|
||
// Дефолт ANT1 — безопасен при любом состоянии.
|
||
// Если активен XVTR с RX antenna override (XvtrRxAnt 1..3) — он переопределяет
|
||
// RX антенну. TX антенна для XVTR всё равно берётся из Alex.TxAnt[band] —
|
||
// обычно та же что для основного HF-band за этой IF-частотой.
|
||
BandIdx := FreqToBandIndex(RXFreqHz);
|
||
if Transmitting then
|
||
AntVal := Alex.TxAnt[BandIdx]
|
||
else if (XvtrRxAnt >= 1) and (XvtrRxAnt <= 3) then
|
||
AntVal := XvtrRxAnt
|
||
else
|
||
AntVal := Alex.RxAnt[BandIdx];
|
||
if AntVal < 1 then AntVal := 1;
|
||
case AntVal of
|
||
2: Result := Result or $02000000; // bit 25: ANT 2
|
||
3: Result := Result or $04000000; // bit 26: ANT 3
|
||
else Result := Result or $01000000; // bit 24: ANT 1 (дефолт)
|
||
end;
|
||
|
||
// Биты 8-11: вторичный RX вход (Bypass relay, Ext1, Ext2, XvtrDDC).
|
||
// В режиме TX управляется глобальными флагами; в RX — per-band конфигом.
|
||
// Alex.RxOnly[IF_band]=3 (галочка XVTR в Antenna/Alex tab для IF-диапазона)
|
||
// разрешает XVTR DDC In только когда XvtrActive=True — иначе порт молчит.
|
||
if Transmitting then
|
||
begin
|
||
if Alex.RxBypassOnTx then
|
||
Result := Result or $00000800; // bit 11: Bypass relay
|
||
if Alex.Ext1OnTx then
|
||
Result := Result or $00000200 // bit 9: Ext1
|
||
or $00000800; // bit 11: Bypass relay
|
||
end
|
||
else
|
||
begin
|
||
case Alex.RxOnly[BandIdx] of
|
||
1: Result := Result or $00000200 // bit 9: Ext1
|
||
or $00000800; // bit 11: Bypass relay
|
||
2: Result := Result or $00000400 // bit 10: Ext2
|
||
or $00000800; // bit 11: Bypass relay
|
||
3: if XvtrActive then
|
||
if IsOrion2 then
|
||
Result := Result or $00000100 // bit 8: XVTR DDC In
|
||
or $00004000 // bit 14: Orion2 Master RX select
|
||
else
|
||
Result := Result or $00000100 // bit 8: XVTR DDC In
|
||
or $00000800; // bit 11: Bypass relay
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// Строит 32-битное слово Alex1 для HP-пакета (байты 1428-1431).
|
||
// Только для Orion MkII 5.2 / ANAN-7000/8000 / Saturn / ANAN-G2.
|
||
// Bit 8 = ALEX1_ANAN7000_RX_GNDonTX: заземляет ADC1-вход во время TX
|
||
// чтобы предотвратить перегрузку второго приёмника.
|
||
// Остальные биты — те же LPF/BPF/ANT что и у ALEX0.
|
||
function CalcAlex1(RXFreqHz, TXFreqHz: Double;
|
||
Transmitting: Boolean;
|
||
const Alex: TAlexSettings;
|
||
XvtrDisablePA: Boolean = False): LongWord;
|
||
var
|
||
txf: Double;
|
||
begin
|
||
Result := 0;
|
||
|
||
if Transmitting and not XvtrDisablePA then
|
||
Result := Result or $08000000; // bit 27: T/R relay
|
||
|
||
// BPF для ADC1 — те же пороги что ALEX0 (Orion2-only, используем частоту ADC0)
|
||
if RXFreqHz < 1500000 then Result := Result or $00001000 // bit 12: HF Bypass
|
||
else if RXFreqHz < 2100000 then Result := Result or $00000040 // bit 6: 160m BPF
|
||
else if RXFreqHz < 5500000 then Result := Result or $00000020 // bit 5: 80/60m BPF
|
||
else if RXFreqHz < 11000000 then Result := Result or $00000010 // bit 4: 40/30m BPF
|
||
else if RXFreqHz < 22000000 then Result := Result or $00000002 // bit 1: 20/15m BPF
|
||
else if RXFreqHz < 35600000 then Result := Result or $00000004 // bit 2: 12/10m BPF
|
||
else Result := Result or $00000008; // bit 3: 6m + preamp
|
||
|
||
// TX LPF — Orion2 RX не проходит через TX LPF, поэтому всегда TX-частота
|
||
txf := TXFreqHz;
|
||
if txf > 35600000 then Result := Result or $20000000 // bit 29: 6m bypass LPF
|
||
else if txf > 24000000 then Result := Result or $40000000 // bit 30: 12/10m LPF
|
||
else if txf > 16500000 then Result := Result or $80000000 // bit 31: 17/15m LPF
|
||
else if txf > 8000000 then Result := Result or $00100000 // bit 20: 30/20m LPF
|
||
else if txf > 5000000 then Result := Result or $00200000 // bit 21: 60/40m LPF
|
||
else if txf > 2500000 then Result := Result or $00400000 // bit 22: 80m LPF
|
||
else Result := Result or $00800000; // bit 23: 160m LPF
|
||
|
||
Result := Result or $01000000; // bit 24: ANT1 (ADC1 дефолт)
|
||
|
||
// Bit 8: заземление ADC1-входа во время TX (галочка "Ground BPF2 on TX")
|
||
if Transmitting and Alex.GndBpf2OnTx then
|
||
Result := Result or $00000100;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetAlexConfig(const A: TAlexSettings);
|
||
begin
|
||
FAlexConfig := A;
|
||
if FConnected then SendFullHP;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetXvtrMode(AEnable, ADisablePA: Boolean; ARxAnt: Byte);
|
||
begin
|
||
FXvtrEnable := AEnable;
|
||
FXvtrDisablePA := AEnable and ADisablePA;
|
||
if AEnable and (ARxAnt >= 1) and (ARxAnt <= 3) then
|
||
FXvtrRxAntOverride := ARxAnt
|
||
else
|
||
FXvtrRxAntOverride := 0;
|
||
if FConnected then SendFullHP;
|
||
end;
|
||
|
||
function THPSDRNetwork.DDCBaseIndex: Integer;
|
||
begin
|
||
// Для ANGELIA/ORION/ORION2/SATURN DDC начинается с индекса 2 (DDC0/1 — PureSignal)
|
||
// Для HERMES/HL2 — с 0
|
||
if FDevice.BoardType in [3, 4, 5, 10] then // ANGELIA=3, ORION=4, ORION2=5, SATURN=10
|
||
Result := 2
|
||
else
|
||
Result := 0;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.ConfigureDDCs(NumDDCs: Byte; SampleRate: Word;
|
||
ADCSource: Byte;
|
||
DitherEnabled: Boolean; RandomEnabled: Boolean);
|
||
begin
|
||
// Кэш главного DDC — RebuildDDCSpecific пере-собирает пакет и при
|
||
// добавлении/удалении пан-DDC (SetPanDDC) без повторной передачи rate.
|
||
FMainNumDDCs := NumDDCs;
|
||
FMainRateKHz := SampleRate;
|
||
FMainADC := ADCSource;
|
||
FMainDither := DitherEnabled;
|
||
FMainRandom := RandomEnabled;
|
||
RebuildDDCSpecific;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.RebuildDDCSpecific;
|
||
var
|
||
Pkt: TDDCSpecificPacket;
|
||
i, ddc: Integer;
|
||
DDCBase: Integer;
|
||
|
||
procedure AddDDC(ddc: Integer; RateKHz: Word; ADC: Byte);
|
||
begin
|
||
// Enable bit для DDC ddc
|
||
Pkt.DDCEnable[ddc div 8] := Pkt.DDCEnable[ddc div 8] or Byte(1 shl (ddc mod 8));
|
||
// Config: 6 байт на DDC начиная с offset 17 в пакете → в массиве DDCConfig
|
||
// DDCConfig[ddc*6 + 0] = ADC source
|
||
// DDCConfig[ddc*6 + 1..2] = sample rate / 1000 (ksps)
|
||
// DDCConfig[ddc*6 + 5] = bits per sample
|
||
Pkt.DDCConfig[ddc * 6] := ADC;
|
||
Pkt.DDCConfig[ddc * 6 + 1] := (RateKHz shr 8) and $FF;
|
||
Pkt.DDCConfig[ddc * 6 + 2] := RateKHz and $FF;
|
||
Pkt.DDCConfig[ddc * 6 + 3] := 0;
|
||
Pkt.DDCConfig[ddc * 6 + 4] := 0;
|
||
Pkt.DDCConfig[ddc * 6 + 5] := 24; // 24 bits per sample
|
||
end;
|
||
|
||
begin
|
||
FillChar(Pkt, SizeOf(Pkt), 0);
|
||
|
||
// ANAN-7000/8000/Saturn имеют 2 ADC
|
||
if FDevice.BoardType in [4, 5, 10] then // ORION=4, ORION2=5, SATURN=10
|
||
Pkt.NumADCs := 2
|
||
else
|
||
Pkt.NumADCs := 1;
|
||
|
||
// Dither/Random — биты 0..NumADCs-1 (один бит на ADC)
|
||
if FMainDither then
|
||
Pkt.DitherADC := (1 shl Pkt.NumADCs) - 1;
|
||
if FMainRandom then
|
||
Pkt.RandomADC := (1 shl Pkt.NumADCs) - 1;
|
||
|
||
DDCBase := DDCBaseIndex;
|
||
|
||
for i := 0 to FMainNumDDCs - 1 do
|
||
AddDDC(DDCBase + i, FMainRateKHz, FMainADC);
|
||
|
||
// Пан-DDC (этап 3): доп. панадаптеры на своих rate/ADC. Контроллер
|
||
// аллоцирует hw-индексы после главного, конфликтов с циклом выше нет.
|
||
for ddc := 0 to MAX_DDCS - 1 do
|
||
if FPanDDCEnabled[ddc] then
|
||
AddDDC(ddc, FPanDDCRateKHz[ddc], FPanDDCADC[ddc]);
|
||
|
||
SendDDCSpecific(Pkt);
|
||
FCachedDDCSpec := Pkt;
|
||
FCachedDDCValid := True;
|
||
FResendCount := 0;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetPanDDC(DDCIdx: Integer; Enabled: Boolean;
|
||
FreqHz: Double; RateKHz: Word; ADCSource: Byte);
|
||
begin
|
||
if (DDCIdx < 0) or (DDCIdx >= MAX_DDCS) then Exit;
|
||
FPanDDCEnabled[DDCIdx] := Enabled;
|
||
FPanDDCFreqHz[DDCIdx] := FreqHz;
|
||
FPanDDCRateKHz[DDCIdx] := RateKHz;
|
||
FPanDDCADC[DDCIdx] := ADCSource;
|
||
if FConnected and FRunning then
|
||
begin
|
||
RebuildDDCSpecific; // enable-бит + rate/ADC
|
||
SendFullHP; // частотное слово DDC
|
||
end;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetPanDDCFreq(DDCIdx: Integer; FreqHz: Double);
|
||
begin
|
||
if (DDCIdx < 0) or (DDCIdx >= MAX_DDCS) then Exit;
|
||
FPanDDCFreqHz[DDCIdx] := FreqHz;
|
||
if FConnected and FPanDDCEnabled[DDCIdx] then SendFullHP;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendDUCSpecific(const Pkt: TDUCSpecificPacket);
|
||
var
|
||
B: TDUCSpecificPacket;
|
||
begin
|
||
B := Pkt;
|
||
PackSeqBytes(B.Seq, NextSeq(FSeqDUCSpec));
|
||
DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortDUCSpec);
|
||
// Кэш для пере-отправки в keepalive (см. ResendThread)
|
||
FCachedDUCSpec := Pkt;
|
||
FCachedDUCValid := True;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendHighPriority(const Pkt: THighPriorityPacket);
|
||
var
|
||
B: THighPriorityPacket;
|
||
begin
|
||
B := Pkt;
|
||
PackSeqBytes(B.Seq, NextSeq(FSeqHP));
|
||
DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortHPFromPC);
|
||
end;
|
||
|
||
procedure THPSDRNetwork.UpdateState(RXFreqHz, TXFreqHz: Double;
|
||
DriveLevel: Byte;
|
||
Transmitting, PAEnabled, AlexEnabled: Boolean);
|
||
begin
|
||
FCurrentRXFreq := RXFreqHz;
|
||
FCurrentTXFreq := TXFreqHz;
|
||
FCurrentDrive := DriveLevel;
|
||
FIsTransmitting := Transmitting;
|
||
FPAEnabled := PAEnabled;
|
||
FAlexEnabled := AlexEnabled;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetStepAtten(dB: Byte);
|
||
begin
|
||
if dB > 31 then dB := 31;
|
||
FStepAtten := dB;
|
||
if FConnected then SendFullHP;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendFullHP;
|
||
var
|
||
Buf: array[0..1443] of Byte;
|
||
Ph: LongWord;
|
||
Alex0: LongWord;
|
||
Alex1: LongWord;
|
||
IsOrion2: Boolean;
|
||
DDCBase: Integer; // 0 для HERMES, 2 для ORION/ORION2/ANGELIA
|
||
ddc: Integer;
|
||
begin
|
||
if not FConnected then Exit;
|
||
|
||
FHPSendLock.Enter;
|
||
try
|
||
|
||
FillChar(Buf, SizeOf(Buf), 0);
|
||
|
||
// Sequence — будет упакован в SendHighPriority через PackSeqBytes,
|
||
// но здесь мы шлём raw буфер напрямую
|
||
Buf[0] := (FSeqHP shr 24) and $FF;
|
||
Buf[1] := (FSeqHP shr 16) and $FF;
|
||
Buf[2] := (FSeqHP shr 8) and $FF;
|
||
Buf[3] := FSeqHP and $FF;
|
||
Inc(FSeqHP);
|
||
|
||
// Byte 4: Run | PTT
|
||
if FRunning then
|
||
begin
|
||
Buf[4] := HP_RUN;
|
||
if FPTTActive then Buf[4] := Buf[4] or HP_PTT0;
|
||
end;
|
||
|
||
// IsOrion2: платы с Alex BPF и TxRx Status bit18 (ORION_MK2=5, SATURN=10)
|
||
IsOrion2 := FDevice.BoardType in [5, 10]; // ORION_MK2=5, SATURN=10
|
||
DDCBase := DDCBaseIndex;
|
||
|
||
// DDC RX frequency (bytes 9 + DDC*4)
|
||
Ph := FreqToPhaseWord(FCurrentRXFreq);
|
||
Buf[9 + DDCBase*4] := (Ph shr 24) and $FF;
|
||
Buf[10 + DDCBase*4] := (Ph shr 16) and $FF;
|
||
Buf[11 + DDCBase*4] := (Ph shr 8) and $FF;
|
||
Buf[12 + DDCBase*4] := Ph and $FF;
|
||
|
||
// Частоты пан-DDC (этап 3): своё частотное слово каждому активному DDC.
|
||
// Макс. смещение 9+79*4=325 < 329 (DUC) — в частотную зону влезают все.
|
||
for ddc := 0 to MAX_DDCS - 1 do
|
||
if FPanDDCEnabled[ddc] then
|
||
begin
|
||
Ph := FreqToPhaseWord(FPanDDCFreqHz[ddc]);
|
||
Buf[9 + ddc*4] := (Ph shr 24) and $FF;
|
||
Buf[10 + ddc*4] := (Ph shr 16) and $FF;
|
||
Buf[11 + ddc*4] := (Ph shr 8) and $FF;
|
||
Buf[12 + ddc*4] := Ph and $FF;
|
||
end;
|
||
|
||
// DUC TX frequency (bytes 329-332)
|
||
Ph := FreqToPhaseWord(FCurrentTXFreq);
|
||
Buf[329] := (Ph shr 24) and $FF;
|
||
Buf[330] := (Ph shr 16) and $FF;
|
||
Buf[331] := (Ph shr 8) and $FF;
|
||
Buf[332] := Ph and $FF;
|
||
|
||
// Drive level (byte 345)
|
||
if FIsTransmitting then
|
||
Buf[345] := FCurrentDrive;
|
||
|
||
// ALEX0 filter bits (bytes 1432-1435)
|
||
if FAlexEnabled then
|
||
begin
|
||
Alex0 := CalcAlex0(FCurrentRXFreq, FCurrentTXFreq,
|
||
FIsTransmitting, IsOrion2, FAlexConfig,
|
||
FXvtrRxAntOverride, FXvtrDisablePA,
|
||
FXvtrEnable, FWidebandEnabled);
|
||
Buf[1432] := (Alex0 shr 24) and $FF;
|
||
Buf[1433] := (Alex0 shr 16) and $FF;
|
||
Buf[1434] := (Alex0 shr 8) and $FF;
|
||
Buf[1435] := Alex0 and $FF;
|
||
|
||
// ALEX1 filter bits (bytes 1428-1431) — только Orion2/Saturn
|
||
if IsOrion2 then
|
||
begin
|
||
Alex1 := CalcAlex1(FCurrentRXFreq, FCurrentTXFreq,
|
||
FIsTransmitting, FAlexConfig,
|
||
FXvtrDisablePA);
|
||
Buf[1428] := (Alex1 shr 24) and $FF;
|
||
Buf[1429] := (Alex1 shr 16) and $FF;
|
||
Buf[1430] := (Alex1 shr 8) and $FF;
|
||
Buf[1431] := Alex1 and $FF;
|
||
end;
|
||
end;
|
||
|
||
// XVTR enable bit (byte 1400 bit 0) — управляет выходом VHF T/R relay платы.
|
||
// Логика как в Thetis:
|
||
// в XVTR-режиме: бит = DisablePA (внешний T/R relay нужен только если PA подавлен)
|
||
// в HF-режиме: бит = Alex.EnableXvtrHf (галочка "Enable XVTR HF" в Antenna tab)
|
||
if FXvtrEnable then
|
||
begin
|
||
if FXvtrDisablePA then
|
||
Buf[1400] := Buf[1400] or $01;
|
||
end
|
||
else
|
||
begin
|
||
if FAlexConfig.EnableXvtrHf then
|
||
Buf[1400] := Buf[1400] or $01;
|
||
end;
|
||
|
||
// Audio mute (byte 1400 bit 1) — ANAN-8000DLE: IO1 output, 0=audio enabled,
|
||
// 1=mute. Когда отправка аудио в радио выключена, держим динамик в мьюте.
|
||
// На прочих платах бит «not assigned» и игнорируется.
|
||
if not FSpeakerAudioEnabled then
|
||
Buf[1400] := Buf[1400] or $02;
|
||
|
||
// Step attenuators ADC0/ADC1 (bytes 1443/1442)
|
||
// 0 dB = 0, max 31 dB
|
||
Buf[1443] := FStepAtten; // ADC0 attenuation
|
||
Buf[1442] := FStepAtten; // ADC1 attenuation
|
||
|
||
DoSendTo(FSocket, Buf, SizeOf(Buf), FDevice.IPAddress, FPortHPFromPC);
|
||
|
||
finally
|
||
FHPSendLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetRunAndFreq(Run: Boolean; DDC0FreqHz, DUCFreqHz: Double;
|
||
DriveLevel: Byte);
|
||
begin
|
||
// При Run=1 аппаратура сбрасывает счётчик HP-последовательности.
|
||
// Синхронизируем свой счётчик чтобы не получить SEQ ERROR на первом пакете.
|
||
if Run then FSeqHP := 0;
|
||
FRunning := Run;
|
||
FCurrentRXFreq := DDC0FreqHz;
|
||
FCurrentTXFreq := DUCFreqHz;
|
||
FCurrentDrive := DriveLevel;
|
||
SendFullHP;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendPTT(Active: Boolean);
|
||
begin
|
||
FPTTActive := Active;
|
||
if FConnected then SendFullHP;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendDDCAudio(const LeftRight: array of SmallInt);
|
||
var
|
||
Pkt: TDDCAudioPacket;
|
||
i: Integer;
|
||
V: SmallInt;
|
||
begin
|
||
FillChar(Pkt, SizeOf(Pkt), 0);
|
||
PackSeqBytes(Pkt.Seq, NextSeq(FSeqAudio));
|
||
for i := 0 to Min(127, High(LeftRight)) do
|
||
begin
|
||
V := LeftRight[i];
|
||
Pkt.AudioData[i * 2] := Byte((V shr 8) and $FF);
|
||
Pkt.AudioData[i * 2 + 1] := Byte(V and $FF);
|
||
end;
|
||
DoSendTo(FSocket, Pkt, SizeOf(Pkt), FDevice.IPAddress, FPortDDCAudio);
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SetSpeakerAudio(AEnabled: Boolean);
|
||
begin
|
||
FSpeakerAudioEnabled := AEnabled;
|
||
if not AEnabled then FSpeakerCount := 0; // сброс накопленного хвоста
|
||
if FConnected then SendFullHP; // применить мьют (byte 1400 bit1)
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendSpeakerAudio(const Left, Right: array of Single;
|
||
Count: Integer);
|
||
|
||
function ToS16(V: Single): SmallInt;
|
||
begin
|
||
if V > 1.0 then V := 1.0
|
||
else if V < -1.0 then V := -1.0;
|
||
Result := SmallInt(Round(V * 32767.0));
|
||
end;
|
||
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if not (FSpeakerAudioEnabled and FConnected and FRunning) then
|
||
begin
|
||
FSpeakerCount := 0;
|
||
Exit;
|
||
end;
|
||
for i := 0 to Count - 1 do
|
||
begin
|
||
FSpeakerBuf[FSpeakerCount] := ToS16(Left[i]);
|
||
FSpeakerBuf[FSpeakerCount + 1] := ToS16(Right[i]);
|
||
Inc(FSpeakerCount, 2);
|
||
if FSpeakerCount >= Length(FSpeakerBuf) then
|
||
begin
|
||
SendDDCAudio(FSpeakerBuf);
|
||
FSpeakerCount := 0;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.PrimeDUCIQ(Pairs: Integer);
|
||
// Pre-roll на старте TX: Pairs нулевых IQ-пар (пакетами по 240) в очередь.
|
||
// Sender вышлет их немедленно (VirtualSamples после RX-паузы = 0, троттл
|
||
// пропустит бёрст) — DUC-FIFO радио наполняется нулями, пока реле/WDSP
|
||
// раскачиваются, и DAC не стартует с пустого буфера (underrun-всплеск).
|
||
var
|
||
Pkt: TDUCIQPacket;
|
||
n: Integer;
|
||
begin
|
||
if not FConnected then Exit;
|
||
FillChar(Pkt, SizeOf(Pkt), 0);
|
||
n := (Pairs + 239) div 240;
|
||
while n > 0 do
|
||
begin
|
||
EnqueueDUCIQ(Pkt);
|
||
Dec(n);
|
||
end;
|
||
end;
|
||
|
||
procedure THPSDRNetwork.SendDUCIQ(const IData, QData: array of Integer);
|
||
var
|
||
Pkt: TDUCIQPacket;
|
||
i, Off: Integer;
|
||
IV, QV: Integer;
|
||
begin
|
||
if not FConnected then Exit;
|
||
FillChar(Pkt, SizeOf(Pkt), 0);
|
||
for i := 0 to Min(239, Min(High(IData), High(QData))) do
|
||
begin
|
||
Off := i * 6;
|
||
IV := IData[i];
|
||
QV := QData[i];
|
||
Pkt.IQData[Off] := Byte((IV shr 16) and $FF);
|
||
Pkt.IQData[Off + 1] := Byte((IV shr 8) and $FF);
|
||
Pkt.IQData[Off + 2] := Byte( IV and $FF);
|
||
Pkt.IQData[Off + 3] := Byte((QV shr 16) and $FF);
|
||
Pkt.IQData[Off + 4] := Byte((QV shr 8) and $FF);
|
||
Pkt.IQData[Off + 5] := Byte( QV and $FF);
|
||
end;
|
||
EnqueueDUCIQ(Pkt);
|
||
end;
|
||
|
||
|
||
initialization
|
||
{$IFDEF WINDOWS}
|
||
WinSock2.WSAStartup($0202, WSAData_);
|
||
{$ENDIF}
|
||
|
||
finalization
|
||
{$IFDEF WINDOWS}
|
||
WinSock2.WSACleanup;
|
||
{$ENDIF}
|
||
|
||
end.
|