mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
ew8bakandClaude Sonnet 4.6
ebca3b4137
Opus decodes 960 samples per frame; the TX DSP thread consumes 512-sample blocks. 960 mod 512 = 448, so the ring always kept a sub-threshold tail, causing TTXDSPThread to skip ticks and starve the DUC hardware every ~20 ms. FlushMicToCallback accumulates samples in FMicStageBuf and calls FOnWebMic only when a full 512-sample block is ready. The remainder stays in the buffer until the next Opus frame arrives. This ensures FTXMicRing always receives data in multiples of 512, eliminating the 0 < Avail < 512 dead-zone entirely. FMicStageLen is reset together with FMicPreRollPos on new TX session to prevent stale samples from a previous session mixing in. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
1594 lines
61 KiB
ObjectPascal
1594 lines
61 KiB
ObjectPascal
unit WebServer;
|
||
|
||
{
|
||
WebServer.pas — HTTP + WebSocket сервер для удалённого управления трансивером.
|
||
|
||
Архитектура (по образцу OpenWebRX):
|
||
─────────────────────────────────
|
||
HTTP GET / → index.html (см. WebPageHtml)
|
||
HTTP GET /ws → Upgrade: WebSocket
|
||
WebSocket сессия:
|
||
• Сервер → клиент:
|
||
- каждые ~50 ms: бинарный фрейм типа 'S' + 1024×Float32 спектр
|
||
- каждые ~50 ms: бинарный фрейм типа 'W' + N×Float32 waterfall строка
|
||
- каждые ~100ms: бинарный фрейм типа 'A' + Opus-пакет (48kHz mono)
|
||
- каждые ~200ms: JSON-текст со state (freq, mode, smeter, …)
|
||
• Клиент → сервер: JSON-команды
|
||
"cmd":"freq","hz":14200000
|
||
"cmd":"mode","mode":1
|
||
"cmd":"filter","bw":2700
|
||
"cmd":"agc","mode":1
|
||
"cmd":"agctop","db":90
|
||
"cmd":"band","idx":5
|
||
"cmd":"span","hz":192000
|
||
"cmd":"volume","v":70
|
||
"cmd":"wfagc","on":true
|
||
"cmd":"wfnf","on":true
|
||
|
||
Аудио: 48kHz mono Float32 → Opus (20ms frames, 32 kbps)
|
||
Спектр: 1024 Float32 dBm значений
|
||
Авторизация: Basic Auth через HTTP заголовок при первом запросе
|
||
|
||
Зависимости: WebUtils, WsClient, WebPageHtml + RTL + libopus (динамическая загрузка)
|
||
Платформы: Windows + Linux (Winsock2 / BSD sockets)
|
||
|
||
ИСПРАВЛЕНИЯ:
|
||
- (Windows build fix) SyncObjs перенесён в конец блока uses — устраняет
|
||
конфликт идентификатора Create с символами из WinSock2 в {$MODE Delphi}.
|
||
- (Windows runtime fix) Добавлены WSAStartup/WSACleanup в конструктор и
|
||
деструктор — без этого socket/bind/listen возвращают WSANOTINITIALISED.
|
||
- (Linux shutdown fix) В Stop: перед SockClose вызывается SockShutdown для
|
||
listen-сокета и для каждого клиентского сокета. На Linux закрытие
|
||
дескриптора не прерывает блокирующий fpAccept/fpRecv в чужом потоке —
|
||
только shutdown(SHUT_RDWR) гарантированно разблокирует их, позволяя
|
||
потокам выйти и WaitFor завершиться без зависания.
|
||
- (Audio fix 1) Исправлена константа OPUS_APPLICATION_AUDIO: было 2101
|
||
(невалидное значение), стало 2049 — правильное значение. Неверная
|
||
константа приводила к Err!=0 из opus_encoder_create, FOpusEnc=nil,
|
||
FOpusReady=false — аудио не кодировалось совсем.
|
||
- (Audio fix 2) Заголовки COOP/COEP убраны — они блокировали WebSocket
|
||
и загрузку CDN ресурсов (fonts, opus-decoder), из-за чего
|
||
FWebClientActive никогда не становился true и десктоп звук не
|
||
отключался при подключении веб-клиента.
|
||
- (Audio fix 3) В JS исправлен вызов декодера: decodeFrame → decode
|
||
(актуальный API opus-decoder@0.7.7). decodeFrame не существует в этой
|
||
версии — silent fail, звука нет.
|
||
- (Audio fix 4) Добавлен оверлей "Click to start audio" — AudioContext
|
||
нельзя создать из WebSocket callback (не user gesture). Оверлей
|
||
гарантирует создание AudioContext при первом кликe пользователя.
|
||
- (Audio fix 5) Буферизация Opus-пакетов пока WASM не инициализирован —
|
||
первые пакеты больше не теряются при медленной загрузке CDN.
|
||
}
|
||
|
||
{$IFDEF FPC}
|
||
{$MODE Delphi}
|
||
{$LONGSTRINGS ON}
|
||
{$ENDIF}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, Math,
|
||
WebUtils, WsClient, WebPageHtml
|
||
{$IFDEF WINDOWS}, Windows, WinSock2{$ELSE}, BaseUnix, Sockets{$ENDIF},
|
||
SyncObjs; // ← после платформенных юнитов: исключает конфликт идентификатора Create
|
||
|
||
const
|
||
WEB_PORT = 8080;
|
||
OPUS_SAMPLE_RATE = 48000;
|
||
OPUS_FRAME_MS = 20;
|
||
OPUS_FRAME_SAMP = OPUS_SAMPLE_RATE * OPUS_FRAME_MS div 1000; // 960 samples
|
||
OPUS_BITRATE = 32000;
|
||
OPUS_CHANNELS = 1;
|
||
// ── TX-mic jitter handling (web → server) ──
|
||
// Pre-roll: при старте новой TX-сессии задерживаем 40мс аудио, чтобы дать
|
||
// FTXMicRing запас перед началом потребления — иначе при джиттере WiFi
|
||
// ring мгновенно пустеет и WDSP TX-thread заливает тишину = "робот".
|
||
MIC_PREROLL_MS = 40;
|
||
MIC_PREROLL_SAMP = OPUS_SAMPLE_RATE * MIC_PREROLL_MS div 1000; // 1920
|
||
// Опоздание > MIC_IDLE_MS считаем концом TX-сессии: сбрасываем pre-roll
|
||
// (на следующий пакет — снова накапливаем cushion).
|
||
MIC_IDLE_MS = 200;
|
||
// Максимум подряд синтезированных PLC-кадров (Opus PLC деградирует после ~3–5 кадров).
|
||
MIC_MAX_PLC = 5;
|
||
MAX_WS_CLIENTS = 4;
|
||
WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
|
||
|
||
// Типы бинарных фреймов (первый байт = тип)
|
||
WS_MSG_SPECTRUM = Byte(Ord('S')); // S + 1024×Float32
|
||
WS_MSG_WATERFALL = Byte(Ord('W')); // W + N×Float32
|
||
WS_MSG_AUDIO = Byte(Ord('A')); // A + Opus bytes
|
||
WS_MSG_AUDIO_PCM = Byte(Ord('P')); // P + N×Float32 (mono 48k)
|
||
WS_MSG_STATE = Byte(Ord('J')); // J + JSON text
|
||
|
||
type
|
||
// ── Opus dynamic binding ──────────────────────────────────────────────────
|
||
POpusEncoder = Pointer;
|
||
|
||
TOpus_encoder_create = function(Fs, channels, application: Integer;
|
||
error: PInteger): POpusEncoder; cdecl;
|
||
TOpus_encoder_destroy = procedure(st: POpusEncoder); cdecl;
|
||
TOpus_encode_float = function(st: POpusEncoder;
|
||
pcm: PSingle; frame_size: Integer;
|
||
data: PByte; max_data_bytes: Integer): Integer; cdecl;
|
||
TOpus_encoder_ctl_set = function(st: POpusEncoder;
|
||
request: Integer; value: Integer): Integer; cdecl;
|
||
|
||
POpusDecoder = Pointer;
|
||
TOpus_decoder_create = function(Fs, channels: Integer;
|
||
error: PInteger): POpusDecoder; cdecl;
|
||
TOpus_decode_float = function(st: POpusDecoder; data: PByte; len: Integer;
|
||
pcm: PSingle; frame_size, decode_fec: Integer): Integer; cdecl;
|
||
TOpus_decoder_destroy = procedure(st: POpusDecoder); cdecl;
|
||
|
||
// ── Callbacks в MainForm ──────────────────────────────────────────────────
|
||
TWebCmdFreq = procedure(Hz: Double) of object;
|
||
TWebCmdMode = procedure(Mode: Integer) of object;
|
||
TWebCmdFilter = procedure(BW: Integer) of object;
|
||
TWebCmdAGC = procedure(Mode: Integer) of object;
|
||
TWebCmdAGCTop = procedure(DB: Integer) of object;
|
||
TWebCmdBand = procedure(Idx: Integer) of object;
|
||
TWebCmdSpan = procedure(Hz: Integer) of object;
|
||
TWebCmdVolume = procedure(V: Integer) of object;
|
||
TWebCmdWfAGC = procedure(On_: Boolean) of object;
|
||
TWebCmdWfNF = procedure(On_: Boolean) of object;
|
||
TWebCmdRun = procedure(On_: Boolean) of object;
|
||
TWebCmdMute = procedure(On_: Boolean) of object;
|
||
TWebCmdCtun = procedure(On_: Boolean) of object;
|
||
TWebCmdNRMode = procedure(Mode: Integer) of object;
|
||
TWebCmdNBMode = procedure(Mode: Integer) of object;
|
||
TWebCmdSNB = procedure(On_: Boolean) of object;
|
||
TWebCmdANF = procedure(On_: Boolean) of object;
|
||
TWebCmdFreqB = procedure(Hz: Double) of object;
|
||
TWebCmdActiveVfo = procedure(Idx: Integer) of object;
|
||
TWebCmdCenter = procedure(Hz: Double) of object;
|
||
TWebCmdMOX = procedure(On_: Boolean) of object;
|
||
TWebCmdDrive = procedure(V: Integer) of object;
|
||
TWebCmdFreqA = procedure(Hz: Double) of object;
|
||
TWebCmdAttn = procedure(Idx: Integer) of object;
|
||
TWebCmdTun = procedure(On_: Boolean) of object;
|
||
TWebCmdFMStep = procedure(Idx: Integer) of object;
|
||
// XVTR-band: web клиент кликнул кнопку трансвертера (Idx 0..CFG_XVTR_COUNT-1).
|
||
// Idx=-1 — выход в HF.
|
||
TWebCmdXvtrBand = procedure(Idx: Integer) of object;
|
||
// Один XVTR-слот для статуса (для отображения в web-bandSel).
|
||
TWebXvtrInfo = record
|
||
Idx: Integer;
|
||
Name: string;
|
||
end;
|
||
TWebXvtrArray = array of TWebXvtrInfo;
|
||
TWebMicCB = procedure(Samples: PSingle; Count: Integer) of object;
|
||
|
||
// ── Главный класс сервера ─────────────────────────────────────────────────
|
||
TWebServer = class
|
||
private
|
||
// ── Opus ──
|
||
FOpusLib: THandle;
|
||
FOpusEnc: POpusEncoder;
|
||
FOpusCreate: TOpus_encoder_create;
|
||
FOpusDestroy: TOpus_encoder_destroy;
|
||
FOpusEncode: TOpus_encode_float;
|
||
FOpusCtl: TOpus_encoder_ctl_set;
|
||
FOpusBuf: array[0..OPUS_FRAME_SAMP-1] of Single;
|
||
FOpusBufPos: Integer;
|
||
FOpusOut: array[0..3999] of Byte;
|
||
FWsAudioBuf: array[0..4000] of Byte; // 1 байт типа + до 4000 байт Opus
|
||
FOpusReady: Boolean;
|
||
// Opus decoder — для RX TX-mic аудио от браузера
|
||
FOpusDec: POpusDecoder;
|
||
FOpusDecCreate: TOpus_decoder_create;
|
||
FOpusDecDecode: TOpus_decode_float;
|
||
FOpusDecDestroy: TOpus_decoder_destroy;
|
||
FOnWebMic: TWebMicCB;
|
||
// ── Jitter buffer для TX-mic от веб-клиента ──
|
||
// FMicLastTick = 0 → нет активной TX-сессии (на следующий пакет — pre-roll сброс)
|
||
// FMicPreRollPos < MIC_PREROLL_SAMP → ещё копим pre-roll
|
||
FMicLastTick: QWord;
|
||
FMicPreRollPos: Integer;
|
||
FMicPreRoll: array[0..MIC_PREROLL_SAMP-1] of Single;
|
||
|
||
// ── Staging buffer: выравнивание по границе DSP-блока ──────────────────
|
||
// Opus декодирует по 960 сэмплов, а TX DSP потребляет по 512.
|
||
// 960 mod 512 = 448 — в ring всегда остаётся хвост меньше порога,
|
||
// из-за чего TTXDSPThread пропускает тики и DUC hardware голодает.
|
||
// FlushMicToCallback накапливает сэмплы здесь и вызывает FOnWebMic
|
||
// ровно тогда, когда накопился полный блок 512 сэмплов.
|
||
// Гарантия: FTXMicRing всегда получает данные кратными 512.
|
||
FMicStageBuf: array[0..511] of Single; // буфер одного DSP-блока
|
||
FMicStageLen: Integer; // сколько сэмплов накоплено
|
||
|
||
// ── TCP ──
|
||
FListenSock: TSocket;
|
||
FClients: array[0..MAX_WS_CLIENTS-1] of TWsClient;
|
||
FClientCount: Integer;
|
||
FClientLock: TCriticalSection;
|
||
|
||
// ── Потоки ──
|
||
FAcceptThread: TThread;
|
||
FPushThread: TThread;
|
||
FRunning: Boolean;
|
||
|
||
// ── Авторизация ──
|
||
FAuthToken: string; // Base64(user:pass)
|
||
// ── Сетевая конфигурация ──
|
||
FPort: Word;
|
||
FBindIP: string;
|
||
|
||
// ── Состояние (обновляется из MainForm) ──
|
||
FSpectrumBuf: array[0..1023] of Single;
|
||
FWfBuf: array[0..1023] of Single;
|
||
FWfCount: Integer;
|
||
FSMeter: Double;
|
||
FFreq: Double;
|
||
FMode: Integer;
|
||
FFilterBW: Integer;
|
||
FAGCMode: Integer;
|
||
FAGCTop: Integer;
|
||
FSpanHz: Double;
|
||
FVolume: Integer;
|
||
FWfAGC: Boolean;
|
||
FWfNF: Boolean;
|
||
FBandIdx: Integer;
|
||
FConnected: Boolean;
|
||
FTrxRunning: Boolean;
|
||
FMuted: Boolean;
|
||
FCtun: Boolean;
|
||
FNRMode: Integer;
|
||
FNBMode: Integer;
|
||
FSNB: Boolean;
|
||
FANF: Boolean;
|
||
FCenterHz: Double;
|
||
FFilterIdx: Integer;
|
||
FVfoB: Double;
|
||
FActiveVfo: Integer; // 0=A, 1=B
|
||
FFMStepIdx: Integer;
|
||
FStateLock: TCriticalSection;
|
||
|
||
// ── Callbacks ──
|
||
FOnFreq: TWebCmdFreq;
|
||
FOnMode: TWebCmdMode;
|
||
FOnFilter: TWebCmdFilter;
|
||
FOnAGC: TWebCmdAGC;
|
||
FOnAGCTop: TWebCmdAGCTop;
|
||
FOnBand: TWebCmdBand;
|
||
FOnSpan: TWebCmdSpan;
|
||
FOnVolume: TWebCmdVolume;
|
||
FOnWfAGC: TWebCmdWfAGC;
|
||
FOnWfNF: TWebCmdWfNF;
|
||
FOnRun: TWebCmdRun;
|
||
FOnMute: TWebCmdMute;
|
||
FOnCtun: TWebCmdCtun;
|
||
FOnNR: TWebCmdNRMode;
|
||
FOnNB: TWebCmdNBMode;
|
||
FOnSNB: TWebCmdSNB;
|
||
FOnANF: TWebCmdANF;
|
||
FOnFreqB: TWebCmdFreqB;
|
||
FOnActiveVfo: TWebCmdActiveVfo;
|
||
FOnCenter: TWebCmdCenter;
|
||
FOnMOX: TWebCmdMOX;
|
||
FOnDrive: TWebCmdDrive;
|
||
FTransmitting: Boolean;
|
||
FDriveLevel: Integer;
|
||
FOnFreqA: TWebCmdFreqA;
|
||
FOnAttn: TWebCmdAttn;
|
||
FAttnIdx: Integer;
|
||
FOnTun: TWebCmdTun;
|
||
FOnFMStep: TWebCmdFMStep;
|
||
FTuning: Boolean;
|
||
FDuplex: Boolean;
|
||
FFreqMhzDigits: Integer; // 3=999MHz, 4=9.999GHz, 5=99.999GHz
|
||
FXvtrBands: TWebXvtrArray; // список enabled XVTR (для web-UI)
|
||
FCurrentXvtr: Integer; // -1 = HF, иначе индекс активного XVTR
|
||
FOnXvtrBand: TWebCmdXvtrBand;
|
||
|
||
FFwdW: Double;
|
||
FSWR: Double;
|
||
FPAMaxPower: Double;
|
||
|
||
FWebClientActive: Boolean;
|
||
|
||
// ── Внутренние методы ──
|
||
function LoadOpus: Boolean;
|
||
procedure UnloadOpus;
|
||
procedure PushMicSamples(P: PSingle; N: Integer);
|
||
procedure FlushMicToCallback(P: PSingle; N: Integer);
|
||
function InitListen: Boolean;
|
||
procedure AcceptLoop;
|
||
procedure PushLoop;
|
||
procedure HandleClient(Client: TWsClient);
|
||
procedure ProcessCommand(Client: TWsClient; const Json: string);
|
||
procedure BroadcastBinary(const Data; Len: Integer);
|
||
procedure BroadcastText(const S: string);
|
||
procedure RemoveClient(Client: TWsClient);
|
||
function BuildStateJson: string;
|
||
function CheckAuth(const Header: string): Boolean;
|
||
procedure SendHttp(Client: TWsClient; Code: Integer; const ContentType, Body: string);
|
||
// Stub-методы (реализация встроена в HandleClient)
|
||
procedure DoHandshake(Client: TWsClient);
|
||
procedure ProcessWsFrame(Client: TWsClient; const Data: array of Byte; Len: Integer; Opcode: Byte);
|
||
|
||
public
|
||
constructor Create(const Username, Password: string;
|
||
Port: Word = 8080; const BindIP: string = '0.0.0.0');
|
||
destructor Destroy; override;
|
||
|
||
function Start: Boolean;
|
||
procedure Stop;
|
||
procedure Reconfigure(const Username, Password, BindIP: string; Port: Word);
|
||
|
||
// Вызывается из DSP-потока (аудио, 48kHz mono)
|
||
procedure PushAudio(const Samples: PSingle; Count: Integer);
|
||
// Вызывается из таймера спектра (UI thread)
|
||
procedure PushSpectrum(
|
||
const Buf: array of Single; Count: Integer;
|
||
const WfBuf_: array of Single;
|
||
SMeter: Double;
|
||
Freq: Double; Mode, FilterBW, AGCMode, AGCTop: Integer;
|
||
SpanHz: Double; Volume: Integer;
|
||
WfAGC, WfNF: Boolean; BandIdx: Integer;
|
||
TrxConnected: Boolean;
|
||
TrxRunning, Muted, Ctun: Boolean;
|
||
NRMode, NBMode: Integer; SNB, ANF: Boolean;
|
||
CenterHz: Double; FilterIdx: Integer;
|
||
VfoB: Double; ActiveVfo: Integer;
|
||
Transmitting: Boolean; DriveLevel: Integer;
|
||
AttnIdx: Integer; Tuning: Boolean; Duplex: Boolean;
|
||
FwdW, SWRV, PAMaxPower: Double);
|
||
|
||
property WebClientActive: Boolean read FWebClientActive;
|
||
property FreqMhzDigits: Integer read FFreqMhzDigits write FFreqMhzDigits;
|
||
property FMStepIdx: Integer read FFMStepIdx write FFMStepIdx;
|
||
|
||
property OnFreq: TWebCmdFreq read FOnFreq write FOnFreq;
|
||
property OnMode: TWebCmdMode read FOnMode write FOnMode;
|
||
property OnFilter: TWebCmdFilter read FOnFilter write FOnFilter;
|
||
property OnAGC: TWebCmdAGC read FOnAGC write FOnAGC;
|
||
property OnAGCTop: TWebCmdAGCTop read FOnAGCTop write FOnAGCTop;
|
||
property OnBand: TWebCmdBand read FOnBand write FOnBand;
|
||
property OnXvtrBand: TWebCmdXvtrBand read FOnXvtrBand write FOnXvtrBand;
|
||
procedure SetXvtrBands(const ABands: TWebXvtrArray; ACurrent: Integer);
|
||
property OnSpan: TWebCmdSpan read FOnSpan write FOnSpan;
|
||
property OnVolume: TWebCmdVolume read FOnVolume write FOnVolume;
|
||
property OnWfAGC: TWebCmdWfAGC read FOnWfAGC write FOnWfAGC;
|
||
property OnWfNF: TWebCmdWfNF read FOnWfNF write FOnWfNF;
|
||
property OnRun: TWebCmdRun read FOnRun write FOnRun;
|
||
property OnMute: TWebCmdMute read FOnMute write FOnMute;
|
||
property OnCtun: TWebCmdCtun read FOnCtun write FOnCtun;
|
||
property OnNR: TWebCmdNRMode read FOnNR write FOnNR;
|
||
property OnNB: TWebCmdNBMode read FOnNB write FOnNB;
|
||
property OnSNB: TWebCmdSNB read FOnSNB write FOnSNB;
|
||
property OnANF: TWebCmdANF read FOnANF write FOnANF;
|
||
property OnFreqB: TWebCmdFreqB read FOnFreqB write FOnFreqB;
|
||
property OnActiveVfo: TWebCmdActiveVfo read FOnActiveVfo write FOnActiveVfo;
|
||
property OnCenter: TWebCmdCenter read FOnCenter write FOnCenter;
|
||
property OnMOX: TWebCmdMOX read FOnMOX write FOnMOX;
|
||
property OnDrive: TWebCmdDrive read FOnDrive write FOnDrive;
|
||
property OnFreqA: TWebCmdFreqA read FOnFreqA write FOnFreqA;
|
||
property OnAttn: TWebCmdAttn read FOnAttn write FOnAttn;
|
||
property OnTun: TWebCmdTun read FOnTun write FOnTun;
|
||
property OnFMStep: TWebCmdFMStep read FOnFMStep write FOnFMStep;
|
||
property OnWebMic: TWebMicCB read FOnWebMic write FOnWebMic;
|
||
end;
|
||
|
||
implementation
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Внутренние классы потоков
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
type
|
||
TAcceptThread = class(TThread)
|
||
private FServer: TWebServer;
|
||
protected procedure Execute; override;
|
||
public constructor Create(AServer: TWebServer);
|
||
end;
|
||
|
||
TPushThread = class(TThread)
|
||
private FServer: TWebServer;
|
||
protected procedure Execute; override;
|
||
public constructor Create(AServer: TWebServer);
|
||
end;
|
||
|
||
TClientThread = class(TThread)
|
||
private FServer: TWebServer; FClient: TWsClient;
|
||
protected procedure Execute; override;
|
||
public constructor Create(AServer: TWebServer; AClient: TWsClient);
|
||
end;
|
||
|
||
constructor TAcceptThread.Create(AServer: TWebServer);
|
||
begin
|
||
inherited Create(True);
|
||
FServer := AServer;
|
||
FreeOnTerminate := False;
|
||
end;
|
||
|
||
procedure TAcceptThread.Execute;
|
||
begin
|
||
FServer.AcceptLoop;
|
||
end;
|
||
|
||
constructor TPushThread.Create(AServer: TWebServer);
|
||
begin
|
||
inherited Create(True);
|
||
FServer := AServer;
|
||
FreeOnTerminate := False;
|
||
end;
|
||
|
||
procedure TPushThread.Execute;
|
||
begin
|
||
FServer.PushLoop;
|
||
end;
|
||
|
||
constructor TClientThread.Create(AServer: TWebServer; AClient: TWsClient);
|
||
begin
|
||
inherited Create(True);
|
||
FServer := AServer;
|
||
FClient := AClient;
|
||
FreeOnTerminate := True;
|
||
end;
|
||
|
||
procedure TClientThread.Execute;
|
||
begin
|
||
FServer.HandleClient(FClient);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
TWebServer — конструктор / деструктор
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
constructor TWebServer.Create(const Username, Password: string;
|
||
Port: Word; const BindIP: string);
|
||
{$IFDEF WINDOWS}
|
||
var
|
||
WSAData: TWSAData;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF WINDOWS}
|
||
// Инициализация Winsock2 — обязательна перед любыми вызовами socket API
|
||
WSAStartup($0202, WSAData);
|
||
{$ENDIF}
|
||
inherited Create;
|
||
FAuthToken := Base64EncodeStr(Username + ':' + Password);
|
||
FPort := Port;
|
||
FBindIP := BindIP;
|
||
FListenSock := SOCK_INVALID;
|
||
FRunning := False;
|
||
FClientCount := 0;
|
||
FOpusReady := False;
|
||
FOpusBufPos := 0;
|
||
FWebClientActive := False;
|
||
FClientLock := TCriticalSection.Create;
|
||
FStateLock := TCriticalSection.Create;
|
||
// Начальные значения состояния
|
||
FFreq := 14200000;
|
||
FMode := 1;
|
||
FFMStepIdx := 3; // 25 kHz default
|
||
FFilterBW:= 2700;
|
||
FAGCMode := 1;
|
||
FAGCTop := 90;
|
||
FSpanHz := 192000;
|
||
FVolume := 70;
|
||
FSMeter := -120;
|
||
FFwdW := 0;
|
||
FSWR := 1.0;
|
||
FPAMaxPower := 100.0;
|
||
FBandIdx := 5;
|
||
FCurrentXvtr := -1;
|
||
FFreqMhzDigits := 3;
|
||
SetLength(FXvtrBands, 0);
|
||
end;
|
||
|
||
procedure TWebServer.SetXvtrBands(const ABands: TWebXvtrArray; ACurrent: Integer);
|
||
var i: Integer;
|
||
begin
|
||
FStateLock.Enter;
|
||
try
|
||
SetLength(FXvtrBands, Length(ABands));
|
||
for i := 0 to High(ABands) do
|
||
FXvtrBands[i] := ABands[i];
|
||
FCurrentXvtr := ACurrent;
|
||
finally
|
||
FStateLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
destructor TWebServer.Destroy;
|
||
begin
|
||
Stop;
|
||
FClientLock.Free;
|
||
FStateLock.Free;
|
||
inherited;
|
||
{$IFDEF WINDOWS}
|
||
// Освобождение ресурсов Winsock2
|
||
WSACleanup;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Загрузка / выгрузка Opus
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TWebServer.LoadOpus: Boolean;
|
||
const
|
||
{$IFDEF WINDOWS} LIBNAME = 'libopus-0.dll';
|
||
{$ELSE} LIBNAME = 'libopus.so.0';
|
||
{$ENDIF}
|
||
var Err: Integer;
|
||
begin
|
||
Result := False;
|
||
FOpusLib := LoadLibrary(LIBNAME);
|
||
if FOpusLib = 0 then Exit;
|
||
|
||
FOpusCreate := TOpus_encoder_create( GetProcAddress(FOpusLib, 'opus_encoder_create'));
|
||
FOpusDestroy := TOpus_encoder_destroy(GetProcAddress(FOpusLib, 'opus_encoder_destroy'));
|
||
FOpusEncode := TOpus_encode_float( GetProcAddress(FOpusLib, 'opus_encode_float'));
|
||
FOpusCtl := TOpus_encoder_ctl_set(GetProcAddress(FOpusLib, 'opus_encoder_ctl'));
|
||
FOpusDecCreate := TOpus_decoder_create( GetProcAddress(FOpusLib, 'opus_decoder_create'));
|
||
FOpusDecDecode := TOpus_decode_float( GetProcAddress(FOpusLib, 'opus_decode_float'));
|
||
FOpusDecDestroy := TOpus_decoder_destroy(GetProcAddress(FOpusLib, 'opus_decoder_destroy'));
|
||
|
||
if not Assigned(FOpusCreate) or not Assigned(FOpusEncode) then
|
||
begin
|
||
FreeLibrary(FOpusLib); FOpusLib := 0; Exit;
|
||
end;
|
||
|
||
FOpusEnc := FOpusCreate(OPUS_SAMPLE_RATE, OPUS_CHANNELS,
|
||
2049 {OPUS_APPLICATION_AUDIO}, @Err);
|
||
if (FOpusEnc = nil) or (Err <> 0) then
|
||
begin
|
||
FreeLibrary(FOpusLib); FOpusLib := 0; Exit;
|
||
end;
|
||
// OPUS_SET_BITRATE_REQUEST = 4002
|
||
if Assigned(FOpusCtl) then
|
||
FOpusCtl(FOpusEnc, 4002, OPUS_BITRATE);
|
||
|
||
// Декодер для TX mic (браузер → Opus → WDSP)
|
||
if Assigned(FOpusDecCreate) then
|
||
begin
|
||
Err := 0;
|
||
FOpusDec := FOpusDecCreate(OPUS_SAMPLE_RATE, OPUS_CHANNELS, @Err);
|
||
if Err <> 0 then FOpusDec := nil;
|
||
end;
|
||
|
||
FOpusBufPos := 0;
|
||
FOpusReady := True;
|
||
Result := True;
|
||
end;
|
||
|
||
procedure TWebServer.FlushMicToCallback(P: PSingle; N: Integer);
|
||
// Аккумулирует сэмплы в FMicStageBuf и вызывает FOnWebMic ровно когда
|
||
// накопился полный DSP-блок (512 сэмплов). Неполный остаток хранится
|
||
// в буфере до следующего вызова.
|
||
//
|
||
// Почему 512: TX DSP поток читает из FTXMicRing блоками по FAudioBufSize=512.
|
||
// Если ring содержит 0 < Avail < 512, поток пропускает тик → DUC underflow.
|
||
// Staging гарантирует что ring всегда получает данные кратными 512.
|
||
var
|
||
Src: PSingle;
|
||
Fill: Integer;
|
||
begin
|
||
if not Assigned(FOnWebMic) or (N <= 0) then Exit;
|
||
Src := P;
|
||
while N > 0 do
|
||
begin
|
||
// Докладываем в stage сколько нужно до полного блока (или сколько есть)
|
||
Fill := Min(N, 512 - FMicStageLen);
|
||
Move(Src^, FMicStageBuf[FMicStageLen], Fill * SizeOf(Single));
|
||
Inc(FMicStageLen, Fill);
|
||
Inc(Src, Fill);
|
||
Dec(N, Fill);
|
||
|
||
// Полный блок готов — передаём в DSP-цепь и сбрасываем stage
|
||
if FMicStageLen = 512 then
|
||
begin
|
||
FOnWebMic(@FMicStageBuf[0], 512);
|
||
FMicStageLen := 0;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TWebServer.PushMicSamples(P: PSingle; N: Integer);
|
||
// Прокладка между Opus-декодером и FlushMicToCallback с pre-roll cushion.
|
||
// Первые MIC_PREROLL_SAMP сэмплов TX-сессии копим в FMicPreRoll и сливаем
|
||
// одним блоком — это даёт FTXMicRing запас глубины ~40мс на джиттер.
|
||
// После pre-roll все сэмплы уходят через FlushMicToCallback, которая
|
||
// выравнивает поток по границе 512 сэмплов.
|
||
var
|
||
Want, Remainder: Integer;
|
||
P2: PSingle;
|
||
begin
|
||
if not Assigned(FOnWebMic) or (N <= 0) then Exit;
|
||
if FMicPreRollPos < MIC_PREROLL_SAMP then
|
||
begin
|
||
Want := MIC_PREROLL_SAMP - FMicPreRollPos;
|
||
if N <= Want then
|
||
begin
|
||
// Pre-roll ещё не набран: просто копим
|
||
Move(P^, FMicPreRoll[FMicPreRollPos], N * SizeOf(Single));
|
||
Inc(FMicPreRollPos, N);
|
||
end
|
||
else
|
||
begin
|
||
// Pre-roll заполнен: сливаем накопленный буфер + остаток пакета
|
||
Move(P^, FMicPreRoll[FMicPreRollPos], Want * SizeOf(Single));
|
||
FMicPreRollPos := MIC_PREROLL_SAMP;
|
||
FlushMicToCallback(@FMicPreRoll[0], MIC_PREROLL_SAMP);
|
||
Remainder := N - Want;
|
||
P2 := P;
|
||
Inc(P2, Want);
|
||
FlushMicToCallback(P2, Remainder);
|
||
end;
|
||
end
|
||
else
|
||
FlushMicToCallback(P, N);
|
||
end;
|
||
|
||
procedure TWebServer.UnloadOpus;
|
||
begin
|
||
if FOpusReady and Assigned(FOpusDestroy) and (FOpusEnc <> nil) then
|
||
FOpusDestroy(FOpusEnc);
|
||
FOpusEnc := nil;
|
||
if Assigned(FOpusDec) and Assigned(FOpusDecDestroy) then
|
||
FOpusDecDestroy(FOpusDec);
|
||
FOpusDec := nil;
|
||
FOpusReady := False;
|
||
if FOpusLib <> 0 then
|
||
begin
|
||
FreeLibrary(FOpusLib);
|
||
FOpusLib := 0;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Start / Stop
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function ParseIPv4(const S: string): LongWord;
|
||
// Парсит dotted-decimal '1.2.3.4', возвращает сетевой порядок байт.
|
||
// '0.0.0.0' и '' → INADDR_ANY (0).
|
||
var
|
||
P, Start: PChar;
|
||
Parts: array[0..3] of Byte;
|
||
Idx, V: Integer;
|
||
begin
|
||
Result := 0;
|
||
if (S = '') or (S = '0.0.0.0') then Exit;
|
||
Idx := 0;
|
||
P := PChar(S);
|
||
Start := P;
|
||
while True do
|
||
begin
|
||
if (P^ = '.') or (P^ = #0) then
|
||
begin
|
||
if Idx > 3 then Exit;
|
||
V := StrToIntDef(Copy(S, Start - PChar(S) + 1, P - Start), -1);
|
||
if (V < 0) or (V > 255) then Exit;
|
||
Parts[Idx] := Byte(V);
|
||
Inc(Idx);
|
||
if P^ = #0 then Break;
|
||
Inc(P);
|
||
Start := P;
|
||
end else
|
||
Inc(P);
|
||
end;
|
||
if Idx <> 4 then Exit;
|
||
// Сетевой порядок: старший байт первый
|
||
Result := (LongWord(Parts[0]) shl 24) or (LongWord(Parts[1]) shl 16)
|
||
or (LongWord(Parts[2]) shl 8) or LongWord(Parts[3]);
|
||
Result := htonl(Result);
|
||
end;
|
||
|
||
function TWebServer.InitListen: Boolean;
|
||
var
|
||
Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
|
||
One: Integer;
|
||
begin
|
||
Result := False;
|
||
{$IFDEF WINDOWS}
|
||
FListenSock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||
{$ELSE}
|
||
FListenSock := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||
{$ENDIF}
|
||
if FListenSock = SOCK_INVALID then Exit;
|
||
|
||
One := 1;
|
||
{$IFDEF WINDOWS}
|
||
setsockopt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One));
|
||
FillChar(Addr, SizeOf(Addr), 0);
|
||
Addr.sin_family := AF_INET;
|
||
Addr.sin_port := htons(FPort);
|
||
Addr.sin_addr.S_addr := ParseIPv4(FBindIP);
|
||
if bind(FListenSock, @Addr, SizeOf(Addr)) = SOCKET_ERROR then Exit;
|
||
if listen(FListenSock, 5) = SOCKET_ERROR then Exit;
|
||
{$ELSE}
|
||
fpSetSockOpt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One));
|
||
FillChar(Addr, SizeOf(Addr), 0);
|
||
Addr.sin_family := AF_INET;
|
||
Addr.sin_port := htons(FPort);
|
||
Addr.sin_addr.s_addr := ParseIPv4(FBindIP);
|
||
if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then Exit;
|
||
if fpListen(FListenSock, 5) <> 0 then Exit;
|
||
{$ENDIF}
|
||
Result := True;
|
||
end;
|
||
|
||
function TWebServer.Start: Boolean;
|
||
begin
|
||
Result := False;
|
||
if FRunning then Exit;
|
||
if not LoadOpus then ; // Opus опционален — продолжаем без него
|
||
if not InitListen then Exit;
|
||
FRunning := True;
|
||
FAcceptThread := TAcceptThread.Create(Self);
|
||
TAcceptThread(FAcceptThread).Start;
|
||
FPushThread := TPushThread.Create(Self);
|
||
TPushThread(FPushThread).Start;
|
||
Result := True;
|
||
end;
|
||
|
||
procedure TWebServer.Stop;
|
||
var i: Integer;
|
||
begin
|
||
if not FRunning then Exit;
|
||
FRunning := False;
|
||
|
||
// ── Шаг 1: shutdown + close listen-сокета ────────────────────────────────
|
||
// SockShutdown ОБЯЗАТЕЛЕН перед SockClose на Linux: закрытие дескриптора
|
||
// не прерывает fpAccept в AcceptThread — только shutdown разблокирует его.
|
||
// На Windows это тоже корректно (SD_BOTH).
|
||
if FListenSock <> SOCK_INVALID then
|
||
begin
|
||
SockShutdown(FListenSock);
|
||
SockClose(FListenSock);
|
||
FListenSock := SOCK_INVALID;
|
||
end;
|
||
|
||
// ── Шаг 2: shutdown всех клиентских сокетов ──────────────────────────────
|
||
// Разблокирует все HandleClient, заблокированные в Client.Recv (fpRecv).
|
||
// FreeOnTerminate=True у TClientThread — они освободятся сами после выхода.
|
||
FClientLock.Enter;
|
||
try
|
||
for i := 0 to FClientCount - 1 do
|
||
if FClients[i] <> nil then
|
||
begin
|
||
FClients[i].State := wsClosed;
|
||
SockShutdown(FClients[i].Socket); // ← разблокирует fpRecv в клиентском потоке
|
||
end;
|
||
finally
|
||
FClientLock.Leave;
|
||
end;
|
||
|
||
// ── Шаг 3: ждём завершения фоновых потоков ───────────────────────────────
|
||
// После shutdown потоки получат ошибку из recv/accept и выйдут сами.
|
||
if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end;
|
||
if FPushThread <> nil then begin FPushThread.WaitFor; FreeAndNil(FPushThread); end;
|
||
|
||
// ── Шаг 4: освобождаем клиентов ──────────────────────────────────────────
|
||
FClientLock.Enter;
|
||
try
|
||
for i := 0 to FClientCount - 1 do FreeAndNil(FClients[i]);
|
||
FClientCount := 0;
|
||
finally
|
||
FClientLock.Leave;
|
||
end;
|
||
|
||
UnloadOpus;
|
||
end;
|
||
|
||
procedure TWebServer.Reconfigure(const Username, Password, BindIP: string; Port: Word);
|
||
begin
|
||
Stop;
|
||
FAuthToken := Base64EncodeStr(Username + ':' + Password);
|
||
FPort := Port;
|
||
FBindIP := BindIP;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Accept loop
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TWebServer.AcceptLoop;
|
||
var
|
||
CSock: TSocket;
|
||
Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
|
||
ALen: {$IFDEF WINDOWS}Integer{$ELSE}TSockLen{$ENDIF};
|
||
Client: TWsClient;
|
||
T: TClientThread;
|
||
begin
|
||
while FRunning do
|
||
begin
|
||
ALen := SizeOf(Addr);
|
||
{$IFDEF WINDOWS}
|
||
CSock := accept(FListenSock, @Addr, @ALen);
|
||
{$ELSE}
|
||
CSock := fpAccept(FListenSock, @Addr, @ALen);
|
||
{$ENDIF}
|
||
if CSock = SOCK_INVALID then
|
||
begin
|
||
if FRunning then Sleep(10);
|
||
Continue;
|
||
end;
|
||
if FClientCount >= MAX_WS_CLIENTS then
|
||
begin
|
||
SockClose(CSock);
|
||
Continue;
|
||
end;
|
||
// 1 секунда на отправку: если TCP-буфер клиента переполнен, SockSend
|
||
// вернёт ошибку вместо того чтобы висеть и держать FClientLock вечно.
|
||
SockSetSndTimeout(CSock, 1000);
|
||
Client := TWsClient.Create(CSock);
|
||
FClientLock.Enter;
|
||
try
|
||
FClients[FClientCount] := Client;
|
||
Inc(FClientCount);
|
||
finally
|
||
FClientLock.Leave;
|
||
end;
|
||
T := TClientThread.Create(Self, Client);
|
||
T.Start;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
HTTP / WebSocket обработчик клиента
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TWebServer.CheckAuth(const Header: string): Boolean;
|
||
var
|
||
Pos_: Integer;
|
||
Token, HeaderLC: string;
|
||
begin
|
||
Result := False;
|
||
HeaderLC := LowerCase(Header);
|
||
Pos_ := System.Pos('authorization: basic ', HeaderLC);
|
||
if Pos_ = 0 then Exit;
|
||
Token := Copy(Header, Pos_ + 21, 200);
|
||
Pos_ := System.Pos(#13, Token); if Pos_ > 0 then Token := Copy(Token, 1, Pos_ - 1);
|
||
Pos_ := System.Pos(#10, Token); if Pos_ > 0 then Token := Copy(Token, 1, Pos_ - 1);
|
||
Token := Trim(Token);
|
||
Result := (Token = FAuthToken);
|
||
end;
|
||
|
||
procedure TWebServer.SendHttp(Client: TWsClient; Code: Integer;
|
||
const ContentType, Body: string);
|
||
var
|
||
StatusText, Response: string;
|
||
begin
|
||
case Code of
|
||
200: StatusText := 'OK';
|
||
401: StatusText := 'Unauthorized';
|
||
404: StatusText := 'Not Found';
|
||
else StatusText := 'Error';
|
||
end;
|
||
Response := Format('HTTP/1.1 %d %s'#13#10 +
|
||
'Content-Type: %s'#13#10 +
|
||
'Content-Length: %d'#13#10 +
|
||
'Connection: close'#13#10 +
|
||
#13#10 + '%s', [Code, StatusText, ContentType, Length(Body), Body]);
|
||
Client.SendRaw(Response[1], Length(Response));
|
||
end;
|
||
|
||
procedure TWebServer.HandleClient(Client: TWsClient);
|
||
var
|
||
R, HeaderEnd: Integer;
|
||
Header, HeaderLC, Key, Path, AcceptKey: string;
|
||
Response: string;
|
||
WsHandled: Boolean;
|
||
IsWsRequest: Boolean;
|
||
// WS frame parsing
|
||
B0, B1: Byte;
|
||
Masked: Boolean;
|
||
PayLen: Integer;
|
||
Mask: array[0..3] of Byte;
|
||
Payload: array of Byte;
|
||
Opcode: Byte;
|
||
i, Need: Integer;
|
||
j: Integer;
|
||
P1, P2: Integer;
|
||
KPos, KEnd: Integer;
|
||
Consumed: Integer;
|
||
Raw: array[0..8191] of Byte;
|
||
RawLen: Integer;
|
||
PcmBuf: array[0..5759] of Single; // 120ms max @ 48kHz (для RX TX-mic)
|
||
Decoded: Integer;
|
||
NowTick: QWord;
|
||
MissedFrames: Integer;
|
||
PlcDecoded: Integer;
|
||
k: Integer;
|
||
begin
|
||
WsHandled := False;
|
||
RawLen := 0;
|
||
|
||
// ── Фаза 1: чтение HTTP-запроса ──────────────────────────────────────────
|
||
Header := '';
|
||
repeat
|
||
R := SockRecv(Client.Socket, @Raw[RawLen], SizeOf(Raw) - RawLen, 0);
|
||
if R <= 0 then begin Client.State := wsClosed; Break; end;
|
||
Inc(RawLen, R);
|
||
SetLength(Header, RawLen);
|
||
Move(Raw[0], Header[1], RawLen);
|
||
HeaderEnd := System.Pos(#13#10#13#10, Header);
|
||
until (HeaderEnd > 0) or (RawLen >= SizeOf(Raw));
|
||
|
||
if (Client.State = wsClosed) or (HeaderEnd = 0) then
|
||
begin
|
||
RemoveClient(Client); Exit;
|
||
end;
|
||
|
||
Header := Copy(Header, 1, HeaderEnd + 3);
|
||
HeaderLC := LowerCase(Header);
|
||
|
||
// Извлечь путь
|
||
Path := '';
|
||
if System.Pos('GET /', Header) > 0 then
|
||
begin
|
||
P1 := System.Pos('GET ', Header) + 4;
|
||
P2 := System.Pos(' HTTP', Header);
|
||
if P2 > P1 then Path := Copy(Header, P1, P2 - P1);
|
||
end;
|
||
|
||
IsWsRequest := (Path = '/ws') and (System.Pos('upgrade: websocket', HeaderLC) > 0);
|
||
|
||
// Basic Auth (только для HTTP-страниц; WS handshake без авторизации)
|
||
if (not IsWsRequest) and (not CheckAuth(Header)) then
|
||
begin
|
||
Response := 'HTTP/1.1 401 Unauthorized'#13#10 +
|
||
'WWW-Authenticate: Basic realm="HPSDR"'#13#10 +
|
||
'Content-Length: 0'#13#10 +
|
||
'Connection: close'#13#10#13#10;
|
||
Client.SendRaw(Response[1], Length(Response));
|
||
RemoveClient(Client); Exit;
|
||
end;
|
||
|
||
// WebSocket upgrade
|
||
if System.Pos('upgrade: websocket', HeaderLC) > 0 then
|
||
begin
|
||
KPos := System.Pos('sec-websocket-key: ', HeaderLC);
|
||
if KPos > 0 then
|
||
begin
|
||
Key := Copy(Header, KPos + 19, 100);
|
||
KEnd := System.Pos(#13, Key);
|
||
if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1);
|
||
Key := Trim(Key);
|
||
end;
|
||
AcceptKey := Base64EncodeBytes(SHA1(Key + WS_GUID), 20);
|
||
Response := 'HTTP/1.1 101 Switching Protocols'#13#10 +
|
||
'Upgrade: websocket'#13#10 +
|
||
'Connection: Upgrade'#13#10 +
|
||
'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10;
|
||
Client.SendRaw(Response[1], Length(Response));
|
||
Client.State := wsOpen;
|
||
|
||
FStateLock.Enter;
|
||
FWebClientActive := True;
|
||
FStateLock.Leave;
|
||
|
||
Client.SendText(BuildStateJson);
|
||
WsHandled := True;
|
||
end
|
||
else if Path = '/' then
|
||
begin
|
||
SendHttp(Client, 200, 'text/html; charset=utf-8', GetIndexHtml);
|
||
RemoveClient(Client); Exit;
|
||
end
|
||
else
|
||
begin
|
||
SendHttp(Client, 404, 'text/plain', 'Not Found');
|
||
RemoveClient(Client); Exit;
|
||
end;
|
||
|
||
if not WsHandled then begin RemoveClient(Client); Exit; end;
|
||
|
||
// ── Фаза 2: цикл WebSocket-сообщений ─────────────────────────────────────
|
||
Client.BufLen := 0;
|
||
while FRunning and (Client.State = wsOpen) do
|
||
begin
|
||
R := Client.Recv;
|
||
if R <= 0 then Break;
|
||
|
||
while Client.BufLen >= 2 do
|
||
begin
|
||
B0 := Client.BufData[0];
|
||
B1 := Client.BufData[1];
|
||
Opcode := B0 and $0F;
|
||
Masked := (B1 and $80) <> 0;
|
||
PayLen := B1 and $7F;
|
||
|
||
Need := 2;
|
||
if PayLen = 126 then Inc(Need, 2)
|
||
else if PayLen = 127 then Inc(Need, 8);
|
||
if Masked then Inc(Need, 4);
|
||
|
||
if Client.BufLen < Need then Break;
|
||
|
||
i := 2;
|
||
if PayLen = 126 then
|
||
begin
|
||
PayLen := (Client.BufData[2] shl 8) or Client.BufData[3];
|
||
Inc(i, 2);
|
||
end
|
||
else if PayLen = 127 then
|
||
begin
|
||
PayLen := (Client.BufData[6] shl 24) or (Client.BufData[7] shl 16) or
|
||
(Client.BufData[8] shl 8) or Client.BufData[9];
|
||
Inc(i, 8);
|
||
end;
|
||
|
||
if Client.BufLen < Need + PayLen then Break;
|
||
|
||
if Masked then
|
||
begin
|
||
Mask[0] := Client.BufData[i]; Mask[1] := Client.BufData[i+1];
|
||
Mask[2] := Client.BufData[i+2]; Mask[3] := Client.BufData[i+3];
|
||
Inc(i, 4);
|
||
end;
|
||
|
||
SetLength(Payload, PayLen);
|
||
if PayLen > 0 then
|
||
begin
|
||
Move(Client.BufData[i], Payload[0], PayLen);
|
||
if Masked then
|
||
for j := 0 to PayLen - 1 do
|
||
Payload[j] := Payload[j] xor Mask[j and 3];
|
||
end;
|
||
|
||
Consumed := i + PayLen;
|
||
if Client.BufLen > Consumed then
|
||
Move(Client.BufData[Consumed], Client.BufData[0], Client.BufLen - Consumed);
|
||
Client.BufLen := Client.BufLen - Consumed;
|
||
|
||
case Opcode of
|
||
$01: // Text → команда
|
||
begin
|
||
SetLength(Header, PayLen);
|
||
if PayLen > 0 then Move(Payload[0], Header[1], PayLen);
|
||
ProcessCommand(Client, Header);
|
||
end;
|
||
$02: // Binary — TX mic Opus frame: byte 'M' + raw Opus packet
|
||
begin
|
||
if (PayLen > 1) and (Payload[0] = Ord('M')) and
|
||
Assigned(FOpusDec) and Assigned(FOpusDecDecode) and
|
||
Assigned(FOnWebMic) then
|
||
begin
|
||
NowTick := GetTickCount64;
|
||
if (FMicLastTick = 0) or ((NowTick - FMicLastTick) > MIC_IDLE_MS) then
|
||
begin
|
||
// Новая TX-сессия (первый пакет или длинный простой):
|
||
// сбрасываем pre-roll и staging, PLC не применяем —
|
||
// нет состояния для предсказания.
|
||
FMicPreRollPos := 0;
|
||
FMicStageLen := 0;
|
||
end
|
||
else
|
||
begin
|
||
// PLC для опоздавших/потерянных кадров по wall-clock.
|
||
// expected_packets ≈ elapsed_ms / 20ms; out of them один — текущий,
|
||
// остальные считаем "потерянными" и синтезируем Opus PLC.
|
||
MissedFrames := Integer((NowTick - FMicLastTick) div OPUS_FRAME_MS);
|
||
if MissedFrames > 0 then Dec(MissedFrames);
|
||
if MissedFrames > MIC_MAX_PLC then MissedFrames := MIC_MAX_PLC;
|
||
for k := 1 to MissedFrames do
|
||
begin
|
||
// opus_decode_float(dec, NULL, 0, pcm, frame_size, 0) → PLC frame
|
||
PlcDecoded := FOpusDecDecode(FOpusDec, nil, 0,
|
||
@PcmBuf[0], OPUS_FRAME_SAMP, 0);
|
||
if PlcDecoded > 0 then PushMicSamples(@PcmBuf[0], PlcDecoded);
|
||
end;
|
||
end;
|
||
FMicLastTick := NowTick;
|
||
Decoded := FOpusDecDecode(FOpusDec, @Payload[1], PayLen - 1,
|
||
@PcmBuf[0], Length(PcmBuf), 0);
|
||
if Decoded > 0 then
|
||
PushMicSamples(@PcmBuf[0], Decoded);
|
||
end;
|
||
end;
|
||
$08: // Close
|
||
begin
|
||
Client.State := wsClosed;
|
||
Break;
|
||
end;
|
||
$09: // Ping → Pong
|
||
Client.SendWsFrame($0A, Payload[0], PayLen);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
FStateLock.Enter;
|
||
FWebClientActive := (FClientCount > 1);
|
||
FStateLock.Leave;
|
||
|
||
RemoveClient(Client);
|
||
end;
|
||
|
||
procedure TWebServer.RemoveClient(Client: TWsClient);
|
||
var i, j: Integer;
|
||
begin
|
||
FClientLock.Enter;
|
||
try
|
||
for i := 0 to FClientCount - 1 do
|
||
if FClients[i] = Client then
|
||
begin
|
||
FClients[i].Free;
|
||
for j := i to FClientCount - 2 do FClients[j] := FClients[j+1];
|
||
FClients[FClientCount-1] := nil;
|
||
Dec(FClientCount);
|
||
Break;
|
||
end;
|
||
FWebClientActive := False;
|
||
for i := 0 to FClientCount - 1 do
|
||
if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then
|
||
begin FWebClientActive := True; Break; end;
|
||
finally
|
||
FClientLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Обработка JSON-команд от браузера
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TWebServer.ProcessCommand(Client: TWsClient; const Json: string);
|
||
var
|
||
Cmd: string;
|
||
HzF: Double;
|
||
HzI, ModeValue, BW, DB, Idx, V: Integer;
|
||
On_: Boolean;
|
||
begin
|
||
Cmd := JsonGetStr(Json, 'cmd');
|
||
|
||
if Cmd = 'freq' then
|
||
begin
|
||
HzF := JsonGetFloat(Json, 'hz', FFreq);
|
||
FStateLock.Enter; FFreq := HzF; FStateLock.Leave;
|
||
if Assigned(FOnFreq) then FOnFreq(HzF);
|
||
end
|
||
else if Cmd = 'mode' then
|
||
begin
|
||
ModeValue := JsonGetInt(Json, 'mode', FMode);
|
||
FStateLock.Enter; FMode := ModeValue; FStateLock.Leave;
|
||
if Assigned(FOnMode) then FOnMode(ModeValue);
|
||
end
|
||
else if Cmd = 'filter' then
|
||
begin
|
||
BW := JsonGetInt(Json, 'bw', FFilterBW);
|
||
FStateLock.Enter; FFilterBW := BW; FStateLock.Leave;
|
||
if Assigned(FOnFilter) then FOnFilter(BW);
|
||
end
|
||
else if Cmd = 'agc' then
|
||
begin
|
||
ModeValue := JsonGetInt(Json, 'mode', FAGCMode);
|
||
FStateLock.Enter; FAGCMode := ModeValue; FStateLock.Leave;
|
||
if Assigned(FOnAGC) then FOnAGC(ModeValue);
|
||
end
|
||
else if Cmd = 'agctop' then
|
||
begin
|
||
DB := JsonGetInt(Json, 'db', FAGCTop);
|
||
FStateLock.Enter; FAGCTop := DB; FStateLock.Leave;
|
||
if Assigned(FOnAGCTop) then FOnAGCTop(DB);
|
||
end
|
||
else if Cmd = 'band' then
|
||
begin
|
||
Idx := JsonGetInt(Json, 'idx', FBandIdx);
|
||
FStateLock.Enter; FBandIdx := Idx; FStateLock.Leave;
|
||
if Assigned(FOnBand) then FOnBand(Idx);
|
||
end
|
||
else if Cmd = 'xvtr_band' then
|
||
begin
|
||
// Idx 0..CFG_XVTR_COUNT-1 — активировать XVTR; -1 — выйти в HF
|
||
Idx := JsonGetInt(Json, 'idx', -1);
|
||
if Assigned(FOnXvtrBand) then FOnXvtrBand(Idx);
|
||
end
|
||
else if Cmd = 'span' then
|
||
begin
|
||
HzI := JsonGetInt(Json, 'hz', Round(FSpanHz));
|
||
FStateLock.Enter; FSpanHz := HzI; FStateLock.Leave;
|
||
if Assigned(FOnSpan) then FOnSpan(HzI);
|
||
end
|
||
else if Cmd = 'volume' then
|
||
begin
|
||
V := JsonGetInt(Json, 'v', FVolume);
|
||
FStateLock.Enter; FVolume := V; FStateLock.Leave;
|
||
if Assigned(FOnVolume) then FOnVolume(V);
|
||
end
|
||
else if Cmd = 'wfagc' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FWfAGC);
|
||
FStateLock.Enter; FWfAGC := On_; FStateLock.Leave;
|
||
if Assigned(FOnWfAGC) then FOnWfAGC(On_);
|
||
end
|
||
else if Cmd = 'wfnf' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FWfNF);
|
||
FStateLock.Enter; FWfNF := On_; FStateLock.Leave;
|
||
if Assigned(FOnWfNF) then FOnWfNF(On_);
|
||
end
|
||
else if Cmd = 'set_run' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FTrxRunning);
|
||
FStateLock.Enter; FTrxRunning := On_; FStateLock.Leave;
|
||
if Assigned(FOnRun) then FOnRun(On_);
|
||
end
|
||
else if Cmd = 'set_mute' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FMuted);
|
||
FStateLock.Enter; FMuted := On_; FStateLock.Leave;
|
||
if Assigned(FOnMute) then FOnMute(On_);
|
||
end
|
||
else if Cmd = 'set_ctun' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FCtun);
|
||
FStateLock.Enter; FCtun := On_; FStateLock.Leave;
|
||
if Assigned(FOnCtun) then FOnCtun(On_);
|
||
end
|
||
else if Cmd = 'set_nr' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FNRMode <> 0);
|
||
ModeValue := Ord(On_);
|
||
FStateLock.Enter; FNRMode := ModeValue; FStateLock.Leave;
|
||
if Assigned(FOnNR) then FOnNR(ModeValue);
|
||
end
|
||
else if Cmd = 'set_nr_mode' then
|
||
begin
|
||
ModeValue := JsonGetInt(Json, 'mode', FNRMode);
|
||
if ModeValue < 0 then ModeValue := 0;
|
||
if ModeValue > 4 then ModeValue := 4;
|
||
FStateLock.Enter; FNRMode := ModeValue; FStateLock.Leave;
|
||
if Assigned(FOnNR) then FOnNR(ModeValue);
|
||
end
|
||
else if Cmd = 'set_nb' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FNBMode <> 0);
|
||
ModeValue := Ord(On_);
|
||
FStateLock.Enter; FNBMode := ModeValue; FStateLock.Leave;
|
||
if Assigned(FOnNB) then FOnNB(ModeValue);
|
||
end
|
||
else if Cmd = 'set_nb_mode' then
|
||
begin
|
||
ModeValue := JsonGetInt(Json, 'mode', FNBMode);
|
||
if ModeValue < 0 then ModeValue := 0;
|
||
if ModeValue > 2 then ModeValue := 2;
|
||
FStateLock.Enter; FNBMode := ModeValue; FStateLock.Leave;
|
||
if Assigned(FOnNB) then FOnNB(ModeValue);
|
||
end
|
||
else if Cmd = 'set_snb' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FSNB);
|
||
FStateLock.Enter; FSNB := On_; FStateLock.Leave;
|
||
if Assigned(FOnSNB) then FOnSNB(On_);
|
||
end
|
||
else if Cmd = 'set_anf' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FANF);
|
||
FStateLock.Enter; FANF := On_; FStateLock.Leave;
|
||
if Assigned(FOnANF) then FOnANF(On_);
|
||
end
|
||
else if Cmd = 'freq_b' then
|
||
begin
|
||
HzF := JsonGetFloat(Json, 'hz', FVfoB);
|
||
FStateLock.Enter; FVfoB := HzF; FStateLock.Leave;
|
||
if Assigned(FOnFreqB) then FOnFreqB(HzF);
|
||
end
|
||
else if Cmd = 'set_active_vfo' then
|
||
begin
|
||
ModeValue := JsonGetInt(Json, 'idx', FActiveVfo);
|
||
if ModeValue < 0 then ModeValue := 0;
|
||
if ModeValue > 1 then ModeValue := 1;
|
||
FStateLock.Enter; FActiveVfo := ModeValue; FStateLock.Leave;
|
||
if Assigned(FOnActiveVfo) then FOnActiveVfo(ModeValue);
|
||
end
|
||
else if Cmd = 'set_center' then
|
||
begin
|
||
HzF := JsonGetFloat(Json, 'hz', FCenterHz);
|
||
FStateLock.Enter; FCenterHz := HzF; FStateLock.Leave;
|
||
if Assigned(FOnCenter) then FOnCenter(HzF);
|
||
end
|
||
else if Cmd = 'set_mox' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FTransmitting);
|
||
FStateLock.Enter; FTransmitting := On_; FStateLock.Leave;
|
||
if Assigned(FOnMOX) then FOnMOX(On_);
|
||
end
|
||
else if Cmd = 'drive' then
|
||
begin
|
||
V := JsonGetInt(Json, 'v', FDriveLevel);
|
||
if V < 0 then V := 0;
|
||
if V > 100 then V := 100;
|
||
FStateLock.Enter; FDriveLevel := V; FStateLock.Leave;
|
||
if Assigned(FOnDrive) then FOnDrive(V);
|
||
end
|
||
else if Cmd = 'set_tun' then
|
||
begin
|
||
On_ := JsonGetBool(Json, 'on', FTuning);
|
||
FStateLock.Enter; FTuning := On_; FStateLock.Leave;
|
||
if Assigned(FOnTun) then FOnTun(On_);
|
||
end
|
||
else if Cmd = 'freq_a' then
|
||
begin
|
||
HzF := JsonGetFloat(Json, 'hz', FFreq);
|
||
FStateLock.Enter; FFreq := HzF; FStateLock.Leave;
|
||
if Assigned(FOnFreqA) then FOnFreqA(HzF);
|
||
end
|
||
else if Cmd = 'attn' then
|
||
begin
|
||
Idx := JsonGetInt(Json, 'idx', FAttnIdx);
|
||
if Idx < 0 then Idx := 0;
|
||
if Idx > 2 then Idx := 2;
|
||
FStateLock.Enter; FAttnIdx := Idx; FStateLock.Leave;
|
||
if Assigned(FOnAttn) then FOnAttn(Idx);
|
||
end
|
||
else if Cmd = 'fm_step' then
|
||
begin
|
||
Idx := JsonGetInt(Json, 'idx', FFMStepIdx);
|
||
if Idx < 0 then Idx := 0;
|
||
if Idx > 3 then Idx := 3;
|
||
FStateLock.Enter; FFMStepIdx := Idx; FStateLock.Leave;
|
||
if Assigned(FOnFMStep) then FOnFMStep(Idx);
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Push-цикл — рассылает спектр / водопад / состояние всем клиентам
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TWebServer.PushLoop;
|
||
var
|
||
Tick, StateLastTick: QWord;
|
||
SpecBuf: array[0..4096] of Byte;
|
||
WfBuf: array[0..4096] of Byte;
|
||
i: Integer;
|
||
HasClients: Boolean;
|
||
begin
|
||
StateLastTick := GetTickCount64;
|
||
while FRunning do
|
||
begin
|
||
Sleep(50); // 20 fps
|
||
Tick := GetTickCount64;
|
||
|
||
FClientLock.Enter;
|
||
HasClients := FClientCount > 0;
|
||
FClientLock.Leave;
|
||
|
||
if not HasClients then Continue;
|
||
|
||
FStateLock.Enter;
|
||
try
|
||
SpecBuf[0] := WS_MSG_SPECTRUM;
|
||
for i := 0 to 1023 do
|
||
PSingle(Pointer(PByte(@SpecBuf[1]) + i*4))^ := FSpectrumBuf[i];
|
||
|
||
WfBuf[0] := WS_MSG_WATERFALL;
|
||
for i := 0 to 1023 do
|
||
PSingle(Pointer(PByte(@WfBuf[1]) + i*4))^ := FWfBuf[i];
|
||
finally
|
||
FStateLock.Leave;
|
||
end;
|
||
|
||
BroadcastBinary(SpecBuf[0], 1 + 1024*4);
|
||
BroadcastBinary(WfBuf[0], 1 + 1024*4);
|
||
|
||
if Tick - StateLastTick >= 200 then
|
||
begin
|
||
StateLastTick := Tick;
|
||
BroadcastText(BuildStateJson);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TWebServer.BroadcastBinary(const Data; Len: Integer);
|
||
var i: Integer;
|
||
begin
|
||
FClientLock.Enter;
|
||
try
|
||
for i := 0 to FClientCount - 1 do
|
||
if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then
|
||
FClients[i].SendBinary(Data, Len);
|
||
finally
|
||
FClientLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
procedure TWebServer.BroadcastText(const S: string);
|
||
var i: Integer;
|
||
begin
|
||
FClientLock.Enter;
|
||
try
|
||
for i := 0 to FClientCount - 1 do
|
||
if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then
|
||
FClients[i].SendText(S);
|
||
finally
|
||
FClientLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Формирование JSON-состояния
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function TWebServer.BuildStateJson: string;
|
||
const
|
||
MODE_N: array[0..7] of string =
|
||
('LSB','USB','DSB','CWL','CWU','FM','AM','SAM');
|
||
var
|
||
FS: TFormatSettings;
|
||
XvtrJson: string;
|
||
i: Integer;
|
||
begin
|
||
FS := DefaultFormatSettings;
|
||
FS.DecimalSeparator := '.';
|
||
FStateLock.Enter;
|
||
try
|
||
// Сборка массива xvtr_bands: [{"idx":0,"name":"2m"},...]
|
||
XvtrJson := '[';
|
||
for i := 0 to High(FXvtrBands) do
|
||
begin
|
||
if i > 0 then XvtrJson := XvtrJson + ',';
|
||
XvtrJson := XvtrJson +
|
||
Format('{"idx":%d,"name":"%s"}',
|
||
[FXvtrBands[i].Idx, FXvtrBands[i].Name], FS);
|
||
end;
|
||
XvtrJson := XvtrJson + ']';
|
||
Result := Format(
|
||
'{"vfo_a_hz":%.0f,"vfo_b_hz":%.0f,"active_vfo":%d,' +
|
||
'"mode":%d,"mode_name":"%s",' +
|
||
'"filter":%d,"filter_bw":%d,' +
|
||
'"agc_mode":%d,"agc_top":%d,' +
|
||
'"span_hz":%.0f,"center_hz":%.0f,"volume":%d,' +
|
||
'"wf_agc":%s,"wf_nf":%s,"band_idx":%d,"smeter_dbm":%.1f,' +
|
||
'"running":%s,"mute":%s,"ctun":%s,' +
|
||
'"nr_mode":%d,"nr":%s,"nb_mode":%d,"nb":%s,"snb":%s,"anf":%s,"connected":%s,' +
|
||
'"transmitting":%s,"drive":%d,"attn_idx":%d,"tuning":%s,"dup":%s,' +
|
||
'"fwd_w":%.1f,"swr":%.2f,"pa_max_power":%.0f,' +
|
||
'"xvtr_current":%d,"xvtr_bands":%s,"freq_mhz_digits":%d,' +
|
||
'"fmstep_idx":%d}',
|
||
[FFreq, FVfoB, FActiveVfo,
|
||
FMode, MODE_N[FMode mod 8],
|
||
FFilterIdx, FFilterBW,
|
||
FAGCMode, FAGCTop,
|
||
FSpanHz, FCenterHz, FVolume,
|
||
BoolToStr(FWfAGC, 'true', 'false'),
|
||
BoolToStr(FWfNF, 'true', 'false'),
|
||
FBandIdx, FSMeter,
|
||
BoolToStr(FTrxRunning, 'true', 'false'),
|
||
BoolToStr(FMuted, 'true', 'false'),
|
||
BoolToStr(FCtun, 'true', 'false'),
|
||
FNRMode,
|
||
BoolToStr(FNRMode <> 0, 'true', 'false'),
|
||
FNBMode,
|
||
BoolToStr(FNBMode <> 0, 'true', 'false'),
|
||
BoolToStr(FSNB, 'true', 'false'),
|
||
BoolToStr(FANF, 'true', 'false'),
|
||
BoolToStr(FConnected, 'true', 'false'),
|
||
BoolToStr(FTransmitting, 'true', 'false'),
|
||
FDriveLevel,
|
||
FAttnIdx,
|
||
BoolToStr(FTuning, 'true', 'false'),
|
||
BoolToStr(FDuplex, 'true', 'false'),
|
||
FFwdW, FSWR, FPAMaxPower,
|
||
FCurrentXvtr, XvtrJson, FFreqMhzDigits,
|
||
FFMStepIdx
|
||
], FS);
|
||
finally
|
||
FStateLock.Leave;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Аудио push (вызывается из DSP-потока)
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TWebServer.PushAudio(const Samples: PSingle; Count: Integer);
|
||
var
|
||
HasWs: Boolean;
|
||
i, n, Enc: Integer;
|
||
begin
|
||
if not FRunning then Exit;
|
||
FClientLock.Enter;
|
||
HasWs := FClientCount > 0;
|
||
FClientLock.Leave;
|
||
if not HasWs then Exit;
|
||
if (Samples = nil) or (Count <= 0) then Exit;
|
||
if not FOpusReady then Exit;
|
||
|
||
i := 0;
|
||
while i < Count do
|
||
begin
|
||
n := Count - i;
|
||
if n > OPUS_FRAME_SAMP - FOpusBufPos then
|
||
n := OPUS_FRAME_SAMP - FOpusBufPos;
|
||
Move(Samples[i], FOpusBuf[FOpusBufPos], n * SizeOf(Single));
|
||
Inc(FOpusBufPos, n);
|
||
Inc(i, n);
|
||
if FOpusBufPos >= OPUS_FRAME_SAMP then
|
||
begin
|
||
Enc := FOpusEncode(FOpusEnc, @FOpusBuf[0], OPUS_FRAME_SAMP,
|
||
@FOpusOut[0], SizeOf(FOpusOut));
|
||
if Enc > 0 then
|
||
begin
|
||
FWsAudioBuf[0] := WS_MSG_AUDIO;
|
||
Move(FOpusOut[0], FWsAudioBuf[1], Enc);
|
||
BroadcastBinary(FWsAudioBuf[0], 1 + Enc);
|
||
end;
|
||
FOpusBufPos := 0;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Обновление состояния из MainForm (UI thread, из таймера спектра)
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TWebServer.PushSpectrum(
|
||
const Buf: array of Single; Count: Integer;
|
||
const WfBuf_: array of Single;
|
||
SMeter: Double;
|
||
Freq: Double; Mode, FilterBW, AGCMode, AGCTop: Integer;
|
||
SpanHz: Double; Volume: Integer;
|
||
WfAGC, WfNF: Boolean; BandIdx: Integer;
|
||
TrxConnected: Boolean;
|
||
TrxRunning, Muted, Ctun: Boolean;
|
||
NRMode, NBMode: Integer; SNB, ANF: Boolean;
|
||
CenterHz: Double; FilterIdx: Integer;
|
||
VfoB: Double; ActiveVfo: Integer;
|
||
Transmitting: Boolean; DriveLevel: Integer;
|
||
AttnIdx: Integer; Tuning: Boolean; Duplex: Boolean;
|
||
FwdW, SWRV, PAMaxPower: Double);
|
||
var N, i: Integer;
|
||
begin
|
||
if not FRunning then Exit;
|
||
N := Min(Count, 1024);
|
||
FStateLock.Enter;
|
||
try
|
||
for i := 0 to N-1 do FSpectrumBuf[i] := Buf[i];
|
||
for i := 0 to Min(High(WfBuf_), 1023) do FWfBuf[i] := WfBuf_[i];
|
||
FSMeter := SMeter;
|
||
FFreq := Freq;
|
||
FMode := Mode;
|
||
FFilterBW := FilterBW;
|
||
FAGCMode := AGCMode;
|
||
FAGCTop := AGCTop;
|
||
FSpanHz := SpanHz;
|
||
FVolume := Volume;
|
||
FWfAGC := WfAGC;
|
||
FWfNF := WfNF;
|
||
FBandIdx := BandIdx;
|
||
FConnected := TrxConnected;
|
||
FTrxRunning := TrxRunning;
|
||
FMuted := Muted;
|
||
FCtun := Ctun;
|
||
FNRMode := NRMode;
|
||
FNBMode := NBMode;
|
||
FSNB := SNB;
|
||
FANF := ANF;
|
||
FCenterHz := CenterHz;
|
||
FFilterIdx := FilterIdx;
|
||
FVfoB := VfoB;
|
||
FActiveVfo := ActiveVfo;
|
||
FTransmitting := Transmitting;
|
||
FDriveLevel := DriveLevel;
|
||
FAttnIdx := AttnIdx;
|
||
FTuning := Tuning;
|
||
FDuplex := Duplex;
|
||
FFwdW := FwdW;
|
||
FSWR := SWRV;
|
||
FPAMaxPower := PAMaxPower;
|
||
finally
|
||
FStateLock.Leave;
|
||
end;
|
||
end;
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
Stub-методы (реализация встроена в HandleClient)
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TWebServer.DoHandshake(Client: TWsClient);
|
||
begin
|
||
// Not used separately — handshake is in HandleClient
|
||
end;
|
||
|
||
procedure TWebServer.ProcessWsFrame(Client: TWsClient;
|
||
const Data: array of Byte; Len: Integer; Opcode: Byte);
|
||
begin
|
||
// Not used separately — frame processing is inlined in HandleClient
|
||
end;
|
||
|
||
end.
|