This commit is contained in:
2026-03-05 16:19:26 +03:00
parent 02666e7d22
commit 7521a46bbc
24 changed files with 12693 additions and 33 deletions
+38 -32
View File
@@ -1,35 +1,3 @@
# ---> Lazarus
# Lazarus compiler-generated binaries (safe to delete)
*.exe
*.dll
*.so
*.dylib
*.lrs
*.res
*.compiled
*.dbg
*.ppu
*.o
*.or
*.a
# Lazarus autogenerated files (duplicated info)
*.rst
*.rsj
*.lrt
# Lazarus local files (user-specific info)
*.lps
# Lazarus backups and unit output folders.
# These can be changed by user in Lazarus/project options.
backup/
*.bak
lib/
# Application bundle for Mac OS
*.app/
# ---> Delphi
# Uncomment these types if you want even more clean repository. But be careful.
# It can make harm to an existing project source. Read explanations below.
@@ -101,3 +69,41 @@ __recovery/
# Boss dependency manager vendor folder https://github.com/HashLoad/boss
modules/
# ---> Lazarus
# Lazarus compiler-generated binaries (safe to delete)
*.exe
*.dll
*.so
*.dylib
*.lrs
*.res
*.compiled
*.dbg
*.ppu
*.o
*.or
*.a
# Lazarus autogenerated files (duplicated info)
*.rst
*.rsj
*.lrt
# Lazarus local files (user-specific info)
*.lps
# Lazarus backups and unit output folders.
# These can be changed by user in Lazarus/project options.
backup/
*.bak
lib/
# Application bundle for Mac OS
*.app/
wdspWisdom00
*.log
ewsdr
hpsdr_trx
webserver_debug.log
+444
View File
@@ -0,0 +1,444 @@
unit AudioOutput;
{
PortAudio output — реализация по образцу piHPSDR/portaudio.c (DL1YCF)
Ключевые особенности:
- Pa_Initialize вызывается один раз в Create (до открытия стрима)
- suggestedLatency = 0.0 (минимум устройства)
- Ring buffer из Double (как в оригинале)
- Callback читает по одному сэмплу, обновляет outpt внутри цикла
- Low water mark: вставляет тишину + полбуфера silence
- High water mark: удаляет лишние сэмплы
- MY_AUDIO_BUFFER_SIZE = 128 frames (низкая латентность)
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, SyncObjs, DynLibs;
const
MY_AUDIO_BUFFER_SIZE = 128; // PA frames per callback — как piHPSDR
MY_RING_BUFFER_SIZE = 9600; // как piHPSDR
MY_RING_LOW_WATER = 512; // как piHPSDR
MY_RING_HIGH_WATER = 9000; // как piHPSDR
type
TPaError = LongInt;
TPaDeviceIndex = LongInt;
TPaTime = Double;
TPaStream = Pointer;
PPaStream = ^TPaStream;
TPaStreamCallbackTimeInfo = record
inputBufferAdcTime: TPaTime;
currentTime: TPaTime;
outputBufferDacTime: TPaTime;
end;
TPaStreamParameters = record
device: TPaDeviceIndex;
channelCount: LongInt;
sampleFormat: LongWord;
suggestedLatency: TPaTime;
hostApiSpecificStreamInfo: Pointer;
end;
PPaStreamParameters = ^TPaStreamParameters;
TPaStreamCallback = function(inputBuffer, outputBuffer: Pointer;
framesPerBuffer: LongWord;
timeInfo: Pointer;
statusFlags: LongWord;
userData: Pointer): LongInt; cdecl;
TPa_Initialize = function: TPaError; cdecl;
TPa_Terminate = function: TPaError; cdecl;
TPa_GetDefaultOutputDevice = function: TPaDeviceIndex; cdecl;
TPa_GetDeviceInfo = function(device: TPaDeviceIndex): Pointer; cdecl;
TPa_OpenStream = function(stream: PPaStream;
inputParam: PPaStreamParameters;
outputParam: PPaStreamParameters;
sampleRate: Double;
framesPerBuffer: LongWord;
streamFlags: LongWord;
callback: TPaStreamCallback;
userData: Pointer): TPaError; cdecl;
TPa_StartStream = function(stream: TPaStream): TPaError; cdecl;
TPa_StopStream = function(stream: TPaStream): TPaError; cdecl;
TPa_CloseStream = function(stream: TPaStream): TPaError; cdecl;
TPa_GetErrorText = function(err: TPaError): PAnsiChar; cdecl;
{ TAudioOutput }
TAudioOutput = class
private
FLibHandle: TLibHandle;
FStream: TPaStream;
FSampleRate: Integer;
FOpen: Boolean;
FPAInited: Boolean; // Pa_Initialize прошла
FLastError: string;
// Ring buffer (interleaved double stereo, как в оригинале)
FBuf: array[0..MY_RING_BUFFER_SIZE * 2 - 1] of Double; // как piHPSDR
FInPt: Integer; // audio_buffer_inpt (write)
FOutPt: Integer; // audio_buffer_outpt (read)
FMutex: TCriticalSection;
// PortAudio functions
FPa_Initialize: TPa_Initialize;
FPa_Terminate: TPa_Terminate;
FPa_GetDefaultOutputDevice: TPa_GetDefaultOutputDevice;
FPa_OpenStream: TPa_OpenStream;
FPa_StartStream: TPa_StartStream;
FPa_StopStream: TPa_StopStream;
FPa_CloseStream: TPa_CloseStream;
FPa_GetErrorText: TPa_GetErrorText;
function LoadLib: Boolean;
function GetLastError: string;
public
constructor Create(SampleRate: Integer = 48000);
destructor Destroy; override;
function Open: Boolean;
procedure Close;
// Пишем стерео double сэмплы — как audio_write() в оригинале
procedure WriteDouble(Left, Right: Double);
// Convenience: массив Single
procedure Write(const Left, Right: array of Single; Count: Integer);
property IsOpen: Boolean read FOpen;
property LastError: string read GetLastError;
end;
// Глобальный callback (cdecl, не метод)
function PaOutCallback(inputBuffer, outputBuffer: Pointer;
framesPerBuffer: LongWord;
timeInfo: Pointer;
statusFlags: LongWord;
userData: Pointer): LongInt; cdecl;
implementation
const
{$IFDEF UNIX}
PA_LIBS: array[0..3] of AnsiString = (
'libportaudio.so.2',
'libportaudio.so',
'libportaudio.so.2.0.0',
'libportaudio.so.0'
);
{$ELSE}
PA_LIBS: array[0..1] of AnsiString = (
'portaudio_x64.dll',
'portaudio.dll'
);
{$ENDIF}
PA_NO_ERROR = 0;
PA_FLOAT32 = LongWord(1);
PA_NO_FLAG = LongWord(0);
PA_CONTINUE = LongInt(0);
PA_NO_DEV = TPaDeviceIndex(-1);
// ---------------------------------------------------------------------------
// Callback — точная копия pa_out_cb из оригинала
// ---------------------------------------------------------------------------
function PaOutCallback(inputBuffer, outputBuffer: Pointer;
framesPerBuffer: LongWord;
timeInfo: Pointer;
statusFlags: LongWord;
userData: Pointer): LongInt; cdecl;
// Точная копия pa_out_cb из piHPSDR/portaudio.c
var
Audio: TAudioOutput;
Out_: PSingle;
i: LongWord;
newpt: Integer;
begin
Audio := TAudioOutput(userData);
Out_ := PSingle(outputBuffer);
if Out_ = nil then
begin
Result := PA_CONTINUE;
Exit;
end;
// Lock-free: callback только читает FInPt, пишет FOutPt
// Write() только пишет FInPt, читает FOutPt — каждый указатель пишет один поток
newpt := Audio.FOutPt;
for i := 0 to framesPerBuffer - 1 do
begin
if Audio.FInPt = newpt then
begin
Out_^ := 0.0; Inc(Out_);
Out_^ := 0.0; Inc(Out_);
end
else
begin
Out_^ := Audio.FBuf[2 * newpt];
Inc(Out_);
Out_^ := Audio.FBuf[2 * newpt + 1];
Inc(Out_);
Inc(newpt);
if newpt >= MY_RING_BUFFER_SIZE then newpt := 0;
end;
end;
Audio.FOutPt := newpt;
Result := PA_CONTINUE;
end;
// ---------------------------------------------------------------------------
constructor TAudioOutput.Create(SampleRate: Integer);
begin
inherited Create;
FSampleRate := SampleRate;
FOpen := False;
FPAInited := False;
FStream := nil;
FLibHandle := NilHandle;
FLastError := '';
FInPt := 0;
FOutPt := 0;
FillChar(FBuf, SizeOf(FBuf), 0);
FMutex := TCriticalSection.Create;
end;
destructor TAudioOutput.Destroy;
begin
Close;
if FPAInited and Assigned(FPa_Terminate) then
begin
FPa_Terminate();
FPAInited := False;
end;
if FLibHandle <> NilHandle then
begin
FreeLibrary(FLibHandle);
FLibHandle := NilHandle;
end;
FMutex.Free;
inherited;
end;
function TAudioOutput.GetLastError: string;
begin
Result := FLastError;
end;
function TAudioOutput.LoadLib: Boolean;
var
i: Integer;
begin
Result := False;
if FLibHandle <> NilHandle then begin Result := True; Exit; end;
for i := 0 to High(PA_LIBS) do
begin
FLibHandle := LoadLibrary(PA_LIBS[i]);
if FLibHandle <> NilHandle then Break;
end;
if FLibHandle = NilHandle then
begin
FLastError := 'libportaudio not found. sudo apt install libportaudio2';
Exit;
end;
FPa_Initialize := TPa_Initialize(GetProcAddress(FLibHandle, 'Pa_Initialize'));
FPa_Terminate := TPa_Terminate(GetProcAddress(FLibHandle, 'Pa_Terminate'));
FPa_GetDefaultOutputDevice := TPa_GetDefaultOutputDevice(GetProcAddress(FLibHandle, 'Pa_GetDefaultOutputDevice'));
FPa_OpenStream := TPa_OpenStream(GetProcAddress(FLibHandle, 'Pa_OpenStream'));
FPa_StartStream := TPa_StartStream(GetProcAddress(FLibHandle, 'Pa_StartStream'));
FPa_StopStream := TPa_StopStream(GetProcAddress(FLibHandle, 'Pa_StopStream'));
FPa_CloseStream := TPa_CloseStream(GetProcAddress(FLibHandle, 'Pa_CloseStream'));
FPa_GetErrorText := TPa_GetErrorText(GetProcAddress(FLibHandle, 'Pa_GetErrorText'));
if not Assigned(FPa_Initialize) or not Assigned(FPa_OpenStream) then
begin
FLastError := 'libportaudio: symbols not found';
FreeLibrary(FLibHandle);
FLibHandle := NilHandle;
Exit;
end;
Result := True;
end;
// ---------------------------------------------------------------------------
// Open — точная последовательность как в audio_open_output()
// ---------------------------------------------------------------------------
function TAudioOutput.Open: Boolean;
var
OutParam: TPaStreamParameters;
Err: TPaError;
Dev: TPaDeviceIndex;
begin
Result := False;
if FOpen then begin Result := True; Exit; end;
if not LoadLib then Exit;
// Pa_Initialize — один раз (как в audio_get_cards)
if not FPAInited then
begin
Err := FPa_Initialize();
if Err <> PA_NO_ERROR then
begin
FLastError := 'Pa_Initialize: ';
if Assigned(FPa_GetErrorText) then
FLastError := FLastError + string(FPa_GetErrorText(Err))
else
FLastError := FLastError + IntToStr(Err);
Exit;
end;
FPAInited := True;
end;
Dev := FPa_GetDefaultOutputDevice();
if Dev = PA_NO_DEV then
begin
FLastError := 'No default output device';
Exit;
end;
// Точно как в оригинале: bzero + suggestedLatency = 0.0
FillChar(OutParam, SizeOf(OutParam), 0);
OutParam.channelCount := 2;
OutParam.device := Dev;
OutParam.hostApiSpecificStreamInfo := nil;
OutParam.sampleFormat := PA_FLOAT32;
{$IFDEF WINDOWS}
// На Windows latency=0 вызывает фризы — используем разумный минимум
OutParam.suggestedLatency := 0.050; // 50ms — стабильно на Windows WASAPI/MME
{$ELSE}
OutParam.suggestedLatency := 0.0; // на Linux ALSA справляется с минимумом
{$ENDIF}
Err := FPa_OpenStream(
@FStream,
nil, // no input
@OutParam,
FSampleRate,
MY_AUDIO_BUFFER_SIZE, // 128 frames как в оригинале
PA_NO_FLAG,
@PaOutCallback,
Self
);
if Err <> PA_NO_ERROR then
begin
FLastError := 'Pa_OpenStream: ';
if Assigned(FPa_GetErrorText) then
FLastError := FLastError + string(FPa_GetErrorText(Err))
else
FLastError := FLastError + IntToStr(Err);
Exit;
end;
// Инициализируем ring buffer
FInPt := 0;
FOutPt := 0;
FillChar(FBuf, SizeOf(FBuf), 0);
Err := FPa_StartStream(FStream);
if Err <> PA_NO_ERROR then
begin
FLastError := 'Pa_StartStream: ';
if Assigned(FPa_GetErrorText) then
FLastError := FLastError + string(FPa_GetErrorText(Err))
else
FLastError := FLastError + IntToStr(Err);
FPa_CloseStream(FStream);
FStream := nil;
Exit;
end;
FOpen := True;
Result := True;
end;
procedure TAudioOutput.Close;
begin
if not FOpen then Exit;
if FStream <> nil then
begin
if Assigned(FPa_StopStream) then FPa_StopStream(FStream);
if Assigned(FPa_CloseStream) then FPa_CloseStream(FStream);
FStream := nil;
end;
FOpen := False;
end;
// ---------------------------------------------------------------------------
// WriteDouble — точная копия audio_write() из оригинала
// ---------------------------------------------------------------------------
// WriteDouble — точная копия audio_write() из piHPSDR/portaudio.c
// Вызывается per-sample из Write. Мьютекс держится весь цикл в Write.
procedure TAudioOutput.WriteDouble(Left, Right: Double);
var
avail: Integer;
oldpt: Integer;
newpt: Integer;
i: Integer;
begin
avail := FInPt - FOutPt;
if avail < 0 then Inc(avail, MY_RING_BUFFER_SIZE);
// LOW WATER: буфер почти пуст — вставляем полбуфера тишины
if avail < MY_RING_LOW_WATER then
begin
oldpt := FInPt;
for i := 0 to MY_RING_BUFFER_SIZE div 2 - avail - 1 do
begin
FBuf[2 * oldpt] := 0.0;
FBuf[2 * oldpt + 1] := 0.0;
Inc(oldpt);
if oldpt >= MY_RING_BUFFER_SIZE then oldpt := 0;
end;
FInPt := oldpt;
end;
// HIGH WATER: буфер почти полон — удаляем половину
if avail > MY_RING_HIGH_WATER then
begin
oldpt := FInPt - avail + MY_RING_BUFFER_SIZE div 2;
if oldpt < 0 then Inc(oldpt, MY_RING_BUFFER_SIZE);
FInPt := oldpt;
end;
// Кладём сэмпл
oldpt := FInPt;
newpt := oldpt + 1;
if newpt = MY_RING_BUFFER_SIZE then newpt := 0;
if newpt <> FOutPt then
begin
FBuf[2 * oldpt] := Left;
FBuf[2 * oldpt + 1] := Right;
FInPt := newpt;
end;
end;
procedure TAudioOutput.Write(const Left, Right: array of Single; Count: Integer);
// Lock-free: Write пишет FInPt, callback читает FInPt
// Порядок: сначала пишем данные в FBuf, потом обновляем FInPt (memory barrier)
var
i: Integer;
begin
if not FOpen then Exit;
for i := 0 to Count - 1 do
WriteDouble(Left[i], Right[i]);
end;
end.
+569
View File
@@ -0,0 +1,569 @@
unit DeviceForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FlatButton, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, IniFiles;
// Декодирование типа платы (совпадает с MainForm.BoardTypeName)
function BoardTypeName(BoardType: Integer): string;
const
DEVICE_CFG_FILE = 'hpsdr_devices.ini';
type
// Запись о сохранённом устройстве
TSavedDevice = record
Name: string; // пользовательское имя
IPAddress: string;
BoardType: Integer;
AutoStart: Boolean; // запускать автоматически при старте
end;
// Результат диалога
TDeviceDialogResult = record
Accepted: Boolean;
IPAddress: string;
SavedIdx: Integer; // -1 если выбрали из discovery, иначе индекс в SavedDevices
end;
{ TDeviceDialog }
TDeviceDialog = class(TForm)
private
// Сохранённые устройства
FSavedDevices: array of TSavedDevice;
FSavedCount: Integer;
FResult: TDeviceDialogResult;
// Discovered devices (IP strings)
FDiscoveredIPs: array of string;
FDiscoveredNames: array of string;
FDiscoveredBoardTypes: array of Integer;
FDiscoveredCount: Integer;
// UI
PanelTop: TPanel;
PanelBottom: TPanel;
PanelLeft: TPanel;
PanelRight: TPanel;
LblSaved: TLabel;
LstSaved: TListBox;
BtnAdd: TFlatButton;
BtnRemove: TFlatButton;
BtnSetAuto: TFlatButton;
EdName: TEdit;
EdIP: TEdit;
LblName: TLabel;
LblIP: TLabel;
LblFound: TLabel;
LstFound: TListBox;
BtnDiscover: TFlatButton;
BtnAddFound: TFlatButton;
BtnConnect: TFlatButton;
BtnCancel: TFlatButton;
FOnDiscover: TNotifyEvent; // внешний callback для запуска discovery
procedure BuildUI;
procedure ApplyTheme;
procedure LoadSaved;
procedure SaveSaved;
procedure RefreshSavedList;
procedure BtnDiscoverClick(Sender: TObject);
procedure BtnAddClick(Sender: TObject);
procedure BtnRemoveClick(Sender: TObject);
procedure BtnSetAutoClick(Sender: TObject);
procedure BtnAddFoundClick(Sender: TObject);
procedure BtnConnectClick(Sender: TObject);
procedure BtnCancelClick(Sender: TObject);
procedure LstSavedDblClick(Sender: TObject);
procedure LstFoundDblClick(Sender: TObject);
procedure LstSavedClick(Sender: TObject);
function MakeBtn(AParent: TWinControl; const Cap: string;
X, Y, W, H: Integer; AClick: TNotifyEvent): TFlatButton;
function MakeLbl(AParent: TWinControl; const Cap: string;
X, Y: Integer): TLabel;
public
constructor Create(AOwner: TComponent); override;
// Добавить найденное устройство (вызывается из MainForm при discovery)
procedure AddDiscovered(const IP, DisplayName: string; BoardType: Integer = 0);
procedure ClearDiscovered;
// Автозапуск: возвращает IP если есть устройство с AutoStart=True
function GetAutoStartIP: string;
function GetAutoStartBoardType: Integer;
function GetSavedBoardType(Idx: Integer): Integer;
// Получить результат
property DialogResult: TDeviceDialogResult read FResult;
property OnDiscover: TNotifyEvent read FOnDiscover write FOnDiscover;
property SavedCount: Integer read FSavedCount;
end;
implementation
function BoardTypeName(BoardType: Integer): string;
begin
case BoardType of
1: Result := 'HERMES (ANAN-10/100)';
2: Result := 'HERMES-E (ANAN-10E/100B)';
3: Result := 'ANGELIA (ANAN-100D)';
4: Result := 'ORION (ANAN-200D)';
5: Result := 'ORION MkII (ANAN-7000/8000)';
6: Result := 'HERMES-LITE 2';
10: Result := 'SATURN (G2)';
else Result := Format('Unknown Board #%d', [BoardType]);
end;
end;
const
CLR_BG = TColor($00121212);
CLR_PANEL = TColor($001A1A1A);
CLR_TEXT = TColor($00E0E0E0);
CLR_TEXTDIM = TColor($00888888);
CLR_BORDER = TColor($00303030);
CLR_ACCENT = TColor($0040FF80);
CLR_AUTO = TColor($0000CCFF); // цвет авто-устройства
BTN_H = 24;
{ TDeviceDialog }
constructor TDeviceDialog.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'Device Selection';
Width := 660;
Height := 420;
Position := poScreenCenter;
BorderStyle := bsDialog;
Color := CLR_BG;
Font.Name := 'Courier New';
Font.Size := 8;
Font.Color := CLR_TEXT;
FSavedCount := 0;
FDiscoveredCount := 0;
FResult.Accepted := False;
BuildUI;
LoadSaved;
RefreshSavedList;
end;
function TDeviceDialog.MakeBtn(AParent: TWinControl; const Cap: string;
X, Y, W, H: Integer; AClick: TNotifyEvent): TFlatButton;
begin
Result := TFlatButton.Create(Self);
Result.Parent := AParent;
Result.Caption := Cap;
Result.Left := X; Result.Top := Y;
Result.Width := W; Result.Height := H;
Result.OnClick := AClick;
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := CLR_TEXT;
Result.ClrNorm := CLR_PANEL;
Result.ClrBorder := TColor($00404040);
Result.ClrHot := TColor($00303030);
Result.ClrActive := TColor($00003300);
Result.ClrText := CLR_TEXT;
Result.ClrTextAct := TColor($0000FF88);
end;
function TDeviceDialog.MakeLbl(AParent: TWinControl; const Cap: string;
X, Y: Integer): TLabel;
begin
Result := TLabel.Create(Self);
Result.Parent := AParent;
Result.Caption := Cap;
Result.Left := X; Result.Top := Y;
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := CLR_TEXTDIM;
end;
procedure TDeviceDialog.BuildUI;
var
LblHint: TLabel;
Ed: TEdit;
begin
// --- Левая панель: сохранённые устройства ---
PanelLeft := TPanel.Create(Self);
PanelLeft.Parent := Self;
PanelLeft.SetBounds(8, 8, 300, 360);
PanelLeft.BevelOuter := bvNone;
PanelLeft.Color := CLR_PANEL;
MakeLbl(PanelLeft, 'SAVED DEVICES', 6, 6);
LstSaved := TListBox.Create(Self);
LstSaved.Parent := PanelLeft;
LstSaved.SetBounds(4, 22, 292, 140);
LstSaved.Color := CLR_BG;
LstSaved.Font.Color:= CLR_TEXT;
LstSaved.Font.Name := 'Courier New';
LstSaved.Font.Size := 8;
LstSaved.OnClick := @LstSavedClick;
LstSaved.OnDblClick := @LstSavedDblClick;
MakeLbl(PanelLeft, 'Name:', 6, 170);
EdName := TEdit.Create(Self);
EdName.Parent := PanelLeft;
EdName.SetBounds(50, 167, 140, BTN_H);
EdName.Color := CLR_BG;
EdName.Font.Color:= CLR_TEXT;
EdName.Font.Name := 'Courier New';
EdName.Font.Size := 8;
MakeLbl(PanelLeft, 'IP:', 6, 198);
EdIP := TEdit.Create(Self);
EdIP.Parent := PanelLeft;
EdIP.SetBounds(50, 195, 140, BTN_H);
EdIP.Color := CLR_BG;
EdIP.Font.Color:= CLR_TEXT;
EdIP.Font.Name := 'Courier New';
EdIP.Font.Size := 8;
EdIP.TextHint := '192.168.1.x';
BtnAdd := MakeBtn(PanelLeft, 'ADD', 6, 225, 70, BTN_H, @BtnAddClick);
BtnRemove := MakeBtn(PanelLeft, 'REMOVE', 80, 225, 70, BTN_H, @BtnRemoveClick);
BtnSetAuto := MakeBtn(PanelLeft, 'SET AUTOSTART', 6, 255, 130, BTN_H, @BtnSetAutoClick);
LblHint := MakeLbl(PanelLeft, '* = autostart', 150, 260);
LblHint.Font.Color := CLR_AUTO;
BtnConnect := MakeBtn(PanelLeft, 'CONNECT', 6, 295, 130, BTN_H+4, @BtnConnectClick);
BtnConnect.ClrText := CLR_ACCENT;
BtnConnect.ClrTextAct := CLR_ACCENT;
// --- Правая панель: discovery ---
PanelRight := TPanel.Create(Self);
PanelRight.Parent := Self;
PanelRight.SetBounds(320, 8, 330, 360);
PanelRight.BevelOuter := bvNone;
PanelRight.Color := CLR_PANEL;
MakeLbl(PanelRight, 'DISCOVERED DEVICES', 6, 6);
LstFound := TListBox.Create(Self);
LstFound.Parent := PanelRight;
LstFound.SetBounds(4, 22, 322, 190);
LstFound.Color := CLR_BG;
LstFound.Font.Color:= CLR_TEXT;
LstFound.Font.Name := 'Courier New';
LstFound.Font.Size := 8;
LstFound.OnDblClick := @LstFoundDblClick;
BtnDiscover := MakeBtn(PanelRight, 'DISCOVER', 6, 220, 100, BTN_H, @BtnDiscoverClick);
BtnAddFound := MakeBtn(PanelRight, 'SAVE DEVICE', 6, 250, 100, BTN_H, @BtnAddFoundClick);
BtnCancel := MakeBtn(PanelRight, 'CANCEL', 220, 295, 100, BTN_H+4, @BtnCancelClick);
end;
procedure TDeviceDialog.ApplyTheme;
begin
// уже задано в BuildUI
end;
procedure TDeviceDialog.LoadSaved;
var
Ini: TIniFile;
I, N: Integer;
Section: string;
begin
FSavedCount := 0;
if not FileExists(DEVICE_CFG_FILE) then Exit;
Ini := TIniFile.Create(DEVICE_CFG_FILE);
try
N := Ini.ReadInteger('Devices', 'Count', 0);
SetLength(FSavedDevices, N);
for I := 0 to N - 1 do
begin
Section := 'Device' + IntToStr(I);
FSavedDevices[I].Name := Ini.ReadString (Section, 'Name', 'HPSDR');
FSavedDevices[I].IPAddress := Ini.ReadString (Section, 'IP', '');
FSavedDevices[I].BoardType := Ini.ReadInteger(Section, 'BoardType', 0);
FSavedDevices[I].AutoStart := Ini.ReadBool (Section, 'AutoStart', False);
Inc(FSavedCount);
end;
finally
Ini.Free;
end;
end;
procedure TDeviceDialog.SaveSaved;
var
Ini: TIniFile;
I: Integer;
Section: string;
begin
Ini := TIniFile.Create(DEVICE_CFG_FILE);
try
Ini.WriteInteger('Devices', 'Count', FSavedCount);
for I := 0 to FSavedCount - 1 do
begin
Section := 'Device' + IntToStr(I);
Ini.WriteString (Section, 'Name', FSavedDevices[I].Name);
Ini.WriteString (Section, 'IP', FSavedDevices[I].IPAddress);
Ini.WriteInteger(Section, 'BoardType', FSavedDevices[I].BoardType);
Ini.WriteBool (Section, 'AutoStart', FSavedDevices[I].AutoStart);
end;
finally
Ini.Free;
end;
end;
procedure TDeviceDialog.RefreshSavedList;
var
I: Integer;
S: string;
begin
LstSaved.Items.Clear;
for I := 0 to FSavedCount - 1 do
begin
S := FSavedDevices[I].Name + ' [' + FSavedDevices[I].IPAddress + ']';
if FSavedDevices[I].BoardType > 0 then
S := S + ' ' + BoardTypeName(FSavedDevices[I].BoardType);
if FSavedDevices[I].AutoStart then
S := '* ' + S;
LstSaved.Items.Add(S);
end;
end;
procedure TDeviceDialog.LstSavedClick(Sender: TObject);
var
Idx: Integer;
begin
Idx := LstSaved.ItemIndex;
if (Idx < 0) or (Idx >= FSavedCount) then Exit;
EdName.Text := FSavedDevices[Idx].Name;
EdIP.Text := FSavedDevices[Idx].IPAddress;
end;
procedure TDeviceDialog.LstSavedDblClick(Sender: TObject);
begin
BtnConnectClick(nil);
end;
procedure TDeviceDialog.LstFoundDblClick(Sender: TObject);
begin
BtnConnectClick(nil);
end;
procedure TDeviceDialog.BtnDiscoverClick(Sender: TObject);
begin
LstFound.Items.Clear;
LstFound.Items.Add('Searching...');
if Assigned(FOnDiscover) then
FOnDiscover(Self);
end;
procedure TDeviceDialog.ClearDiscovered;
begin
FDiscoveredCount := 0;
SetLength(FDiscoveredIPs, 0);
SetLength(FDiscoveredNames, 0);
SetLength(FDiscoveredBoardTypes, 0);
LstFound.Items.Clear;
end;
procedure TDeviceDialog.AddDiscovered(const IP, DisplayName: string; BoardType: Integer = 0);
var
Idx: Integer;
S: string;
begin
if (LstFound.Items.Count = 1) and (LstFound.Items[0] = 'Searching...') then
LstFound.Items.Clear;
Idx := FDiscoveredCount;
Inc(FDiscoveredCount);
SetLength(FDiscoveredIPs, FDiscoveredCount);
SetLength(FDiscoveredNames, FDiscoveredCount);
SetLength(FDiscoveredBoardTypes, FDiscoveredCount);
FDiscoveredIPs[Idx] := IP;
FDiscoveredNames[Idx] := DisplayName;
FDiscoveredBoardTypes[Idx] := BoardType;
S := DisplayName;
if BoardType > 0 then
S := S + ' ' + BoardTypeName(BoardType);
LstFound.Items.Add(S);
end;
procedure TDeviceDialog.BtnAddClick(Sender: TObject);
var
Idx: Integer;
begin
if Trim(EdIP.Text) = '' then
begin
ShowMessage('Enter IP address');
Exit;
end;
Idx := FSavedCount;
Inc(FSavedCount);
SetLength(FSavedDevices, FSavedCount);
FSavedDevices[Idx].Name := Trim(EdName.Text);
if FSavedDevices[Idx].Name = '' then
FSavedDevices[Idx].Name := 'HPSDR';
FSavedDevices[Idx].IPAddress := Trim(EdIP.Text);
FSavedDevices[Idx].BoardType := 0;
FSavedDevices[Idx].AutoStart := False;
SaveSaved;
RefreshSavedList;
LstSaved.ItemIndex := Idx;
end;
procedure TDeviceDialog.BtnRemoveClick(Sender: TObject);
var
Idx, I: Integer;
begin
Idx := LstSaved.ItemIndex;
if (Idx < 0) or (Idx >= FSavedCount) then Exit;
for I := Idx to FSavedCount - 2 do
FSavedDevices[I] := FSavedDevices[I + 1];
Dec(FSavedCount);
SetLength(FSavedDevices, FSavedCount);
SaveSaved;
RefreshSavedList;
EdName.Text := '';
EdIP.Text := '';
end;
procedure TDeviceDialog.BtnSetAutoClick(Sender: TObject);
var
Idx, I: Integer;
begin
Idx := LstSaved.ItemIndex;
if (Idx < 0) or (Idx >= FSavedCount) then
begin
ShowMessage('Select a device first');
Exit;
end;
// Только одно устройство может быть AutoStart
for I := 0 to FSavedCount - 1 do
FSavedDevices[I].AutoStart := (I = Idx);
SaveSaved;
RefreshSavedList;
LstSaved.ItemIndex := Idx;
end;
procedure TDeviceDialog.BtnAddFoundClick(Sender: TObject);
var
Idx: Integer;
begin
Idx := LstFound.ItemIndex;
if (Idx < 0) or (Idx >= FDiscoveredCount) then
begin
ShowMessage('Select a discovered device first');
Exit;
end;
EdIP.Text := FDiscoveredIPs[Idx];
EdName.Text := FDiscoveredNames[Idx];
BtnAddClick(nil);
// Обновляем BoardType только что добавленной записи
if FSavedCount > 0 then
begin
FSavedDevices[FSavedCount - 1].BoardType := FDiscoveredBoardTypes[Idx];
SaveSaved;
RefreshSavedList;
LstSaved.ItemIndex := FSavedCount - 1;
end;
end;
procedure TDeviceDialog.BtnConnectClick(Sender: TObject);
var
IP: string;
Idx: Integer;
begin
IP := '';
// Приоритет: выбранное сохранённое > выбранное найденное > ручной IP
Idx := LstSaved.ItemIndex;
if (Idx >= 0) and (Idx < FSavedCount) then
begin
IP := FSavedDevices[Idx].IPAddress;
FResult.SavedIdx := Idx;
end
else
begin
Idx := LstFound.ItemIndex;
if (Idx >= 0) and (Idx < FDiscoveredCount) then
begin
IP := FDiscoveredIPs[Idx];
FResult.SavedIdx := -1;
end
else if Trim(EdIP.Text) <> '' then
begin
IP := Trim(EdIP.Text);
FResult.SavedIdx := -1;
end;
end;
if IP = '' then
begin
ShowMessage('Select or enter a device to connect');
Exit;
end;
FResult.Accepted := True;
FResult.IPAddress := IP;
ModalResult := mrOk;
end;
procedure TDeviceDialog.BtnCancelClick(Sender: TObject);
begin
FResult.Accepted := False;
ModalResult := mrCancel;
end;
function TDeviceDialog.GetAutoStartIP: string;
var
I: Integer;
begin
Result := '';
for I := 0 to FSavedCount - 1 do
if FSavedDevices[I].AutoStart then
begin
Result := FSavedDevices[I].IPAddress;
Exit;
end;
end;
function TDeviceDialog.GetAutoStartBoardType: Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to FSavedCount - 1 do
if FSavedDevices[I].AutoStart then
begin
Result := FSavedDevices[I].BoardType;
Exit;
end;
end;
function TDeviceDialog.GetSavedBoardType(Idx: Integer): Integer;
begin
if (Idx >= 0) and (Idx < FSavedCount) then
Result := FSavedDevices[Idx].BoardType
else
Result := 0;
end;
end.
+170
View File
@@ -0,0 +1,170 @@
unit FlatButton;
{ Кнопка с полным контролем цвета на Windows и Linux.
Используй вместо TButton везде где нужна тёмная тема. }
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Graphics, LCLType, Types;
type
TFlatButton = class(TGraphicControl)
private
FActive: Boolean;
FHot: Boolean;
FClrNorm: TColor;
FClrActive: TColor;
FClrHot: TColor;
FClrBorder: TColor;
FClrText: TColor;
FClrTextAct:TColor;
FOnClick: TNotifyEvent;
procedure SetActive(V: Boolean);
protected
procedure Paint; override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
property Active: Boolean read FActive write SetActive;
property ClrNorm: TColor read FClrNorm write FClrNorm;
property ClrActive: TColor read FClrActive write FClrActive;
property ClrHot: TColor read FClrHot write FClrHot;
property ClrBorder: TColor read FClrBorder write FClrBorder;
property ClrText: TColor read FClrText write FClrText;
property ClrTextAct:TColor read FClrTextAct write FClrTextAct;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property Caption;
property Font;
property Enabled;
property Visible;
end;
// Фабрика — аналог MakeBtn, возвращает TFlatButton
function MakeFlatBtn(AParent: TWinControl; const ACap: string;
ALeft, ATop, AW, AH: Integer;
AHandler: TNotifyEvent;
ClrNorm: TColor = TColor($00202020);
ClrActive: TColor = TColor($00003300);
ClrHot: TColor = TColor($00303030);
ClrBorder: TColor = TColor($00404040);
ClrText: TColor = TColor($00E0E0E0);
ClrTextAct: TColor = TColor($0000FF88)): TFlatButton;
implementation
constructor TFlatButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActive := False;
FHot := False;
FClrNorm := TColor($00202020);
FClrActive := TColor($00003300);
FClrHot := TColor($00303030);
FClrBorder := TColor($00404040);
FClrText := TColor($00E0E0E0);
FClrTextAct := TColor($0000FF88);
Cursor := crHandPoint;
end;
procedure TFlatButton.SetActive(V: Boolean);
begin
if FActive = V then Exit;
FActive := V;
Invalidate;
end;
procedure TFlatButton.Paint;
var
R: TRect;
TW, TH: Integer;
BG: TColor;
begin
R := ClientRect;
// Фон
if FActive then BG := FClrActive
else if FHot then BG := FClrHot
else BG := FClrNorm;
Canvas.Brush.Color := BG;
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Style := psClear;
Canvas.FillRect(R);
// Рамка
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := FClrBorder;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(R);
// Текст
if FActive then Canvas.Font.Color := FClrTextAct
else Canvas.Font.Color := FClrText;
Canvas.Brush.Style := bsClear;
TW := Canvas.TextWidth(Caption);
TH := Canvas.TextHeight('A');
Canvas.TextOut((Width - TW) div 2, (Height - TH) div 2, Caption);
end;
procedure TFlatButton.MouseEnter;
begin
inherited;
FHot := True;
Invalidate;
end;
procedure TFlatButton.MouseLeave;
begin
inherited;
FHot := False;
Invalidate;
end;
procedure TFlatButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
end;
procedure TFlatButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if (Button = mbLeft) and PtInRect(ClientRect, Point(X, Y)) then
if Assigned(FOnClick) then FOnClick(Self);
end;
function MakeFlatBtn(AParent: TWinControl; const ACap: string;
ALeft, ATop, AW, AH: Integer;
AHandler: TNotifyEvent;
ClrNorm, ClrActive, ClrHot, ClrBorder, ClrText, ClrTextAct: TColor): TFlatButton;
begin
Result := TFlatButton.Create(AParent);
Result.Parent := AParent;
Result.Caption := ACap;
Result.Left := ALeft;
Result.Top := ATop;
Result.Width := AW;
Result.Height := AH;
Result.OnClick := AHandler;
Result.ClrNorm := ClrNorm;
Result.ClrActive := ClrActive;
Result.ClrHot := ClrHot;
Result.ClrBorder := ClrBorder;
Result.ClrText := ClrText;
Result.ClrTextAct := ClrTextAct;
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := ClrText;
end;
end.
+394
View File
@@ -0,0 +1,394 @@
unit FreqDisplay;
{
TFreqDisplay — цифровой дисплей частоты с управлением по разрядам
===================================================================
Отображает частоту в Гц вида 14.201.123
Наводишь мышь на цифру → подсветка разряда.
Колёсико мыши → меняет выделенный разряд (+/- 10^N).
Стрелки Left/Right → переключают активный разряд.
Стрелки Up/Down → меняют активный разряд.
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Graphics, LCLType, Math;
type
TFreqChangeEvent = procedure(Sender: TObject; NewFreq: Int64) of object;
TFreqDisplay = class(TCustomControl)
private
FFrequency: Int64;
FMinFreq: Int64;
FMaxFreq: Int64;
FFontSize: Integer;
FFontName: string;
FColorNormal: TColor;
FColorHover: TColor;
FColorDim: TColor;
FOnChange: TFreqChangeEvent;
FHoverDigit: Integer; // 0=единицы .. 8=100МГц, -1=нет
FDigitX: array[0..8] of Integer; // X левого края каждой цифры
FDigitW: Integer;
FCharH: Integer;
procedure SetFrequency(V: Int64);
procedure SetFontSize(V: Integer);
function ClampFreq(V: Int64): Int64;
function DigitAtX(X: Integer): Integer;
function DigitStep(D: Integer): Int64;
procedure ChangeByDigit(D, Delta: Integer);
procedure BuildDigitMap(const S: string; StartX: Integer);
protected
procedure Paint; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseLeave; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Click; override;
public
constructor Create(AOwner: TComponent); override;
property Frequency: Int64 read FFrequency write SetFrequency;
property MinFreq: Int64 read FMinFreq write FMinFreq;
property MaxFreq: Int64 read FMaxFreq write FMaxFreq;
property FontSize: Integer read FFontSize write SetFontSize;
property FontName: string read FFontName write FFontName;
property ColorNormal: TColor read FColorNormal write FColorNormal;
property ColorHover: TColor read FColorHover write FColorHover;
property ColorDim: TColor read FColorDim write FColorDim;
property OnChange: TFreqChangeEvent read FOnChange write FOnChange;
end;
implementation
constructor TFreqDisplay.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFrequency := 14200000;
FMinFreq := 0;
FMaxFreq := 2000000000;
FFontSize := 20;
FFontName := 'Courier New';
FColorNormal := TColor($00E8F0FF);
FColorHover := TColor($0040DDFF);
FColorDim := TColor($00607080);
FHoverDigit := -1;
FDigitW := 14;
FCharH := 24;
TabStop := True;
Width := 220;
Height := 40;
end;
function TFreqDisplay.ClampFreq(V: Int64): Int64;
begin
if V < FMinFreq then Result := FMinFreq
else if V > FMaxFreq then Result := FMaxFreq
else Result := V;
end;
function TFreqDisplay.DigitStep(D: Integer): Int64;
var
i: Integer;
Result_: Int64;
begin
Result_ := 1;
for i := 0 to D - 1 do
Result_ := Result_ * 10;
Result := Result_;
end;
function TFreqDisplay.DigitAtX(X: Integer): Integer;
var
i: Integer;
begin
Result := -1;
if FDigitW = 0 then Exit;
for i := 0 to 8 do
if (X >= FDigitX[i]) and (X < FDigitX[i] + FDigitW) then
begin
Result := i;
Exit;
end;
end;
// Строим карту FDigitX из строки вида "14.201.123"
// Цифры нумеруются справа налево: digit0=единицы, digit8=сотни млн
procedure TFreqDisplay.BuildDigitMap(const S: string; StartX: Integer);
var
Xs: array[0..11] of Integer; // X каждого символа строки (макс 12 симв)
ci: Integer;
xi: Integer;
dIdx: Integer;
len: Integer;
begin
len := Length(S);
if len > 12 then len := 12;
xi := StartX;
for ci := 0 to len - 1 do
begin
Xs[ci] := xi;
Inc(xi, Canvas.TextWidth(S[ci + 1]));
end;
// Назначаем digit индексы справа налево, пропуская точки
dIdx := 0;
for ci := len - 1 downto 0 do
begin
if S[ci + 1] <> '.' then
begin
if dIdx <= 8 then
FDigitX[dIdx] := Xs[ci];
Inc(dIdx);
end;
end;
end;
procedure TFreqDisplay.Paint;
var
C: TCanvas;
S: string;
Hz: Int64;
Mhz: Integer;
KHz: Integer;
Ones: Integer;
TotalW: Integer;
StartX: Integer;
ChW, ChH: Integer;
xi: Integer;
ci: Integer;
ch: Char;
dIdx: Integer;
col: TColor;
DiChar: array[0..11] of Integer;
tmpIdx: Integer;
len: Integer;
begin
C := Canvas;
// Фон — прозрачный (наследует от Panel)
C.Brush.Style := bsClear;
C.FillRect(ClientRect);
C.Font.Name := FFontName;
C.Font.Size := FFontSize;
C.Font.Bold := True;
C.Font.Style := [fsBold];
ChW := C.TextWidth('0');
ChH := C.TextHeight('0');
FDigitW := ChW;
FCharH := ChH;
Hz := Abs(FFrequency);
Mhz := Hz div 1000000;
KHz := (Hz div 1000) mod 1000;
Ones := Hz mod 1000;
S := Format('%d.%3.3d.%3.3d', [Mhz, KHz, Ones]);
TotalW := C.TextWidth(S);
StartX := (Width - TotalW) div 2;
if StartX < 2 then StartX := 2;
// Строим карту digit → X
BuildDigitMap(S, StartX);
// Строим обратную карту символ → digit index
len := Length(S);
if len > 12 then len := 12;
tmpIdx := 0;
for ci := len - 1 downto 0 do
begin
if S[ci + 1] <> '.' then
begin
DiChar[ci] := tmpIdx;
Inc(tmpIdx);
end
else
DiChar[ci] := -1;
end;
// Рисуем
xi := StartX;
for ci := 0 to len - 1 do
begin
ch := S[ci + 1];
dIdx := DiChar[ci];
if ch = '.' then
col := FColorDim
else if dIdx = FHoverDigit then
col := FColorHover
else
col := FColorNormal;
// Фоновая подсветка активного разряда
if (dIdx >= 0) and (dIdx = FHoverDigit) then
begin
C.Brush.Color := TColor($00182838);
C.Brush.Style := bsSolid;
C.FillRect(Rect(xi - 1, 2, xi + ChW + 1, Height - 2));
C.Brush.Style := bsClear;
end;
C.Font.Color := col;
C.Brush.Style := bsClear;
C.TextOut(xi, (Height - ChH) div 2, ch);
Inc(xi, C.TextWidth(ch));
end;
// Рамка фокуса
if Focused then
begin
C.Pen.Color := TColor($00004060);
C.Pen.Style := psDot;
C.Pen.Width := 1;
C.Brush.Style := bsClear;
C.Rectangle(1, 1, Width - 2, Height - 2);
C.Pen.Style := psSolid;
end;
end;
procedure TFreqDisplay.ChangeByDigit(D, Delta: Integer);
var
Step: Int64;
Base: Int64;
NewFreq: Int64;
begin
if D < 0 then Exit;
Step := DigitStep(D);
// Нижняя граница текущего разряда (кратная Step)
Base := (FFrequency div Step) * Step;
if Delta > 0 then
begin
// Вверх: от нижней границы + шаг
// 7.129.054 + 100 → base=7.129.000 → 7.129.000 + 100 = 7.129.100
NewFreq := Base + Step * Delta;
end
else
begin
// Вниз:
// Если уже кратна — просто шагаем: 7.129.100 - 100 = 7.129.000
// Если не кратна — возвращаем нижнюю границу: 7.129.054 → 7.129.000
if FFrequency = Base then
NewFreq := Base + Step * Delta // кратна → шагаем
else
NewFreq := Base; // не кратна → снэп к нижней границе
end;
NewFreq := ClampFreq(NewFreq);
if NewFreq <> FFrequency then
begin
FFrequency := NewFreq;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self, FFrequency);
end;
end;
procedure TFreqDisplay.MouseMove(Shift: TShiftState; X, Y: Integer);
var
d: Integer;
begin
inherited;
d := DigitAtX(X);
if d <> FHoverDigit then
begin
FHoverDigit := d;
Invalidate;
end;
if d >= 0 then Cursor := crHandPoint
else Cursor := crDefault;
end;
procedure TFreqDisplay.MouseLeave;
begin
inherited;
if FHoverDigit <> -1 then
begin
FHoverDigit := -1;
Invalidate;
end;
Cursor := crDefault;
end;
function TFreqDisplay.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
var
d: Integer;
Delta: Integer;
Local: TPoint;
begin
Result := False;
Local := ScreenToClient(MousePos);
d := FHoverDigit;
if d < 0 then
d := DigitAtX(Local.X);
if d >= 0 then
begin
if WheelDelta > 0 then Delta := 1 else Delta := -1;
ChangeByDigit(d, Delta);
Result := True; // обработали — не передаём дальше
end;
if not Result then
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;
procedure TFreqDisplay.KeyDown(var Key: Word; Shift: TShiftState);
var
d: Integer;
begin
d := FHoverDigit;
if d < 0 then d := 3; // по умолчанию — кГц
case Key of
VK_UP: begin ChangeByDigit(d, +1); Key := 0; end;
VK_DOWN: begin ChangeByDigit(d, -1); Key := 0; end;
VK_LEFT: begin
if FHoverDigit < 0 then FHoverDigit := 3;
if FHoverDigit < 8 then Inc(FHoverDigit);
Invalidate; Key := 0;
end;
VK_RIGHT: begin
if FHoverDigit < 0 then FHoverDigit := 3;
if FHoverDigit > 0 then Dec(FHoverDigit);
Invalidate; Key := 0;
end;
end;
inherited KeyDown(Key, Shift);
end;
procedure TFreqDisplay.Click;
begin
inherited;
SetFocus;
end;
procedure TFreqDisplay.SetFrequency(V: Int64);
begin
V := ClampFreq(V);
if V <> FFrequency then
begin
FFrequency := V;
Invalidate;
end;
end;
procedure TFreqDisplay.SetFontSize(V: Integer);
begin
if V <> FFontSize then
begin
FFontSize := V;
Invalidate;
end;
end;
end.
+1070
View File
File diff suppressed because it is too large Load Diff
+464
View File
@@ -0,0 +1,464 @@
unit HPSDRProtocol;
{
openHPSDR Ethernet Protocol V4.3 constants and packet structures.
Big-Endian (Network Byte Order) unless otherwise noted.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
// ---------------------------------------------------------------------------
// UDP Ports (defaults)
// ---------------------------------------------------------------------------
const
PORT_COMMAND = 1024; // Discovery, Erase, Program, Set IP
PORT_DDC_SPECIFIC = 1025; // DDC Specific packet (PC -> HW)
PORT_DUC_SPECIFIC = 1026; // DUC/TXA Specific packet (PC -> HW)
PORT_HP_FROM_PC = 1027; // High Priority from PC
PORT_HP_TO_PC = 1025; // High Priority Status from HW
PORT_DDC_AUDIO = 1028; // DDC Audio (PC -> HW)
PORT_DUC_IQ = 1029; // DUC I&Q data (PC -> HW)
PORT_MIC_DATA = 1026; // Microphone data (HW -> PC)
PORT_WIDEBAND_ADC0 = 1027; // Wideband data (HW -> PC)
PORT_DDC0_IQ = 1035; // DDC0 I&Q (HW -> PC), DDC1=1036 etc.
// ---------------------------------------------------------------------------
// Command bytes (Byte 4 of packet)
// ---------------------------------------------------------------------------
CMD_GENERAL = $00;
CMD_DISCOVERY = $02;
CMD_SET_IP = $03;
CMD_ERASE = $04;
CMD_PROGRAM = $05;
// ---------------------------------------------------------------------------
// Discovery Reply Byte 4
// ---------------------------------------------------------------------------
REPLY_DISCOVERY_FREE = $02; // Hardware available
REPLY_DISCOVERY_INUSE = $03; // Hardware in use by another host
REPLY_XML_DESC = $FE; // XML hardware description follows
REPLY_FULL_DESC = $FF; // Full hardware description follows
// ---------------------------------------------------------------------------
// Board types (Discovery Reply Byte 11)
// ---------------------------------------------------------------------------
BOARD_ATLAS = 0;
BOARD_HERMES = 1; // ANAN-10, 100
BOARD_HERMES_10E = 2; // ANAN-10E, 100B
BOARD_ANGELA = 3; // ANAN-100D
BOARD_ORION = 4; // ANAN-200D
BOARD_ORION_MK2 = 5; // ANAN-7/8000DLE
BOARD_HERMES_LITE = 6;
BOARD_SATURN = 10; // ANAN-G2
// ---------------------------------------------------------------------------
// Packet sizes
// ---------------------------------------------------------------------------
DISCOVERY_PACKET_SIZE = 60;
GENERAL_PACKET_SIZE = 60;
DDC_SPECIFIC_SIZE = 1444;
DUC_SPECIFIC_SIZE = 60;
HP_DATA_PC_SIZE = 1444;
HP_STATUS_HW_SIZE = 60;
DDC_AUDIO_SIZE = 260; // 4 hdr + 64*2*2
DUC_IQ_SIZE = 1444; // 4 hdr + 240*6
MIC_DATA_SIZE = 132; // 4 hdr + 64*2
DDC_IQ_SIZE = 1444; // 4 hdr + 12 info + 238*6
// ---------------------------------------------------------------------------
// DDC sample rates (ksps)
// ---------------------------------------------------------------------------
DDC_RATE_48 = 48;
DDC_RATE_96 = 96;
DDC_RATE_192 = 192;
DDC_RATE_384 = 384;
DDC_RATE_768 = 768;
DDC_RATE_1536 = 1536;
// ---------------------------------------------------------------------------
// DSP clock (Hz)
// ---------------------------------------------------------------------------
DSP_CLOCK_HZ: Double = 122880000.0;
// ---------------------------------------------------------------------------
// Maximum DDCs / ADCs
// ---------------------------------------------------------------------------
MAX_DDCS = 80;
MAX_ADCS = 8;
MAX_DUCS = 4;
// ---------------------------------------------------------------------------
// High Priority Byte 4 bits (PC -> HW)
// ---------------------------------------------------------------------------
HP_RUN = $01;
HP_PTT0 = $02;
HP_PTT1 = $04;
HP_PTT2 = $08;
HP_PTT3 = $10;
// ---------------------------------------------------------------------------
// High Priority Status Byte 4 bits (HW -> PC)
// ---------------------------------------------------------------------------
HPS_PTT = $01;
HPS_DOT = $02;
HPS_DASH = $04;
HPS_PLL_LOCKED = $10;
HPS_FIFO_EMPTY = $20;
HPS_FIFO_FULL = $40;
// ---------------------------------------------------------------------------
// DUC Specific Byte 5 bits (CW options)
// ---------------------------------------------------------------------------
CW_EER = $01;
CW_MODE = $02;
CW_REVERSE_KEYS = $04;
CW_IAMBIC = $08;
CW_SIDETONE = $10;
CW_MODE_B = $20;
CW_STRICT_SPACING = $40;
CW_BREAK_IN = $80;
// ---------------------------------------------------------------------------
// Packet record types
// ---------------------------------------------------------------------------
type
// Raw byte array for a generic 60-byte command packet
TRawPacket60 = array[0..59] of Byte;
TRawPacket1444 = array[0..1443] of Byte;
PRawPacket1444 = ^TRawPacket1444;
PRawPacket60 = ^TRawPacket60;
// -------------------------------------------------------------------------
// Discovery packet (PC -> HW)
// -------------------------------------------------------------------------
TDiscoveryPacket = packed record
SeqHi, SeqMidHi, SeqMidLo, SeqLo: Byte; // Bytes 0-3: always 0
Command: Byte; // Byte 4: CMD_DISCOVERY=$02
Zeros: array[5..59] of Byte; // Bytes 5-59: zero
end;
// -------------------------------------------------------------------------
// Discovery Reply (HW -> PC)
// -------------------------------------------------------------------------
TDiscoveryReply = packed record
SeqHi, SeqMidHi, SeqMidLo, SeqLo: Byte; // 0-3
Status: Byte; // 4: $02 free/$03 in use
MAC: array[0..5] of Byte; // 5-10
BoardType: Byte; // 11
ProtocolVersion: Byte; // 12
FirmwareVersion: Byte; // 13
Mercury0: Byte; // 14
Mercury1: Byte; // 15
Mercury2: Byte; // 16
Mercury3: Byte; // 17
PennyVersion: Byte; // 18
MetisVersion: Byte; // 19
NumDDCs: Byte; // 20
FreqOrPhase: Byte; // 21: 0=freq, 1=phase
EndianModes: Byte; // 22
BetaVersion: Byte; // 23
Reserved: array[24..59] of Byte;
end;
// -------------------------------------------------------------------------
// General Packet (PC -> HW, port 1024)
// -------------------------------------------------------------------------
TGeneralPacket = packed record
Seq: array[0..3] of Byte; // 0-3
Command: Byte; // 4: CMD_GENERAL=$00
DDCSpecPort: array[0..1] of Byte; // 5-6: default 1025
DUCSpecPort: array[0..1] of Byte; // 7-8: default 1026
HPFromPCPort: array[0..1] of Byte; // 9-10: default 1027
HPToPCPort: array[0..1] of Byte; // 11-12: default 1025
DDCAudioPort: array[0..1] of Byte; // 13-14: default 1028
DUCIQPort: array[0..1] of Byte; // 15-16: default 1029
DDC0Port: array[0..1] of Byte; // 17-18: default 1035
MicPort: array[0..1] of Byte; // 19-20: default 1026
WBPort: array[0..1] of Byte; // 21-22: default 1027
WBEnable: Byte; // 23
WBSamplesPerPkt: array[0..1] of Byte; // 24-25: default 512
WBSampleSize: Byte; // 26: default 16
WBUpdateRate: Byte; // 27: 0-255ms
WBPacketsPerFrame: Byte; // 28: default 32
MemMapFromPCPort: array[0..1] of Byte; // 29-30
MemMapToPCPort: array[0..1] of Byte; // 31-32
EnvPWMMin: array[0..1] of Byte; // 33-34
EnvPWMMax: array[0..1] of Byte; // 35-36
Flags37: Byte; // 37: timestamp/VITA/VNA/phase
Flags38: Byte; // 38: HW timer enable
DataFormat: Byte; // 39: endian/format
Reserved40: array[40..55] of Byte;
AtlasBusConfig: Byte; // 56: Atlas config [2:0]
Ref10MHz: Byte; // 57: 10MHz source [1:0]
PAConfig: Byte; // 58: PA/Apollo/Mercury/clock
AlexEnable: Byte; // 59: Alex[0..7] enable
end;
// -------------------------------------------------------------------------
// DDC Specific Packet (PC -> HW)
// -------------------------------------------------------------------------
TDDCSpecificPacket = packed record
Seq: array[0..3] of Byte; // 0-3
NumADCs: Byte; // 4: number of ADCs
DitherADC: Byte; // 5: dither enable bits
RandomADC: Byte; // 6: random enable bits
DDCEnable: array[0..9] of Byte; // 7-16: enable bits DDC0..79
// DDC config: 6 bytes each for DDC0..79
// Byte 17+n*6: ADC selection
// Byte 18+n*6: SampleRate [15:8]
// Byte 19+n*6: SampleRate [7:0]
// Byte 20+n*6: CIC1 (future)
// Byte 21+n*6: CIC2 (future)
// Byte 22+n*6: SampleSize (default 24)
DDCConfig: array[0..479] of Byte; // 17-496
Filler: array[497..1362] of Byte;
SyncDDC: array[0..79] of Byte; // 1363-1442
Unused: Byte; // 1443
end;
// Per-DDC config helper (maps into DDCConfig array above)
TDDCConfig = packed record
ADCSource: Byte; // which ADC (0..NumADCs-1) or NumADCs for DAC
SampleRateHi, SampleRateLo: Byte;
CIC1, CIC2: Byte;
SampleSize: Byte; // default 24
end;
// -------------------------------------------------------------------------
// DUC (Transmitter) Specific Packet (PC -> HW)
// -------------------------------------------------------------------------
TDUCSpecificPacket = packed record
Seq: array[0..3] of Byte;
NumDACs: Byte; // 4
CWOptions: Byte; // 5: CW_* flags
SidetoneLevel: Byte; // 6: 0..127
SidetoneFreqHi: Byte; // 7
SidetoneFreqLo: Byte; // 8
KeyerSpeed: Byte; // 9: 0..60 WPM
KeyerWeight: Byte; // 10: 33..66
HangDelayHi: Byte; // 11
HangDelayLo: Byte; // 12
RFDelay: Byte; // 13
DUC0RateHi: Byte; // 14
DUC0RateLo: Byte; // 15
DUC0Bits: Byte; // 16: default 24
CWRampPeriod: Byte; // 17: ms, 0=default
Reserved18: array[18..49] of Byte;
MicLineSelect: Byte; // 50
LineInGain: Byte; // 51: 0=+12dB, 31=-34.5dB
Reserved52: array[52..56] of Byte;
StepAtten2: Byte; // 57: ADC2 atten during TX (0-31dB)
StepAtten1: Byte; // 58: ADC1 atten during TX
StepAtten0: Byte; // 59: ADC0 atten during TX
end;
// -------------------------------------------------------------------------
// High Priority Packet (PC -> HW, port 1027)
// Full packet is 1444 bytes but we define the key fields
// -------------------------------------------------------------------------
THighPriorityPacket = packed record
Seq: array[0..3] of Byte;
RunPTT: Byte; // 4: HP_RUN | HP_PTTn
CWX0: Byte; // 5: [0]=CWX [1]=Dot [2]=Dash
CWX1: Byte; // 6: reserved
CWX2: Byte; // 7: reserved
CWX3: Byte; // 8: reserved
// Bytes 9-12: DDC0 frequency/phase word (Big-Endian)
// Bytes 13-16: DDC1 ...
// Bytes 17-328: DDC2..DDC79
// Bytes 329-332: DUC0
// Byte 345: DUC0 drive level (0-255)
// Bytes 1398-1399: CAT over TCP port
// Byte 1400: Transverter/audio enable
// Byte 1401: Open Collector outputs
// Bytes 1432-1435: Alex0 filter config
// Byte 1443: Step Attenuator 0
Data: array[9..1443] of Byte;
end;
// -------------------------------------------------------------------------
// High Priority Status Packet (HW -> PC, port 1025)
// -------------------------------------------------------------------------
THighPriorityStatus = packed record
Seq: array[0..3] of Byte;
StatusBits: Byte; // 4: HPS_PTT/DOT/DASH/PLL_LOCKED
ADCOverload: Byte; // 5: [0..7] = ADC0..7 overload
ExciterPwr0Hi: Byte; // 6
ExciterPwr0Lo: Byte; // 7
ExciterPwr1: array[0..1] of Byte; // 8-9 (reserved)
ExciterPwr2: array[0..1] of Byte; // 10-11 (reserved)
ExciterPwr3: array[0..1] of Byte; // 12-13 (reserved)
FwdPwrAlex0Hi: Byte; // 14
FwdPwrAlex0Lo: Byte; // 15
FwdPwrAlex1: array[0..1] of Byte; // 16-17 (reserved)
FwdPwrAlex2: array[0..1] of Byte; // 18-19 (reserved)
FwdPwrAlex3: array[0..1] of Byte; // 20-21 (reserved)
RevPwrAlex0Hi: Byte; // 22
RevPwrAlex0Lo: Byte; // 23
RevPwrAlex1: array[0..1] of Byte; // 24-25 (reserved)
RevPwrAlex2: array[0..1] of Byte; // 26-27 (reserved)
RevPwrAlex3: array[0..1] of Byte; // 28-29 (reserved)
FIFOOverflow: Byte; // 30: [3:0] overflow bits
DDCFIFODepthHi: Byte; // 31
DDCFIFODepthLo: Byte; // 32
MicFIFODepthHi: Byte; // 33
MicFIFODepthLo: Byte; // 34
DUCFIFODepthHi: Byte; // 35
DUCFIFODepthLo: Byte; // 36
SpkFIFODepthHi: Byte; // 37
SpkFIFODepthLo: Byte; // 38
Unused39: array[39..48] of Byte;
SupplyVoltsHi: Byte; // 49
SupplyVoltsLo: Byte; // 50
UserADC3Hi: Byte; // 51
UserADC3Lo: Byte; // 52
UserADC2Hi: Byte; // 53
UserADC2Lo: Byte; // 54
UserADC1Hi: Byte; // 55
UserADC1Lo: Byte; // 56
UserADC0Hi: Byte; // 57
UserADC0Lo: Byte; // 58
UserInputBits: Byte; // 59: IO4/IO5/IO6/IO8/IO2 etc.
end;
// -------------------------------------------------------------------------
// Microphone Data Packet (HW -> PC, default port 1026)
// -------------------------------------------------------------------------
TMicDataPacket = packed record
Seq: array[0..3] of Byte;
Samples: array[0..63] of SmallInt; // 64 x 16-bit signed, big-endian
end;
// -------------------------------------------------------------------------
// DDC I&Q Packet (HW -> PC, DDC0 default port 1035)
// -------------------------------------------------------------------------
TDDCIQPacket = packed record
Seq: array[0..3] of Byte; // 0-3
TimeStamp: array[0..7] of Byte; // 4-11: 64-bit VITA-49 timestamp
BitsPerSample: array[0..1] of Byte; // 12-13
SamplesPerFrame: array[0..1] of Byte;// 14-15
// From byte 16: interleaved I/Q samples
// For 24-bit: 3 bytes I, 3 bytes Q repeated
// Max 238 IQ pairs for 24-bit = 1428 bytes, total packet = 1444
IQData: array[0..1427] of Byte; // 16-1443
end;
// -------------------------------------------------------------------------
// DDC Audio Packet (PC -> HW, default port 1028)
// 64 Left + 64 Right 16-bit samples at 48ksps
// -------------------------------------------------------------------------
TDDCAudioPacket = packed record
Seq: array[0..3] of Byte;
// Interleaved Left/Right 16-bit samples (big-endian)
// [L0_hi, L0_lo, R0_hi, R0_lo, L1_hi, L1_lo, R1_hi, R1_lo, ...]
AudioData: array[0..255] of Byte; // 64 * 4 bytes
end;
// -------------------------------------------------------------------------
// DUC I&Q Data Packet (PC -> HW, default port 1029)
// 240 IQ pairs at 192ksps, 24-bit
// -------------------------------------------------------------------------
TDUCIQPacket = packed record
Seq: array[0..3] of Byte;
// 240 * 6 bytes = 1440 bytes
IQData: array[0..1439] of Byte;
end;
// ---------------------------------------------------------------------------
// Helper functions for Big-Endian packing/unpacking
// ---------------------------------------------------------------------------
// Pack a 32-bit word into 4 bytes (Big-Endian)
procedure PackU32BE(Value: LongWord; out B: array of Byte; Offset: Integer = 0);
// Unpack 4 bytes to a 32-bit word (Big-Endian)
function UnpackU32BE(const B: array of Byte; Offset: Integer = 0): LongWord;
// Pack a 16-bit word into 2 bytes (Big-Endian)
procedure PackU16BE(Value: Word; out B: array of Byte; Offset: Integer = 0);
// Unpack 2 bytes to a 16-bit word (Big-Endian)
function UnpackU16BE(const B: array of Byte; Offset: Integer = 0): Word;
// Convert frequency in Hz to phase word for HPSDR hardware
function FreqToPhaseWord(FreqHz: Double): LongWord;
// Convert phase word back to frequency
function PhaseWordToFreq(PhaseWord: LongWord): Double;
// Convert raw ADC value to supply voltage
function ADCToSupplyVolts(RawADC: Word): Double;
// Convert raw ADC value to RF power in Watts (ANAN-100)
function ADCToWatts100(RawADC: Word): Double;
// Convert raw ADC value to RF power in Watts (ANAN-10)
function ADCToWatts10(RawADC: Word): Double;
implementation
procedure PackU32BE(Value: LongWord; out B: array of Byte; Offset: Integer);
begin
B[Offset + 0] := (Value shr 24) and $FF;
B[Offset + 1] := (Value shr 16) and $FF;
B[Offset + 2] := (Value shr 8) and $FF;
B[Offset + 3] := Value and $FF;
end;
function UnpackU32BE(const B: array of Byte; Offset: Integer): LongWord;
begin
Result := (LongWord(B[Offset]) shl 24)
or (LongWord(B[Offset+1]) shl 16)
or (LongWord(B[Offset+2]) shl 8)
or LongWord(B[Offset+3]);
end;
procedure PackU16BE(Value: Word; out B: array of Byte; Offset: Integer);
begin
B[Offset + 0] := (Value shr 8) and $FF;
B[Offset + 1] := Value and $FF;
end;
function UnpackU16BE(const B: array of Byte; Offset: Integer): Word;
begin
Result := (Word(B[Offset]) shl 8) or Word(B[Offset+1]);
end;
function FreqToPhaseWord(FreqHz: Double): LongWord;
begin
// phase_word = 2^32 * freq / DSP_CLOCK
Result := Round(4294967296.0 * FreqHz / DSP_CLOCK_HZ);
end;
function PhaseWordToFreq(PhaseWord: LongWord): Double;
begin
Result := PhaseWord * DSP_CLOCK_HZ / 4294967296.0;
end;
function ADCToSupplyVolts(RawADC: Word): Double;
begin
// V = ADC / 4095 * 3.3
Result := (RawADC / 4095.0) * 3.3;
end;
function ADCToWatts100(RawADC: Word): Double;
var
V: Double;
begin
// W = (ADC/4095 * 3.3)^2 / 0.095 (ANAN-100, 0-150W range)
V := (RawADC / 4095.0) * 3.3;
Result := (V * V) / 0.095;
end;
function ADCToWatts10(RawADC: Word): Double;
var
V: Double;
begin
// W = (ADC/4095 * 3.3)^2 / 0.09 (ANAN-10, 0-20W range)
V := (RawADC / 4095.0) * 3.3;
Result := (V * V) / 0.09;
end;
end.
+16
View File
@@ -0,0 +1,16 @@
object MainForm: TMainForm
Left = 100
Height = 720
Top = 50
Width = 1280
Caption = 'EWSDR | OpenHPSDR'
Color = clBlack
Font.Color = clSilver
Font.Height = -13
Font.Name = 'Courier New'
Position = poScreenCenter
LCLVersion = '4.6.0.0'
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
end
+3998
View File
File diff suppressed because it is too large Load Diff
+1 -1
View File
@@ -1,2 +1,2 @@
# ewsdr
# EWSDR
+336
View File
@@ -0,0 +1,336 @@
unit Settings;
{
Settings.pas JSON-конфигурация HPSDR SDR приложения.
Структура hpsdr_settings.json:
{ "AA:BB:CC:DD:EE:FF": { "global": {...}, "bands": {"5": {...}} } }
}
{$mode objfpc}{$H+}
interface
uses SysUtils, Classes, fpJSON, jsonparser, jsonscanner;
const
SETTINGS_FILE = 'hpsdr_settings.json';
CFG_BAND_COUNT = 11;
CFG_BAND_DEFAULT_FREQ: array[0..CFG_BAND_COUNT-1] of Double = (
1900000, 3750000, 5357000, 7100000, 10125000,
14200000, 18120000, 21200000, 24940000, 28500000, 50150000);
CFG_BAND_DEFAULT_MODE: array[0..CFG_BAND_COUNT-1] of Integer = (
0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1);
type
TBandSettings = record
VfoA: Double;
VfoB: Double;
Mode: Integer;
FilterIdx: Integer;
FilterBW: Integer;
AGCMode: Integer;
AGCTop: Integer;
CTun: Boolean;
SpanHz: Double;
end;
TGlobalSettings = record
Volume: Integer;
DriveLevel: Integer;
ActiveVfo: Integer;
NREnabled: Boolean;
NBEnabled: Boolean;
ANFEnabled: Boolean;
AGCSlope: Integer;
AGCHangThreshold: Integer;
WfAGCEnabled: Boolean;
WfNFEnabled: Boolean;
LastBand: Integer;
SampleRate: Integer; // глобальный — один для всех диапазонов
WindowLeft: Integer;
WindowTop: Integer;
WindowWidth: Integer;
WindowHeight: Integer;
end;
TSettingsManager = class
private
FFilePath: string;
FRoot: TJSONObject;
function EnsureObj(P: TJSONObject; const K: string): TJSONObject;
function GetDevObj(const M: string): TJSONObject;
function GetGlobalObj(D: TJSONObject): TJSONObject;
function GetBandObj(D: TJSONObject; Idx: Integer): TJSONObject;
function JI(O: TJSONObject; const K: string; Def: Integer): Integer;
function JD(O: TJSONObject; const K: string; Def: Double): Double;
function JB(O: TJSONObject; const K: string; Def: Boolean): Boolean;
procedure JW(O: TJSONObject; const K: string; V: Integer); overload;
procedure JW(O: TJSONObject; const K: string; V: Double); overload;
procedure JW(O: TJSONObject; const K: string; V: Boolean); overload;
public
constructor Create(const FilePath: string = SETTINGS_FILE);
destructor Destroy; override;
procedure Load;
procedure Save;
function LoadDevice(const MAC: array of Byte;
out G: TGlobalSettings;
var Bands: array of TBandSettings): Boolean;
procedure SaveGlobal(const MAC: array of Byte; const G: TGlobalSettings);
procedure SaveBand(const MAC: array of Byte; BandIdx: Integer;
const B: TBandSettings);
function LoadBand(const MAC: array of Byte; BandIdx: Integer;
out B: TBandSettings): Boolean;
class function MacToStr(const MAC: array of Byte): string;
class procedure DefaultBand(BandIdx: Integer; out B: TBandSettings);
class procedure DefaultGlobal(out G: TGlobalSettings);
// Размер окна — не привязан к MAC, хранится в корне JSON
procedure SaveWindowBounds(L, T, W, H: Integer);
procedure LoadWindowBounds(out L, T, W, H: Integer);
end;
implementation
class function TSettingsManager.MacToStr(const MAC: array of Byte): string;
begin
Result := Format('%02X:%02X:%02X:%02X:%02X:%02X',
[MAC[0],MAC[1],MAC[2],MAC[3],MAC[4],MAC[5]]);
end;
class procedure TSettingsManager.DefaultBand(BandIdx: Integer; out B: TBandSettings);
begin
FillChar(B, SizeOf(B), 0);
B.VfoA := CFG_BAND_DEFAULT_FREQ[BandIdx];
B.VfoB := CFG_BAND_DEFAULT_FREQ[BandIdx];
B.Mode := CFG_BAND_DEFAULT_MODE[BandIdx];
B.FilterIdx := 5;
B.FilterBW := 2700;
B.AGCMode := 1;
B.AGCTop := 90;
B.CTun := False;
B.SpanHz := 192000;
end;
class procedure TSettingsManager.DefaultGlobal(out G: TGlobalSettings);
begin
FillChar(G, SizeOf(G), 0);
G.Volume := 70; G.DriveLevel := 50; G.ActiveVfo := 0;
G.AGCSlope := 0; G.AGCHangThreshold := 100; G.LastBand := 5;
G.SampleRate := 192000;
end;
constructor TSettingsManager.Create(const FilePath: string);
begin
inherited Create;
FFilePath := FilePath;
FRoot := TJSONObject.Create;
end;
destructor TSettingsManager.Destroy;
begin
FRoot.Free;
inherited;
end;
procedure TSettingsManager.Load;
var F: TFileStream; P: TJSONParser; D: TJSONData;
begin
if not FileExists(FFilePath) then Exit;
try
F := TFileStream.Create(FFilePath, fmOpenRead or fmShareDenyNone);
try
P := TJSONParser.Create(F, [joUTF8]);
try
D := P.Parse;
if (D <> nil) and (D is TJSONObject) then
begin FRoot.Free; FRoot := TJSONObject(D); end
else
D.Free;
finally P.Free; end;
finally F.Free; end;
except
FreeAndNil(FRoot);
FRoot := TJSONObject.Create;
end;
end;
procedure TSettingsManager.Save;
var
S: string;
F: TFileStream;
Buf: TBytes;
begin
try
S := FRoot.FormatJSON([], 2);
Buf := TEncoding.UTF8.GetBytes(S);
F := TFileStream.Create(FFilePath, fmCreate);
try
if Length(Buf) > 0 then
F.WriteBuffer(Buf[0], Length(Buf));
finally F.Free; end;
except end;
end;
function TSettingsManager.EnsureObj(P: TJSONObject; const K: string): TJSONObject;
var D: TJSONData; Idx: Integer;
begin
D := P.Find(K);
if (D <> nil) and (D is TJSONObject) then
Result := TJSONObject(D)
else
begin
if D <> nil then begin Idx := P.IndexOfName(K); if Idx >= 0 then P.Delete(Idx); end;
Result := TJSONObject.Create;
P.Add(K, Result);
end;
end;
function TSettingsManager.GetDevObj(const M: string): TJSONObject;
begin Result := EnsureObj(FRoot, M); end;
function TSettingsManager.GetGlobalObj(D: TJSONObject): TJSONObject;
begin Result := EnsureObj(D, 'global'); end;
function TSettingsManager.GetBandObj(D: TJSONObject; Idx: Integer): TJSONObject;
begin Result := EnsureObj(EnsureObj(D, 'bands'), IntToStr(Idx)); end;
function TSettingsManager.JI(O: TJSONObject; const K: string; Def: Integer): Integer;
var D: TJSONData;
begin D := O.Find(K); if D<>nil then try Result:=D.AsInteger; except Result:=Def; end else Result:=Def; end;
function TSettingsManager.JD(O: TJSONObject; const K: string; Def: Double): Double;
var D: TJSONData;
begin D := O.Find(K); if D<>nil then try Result:=D.AsFloat; except Result:=Def; end else Result:=Def; end;
function TSettingsManager.JB(O: TJSONObject; const K: string; Def: Boolean): Boolean;
var D: TJSONData;
begin D := O.Find(K); if D<>nil then try Result:=D.AsBoolean; except Result:=Def; end else Result:=Def; end;
procedure TSettingsManager.JW(O: TJSONObject; const K: string; V: Integer);
var Idx: Integer;
begin
Idx := O.IndexOfName(K); if Idx >= 0 then O.Delete(Idx);
O.Add(K, V);
end;
procedure TSettingsManager.JW(O: TJSONObject; const K: string; V: Double);
var Idx: Integer;
begin
Idx := O.IndexOfName(K); if Idx >= 0 then O.Delete(Idx);
O.Add(K, V);
end;
procedure TSettingsManager.JW(O: TJSONObject; const K: string; V: Boolean);
var Idx: Integer;
begin
Idx := O.IndexOfName(K); if Idx >= 0 then O.Delete(Idx);
O.Add(K, V);
end;
function TSettingsManager.LoadDevice(const MAC: array of Byte;
out G: TGlobalSettings;
var Bands: array of TBandSettings): Boolean;
var MacStr: string; DevObj,GObj,BObj: TJSONObject; i: Integer;
begin
MacStr := MacToStr(MAC);
Result := FRoot.Find(MacStr) <> nil;
DevObj := GetDevObj(MacStr);
GObj := GetGlobalObj(DevObj);
G.Volume := JI(GObj,'volume',70);
G.DriveLevel := JI(GObj,'drive_level',50);
G.ActiveVfo := JI(GObj,'active_vfo',0);
G.NREnabled := JB(GObj,'nr_enabled',False);
G.NBEnabled := JB(GObj,'nb_enabled',False);
G.ANFEnabled := JB(GObj,'anf_enabled',False);
G.AGCSlope := JI(GObj,'agc_slope',0);
G.AGCHangThreshold := JI(GObj,'agc_hang_threshold',100);
G.WfAGCEnabled := JB(GObj,'wf_agc_enabled',False);
G.WfNFEnabled := JB(GObj,'wf_nf_enabled',False);
G.LastBand := JI(GObj,'last_band',5);
G.SampleRate := JI(GObj,'sample_rate',192000);
for i := 0 to CFG_BAND_COUNT-1 do
begin
DefaultBand(i, Bands[i]);
BObj := GetBandObj(DevObj, i);
Bands[i].VfoA := JD(BObj,'vfo_a', Bands[i].VfoA);
Bands[i].VfoB := JD(BObj,'vfo_b', Bands[i].VfoB);
Bands[i].Mode := JI(BObj,'mode', Bands[i].Mode);
Bands[i].FilterIdx := JI(BObj,'filter_idx', Bands[i].FilterIdx);
Bands[i].FilterBW := JI(BObj,'filter_bw', Bands[i].FilterBW);
Bands[i].AGCMode := JI(BObj,'agc_mode', Bands[i].AGCMode);
Bands[i].AGCTop := JI(BObj,'agc_top', Bands[i].AGCTop);
Bands[i].CTun := JB(BObj,'ctun', Bands[i].CTun);
Bands[i].SpanHz := JD(BObj,'span_hz', Bands[i].SpanHz);
end;
end;
procedure TSettingsManager.SaveGlobal(const MAC: array of Byte;
const G: TGlobalSettings);
var O: TJSONObject;
begin
O := GetGlobalObj(GetDevObj(MacToStr(MAC)));
JW(O,'volume',G.Volume); JW(O,'drive_level',G.DriveLevel);
JW(O,'active_vfo',G.ActiveVfo);
JW(O,'nr_enabled',G.NREnabled); JW(O,'nb_enabled',G.NBEnabled);
JW(O,'anf_enabled',G.ANFEnabled);
JW(O,'agc_slope',G.AGCSlope);
JW(O,'agc_hang_threshold',G.AGCHangThreshold);
JW(O,'wf_agc_enabled',G.WfAGCEnabled);
JW(O,'wf_nf_enabled',G.WfNFEnabled);
JW(O,'last_band',G.LastBand);
JW(O,'sample_rate',G.SampleRate);
end;
procedure TSettingsManager.SaveBand(const MAC: array of Byte; BandIdx: Integer;
const B: TBandSettings);
var O: TJSONObject;
begin
if (BandIdx < 0) or (BandIdx >= CFG_BAND_COUNT) then Exit;
O := GetBandObj(GetDevObj(MacToStr(MAC)), BandIdx);
JW(O,'vfo_a',B.VfoA); JW(O,'vfo_b',B.VfoB);
JW(O,'mode',B.Mode);
JW(O,'filter_idx',B.FilterIdx); JW(O,'filter_bw',B.FilterBW);
JW(O,'agc_mode',B.AGCMode); JW(O,'agc_top',B.AGCTop);
JW(O,'ctun',B.CTun); JW(O,'span_hz',B.SpanHz);
end;
function TSettingsManager.LoadBand(const MAC: array of Byte; BandIdx: Integer;
out B: TBandSettings): Boolean;
var MacStr: string; O: TJSONObject;
begin
DefaultBand(BandIdx, B);
MacStr := MacToStr(MAC);
Result := FRoot.Find(MacStr) <> nil;
if not Result then Exit;
O := GetBandObj(GetDevObj(MacStr), BandIdx);
B.VfoA := JD(O,'vfo_a', B.VfoA);
B.VfoB := JD(O,'vfo_b', B.VfoB);
B.Mode := JI(O,'mode', B.Mode);
B.FilterIdx := JI(O,'filter_idx', B.FilterIdx);
B.FilterBW := JI(O,'filter_bw', B.FilterBW);
B.AGCMode := JI(O,'agc_mode', B.AGCMode);
B.AGCTop := JI(O,'agc_top', B.AGCTop);
B.CTun := JB(O,'ctun', B.CTun);
B.SpanHz := JD(O,'span_hz', B.SpanHz);
end;
procedure TSettingsManager.SaveWindowBounds(L, T, W, H: Integer);
var O: TJSONObject;
begin
O := EnsureObj(FRoot, 'window');
JW(O, 'left', L);
JW(O, 'top', T);
JW(O, 'width', W);
JW(O, 'height', H);
end;
procedure TSettingsManager.LoadWindowBounds(out L, T, W, H: Integer);
var O: TJSONObject;
begin
L := 80; T := 80; W := 1400; H := 900;
if FRoot.Find('window') = nil then Exit;
O := EnsureObj(FRoot, 'window');
L := JI(O, 'left', 80);
T := JI(O, 'top', 80);
W := JI(O, 'width', 1400);
H := JI(O, 'height', 900);
end;
end.
+476
View File
@@ -0,0 +1,476 @@
unit VfoOverlay;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Graphics, Types, Math;
type
TModeFilterEvent = procedure(Mode: Integer; FilterBW: Integer) of object;
TVfoOverlay = class(TCustomControl)
private
FMode: Integer;
FFilterBW: Integer;
FVfoHz: Double;
FSMeterDB: Double;
FOnSelect: TModeFilterEvent;
FModeFilter: array[0..7] of Integer; // запомненный фильтр для каждого режима
FHitRects: array[0..15] of TRect;
FHitActions: array[0..15] of Integer; // <0 = режим (-1=idx0..), >0 = BW фильтра
FHitCount: Integer;
FHotIdx: Integer;
procedure DrawSelf(C: TCanvas; W, H: Integer);
procedure DrawSMeterBar(C: TCanvas; X, Y, BW, BH: Integer);
procedure DrawModeRow(C: TCanvas; X, Y, RowW, RowH: Integer);
procedure DrawFilterRow(C: TCanvas; X, Y, RowW, RowH: Integer);
procedure RegisterHit(HR: TRect; HV: Integer);
function CalcSLabel: string;
function FormatFreq(Hz: Double): string;
function GetFilterBWForMode(ModeIdx, FilterIdx: Integer): Integer;
function GetFilterLblForMode(ModeIdx, FilterIdx: Integer): string;
function GetFilterCountForMode(ModeIdx: Integer): Integer;
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseLeave; override;
public
constructor Create(AOwner: TComponent); override;
procedure SetState(AMode, ABW: Integer; AVfoHz, ASMeterDB: Double);
procedure UpdateSMeter(DB: Double);
procedure UpdateVfo(AVfoHz: Double);
property OnSelect: TModeFilterEvent read FOnSelect write FOnSelect;
end;
implementation
const
CLR_PANEL_BG = TColor($00141414);
CLR_BORDER = TColor($00505050);
CLR_TEXT = TColor($00E8E8E8);
CLR_DIM = TColor($00787878);
CLR_ACCENT = TColor($0040FF80);
CLR_BTN_NORM = TColor($00282828);
CLR_BTN_HOT = TColor($00383838);
CLR_BTN_ACT = TColor($00183828);
CLR_FREQ = TColor($0050FF80);
CLR_SVAL = TColor($0030C8FF);
CLR_BAR_GRN = TColor($0018A030);
CLR_BAR_RED = TColor($000030C0);
CLR_BAR_BG = TColor($00101010);
// Режимы — ТОЧНО как в MainForm.pas
// 0=LSB, 1=USB, 2=DSB, 3=CWL, 4=CWU, 5=FM, 6=AM, 7=SAM
OVL_MODE_COUNT = 8;
OVL_MODE_NAMES: array[0..7] of string = (
'LSB','USB','DSB','CWL','CWU','FM','AM','SAM');
// Фильтры SSB (LSB=0, USB=1, DSB=2)
SSB_BW: array[0..5] of Integer = (1800,2100,2400,2700,3300,3800);
SSB_LBL: array[0..5] of string = ('1.8K','2.1K','2.4K','2.7K','3.3K','3.8K');
// Фильтры CW (CWL=3, CWU=4)
CW_BW: array[0..5] of Integer = (500,250,100,50,750,1000);
CW_LBL: array[0..5] of string = ('500','250','100','50','750','1K');
// Фильтры FM (FM=5)
FM_BW: array[0..5] of Integer = (20000,15000,12000,10000,8000,5000);
FM_LBL: array[0..5] of string = ('20K','15K','12K','10K','8K','5K');
// Фильтры AM/SAM (AM=6, SAM=7)
AM_BW: array[0..5] of Integer = (8000,6600,5200,4000,3100,12000);
AM_LBL: array[0..5] of string = ('8K','6.6K','5.2K','4K','3.1K','12K');
// S-шкала: S1..S9
DB_S: array[1..9] of Double = (-121,-115,-109,-103,-97,-91,-85,-79,-73);
function TVfoOverlay.GetFilterBWForMode(ModeIdx, FilterIdx: Integer): Integer;
begin
case ModeIdx of
0,1,2: Result := SSB_BW[FilterIdx];
3,4: Result := CW_BW[FilterIdx];
5: Result := FM_BW[FilterIdx];
else Result := AM_BW[FilterIdx]; // 6=AM, 7=SAM
end;
end;
function TVfoOverlay.GetFilterLblForMode(ModeIdx, FilterIdx: Integer): string;
begin
case ModeIdx of
0,1,2: Result := SSB_LBL[FilterIdx];
3,4: Result := CW_LBL[FilterIdx];
5: Result := FM_LBL[FilterIdx];
else Result := AM_LBL[FilterIdx];
end;
end;
function TVfoOverlay.GetFilterCountForMode(ModeIdx: Integer): Integer;
begin
Result := 6; // всегда 6 вариантов фильтра
end;
function DBmToSLabel(DB: Double): string;
var
I, Over: Integer;
begin
if DB >= DB_S[9] then
begin
Over := Round(DB - DB_S[9]);
if Over < 5 then
Result := 'S9'
else
begin
Over := ((Over + 5) div 10) * 10;
if Over = 0 then Over := 10;
Result := 'S9+' + IntToStr(Over);
end;
end
else if DB <= DB_S[1] then
Result := 'S1'
else
begin
Result := 'S1';
for I := 1 to 8 do
if DB >= DB_S[I] then
Result := 'S' + IntToStr(I);
end;
end;
constructor TVfoOverlay.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FMode := 1; // USB по умолчанию (как в MainForm)
FFilterBW := 2700;
FVfoHz := 14200000;
FSMeterDB := -121;
FHitCount := 0;
FHotIdx := -1;
// Дефолтные фильтры для каждого режима (запоминаются при переключении)
FModeFilter[0] := 2700; // LSB
FModeFilter[1] := 2700; // USB
FModeFilter[2] := 2700; // DSB
FModeFilter[3] := 500; // CWL
FModeFilter[4] := 500; // CWU
FModeFilter[5] := 15000; // FM
FModeFilter[6] := 8000; // AM
FModeFilter[7] := 8000; // SAM
Width := 260; // шире — 8 кнопок режимов
Height := 130;
Cursor := crHandPoint;
end;
procedure TVfoOverlay.RegisterHit(HR: TRect; HV: Integer);
begin
if FHitCount > High(FHitRects) then Exit;
FHitRects[FHitCount] := HR;
FHitActions[FHitCount] := HV;
Inc(FHitCount);
end;
function TVfoOverlay.FormatFreq(Hz: Double): string;
var
iM, iK, iH: Integer;
begin
iM := Trunc(Hz / 1e6);
iK := Trunc((Hz - iM * 1e6) / 1000);
iH := Round(Hz - iM * 1e6 - iK * 1000);
Result := Format('%d.%3.3d.%3.3d', [iM, iK, iH]);
end;
function TVfoOverlay.CalcSLabel: string;
begin
Result := DBmToSLabel(FSMeterDB);
end;
procedure TVfoOverlay.DrawSMeterBar(C: TCanvas; X, Y, BW, BH: Integer);
const
DB_MIN = -127.0;
DB_MAX = -13.0;
S_POS: array[0..7] of Double = (-121,-109,-97,-85,-73,-53,-33,-13);
S_LBL: array[0..7] of string = ('1','3','5','7','S9','+20','+40','+60');
var
I, BarEnd, S9X, PX, BarH: Integer;
T: Double;
Lbl: string;
TW: Integer;
begin
BarH := BH - 11;
C.Brush.Color := CLR_BAR_BG;
C.Brush.Style := bsSolid;
C.Pen.Style := psClear;
C.FillRect(Rect(X, Y, X+BW, Y+BarH));
S9X := X + Round((-73 - DB_MIN) / (DB_MAX - DB_MIN) * BW);
T := Max(0.0, Min(1.0, (FSMeterDB - DB_MIN) / (DB_MAX - DB_MIN)));
BarEnd := X + Round(T * BW);
if BarEnd > X + 1 then
begin
if BarEnd <= S9X then
begin
C.Brush.Color := CLR_BAR_GRN;
C.FillRect(Rect(X+1, Y+1, BarEnd, Y+BarH-1));
end
else
begin
C.Brush.Color := CLR_BAR_GRN;
C.FillRect(Rect(X+1, Y+1, S9X, Y+BarH-1));
C.Brush.Color := CLR_BAR_RED;
C.FillRect(Rect(S9X, Y+1, Min(BarEnd, X+BW-1), Y+BarH-1));
end;
end;
C.Pen.Style := psSolid;
C.Pen.Color := CLR_BORDER;
C.Brush.Style := bsClear;
C.Rectangle(X, Y, X+BW, Y+BarH);
C.Font.Name := 'Courier New';
C.Font.Size := 5;
C.Font.Style := [];
for I := 0 to High(S_POS) do
begin
T := (S_POS[I] - DB_MIN) / (DB_MAX - DB_MIN);
PX := X + Round(T * BW);
Lbl := S_LBL[I];
TW := C.TextWidth(Lbl);
if I < 4 then C.Font.Color := CLR_DIM
else C.Font.Color := CLR_ACCENT;
C.Pen.Color := CLR_DIM;
C.Pen.Style := psSolid;
C.MoveTo(PX, Y+BarH); C.LineTo(PX, Y+BarH+2);
C.TextOut(PX - TW div 2, Y+BarH+2, Lbl);
end;
end;
procedure TVfoOverlay.DrawModeRow(C: TCanvas; X, Y, RowW, RowH: Integer);
var
I, BtnW, BX: Integer;
HR: TRect;
IsAct, IsHot: Boolean;
begin
BtnW := (RowW - (OVL_MODE_COUNT - 1)) div OVL_MODE_COUNT;
for I := 0 to OVL_MODE_COUNT - 1 do
begin
BX := X + I * (BtnW + 1);
HR := Rect(BX, Y, BX + BtnW, Y + RowH);
IsAct := (I = FMode);
IsHot := (FHotIdx >= 0) and (FHitActions[FHotIdx] = -(I + 1));
if IsAct then C.Brush.Color := CLR_BTN_ACT
else if IsHot then C.Brush.Color := CLR_BTN_HOT
else C.Brush.Color := CLR_BTN_NORM;
C.Brush.Style := bsSolid; C.Pen.Style := psClear;
C.FillRect(HR);
C.Pen.Style := psSolid; C.Pen.Color := CLR_BORDER;
C.Brush.Style := bsClear; C.Rectangle(HR);
if IsAct then C.Font.Color := CLR_ACCENT
else C.Font.Color := CLR_TEXT;
C.Font.Size := 6; C.Font.Style := []; C.Font.Name := 'Courier New';
C.Brush.Style := bsClear;
C.TextOut(BX + (BtnW - C.TextWidth(OVL_MODE_NAMES[I])) div 2,
Y + (RowH - C.TextHeight('A')) div 2,
OVL_MODE_NAMES[I]);
RegisterHit(HR, -(I + 1)); // -1=LSB, -2=USB, -3=DSB, -4=CWL, -5=CWU, -6=FM, -7=AM, -8=SAM
end;
end;
procedure TVfoOverlay.DrawFilterRow(C: TCanvas; X, Y, RowW, RowH: Integer);
const
FILT_COUNT = 6;
var
I, BtnW, BX, BV: Integer;
HR: TRect;
Lbl: string;
IsAct: Boolean;
begin
BtnW := (RowW - (FILT_COUNT - 1)) div FILT_COUNT;
for I := 0 to FILT_COUNT - 1 do
begin
BX := X + I * (BtnW + 1);
HR := Rect(BX, Y, BX + BtnW, Y + RowH);
BV := GetFilterBWForMode(FMode, I);
IsAct := (BV = FFilterBW);
Lbl := GetFilterLblForMode(FMode, I);
if IsAct then C.Brush.Color := CLR_BTN_ACT
else if (FHotIdx >= 0) and (FHitActions[FHotIdx] = BV) then
C.Brush.Color := CLR_BTN_HOT
else C.Brush.Color := CLR_BTN_NORM;
C.Brush.Style := bsSolid; C.Pen.Style := psClear;
C.FillRect(HR);
C.Pen.Style := psSolid; C.Pen.Color := CLR_BORDER;
C.Brush.Style := bsClear; C.Rectangle(HR);
if IsAct then C.Font.Color := CLR_ACCENT
else C.Font.Color := CLR_TEXT;
C.Font.Size := 7; C.Font.Name := 'Courier New';
C.Brush.Style := bsClear;
C.TextOut(BX + (BtnW - C.TextWidth(Lbl)) div 2,
Y + (RowH - C.TextHeight('A')) div 2, Lbl);
RegisterHit(HR, BV); // BV всегда > 0 (BW в Гц, минимум 25)
end;
end;
procedure TVfoOverlay.DrawSelf(C: TCanvas; W, H: Integer);
const
PAD = 4;
FREQ_H = 18;
INFO_H = 14;
SM_H = 27;
ROW_H = 20;
GAP = 3;
var
FreqStr, SStr: string;
FW, CurY: Integer;
begin
FHitCount := 0;
C.Brush.Color := CLR_PANEL_BG;
C.Brush.Style := bsSolid;
C.Pen.Color := CLR_BORDER;
C.Pen.Style := psSolid;
C.Pen.Width := 1;
C.RoundRect(0, 0, W, H, 6, 6);
CurY := PAD;
// Частота
FreqStr := FormatFreq(FVfoHz);
C.Font.Name := 'Courier New'; C.Font.Size := 11; C.Font.Style := [fsBold];
C.Font.Color := CLR_FREQ;
FW := C.TextWidth(FreqStr);
C.Brush.Style := bsClear;
C.TextOut((W - FW) div 2, CurY, FreqStr);
Inc(CurY, FREQ_H);
// Режим (слева) + S-value (справа)
SStr := CalcSLabel;
C.Font.Size := 8; C.Font.Style := [fsBold];
C.Font.Color := CLR_ACCENT;
C.TextOut(PAD + 2, CurY, OVL_MODE_NAMES[FMode]);
C.Font.Color := CLR_SVAL;
C.TextOut(W - PAD - C.TextWidth(SStr) - 2, CurY, SStr);
Inc(CurY, INFO_H);
// S-метр
DrawSMeterBar(C, PAD, CurY, W - PAD * 2, SM_H);
Inc(CurY, SM_H + GAP);
// Кнопки режимов
DrawModeRow(C, PAD, CurY, W - PAD * 2, ROW_H);
Inc(CurY, ROW_H + GAP);
// Кнопки фильтров
DrawFilterRow(C, PAD, CurY, W - PAD * 2, ROW_H);
end;
procedure TVfoOverlay.Paint;
begin
DrawSelf(Canvas, Width, Height);
end;
procedure TVfoOverlay.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
I, HV, NewMode, NewBW: Integer;
begin
inherited;
if Button <> mbLeft then Exit;
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(X, Y)) then
begin
HV := FHitActions[I];
if HV < 0 then
begin
NewMode := (-HV) - 1;
if NewMode <> FMode then
begin
// Сохраняем текущий фильтр для старого режима
FModeFilter[FMode] := FFilterBW;
FMode := NewMode;
// Восстанавливаем запомненный фильтр для нового режима
FFilterBW := FModeFilter[FMode];
Invalidate;
if Assigned(FOnSelect) then FOnSelect(FMode, FFilterBW);
end;
end
else if HV > 0 then
begin
NewBW := HV;
if NewBW <> FFilterBW then
begin
FFilterBW := NewBW;
// Запоминаем выбранный фильтр для текущего режима
FModeFilter[FMode] := FFilterBW;
Invalidate;
if Assigned(FOnSelect) then FOnSelect(FMode, FFilterBW);
end;
end;
Break;
end;
end;
procedure TVfoOverlay.MouseMove(Shift: TShiftState; X, Y: Integer);
var
I, OldHot: Integer;
begin
inherited;
OldHot := FHotIdx; FHotIdx := -1;
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(X, Y)) then
begin FHotIdx := I; Break; end;
if FHotIdx <> OldHot then Invalidate;
end;
procedure TVfoOverlay.MouseLeave;
begin
inherited;
if FHotIdx >= 0 then begin FHotIdx := -1; Invalidate; end;
end;
procedure TVfoOverlay.SetState(AMode, ABW: Integer; AVfoHz, ASMeterDB: Double);
begin
FMode := Max(0, Min(OVL_MODE_COUNT - 1, AMode));
FFilterBW := ABW;
// Синхронизируем память фильтра для текущего режима
FModeFilter[FMode] := ABW;
FVfoHz := AVfoHz;
FSMeterDB := ASMeterDB;
Invalidate;
end;
procedure TVfoOverlay.UpdateSMeter(DB: Double);
begin
// Не клипаем — передаём как есть, как в основном S-метре
if Abs(DB - FSMeterDB) > 0.4 then
begin
FSMeterDB := DB;
Invalidate;
end;
end;
procedure TVfoOverlay.UpdateVfo(AVfoHz: Double);
begin
if FVfoHz <> AVfoHz then
begin
FVfoHz := AVfoHz;
Invalidate;
end;
end;
end.
+941
View File
@@ -0,0 +1,941 @@
unit WDSP;
{
Pascal/Lazarus binding for the WDSP (Wideband DSP) library.
Автоматически переведено из заголовочного файла wdsp.h.
Использование:
1. Поместите wdsp.dll (Linux: libwdsp.so) рядом с исполняемым файлом.
2. Подключите unit в секции uses: uses WDSP;
3. Вызывайте функции напрямую, например: OpenChannel(0, 1024, ...);
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
// Если wdsp.dll / libwdsp.so отсутствует — функции будут nil вместо краша.
// WDSPEngine.Open вернёт False и программа продолжит работу в демо-режиме.
{$IFDEF FPC}
{$WEAKEXTERNALSYMBOLS ON}
{$ENDIF}
interface
uses
SysUtils;
const
{$IFDEF WINDOWS}
WDSP_LIB = 'wdsp.dll';
{$ELSE}
WDSP_LIB = 'libwdsp.so';
{$ENDIF}
// Analyzer detector modes
DETECTOR_MODE_PEAK = 0;
DETECTOR_MODE_ROSENFELL = 1;
DETECTOR_MODE_AVERAGE = 2;
DETECTOR_MODE_SAMPLE = 3;
DETECTOR_MODE_RMS = 4;
// Average hold/modes
AVERAGE_PEAK_HOLD = -1;
AVERAGE_MODE_NONE = 0;
AVERAGE_MODE_RECURSIVE = 1;
AVERAGE_MODE_TIME_WINDOW = 2;
AVERAGE_MODE_LOG_RECURSIVE = 3;
type
INREAL = Single;
OUTREAL = Single;
dINREAL = Single;
dOUTREAL = Single;
PDWORD = ^DWORD;
PINREAl = ^INREAL;
POUTREAl = ^OUTREAL;
PdINREAL = ^dINREAL;
PdOUTREAL = ^dOUTREAL;
PDouble = ^Double;
PInteger = ^Integer;
PSingle = ^Single;
PPDouble = ^PDouble;
PPSingle = ^PSingle;
PPVoid = ^Pointer;
// Opaque pointers (void* in C)
TEER = Pointer;
TANB = Pointer;
TNOB = Pointer;
TRESAMPLE = Pointer;
TGAIN = Pointer;
TLPCRITICAL_SECTION = Pointer;
// RXA Meter types
TrxaMeterType = (
RXA_S_PK,
RXA_S_AV,
RXA_ADC_PK,
RXA_ADC_AV,
RXA_AGC_GAIN,
RXA_AGC_PK,
RXA_AGC_AV,
RXA_METERTYPE_LAST
);
// TXA Meter types
TtxaMeterType = (
TXA_MIC_PK,
TXA_MIC_AV,
TXA_EQ_PK,
TXA_EQ_AV,
TXA_LVLR_PK,
TXA_LVLR_AV,
TXA_LVLR_GAIN,
TXA_CFC_PK,
TXA_CFC_AV,
TXA_CFC_GAIN,
TXA_COMP_PK,
TXA_COMP_AV,
TXA_ALC_PK,
TXA_ALC_AV,
TXA_ALC_GAIN,
TXA_OUT_PK,
TXA_OUT_AV,
TXA_METERTYPE_LAST
);
// Callback type for DEXP VOX push
TPushVoxProc = procedure(id: Integer; active: Integer); cdecl;
// ---------------------------------------------------------------------------
// RXA.c
// ---------------------------------------------------------------------------
procedure SetRXAMode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure RXASetPassband(channel: Integer; f_low: Double; f_high: Double); cdecl; external WDSP_LIB;
procedure RXASetNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure RXASetMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// TXA.c
// ---------------------------------------------------------------------------
procedure SetTXAMode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetTXABandpassFreqs(channel: Integer; f_low: Double; f_high: Double); cdecl; external WDSP_LIB;
procedure TXASetNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure TXASetMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetTXAFMAFFilter(channel: Integer; low: Double; high: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// amd.c
// ---------------------------------------------------------------------------
procedure SetRXAAMDRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAAMDSBMode(channel: Integer; sbmode: Integer); cdecl; external WDSP_LIB;
procedure SetRXAAMDFadeLevel(channel: Integer; levelfade: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// ammod.c
// ---------------------------------------------------------------------------
procedure SetTXAAMCarrierLevel(channel: Integer; c_level: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// amsq.c
// ---------------------------------------------------------------------------
procedure SetRXAAMSQRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAAMSQThreshold(channel: Integer; threshold: Double); cdecl; external WDSP_LIB;
procedure SetRXAAMSQMaxTail(channel: Integer; tail: Double); cdecl; external WDSP_LIB;
procedure SetTXAAMSQRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXAAMSQMutedGain(channel: Integer; dBlevel: Double); cdecl; external WDSP_LIB;
procedure SetTXAAMSQThreshold(channel: Integer; threshold: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// analyzer.c
// ---------------------------------------------------------------------------
procedure SetupDetectMaxBin(run: Integer; disp: Integer; ss: Integer; LO: Integer;
rate: Double; fLow: Double; fHigh: Double; tau: Double; frame_rate: Integer); cdecl; external WDSP_LIB;
function GetDetectMaxBin(disp: Integer): Double; cdecl; external WDSP_LIB;
procedure XCreateAnalyzer(disp: Integer; success: PInteger; m_size: Integer;
m_num_fft: Integer; m_stitch: Integer; app_data_path: PAnsiChar); cdecl; external WDSP_LIB;
procedure DestroyAnalyzer(disp: Integer); cdecl; external WDSP_LIB;
procedure GetPixels(disp: Integer; pixout: Integer; pix: PdOUTREAL; flag: PInteger); cdecl; external WDSP_LIB;
procedure SnapSpectrum(disp: Integer; ss: Integer; LO: Integer; snap_buff: PDouble); cdecl; external WDSP_LIB;
procedure SnapSpectrumTimeout(disp: Integer; ss: Integer; LO: Integer;
snap_buff: PDouble; timeout: DWORD; flag: PInteger); cdecl; external WDSP_LIB;
// SetCalibration: cal is pointer to array of [n_points][dMAX_M+1] doubles
procedure SetCalibration(disp: Integer; set_num: Integer; n_points: Integer;
cal: PDouble); cdecl; external WDSP_LIB;
procedure OpenBuffer(disp: Integer; ss: Integer; LO: Integer;
Ipointer: PPVoid; Qpointer: PPVoid); cdecl; external WDSP_LIB;
procedure CloseBuffer(disp: Integer; ss: Integer; LO: Integer); cdecl; external WDSP_LIB;
procedure Spectrum(disp: Integer; ss: Integer; LO: Integer;
pI: PdINREAL; pQ: PdINREAL); cdecl; external WDSP_LIB;
procedure Spectrum2(run: Integer; disp: Integer; ss: Integer; LO: Integer;
pbuff: PdINREAL); cdecl; external WDSP_LIB;
procedure Spectrum0(run: Integer; disp: Integer; ss: Integer; LO: Integer;
pbuff: PDouble); cdecl; external WDSP_LIB;
procedure SetDisplayDetectorMode(disp: Integer; pixout: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetDisplayAverageMode(disp: Integer; pixout: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetDisplayNumAverage(disp: Integer; pixout: Integer; num: Integer); cdecl; external WDSP_LIB;
procedure SetDisplayAvBackmult(disp: Integer; pixout: Integer; mult: Double); cdecl; external WDSP_LIB;
procedure SetDisplaySampleRate(disp: Integer; rate: Integer); cdecl; external WDSP_LIB;
procedure SetDisplayNormOneHz(disp: Integer; pixout: Integer; norm: Integer); cdecl; external WDSP_LIB;
// SetAnalyzer — главная функция настройки анализатора (см. WDSP Guide §SetAnalyzer)
// void SetAnalyzer(disp, n_pixout, n_fft, typ, flp, sz, bf_sz, win_type,
// pi, ovrlp, clp, fscLin, fscHin, n_pix, n_stch,
// calset, fmin, fmax, max_w)
procedure SetAnalyzer(disp: Integer; n_pixout: Integer; n_fft: Integer;
typ: Integer; flp: PInteger; sz: Integer; bf_sz: Integer;
win_type: Integer; pi: Double; ovrlp: Integer; clp: Integer;
fscLin: Double; fscHin: Double; n_pix: Integer;
n_stch: Integer; calset: Integer; fmin: Double;
fmax: Double; max_w: Integer); cdecl; external WDSP_LIB;
procedure ResetPixelBuffers(disp: Integer); cdecl; external WDSP_LIB;
function GetDisplayENB(disp: Integer): Double; cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// anf.c
// ---------------------------------------------------------------------------
procedure SetRXAANFRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAANFVals(channel: Integer; taps: Integer; delay: Integer;
gain: Double; leakage: Double); cdecl; external WDSP_LIB;
procedure SetRXAANFTaps(channel: Integer; taps: Integer); cdecl; external WDSP_LIB;
procedure SetRXAANFDelay(channel: Integer; delay: Integer); cdecl; external WDSP_LIB;
procedure SetRXAANFGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetRXAANFLeakage(channel: Integer; leakage: Double); cdecl; external WDSP_LIB;
procedure SetRXAANFPosition(channel: Integer; position: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// anr.c
// ---------------------------------------------------------------------------
procedure SetRXAANRRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAANRVals(channel: Integer; taps: Integer; delay: Integer;
gain: Double; leakage: Double); cdecl; external WDSP_LIB;
procedure SetRXAANRTaps(channel: Integer; taps: Integer); cdecl; external WDSP_LIB;
procedure SetRXAANRDelay(channel: Integer; delay: Integer); cdecl; external WDSP_LIB;
procedure SetRXAANRGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetRXAANRLeakage(channel: Integer; leakage: Double); cdecl; external WDSP_LIB;
procedure SetRXAANRPosition(channel: Integer; position: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// apfshadow.c (SPCW / Synchronous Peak CW filter)
// ---------------------------------------------------------------------------
procedure SetRXASPCWSelection(channel: Integer; selection: Integer); cdecl; external WDSP_LIB;
procedure SetRXASPCWRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXASPCWFreq(channel: Integer; f_center: Double); cdecl; external WDSP_LIB;
procedure SetRXASPCWBandwidth(channel: Integer; bandwidth: Double); cdecl; external WDSP_LIB;
procedure SetRXASPCWGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// bandpass.c
// ---------------------------------------------------------------------------
procedure SetRXABPSRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXABPSFreqs(channel: Integer; f_low: Double; f_high: Double); cdecl; external WDSP_LIB;
procedure SetRXABPSWindow(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure SetTXABPSRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXABPSFreqs(channel: Integer; f_low: Double; f_high: Double); cdecl; external WDSP_LIB;
procedure SetTXABPSWindow(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure SetRXABandpassRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXABandpassFreqs(channel: Integer; f_low: Double; f_high: Double); cdecl; external WDSP_LIB;
procedure SetRXABandpassWindow(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure SetRXABandpassNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetRXABandpassMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetTXABandpassRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXABandpassWindow(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure SetTXABandpassNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetTXABandpassMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// calcc.c (Predistortion / PA calibration)
// ---------------------------------------------------------------------------
procedure pscc(channel: Integer; size: Integer; tx: PDouble; rx: PDouble); cdecl; external WDSP_LIB;
procedure psccF(channel: Integer; size: Integer; Itxbuff: PSingle; Qtxbuff: PSingle;
Irxbuff: PSingle; Qrxbuff: PSingle; mox: Integer; solidmox: Integer); cdecl; external WDSP_LIB;
procedure PSSaveCorr(channel: Integer; filename: PAnsiChar); cdecl; external WDSP_LIB;
procedure PSRestoreCorr(channel: Integer; filename: PAnsiChar); cdecl; external WDSP_LIB;
procedure SetPSRunCal(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetPSMox(channel: Integer; mox: Integer); cdecl; external WDSP_LIB;
procedure GetPSInfo(channel: Integer; info: PInteger); cdecl; external WDSP_LIB;
procedure SetPSReset(channel: Integer; reset: Integer); cdecl; external WDSP_LIB;
procedure SetPSMancal(channel: Integer; mancal: Integer); cdecl; external WDSP_LIB;
procedure SetPSAutomode(channel: Integer; automode: Integer); cdecl; external WDSP_LIB;
procedure SetPSTurnon(channel: Integer; turnon: Integer); cdecl; external WDSP_LIB;
procedure SetPSControl(channel: Integer; reset: Integer; mancal: Integer;
automode: Integer; turnon: Integer); cdecl; external WDSP_LIB;
procedure SetPSLoopDelay(channel: Integer; delay: Double); cdecl; external WDSP_LIB;
procedure SetPSMoxDelay(channel: Integer; delay: Double); cdecl; external WDSP_LIB;
function SetPSTXDelay(channel: Integer; delay: Double): Double; cdecl; external WDSP_LIB;
procedure SetPSHWPeak(channel: Integer; peak: Double); cdecl; external WDSP_LIB;
procedure GetPSHWPeak(channel: Integer; peak: PDouble); cdecl; external WDSP_LIB;
procedure GetPSMaxTX(channel: Integer; maxtx: PDouble); cdecl; external WDSP_LIB;
procedure SetPSPtol(channel: Integer; ptol: Double); cdecl; external WDSP_LIB;
procedure GetPSDisp(channel: Integer; x: PDouble; ym: PDouble; yc: PDouble;
ys: PDouble; cm: PDouble; cc: PDouble; cs: PDouble); cdecl; external WDSP_LIB;
procedure SetPSFeedbackRate(channel: Integer; rate: Integer); cdecl; external WDSP_LIB;
procedure SetPSPinMode(channel: Integer; pin: Integer); cdecl; external WDSP_LIB;
procedure SetPSMapMode(channel: Integer; map: Integer); cdecl; external WDSP_LIB;
procedure SetPSStabilize(channel: Integer; stbl: Integer); cdecl; external WDSP_LIB;
procedure SetPSIntsAndSpi(channel: Integer; ints: Integer; spi: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// cblock.c
// ---------------------------------------------------------------------------
procedure SetRXACBLRun(channel: Integer; setit: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// cfcomp.c
// ---------------------------------------------------------------------------
procedure SetTXACFCOMPRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXACFCOMPPosition(channel: Integer; pos: Integer); cdecl; external WDSP_LIB;
procedure SetTXACFCOMPprofile(channel: Integer; nfreqs: Integer;
F: PDouble; G: PDouble; E: PDouble); cdecl; external WDSP_LIB;
procedure SetTXACFCOMPPrecomp(channel: Integer; precomp: Double); cdecl; external WDSP_LIB;
procedure SetTXACFCOMPPeqRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXACFCOMPPrePeq(channel: Integer; prepeq: Double); cdecl; external WDSP_LIB;
procedure GetTXACFCOMPDisplayCompression(channel: Integer;
comp_values: PDouble; ready: PInteger); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// cfir.c
// ---------------------------------------------------------------------------
procedure SetTXACFIRRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXACFIRNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// channel.c
// ---------------------------------------------------------------------------
procedure OpenChannel(channel: Integer; in_size: Integer; dsp_size: Integer;
input_samplerate: Integer; dsp_rate: Integer; output_samplerate: Integer;
atype: Integer; state: Integer; tdelayup: Double; tslewup: Double;
tdelaydown: Double; tslewdown: Double; bfo: Integer); cdecl; external WDSP_LIB;
procedure CloseChannel(channel: Integer); cdecl; external WDSP_LIB;
procedure SetType(channel: Integer; atype: Integer); cdecl; external WDSP_LIB;
procedure SetInputBuffsize(channel: Integer; in_size: Integer); cdecl; external WDSP_LIB;
procedure SetDSPBuffsize(channel: Integer; dsp_size: Integer); cdecl; external WDSP_LIB;
procedure SetInputSamplerate(channel: Integer; in_rate: Integer); cdecl; external WDSP_LIB;
procedure SetDSPSamplerate(channel: Integer; dsp_rate: Integer); cdecl; external WDSP_LIB;
procedure SetOutputSamplerate(channel: Integer; out_rate: Integer); cdecl; external WDSP_LIB;
procedure SetAllRates(channel: Integer; in_rate: Integer; dsp_rate: Integer;
out_rate: Integer); cdecl; external WDSP_LIB;
function SetChannelState(channel: Integer; state: Integer; dmode: Integer): Integer; cdecl; external WDSP_LIB;
procedure SetChannelTDelayUp(channel: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetChannelTSlewUp(channel: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetChannelTDelayDown(channel: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetChannelTSlewDown(channel: Integer; time: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// compress.c
// ---------------------------------------------------------------------------
procedure SetTXACompressorRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXACompressorGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// dexp.c (Downward EXPander / VOX gate)
// ---------------------------------------------------------------------------
procedure create_dexp(id: Integer; run_dexp: Integer; size: Integer;
ain: PDouble; aout: PDouble; rate: Integer; dettau: Double;
tattack: Double; tdecay: Double; thold: Double; exp_ratio: Double;
hyst_ratio: Double; attack_thresh: Double; nc: Integer; wtype: Integer;
lowcut: Double; highcut: Double; run_filt: Integer; run_vox: Integer;
run_audelay: Integer; audelay: Double; pushvox: TPushVoxProc;
antivox_run: Integer; antivox_size: Integer; antivox_rate: Integer;
antivox_gain: Double; antivox_tau: Double); cdecl; external WDSP_LIB;
procedure destroy_dexp(id: Integer); cdecl; external WDSP_LIB;
procedure flush_dexp(id: Integer); cdecl; external WDSP_LIB;
procedure xdexp(id: Integer); cdecl; external WDSP_LIB;
procedure SendCBPushDexpVox(id: Integer; pushvox: TPushVoxProc); cdecl; external WDSP_LIB;
procedure SetDEXPRun(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetDEXPSize(id: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure SetDEXPIOBuffers(id: Integer; ain: PDouble; aout: PDouble); cdecl; external WDSP_LIB;
procedure SetDEXPRate(id: Integer; rate: Double); cdecl; external WDSP_LIB;
procedure SetDEXPDetectorTau(id: Integer; tau: Double); cdecl; external WDSP_LIB;
procedure SetDEXPAttackTime(id: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetDEXPReleaseTime(id: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetDEXPHoldTime(id: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetDEXPExpansionRatio(id: Integer; ratio: Double); cdecl; external WDSP_LIB;
procedure SetDEXPHysteresisRatio(id: Integer; ratio: Double); cdecl; external WDSP_LIB;
procedure SetDEXPAttackThreshold(id: Integer; thresh: Double); cdecl; external WDSP_LIB;
procedure SetDEXPFilterTaps(id: Integer; taps: Integer); cdecl; external WDSP_LIB;
procedure SetDEXPWindowType(id: Integer; atype: Integer); cdecl; external WDSP_LIB;
procedure SetDEXPLowCut(id: Integer; lowcut: Double); cdecl; external WDSP_LIB;
procedure SetDEXPHighCut(id: Integer; highcut: Double); cdecl; external WDSP_LIB;
procedure SetDEXPRunSideChannelFilter(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetDEXPRunVox(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetDEXPRunAudioDelay(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetDEXPAudioDelay(id: Integer; delay: Double); cdecl; external WDSP_LIB;
procedure GetDEXPPeakSignal(id: Integer; peak: PDouble); cdecl; external WDSP_LIB;
procedure SetAntiVOXRun(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetAntiVOXSize(id: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure SetAntiVOXRate(id: Integer; rate: Double); cdecl; external WDSP_LIB;
procedure SetAntiVOXGain(id: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetAntiVOXDetectorTau(id: Integer; tau: Double); cdecl; external WDSP_LIB;
procedure SendAntiVOXData(id: Integer; nsamples: Integer; data: PDouble); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// div.c (Diversity combining)
// ---------------------------------------------------------------------------
procedure create_divEXT(id: Integer; run: Integer; nr: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure destroy_divEXT(id: Integer); cdecl; external WDSP_LIB;
procedure flush_divEXT(id: Integer); cdecl; external WDSP_LIB;
procedure xdivEXT(id: Integer; nsamples: Integer; ain: PPDouble; aout: PDouble); cdecl; external WDSP_LIB;
procedure SetEXTDIVRun(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetEXTDIVBuffsize(id: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure SetEXTDIVNr(id: Integer; nr: Integer); cdecl; external WDSP_LIB;
procedure SetEXTDIVOutput(id: Integer; output: Integer); cdecl; external WDSP_LIB;
procedure SetEXTDIVRotate(id: Integer; nr: Integer;
Irotate: PDouble; Qrotate: PDouble); cdecl; external WDSP_LIB;
procedure xdivEXTF(id: Integer; size: Integer; input: PPSingle;
Iout: PSingle; Qout: PSingle); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// doublepole.c
// ---------------------------------------------------------------------------
procedure SetRXADoublepoleRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXADoublepoleFreqs(channel: Integer; f_center: Double; bandwidth: Double); cdecl; external WDSP_LIB;
procedure SetRXADoublepoleGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// eer.c (Envelope Elimination and Restoration)
// ---------------------------------------------------------------------------
function create_eer(run: Integer; size: Integer; ain: PDouble; aout: PDouble;
outM: PDouble; rate: Integer; mgain: Double; pgain: Double;
rundelays: Integer; mdelay: Double; pdelay: Double; amiq: Integer): TEER; cdecl; external WDSP_LIB;
procedure destroy_eer(a: TEER); cdecl; external WDSP_LIB;
procedure flush_eer(a: TEER); cdecl; external WDSP_LIB;
procedure xeer(a: TEER); cdecl; external WDSP_LIB;
procedure create_eerEXT(id: Integer; run: Integer; size: Integer; rate: Integer;
mgain: Double; pgain: Double; rundelays: Integer; mdelay: Double;
pdelay: Double; amiq: Integer); cdecl; external WDSP_LIB;
procedure destroy_eerEXT(id: Integer); cdecl; external WDSP_LIB;
procedure flush_eerEXT(id: Integer); cdecl; external WDSP_LIB;
procedure SetEERRun(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetEERAMIQ(id: Integer; amiq: Integer); cdecl; external WDSP_LIB;
procedure SetEERMgain(id: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetEERPgain(id: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetEERRunDelays(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetEERMdelay(id: Integer; delay: Double); cdecl; external WDSP_LIB;
procedure SetEERPdelay(id: Integer; delay: Double); cdecl; external WDSP_LIB;
procedure SetEERSize(id: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure SetEERSamplerate(id: Integer; rate: Integer); cdecl; external WDSP_LIB;
procedure pSetEERRun(a: TEER; run: Integer); cdecl; external WDSP_LIB;
procedure pSetEERAMIQ(a: TEER; amiq: Integer); cdecl; external WDSP_LIB;
procedure pSetEERMgain(a: TEER; gain: Double); cdecl; external WDSP_LIB;
procedure pSetEERPgain(a: TEER; gain: Double); cdecl; external WDSP_LIB;
procedure pSetEERRunDelays(a: TEER; run: Integer); cdecl; external WDSP_LIB;
procedure pSetEERMdelay(a: TEER; delay: Double); cdecl; external WDSP_LIB;
procedure pSetEERPdelay(a: TEER; delay: Double); cdecl; external WDSP_LIB;
procedure pSetEERSize(a: TEER; size: Integer); cdecl; external WDSP_LIB;
procedure pSetEERSamplerate(a: TEER; rate: Integer); cdecl; external WDSP_LIB;
procedure xeerEXTF(id: Integer; inI: PSingle; inQ: PSingle; outI: PSingle;
outQ: PSingle; outMI: PSingle; outMQ: PSingle; mox: Integer; size: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// emnr.c (Enhanced Minimum Noise Reduction)
// ---------------------------------------------------------------------------
procedure SetRXAEMNRpost2Run(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEMNRpost2Factor(channel: Integer; factor: Double); cdecl; external WDSP_LIB;
procedure SetRXAEMNRpost2Nlevel(channel: Integer; nlevel: Double); cdecl; external WDSP_LIB;
procedure SetRXAEMNRpost2Taper(channel: Integer; taper: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEMNRpost2Rate(channel: Integer; tc: Double); cdecl; external WDSP_LIB;
procedure SetRXAEMNRRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEMNRgainMethod(channel: Integer; method: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEMNRnpeMethod(channel: Integer; method: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEMNRaeRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEMNRPosition(channel: Integer; position: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEMNRaeZetaThresh(channel: Integer; zetathresh: Double); cdecl; external WDSP_LIB;
procedure SetRXAEMNRaePsi(channel: Integer; psi: Double); cdecl; external WDSP_LIB;
procedure SetRXAEMNRtrainZetaThresh(channel: Integer; thresh: Double); cdecl; external WDSP_LIB;
procedure SetRXAEMNRtrainT2(channel: Integer; t2: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// emph.c (FM Pre/De-emphasis)
// ---------------------------------------------------------------------------
procedure SetTXAFMEmphPosition(channel: Integer; position: Integer); cdecl; external WDSP_LIB;
procedure SetTXAFMEmphMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetTXAFMEmphNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetTXAFMPreEmphFreqs(channel: Integer; low: Double; high: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// eq.c (Equalizer)
// ---------------------------------------------------------------------------
procedure SetRXAEQRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEQNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEQMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEQProfile(channel: Integer; nfreqs: Integer; F: PDouble; G: PDouble); cdecl; external WDSP_LIB;
procedure SetRXAEQCtfmode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetRXAEQWintype(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure SetRXAGrphEQ(channel: Integer; rxeq: PInteger); cdecl; external WDSP_LIB;
procedure SetRXAGrphEQ10(channel: Integer; rxeq: PInteger); cdecl; external WDSP_LIB;
procedure SetTXAEQRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXAEQNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetTXAEQMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetTXAEQProfile(channel: Integer; nfreqs: Integer; F: PDouble; G: PDouble); cdecl; external WDSP_LIB;
procedure SetTXAEQCtfmode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetTXAEQWintype(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure SetTXAEQMethod(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure SetTXAGrphEQ(channel: Integer; txeq: PInteger); cdecl; external WDSP_LIB;
procedure SetTXAGrphEQ10(channel: Integer; txeq: PInteger); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// fmd.c (FM Demodulator)
// ---------------------------------------------------------------------------
procedure SetRXAFMDeviation(channel: Integer; deviation: Double); cdecl; external WDSP_LIB;
procedure SetRXACTCSSFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetRXACTCSSRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMNCde(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMMPde(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMNCaud(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMMPaud(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMLimRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMLimGain(channel: Integer; gaindB: Double); cdecl; external WDSP_LIB;
procedure SetRXAFMAFFilter(channel: Integer; low: Double; high: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// fmmod.c (FM Modulator)
// ---------------------------------------------------------------------------
procedure SetTXAFMDeviation(channel: Integer; deviation: Double); cdecl; external WDSP_LIB;
procedure SetTXACTCSSFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXACTCSSRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXAFMNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetTXAFMMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure SetTXAFMAFFreqs(channel: Integer; low: Double; high: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// fmsq.c (FM Squelch)
// ---------------------------------------------------------------------------
procedure SetRXAFMSQRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMSQThreshold(channel: Integer; threshold: Double); cdecl; external WDSP_LIB;
procedure SetRXAFMSQNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure SetRXAFMSQMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// gain.c
// ---------------------------------------------------------------------------
function create_gain(run: Integer; prun: PInteger; size: Integer;
ain: PDouble; aout: PDouble; Igain: Double; Qgain: Double): TGAIN; cdecl; external WDSP_LIB;
procedure destroy_gain(a: TGAIN); cdecl; external WDSP_LIB;
procedure flush_gain(a: TGAIN); cdecl; external WDSP_LIB;
procedure xgain(a: TGAIN); cdecl; external WDSP_LIB;
procedure pSetTXOutputLevel(a: TGAIN; level: Double); cdecl; external WDSP_LIB;
procedure pSetTXOutputLevelRun(a: TGAIN; run: Integer); cdecl; external WDSP_LIB;
procedure pSetTXOutputLevelSize(a: TGAIN; size: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// gaussian.c
// ---------------------------------------------------------------------------
procedure SetRXAGaussianRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAGaussianFreqs(channel: Integer; f_center: Double; bandwidth: Double); cdecl; external WDSP_LIB;
procedure SetRXAGaussianGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetRXAGaussianNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// gen.c (Signal generators)
// ---------------------------------------------------------------------------
procedure SetRXAPreGenRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAPreGenMode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetRXAPreGenToneMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetRXAPreGenToneFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetRXAPreGenNoiseMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetRXAPreGenSweepMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetRXAPreGenSweepFreq(channel: Integer; freq1: Double; freq2: Double); cdecl; external WDSP_LIB;
procedure SetRXAPreGenSweepRate(channel: Integer; rate: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPreGenMode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPreGenToneMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenToneFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenNoiseMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenSweepMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenSweepFreq(channel: Integer; freq1: Double; freq2: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenSweepRate(channel: Integer; rate: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenSawtoothMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenSawtoothFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenTriangleMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenTriangleFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenPulseMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenPulseFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenPulseDutyCycle(channel: Integer; dc: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenPulseToneFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPreGenPulseTransition(channel: Integer; transtime: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPostGenMode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPostGenToneMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenToneFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTMag(channel: Integer; mag1: Double; mag2: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTFreq(channel: Integer; freq1: Double; freq2: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenSweepMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenSweepFreq(channel: Integer; freq1: Double; freq2: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenSweepRate(channel: Integer; rate: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenPulseMag(channel: Integer; mag: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenPulseFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenPulseDutyCycle(channel: Integer; dc: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenPulseToneFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenPulseTransition(channel: Integer; transtime: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenPulseIQout(channel: Integer; IQout: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTPulseMag(channel: Integer; mag1: Double; mag2: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTPulseFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTPulseDutyCycle(channel: Integer; dc: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTPulseToneFreq(channel: Integer; freq1: Double; freq2: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTPulseTransition(channel: Integer; transtime: Double); cdecl; external WDSP_LIB;
procedure SetTXAPostGenTTPulseIQout(channel: Integer; IQout: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// iir.c
// ---------------------------------------------------------------------------
procedure SetRXABiQuadRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXABiQuadFreq(channel: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetRXABiQuadBandwidth(channel: Integer; bw: Double); cdecl; external WDSP_LIB;
procedure SetRXABiQuadGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetRXAmpeakRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAmpeakNpeaks(channel: Integer; npeaks: Integer); cdecl; external WDSP_LIB;
procedure SetRXAmpeakFilEnable(channel: Integer; fil: Integer; enable: Integer); cdecl; external WDSP_LIB;
procedure SetRXAmpeakFilFreq(channel: Integer; fil: Integer; freq: Double); cdecl; external WDSP_LIB;
procedure SetRXAmpeakFilBw(channel: Integer; fil: Integer; bw: Double); cdecl; external WDSP_LIB;
procedure SetRXAmpeakFilGain(channel: Integer; fil: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetTXAPHROTRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPHROTCorner(channel: Integer; corner: Double); cdecl; external WDSP_LIB;
procedure SetTXAPHROTNstages(channel: Integer; nstages: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPHROTReverse(channel: Integer; reverse: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// impulse_cache.c
// ---------------------------------------------------------------------------
function save_impulse_cache(path: PAnsiChar): Integer; cdecl; external WDSP_LIB;
function read_impulse_cache(path: PAnsiChar): Integer; cdecl; external WDSP_LIB;
procedure use_impulse_cache(use: Integer); cdecl; external WDSP_LIB;
procedure init_impulse_cache(use: Integer); cdecl; external WDSP_LIB;
procedure destroy_impulse_cache; cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// iobuffs.c
// ---------------------------------------------------------------------------
procedure fexchange0(channel: Integer; ain: PDouble; aout: PDouble; error: PInteger); cdecl; external WDSP_LIB;
procedure fexchange2(channel: Integer; Iin: PINREAL; Qin: PINREAL;
Iout: POUTREAL; Qout: POUTREAL; error: PInteger); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// iqc.c (IQ Correction)
// ---------------------------------------------------------------------------
procedure GetTXAiqcValues(channel: Integer; cm: PDouble; cc: PDouble; cs: PDouble); cdecl; external WDSP_LIB;
procedure SetTXAiqcValues(channel: Integer; cm: PDouble; cc: PDouble; cs: PDouble); cdecl; external WDSP_LIB;
procedure SetTXAiqcSwap(channel: Integer; cm: PDouble; cc: PDouble; cs: PDouble); cdecl; external WDSP_LIB;
procedure SetTXAiqcStart(channel: Integer; cm: PDouble; cc: PDouble; cs: PDouble); cdecl; external WDSP_LIB;
procedure SetTXAiqcEnd(channel: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// matchedCW.c
// ---------------------------------------------------------------------------
procedure SetRXAMatchedRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAMatchedFreqs(channel: Integer; f_center: Double; bandwidth: Double); cdecl; external WDSP_LIB;
procedure SetRXAMatchedGain(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// meter.c
// ---------------------------------------------------------------------------
function GetRXAMeter(channel: Integer; mt: Integer): Double; cdecl; external WDSP_LIB;
function GetTXAMeter(channel: Integer; mt: Integer): Double; cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// nbp.c (Notch Band Pass)
// ---------------------------------------------------------------------------
function RXANBPAddNotch(channel: Integer; notch: Integer; fcenter: Double;
fwidth: Double; active: Integer): Integer; cdecl; external WDSP_LIB;
function RXANBPGetNotch(channel: Integer; notch: Integer; fcenter: PDouble;
fwidth: PDouble; active: PInteger): Integer; cdecl; external WDSP_LIB;
function RXANBPDeleteNotch(channel: Integer; notch: Integer): Integer; cdecl; external WDSP_LIB;
function RXANBPEditNotch(channel: Integer; notch: Integer; fcenter: Double;
fwidth: Double; active: Integer): Integer; cdecl; external WDSP_LIB;
procedure RXANBPGetNumNotches(channel: Integer; nnotches: PInteger); cdecl; external WDSP_LIB;
procedure RXANBPSetTuneFrequency(channel: Integer; tunefreq: Double); cdecl; external WDSP_LIB;
procedure RXANBPSetShiftFrequency(channel: Integer; shift: Double); cdecl; external WDSP_LIB;
procedure RXANBPSetNotchesRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure RXANBPSetRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure RXANBPSetFreqs(channel: Integer; flow: Double; fhigh: Double); cdecl; external WDSP_LIB;
procedure RXANBPSetWindow(channel: Integer; wintype: Integer); cdecl; external WDSP_LIB;
procedure RXANBPSetNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure RXANBPSetMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
procedure RXANBPGetMinNotchWidth(channel: Integer; minwidth: PDouble); cdecl; external WDSP_LIB;
procedure RXANBPSetAutoIncrease(channel: Integer; autoincr: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// nob.c (Noise/Impulse Blankers - ANB and NOB)
// ---------------------------------------------------------------------------
function create_anb(run: Integer; buffsize: Integer; ain: PDouble; aout: PDouble;
samplerate: Double; tau: Double; hangtime: Double; advtime: Double;
backtau: Double; threshold: Double): TANB; cdecl; external WDSP_LIB;
procedure destroy_anb(a: TANB); cdecl; external WDSP_LIB;
procedure flush_anb(a: TANB); cdecl; external WDSP_LIB;
procedure xanb(a: TANB); cdecl; external WDSP_LIB;
procedure pSetRCVRANBRun(a: TANB; run: Integer); cdecl; external WDSP_LIB;
procedure pSetRCVRANBBuffsize(a: TANB; size: Integer); cdecl; external WDSP_LIB;
procedure pSetRCVRANBSamplerate(a: TANB; rate: Integer); cdecl; external WDSP_LIB;
procedure pSetRCVRANBTau(a: TANB; tau: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRANBHangtime(a: TANB; time: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRANBAdvtime(a: TANB; time: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRANBBacktau(a: TANB; tau: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRANBThreshold(a: TANB; thresh: Double); cdecl; external WDSP_LIB;
procedure create_anbEXT(id: Integer; run: Integer; buffsize: Integer;
samplerate: Double; tau: Double; hangtime: Double; advtime: Double;
backtau: Double; threshold: Double); cdecl; external WDSP_LIB;
procedure destroy_anbEXT(id: Integer); cdecl; external WDSP_LIB;
procedure flush_anbEXT(id: Integer); cdecl; external WDSP_LIB;
procedure xanbEXT(id: Integer; ain: PDouble; aout: PDouble); cdecl; external WDSP_LIB;
procedure SetEXTANBRun(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetEXTANBBuffsize(id: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure SetEXTANBSamplerate(id: Integer; rate: Integer); cdecl; external WDSP_LIB;
procedure SetEXTANBTau(id: Integer; tau: Double); cdecl; external WDSP_LIB;
procedure SetEXTANBHangtime(id: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetEXTANBAdvtime(id: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetEXTANBBacktau(id: Integer; tau: Double); cdecl; external WDSP_LIB;
procedure SetEXTANBThreshold(id: Integer; thresh: Double); cdecl; external WDSP_LIB;
procedure xanbEXTF(id: Integer; I: PSingle; Q: PSingle); cdecl; external WDSP_LIB;
// NOB (Noise Blanker II)
function create_nob(run: Integer; buffsize: Integer; ain: PDouble; aout: PDouble;
samplerate: Double; mode: Integer; advslewtime: Double; advtime: Double;
hangslewtime: Double; hangtime: Double; max_imp_seq_time: Double;
backtau: Double; threshold: Double): TNOB; cdecl; external WDSP_LIB;
procedure destroy_nob(a: TNOB); cdecl; external WDSP_LIB;
procedure flush_nob(a: TNOB); cdecl; external WDSP_LIB;
procedure xnob(a: TNOB); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBRun(a: TNOB; run: Integer); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBMode(a: TNOB; mode: Integer); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBBuffsize(a: TNOB; size: Integer); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBSamplerate(a: TNOB; rate: Integer); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBTau(a: TNOB; tau: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBHangtime(a: TNOB; time: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBAdvtime(a: TNOB; time: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBBacktau(a: TNOB; tau: Double); cdecl; external WDSP_LIB;
procedure pSetRCVRNOBThreshold(a: TNOB; thresh: Double); cdecl; external WDSP_LIB;
procedure create_nobEXT(id: Integer; run: Integer; mode: Integer; buffsize: Integer;
samplerate: Double; slewtime: Double; hangtime: Double; advtime: Double;
backtau: Double; threshold: Double); cdecl; external WDSP_LIB;
procedure destroy_nobEXT(id: Integer); cdecl; external WDSP_LIB;
procedure flush_nobEXT(id: Integer); cdecl; external WDSP_LIB;
procedure xnobEXT(id: Integer; ain: PDouble; aout: PDouble); cdecl; external WDSP_LIB;
procedure SetEXTNOBRun(id: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetEXTNOBMode(id: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetEXTNOBBuffsize(id: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure SetEXTNOBSamplerate(id: Integer; rate: Integer); cdecl; external WDSP_LIB;
procedure SetEXTNOBTau(id: Integer; tau: Double); cdecl; external WDSP_LIB;
procedure SetEXTNOBHangtime(id: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetEXTNOBAdvtime(id: Integer; time: Double); cdecl; external WDSP_LIB;
procedure SetEXTNOBBacktau(id: Integer; tau: Double); cdecl; external WDSP_LIB;
procedure SetEXTNOBThreshold(id: Integer; thresh: Double); cdecl; external WDSP_LIB;
procedure xnobEXTF(id: Integer; I: PSingle; Q: PSingle); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// osctrl.c
// ---------------------------------------------------------------------------
procedure SetTXAosctrlRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// patchpanel.c
// ---------------------------------------------------------------------------
procedure SetRXAPanelRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAPanelSelect(channel: Integer; select: Integer); cdecl; external WDSP_LIB;
procedure SetRXAPanelGain1(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetRXAPanelGain2(channel: Integer; gainI: Double; gainQ: Double); cdecl; external WDSP_LIB;
procedure SetRXAPanelPan(channel: Integer; pan: Double); cdecl; external WDSP_LIB;
procedure SetRXAPanelCopy(channel: Integer; copy: Integer); cdecl; external WDSP_LIB;
procedure SetRXAPanelBinaural(channel: Integer; bin: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPanelRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetTXAPanelGain1(channel: Integer; gain: Double); cdecl; external WDSP_LIB;
procedure SetTXAPanelSelect(channel: Integer; select: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// resample.c
// ---------------------------------------------------------------------------
function create_resample(run: Integer; size: Integer; ain: PDouble; aout: PDouble;
in_rate: Integer; out_rate: Integer; fc: Double; ncoef: Integer;
gain: Double): TRESAMPLE; cdecl; external WDSP_LIB;
procedure destroy_resample(a: TRESAMPLE); cdecl; external WDSP_LIB;
procedure flush_resample(a: TRESAMPLE); cdecl; external WDSP_LIB;
function xresample(a: TRESAMPLE): Integer; cdecl; external WDSP_LIB;
function create_resampleV(in_rate: Integer; out_rate: Integer): Pointer; cdecl; external WDSP_LIB;
procedure xresampleV(input: PDouble; output: PDouble; numsamps: Integer;
outsamps: PInteger; ptr: Pointer); cdecl; external WDSP_LIB;
procedure destroy_resampleV(ptr: Pointer); cdecl; external WDSP_LIB;
function create_resampleFV(in_rate: Integer; out_rate: Integer): Pointer; cdecl; external WDSP_LIB;
procedure xresampleFV(input: PSingle; output: PSingle; numsamps: Integer;
outsamps: PInteger; ptr: Pointer); cdecl; external WDSP_LIB;
procedure destroy_resampleFV(ptr: Pointer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// rmatch.c (Rate Matching buffer)
// ---------------------------------------------------------------------------
procedure xrmatchIN(b: Pointer; ain: PDouble); cdecl; external WDSP_LIB;
procedure xrmatchOUT(b: Pointer; aout: PDouble); cdecl; external WDSP_LIB;
procedure getRMatchDiags(b: Pointer; underflows: PInteger; overflows: PInteger;
var_: PDouble; ringsize: PInteger; nring: PInteger); cdecl; external WDSP_LIB;
procedure resetRMatchDiags(b: Pointer); cdecl; external WDSP_LIB;
procedure forceRMatchVar(b: Pointer; force: Integer; fvar: Double); cdecl; external WDSP_LIB;
function create_rmatchV(in_size: Integer; out_size: Integer; nom_inrate: Integer;
nom_outrate: Integer; ringsize: Integer; var_: Double): Pointer; cdecl; external WDSP_LIB;
procedure destroy_rmatchV(ptr: Pointer); cdecl; external WDSP_LIB;
procedure setRMatchInsize(ptr: Pointer; insize: Integer); cdecl; external WDSP_LIB;
procedure setRMatchOutsize(ptr: Pointer; outsize: Integer); cdecl; external WDSP_LIB;
procedure setRMatchNomInrate(ptr: Pointer; nom_inrate: Integer); cdecl; external WDSP_LIB;
procedure setRMatchNomOutrate(ptr: Pointer; nom_outrate: Integer); cdecl; external WDSP_LIB;
procedure setRMatchRingsize(ptr: Pointer; ringsize: Integer); cdecl; external WDSP_LIB;
procedure setRMatchFeedbackGain(b: Pointer; feedback_gain: Double); cdecl; external WDSP_LIB;
procedure setRMatchSlewTime(b: Pointer; slew_time: Double); cdecl; external WDSP_LIB;
procedure setRMatchSlewTime1(b: Pointer; slew_time: Double); cdecl; external WDSP_LIB;
procedure setRMatchPropRingMin(ptr: Pointer; prop_min: Integer); cdecl; external WDSP_LIB;
procedure setRMatchPropRingMax(ptr: Pointer; prop_max: Integer); cdecl; external WDSP_LIB;
procedure setRMatchFFRingMin(ptr: Pointer; ff_ringmin: Integer); cdecl; external WDSP_LIB;
procedure setRMatchFFRingMax(ptr: Pointer; ff_ringmax: Integer); cdecl; external WDSP_LIB;
procedure setRMatchFFAlpha(ptr: Pointer; ff_alpha: Double); cdecl; external WDSP_LIB;
procedure getControlFlag(ptr: Pointer; control_flag: PInteger); cdecl; external WDSP_LIB;
function create_rmatchLegacyV(in_size: Integer; out_size: Integer; nom_inrate: Integer;
nom_outrate: Integer; ringsize: Integer): Pointer; cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// rnnr.c (RNN-based Noise Reduction)
// ---------------------------------------------------------------------------
procedure SetRXARNNRRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure RNNRloadModel(file_path: PAnsiChar); cdecl; external WDSP_LIB;
procedure SetRXARNNRPosition(channel: Integer; position: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// sbnr.c (Spectral Blind Noise Reduction)
// ---------------------------------------------------------------------------
procedure SetRXASBNRRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXASBNRreductionAmount(channel: Integer; amount: Single); cdecl; external WDSP_LIB;
procedure SetRXASBNRsmoothingFactor(channel: Integer; factor: Single); cdecl; external WDSP_LIB;
procedure SetRXASBNRwhiteningFactor(channel: Integer; factor: Single); cdecl; external WDSP_LIB;
procedure SetRXASBNRnoiseRescale(channel: Integer; factor: Single); cdecl; external WDSP_LIB;
procedure SetRXASBNRpostFilterThreshold(channel: Integer; threshold: Single); cdecl; external WDSP_LIB;
procedure SetRXASBNRnoiseScalingType(channel: Integer; noise_scaling_type: Integer); cdecl; external WDSP_LIB;
procedure SetRXASBNRPosition(channel: Integer; position: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// sender.c
// ---------------------------------------------------------------------------
procedure SetRXASpectrum(channel: Integer; flag: Integer; disp: Integer;
ss: Integer; LO: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// shift.c
// ---------------------------------------------------------------------------
procedure SetRXAShiftRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXAShiftFreq(channel: Integer; fshift: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// siphon.c
// ---------------------------------------------------------------------------
procedure RXAGetaSipF(channel: Integer; aout: PSingle; size: Integer); cdecl; external WDSP_LIB;
procedure RXAGetaSipF1(channel: Integer; aout: PSingle; size: Integer); cdecl; external WDSP_LIB;
procedure TXASetSipPosition(channel: Integer; pos: Integer); cdecl; external WDSP_LIB;
procedure TXASetSipMode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure TXASetSipDisplay(channel: Integer; disp: Integer); cdecl; external WDSP_LIB;
procedure TXAGetaSipF(channel: Integer; aout: PSingle; size: Integer); cdecl; external WDSP_LIB;
procedure TXAGetaSipF1(channel: Integer; aout: PSingle; size: Integer); cdecl; external WDSP_LIB;
procedure TXASetSipSpecmode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure TXAGetSpecF1(channel: Integer; aout: PSingle); cdecl; external WDSP_LIB;
procedure TXASetSipAllocDisps(channel: Integer; n_alloc_disps: Integer;
alloc_run: PInteger; alloc_disp: PInteger); cdecl; external WDSP_LIB;
procedure create_siphonEXT(id: Integer; run: Integer; insize: Integer;
sipsize: Integer; fftsize: Integer; specmode: Integer); cdecl; external WDSP_LIB;
procedure destroy_siphonEXT(id: Integer); cdecl; external WDSP_LIB;
procedure flush_siphonEXT(id: Integer); cdecl; external WDSP_LIB;
procedure xsiphonEXT(id: Integer; buff: PDouble); cdecl; external WDSP_LIB;
procedure GetaSipF1EXT(id: Integer; aout: PSingle; size: Integer); cdecl; external WDSP_LIB;
procedure SetSiphonInsize(id: Integer; size: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// slew.c
// ---------------------------------------------------------------------------
procedure SetTXAuSlewTime(channel: Integer; time: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// snb.c (Spectral Noise Blanker A)
// ---------------------------------------------------------------------------
procedure SetRXASNBARun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXASNBAovrlp(channel: Integer; ovrlp: Integer); cdecl; external WDSP_LIB;
procedure SetRXASNBAasize(channel: Integer; size: Integer); cdecl; external WDSP_LIB;
procedure SetRXASNBAnpasses(channel: Integer; npasses: Integer); cdecl; external WDSP_LIB;
procedure SetRXASNBAk1(channel: Integer; k1: Double); cdecl; external WDSP_LIB;
procedure SetRXASNBAk2(channel: Integer; k2: Double); cdecl; external WDSP_LIB;
procedure SetRXASNBAbridge(channel: Integer; bridge: Integer); cdecl; external WDSP_LIB;
procedure SetRXASNBApresamps(channel: Integer; presamps: Integer); cdecl; external WDSP_LIB;
procedure SetRXASNBApostsamps(channel: Integer; postsamps: Integer); cdecl; external WDSP_LIB;
procedure SetRXASNBApmultmin(channel: Integer; pmultmin: Double); cdecl; external WDSP_LIB;
procedure SetRXASNBAOutputBandwidth(channel: Integer; flow: Double; fhigh: Double); cdecl; external WDSP_LIB;
procedure RXABPSNBASetNC(channel: Integer; nc: Integer); cdecl; external WDSP_LIB;
procedure RXABPSNBASetMP(channel: Integer; mp: Integer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// ssql.c (Signal Squelch)
// ---------------------------------------------------------------------------
procedure SetRXASSQLRun(channel: Integer; run: Integer); cdecl; external WDSP_LIB;
procedure SetRXASSQLThreshold(channel: Integer; threshold: Double); cdecl; external WDSP_LIB;
procedure SetRXASSQLTauMute(channel: Integer; tau_mute: Double); cdecl; external WDSP_LIB;
procedure SetRXASSQLTauUnMute(channel: Integer; tau_unmute: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// utilities.c
// ---------------------------------------------------------------------------
function malloc0(size: Integer): Pointer; cdecl; external WDSP_LIB;
function NewCriticalSection: Pointer; cdecl; external WDSP_LIB;
procedure DestroyCriticalSection(cs_ptr: TLPCRITICAL_SECTION); cdecl; external WDSP_LIB;
procedure analyze_bandpass_filter(N: Integer; f_low: Double; f_high: Double;
samplerate: Double; wintype: Integer; rtype: Integer; scale: Double); cdecl; external WDSP_LIB;
procedure print_buffer_parameters(filename: PAnsiChar; channel: Integer); cdecl; external WDSP_LIB;
function create_bfcu(id: Integer; min_size: Integer; max_size: Integer;
rate: Double; corner: Double; points: Integer): Integer; cdecl; external WDSP_LIB;
procedure destroy_bfcu(id: Integer); cdecl; external WDSP_LIB;
procedure getFilterCorners(id: Integer; lower_index: PInteger; upper_index: PInteger); cdecl; external WDSP_LIB;
procedure getFilterCurve(id: Integer; size: Integer; w_type: Integer;
index_low: Integer; index_high: Integer; segment: PDouble); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// varsamp.c
// ---------------------------------------------------------------------------
function create_varsampV(in_rate: Integer; out_rate: Integer; R: Integer): Pointer; cdecl; external WDSP_LIB;
procedure xvarsampV(input: PDouble; output: PDouble; numsamps: Integer;
var_: Double; outsamps: PInteger; ptr: Pointer); cdecl; external WDSP_LIB;
procedure destroy_varsampV(ptr: Pointer); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// version.c
// ---------------------------------------------------------------------------
function GetWDSPVersion: Integer; cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// wcpAGC.c (Wideband Constant Power AGC)
// ---------------------------------------------------------------------------
procedure SetRXAAGCMode(channel: Integer; mode: Integer); cdecl; external WDSP_LIB;
procedure SetRXAAGCAttack(channel: Integer; attack: Integer); cdecl; external WDSP_LIB;
procedure SetRXAAGCDecay(channel: Integer; decay: Integer); cdecl; external WDSP_LIB;
procedure SetRXAAGCHang(channel: Integer; hang: Integer); cdecl; external WDSP_LIB;
procedure GetRXAAGCHangLevel(channel: Integer; hangLevel: PDouble); cdecl; external WDSP_LIB;
procedure SetRXAAGCHangLevel(channel: Integer; hangLevel: Double); cdecl; external WDSP_LIB;
procedure GetRXAAGCHangThreshold(channel: Integer; hangthreshold: PInteger); cdecl; external WDSP_LIB;
procedure SetRXAAGCHangThreshold(channel: Integer; hangthreshold: Integer); cdecl; external WDSP_LIB;
procedure GetRXAAGCThresh(channel: Integer; thresh: PDouble; size: Double; rate: Double); cdecl; external WDSP_LIB;
procedure SetRXAAGCThresh(channel: Integer; thresh: Double; size: Double; rate: Double); cdecl; external WDSP_LIB;
procedure GetRXAAGCTop(channel: Integer; max_agc: PDouble); cdecl; external WDSP_LIB;
procedure SetRXAAGCTop(channel: Integer; max_agc: Double); cdecl; external WDSP_LIB;
procedure SetRXAAGCSlope(channel: Integer; slope: Integer); cdecl; external WDSP_LIB;
procedure SetRXAAGCFixed(channel: Integer; fixed_agc: Double); cdecl; external WDSP_LIB;
procedure SetRXAAGCMaxInputLevel(channel: Integer; level: Double); cdecl; external WDSP_LIB;
procedure SetTXAALCSt(channel: Integer; state: Integer); cdecl; external WDSP_LIB;
procedure SetTXAALCAttack(channel: Integer; attack: Integer); cdecl; external WDSP_LIB;
procedure SetTXAALCDecay(channel: Integer; decay: Integer); cdecl; external WDSP_LIB;
procedure SetTXAALCHang(channel: Integer; hang: Integer); cdecl; external WDSP_LIB;
procedure SetTXAALCMaxGain(channel: Integer; maxgain: Double); cdecl; external WDSP_LIB;
procedure SetTXALevelerSt(channel: Integer; state: Integer); cdecl; external WDSP_LIB;
procedure SetTXALevelerAttack(channel: Integer; attack: Integer); cdecl; external WDSP_LIB;
procedure SetTXALevelerDecay(channel: Integer; decay: Integer); cdecl; external WDSP_LIB;
procedure SetTXALevelerHang(channel: Integer; hang: Integer); cdecl; external WDSP_LIB;
procedure SetTXALevelerTop(channel: Integer; maxgain: Double); cdecl; external WDSP_LIB;
// ---------------------------------------------------------------------------
// wisdom.c (FFTW wisdom)
// ---------------------------------------------------------------------------
function wisdom_get_status: PAnsiChar; cdecl; external WDSP_LIB;
function WDSPwisdom(directory: PAnsiChar): Integer; cdecl; external WDSP_LIB;
implementation
end.
+899
View File
@@ -0,0 +1,899 @@
unit WDSPEngine;
{
WDSP DSP Engine for OpenHPSDR Transceiver
Correct WDSP API usage based on actual WDSP.pas bindings:
Spectrum pipeline:
XCreateAnalyzer(disp, ...) создать analyzer display
SetDisplay*(disp, ...) настроить detector/average/rate
SetRXASpectrum(ch, 1, disp, 0, 0) подключить RXA к display
fexchange0() в цикле WDSP внутри пишет данные в display буфер
Spectrum0(1, disp, 0, 0, nil) тригер snapshot
GetPixels(disp, 0, pix, flag) забрать пиксели
OpenChannel сигнатура (13 параметров):
channel, in_size, dsp_size, in_rate, dsp_rate, out_rate,
atype, state, tdelayup, tslewup, tdelaydown, tslewdown, bfo
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, SyncObjs,
WDSP;
const
// WDSP mode integers (нет именованных констант в WDSP.pas)
WDSP_LSB = 0;
WDSP_USB = 1;
WDSP_DSB = 2;
WDSP_CWL = 3;
WDSP_CWU = 4;
WDSP_FM = 5;
WDSP_AM = 6;
WDSP_SAM = 12;
// Наши индексы режимов (совпадают с кнопками MainForm)
MODE_LSB = 0;
MODE_USB = 1;
MODE_DSB = 2;
MODE_CWL = 3;
MODE_CWU = 4;
MODE_FM = 5;
MODE_AM = 6;
MODE_SAM = 7;
// AGC modes
AGC_OFF = 0;
AGC_LONG = 1;
AGC_SLOW = 2;
AGC_MEDIUM = 3;
AGC_FAST = 4;
// S-meter types для GetRXAMeter
RXA_S_PK = 0; // peak, dBm
RXA_S_AV = 1; // average, dBm
RXA_CHAN = 0;
TXA_CHAN = 1; // используем разные каналы для RX и TX
DISP_ID = 0; // ID для XCreateAnalyzer
DSP_BUFSIZE = 1024;
SPECTRUM_PIXELS = 1024;
// Очередь IQ пакетов между сетевым и DSP потоком
IQ_QUEUE_SIZE = 64; // кол-во слотов (степень двойки для AND-маски)
IQ_PKT_MAXBYTES = 1428; // max байт IQ данных в пакете (238*6)
type
// Пакет в очереди между сетевым и DSP потоком
TIQQueueItem = record
Data: array[0..IQ_PKT_MAXBYTES - 1] of Byte;
DataLen: Integer; // реальная длина данных
IQPairs: Integer; // количество IQ пар
end;
TWDSPAGCMode = (agcOff = 0, agcLong = 1, agcSlow = 2,
agcMedium = 3, agcFast = 4);
TOnAudioReady = procedure(const Left, Right: array of Single;
Count: Integer) of object;
TOnSpectrumReady = procedure(const Pixels: array of Single;
Count: Integer) of object;
{ TWDSPEngine }
TWDSPEngine = class
private
FInitialized: Boolean;
FAnalyzerOpen: Boolean;
FSampleRate: Integer;
FAudioRate: Integer;
FBufSize: Integer; // входной буфер @ FSampleRate
FAudioBufSize: Integer; // выходной буфер @ FAudioRate (= FBufSize * FAudioRate / FSampleRate)
// Interleaved double I/Q буферы для fexchange0
FRXIn: array of Double;
FRXOut: array of Double;
FTXIn: array of Double;
FTXOut: array of Double;
// Накопитель входного буфера (DDC пакеты могут быть мельче FBufSize)
FRXAccI: array of Double;
FRXAccQ: array of Double;
FRXAccPos: Integer;
// Snapshot буфер для Spectrum0
FSnapBuf: array of Double;
// Аудио выходные буферы — аллоцируем один раз
FOutL: array of Single;
FOutR: array of Single;
// DSP поток + очередь пакетов
FDSPThread: TThread;
FQueue: array[0..IQ_QUEUE_SIZE - 1] of TIQQueueItem;
FQueueHead: Integer; // пишет сетевой поток
FQueueTail: Integer; // читает DSP поток
FQueueSem: PRTLEvent; // сигнал: есть новые данные (RTLEvent)
FDSPRunning: Boolean;
// Double буфер для Spectrum0 (принимает PDouble, не PdINREAL)
FSpecBuf: array of Double; // Double буфер для Spectrum0 (PDouble)
FSpectrumPixels: array[0..SPECTRUM_PIXELS - 1] of Single;
FFlp: array[0..0] of Integer; // for SetAnalyzer flp parameter
FOnAudio: TOnAudioReady;
FOnSpectrum: TOnSpectrumReady;
FMode: Integer;
FSMeter: Double;
FFilterLow: Integer;
FFilterHigh: Integer;
FAGCMode: TWDSPAGCMode;
FAGCTop: Double; // gain (dB) = agc_gain в piHPSDR
FAGCSlope: Integer; // наклон АРУ в дБ (default 0)
FAGCHangThreshold: Integer; // порог hang 0..100
FAGCHangLevel: Double; // читается из WDSP (GetRXAAGCHangLevel)
FAGCThresh: Double; // читается из WDSP (GetRXAAGCThresh)
FLastSpectrumW: Integer; // последняя известная ширина спектра (пикс)
FShiftHz: Double; // NCO shift для CTUN
FNREnabled: Boolean;
FNBEnabled: Boolean;
FANFEnabled: Boolean;
FMuted: Boolean;
FVolume: Double;
function ModeToWDSP(Mode: Integer): Integer;
procedure ApplyDefaultFilter;
procedure ProcessRXBlock;
procedure PushIQItemToDSP(const Item: TIQQueueItem);
procedure OpenAnalyzer;
procedure CloseAnalyzer;
public
constructor Create(SampleRate: Integer = 192000;
AudioRate: Integer = 48000;
BufSize: Integer = DSP_BUFSIZE);
destructor Destroy; override;
// Открыть DSP каналы
function Open: Boolean;
procedure Close;
procedure ChangeSampleRate(NewRate: Integer);
// Подача 24-bit big-endian IQ из DDC пакета
// Buf — массив байт, DataOffset — смещение до IQ данных внутри Buf
procedure PushDDCPacket(const Buf: array of Byte;
DataOffset: Integer;
IQPairs: Integer);
// RX управление
procedure SetMode(Mode: Integer);
procedure SetFilter(Low, High: Integer);
procedure SetAGC(Mode: TWDSPAGCMode; FixedGain: Double = 0.0);
procedure SetAGCTop(TopDBm: Double);
procedure SetAGCSlope(Slope: Integer);
procedure SetAGCHangThreshold(Threshold: Integer);
procedure UpdateAGCLines(SpectrumW: Integer); // читает hang/thresh из WDSP для линии на спектре
procedure SetSpectrumWidth(W: Integer); // обновляет FLastSpectrumW для корректных AGC линий
procedure SetShift(ShiftHz: Double); // CTUN NCO сдвиг
procedure SetNR(Enable: Boolean);
procedure SetNB(Enable: Boolean);
procedure SetANF(Enable: Boolean);
procedure SetVolume(Vol: Double);
procedure SetMute(Mute: Boolean);
// TX управление
procedure SetTXMode(Mode: Integer);
procedure SetTXFilter(Low, High: Integer);
procedure SetDriveLevel(Level: Double);
procedure SetMicGain(GainDB: Double);
procedure SetTXRun(Run: Boolean);
// Spectrum — вызывать из таймера (~20 fps)
procedure UpdateSpectrum;
procedure GetSpectrumData(var Pixels: array of Single; var Count: Integer);
// S-meter
function GetSMeterDBm: Double;
property Initialized: Boolean read FInitialized;
property SampleRate: Integer read FSampleRate;
property AudioBufSize: Integer read FAudioBufSize;
property AGCTop: Double read FAGCTop;
property AGCSlope: Integer read FAGCSlope;
property AGCHangThreshold: Integer read FAGCHangThreshold;
property AGCHangLevel: Double read FAGCHangLevel;
property AGCThresh: Double read FAGCThresh;
property Mode: Integer read FMode;
property FilterLow: Integer read FFilterLow;
property FilterHigh: Integer read FFilterHigh;
property SMeter: Double read FSMeter;
property OnAudio: TOnAudioReady read FOnAudio write FOnAudio;
property OnSpectrum: TOnSpectrumReady read FOnSpectrum write FOnSpectrum;
end;
implementation
// ===========================================================================
// DSP поток — обрабатывает IQ пакеты из очереди
// Сетевой поток только кладёт пакеты, этот поток занимается DSP
// Аналог iq_thread в piHPSDR/new_protocol.c
// ===========================================================================
type
TDSPThread = class(TThread)
private
FEngine: TWDSPEngine;
protected
procedure Execute; override;
public
constructor Create(AEngine: TWDSPEngine);
end;
constructor TDSPThread.Create(AEngine: TWDSPEngine);
begin
FEngine := AEngine;
FreeOnTerminate := False;
inherited Create(False);
end;
procedure TDSPThread.Execute;
var
Item: ^TIQQueueItem;
begin
while not Terminated do
begin
// Ждём сигнала от сетевого потока (как sem_wait в piHPSDR)
RTLEventWaitFor(FEngine.FQueueSem, 100);
if Terminated then Break;
// Разбираем все накопившиеся пакеты
while FEngine.FQueueTail <> FEngine.FQueueHead do
begin
Item := @FEngine.FQueue[FEngine.FQueueTail];
FEngine.PushIQItemToDSP(Item^);
FEngine.FQueueTail := (FEngine.FQueueTail + 1) and (IQ_QUEUE_SIZE - 1);
end;
end;
end;
// ---------------------------------------------------------------------------
function TWDSPEngine.ModeToWDSP(Mode: Integer): Integer;
begin
case Mode of
MODE_LSB: Result := WDSP_LSB;
MODE_USB: Result := WDSP_USB;
MODE_DSB: Result := WDSP_DSB;
MODE_CWL: Result := WDSP_CWL;
MODE_CWU: Result := WDSP_CWU;
MODE_FM: Result := WDSP_FM;
MODE_AM: Result := WDSP_AM;
MODE_SAM: Result := WDSP_SAM;
else Result := WDSP_USB;
end;
end;
procedure TWDSPEngine.ApplyDefaultFilter;
begin
case FMode of
MODE_LSB: SetFilter(-2400, -100);
MODE_USB: SetFilter( 100, 2400);
MODE_DSB: SetFilter(-2400, 2400);
MODE_CWL: SetFilter( -800, -200);
MODE_CWU: SetFilter( 200, 800);
MODE_FM: SetFilter(-5000, 5000);
MODE_AM: SetFilter(-4000, 4000);
MODE_SAM: SetFilter(-4000, 4000);
end;
end;
// ---------------------------------------------------------------------------
// Constructor / Destructor
// ---------------------------------------------------------------------------
constructor TWDSPEngine.Create(SampleRate, AudioRate, BufSize: Integer);
begin
inherited Create;
FSampleRate := SampleRate;
FAudioRate := AudioRate;
// BufSize = dsp_size @ AudioRate (внутренний DSP буфер, piHPSDR buffer_size = 1024)
// FBufSize = in_size @ SampleRate = BufSize * (SampleRate/AudioRate)
// piHPSDR: in_size = buffer_size * sample_rate/48000 = 1024*4 = 4096 @ 192kHz
FAudioBufSize := BufSize; // dsp_size = out_size @ AudioRate
FBufSize := BufSize * SampleRate div AudioRate; // in_size @ SampleRate = 4096
FInitialized := False;
FAnalyzerOpen := False;
FMode := MODE_USB;
FFilterLow := 100;
FFilterHigh := 2400;
FAGCMode := agcMedium;
FShiftHz := 0.0;
FAGCTop := -90.0;
FVolume := 0.7;
FSMeter := -130.0;
FRXAccPos := 0;
SetLength(FRXIn, FBufSize * 2); // in_size пар @ FSampleRate (4096*2)
SetLength(FRXOut, FAudioBufSize * 2); // out_size пар @ FAudioRate (1024*2)
SetLength(FTXIn, FAudioBufSize * 2);
SetLength(FTXOut, FBufSize * 2);
SetLength(FRXAccI, FBufSize);
SetLength(FRXAccQ, FBufSize);
SetLength(FSnapBuf, FBufSize * 2);
SetLength(FOutL, FAudioBufSize);
SetLength(FOutR, FAudioBufSize);
SetLength(FSpecBuf, FBufSize * 2);
// Очередь и DSP поток
FQueueHead := 0;
FQueueTail := 0;
FDSPRunning := False;
FQueueSem := RTLEventCreate;
FDSPThread := nil;
end;
destructor TWDSPEngine.Destroy;
begin
Close;
RTLEventDestroy(FQueueSem);
inherited;
end;
// ---------------------------------------------------------------------------
// Analyzer display
// ---------------------------------------------------------------------------
procedure TWDSPEngine.OpenAnalyzer;
var
Success: Integer;
MaxW: Integer;
Ovrlp: Integer;
FRAME_RATE: Integer;
begin
if FAnalyzerOpen then Exit;
// ---- Шаг 1: создать анализатор ----
// success = 0 означает УСПЕХ (WDSP Guide p.119)
// m_size = максимальный FFT размер (должен быть степенью 2, ≤ 262144)
// m_LO = 1 (нет spur elimination)
// m_stitch = 1 (один sub-span)
Success := -1;
XCreateAnalyzer(DISP_ID, @Success, 262144, 1, 1, nil);
if Success <> 0 then
begin
// Анализатор не создан — работаем без спектра, краша не будет
Exit;
end;
// ---- Шаг 2: SetAnalyzer ----
// Рассчитываем параметры по документации (WDSP Guide p.120-121)
FRAME_RATE := 20; // 20 fps
// max_w = fft_size + min(KEEP_TIME*sample_rate, KEEP_TIME*fft_size*frame_rate)
// KEEP_TIME = 0.1
// min(0.1*192000, 0.1*4096*20) = min(19200, 8192) = 8192
MaxW := 4096 + 8192; // = 12288
// ovrlp = max(0, ceil(fft_size - sample_rate/frame_rate))
// = max(0, ceil(4096 - 192000/20)) = max(0, 4096-9600) = 0
Ovrlp := 0;
FFlp[0] := 0; // LO на нижней стороне, нет spur elimination
SetAnalyzer(
DISP_ID,
1, // n_pixout: 1 (один выход — панадаптер и водопад одинаковые)
1, // n_fft: 1 (без spur elimination)
1, // typ: 1 = COMPLEX (I+Q)
@FFlp[0], // flp: [0] — LO ниже сигнала
4096, // sz: размер FFT
FAudioBufSize, // bf_sz: блок данных @ AudioRate = dsp_size (1024 @ 48kHz)
1, // win_type: 1 = 4-term Blackman-Harris
14.0, // pi: Kaiser beta (не используется при BH)
Ovrlp, // ovrlp: перекрытие = 0
0, // clp: обрезка краёв = 0
0.0, // fscLin: pan left = 0 (полный диапазон)
0.0, // fscHin: pan right = 0 (полный диапазон)
SPECTRUM_PIXELS, // n_pix: пикселей на выходе GetPixels
1, // n_stch: 1 sub-span (нет stitching)
0, // calset: нет калибровки
0.0, // fmin
0.0, // fmax
MaxW // max_w: рассчитан выше = 12288
);
// ---- Шаг 3: настройка детектора и усреднения ----
// DETECTOR_MODE_AVERAGE + LOG_RECURSIVE — плавный, как в piHPSDR/Thetis
// backmult ~0.45 = инерция ~2.2 кадра → плавно, без смазывания быстрых сигналов
// NumAverage = FRAME_RATE * 0.12 ≈ 2..3 при 20fps — достаточно для LOG_RECURSIVE
SetDisplayDetectorMode(DISP_ID, 0, DETECTOR_MODE_AVERAGE);
SetDisplayAverageMode(DISP_ID, 0, AVERAGE_MODE_LOG_RECURSIVE);
SetDisplayNumAverage(DISP_ID, 0, Max(2, Trunc(FRAME_RATE * 0.12)));
SetDisplayAvBackmult(DISP_ID, 0, 0.45);
SetDisplaySampleRate(DISP_ID, FSampleRate);
SetDisplayNormOneHz(DISP_ID, 0, 0);
FAnalyzerOpen := True;
end;
procedure TWDSPEngine.CloseAnalyzer;
begin
if not FAnalyzerOpen then Exit;
DestroyAnalyzer(DISP_ID);
FAnalyzerOpen := False;
end;
// ---------------------------------------------------------------------------
// Open / Close
// ---------------------------------------------------------------------------
function TWDSPEngine.Open: Boolean;
begin
Result := False;
if FInitialized then Exit;
// Проверяем что libwdsp загружена (WEAKEXTERNALSYMBOLS: nil если нет DLL)
if not Assigned(@OpenChannel) then
begin
// wdsp.dll / libwdsp.so не найдена — демо-режим
FInitialized := False;
Exit;
end;
try
// ---- RXA channel 0 ----
OpenChannel(
RXA_CHAN,
FBufSize, // in_size @ FSampleRate (4096 @ 192kHz)
FAudioBufSize, // dsp_size @ AudioRate (1024 @ 48kHz) — как piHPSDR buffer_size
FSampleRate,
FAudioRate, // dsp_rate = 48kHz
FAudioRate, // out_rate = 48kHz
0, // atype: 0=RX
1, // state: 1=run
0.010, 0.010, 0.010, 0.010,
0
);
SetRXAMode(RXA_CHAN, ModeToWDSP(FMode));
SetRXAShiftRun(RXA_CHAN, 1); // включаем NCO шифтер (нужен для CTUN)
SetRXAShiftFreq(RXA_CHAN, 0.0); // по умолчанию сдвига нет
RXASetPassband(RXA_CHAN, FFilterLow, FFilterHigh);
SetAGC(FAGCMode, 50.0); // настраиваем AGC с полными параметрами piHPSDR
SetRXAPanelGain1(RXA_CHAN, FVolume);
SetRXAPanelSelect(RXA_CHAN, 3);
SetRXAPanelRun(RXA_CHAN, 1);
OpenAnalyzer;
// НЕ используем SetRXASpectrum — кормим анализатор вручную
// через Spectrum0 с Double буфером, чтобы избежать SIGSEGV
// (fexchange0 работает с Single, а внутри WDSP Spectrum2 ждёт Double)
// ---- TXA channel 1 ----
OpenChannel(
TXA_CHAN,
FBufSize,
FBufSize,
FAudioRate,
48000,
FSampleRate,
1, // atype: 1=TX
0, // state: 0=hold
0.010, 0.010, 0.010, 0.010,
0
);
SetTXAMode(TXA_CHAN, ModeToWDSP(FMode));
SetTXABandpassFreqs(TXA_CHAN, 100, 2800);
SetTXABandpassWindow(TXA_CHAN, 1);
SetTXALevelerSt(TXA_CHAN, 1);
SetTXALevelerTop(TXA_CHAN, 5.0);
SetTXAALCSt(TXA_CHAN, 1);
SetTXAALCDecay(TXA_CHAN, 10);
SetTXACompressorRun(TXA_CHAN, 0);
SetTXAPanelGain1(TXA_CHAN, 1.0);
SetTXAPanelRun(TXA_CHAN, 1);
SetTXAPanelSelect(TXA_CHAN, 1);
FInitialized := True;
Result := True;
// Запускаем DSP поток после успешной инициализации WDSP
// Аналог iq_thread_id = g_thread_new("iq thread", ...) в piHPSDR
FDSPThread := TDSPThread.Create(Self);
FDSPThread.Priority := tpHighest; // DSP критический поток
except
FInitialized := False;
Result := False;
end;
end;
procedure TWDSPEngine.Close;
begin
if not FInitialized then Exit;
// Останавливаем DSP поток перед закрытием WDSP каналов
if Assigned(FDSPThread) then
begin
FDSPThread.Terminate;
RTLEventSetEvent(FQueueSem); // разбудить чтобы увидел Terminated
FDSPThread.WaitFor;
FreeAndNil(FDSPThread);
end;
CloseAnalyzer;
CloseChannel(RXA_CHAN);
CloseChannel(TXA_CHAN);
FInitialized := False;
end;
procedure TWDSPEngine.ChangeSampleRate(NewRate: Integer);
// Меняет samplerate на лету: Close → сброс очереди → пересчёт буферов → Open.
begin
if NewRate = FSampleRate then Exit;
// Останавливаем текущий канал
Close;
// Сбрасываем очередь IQ пакетов — старые пакеты не совместимы с новым rate.
// Без этого DSP поток тратит секунды на разбор накопившихся пакетов.
FQueueHead := 0;
FQueueTail := 0;
FRXAccPos := 0;
// Обновляем параметры
FSampleRate := NewRate;
FBufSize := FAudioBufSize * NewRate div FAudioRate;
// Перераспределяем буферы под новый размер
SetLength(FRXIn, FBufSize * 2);
SetLength(FRXOut, FBufSize * 2);
SetLength(FSpecBuf, FBufSize * 2);
SetLength(FRXAccI, FBufSize);
SetLength(FRXAccQ, FBufSize);
// Переинициализируем WDSP с новым rate
Open;
end;
procedure TWDSPEngine.PushDDCPacket(const Buf: array of Byte;
DataOffset: Integer; IQPairs: Integer);
// Вызывается из СЕТЕВОГО потока — только кладём в очередь и возвращаемся немедленно
// DSP поток разбудится семафором и займётся обработкой
var
NextHead: Integer;
Item: ^TIQQueueItem;
DataBytes: Integer;
begin
NextHead := (FQueueHead + 1) and (IQ_QUEUE_SIZE - 1);
if NextHead = FQueueTail then Exit; // очередь полна — пропускаем пакет
Item := @FQueue[FQueueHead];
DataBytes := IQPairs * 6;
if DataBytes > IQ_PKT_MAXBYTES then DataBytes := IQ_PKT_MAXBYTES;
Move(Buf[DataOffset], Item^.Data[0], DataBytes);
Item^.DataLen := DataBytes;
Item^.IQPairs := IQPairs;
FQueueHead := NextHead;
RTLEventSetEvent(FQueueSem); // будим DSP поток (как sem_post в piHPSDR)
end;
procedure TWDSPEngine.PushIQItemToDSP(const Item: TIQQueueItem);
// Вызывается из DSP потока — декодирует IQ и накапливает до FBufSize
var
i, Pos: Integer;
IR, QR: LongInt;
const
SCALE = 1.0 / 8388608.0;
begin
for i := 0 to Item.IQPairs - 1 do
begin
Pos := i * 6;
if Pos + 5 >= Item.DataLen then Break;
IR := (LongInt(Item.Data[Pos]) shl 16) or
(LongInt(Item.Data[Pos+1]) shl 8) or
LongInt(Item.Data[Pos+2]);
QR := (LongInt(Item.Data[Pos+3]) shl 16) or
(LongInt(Item.Data[Pos+4]) shl 8) or
LongInt(Item.Data[Pos+5]);
if (IR and $800000) <> 0 then IR := IR or LongInt($FF000000);
if (QR and $800000) <> 0 then QR := QR or LongInt($FF000000);
FRXAccI[FRXAccPos] := IR * SCALE;
FRXAccQ[FRXAccPos] := QR * SCALE;
Inc(FRXAccPos);
if FRXAccPos >= FBufSize then
ProcessRXBlock;
end;
end;
procedure TWDSPEngine.ProcessRXBlock;
var
i: Integer;
Err: Integer;
// OutL/OutR теперь поля класса — не аллоцируем каждый раз
begin
FRXAccPos := 0;
if not FInitialized then Exit;
try
// Упаковываем в interleaved буфер для fexchange0
for i := 0 to FBufSize - 1 do
begin
FRXIn[i * 2] := FRXAccI[i];
FRXIn[i * 2 + 1] := FRXAccQ[i];
end;
// Копируем входные IQ ДО fexchange0 для Spectrum0
// fexchange0 in-place перезапишет FRXIn выходными данными @ 48kHz
if FAnalyzerOpen then
for i := 0 to FBufSize * 2 - 1 do
FSpecBuf[i] := FRXIn[i]; // Single→Double, входные IQ @ 192kHz
// DSP обработка
Err := 0;
fexchange0(RXA_CHAN, @FRXIn[0], @FRXOut[0], @Err);
// Spectrum0 с входными данными (скопированными до fexchange0)
if FAnalyzerOpen then
Spectrum0(1, DISP_ID, 0, 0, @FSpecBuf[0]);
// S-meter: читаем ОДИН раз в DSP-колбэке и кешируем в FSMeter.
// GetRXAMeter сбрасывает аккумулятор после вызова, поэтому второй
// вызов вернёт 0/-∞ — отсюда "падение до нуля". Только здесь!
FSMeter := GetRXAMeter(RXA_CHAN, RXA_S_AV);
// Аудио колбэк — FAudioBufSize сэмплов @ FAudioRate (после децимации 4:1)
if Assigned(FOnAudio) and not FMuted then
begin
for i := 0 to FAudioBufSize - 1 do
begin
FOutL[i] := FRXOut[i * 2] * FVolume;
FOutR[i] := FRXOut[i * 2 + 1] * FVolume;
end;
FOnAudio(FOutL, FOutR, FAudioBufSize);
end;
except
// Защита от падения libwdsp в потоке — просто пропускаем блок
end;
end;
// ---------------------------------------------------------------------------
// RX управление
// ---------------------------------------------------------------------------
procedure TWDSPEngine.SetMode(Mode: Integer);
begin
FMode := Mode;
if not FInitialized then Exit;
SetRXAMode(RXA_CHAN, ModeToWDSP(Mode));
// НЕ вызываем ApplyDefaultFilter — фильтр устанавливается явно из UI
end;
procedure TWDSPEngine.SetFilter(Low, High: Integer);
begin
FFilterLow := Low;
FFilterHigh := High;
if not FInitialized then Exit;
// RXASetPassband — правильный unified API, пересчитывает фильтр целиком
RXASetPassband(RXA_CHAN, Low, High);
end;
procedure TWDSPEngine.SetAGC(Mode: TWDSPAGCMode; FixedGain: Double);
begin
FAGCMode := Mode;
if not FInitialized then Exit;
// Точно по piHPSDR receiver.c: set_agc()
SetRXAAGCMode(RXA_CHAN, Ord(Mode));
SetRXAAGCSlope(RXA_CHAN, FAGCSlope);
SetRXAAGCTop(RXA_CHAN, FAGCTop);
case Mode of
agcOff:
SetRXAAGCFixed(RXA_CHAN, FixedGain);
agcLong: begin
SetRXAAGCAttack(RXA_CHAN, 2);
SetRXAAGCHang(RXA_CHAN, 2000);
SetRXAAGCDecay(RXA_CHAN, 2000);
SetRXAAGCHangThreshold(RXA_CHAN, FAGCHangThreshold);
end;
agcSlow: begin
SetRXAAGCAttack(RXA_CHAN, 2);
SetRXAAGCHang(RXA_CHAN, 1000);
SetRXAAGCDecay(RXA_CHAN, 500);
SetRXAAGCHangThreshold(RXA_CHAN, FAGCHangThreshold);
end;
agcMedium: begin
SetRXAAGCAttack(RXA_CHAN, 2);
SetRXAAGCHang(RXA_CHAN, 0);
SetRXAAGCDecay(RXA_CHAN, 250);
SetRXAAGCHangThreshold(RXA_CHAN, 100);
end;
agcFast: begin
SetRXAAGCAttack(RXA_CHAN, 2);
SetRXAAGCHang(RXA_CHAN, 0);
SetRXAAGCDecay(RXA_CHAN, 50);
SetRXAAGCHangThreshold(RXA_CHAN, 100);
end;
end;
// Читаем обратно hang level и thresh для линии на спектре
UpdateAGCLines(FLastSpectrumW);
end;
procedure TWDSPEngine.SetShift(ShiftHz: Double);
begin
FShiftHz := ShiftHz;
if not FInitialized then Exit;
SetRXAShiftFreq(RXA_CHAN, ShiftHz);
end;
procedure TWDSPEngine.SetAGCTop(TopDBm: Double);
begin
FAGCTop := TopDBm;
if not FInitialized then Exit;
SetRXAAGCTop(RXA_CHAN, TopDBm);
UpdateAGCLines(FLastSpectrumW);
end;
procedure TWDSPEngine.SetAGCSlope(Slope: Integer);
begin
FAGCSlope := Slope;
if not FInitialized then Exit;
SetRXAAGCSlope(RXA_CHAN, Slope);
end;
procedure TWDSPEngine.SetAGCHangThreshold(Threshold: Integer);
begin
FAGCHangThreshold := Threshold;
if not FInitialized then Exit;
SetRXAAGCHangThreshold(RXA_CHAN, Threshold);
UpdateAGCLines(FLastSpectrumW);
end;
procedure TWDSPEngine.SetSpectrumWidth(W: Integer);
begin
if W > 0 then FLastSpectrumW := W;
end;
procedure TWDSPEngine.UpdateAGCLines(SpectrumW: Integer);
begin
if not FInitialized then Exit;
if SpectrumW <= 0 then Exit; // окно ещё не показано — не читаем
GetRXAAGCHangLevel(RXA_CHAN, @FAGCHangLevel);
GetRXAAGCThresh(RXA_CHAN, @FAGCThresh,
SpectrumW, // реальная ширина дисплея в пикселях
FSampleRate);
end;
procedure TWDSPEngine.SetNR(Enable: Boolean);
begin
FNREnabled := Enable;
if not FInitialized then Exit;
SetRXAEMNRRun(RXA_CHAN, Ord(Enable));
end;
procedure TWDSPEngine.SetNB(Enable: Boolean);
begin
FNBEnabled := Enable;
if not FInitialized then Exit;
SetEXTANBRun(RXA_CHAN, Ord(Enable));
end;
procedure TWDSPEngine.SetANF(Enable: Boolean);
begin
FANFEnabled := Enable;
if not FInitialized then Exit;
SetRXAANFRun(RXA_CHAN, Ord(Enable));
end;
procedure TWDSPEngine.SetVolume(Vol: Double);
begin
FVolume := Max(0.0, Min(1.0, Vol));
if not FInitialized then Exit;
SetRXAPanelGain1(RXA_CHAN, FVolume);
end;
procedure TWDSPEngine.SetMute(Mute: Boolean);
begin
FMuted := Mute;
if not FInitialized then Exit;
SetRXAPanelRun(RXA_CHAN, Ord(not Mute));
end;
// ---------------------------------------------------------------------------
// TX управление
// ---------------------------------------------------------------------------
procedure TWDSPEngine.SetTXMode(Mode: Integer);
begin
if not FInitialized then Exit;
SetTXAMode(TXA_CHAN, ModeToWDSP(Mode));
end;
procedure TWDSPEngine.SetTXFilter(Low, High: Integer);
begin
if not FInitialized then Exit;
SetTXABandpassFreqs(TXA_CHAN, Low, High);
end;
procedure TWDSPEngine.SetDriveLevel(Level: Double);
begin
if not FInitialized then Exit;
SetTXAALCMaxGain(TXA_CHAN, Max(0.0, Min(1.0, Level)));
end;
procedure TWDSPEngine.SetMicGain(GainDB: Double);
begin
if not FInitialized then Exit;
SetTXAPanelGain1(TXA_CHAN, Power(10.0, GainDB / 20.0));
end;
procedure TWDSPEngine.SetTXRun(Run: Boolean);
begin
if not FInitialized then Exit;
if Run then
SetChannelState(TXA_CHAN, 1, 0) // run, no delay
else
SetChannelState(TXA_CHAN, 0, 1); // stop, with slew
end;
// ---------------------------------------------------------------------------
// Spectrum
// ---------------------------------------------------------------------------
procedure TWDSPEngine.UpdateSpectrum;
// Вызывается из таймера главного потока (~20fps)
// Spectrum0 уже вызван в сетевом потоке после каждого fexchange0
// Здесь только читаем готовые пиксели
var
PixBuf: array[0..SPECTRUM_PIXELS - 1] of Single;
Flag: Integer;
i: Integer;
begin
if not FInitialized or not FAnalyzerOpen then Exit;
Flag := 0;
GetPixels(DISP_ID, 0, @PixBuf[0], @Flag);
if Flag = 0 then Exit; // нет нового кадра — ждём следующего тика
for i := 0 to SPECTRUM_PIXELS - 1 do
FSpectrumPixels[i] := PixBuf[i];
if Assigned(FOnSpectrum) then
FOnSpectrum(FSpectrumPixels, SPECTRUM_PIXELS);
end;
procedure TWDSPEngine.GetSpectrumData(var Pixels: array of Single;
var Count: Integer);
var
N: Integer;
begin
N := Min(SPECTRUM_PIXELS, Length(Pixels));
if N > 0 then
Move(FSpectrumPixels[0], Pixels[0], N * SizeOf(Single));
Count := N;
end;
function TWDSPEngine.GetSMeterDBm: Double;
begin
// НЕ вызываем GetRXAMeter здесь повторно — значение уже обновлено
// в DSP-колбэке. Повторный вызов сбрасывает аккумулятор WDSP → 0.
Result := FSMeter;
end;
end.
+442
View File
@@ -0,0 +1,442 @@
unit WebPageHtml;
{
WebPageHtml.pas Встроенный HTML/CSS/JS интерфейс веб-пульта HPSDR.
Содержит единственную функцию GetIndexHtml, которая возвращает полную
HTML-страницу (одним файлом) для отправки клиенту по HTTP GET /.
Страница включает:
- CSS: тёмная тема, VFO, спектр, водопад, S-метр
- HTML: разметка панелей управления
- JS: WebSocket клиент, отрисовка спектра/водопада/S-метра,
VFO отображение и управление, Opus декодер (CDN)
}
{$IFDEF FPC}
{$MODE Delphi}
{$LONGSTRINGS ON}
{$ENDIF}
interface
function GetIndexHtml: string;
implementation
function GetIndexHtml: string;
begin
Result :=
// ── <head>: мета, шрифты, CSS ──────────────────────────────────────────
'<!DOCTYPE html><html lang="en"><head>' +
'<meta charset="UTF-8">' +
'<meta name="viewport" content="width=device-width,initial-scale=1">' +
'<title>HPSDR Web Remote</title>' +
'<link rel="preconnect" href="https://fonts.googleapis.com">' +
'<link href="https://fonts.googleapis.com/css2?family=Roboto+Mono:wght@300;400&family=Share+Tech+Mono&display=swap" rel="stylesheet">' +
'<style>' +
'*{box-sizing:border-box;margin:0;padding:0}' +
'body{background:#141414;color:#ccc;font-family:"Segoe UI",Tahoma,sans-serif;font-size:12px;overflow:hidden;height:100vh}' +
'.wrap{display:flex;flex-direction:column;height:100vh;gap:2px;padding:2px}' +
'@import url(''https://fonts.googleapis.com/css2?family=Orbitron:wght@400;500&display=swap'');' +
// ── Тулбар ──
'.tbar{display:flex;align-items:center;gap:5px;background:#1e1e1e;border:1px solid #2e2e2e;border-radius:3px;padding:2px 6px;flex-shrink:0;height:32px}' +
'.tsep{flex:1}' +
'button{background:linear-gradient(180deg,#404040,#2c2c2c);color:#ccc;border:1px solid #505050;border-radius:3px;padding:0 9px;font-size:11px;cursor:pointer;height:22px;white-space:nowrap;line-height:1;display:inline-flex;align-items:center;justify-content:center}' +
'button:hover{background:linear-gradient(180deg,#4c4c4c,#383838)}' +
'button.on{background:linear-gradient(180deg,#1e4d1e,#163216);border-color:#3d7a3d;color:#7fff7f}' +
'button.rx-tx{background:linear-gradient(180deg,#4d1e1e,#321616);border-color:#7a3d3d;color:#ff8080}' +
'select{background:#222;color:#bbb;border:1px solid #484848;border-radius:3px;padding:0 4px;font-size:11px;height:22px;cursor:pointer}' +
'.sl-g{display:flex;align-items:center;gap:3px}' +
'.sl-lb{font-size:10px;color:#777;white-space:nowrap}' +
'.sl-val{font-size:10px;color:#9ab;white-space:nowrap;min-width:2.5em;text-align:right}' +
'.sl-sep{color:#444;padding:0 2px;font-size:11px;align-self:center}' +
'input[type=range]{-webkit-appearance:none;height:3px;background:#3a3a3a;border-radius:2px;cursor:pointer;width:72px;outline:none}' +
'input[type=range]::-webkit-slider-thumb{-webkit-appearance:none;width:11px;height:11px;border-radius:50%;background:#5a9ab0;border:1px solid #7ac;cursor:pointer}' +
'input[type=range]::-moz-range-thumb{width:11px;height:11px;border-radius:50%;background:#5a9ab0;border:1px solid #7ac;cursor:pointer}' +
'.vol-ic{font-size:13px;cursor:pointer;color:#7ab;user-select:none;line-height:1}' +
// ── VFO-строка ──
'.row2{height:74px;display:flex;align-items:center;gap:6px;background:#0c0c0c}' +
'#smeter{height:64px;width:340px;flex-shrink:0;border:1px solid #333;border-radius:2px;display:block}' +
'.vfo-mid{flex:1;display:flex;align-items:center;justify-content:center;gap:5px}' +
'.vbtn{width:38px;height:38px;display:flex;align-items:center;justify-content:center;font-size:13px;font-weight:700;cursor:pointer;border-radius:3px;color:#888;border:1px solid #444;background:linear-gradient(180deg,#2a2a2a,#1e1e1e);padding:0}' +
'.vbtn.active{color:#7fff7f;border-color:#3d7a3d;background:linear-gradient(180deg,#1e3e1e,#142814)}' +
'.vfo-ro{font:400 44px "Orbitron","Consolas",monospace;letter-spacing:0.02em;color:#7fff7f;background:#0c0c0c;border:none;border-radius:0;padding:0 6px;cursor:pointer;user-select:none;height:62px;display:inline-flex;align-items:baseline;padding-top:10px;white-space:nowrap;overflow:hidden}' +
'.vfo-ro.dim{color:#2a4a2a;background:#1e1e1e;border:none}' +
'.vfo-ro .dg{display:inline-block;min-width:0.55em;font-size:44px;line-height:1}' +
'.vfo-ro .dg.lead{color:#2a3a2a}.vfo-ro.dim .dg.lead{color:#1e281e}' +
'.vfo-ro .sp{display:inline-block;color:#2a6030;min-width:0.3em;font-size:44px;line-height:1}' +
'.vfo-ro.dim .sp{color:#1a2a1a}' +
'.vfo-ro .dg.sel{background:rgba(127,255,127,.18);outline:1px solid rgba(127,255,127,.35);border-radius:2px}' +
'.vfo-hz{display:inline-flex;align-items:baseline}' +
'.vfo-hz .dg{display:inline-block;font-size:22px;line-height:1;min-width:0.55em;font-weight:400}' +
'.vfo-ro.dim .vfo-hz .dg{color:#2a4a2a}' +
'.swap-g{display:flex;gap:3px}' +
'.swap-g button{padding:0 7px;height:22px;font-size:10px}' +
'.right-g{display:flex;align-items:center;gap:4px;margin-left:auto}' +
'.right-g button,.right-g select{height:62px;font-size:12px}' +
// ── Спектр / линейка / водопад ──
'.spec-area{flex:1 1 auto;min-height:80px;position:relative;background:#050a05;border:1px solid #252525;border-radius:3px;overflow:hidden}' +
'.spec-area canvas{position:absolute;top:0;left:0;width:100%;height:100%}' +
'.span-ov{position:absolute;top:4px;left:4px;display:flex;gap:3px;z-index:5}' +
'.sp-btn{background:rgba(15,25,15,0.78);color:#6a9a6a;border:1px solid rgba(60,100,60,0.5);border-radius:3px;padding:0 7px;font-size:10px;height:18px;cursor:pointer;backdrop-filter:blur(1px)}' +
'.sp-btn:hover{background:rgba(25,45,25,0.88);border-color:rgba(80,140,80,0.7);color:#9aca9a}' +
'.sp-btn.on{background:rgba(20,50,20,0.92);border-color:#4a9a4a;color:#aaffaa}' +
'.ruler-area{flex:0 0 24px;position:relative;background:#0c1210;border-left:1px solid #252525;border-right:1px solid #252525;overflow:hidden}' +
'.ruler-area canvas{position:absolute;top:0;left:0;width:100%;height:100%}' +
'.wf-area{flex:0 0 405px;position:relative;background:#000;border:1px solid #252525;border-radius:3px;overflow:hidden}' +
'.wf-area canvas{position:absolute;top:0;left:0;width:100%;height:100%}' +
'.sbar{flex:0 0 16px;display:flex;align-items:center;padding:0 6px;gap:10px;background:#0e0e0e;border-top:1px solid #222;font-size:10px;color:#555}' +
'#latEl{margin-left:auto}' +
'</style></head>' +
// ── <body>: разметка панелей ────────────────────────────────────────────
'<body><div class="wrap">' +
// Тулбар 1: громкость, AGC, режимы, DSP кнопки
'<div class="tbar">' +
'<span class="vol-ic" id="muteIc" title="Mute">&#128266;</span>' +
'<div class="sl-g"><input type="range" id="volSl" min="0" max="100" value="70"><span class="sl-val" id="volVal">70</span></div>' +
'<span class="sl-sep">|</span>' +
'<div class="sl-g"><span class="sl-lb">RF</span><input type="range" id="rfSl" min="0" max="120" value="90"><span class="sl-val" id="rfVal">90dB</span></div>' +
'<span class="sl-sep">|</span>' +
'<button id="toneBtn">TONE</button>' +
'<span class="sl-sep">|</span>' +
'<div class="sl-g"><span class="sl-lb">TX</span><input type="range" id="txSl" min="0" max="100" value="50"><span class="sl-val" id="txVal">50</span></div>' +
'<span class="sl-sep">|</span>' +
'<div class="tsep"></div>' +
'<select id="agcSel">' +
'<option value="0">AGC-F</option><option value="1" selected>AGC-M</option>' +
'<option value="2">AGC-S</option><option value="3">AGC-L</option><option value="4">AGC-OFF</option>' +
'</select>' +
'<select id="modGrpSel">' +
'<option value="ssb" selected>SSB</option><option value="cw">CW</option>' +
'<option value="fm">FM</option><option value="am">AM</option>' +
'</select>' +
'<select id="stepSel">' +
'<option value="10">10 Hz</option><option value="100" selected>100 Hz</option>' +
'<option value="1000">1 kHz</option><option value="10000">10 kHz</option>' +
'</select>' +
'<select id="attSel"><option value="0" selected>0 dB</option><option value="1">-10 dB</option><option value="2">-20 dB</option></select>' +
'<button id="nbBtn">NB</button>' +
'<button id="anfBtn">ANF</button>' +
'<button id="nrBtn">NR</button>' +
'</div>' +
// Тулбар 2: S-метр, VFO A/B, RX/TX, диапазон, CW
'<div class="tbar row2">' +
'<canvas id="smeter" width="340" height="64"></canvas>' +
'<div class="vfo-mid">' +
'<button class="vbtn active" id="vBtnA">A</button>' +
'<div id="vDispA" class="vfo-ro"></div>' +
'<div class="swap-g">' +
'<button id="btnBA">B=A</button>' +
'<button id="btnSwap">SWAP</button>' +
'<button id="btnAB">A=B</button>' +
'</div>' +
'<span style="display:inline-block;width:12px"></span>' +
'<button class="vbtn" id="vBtnB">B</button>' +
'<div id="vDispB" class="vfo-ro dim"></div>' +
'</div>' +
'<div class="right-g">' +
'<button id="rxTxBtn">RX</button>' +
'<button id="cwBtn">CW</button>' +
'<button id="modTglBtn">LSB</button>' +
'<select id="bandSel"></select>' +
'<button id="fnpBtn">FNP</button>' +
'</div>' +
'</div>' +
// Спектр / частотная линейка / водопад / статусбар
'<div class="spec-area"><canvas id="spec"></canvas><div class="span-ov" id="spanOv"></div></div>' +
'<div class="ruler-area"><canvas id="ruler"></canvas></div>' +
'<div class="wf-area"><canvas id="wf"></canvas></div>' +
'<div class="sbar"><span id="stEl">connecting...</span><span id="latEl"></span></div>' +
'</div>' +
// ── <script>: весь клиентский JS ───────────────────────────────────────
'<script>' +
// Ссылки на canvas и контексты
'const specCv=document.getElementById("spec"),wfCv=document.getElementById("wf"),' +
'rulerCv=document.getElementById("ruler"),smCv=document.getElementById("smeter");' +
'const sctx=specCv.getContext("2d"),wctx=wfCv.getContext("2d"),' +
'rctx=rulerCv.getContext("2d"),mctx=smCv.getContext("2d");' +
'const wfBuf=document.createElement("canvas"),wfBCtx=wfBuf.getContext("2d");' +
'const stEl=document.getElementById("stEl"),latEl=document.getElementById("latEl");' +
// Состояние
'let cur={},vfoA=14200000,vfoB=14200000,activeVfo="A";' +
'let dragging=false,dragX0=0,dragCen0=0,dragVfo0=0,dragMs=0;' +
'let hoverX=-1,wTarget="",markerOn=false,markerX=0;' +
'let specSm=[],wfAvg=[],wfHi=-50,wfLo=-120;' +
'let audioCtx=null,audioT=0;' +
// AudioContext
'function audioKick(){if(!audioCtx){audioCtx=new(window.AudioContext||window.webkitAudioContext)({sampleRate:48000});audioT=audioCtx.currentTime+0.05;}if(audioCtx.state!=="running")audioCtx.resume();}' +
// Цветовая палитра водопада (256 цветов)
'const PAL=[0x000000,0x000003,0x000006,0x000009,0x00000C,0x00000F,0x000012,0x000015,0x000019,0x00001C,0x00001F,0x000022,0x000025,0x000028,0x00002B,0x00002F,0x000032,0x000035,0x000038,0x00003B,0x00003E,0x000041,0x000045,0x000048,0x00004B,0x00004E,0x000051,0x000054,0x000057,0x00005A,0x00005E,0x000061,0x000064,0x000067,0x00006A,0x00006D,0x000070,0x000074,0x000077,0x00007A,0x00007D,0x000080,0x000083,0x000086,0x00008A,0x00008D,0x000090,0x000093,0x000096,0x000099,0x00009C,0x0000A0,0x0002A2,0x0004A4,0x0006A7,0x0008A9,0x000AAC,0x000CAE,0x000EB1,0x0010B3,0x0012B6,0x0014B8,0x0017BB,0x0019BD,0x001BC0,0x001DC2,0x001FC5,0x0021C7,0x0023CA,0x0025CC,0x0027CF,0x0029D1,0x002BD4,0x002ED6,0x0030D9,0x0032DB,0x0034DE,0x0036E0,0x0038E3,0x003AE5,0x003CE8,0x003EEA,0x0040EC,0x0042EF,0x0045F1,0x0047F4,0x0049F6,0x004BF9,0x004DFB,0x004FFE,0x0052FE,0x0056FD,0x005AFC,0x005DFB,0x0061FA,0x0065F9,0x0068F8,0x006CF7,0x0070F6,0x0073F6,0x0077F5,0x007BF4,0x007EF3,0x0082F2,0x0085F1,0x0089F0,0x008DEF,0x0090EE,0x0094ED,0x0098EC,0x009BEC,0x009FEB,0x00A3EA,0x00A6E9,0x00AAE8,0x00AEE7,0x00B1E6,0x00B5E5,0x00B9E4,0x00BCE3,0x00C0E2,0x00C4E1,0x00C7E1,0x00CBE0,0x00CFDF,0x00D2DE,0x00D6DD,0x00DADC,0x00DCD9,0x00DDD3,0x00DECD,0x00DFC7,0x00E0C2,0x00E1BC,0x00E1B6,0x00E2B0,0x00E3AB,0x00E4A5,0x00E59F,0x00E699,0x00E794,0x00E88E,0x00E98';
Result := Result +
'8,0x00EA82,0x00EB7D,0x00EC77,0x00EC71,0x00ED6B,0x00EE66,0x00EF60,0x00F05A,0x00F154,0x00F24F,0x00F349,0x00F443,0x00F53D,0x00F638,0x00F632,0x00F72C,0x00F826,0x00F921,0x00FA1B,0x00FB15,0x00FC0F,0x00FD0A,0x00FE04,0x01FF00,0x08FF00,0x0EFF00,0x15FF00,0x1CFF00,0x22FF00,0x29FF00,0x30FF00,0x36FF00,0x3DFF00,0x44FF00,0x4AFF00,0x51FF00,0x58FF00,0x5FFF00,0x65FF00,0x6CFF00,0x72FF00,0x79FF00,0x80FF00,0x86FF00,0x8DFF00,0x94FF00,0x9BFF00,0xA1FF00,0xA8FF00,0xAEFF00,0xB5FF00,0xBCFF00,0xC2FF00,0xC9FF00,0xD0FF00,0xD6FF00,0xDDFF00,0xE4FF00,0xEAFF00,0xF1FF00,0xF8FF00,0xFFFF00,0xFFF900,0xFFF300,0xFFED00,0xFFE800,0xFFE200,0xFFDC00,0xFFD600,0xFFD100,0xFFCB00,0xFFC500,0xFFC000,0xFFBA00,0xFFB400,0xFFAE00,0xFFA900,0xFFA300,0xFF9D00,0xFF9800,0xFF9200,0xFF8C00,0xFF8600,0xFF8100,0xFF7B00,0xFF7500,0xFF7000,0xFF6A00,0xFF6400,0xFF5E00,0xFF5900,0xFF5300,0xFF5304,0xFF5C11,0xFF641D,0xFF6D2A,0xFF7536,0xFF7E43,0xFF864F,0xFF8F5C,0xFF9868,0xFFA075,0xFFA982,0xFFB18E,0xFFBA9A,0xFFC2A7,0xFFCBB3,0xFFD4C0,0xFFDCCC,0xFFE5D9,0xFFEDE6,0xFFF6F2,0xFFFFFF];' +
// Утилиты
'const cl=(v,a,b)=>Math.max(a,Math.min(b,v));' +
'const q=id=>document.getElementById(id);' +
'function sw(id,on){const b=q(id);if(b)b.classList.toggle("on",!!on);}' +
'function ws2(obj){if(ws&&ws.readyState===1)ws.send(JSON.stringify(obj));}' +
'function cmd(c,v){ws2({cmd:c,on:v});}' +
// Режимы и группы
'const MODE_N=["LSB","USB","DSB","CWL","CWU","FM","AM","SAM"];' +
'const GRP_MAP={ssb:[0,1],cw:[3,4],fm:[5,5],am:[6,7]};' +
'function modGrp(){return q("modGrpSel").value||"ssb";}' +
'function modTglTarget(){const grp=GRP_MAP[modGrp()];const cur_m=cur.mode||0;return(cur_m===grp[0])?grp[1]:grp[0];}' +
'function updModTglLabel(){const b=q("modTglBtn");if(!b)return;b.textContent=MODE_N[modTglTarget()];}' +
'function syncModGrp(m){const g=m<=1?"ssb":m<=4?"cw":m===5?"fm":"am";const s=q("modGrpSel");if(s&&s.value!==g)s.value=g;}' +
'q("modGrpSel").onchange=function(){updModTglLabel();};' +
'q("modTglBtn").onclick=function(){audioKick();ws2({cmd:"mode",mode:modTglTarget()});};' +
'q("cwBtn").onclick=function(){audioKick();ws2({cmd:"mode",mode:cur.mode===3?4:3});};' +
'q("agcSel").onchange=function(e){ws2({cmd:"agc",mode:+e.target.value});};' +
// Слайдеры
'q("volSl").oninput=function(e){ws2({cmd:"volume",v:+e.target.value});var v=q("volVal");if(v)v.textContent=e.target.value;};' +
'q("rfSl").oninput=function(e){ws2({cmd:"agctop",db:+e.target.value});var v=q("rfVal");if(v)v.textContent=e.target.value+"dB";};' +
'q("txSl").oninput=function(e){var v=q("txVal");if(v)v.textContent=e.target.value;};' +
// DSP кнопки
'q("nrBtn").onclick=function(){cmd("set_nr",!cur.nr);};' +
'q("nbBtn").onclick=function(){cmd("set_nb",!cur.nb);};' +
'q("anfBtn").onclick=function(){cmd("set_anf",!cur.anf);};' +
// VFO отображение
'let stA=0,stAmem=100,stB=0,stBmem=100;' +
'function fmtVfo(hz,step){' +
'const s=String(Math.max(0,Math.round(hz||0))).padStart(9,"0");' +
'let h="",seenNZ=false;' +
'for(let i=0;i<6;i++){' +
'const st=Math.pow(10,8-i);' +
'if(s[i]!=="0")seenNZ=true;' +
'const lead=(!seenNZ)?" lead":"";' +
'const sel=(step>0&&st===step)?" sel":"";' +
'h+="<span class=\"dg"+lead+sel+" data-s=\""+st+"\">"+s[i]+"</span>";' +
'if(i===2)h+="<span class=\"sp\">.</span>";}' +
'h+="<span class=\"sp\">.</span>";' +
'h+="<span class=\"vfo-hz\">";' +
'for(let i=6;i<9;i++){const st=Math.pow(10,8-i);' +
'const sel=(step>0&&st===step)?" sel":"";' +
'h+="<span class=\"dg"+sel+" data-s=\""+st+"\">"+s[i]+"</span>";}' +
'return h;}' +
'function renderVfos(){q("vDispA").innerHTML=fmtVfo(vfoA,stA);q("vDispB").innerHTML=fmtVfo(vfoB,stB);}' +
// Привязка событий VFO (колесо, клик по цифре, dblclick)
'function bindVfo(dispId,getHz,setHz,getSt,setSt,getMem,setMem){' +
'const el=q(dispId);' +
'el.addEventListener("mousemove",e=>{const t=e.target,s=Number(t?.dataset?.s||0);if(s>0){setSt(s);setMem(s);renderVfos();}});' +
'el.addEventListener("click",e=>{const t=e.target,s=Number(t?.dataset?.s||0);if(s>0){setSt(s);setMem(s);}});' +
'el.addEventListener("mouseleave",()=>{if(getSt()!==0){setSt(0);renderVfos();}});' +
'el.addEventListener("wheel",e=>{e.preventDefault();e.stopPropagation();audioKick();' +
'const dir=e.deltaY<0?1:-1,st=getSt()||getMem()||100;' +
'const nf=cl(Math.round(getHz())+st*dir,30000,60000000);' +
'setHz(nf);renderVfos();ws2({cmd:"freq",hz:nf});},{passive:false});' +
'el.addEventListener("dblclick",()=>{' +
'const s=prompt("Set Hz",String(Math.round(getHz())));if(!s)return;' +
'const f=parseInt(s.replace(/[^0-9]/g,""),10);if(!isFinite(f))return;' +
'const nf=cl(f,30000,60000000);setHz(nf);renderVfos();ws2({cmd:"freq",hz:nf});' +
'});}' +
'bindVfo("vDispA",()=>vfoA,v=>{vfoA=v;},()=>stA,v=>{stA=v;},()=>stAmem,v=>{stAmem=v;});' +
'bindVfo("vDispB",()=>vfoB,v=>{vfoB=v;},()=>stB,v=>{stB=v;},()=>stBmem,v=>{stBmem=v;});' +
// Переключение активного VFO, кнопки A=B/B=A/SWAP
'function selVfo(w){activeVfo=w;q("vBtnA").classList.toggle("active",w==="A");q("vBtnB").classList.toggle("active",w==="B");q("vDispA").classList.toggle("dim",w!="A");q("vDispB").classList.toggle("dim",w!="B");ws2({cmd:"freq",hz:Math.round(w==="A"?vfoA:vfoB)});}' +
'q("vBtnA").onclick=()=>selVfo("A");' +
'q("vBtnB").onclick=()=>selVfo("B");' +
'q("btnBA").onclick=()=>{vfoA=vfoB;renderVfos();ws2({cmd:"freq",hz:Math.round(vfoA)});};' +
'q("btnAB").onclick=()=>{vfoB=vfoA;renderVfos();};' +
'q("btnSwap").onclick=()=>{const t=vfoA;vfoA=vfoB;vfoB=t;renderVfos();ws2({cmd:"freq",hz:Math.round(activeVfo==="A"?vfoA:vfoB)});};' +
// RX/TX и Mute
'q("rxTxBtn").onclick=()=>{audioKick();cmd("set_run",!cur.running);};' +
'function updRunBtn(r){const b=q("rxTxBtn");b.textContent=r?"TX":"RX";b.classList.toggle("rx-tx",!!r);}' +
'q("muteIc").onclick=()=>{cur.mute=!cur.mute;q("muteIc").textContent=cur.mute?"\uD83D\uDD07":"\uD83D\uDD0A";cmd("set_mute",cur.mute);};' +
// Кнопки выбора полосы обзора (SPAN)
'const SPANS=[3000,6000,12000,24000,48000,96000,192000,384000,480000,960000];' +
'const SPAN_L=["3K","6K","12K","24K","48K","96K","192K","384K","480K","960K"];' +
'(function(){const c=q("spanOv");SPANS.forEach((hz,i)=>{const b=document.createElement("button");b.className="sp-btn";b.id="sb"+i;b.textContent=SPAN_L[i];b.onclick=()=>ws2({cmd:"span",hz});c.appendChild(b);});})();' +
'function updSpan(s){SPANS.forEach((hz,i)=>{const b=q("sb"+i);if(b)b.classList.toggle("on",hz===s);});}' +
// Список диапазонов
'const BAND_N=["160m","80m","60m","40m","30m","20m","17m","15m","12m","10m","6m"];' +
'const BAND_F=[1900000,3750000,5357000,7100000,10125000,14200000,18120000,21200000,24940000,28500000,50150000];' +
'(function(){const s=q("bandSel");BAND_N.forEach((n,i)=>{const o=document.createElement("option");o.value=i;o.textContent=n;s.appendChild(o);});s.onchange=()=>ws2({cmd:"band",idx:+s.value});})();' +
'function updBand(vfo){let bi=0,bd=1e15;BAND_F.forEach((f,i)=>{const d=Math.abs((vfo||0)-f);if(d<bd){bd=d;bi=i;}});q("bandSel").value=bi;}' +
// S-метр
'let smAvg=-130,smPeak=-130,smMin=-130;' +
'function dbToX(db,bx,bw){return Math.max(bx,Math.min(bx+bw,Math.round(bx+(db+127)/127*bw)));}' +
'function paintSM(dbm){' +
'const w=smCv.clientWidth||340,h=smCv.clientHeight||64;' +
'const AVG_ALPHA=0.40,ZONE_DB=6,PEAK_BASE=0.12,MIN_BASE=0.12,ACCEL=0.030,MAX_A=0.92;' +
'const DBM_MARKS=[-120,-100,-80,-60,-40,-20,0];' +
'const DBM_LABELS=["-120","-100","-80","-60","-40","-20","0"];' +
'const S_MARKS_DBM=[-121,-115,-109,-103,-93,-83,-73,-53,-33];' +
'const S_MARKS_LBL=["S1","S3","S5","S7","S9","+10","+20","+40","+60"];' +
'const TICK_LONG=5,TICK_MED=3;' +
'smAvg=smAvg*(1-AVG_ALPHA)+dbm*AVG_ALPHA;' +
'const pTarget=Math.max(dbm,smAvg+ZONE_DB),mTarget=Math.min(dbm,smAvg-ZONE_DB);' +
'const pA=Math.min(MAX_A,PEAK_BASE+Math.abs(pTarget-smPeak)*ACCEL);' +
'const mA=Math.min(MAX_A,MIN_BASE+Math.abs(mTarget-smMin)*ACCEL);' +
'smPeak+=pA*(pTarget-smPeak);smMin+=mA*(mTarget-smMin);' +
'const BX=62,BW=Math.max(10,w-66);' +
'const YT=Math.round(h*36/100),YB=Math.round(h*66/100);' +
'const S9X=dbToX(-73,BX,BW),OVRX=dbToX(-43,BX,BW);' +
'mctx.fillStyle="#0c0c0c";mctx.fillRect(0,0,w,h);' +
'mctx.fillStyle="#061006";mctx.fillRect(BX,YT,S9X-BX,YB-YT);' +
'mctx.fillStyle="#0A1006";mctx.fillRect(S9X,YT,OVRX-S9X,YB-YT);' +
'mctx.fillStyle="#060A10";mctx.fillRect(OVRX,YT,BX+BW-OVRX,YB-YT);' +
'const barEnd=dbToX(dbm,BX,BW);' +
'if(barEnd>BX){mctx.fillStyle="#091F00";mctx.fillRect(BX,YT+1,Math.min(barEnd,S9X)-BX,YB-YT-2);' +
'if(barEnd>S9X){mctx.fillStyle="#091528";mctx.fillRect(S9X,YT+1,barEnd-S9X,YB-YT-2);}}' +
'const px1=Math.max(BX+1,Math.min(dbToX(smMin,BX,BW),dbToX(smPeak,BX,BW)));' +
'const px2=Math.min(BX+BW-1,Math.max(dbToX(smMin,BX,BW),dbToX(smPeak,BX,BW)));' +
'if(px2>px1){mctx.fillStyle="rgba(255,255,255,0.25)";mctx.fillRect(px1,YT+1,px2-px1,YB-YT-2);}' +
'const pX=dbToX(smPeak,BX,BW);' +
'mctx.strokeStyle="#F8F8FF";mctx.lineWidth=2;mctx.beginPath();mctx.moveTo(pX,YT);mctx.lineTo(pX,YB);mctx.stroke();' +
'mctx.lineWidth=1;mctx.strokeStyle="#303028";mctx.strokeRect(BX,YT,BW,YB-YT);' +
'mctx.font="10px Courier New";' +
'for(let i=0;i<DBM_MARKS.length;i++){const x=dbToX(DBM_MARKS[i],BX,BW);' +
'mctx.strokeStyle="#DCE0E0";mctx.lineWidth=1;mctx.beginPath();mctx.moveTo(x,YT-TICK_LONG);mctx.lineTo(x,YT-1);mctx.stroke();' +
'const t=DBM_LABELS[i],tw=mctx.measureText(t).width;' +
'mctx.fillStyle="#DCDCD0";mctx.fillText(t,Math.round(x-tw/2),YT-TICK_LONG-1);}' +
'for(let d=-125;d<0;d+=5){const x=dbToX(d,BX,BW);' +
'mctx.strokeStyle="#708070";mctx.lineWidth=1;mctx.beginPath();mctx.moveTo(x,YT-TICK_MED);mctx.lineTo(x,YT-1);mctx.stroke();}' +
'for(let i=0;i<S_MARKS_DBM.length;i++){const x=dbToX(S_MARKS_DBM[i],BX,BW),ov=S_MARKS_DBM[i]>=-73;' +
'mctx.strokeStyle=ov?"#70A090":"#708070";mctx.lineWidth=1;mctx.beginPath();mctx.moveTo(x,YB+1);mctx.lineTo(x,YB+TICK_LONG);mctx.stroke();' +
'const t=S_MARKS_LBL[i],tw=mctx.measureText(t).width;' +
'mctx.fillStyle=ov?"#90D090":"#E0E0E0";mctx.fillText(t,Math.round(x-tw/2),YB+TICK_LONG+9);}' +
'mctx.fillStyle="#DCD896";mctx.font="bold 12px Courier New";' +
'mctx.fillText(dbm.toFixed(1).padStart(6," "),1,12);' +
'mctx.fillStyle="#707050";mctx.font="10px Courier New";mctx.fillText("dBm",1,YT-2);' +
'let sLbl;if(dbm<-93){let sv=Math.round((dbm+127)/6);if(sv<1)sv=1;if(sv>9)sv=9;sLbl="S"+sv;}' +
'else sLbl="S9+"+Math.round(dbm+93);' +
'mctx.fillStyle="#F0F0F0";mctx.font="bold 12px Courier New";mctx.fillText(sLbl,1,YB+TICK_LONG+10);}' +
// Применение state от сервера
'function applyState(msg){' +
'cur=msg;vfoA=msg.vfo_a_hz||vfoA;renderVfos();' +
'const as=q("agcSel");if(as&&msg.agc_mode!=null)as.value=msg.agc_mode;' +
'const vs=q("volSl");if(vs&&!vs.matches(":active")){vs.value=msg.volume||70;var vv=q("volVal");if(vv)vv.textContent=msg.volume||70;}' +
'const rs=q("rfSl");if(rs&&!rs.matches(":active")){rs.value=msg.agc_top||90;var rv=q("rfVal");if(rv)rv.textContent=(msg.agc_top||90)+"dB";}' +
'sw("nrBtn",!!msg.nr);sw("nbBtn",!!msg.nb);sw("anfBtn",!!msg.anf);' +
'updRunBtn(!!msg.running);syncModGrp(msg.mode||0);updModTglLabel();' +
'updBand(msg.vfo_a_hz||0);updSpan(msg.span_hz||192000);' +
'paintSM(Number(msg.smeter_dbm||-130));' +
'const mn=msg.mode_name||(MODE_N[msg.mode||0]||"?");' +
'stEl.textContent=(msg.connected?"OK":"OFF")+" | "+(msg.running?"RUN":"STOP")+" | "+mn+" | "+((vfoA/1e6).toFixed(3))+" MHz";}' +
// Waterfall palette lookup и фильтр
'function pal(db){const v=Math.round(cl((db-wfLo)/Math.max(1,wfHi-wfLo),0,1)*255);const c=PAL[v]|0;return[(c>>16)&255,(c>>8)&255,c&255];}' +
'function fltLH(){const bw=cur.filter_bw||2700;const m=cur.mode|0;if(m===0)return[-bw,-100];if(m===1)return[100,bw];return[-bw/2,bw/2];}' +
'function xToHz(x,w){return(cur.center_hz||0)+((x/Math.max(1,w))-.5)*(cur.span_hz||0);}' +
'function hzToX(f,w){return((f-(cur.center_hz||0))/(cur.span_hz||1)+.5)*w;}' +
// Маркер частоты
'function drawMk(ctx,w,h){if(!markerOn)return;ctx.save();ctx.strokeStyle="rgba(255,80,80,.85)";ctx.lineWidth=1;ctx.beginPath();ctx.moveTo(markerX,0);ctx.lineTo(markerX,h);ctx.stroke();' +
'const lbl=((xToHz(markerX,w))/1e6).toFixed(4)+" M";ctx.fillStyle="rgba(35,5,5,.82)";ctx.fillRect(cl(markerX+5,0,w-88),h-16,84,13);ctx.fillStyle="#f88";ctx.font="10px monospace";ctx.fillText(lbl,cl(markerX+8,2,w-86),h-6);ctx.restore();}' +
// Частотная линейка
'function drawRuler(){const w=rulerCv.clientWidth,h=rulerCv.clientHeight;rctx.fillStyle="#0c1210";rctx.fillRect(0,0,w,h);' +
'const st=(cur.center_hz||0)-(cur.span_hz||0)/2;' +
'for(let i=0;i<=8;i++){const x=i*w/8,f=st+i*(cur.span_hz||0)/8;rctx.strokeStyle="#2a3a2e";rctx.lineWidth=1;rctx.beginPath();rctx.moveTo(x+.5,0);rctx.lineTo(x+.5,7);rctx.stroke();rctx.fillStyle="#7a9a80";rctx.font="10px monospace";const t=(f/1e6).toFixed(3);rctx.fillText(t,x-14,21);}' +
'const vx=hzToX(vfoA,w);rctx.strokeStyle="#60d070";rctx.lineWidth=1;rctx.beginPath();rctx.moveTo(vx+.5,0);rctx.lineTo(vx+.5,h);rctx.stroke();}' +
// Спектр
'function drawSpec(bins){const w=specCv.clientWidth,h=specCv.clientHeight;sctx.fillStyle="#050a05";sctx.fillRect(0,0,w,h);' +
'for(let i=1;i<5;i++){const y=i*h/5;sctx.strokeStyle="#121e12";sctx.lineWidth=1;sctx.beginPath();sctx.moveTo(0,y);sctx.lineTo(w,y);sctx.stroke();}' +
'if(!bins?.length){drawMk(sctx,w,h);return;}' +
'if(specSm.length!==bins.length)specSm=new Array(bins.length).fill(-130);' +
'const[fl,fh]=fltLH(),x1=hzToX(vfoA+fl,w),x2=hzToX(vfoA+fh,w);' +
'sctx.fillStyle="rgba(80,150,255,.12)";sctx.fillRect(Math.min(x1,x2),0,Math.abs(x2-x1),h);' +
'sctx.beginPath();for(let x=0;x<w;x++){const i=Math.floor(x*(bins.length-1)/Math.max(1,w-1));specSm[i]=specSm[i]*.70+bins[i]*.30;const y=cl(((-specSm[i]-20)/120)*h,0,h-1);x===0?sctx.moveTo(0,y):sctx.lineTo(x,y);}' +
'const g=sctx.createLinearGradient(0,0,0,h);g.addColorStop(0,"rgba(60,230,60,.2)");g.addColorStop(1,"rgba(60,230,60,.01)");' +
'sctx.lineTo(w,h);sctx.lineTo(0,h);sctx.closePath();sctx.fillStyle=g;sctx.fill();' +
'sctx.beginPath();for(let x=0;x<w;x++){const i=Math.floor(x*(bins.length-1)/Math.max(1,w-1));const y=cl(((-specSm[i]-20)/120)*h,0,h-1);x===0?sctx.moveTo(0,y):sctx.lineTo(x,y);}' +
'sctx.strokeStyle="#3ddd3d";sctx.lineWidth=1.2;sctx.stroke();' +
'const vx=hzToX(vfoA,w);sctx.strokeStyle="#60ff80";sctx.lineWidth=1;sctx.beginPath();sctx.moveTo(vx,0);sctx.lineTo(vx,h);sctx.stroke();drawMk(sctx,w,h);}' +
// Водопад
'function drawWf(bins){const w=wfCv.clientWidth,h=wfCv.clientHeight;' +
'if(!bins?.length){drawMk(wctx,w,h);return;}' +
'if(wfBuf.width!==w||wfBuf.height!==h){wfBuf.width=w;wfBuf.height=h;wfBCtx.fillStyle="#000";wfBCtx.fillRect(0,0,w,h);}' +
'if(wfAvg.length!==bins.length){wfAvg=new Array(bins.length).fill(-120);wfHi=-50;wfLo=-120;}' +
'const useAgc=cur.wf_agc!==false;const useNf=cur.wf_nf!==false;' +
'for(let i=0;i<bins.length;i++){wfAvg[i]=wfAvg[i]*.75+bins[i]*.25;}' +
'let peak=-200,nfSum=0,nfCount=0;' +
'for(let i=0;i<bins.length;i++){if(wfAvg[i]>peak)peak=wfAvg[i];}' +
'for(let i=0;i<bins.length;i++){if(wfAvg[i]<wfLo+15){nfSum+=wfAvg[i];nfCount++;}}' +
'if(peak>wfHi)wfHi=peak+5;else wfHi=wfHi+0.02*((peak+5)-wfHi);' +
'if(nfCount>10)wfLo=wfLo+0.005*(((nfSum/nfCount)-5)-wfLo);' +
'let hHi=wfHi,hLo=wfLo;if(hHi<hLo+15)hHi=hLo+15;' +
'if(hHi>0)hHi=0;if(hLo<-160)hLo=-160;wfHi=hHi;wfLo=hLo;' +
'wfBCtx.drawImage(wfBuf,0,0,w,h-1,0,1,w,h-1);const row=wfBCtx.createImageData(w,1);' +
'for(let x=0;x<w;x++){const i=Math.floor(x*(wfAvg.length-1)/Math.max(1,w-1));const[r,g,b]=pal(wfAvg[i]);const o=x*4;row.data[o]=r;row.data[o+1]=g;row.data[o+2]=b;row.data[o+3]=255;}' +
'wfBCtx.putImageData(row,0,0);wctx.drawImage(wfBuf,0,0,w,h);' +
'const[fl,fh]=fltLH(),x1=hzToX(vfoA+fl,w),x2=hzToX(vfoA+fh,w);' +
'wctx.fillStyle="rgba(220,230,230,.10)";wctx.fillRect(Math.min(x1,x2),0,Math.abs(x2-x1),h);' +
'const vx=hzToX(vfoA,w);wctx.strokeStyle="#60ff80";wctx.lineWidth=1;wctx.beginPath();wctx.moveTo(vx,0);wctx.lineTo(vx,h);wctx.stroke();drawMk(wctx,w,h);}' +
// Resize с учётом devicePixelRatio
'function rcv(cv){const dpr=Math.max(1,devicePixelRatio||1),w=cv.clientWidth|0,h=cv.clientHeight|0;if(cv.width!==(w*dpr|0)||cv.height!==(h*dpr|0)){cv.width=w*dpr;cv.height=h*dpr;cv.getContext("2d").setTransform(dpr,0,0,dpr,0,0);}}' +
'function resize(){rcv(specCv);rcv(wfCv);rcv(rulerCv);const sw=smCv.clientWidth|0,sh=smCv.clientHeight|0;if(smCv.width!==sw||smCv.height!==sh){smCv.width=sw;smCv.height=sh;}if(wfBuf.width!==wfCv.clientWidth||wfBuf.height!==wfCv.clientHeight){wfBuf.width=wfCv.clientWidth;wfBuf.height=wfCv.clientHeight;wfBCtx.fillStyle="#000";wfBCtx.fillRect(0,0,wfBuf.width,wfBuf.height);}}' +
// Управление мышью: шаг, колесо, перетаскивание
'function tuneStep(e){const s=+q("stepSel").value||100;if(e.ctrlKey&&e.shiftKey)return 1000000;if(e.ctrlKey)return 1000;if(e.shiftKey)return 10;return s;}' +
'function doWheel(e){e.preventDefault();e.stopPropagation();audioKick();const dir=e.deltaY<0?1:-1,st=tuneStep(e),base=Math.floor(vfoA/st)*st;vfoA=cl(dir>0?base+st:(Math.round(vfoA)===base?base-st:base),30000,60000000);cur.vfo_a_hz=vfoA;renderVfos();ws2({cmd:"freq",hz:vfoA});}' +
'function bindCv(cv){let wT=0;const wh=e=>{const n=performance.now();if(n-wT<20)return;wT=n;wTarget=cv.id;doWheel(e);};' +
'cv.addEventListener("contextmenu",e=>e.preventDefault());' +
'cv.addEventListener("mouseenter",()=>{wTarget=cv.id;});' +
'cv.addEventListener("wheel",wh,{passive:false,capture:true});' +
'cv.addEventListener("mousedown",e=>{audioKick();wTarget=cv.id;if(e.button===2){markerOn=Math.abs(markerX-e.offsetX)>=8||!markerOn;markerX=e.offsetX;return;}if(e.button!==0)return;dragging=true;dragX0=e.offsetX;dragCen0=cur.center_hz||0;dragVfo0=vfoA;dragMs=0;});' +
'cv.addEventListener("mousemove",e=>{wTarget=cv.id;hoverX=e.offsetX;if(markerOn)markerX=e.offsetX;if(!dragging)return;const n=Date.now();if(n-dragMs<35)return;dragMs=n;const dHz=(e.offsetX-dragX0)/Math.max(1,cv.clientWidth)*(cur.span_hz||0);if(cur.ctun)ws2({cmd:"freq",hz:Math.round(dragCen0-dHz)});else{vfoA=cl(Math.round(dragVfo0-dHz),30000,60000000);cur.vfo_a_hz=vfoA;renderVfos();ws2({cmd:"freq",hz:vfoA});}});' +
'cv.addEventListener("mouseup",e=>{if(e.button===2)return;if(Math.abs(e.offsetX-dragX0)<4){vfoA=cl(Math.round(xToHz(e.offsetX,cv.clientWidth)/100)*100,30000,60000000);cur.vfo_a_hz=vfoA;renderVfos();ws2({cmd:"freq",hz:vfoA});}dragging=false;});' +
'cv.addEventListener("mouseleave",()=>{if(!markerOn)hoverX=-1;wTarget="";dragging=false;});}' +
'bindCv(specCv);bindCv(wfCv);' +
'window.addEventListener("wheel",e=>{if(e.target?.closest?.(".vfo-ro"))return;if(!wTarget){if(e.target===specCv)wTarget="spec";else if(e.target===wfCv)wTarget="wf";}if(wTarget)doWheel(e);},{passive:false,capture:true});' +
// Opus декодер (CDN) и воспроизведение
'let ws=null,opDec=null,opRdy=false;' +
'async function initOpus(){if(opRdy)return;' +
'try{const m=await import("https://cdn.jsdelivr.net/npm/opus-decoder@0.7.7/+esm");' +
'opDec=new m.OpusDecoder({channels:1,sampleRate:48000});' +
'await opDec.ready;opRdy=true;}catch(e){console.error("Opus init:",e);}}' +
'function playOpus(b){if(!opRdy||!audioCtx||!b?.length)return;' +
'try{const r=opDec.decodeFrame(b);' +
'if(!r||!r.channelData||!r.samplesDecoded)return;' +
'const pcm=r.channelData[0];' +
'const buf=audioCtx.createBuffer(1,r.samplesDecoded,48000);' +
'buf.copyToChannel(pcm.subarray(0,r.samplesDecoded),0);' +
'const src=audioCtx.createBufferSource();src.buffer=buf;src.connect(audioCtx.destination);' +
'const now=audioCtx.currentTime;' +
'if(audioT<now-.05||audioT>now+.5)audioT=now+.02;' +
'src.start(audioT);audioT+=r.samplesDecoded/48000;' +
'latEl.textContent="lat: "+Math.max(0,(audioT-now)*1000).toFixed(0)+"ms | Opus";' +
'}catch(e){console.error("playOpus:",e);}}' +
// WebSocket подключение и обработка сообщений
'function connect(){const p=location.protocol==="https:"?"wss":"ws";ws=new WebSocket(p+"://"+location.host+"/ws");ws.binaryType="arraybuffer";' +
'ws.onopen=()=>{stEl.textContent="connected";initOpus().then(()=>{latEl.textContent=opRdy?"Opus ready":"Opus FAILED";});};' +
'ws.onclose=()=>{stEl.textContent="disconnected...";setTimeout(connect,3000);};' +
'ws.onerror=()=>ws.close();' +
'ws.onmessage=e=>{if(typeof e.data==="string"){try{applyState(JSON.parse(e.data));}catch(x){}return;}' +
'const ab=e.data,t=(new DataView(ab)).getUint8(0);' +
'if(t===0x53){const n=(ab.byteLength-1)>>2;const tmp=new Uint8Array(ab,1);const al=new ArrayBuffer(n*4);new Uint8Array(al).set(tmp);const b=Array.from(new Float32Array(al));drawSpec(b);drawWf(b);drawRuler();}' +
'else if(t===0x41){audioKick();if(opRdy)playOpus(new Uint8Array(ab,1));}};}' +
// Инициализация
'window.addEventListener("resize",resize);resize();renderVfos();connect();' +
'document.addEventListener("click",()=>{if(audioCtx?.state==="suspended")audioCtx.resume();});' +
'</script></body></html>';
end;
end.
+1131
View File
File diff suppressed because it is too large Load Diff
+334
View File
@@ -0,0 +1,334 @@
unit WebUtils;
{
WebUtils.pas Вспомогательные функции для WebServer:
- Кросс-платформенные обёртки сокетов (Windows/Linux)
- SHA-1 (минимальная реализация для WebSocket handshake)
- Base64 (кодирование)
- JSON helpers (JsonGetStr, JsonGetFloat, JsonGetInt, JsonGetBool)
- AudioLog (отладочное логирование аудио)
ИСПРАВЛЕНИЯ:
- (Windows build fix) Порядок uses: стандартные RTL-юниты первыми,
платформенные (WinSock2) последними исключает конфликт
идентификатора Create в режиме {$MODE Delphi} под Windows.
- (Linux shutdown fix) Добавлена SockShutdown вызов shutdown(SHUT_RDWR)
перед close, что немедленно прерывает заблокированные fpAccept/fpRecv
в других потоках и предотвращает зависание при закрытии программы.
}
{$IFDEF FPC}
{$MODE Delphi}
{$LONGSTRINGS ON}
{$ENDIF}
interface
uses
SysUtils, Math
{$IFDEF WINDOWS}, Windows, WinSock2{$ELSE}, BaseUnix, Sockets{$ENDIF};
{ ── Кросс-платформенные константы сокетов ─────────────────────────────────── }
{$IFDEF WINDOWS}
const
SOCK_INVALID = INVALID_SOCKET;
SOCK_ERR = SOCKET_ERROR;
{$ELSE}
const
SOCK_INVALID = TSocket(-1);
SOCK_ERR = -1;
INVALID_SOCKET = TSocket(-1);
{$ENDIF}
{ ── Обёртки системных вызовов сокетов ─────────────────────────────────────── }
function SockClose(S: TSocket): Integer; inline;
{ SockShutdown прерывает все блокирующие recv/accept на сокете в других
потоках. На Linux необходимо вызывать ДО SockClose, иначе потоки не
разблокируются и программа зависнет при завершении.
На Windows работает через SD_BOTH. }
procedure SockShutdown(S: TSocket);
function SockRecv(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer; inline;
function SockSend(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer; inline;
procedure SockSetNonBlock(S: TSocket; NB: Boolean);
{ ── SHA-1 ─────────────────────────────────────────────────────────────────── }
type
TSHA1Digest = array[0..19] of Byte;
TSHA1State = array[0..4] of LongWord;
procedure SHA1Transform(var S: TSHA1State; const Block: array of Byte);
function SHA1(const Data: string): TSHA1Digest;
{ ── Base64 ───────────────────────────────────────────────────────────────── }
function Base64EncodeBytes(const Data: array of Byte; Len: Integer): string;
function Base64EncodeStr(const S: string): string;
{ ── JSON helpers ─────────────────────────────────────────────────────────── }
function JsonGetStr(const Json, Key: string): string;
function JsonGetFloat(const Json, Key: string; Def: Double): Double;
function JsonGetInt(const Json, Key: string; Def: Integer): Integer;
function JsonGetBool(const Json, Key: string; Def: Boolean): Boolean;
{ ── Отладочное логирование аудио ─────────────────────────────────────────── }
procedure AudioLog(const S: string);
implementation
{ ═══════════════════════════════════════════════════════════════════════════
Кросс-платформенные обёртки сокетов
═══════════════════════════════════════════════════════════════════════════ }
{$IFDEF WINDOWS}
function SockClose(S: TSocket): Integer;
begin
Result := closesocket(S);
end;
procedure SockShutdown(S: TSocket);
begin
// SD_BOTH = 2 — прерывает и recv и send, разблокирует accept/recv в других потоках
shutdown(S, SD_BOTH);
end;
function SockRecv(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer;
begin
Result := recv(S, Buf^, Len, Flags);
end;
function SockSend(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer;
begin
Result := send(S, Buf^, Len, Flags);
end;
procedure SockSetNonBlock(S: TSocket; NB: Boolean);
var Mode: LongWord;
begin
Mode := Ord(NB);
ioctlsocket(S, FIONBIO, @Mode);
end;
{$ELSE}
function SockClose(S: TSocket): Integer;
begin
Result := fpClose(S);
end;
procedure SockShutdown(S: TSocket);
begin
// SHUT_RDWR = 2 — прерывает все блокирующие fpAccept/fpRecv в других потоках.
// На Linux одного fpClose недостаточно — он не прерывает системный вызов
// в чужом потоке. После shutdown поток получит 0 или ECONNRESET и выйдет.
fpShutdown(S, 2 {SHUT_RDWR});
end;
function SockRecv(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer;
begin
Result := fpRecv(S, Buf, Len, Flags);
end;
function SockSend(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer;
begin
Result := fpSend(S, Buf, Len, Flags);
end;
procedure SockSetNonBlock(S: TSocket; NB: Boolean);
var Flags: Integer;
begin
Flags := fpFcntl(S, F_GETFL, 0);
if NB then Flags := Flags or O_NONBLOCK
else Flags := Flags and (not O_NONBLOCK);
fpFcntl(S, F_SETFL, Flags);
end;
{$ENDIF}
{ ═══════════════════════════════════════════════════════════════════════════
SHA-1 (минимальная реализация для WebSocket handshake)
═══════════════════════════════════════════════════════════════════════════ }
procedure SHA1Transform(var S: TSHA1State; const Block: array of Byte);
var
W: array[0..79] of LongWord;
i: Integer;
a, b, c, d, e, t, f, k: LongWord;
begin
for i := 0 to 15 do
W[i] := (Block[i*4] shl 24) or (Block[i*4+1] shl 16) or
(Block[i*4+2] shl 8) or Block[i*4+3];
for i := 16 to 79 do
begin
t := W[i-3] xor W[i-8] xor W[i-14] xor W[i-16];
W[i] := (t shl 1) or (t shr 31);
end;
a := S[0]; b := S[1]; c := S[2]; d := S[3]; e := S[4];
for i := 0 to 79 do
begin
if i < 20 then begin f := (b and c) or ((not b) and d); k := $5A827999; end
else if i < 40 then begin f := b xor c xor d; k := $6ED9EBA1; end
else if i < 60 then begin f := (b and c) or (b and d) or (c and d); k := $8F1BBCDC; end
else begin f := b xor c xor d; k := $CA62C1D6; end;
t := ((a shl 5) or (a shr 27)) + f + e + k + W[i];
e := d; d := c; c := (b shl 30) or (b shr 2); b := a; a := t;
end;
Inc(S[0], a); Inc(S[1], b); Inc(S[2], c); Inc(S[3], d); Inc(S[4], e);
end;
function SHA1(const Data: string): TSHA1Digest;
var
S: TSHA1State;
Buf: array[0..63] of Byte;
Len, BitLen, i, Pad: Integer;
begin
S[0] := $67452301; S[1] := $EFCDAB89;
S[2] := $98BADCFE; S[3] := $10325476; S[4] := $C3D2E1F0;
Len := Length(Data);
BitLen := Len * 8;
i := 0;
while i + 64 <= Len do
begin
Move(Data[i+1], Buf[0], 64);
SHA1Transform(S, Buf);
Inc(i, 64);
end;
Pad := Len - i;
FillChar(Buf[0], 64, 0);
if Pad > 0 then Move(Data[i+1], Buf[0], Pad);
Buf[Pad] := $80;
if Pad >= 55 then
begin
SHA1Transform(S, Buf);
FillChar(Buf[0], 64, 0);
end;
Buf[63] := Byte(BitLen); Buf[62] := Byte(BitLen shr 8);
Buf[61] := Byte(BitLen shr 16); Buf[60] := Byte(BitLen shr 24);
SHA1Transform(S, Buf);
for i := 0 to 4 do
begin
Result[i*4] := Byte(S[i] shr 24); Result[i*4+1] := Byte(S[i] shr 16);
Result[i*4+2] := Byte(S[i] shr 8); Result[i*4+3] := Byte(S[i]);
end;
end;
{ ═══════════════════════════════════════════════════════════════════════════
Base64
═══════════════════════════════════════════════════════════════════════════ }
const
B64Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function Base64EncodeBytes(const Data: array of Byte; Len: Integer): string;
var
i, j, n: Integer;
begin
Result := '';
i := 0;
while i < Len do
begin
n := Data[i] shl 16;
if i+1 < Len then n := n or (Data[i+1] shl 8);
if i+2 < Len then n := n or Data[i+2];
Result := Result
+ B64Chars[(n shr 18) and 63 + 1]
+ B64Chars[(n shr 12) and 63 + 1]
+ B64Chars[(n shr 6) and 63 + 1]
+ B64Chars[ n and 63 + 1];
Inc(i, 3);
end;
j := Len mod 3;
if j = 1 then begin Result[Length(Result)-1] := '='; Result[Length(Result)] := '='; end
else if j = 2 then Result[Length(Result)] := '=';
end;
function Base64EncodeStr(const S: string): string;
var
B: array of Byte;
i: Integer;
begin
SetLength(B, Length(S));
for i := 1 to Length(S) do B[i-1] := Ord(S[i]);
Result := Base64EncodeBytes(B, Length(S));
end;
{ ═══════════════════════════════════════════════════════════════════════════
JSON helpers (минимальный парсер без зависимостей)
═══════════════════════════════════════════════════════════════════════════ }
function JsonGetStr(const Json, Key: string): string;
var
P, P2: Integer;
K: string;
begin
Result := '';
K := '"' + Key + '"';
P := System.Pos(K, Json);
if P = 0 then Exit;
Inc(P, Length(K));
while (P <= Length(Json)) and (Json[P] in [' ', ':']) do Inc(P);
if P > Length(Json) then Exit;
if Json[P] = '"' then
begin
Inc(P); P2 := P;
while (P2 <= Length(Json)) and (Json[P2] <> '"') do Inc(P2);
Result := Copy(Json, P, P2 - P);
end
else
begin
P2 := P;
while (P2 <= Length(Json)) and not (Json[P2] in [',', '}']) do Inc(P2);
Result := Trim(Copy(Json, P, P2 - P));
end;
end;
function JsonGetFloat(const Json, Key: string; Def: Double): Double;
var S: string;
begin
S := JsonGetStr(Json, Key);
if S = '' then
Result := Def
else
begin
val(S, Result);
if IsNaN(Result) then Result := Def;
end;
end;
function JsonGetInt(const Json, Key: string; Def: Integer): Integer;
begin
Result := Round(JsonGetFloat(Json, Key, Def));
end;
function JsonGetBool(const Json, Key: string; Def: Boolean): Boolean;
var S: string;
begin
S := JsonGetStr(Json, Key);
if S = '' then Result := Def
else Result := (S = 'true') or (S = '1');
end;
{ ═══════════════════════════════════════════════════════════════════════════
Отладочное логирование аудио
═══════════════════════════════════════════════════════════════════════════ }
procedure AudioLog(const S: string);
var F: TextFile;
begin
try
AssignFile(F, 'audio_debug.log');
if FileExists('audio_debug.log') then Append(F) else Rewrite(F);
WriteLn(F, FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + S);
CloseFile(F);
except
end;
end;
end.
+268
View File
@@ -0,0 +1,268 @@
unit WinFirewall;
{
WinFirewall.pas управление правилами Windows Firewall для HPSDR-приложения.
Логика работы:
1. Сначала пробуем добавить все недостающие правила через COM без elevation.
Если программа запущена с правами администратора всё добавится сразу.
2. Если COM не удался (нет прав) собираем ВСЕ недостающие правила в одну
batch-команду и вызываем UAC elevation ОДИН РАЗ.
Создаёт до 4 правил (каждое проверяется по имени, дубли не добавляются):
"<AppName> UDP In" входящий UDP (HPSDR Protocol 2)
"<AppName> UDP Out" исходящий UDP (HPSDR Protocol 2)
"<AppName> TCP In" входящий TCP (WebSocket/HTTP сервер)
"<AppName> TCP Out" исходящий TCP (WebSocket/HTTP сервер)
}
{$mode objfpc}{$H+}
interface
uses SysUtils;
function FirewallRuleExists(const RuleName: string): Boolean;
procedure FirewallEnsureAllowed(const ExePath, AppName: string);
implementation
{$IFDEF WINDOWS}
uses
Windows, ComObj, ActiveX, Variants, ShellAPI;
const
PROGID_NETFW_POLICY2 = 'HNetCfg.FwPolicy2';
PROGID_NETFW_RULE = 'HNetCfg.FWRule';
NET_FW_RULE_DIR_IN = 1;
NET_FW_RULE_DIR_OUT = 2;
NET_FW_IP_PROTOCOL_TCP = 6;
NET_FW_IP_PROTOCOL_UDP = 17;
NET_FW_ACTION_ALLOW = 1;
FW_PROFILE_ALL = Integer($7FFFFFFF);
SEE_MASK_NOCLOSEPROCESS = DWORD($00000040);
SEE_MASK_FLAG_NO_UI = DWORD($00000400);
{ ── Проверка наличия правила через COM ───────────────────────────────────── }
function FirewallRuleExists(const RuleName: string): Boolean;
var
FwPolicy2: OleVariant;
FwRules: OleVariant;
FwRule: OleVariant;
Enum: IEnumVariant;
fetched: LongWord;
v: OleVariant;
begin
Result := False;
try
CoInitialize(nil);
try
FwPolicy2 := CreateOleObject(PROGID_NETFW_POLICY2);
FwRules := FwPolicy2.Rules;
Enum := IEnumVariant(IUnknown(FwRules._NewEnum));
if Enum = nil then Exit;
while Enum.Next(1, v, fetched) = S_OK do
begin
if fetched = 0 then Break;
try
FwRule := v;
if CompareText(string(FwRule.Name), RuleName) = 0 then
begin
Result := True;
Break;
end;
except
end;
v := Unassigned;
end;
finally
CoUninitialize;
end;
except
Result := False;
end;
end;
{ ── Добавление одного правила через COM (без elevation) ───────────────────── }
function TryAddRuleCOM(const ExePath, RuleName: string;
Protocol, Direction: Integer; const Description: string): Boolean;
var
FwPolicy2: OleVariant;
FwRules: OleVariant;
FwRule: OleVariant;
begin
Result := False;
try
CoInitialize(nil);
try
FwPolicy2 := CreateOleObject(PROGID_NETFW_POLICY2);
FwRules := FwPolicy2.Rules;
FwRule := CreateOleObject(PROGID_NETFW_RULE);
FwRule.Name := RuleName;
FwRule.Description := Description;
FwRule.Protocol := Protocol;
FwRule.Direction := Direction;
FwRule.Action := NET_FW_ACTION_ALLOW;
FwRule.Profiles := FW_PROFILE_ALL;
FwRule.Enabled := True;
// ApplicationName только для входящих — для исходящих netsh dir=out
// тоже не принимает program= на ряде версий Windows, поэтому
// ограничиваем по приложению только In-правила
if Direction = NET_FW_RULE_DIR_IN then
FwRule.ApplicationName := ExePath;
FwRules.Add(FwRule);
Result := True;
finally
CoUninitialize;
end;
except
Result := False;
end;
end;
{ ── Elevation: добавляем ВСЕ недостающие правила ОДНИМ вызовом UAC ─────────
Параметр Cmd готовая batch-строка с несколькими netsh-командами,
разделёнными через &&. Запускается cmd.exe /C "..." через runas. }
procedure RunElevated(const Cmd: AnsiString);
var
SEI: TShellExecuteInfoA;
FileBuf: array[0..15] of AnsiChar;
VerbBuf: array[0..7] of AnsiChar;
ParamBuf: array[0..4095] of AnsiChar;
begin
StrPCopy(FileBuf, 'cmd.exe');
StrPCopy(VerbBuf, 'runas');
StrPCopy(ParamBuf, Cmd);
FillChar(SEI, SizeOf(SEI), 0);
SEI.cbSize := SizeOf(SEI);
SEI.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
SEI.lpVerb := @VerbBuf[0];
SEI.lpFile := @FileBuf[0];
SEI.lpParameters := @ParamBuf[0];
SEI.nShow := SW_HIDE;
if ShellExecuteExA(@SEI) and (SEI.hProcess <> 0) then
begin
WaitForSingleObject(SEI.hProcess, 15000);
CloseHandle(SEI.hProcess);
end;
end;
function NetshAddRule(const RuleName, ExePath, Proto, Dir: string): string;
begin
// Строит одну netsh-команду для добавления правила.
// program= добавляем только для входящих (dir=in), для dir=out не указываем —
// Windows Firewall для Out-правил program= игнорирует или отклоняет.
Result := 'netsh advfirewall firewall add rule' +
' name="' + RuleName + '"' +
' dir=' + Dir +
' action=allow' +
' protocol=' + Proto +
' enable=yes profile=any';
if Dir = 'in' then
Result := Result + ' program="' + ExePath + '"';
end;
{ ── Основная точка входа ─────────────────────────────────────────────────── }
procedure FirewallEnsureAllowed(const ExePath, AppName: string);
type
TRuleInfo = record
Name: string;
Proto: Integer;
Dir: Integer;
Desc: string;
ProtoStr: string;
DirStr: string;
end;
const
RULE_COUNT = 4;
var
Rules: array[0..RULE_COUNT-1] of TRuleInfo;
i: Integer;
NeedElevate: Boolean;
BatchCmd: AnsiString;
Sep: AnsiString;
begin
// Описываем все 4 правила
Rules[0].Name := AppName + ' UDP In';
Rules[0].Proto := NET_FW_IP_PROTOCOL_UDP;
Rules[0].Dir := NET_FW_RULE_DIR_IN;
Rules[0].Desc := 'HPSDR Protocol 2 UDP inbound';
Rules[0].ProtoStr := 'udp';
Rules[0].DirStr := 'in';
Rules[1].Name := AppName + ' UDP Out';
Rules[1].Proto := NET_FW_IP_PROTOCOL_UDP;
Rules[1].Dir := NET_FW_RULE_DIR_OUT;
Rules[1].Desc := 'HPSDR Protocol 2 UDP outbound';
Rules[1].ProtoStr := 'udp';
Rules[1].DirStr := 'out';
Rules[2].Name := AppName + ' TCP In';
Rules[2].Proto := NET_FW_IP_PROTOCOL_TCP;
Rules[2].Dir := NET_FW_RULE_DIR_IN;
Rules[2].Desc := 'HPSDR WebSocket/HTTP server TCP inbound';
Rules[2].ProtoStr := 'tcp';
Rules[2].DirStr := 'in';
Rules[3].Name := AppName + ' TCP Out';
Rules[3].Proto := NET_FW_IP_PROTOCOL_TCP;
Rules[3].Dir := NET_FW_RULE_DIR_OUT;
Rules[3].Desc := 'HPSDR WebSocket/HTTP server TCP outbound';
Rules[3].ProtoStr := 'tcp';
Rules[3].DirStr := 'out';
// Шаг 1: пробуем добавить через COM без elevation.
// Если запущены с правами админа — всё добавится здесь, UAC не понадобится.
NeedElevate := False;
for i := 0 to RULE_COUNT - 1 do
begin
if FirewallRuleExists(Rules[i].Name) then Continue;
if not TryAddRuleCOM(ExePath, Rules[i].Name,
Rules[i].Proto, Rules[i].Dir, Rules[i].Desc) then
NeedElevate := True; // COM не удался — запомним, соберём batch
end;
if not NeedElevate then Exit;
// Шаг 2: COM не удался (нет прав). Собираем ВСЕ недостающие правила
// в одну batch-строку и поднимаем UAC ровно ОДИН РАЗ.
BatchCmd := '/C ';
Sep := '';
for i := 0 to RULE_COUNT - 1 do
begin
if FirewallRuleExists(Rules[i].Name) then Continue;
BatchCmd := BatchCmd + Sep +
AnsiString(NetshAddRule(Rules[i].Name, ExePath,
Rules[i].ProtoStr, Rules[i].DirStr));
Sep := ' && ';
end;
if BatchCmd <> '/C ' then
RunElevated(BatchCmd);
end;
{$ELSE}
{ ── Заглушки для Linux / macOS ───────────────────────────────────────────── }
function FirewallRuleExists(const RuleName: string): Boolean;
begin
Result := True;
end;
procedure FirewallEnsureAllowed(const ExePath, AppName: string);
begin
end;
{$ENDIF}
end.
+175
View File
@@ -0,0 +1,175 @@
unit WsClient;
{
WsClient.pas WebSocket клиент (одно соединение).
Инкапсулирует:
- TCP-сокет
- Состояние WS (handshake / open / closed)
- Буфер приёма
- Отправку raw-байт, WS-фреймов (text / binary)
- Basic-Auth флаг
}
{$IFDEF FPC}
{$MODE Delphi}
{$LONGSTRINGS ON}
{$ENDIF}
interface
uses
SyncObjs, WebUtils
{$IFDEF WINDOWS}, WinSock2{$ELSE}, Sockets{$ENDIF};
type
TWsState = (wsHandshake, wsOpen, wsClosed);
TWsClient = class
private
FSocket: TSocket;
FState: TWsState;
FLock: TCriticalSection;
FBuf: array[0..4095] of Byte;
FBufLen: Integer;
FAuthed: Boolean;
public
constructor Create(ASocket: TSocket);
destructor Destroy; override;
{ Отправка raw-байт (вызывать держа FLock) }
function SendRaw(const Data; Len: Integer): Boolean;
{ Отправка WebSocket-фрейма (text или binary) }
function SendWsFrame(Opcode: Byte; const Data; Len: Integer): Boolean;
{ Текстовый WS-фрейм (opcode $01) }
function SendText(const S: string): Boolean;
{ Бинарный WS-фрейм (opcode $02) }
function SendBinary(const Data; Len: Integer): Boolean;
{ Читает данные в FBuf, возвращает кол-во байт (-1 = ошибка/закрыто) }
function Recv: Integer;
{ Указатель на начало буфера приёма }
function BufData: PByte; inline;
property Socket: TSocket read FSocket;
property State: TWsState read FState write FState;
property Authed: Boolean read FAuthed write FAuthed;
property Lock: TCriticalSection read FLock;
property BufLen: Integer read FBufLen write FBufLen;
end;
implementation
{ ═══════════════════════════════════════════════════════════════════════════
TWsClient
═══════════════════════════════════════════════════════════════════════════ }
constructor TWsClient.Create(ASocket: TSocket);
begin
inherited Create;
FSocket := ASocket;
FState := wsHandshake;
FBufLen := 0;
FAuthed := False;
FLock := TCriticalSection.Create;
end;
destructor TWsClient.Destroy;
begin
if FSocket <> SOCK_INVALID then
SockClose(FSocket);
FLock.Free;
inherited;
end;
function TWsClient.SendRaw(const Data; Len: Integer): Boolean;
var
Sent, R: Integer;
P: PByte;
begin
Result := False;
if (FSocket = SOCK_INVALID) or (Len <= 0) then Exit;
P := @Data;
Sent := 0;
while Sent < Len do
begin
R := SockSend(FSocket, P + Sent, Len - Sent, 0);
if R <= 0 then Exit;
Inc(Sent, R);
end;
Result := True;
end;
function TWsClient.SendWsFrame(Opcode: Byte; const Data; Len: Integer): Boolean;
var
Header: array[0..9] of Byte;
HLen: Integer;
P: PByte;
begin
Result := False;
if FState <> wsOpen then Exit;
// FIN=1 + opcode
Header[0] := $80 or (Opcode and $0F);
if Len <= 125 then
begin
Header[1] := Byte(Len);
HLen := 2;
end
else if Len <= 65535 then
begin
Header[1] := 126;
Header[2] := Byte(Len shr 8);
Header[3] := Byte(Len);
HLen := 4;
end
else
begin
Header[1] := 127;
Header[2] := 0; Header[3] := 0; Header[4] := 0; Header[5] := 0;
Header[6] := Byte(Len shr 24); Header[7] := Byte(Len shr 16);
Header[8] := Byte(Len shr 8); Header[9] := Byte(Len);
HLen := 10;
end;
FLock.Enter;
try
Result := SendRaw(Header[0], HLen);
if Result and (Len > 0) then
begin
P := @Data;
Result := SendRaw(P^, Len);
end;
finally
FLock.Leave;
end;
end;
function TWsClient.SendText(const S: string): Boolean;
begin
if Length(S) = 0 then begin Result := True; Exit; end;
Result := SendWsFrame($01, S[1], Length(S));
end;
function TWsClient.SendBinary(const Data; Len: Integer): Boolean;
begin
Result := SendWsFrame($02, Data, Len);
end;
function TWsClient.Recv: Integer;
begin
Result := SockRecv(FSocket, @FBuf[FBufLen], SizeOf(FBuf) - FBufLen, 0);
if Result > 0 then Inc(FBufLen, Result);
end;
function TWsClient.BufData: PByte;
begin
Result := @FBuf[0];
end;
end.
+95
View File
@@ -0,0 +1,95 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="EWSDR"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
</General>
<VersionInfo>
<UseVersionInfo Value="True"/>
<MinorVersionNr Value="2"/>
</VersionInfo>
<BuildModes>
<Item Name="Debug" Default="True"/>
<Item Name="Release">
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<RunWithoutDebug Value="True"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
</CompilerOptions>
</Item>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="ewsdr.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="MainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
<Unit>
<Filename Value="HPSDRProtocol.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="HPSDRNetwork.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
</CompilerOptions>
</CONFIG>
+29
View File
@@ -0,0 +1,29 @@
program ewsdr;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
// Без этого на Windows запускается консольное окно
{$IFDEF WINDOWS}
{$APPTYPE GUI}
{$ENDIF}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Interfaces, // LCL platform
Forms,
MainForm;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Title:='EWSDR';
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm.MainForm);
Application.Run;
end.
+14
View File
@@ -0,0 +1,14 @@
[Devices]
Count=2
[Device0]
Name=172.16.2.200 ORION MkII (ANAN-7000/8000) FW:22 DDC:8
IP=172.16.2.200
BoardType=5
AutoStart=1
[Device1]
Name=172.16.2.99 ORION MkII (ANAN-7000/8000) FW:19 DDC:2
IP=172.16.2.99
BoardType=5
AutoStart=0
+389
View File
@@ -0,0 +1,389 @@
{
" 0:1C:C0:A2:17:EE" : {
"global" : {
"volume" : 70,
"drive_level" : 50,
"active_vfo" : 0,
"nr_enabled" : false,
"nb_enabled" : false,
"anf_enabled" : false,
"agc_slope" : 0,
"agc_hang_threshold" : 100,
"last_band" : 3,
"window_left" : 80,
"window_top" : 80,
"window_width" : 1400,
"window_height" : 900
},
"bands" : {
"0" : {
"vfo_a" : 1.9000000000000000E+006,
"vfo_b" : 1.9000000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"1" : {
"vfo_a" : 3.7500000000000000E+006,
"vfo_b" : 3.7500000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 49,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"2" : {
"vfo_a" : 5.3570000000000000E+006,
"vfo_b" : 5.3570000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"3" : {
"vfo_a" : 7.1032350000000000E+006,
"vfo_b" : 7.1000000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"4" : {},
"5" : {
"vfo_a" : 1.4200000000000000E+007,
"vfo_b" : 1.4200000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"6" : {},
"7" : {
"vfo_a" : 2.1200000000000000E+007,
"vfo_b" : 2.1200000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"8" : {
"vfo_a" : 2.4940000000000000E+007,
"vfo_b" : 2.4940000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"9" : {
"vfo_a" : 2.8500000000000000E+007,
"vfo_b" : 2.8500000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"10" : {}
}
},
" 4:91:62:FD:7B:86" : {
"global" : {
"window_left" : 80,
"window_top" : 80,
"window_width" : 1400,
"window_height" : 900,
"volume" : 70,
"drive_level" : 50,
"active_vfo" : 0,
"nr_enabled" : false,
"nb_enabled" : false,
"anf_enabled" : false,
"agc_slope" : 0,
"agc_hang_threshold" : 100,
"wf_agc_enabled" : true,
"wf_nf_enabled" : true,
"last_band" : 1
},
"bands" : {
"0" : {
"vfo_a" : 1.9000000000000000E+006,
"vfo_b" : 1.9000000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"1" : {
"vfo_a" : 3.6740000000000000E+006,
"vfo_b" : 3.7500000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 50,
"ctun" : true,
"span_hz" : 1.9200000000000000E+005
},
"2" : {
"vfo_a" : 5.3570000000000000E+006,
"vfo_b" : 5.3570000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"3" : {
"vfo_a" : 7.1020000000000000E+006,
"vfo_b" : 7.1000000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 2,
"agc_top" : 55,
"ctun" : true,
"span_hz" : 1.9200000000000000E+005
},
"4" : {
"vfo_a" : 1.0125000000000000E+007,
"vfo_b" : 1.0125000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 87,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"5" : {
"vfo_a" : 1.4149000000000000E+007,
"vfo_b" : 1.4200000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 62,
"ctun" : true,
"span_hz" : 1.9200000000000000E+005
},
"6" : {
"vfo_a" : 1.8120000000000000E+007,
"vfo_b" : 1.8120000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"7" : {
"vfo_a" : 2.1200000000000000E+007,
"vfo_b" : 2.1200000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"8" : {
"vfo_a" : 2.4940000000000000E+007,
"vfo_b" : 2.4940000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"9" : {
"vfo_a" : 2.8500000000000000E+007,
"vfo_b" : 2.8500000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"10" : {
"vfo_a" : 5.0150000000000000E+007,
"vfo_b" : 5.0150000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
}
}
},
"window" : {
"left" : 522,
"top" : 139,
"width" : 1516,
"height" : 802
},
" 0: 0: 0: 0: 0: 0" : {
"global" : {
"volume" : 59,
"drive_level" : 50,
"active_vfo" : 0,
"nr_enabled" : false,
"nb_enabled" : false,
"anf_enabled" : false,
"agc_slope" : 0,
"agc_hang_threshold" : 100,
"wf_agc_enabled" : true,
"wf_nf_enabled" : true,
"last_band" : 1,
"sample_rate" : 192000
},
"bands" : {
"0" : {
"vfo_a" : 1.9000000000000000E+006,
"vfo_b" : 1.9000000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"1" : {
"vfo_a" : 3.7310000000000000E+006,
"vfo_b" : 3.7500000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 60,
"ctun" : true,
"span_hz" : 1.9200000000000000E+005
},
"2" : {
"vfo_a" : 5.3570000000000000E+006,
"vfo_b" : 5.3570000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"3" : {
"vfo_a" : 7.1530000000000000E+006,
"vfo_b" : 7.1000000000000000E+006,
"mode" : 0,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 61,
"ctun" : true,
"span_hz" : 1.9200000000000000E+005
},
"4" : {
"vfo_a" : 1.0125000000000000E+007,
"vfo_b" : 1.0125000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"5" : {
"vfo_a" : 1.4163000000000000E+007,
"vfo_b" : 1.4200000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 69,
"ctun" : true,
"span_hz" : 1.9200000000000000E+005
},
"6" : {
"vfo_a" : 1.8120000000000000E+007,
"vfo_b" : 1.8120000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"7" : {
"vfo_a" : 2.1200000000000000E+007,
"vfo_b" : 2.1200000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"8" : {
"vfo_a" : 2.4940000000000000E+007,
"vfo_b" : 2.4940000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"9" : {
"vfo_a" : 2.8500000000000000E+007,
"vfo_b" : 2.8500000000000000E+007,
"mode" : 1,
"filter_idx" : 5,
"filter_bw" : 2700,
"agc_mode" : 1,
"agc_top" : 90,
"ctun" : false,
"span_hz" : 1.9200000000000000E+005
},
"10" : {}
}
}
}
BIN
View File
Binary file not shown.

After

Width:  |  Height:  |  Size: 61 KiB