mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
ew8bakandClaude Sonnet 4.6
65545982e3
Pre-roll bug: when MIC_PREROLL_SAMP is an exact multiple of OPUS_FRAME_SAMP (1920/960=2), the N<=Want branch filled the buffer but never flushed it, losing the first 40ms of audio and leaving the ring empty long enough for silence blocks to be injected into WDSP. StallCount threshold raised from 2 to 4 (~43ms) to cover OS scheduler jitter of up to 22ms, preventing false silence injection when an Opus frame arrives slightly late relative to the DSP tick. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
1596 lines
61 KiB
ObjectPascal
1596 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
|
||
Move(P^, FMicPreRoll[FMicPreRollPos], N * SizeOf(Single));
|
||
Inc(FMicPreRollPos, N);
|
||
// N = Want точно заполняет pre-roll — надо слить (иначе буфер потерян)
|
||
if FMicPreRollPos = MIC_PREROLL_SAMP then
|
||
FlushMicToCallback(@FMicPreRoll[0], MIC_PREROLL_SAMP);
|
||
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.
|