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; 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.