diff --git a/.gitignore b/.gitignore index 79f8960..d5749da 100644 --- a/.gitignore +++ b/.gitignore @@ -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 + diff --git a/AudioOutput.pas b/AudioOutput.pas new file mode 100644 index 0000000..93d1db0 --- /dev/null +++ b/AudioOutput.pas @@ -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. diff --git a/DeviceForm.pas b/DeviceForm.pas new file mode 100644 index 0000000..c32cc85 --- /dev/null +++ b/DeviceForm.pas @@ -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. diff --git a/FlatButton.pas b/FlatButton.pas new file mode 100644 index 0000000..0d2ccc1 --- /dev/null +++ b/FlatButton.pas @@ -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. diff --git a/FreqDisplay.pas b/FreqDisplay.pas new file mode 100644 index 0000000..b620c5a --- /dev/null +++ b/FreqDisplay.pas @@ -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. diff --git a/HPSDRNetwork.pas b/HPSDRNetwork.pas new file mode 100644 index 0000000..5ee7ff0 --- /dev/null +++ b/HPSDRNetwork.pas @@ -0,0 +1,1070 @@ +unit HPSDRNetwork; + +{ + UDP network layer for openHPSDR Ethernet Protocol V4.3. + Pure FPC RTL - uses only the standard 'Sockets' unit. + No anonymous procedures, no inline var - compatible with FPC 3.2 / Lazarus 2.x +} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +interface + +uses + Classes, SysUtils, Math, +{$IFDEF WINDOWS} + WinSock2, MMSystem, +{$ELSE} + Sockets, BaseUnix, +{$ENDIF} + HPSDRProtocol; + +{$IFDEF WINDOWS} +// --------------------------------------------------------------------------- +// WinSock2 — type aliases и forward declarations +// --------------------------------------------------------------------------- +const + SOCK_INVALID = TSocket(INVALID_SOCKET); + INADDR_ANY = 0; + IPPROTO_UDP = 17; + SO_EXCLUSIVEADDRUSE = LongInt(not 5); // = $FFFFFFFB — исключительное владение портом + +type + TInetSockAddr = WinSock2.TSockAddrIn; + TSockLen = Integer; + TFDSet = WinSock2.TFDSet; + TTimeVal = WinSock2.TTimeVal; + +function fpSocket(Domain, SType, Proto: Integer): TSocket; +function fpBind(S: TSocket; Addr: PSockAddr; AddrLen: Integer): Integer; +function fpSetSockOpt(S: TSocket; Level, OptName: Integer; + OptVal: Pointer; OptLen: Integer): Integer; +function fpGetSockName(S: TSocket; Addr: PSockAddr; + AddrLen: PInteger): Integer; +function fpSendTo(S: TSocket; Buf: Pointer; BufLen, Flags: Integer; + ToAddr: PSockAddr; AddrLen: Integer): Integer; +function fpRecvFrom(S: TSocket; Buf: Pointer; BufLen, Flags: Integer; + FromAddr: PSockAddr; FromLen: PInteger): Integer; +procedure fpFD_ZERO(var FDS: TFDSet); +procedure fpFD_SET(S: TSocket; var FDS: TFDSet); +function fpSelect(Nfds: Integer; ReadFDS, WriteFDS, ExceptFDS: PFDSet; + Timeout: PTimeVal): Integer; +procedure CloseSocket(S: TSocket); +function htons(Host: Word): Word; +function ntohs(Net: Word): Word; +function StrToNetAddr(const IP: string): WinSock2.TInAddr; +function NetAddrToStr(const Addr: WinSock2.TInAddr): string; + +{$ELSE} +// --------------------------------------------------------------------------- +// Unix — типы уже определены в Sockets/BaseUnix +// --------------------------------------------------------------------------- +const + SOCK_INVALID = TSocket(-1); +{$ENDIF} + + +type + THPSDRDevice = record + IPAddress: string; + Port: Word; + MAC: array[0..5] of Byte; + BoardType: Byte; + ProtocolVersion: Byte; + FirmwareVersion: Byte; + NumDDCs: Byte; + FreqOrPhase: Byte; + EndianModes: Byte; + InUse: Boolean; + Valid: Boolean; + end; + PHPSDRDevice = ^THPSDRDevice; + THPSDRDeviceArray = array of THPSDRDevice; + + TOnDeviceFound = procedure(const Dev: THPSDRDevice) of object; + TOnDDCIQPacket = procedure(DDCIndex: Integer; + const Data: TDDCIQPacket) of object; + TOnMicPacket = procedure(const Data: TMicDataPacket) of object; + TOnHPStatus = procedure(const Status: THighPriorityStatus) of object; + + { THPSDRNetwork } + THPSDRNetwork = class + private + FSocket: TSocket; + FLocalPort: Word; + FDevice: THPSDRDevice; + FConnected: Boolean; + FRunning: Boolean; + + FSeqGeneral: LongWord; + FLastError: string; // последняя ошибка сокета (для диагностики) + FSeqDDCSpec: LongWord; + FSeqDUCSpec: LongWord; + FSeqHP: LongWord; + FSeqAudio: LongWord; + FSeqDUCIQ: LongWord; + + FReceiveThread: TThread; + FKeepaliveThread: TThread; + + FOnDeviceFound: TOnDeviceFound; + FOnDDCIQ: TOnDDCIQPacket; + FOnMic: TOnMicPacket; + FOnHPStatus: TOnHPStatus; + + FPortDDCSpec: Word; + FPortDUCSpec: Word; + FPortHPFromPC: Word; + FPortDDCAudio: Word; + FPortDUCIQ: Word; + FDirectIP: string; // для unicast discovery + + // Текущее состояние для построения HP пакетов + FCurrentRXFreq: Double; + FCurrentTXFreq: Double; + FCurrentDrive: Byte; + FIsTransmitting: Boolean; + FPAEnabled: Boolean; + FAlexEnabled: Boolean; + + function DoCreateSocket: TSocket; + procedure DoCloseSocket(var S: TSocket); + function DoSendTo(S: TSocket; const Buf; BufLen: Integer; + const DestIP: string; DestPort: Word): Boolean; + function DoRecvFrom(S: TSocket; var Buf; BufLen: Integer; + var SrcIP: string; var SrcPort: Word; + TimeoutMs: Integer): Integer; + + procedure HandleHPStatus(const Buf: array of Byte; Len: Integer); + procedure HandleDDCIQ(const Buf: array of Byte; Len: Integer; DDCIdx: Integer); + procedure HandleMicData(const Buf: array of Byte; Len: Integer); + procedure StartThreads; + procedure StopThreads; + function NextSeq(var S: LongWord): LongWord; + procedure PackSeqBytes(var B: array of Byte; Seq: LongWord); + + public + constructor Create; + destructor Destroy; override; + + function Discover(TimeoutMs: Integer = 3000): THPSDRDeviceArray; + function Connect(const Dev: THPSDRDevice): Boolean; + procedure Disconnect; + + procedure SendGeneralPacket(const Pkt: TGeneralPacket); + procedure SendDDCSpecific(const Pkt: TDDCSpecificPacket); + procedure ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; ADCSource: Byte = 0); + procedure SendDUCSpecific(const Pkt: TDUCSpecificPacket); + procedure SendHighPriority(const Pkt: THighPriorityPacket); + procedure SetRunAndFreq(Run: Boolean; DDC0FreqHz, DUCFreqHz: Double; + DriveLevel: Byte = 100); + procedure UpdateState(RXFreqHz, TXFreqHz: Double; DriveLevel: Byte; + Transmitting, PAEnabled, AlexEnabled: Boolean); + procedure SendFullHP; + procedure SendDDCAudio(const LeftRight: array of SmallInt); + procedure SendDUCIQ(const IData, QData: array of Integer); + + property Connected: Boolean read FConnected; + property Running: Boolean read FRunning; + property Device: THPSDRDevice read FDevice; + property LocalPort: Word read FLocalPort; + property LastError: string read FLastError; + property OnDeviceFound: TOnDeviceFound read FOnDeviceFound write FOnDeviceFound; + property OnDDCIQ: TOnDDCIQPacket read FOnDDCIQ write FOnDDCIQ; + property OnMicPacket: TOnMicPacket read FOnMic write FOnMic; + property OnHPStatus: TOnHPStatus read FOnHPStatus write FOnHPStatus; + property DirectIP: string read FDirectIP write FDirectIP; // unicast discovery + end; + +implementation + +{$IFDEF WINDOWS} +var + WSAData_: WinSock2.TWSAData; +{$ENDIF} + +{$IFDEF WINDOWS} +// --------------------------------------------------------------------------- +// WinSock2 wrapper implementations +// --------------------------------------------------------------------------- +function fpSocket(Domain, SType, Proto: Integer): TSocket; +begin + Result := WinSock2.socket(Domain, SType, Proto); +end; + +function fpBind(S: TSocket; Addr: PSockAddr; AddrLen: Integer): Integer; +begin + Result := WinSock2.bind(S, Addr^, AddrLen); +end; + +function fpSetSockOpt(S: TSocket; Level, OptName: Integer; + OptVal: Pointer; OptLen: Integer): Integer; +begin + Result := WinSock2.setsockopt(S, Level, OptName, OptVal, OptLen); +end; + +function fpGetSockName(S: TSocket; Addr: PSockAddr; AddrLen: PInteger): Integer; +begin + Result := WinSock2.getsockname(S, Addr^, AddrLen^); +end; + +function fpSendTo(S: TSocket; Buf: Pointer; BufLen, Flags: Integer; + ToAddr: PSockAddr; AddrLen: Integer): Integer; +begin + Result := WinSock2.sendto(S, Buf^, BufLen, Flags, ToAddr^, AddrLen); +end; + +function fpRecvFrom(S: TSocket; Buf: Pointer; BufLen, Flags: Integer; + FromAddr: PSockAddr; FromLen: PInteger): Integer; +begin + Result := WinSock2.recvfrom(S, Buf^, BufLen, Flags, FromAddr^, FromLen^); +end; + +procedure fpFD_ZERO(var FDS: TFDSet); +begin + WinSock2.FD_ZERO(FDS); +end; + +procedure fpFD_SET(S: TSocket; var FDS: TFDSet); +begin + WinSock2.FD_SET(S, FDS); +end; + +function fpSelect(Nfds: Integer; ReadFDS, WriteFDS, ExceptFDS: PFDSet; + Timeout: PTimeVal): Integer; +begin + Result := WinSock2.select(Nfds, ReadFDS, WriteFDS, ExceptFDS, Timeout); +end; + +procedure CloseSocket(S: TSocket); +begin + WinSock2.closesocket(S); +end; + +function htons(Host: Word): Word; +begin + Result := WinSock2.htons(Host); +end; + +function ntohs(Net: Word): Word; +begin + Result := WinSock2.ntohs(Net); +end; + +function StrToNetAddr(const IP: string): WinSock2.TInAddr; +begin + Result.S_addr := WinSock2.inet_addr(PAnsiChar(AnsiString(IP))); +end; + +function NetAddrToStr(const Addr: WinSock2.TInAddr): string; +begin + Result := string(WinSock2.inet_ntoa(Addr)); +end; +{$ENDIF} + +// =========================================================================== +// Синхронизация через отдельные классы-посредники (без анонимных процедур) +// =========================================================================== + +type + { TStatusSync - передаёт HP Status в главный поток } + TStatusSync = class + private + FCallback: TOnHPStatus; + FStatus: THighPriorityStatus; + public + constructor Create(CB: TOnHPStatus; const St: THighPriorityStatus); + procedure Execute; + end; + + { TMicSync - передаёт Mic данные в главный поток } + TMicSync = class + private + FCallback: TOnMicPacket; + FPkt: TMicDataPacket; + public + constructor Create(CB: TOnMicPacket; const P: TMicDataPacket); + procedure Execute; + end; + +constructor TStatusSync.Create(CB: TOnHPStatus; const St: THighPriorityStatus); +begin + inherited Create; + FCallback := CB; + FStatus := St; +end; + +procedure TStatusSync.Execute; +begin + if Assigned(FCallback) then FCallback(FStatus); +end; + +constructor TMicSync.Create(CB: TOnMicPacket; const P: TMicDataPacket); +begin + inherited Create; + FCallback := CB; + FPkt := P; +end; + +procedure TMicSync.Execute; +begin + if Assigned(FCallback) then FCallback(FPkt); +end; + +// =========================================================================== +// Receive thread +// =========================================================================== +type + TReceiveThread = class(TThread) + private + FNet: THPSDRNetwork; + protected + procedure Execute; override; + public + constructor Create(ANet: THPSDRNetwork); + end; + +constructor TReceiveThread.Create(ANet: THPSDRNetwork); +begin + FNet := ANet; + FreeOnTerminate := False; + inherited Create(False); +end; + +procedure TReceiveThread.Execute; +var + Buf: array[0..1500] of Byte; + Len: Integer; + SrcIP: string; + SrcPort: Word; +begin + FillChar(Buf, SizeOf(Buf), 0); + SrcIP := ''; + SrcPort := 0; + while not Terminated do + begin + if FNet.FSocket = SOCK_INVALID then + begin + Sleep(50); + Continue; + end; + Len := FNet.DoRecvFrom(FNet.FSocket, Buf, SizeOf(Buf), SrcIP, SrcPort, 50); + if Terminated then Break; + if Len < 4 then Continue; + + case SrcPort of + PORT_HP_TO_PC: + if Len >= SizeOf(THighPriorityStatus) then + FNet.HandleHPStatus(Buf, Len); + PORT_MIC_DATA: + if Len >= 132 then + FNet.HandleMicData(Buf, Len); + PORT_DDC0_IQ .. PORT_DDC0_IQ + MAX_DDCS - 1: + FNet.HandleDDCIQ(Buf, Len, SrcPort - PORT_DDC0_IQ); + end; + end; +end; + +// =========================================================================== +// Keepalive thread +// =========================================================================== +type + TKeepaliveThread = class(TThread) + private + FNet: THPSDRNetwork; + protected + procedure Execute; override; + public + constructor Create(ANet: THPSDRNetwork); + end; + +constructor TKeepaliveThread.Create(ANet: THPSDRNetwork); +begin + FNet := ANet; + FreeOnTerminate := False; + inherited Create(False); +end; + +procedure TKeepaliveThread.Execute; +begin + while not Terminated do + begin + Sleep(50); + if Terminated then Break; + if not FNet.FConnected then Continue; + // Отправляем полный HP с частотами и ALEX — как piHPSDR + FNet.SendFullHP; + end; +end; + +// =========================================================================== +// THPSDRNetwork +// =========================================================================== + +constructor THPSDRNetwork.Create; +begin + inherited; + FSocket := SOCK_INVALID; + FConnected := False; + FRunning := False; + FLocalPort := 0; + FReceiveThread := nil; + FKeepaliveThread := nil; + FPortDDCSpec := PORT_DDC_SPECIFIC; + FPortDUCSpec := PORT_DUC_SPECIFIC; + FPortHPFromPC := PORT_HP_FROM_PC; + FPortDDCAudio := PORT_DDC_AUDIO; + FPortDUCIQ := PORT_DUC_IQ; + FCurrentRXFreq := 7100000; + FCurrentTXFreq := 7100000; + FCurrentDrive := 0; + FIsTransmitting := False; + FPAEnabled := True; + FAlexEnabled := True; +end; + +destructor THPSDRNetwork.Destroy; +begin + Disconnect; + inherited; +end; + +function THPSDRNetwork.NextSeq(var S: LongWord): LongWord; +begin + Result := S; + Inc(S); +end; + +procedure THPSDRNetwork.PackSeqBytes(var B: array of Byte; Seq: LongWord); +begin + B[0] := (Seq shr 24) and $FF; + B[1] := (Seq shr 16) and $FF; + B[2] := (Seq shr 8) and $FF; + B[3] := Seq and $FF; +end; + +// --------------------------------------------------------------------------- +// Сокеты (только FPC RTL Sockets unit) +// --------------------------------------------------------------------------- + +function THPSDRNetwork.DoCreateSocket: TSocket; +var + Addr: TInetSockAddr; + Opt: LongInt; + ALen: TSockLen; +begin + FillChar(Addr, SizeOf(Addr), 0); + Result := fpSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP); + if Result = SOCK_INVALID then + begin + FLastError := 'fpSocket failed'; + Exit; + end; + + // Broadcast + Opt := 1; + fpSetSockOpt(Result, SOL_SOCKET, SO_BROADCAST, @Opt, SizeOf(Opt)); + +{$IFDEF WINDOWS} + // На Windows SO_REUSEADDR позволяет перехватить порт другому процессу. + // Используем SO_EXCLUSIVEADDRUSE вместо SO_REUSEADDR. + Opt := 1; + fpSetSockOpt(Result, SOL_SOCKET, SO_EXCLUSIVEADDRUSE, @Opt, SizeOf(Opt)); +{$ELSE} + Opt := 1; + fpSetSockOpt(Result, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(Opt)); +{$ENDIF} + + // Большой приёмный буфер + Opt := 4 * 1024 * 1024; + fpSetSockOpt(Result, SOL_SOCKET, SO_RCVBUF, @Opt, SizeOf(Opt)); + + FillChar(Addr, SizeOf(Addr), 0); + Addr.sin_family := AF_INET; + Addr.sin_port := htons(0); // случайный свободный порт +{$IFDEF WINDOWS} + Addr.sin_addr.S_addr := INADDR_ANY; +{$ELSE} + Addr.sin_addr.s_addr := INADDR_ANY; +{$ENDIF} + + if fpBind(Result, @Addr, SizeOf(Addr)) <> 0 then + begin +{$IFDEF WINDOWS} + FLastError := 'fpBind failed, WSAError=' + IntToStr(WinSock2.WSAGetLastError); +{$ELSE} + FLastError := 'fpBind failed'; +{$ENDIF} + CloseSocket(Result); + Result := SOCK_INVALID; + Exit; + end; + + ALen := SizeOf(Addr); + if fpGetSockName(Result, @Addr, @ALen) = 0 then + FLocalPort := ntohs(Addr.sin_port); + + FLastError := ''; +end; + +procedure THPSDRNetwork.DoCloseSocket(var S: TSocket); +begin + if S <> SOCK_INVALID then + begin + CloseSocket(S); + S := SOCK_INVALID; + end; +end; + +function THPSDRNetwork.DoSendTo(S: TSocket; const Buf; BufLen: Integer; + const DestIP: string; DestPort: Word): Boolean; +var + Addr: TInetSockAddr; +begin + Result := False; + if S = SOCK_INVALID then Exit; + FillChar(Addr, SizeOf(Addr), 0); + Addr.sin_family := AF_INET; + Addr.sin_port := htons(DestPort); + Addr.sin_addr := StrToNetAddr(DestIP); + Result := fpSendTo(S, @Buf, BufLen, 0, @Addr, SizeOf(Addr)) = BufLen; +end; + +function THPSDRNetwork.DoRecvFrom(S: TSocket; var Buf; BufLen: Integer; + var SrcIP: string; var SrcPort: Word; + TimeoutMs: Integer): Integer; +var + FDS: TFDSet; + TV: TTimeVal; + Addr: TInetSockAddr; + ALen: TSockLen; + N: LongInt; +begin + Result := 0; + if S = SOCK_INVALID then Exit; + + fpFD_ZERO(FDS); + fpFD_SET(S, FDS); + TV.tv_sec := TimeoutMs div 1000; + TV.tv_usec := (TimeoutMs mod 1000) * 1000; + + N := fpSelect(S + 1, @FDS, nil, nil, @TV); + if N <= 0 then Exit; + + ALen := SizeOf(Addr); + Result := fpRecvFrom(S, @Buf, BufLen, 0, @Addr, @ALen); + if Result > 0 then + begin + SrcIP := NetAddrToStr(Addr.sin_addr); + SrcPort := ntohs(Addr.sin_port); + end + else + Result := 0; +end; + +// --------------------------------------------------------------------------- +// Discovery +// --------------------------------------------------------------------------- + +function THPSDRNetwork.Discover(TimeoutMs: Integer): THPSDRDeviceArray; +var + S: TSocket; + Pkt: TDiscoveryPacket; + Buf: array[0..511] of Byte; + Len: Integer; + SrcIP: string; + SrcPort: Word; + Found: THPSDRDeviceArray; + Start: QWord; + LastSend: QWord; + Elapsed: QWord; + Remaining: Integer; + k: Integer; + Dup: Boolean; +begin + FillChar(Buf, SizeOf(Buf), 0); + SrcIP := ''; + SrcPort := 0; + SetLength(Found, 0); + Result := Found; + + S := DoCreateSocket; + if S = SOCK_INVALID then Exit; + try + FillChar(Pkt, SizeOf(Pkt), 0); + Pkt.Command := CMD_DISCOVERY; + + // Отправляем broadcast (и unicast если задан FDirectIP) + DoSendTo(S, Pkt, SizeOf(Pkt), '255.255.255.255', PORT_COMMAND); + if FDirectIP <> '' then + DoSendTo(S, Pkt, SizeOf(Pkt), FDirectIP, PORT_COMMAND); + + Start := GetTickCount64; + LastSend := Start; + repeat + Elapsed := GetTickCount64 - Start; + if Elapsed >= QWord(TimeoutMs) then Break; + + // Повторяем broadcast каждые 500 мс + if GetTickCount64 - LastSend >= 500 then + begin + DoSendTo(S, Pkt, SizeOf(Pkt), '255.255.255.255', PORT_COMMAND); + if FDirectIP <> '' then + DoSendTo(S, Pkt, SizeOf(Pkt), FDirectIP, PORT_COMMAND); + LastSend := GetTickCount64; + end; + + // Ждём ответ не дольше 100 мс за раз — чтобы успеть повторить отправку + Remaining := TimeoutMs - Integer(Elapsed); + if Remaining <= 0 then Break; + if Remaining > 100 then Remaining := 100; + + Len := DoRecvFrom(S, Buf, SizeOf(Buf), SrcIP, SrcPort, Remaining); + if Len < 60 then Continue; + if not (Buf[4] in [$02, $03]) then Continue; + + Dup := False; + for k := 0 to High(Found) do + if Found[k].IPAddress = SrcIP then + begin + Dup := True; + Break; + end; + if Dup then Continue; + + SetLength(Found, Length(Found) + 1); + FillChar(Found[High(Found)], SizeOf(THPSDRDevice), 0); + with Found[High(Found)] do + begin + IPAddress := SrcIP; + Port := SrcPort; + Move(Buf[5], MAC[0], 6); + BoardType := Buf[11]; + ProtocolVersion := Buf[12]; + FirmwareVersion := Buf[13]; + NumDDCs := Buf[20]; + FreqOrPhase := Buf[21]; + EndianModes := Buf[22]; + InUse := Buf[4] = $03; + Valid := True; + end; + + if Assigned(FOnDeviceFound) then + FOnDeviceFound(Found[High(Found)]); + until False; + + Result := Found; + finally + DoCloseSocket(S); + end; +end; + +function THPSDRNetwork.Connect(const Dev: THPSDRDevice): Boolean; +begin + Result := False; + if FConnected then Disconnect; + + FDevice := Dev; + FSocket := DoCreateSocket; + if FSocket = SOCK_INVALID then Exit; + + FConnected := True; + FSeqGeneral := 0; + FSeqDDCSpec := 0; + FSeqDUCSpec := 0; + FSeqHP := 0; + FSeqAudio := 0; + FSeqDUCIQ := 0; + + StartThreads; + Result := True; +end; + +procedure THPSDRNetwork.Disconnect; +begin + if not FConnected then Exit; + + if FRunning then + SetRunAndFreq(False, 7100000, 7100000, 0); + + FRunning := False; + StopThreads; + DoCloseSocket(FSocket); + FConnected := False; + FDevice.Valid := False; +end; + +procedure THPSDRNetwork.StartThreads; +begin +{$IFDEF WINDOWS} + // Повышаем точность системного таймера — по умолчанию 15.6ms, делаем 1ms + // Это критично для Sleep() в потоках и PortAudio + timeBeginPeriod(1); +{$ENDIF} + FReceiveThread := TReceiveThread.Create(Self); + FReceiveThread.Priority := tpHighest; // Сетевой поток — критический + FKeepaliveThread := TKeepaliveThread.Create(Self); + FKeepaliveThread.Priority := tpNormal; +end; + +procedure THPSDRNetwork.StopThreads; +begin +{$IFDEF WINDOWS} + timeEndPeriod(1); +{$ENDIF} + if Assigned(FReceiveThread) then + begin + FReceiveThread.Terminate; + if FSocket <> SOCK_INVALID then + begin + CloseSocket(FSocket); + FSocket := SOCK_INVALID; + end; + FReceiveThread.WaitFor; + FreeAndNil(FReceiveThread); + end; + if Assigned(FKeepaliveThread) then + begin + FKeepaliveThread.Terminate; + FKeepaliveThread.WaitFor; + FreeAndNil(FKeepaliveThread); + end; +end; + +// --------------------------------------------------------------------------- +// Обработчики пакетов — синхронизация через объекты, без анонимных proc +// --------------------------------------------------------------------------- + +procedure THPSDRNetwork.HandleHPStatus(const Buf: array of Byte; Len: Integer); +var + St: THighPriorityStatus; + Sync: TStatusSync; + M: TThreadMethod; +begin + if not Assigned(FOnHPStatus) then Exit; + Move(Buf[0], St, SizeOf(St)); + Sync := TStatusSync.Create(FOnHPStatus, St); + try + M := Sync.Execute; + TThread.Synchronize(nil, M); + finally + Sync.Free; + end; +end; + +procedure THPSDRNetwork.HandleDDCIQ(const Buf: array of Byte; Len: Integer; + DDCIdx: Integer); +var + Pkt: TDDCIQPacket; +begin + if not Assigned(FOnDDCIQ) then Exit; + FillChar(Pkt, SizeOf(Pkt), 0); + Move(Buf[0], Pkt, Min(Len, SizeOf(Pkt))); + FOnDDCIQ(DDCIdx, Pkt); // прямой вызов из потока — UI не трогает +end; + +procedure THPSDRNetwork.HandleMicData(const Buf: array of Byte; Len: Integer); +var + Pkt: TMicDataPacket; + Sync: TMicSync; + M: TThreadMethod; +begin + if not Assigned(FOnMic) then Exit; + Move(Buf[0], Pkt, SizeOf(Pkt)); + Sync := TMicSync.Create(FOnMic, Pkt); + try + M := Sync.Execute; + TThread.Synchronize(nil, M); + finally + Sync.Free; + end; +end; + +// --------------------------------------------------------------------------- +// Отправка пакетов +// --------------------------------------------------------------------------- + +procedure THPSDRNetwork.SendGeneralPacket(const Pkt: TGeneralPacket); +var + B: TGeneralPacket; +begin + B := Pkt; + PackSeqBytes(B.Seq, NextSeq(FSeqGeneral)); + DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, PORT_COMMAND); +end; + +procedure THPSDRNetwork.SendDDCSpecific(const Pkt: TDDCSpecificPacket); +var + B: TDDCSpecificPacket; +begin + B := Pkt; + PackSeqBytes(B.Seq, NextSeq(FSeqDDCSpec)); + DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortDDCSpec); +end; + +// --------------------------------------------------------------------------- +// ALEX фильтры — логика из piHPSDR new_protocol.c +// Возвращает 32-bit ALEX0 register value +// RXFreqHz — частота приёма ADC0 +// TXFreqHz — частота передачи (или = RXFreqHz при RX) +// Transmitting — режим передачи +// IsOrion2 — ANAN-7000/8000 (другие BPF) +// --------------------------------------------------------------------------- +function CalcAlex0(RXFreqHz, TXFreqHz: Double; + Transmitting, IsOrion2: Boolean): LongWord; +var + txf: Double; +begin + Result := 0; + + // TX relay при передаче + if Transmitting then + Result := Result or $08000000; // ALEX_TX_RELAY + + // RX HPF (для ANAN-100/200) или BPF (для ANAN-7000) + if IsOrion2 then + begin + // Band-pass filters ANAN-7000/8000 + if RXFreqHz < 1500000 then Result := Result or $00001000 // BYPASS_BPF + else if RXFreqHz < 2100000 then Result := Result or $00000040 // 160 BPF + else if RXFreqHz < 5500000 then Result := Result or $00000020 // 80/60 BPF + else if RXFreqHz < 11000000 then Result := Result or $00000010 // 40/30 BPF + else if RXFreqHz < 22000000 then Result := Result or $00000002 // 20/15 BPF + else if RXFreqHz < 35600000 then Result := Result or $00000004 // 12/10 BPF + else Result := Result or $00000008; // 6m+preamp + end + else + begin + // High-pass filters ANAN-100/200 + if RXFreqHz < 1800000 then Result := Result or $00001000 // BYPASS_HPF + else if RXFreqHz < 6500000 then Result := Result or $00000040 // 1.5 MHz HPF + else if RXFreqHz < 9500000 then Result := Result or $00000020 // 6.5 MHz HPF + else if RXFreqHz < 13000000 then Result := Result or $00000010 // 9.5 MHz HPF + else if RXFreqHz < 20000000 then Result := Result or $00000002 // 13 MHz HPF + else if RXFreqHz < 50000000 then Result := Result or $00000004 // 20 MHz HPF + else Result := Result or $00000008; // 6m preamp + end; + + // TX LPF — при RX через Ant1/2/3 сигнал идёт через TX LPF тоже + // (для pre-Orion2 без внешней антенны) + if not Transmitting and not IsOrion2 then + txf := RXFreqHz // RX через Ant1: используем RX частоту для LPF + else + txf := TXFreqHz; + + if txf > 35600000 then Result := Result or $20000000 // 6m bypass LPF + else if txf > 24000000 then Result := Result or $40000000 // 12/10m LPF + else if txf > 16500000 then Result := Result or $80000000 // 17/15m LPF + else if txf > 8000000 then Result := Result or $00100000 // 30/20m LPF + else if txf > 5000000 then Result := Result or $00200000 // 60/40m LPF + else if txf > 2500000 then Result := Result or $00400000 // 80m LPF + else Result := Result or $00800000; // 160m LPF + + // TX antenna — ANT1 по умолчанию + if not Transmitting then + Result := Result or $01000000; // ALEX_TX_ANTENNA_1 +end; + +procedure THPSDRNetwork.ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; + ADCSource: Byte); +var + Pkt: TDDCSpecificPacket; + i, ddc: Integer; + DDCBase: Integer; +begin + FillChar(Pkt, SizeOf(Pkt), 0); + + // ANAN-7000/8000 имеют 2 ADC + if FDevice.BoardType in [4, 5] then // ORION=4, ORION2=5 + Pkt.NumADCs := 2 + else + Pkt.NumADCs := 1; + + // Для ANGELIA/ORION/ORION2 DDC начинается с индекса 2 (DDC0/1 — PureSignal) + // Для HERMES/HL2 — с 0 + if FDevice.BoardType in [3, 4, 5] then // ANGELIA=3, ORION=4, ORION2=5 + DDCBase := 2 + else + DDCBase := 0; + + for i := 0 to NumDDCs - 1 do + begin + ddc := DDCBase + i; + // Enable bit для DDC ddc + Pkt.DDCEnable[ddc div 8] := Pkt.DDCEnable[ddc div 8] or Byte(1 shl (ddc mod 8)); + // Config: 6 байт на DDC начиная с offset 17 в пакете → в массиве DDCConfig + // DDCConfig[ddc*6 + 0] = ADC source + // DDCConfig[ddc*6 + 1..2] = sample rate / 1000 (ksps) + // DDCConfig[ddc*6 + 5] = bits per sample + Pkt.DDCConfig[ddc * 6] := ADCSource; + Pkt.DDCConfig[ddc * 6 + 1] := (SampleRate shr 8) and $FF; + Pkt.DDCConfig[ddc * 6 + 2] := SampleRate and $FF; + Pkt.DDCConfig[ddc * 6 + 3] := 0; + Pkt.DDCConfig[ddc * 6 + 4] := 0; + Pkt.DDCConfig[ddc * 6 + 5] := 24; // 24 bits per sample + end; + + SendDDCSpecific(Pkt); +end; + +procedure THPSDRNetwork.SendDUCSpecific(const Pkt: TDUCSpecificPacket); +var + B: TDUCSpecificPacket; +begin + B := Pkt; + PackSeqBytes(B.Seq, NextSeq(FSeqDUCSpec)); + DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortDUCSpec); +end; + +procedure THPSDRNetwork.SendHighPriority(const Pkt: THighPriorityPacket); +var + B: THighPriorityPacket; +begin + B := Pkt; + PackSeqBytes(B.Seq, NextSeq(FSeqHP)); + DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortHPFromPC); +end; + +procedure THPSDRNetwork.UpdateState(RXFreqHz, TXFreqHz: Double; + DriveLevel: Byte; + Transmitting, PAEnabled, AlexEnabled: Boolean); +begin + FCurrentRXFreq := RXFreqHz; + FCurrentTXFreq := TXFreqHz; + FCurrentDrive := DriveLevel; + FIsTransmitting := Transmitting; + FPAEnabled := PAEnabled; + FAlexEnabled := AlexEnabled; +end; + +procedure THPSDRNetwork.SendFullHP; +var + Buf: array[0..1443] of Byte; + Ph: LongWord; + Alex0: LongWord; + IsOrion2: Boolean; + DDCBase: Integer; // 0 для HERMES, 2 для ORION/ORION2/ANGELIA +begin + if not FConnected then Exit; + + FillChar(Buf, SizeOf(Buf), 0); + + // Sequence — будет упакован в SendHighPriority через PackSeqBytes, + // но здесь мы шлём raw буфер напрямую + Buf[0] := (FSeqHP shr 24) and $FF; + Buf[1] := (FSeqHP shr 16) and $FF; + Buf[2] := (FSeqHP shr 8) and $FF; + Buf[3] := FSeqHP and $FF; + Inc(FSeqHP); + + // Byte 4: Run | PTT + if FRunning then Buf[4] := HP_RUN; + + // DDC base: ORION/ORION2/ANGELIA начинают с DDC2 + IsOrion2 := (FDevice.BoardType = 5); // ORION-II = 5 + if FDevice.BoardType in [3, 4, 5] then // ANGELIA=3, ORION=4, ORION2=5 + DDCBase := 2 + else + DDCBase := 0; + + // DDC RX frequency (bytes 9 + DDC*4) + Ph := FreqToPhaseWord(FCurrentRXFreq); + Buf[9 + DDCBase*4] := (Ph shr 24) and $FF; + Buf[10 + DDCBase*4] := (Ph shr 16) and $FF; + Buf[11 + DDCBase*4] := (Ph shr 8) and $FF; + Buf[12 + DDCBase*4] := Ph and $FF; + + // DUC TX frequency (bytes 329-332) + Ph := FreqToPhaseWord(FCurrentTXFreq); + Buf[329] := (Ph shr 24) and $FF; + Buf[330] := (Ph shr 16) and $FF; + Buf[331] := (Ph shr 8) and $FF; + Buf[332] := Ph and $FF; + + // Drive level (byte 345) + if FIsTransmitting then + Buf[345] := FCurrentDrive; + + // ALEX0 filter bits (bytes 1432-1435) + if FAlexEnabled then + begin + Alex0 := CalcAlex0(FCurrentRXFreq, FCurrentTXFreq, + FIsTransmitting, IsOrion2); + Buf[1432] := (Alex0 shr 24) and $FF; + Buf[1433] := (Alex0 shr 16) and $FF; + Buf[1434] := (Alex0 shr 8) and $FF; + Buf[1435] := Alex0 and $FF; + end; + + // Step attenuators ADC0/ADC1 (bytes 1443/1442) + // 0 dB = 0, max 31 dB + Buf[1443] := 0; // ADC0 attenuation + Buf[1442] := 0; // ADC1 attenuation + + DoSendTo(FSocket, Buf, SizeOf(Buf), FDevice.IPAddress, FPortHPFromPC); +end; + +procedure THPSDRNetwork.SetRunAndFreq(Run: Boolean; DDC0FreqHz, DUCFreqHz: Double; + DriveLevel: Byte); +begin + FRunning := Run; + FCurrentRXFreq := DDC0FreqHz; + FCurrentTXFreq := DUCFreqHz; + FCurrentDrive := DriveLevel; + SendFullHP; +end; + +procedure THPSDRNetwork.SendDDCAudio(const LeftRight: array of SmallInt); +var + Pkt: TDDCAudioPacket; + i: Integer; + V: SmallInt; +begin + FillChar(Pkt, SizeOf(Pkt), 0); + PackSeqBytes(Pkt.Seq, NextSeq(FSeqAudio)); + for i := 0 to Min(127, High(LeftRight)) do + begin + V := LeftRight[i]; + Pkt.AudioData[i * 2] := Byte((V shr 8) and $FF); + Pkt.AudioData[i * 2 + 1] := Byte(V and $FF); + end; + DoSendTo(FSocket, Pkt, SizeOf(Pkt), FDevice.IPAddress, FPortDDCAudio); +end; + +procedure THPSDRNetwork.SendDUCIQ(const IData, QData: array of Integer); +var + Pkt: TDUCIQPacket; + i, Off: Integer; + IV, QV: Integer; +begin + FillChar(Pkt, SizeOf(Pkt), 0); + PackSeqBytes(Pkt.Seq, NextSeq(FSeqDUCIQ)); + for i := 0 to Min(239, Min(High(IData), High(QData))) do + begin + Off := i * 6; + IV := IData[i]; + QV := QData[i]; + Pkt.IQData[Off] := Byte((IV shr 16) and $FF); + Pkt.IQData[Off + 1] := Byte((IV shr 8) and $FF); + Pkt.IQData[Off + 2] := Byte( IV and $FF); + Pkt.IQData[Off + 3] := Byte((QV shr 16) and $FF); + Pkt.IQData[Off + 4] := Byte((QV shr 8) and $FF); + Pkt.IQData[Off + 5] := Byte( QV and $FF); + end; + DoSendTo(FSocket, Pkt, SizeOf(Pkt), FDevice.IPAddress, FPortDUCIQ); +end; + + +initialization +{$IFDEF WINDOWS} + WinSock2.WSAStartup($0202, WSAData_); +{$ENDIF} + +finalization +{$IFDEF WINDOWS} + WinSock2.WSACleanup; +{$ENDIF} + +end. diff --git a/HPSDRProtocol.pas b/HPSDRProtocol.pas new file mode 100644 index 0000000..c71f6f3 --- /dev/null +++ b/HPSDRProtocol.pas @@ -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. diff --git a/MainForm.lfm b/MainForm.lfm new file mode 100644 index 0000000..617c630 --- /dev/null +++ b/MainForm.lfm @@ -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 diff --git a/MainForm.pas b/MainForm.pas new file mode 100644 index 0000000..a686116 --- /dev/null +++ b/MainForm.pas @@ -0,0 +1,3998 @@ +unit MainForm; + +{ + OpenHPSDR Transceiver - Main Form + Lazarus / FPC 3.2+ (нет inline var, нет анонимных процедур) +} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +interface + +uses + Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, FlatButton, WinFirewall, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, ComCtrls, Buttons, Menus, Math, Types, + HPSDRProtocol, HPSDRNetwork, + WDSPEngine, AudioOutput, + IntfGraphics, FPImage, + Settings, + WebServer; + +const + CLR_BG = TColor($00101010); + CLR_PANEL = TColor($00181818); + CLR_BORDER = TColor($00303030); + CLR_FREQ = TColor($0000FF00); + CLR_FREQ_DIM = TColor($00008000); + CLR_AMBER = TColor($0000AAFF); + CLR_ACTIVE = TColor($00003300); + CLR_INACTIVE = TColor($00202020); + CLR_TEXT = TColor($00CCCCCC); + CLR_TEXTDIM = TColor($00666666); + CLR_METER_ON = TColor($0000CC44); + CLR_METER_OVR= TColor($000000CC); + CLR_SPECTRUM = TColor($0044FF44); + + BAND_COUNT = 11; + MODE_COUNT = 8; + FILT_COUNT = 10; + + // Группы фильтров по типу модуляции + // SSB: LSB/USB + FILT_SSB_NAMES: array[0..FILT_COUNT-1] of string = + ('5.0k','4.4k','3.8k','3.3k','2.9k','2.7k','2.4k','2.1k','1.8k','1.0k'); + FILT_SSB_BW: array[0..FILT_COUNT-1] of Integer = + (5000, 4400, 3800, 3300, 2900, 2700, 2400, 2100, 1800, 1000); + FILT_SSB_DEF = 5; // 2.7k + + // CW: CWL/CWU + FILT_CW_NAMES: array[0..FILT_COUNT-1] of string = + ('1.0k','800','750','600','500','400','250','100','50','25'); + FILT_CW_BW: array[0..FILT_COUNT-1] of Integer = + (1000, 800, 750, 600, 500, 400, 250, 100, 50, 25); + FILT_CW_DEF = 4; // 500 + + // AM/SAM/DSB + FILT_AM_NAMES: array[0..FILT_COUNT-1] of string = + ('16k','12k','10k','8k','6.6k','5.2k','4.0k','3.1k','2.9k','2.4k'); + FILT_AM_BW: array[0..FILT_COUNT-1] of Integer = + (16000, 12000, 10000, 8000, 6600, 5200, 4000, 3100, 2900, 2400); + FILT_AM_DEF = 3; // 8k + + // FM + FILT_FM_NAMES: array[0..FILT_COUNT-1] of string = + ('20k','15k','12k','10k','8k','6k','5k','4k','3k','2k'); + FILT_FM_BW: array[0..FILT_COUNT-1] of Integer = + (20000, 15000, 12000, 10000, 8000, 6000, 5000, 4000, 3000, 2000); + FILT_FM_DEF = 0; // 20k + + BAND_NAMES: array[0..BAND_COUNT-1] of string = ( + '160m','80m','60m','40m','30m','20m','17m','15m','12m','10m','6m'); + BAND_FREQ: array[0..BAND_COUNT-1] of Double = ( + 1900000, 3750000, 5357000, 7100000, 10125000, + 14200000, 18120000, 21200000, 24940000, 28500000, 50150000); + + MODE_NAMES: array[0..MODE_COUNT-1] of string = ( + 'LSB','USB','DSB','CWL','CWU','FM','AM','SAM'); + + + + WFALL_PALETTE: array[0..255] of LongWord = ( + $00000000, $00020000, $00050000, $00080000, $000A0000, $000D0000, $00100000, $00120000, + $00150000, $00180000, $001A0000, $001D0000, $00200000, $00220000, $00250000, $00280000, + $002A0000, $002D0000, $00300000, $00320000, $00350000, $00380000, $003A0000, $003D0000, + $00400000, $00420000, $00450000, $00480000, $004A0000, $004D0000, $00500000, $00530000, + $00560000, $005A0000, $005D0000, $00600000, $00640000, $00670000, $006A0000, $006E0000, + $00710000, $00740000, $00780000, $007B0000, $007E0000, $00820000, $00850000, $00880000, + $008C0000, $008F0000, $00920000, $00960000, $00990000, $009C0000, $00A00000, $00A30000, + $00A60000, $00AA0000, $00AD0000, $00B00000, $00B40000, $00B60200, $00B90500, $00BB0700, + $00BE0A00, $00C00C00, $00C30F00, $00C51100, $00C81400, $00CA1600, $00CD1900, $00CF1B00, + $00D21E00, $00D42000, $00D72300, $00D92500, $00DC2800, $00DE2A00, $00E12D00, $00E32F00, + $00E63200, $00E73700, $00E83C00, $00E94100, $00EB4600, $00EC4B00, $00ED5000, $00EE5500, + $00F05A00, $00F15F00, $00F26400, $00F36900, $00F56E00, $00F67300, $00F77800, $00F87D00, + $00FA8200, $00FB8700, $00FC8C00, $00FD9100, $00FF9600, $00FD9A00, $00FB9E00, $00F9A200, + $00F8A600, $00F6AA00, $00F4AE00, $00F2B200, $00F1B600, $00EFBA00, $00EDBE00, $00EBC200, + $00EAC600, $00E8CA00, $00E6CE00, $00E4D200, $00E3D600, $00E1DA00, $00DFDE00, $00DDE200, + $00DCE600, $00D6E700, $00D0E800, $00CAE900, $00C4EB00, $00BEEC00, $00B8ED00, $00B2EE00, + $00ACF000, $00A6F100, $00A0F200, $009AF300, $0094F500, $008EF600, $0088F700, $0082F800, + $007CFA00, $0076FB00, $0070FC00, $006AFD00, $0064FF00, $005FFF04, $005AFF08, $0055FF0C, + $0050FF10, $004BFF14, $0046FF18, $0041FF1C, $003CFF20, $0037FF24, $0032FF28, $002CFF2C, + $0028FF30, $0023FF34, $001EFF38, $0019FF3C, $0014FF40, $000FFF44, $000AFF48, $0005FF4C, + $0000FF50, $0000FF56, $0000FF5C, $0000FF62, $0000FF68, $0000FF6E, $0000FF74, $0000FF7A, + $0000FF80, $0000FF86, $0000FF8C, $0000FF92, $0000FF98, $0000FF9E, $0000FFA4, $0000FFAA, + $0000FFB0, $0000FFB6, $0000FFBC, $0000FFC2, $0000FFC8, $0000FDCA, $0000FBCD, $0000F9D0, + $0000F8D3, $0000F6D5, $0000F4D8, $0000F2DB, $0000F1DE, $0000EFE0, $0000EDE3, $0000EBE6, + $0000EAE9, $0000E8EB, $0000E6EE, $0000E4F1, $0000E3F4, $0000E1F6, $0000DFF9, $0000DDFC, + $0000DCFF, $0000D7FF, $0000D2FF, $0000CDFF, $0000C8FF, $0000C3FF, $0000BEFF, $0000B9FF, + $0000B4FF, $0000AFFF, $0000AAFF, $0000A5FF, $0000A0FF, $00009BFF, $000096FF, $000091FF, + $00008CFF, $000087FF, $000082FF, $00007DFF, $000078FF, $000073FF, $00006FFF, $00006AFF, + $000066FF, $000061FF, $00005DFF, $000058FF, $000054FF, $00004FFF, $00004BFF, $000046FF, + $000042FF, $00003DFF, $000039FF, $000034FF, $000030FF, $00002BFF, $000027FF, $000022FF, + $00001EFF, $00112DFF, $00223CFF, $00334BFF, $00445AFF, $005569FF, $006678FF, $007787FF, + $008896FF, $0099A5FF, $00AAB4FF, $00BBC3FF, $00CCD2FF, $00DDE1FF, $00EEF0FF, $00FFFFFF + ); + +type + TDeviceItem = record + Dev: THPSDRDevice; + Display: string; + end; + + // Синхронизирующий объект для OnDeviceFound + TDeviceFoundSync = class + private + FForm: TObject; // TMainForm, через forward ref + FDev: THPSDRDevice; + FEntry: string; + public + constructor Create(AForm: TObject; const D: THPSDRDevice; const E: string); + procedure Execute; + end; + + // Синхронизирующий объект для HP Status + TStatusUISync = class + private + FForm: TObject; + FFwdW: Double; + FSWRV: Double; + FSupplyV: Double; + FPLLLock: Boolean; + public + constructor Create(AForm: TObject; FW, SW, SV: Double; PLL: Boolean); + procedure Execute; + end; + + // Синхронизирующий объект для DDC IQ + TDDCSeqSync = class + private + FForm: TObject; + FDDCIdx: Integer; + FSeq: LongWord; + public + constructor Create(AForm: TObject; Idx: Integer; Seq: LongWord); + procedure Execute; + end; + + { TMainForm } + TMainForm = class(TForm) + private + // ---- Network ---- + FNetwork: THPSDRNetwork; + FDevices: array of TDeviceItem; + FDeviceCount: Integer; + FDeviceDialog: TDeviceDialog; + FPendingIP: string; // IP устройства для подключения + FVfoOverlay: TVfoOverlay; // накладка SmartSDR-стиль на спектре + FPanelHidden: Boolean; // True = левая панель скрыта + FPendingBoardType: Integer; // BoardType устройства для подключения + + // ---- DSP + Audio ---- + FDSPEngine: TWDSPEngine; + FAudioOut: TAudioOutput; + FWDSPReady: Boolean; // True когда WDSP открыт и работает + + // ---- State ---- + FVfoA: Double; + FVfoB: Double; + FActiveVfo: Integer; + FMode: Integer; + FFilter: Integer; + FAGCMode: Integer; // 0=FAST 1=MED 2=SLOW 3=LONG 4=OFF + FAGCTop: Integer; // AGC level dBm, −20..−120 + FCTun: Boolean; // Center Tune: True=спектр стоит, маркер двигается + FFilterBW: Integer; // текущая полоса фильтра в Гц + // мышь на спектре/водопаде + FSpecDrag: Boolean; + FSpecDragX0: Integer; // X при нажатии + FSpecDragFreq: Double; // FCenterFreq при нажатии + FSpectrumDirty: Boolean; // таймер должен перерисовать спектр/водопад + // Маркер правой кнопки: вертикальная линия на спектре и водопаде + FMarkerActive: Boolean; // True = линия видима + FMarkerX: Integer; // X в пикселях (относительно ширины панели) + FDriveLevel: Byte; + FRunning: Boolean; + FTransmitting: Boolean; + FMuted: Boolean; + FVolume: Integer; + FLastSMeter: Double; + FSMeterPeak: Double; // верхняя граница светлой зоны + FSMeterMin: Double; // нижняя граница светлой зоны + FSMeterAvg: Double; // сглаженное среднее (EMA) + FRXPacketCount: LongWord; // счётчик принятых IQ пакетов + FRXStartTime: QWord; // GetTickCount64 момента нажатия START + FRXLastPktTime: QWord; // GetTickCount64 последнего принятого пакета + FActiveDDC: Integer; // DDC index для текущей платы (0 или 2) + FLastDDCSeq: LongWord; // последний seq (пишется из сетевого потока) + FLastDDCIndex: Integer; // последний DDC index + FLastFwdW: Double; + FLastSWR: Double; + + // ---- Spectrum ---- + FSpectrumBuf: array[0..1023] of Single; + FWfAvgBuf: array[0..1023] of Single; // EMA спектра для WF AGC/NF + FSpectrumBitmap: TBitmap; + // --- Waterfall display normalization --- + FWfAGCEnabled: Boolean; // Waterfall AGC: авто подстройка верхней границы + FWfNFEnabled: Boolean; // Noise Floor tracking: авто подстройка нижней границы + FWfHigh: Double; // верхняя граница waterfall (dBm) — "белое" + FWfLow: Double; // нижняя граница waterfall (dBm) — "чёрное" + FWaterfallBitmap:TBitmap; // отображаемый буфер + FWaterfallTemp: TBitmap; // рабочий буфер для скролла + FSpectrumWidth: Integer; + FSpectrumHeight: Integer; + FWaterfallHeight:Integer; + // --- Settings --- + FSettings: TSettingsManager; + FWebServer: TWebServer; // веб-интерфейс (порт 8080) + // Временные поля для передачи параметров в Synchronize-методы + FWebSyncFreq: Double; + FWebSyncInt: Integer; + FWebSyncBool: Boolean; + FWebSyncM: TThreadMethod; + FCurrentBand: Integer; // текущий активный диапазон 0..10 + FDevMAC: array[0..5] of Byte; // MAC подключённого трансивера + FPendingDev: THPSDRDevice; // устройство ожидающее открытия WDSP + FBandCache: array[0..CFG_BAND_COUNT-1] of TBandSettings; // кэш диапазонов + FDevConnected: Boolean; // True после первого подключения + FCenterFreq: Double; // центр спектра = LO (DDC). При CTUN ON не меняется при кручении VFO + FSpanHz: Double; + FSampleRate: Integer; // текущий DDC sample rate (Hz) + + // ---- Timers ---- + FMeterTimer: TTimer; + FSpectrumTimer: TTimer; + FAfterShowTimer:TTimer; // однократный таймер для пост-инициализации + + // ---- Toolbar ---- + PanelToolbar: TPanel; + BtnDiscover: TFlatButton; + BtnStartStop: TFlatButton; // START / STOP (connect+run в одном) + + // ---- Left panel ---- + PanelLeft: TPanel; + + PanelVfoA: TPanel; + LblVfoALabel: TLabel; + FreqDispA: TFreqDisplay; + + PanelVfoB: TPanel; + LblVfoBLabel: TLabel; + FreqDispB: TFreqDisplay; + + PanelVfoButtons: TPanel; + BtnVfoSwap: TFlatButton; + BtnVfoACopyB: TFlatButton; + BtnVfoBCopyA: TFlatButton; + + PanelBands: TPanel; + BtnBand: array[0..BAND_COUNT-1] of TFlatButton; + + PanelMode: TPanel; + BtnMode: array[0..MODE_COUNT-1] of TFlatButton; + + PanelFilter: TPanel; + BtnFilter: array[0..FILT_COUNT-1] of TFlatButton; + BtnCTun: TFlatButton; + + PanelRX: TPanel; + LblAGC: TLabel; + BtnAGCMode: array[0..4] of TFlatButton; // FAST MED SLOW LONG OFF + LblAGCTop: TLabel; // показывает значение уровня + TrkAGC: TTrackBar; // ползунок уровня AGC + LblVol: TLabel; + TrkVolume: TTrackBar; + BtnNR: TFlatButton; + BtnNB: TFlatButton; + BtnANF: TFlatButton; + BtnMute: TFlatButton; + + PanelSMeterRight: TPanel; // контейнер S-метра справа + PbSMeterRight: TPaintBox;// новый большой S-метр справа + FSmBitmap: TBitmap; // off-screen буфер для alpha-blend + + PanelTX: TPanel; + LblDrv: TLabel; + TrkDrive: TTrackBar; + BtnMOX: TFlatButton; + PbFwdPower: TPaintBox; + PbSWR: TPaintBox; + LblFwdPwr: TLabel; + LblSWRVal: TLabel; + + // ---- Right panel ---- + PanelRight: TPanel; + PanelSpanButtons: TPanel; + LblSpan: TLabel; + BtnSpan48k: TFlatButton; + BtnSpan96k: TFlatButton; + BtnSpan192k: TFlatButton; + BtnSpan384k: TFlatButton; + BtnSpan768k: TFlatButton; + BtnSpan1536k: TFlatButton; + BtnWfAGC: TFlatButton; + BtnWfNF: TFlatButton; + BtnHidePanel: TFlatButton; // скрыть/показать левую панель + PbSpectrum: TPaintBox; + PbRuler: TPaintBox; // полоса частотных меток между спектром и водопадом + PbWaterfall: TPaintBox; + + // ---- Status bar ---- + StatusBar1: TStatusBar; + + // ---- Helpers ---- + procedure BuildUI; + procedure ApplyDarkTheme; + procedure StyleButton(B: TFlatButton; Active: Boolean = False); + procedure UpdateVfoDisplay; + function FormatFreq(Hz: Double): string; + function ScaleX(X, Total, Width: Integer): Integer; + + procedure DrawSMeterWide(ACanvas: TCanvas; R: TRect; Value, Peak, MinVal: Double; + out ZX1, ZX2, ZY1, ZY2: Integer); + procedure DrawSMeterZone(ACanvas: TCanvas; R: TRect; X1, X2, Y1, Y2: Integer); + procedure PbSMeterRightPaint(Sender: TObject); + procedure DrawBarMeter(ACanvas: TCanvas; R: TRect; + Value, MaxVal: Double; BarColor: TColor); + procedure DrawSpectrum; + procedure DrawSpectrumGradient(const SpPts: array of TPoint; W, H: Integer); + procedure DrawMarkerLine(C: TCanvas; W, H: Integer); + procedure DrawWaterfall; + procedure ResetWfAvgBuf; + procedure ResizeSMeter; + procedure FillDemoSpectrum; + procedure ResetSpectrumBuf; + procedure ResizeSpectrumPanels; + + // Network callbacks + procedure OnDeviceFound(const Dev: THPSDRDevice); + procedure OnHPStatusCB(const Status: THighPriorityStatus); + procedure OnDDCIQCB(DDCIndex: Integer; const Data: TDDCIQPacket); + procedure OnWDSPOpenDone(Success: Boolean); + procedure DoConnectDevice(const Dev: THPSDRDevice); + procedure OnMicPacketCB(const Data: TMicDataPacket); + + // DSP/Audio callbacks (вызываются из рабочих потоков) + procedure OnAudioReady(const Left, Right: array of Single; Count: Integer); + procedure OnSpectrumReady(const Pixels: array of Single; Count: Integer); + + // Public UI update (called from sync objects) + procedure DoAddDevice(const Dev: THPSDRDevice; const Entry: string); + procedure DoUpdateStatus(FwdW, SWRV, SupplyV: Double; PLLLock: Boolean); + procedure DoUpdateDDCSeq(DDCIdx: Integer; Seq: LongWord); + procedure DoUpdateDDCSeqOrNoDevice(DDCIdx: Integer; Seq: LongWord); + + // Event handlers + procedure BtnDiscoverClick(Sender: TObject); + procedure BtnDiscoverFromDialog(Sender: TObject); + procedure BtnStartStopClick(Sender: TObject); + procedure FreqDispAChanged(Sender: TObject; NewFreq: Int64); + procedure ApplyVfoA(NewFreq: Int64); + // Настройки + procedure SaveCurrentBand; + procedure RestoreBand(BandIdx: Integer); + procedure SaveAllAndExit; + procedure RestoreWindowBounds; + function MakeGlobalSettings: TGlobalSettings; + function MakeBandSettings: TBandSettings; + procedure FreqDispBChanged(Sender: TObject; NewFreq: Int64); + procedure BtnBandClick(Sender: TObject); + procedure ApplyModeFilter; + procedure BtnModeClick(Sender: TObject); + procedure BtnFilterClick(Sender: TObject); + procedure BtnCTunClick(Sender: TObject); + procedure UpdateFilterButtons; + procedure PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure PbSpectrumMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure PbSpectrumMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure DrawRuler; + procedure PbWaterfallMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure PbWaterfallMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure PbWaterfallMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure DoSpectrumClick(PixelX: Integer; PanelWidth: Integer); + procedure DoSpectrumDrag(PixelX: Integer; PanelWidth: Integer); + procedure BtnVfoSwapClick(Sender: TObject); + procedure BtnVfoACopyBClick(Sender: TObject); + procedure BtnVfoBCopyAClick(Sender: TObject); + procedure BtnMOXClick(Sender: TObject); + procedure BtnMuteClick(Sender: TObject); + procedure BtnNRClick(Sender: TObject); + procedure BtnNBClick(Sender: TObject); + procedure BtnANFClick(Sender: TObject); + procedure BtnSpanClick(Sender: TObject); + // Веб-интерфейс: callbacks от TWebServer + procedure WebOnFreq(Hz: Double); + procedure WebOnMode(Mode: Integer); + procedure WebOnFilter(BW: Integer); + procedure WebOnAGC(Mode: Integer); + procedure WebOnAGCTop(DB: Integer); + procedure WebOnBand(Idx: Integer); + procedure WebOnSpan(Hz: Integer); + procedure WebOnVolume(V: Integer); + procedure WebOnWfAGC(On_: Boolean); + procedure WebOnWfNF(On_: Boolean); + procedure WebOnRun(On_: Boolean); + procedure WebOnMute(On_: Boolean); + procedure WebOnCtun(On_: Boolean); + procedure WebOnNR(On_: Boolean); + procedure WebOnNB(On_: Boolean); + procedure WebOnANF(On_: Boolean); + // Synchronize-обёртки (выполняются в UI-потоке) + procedure SyncWebFreq; + procedure SyncWebMode; + procedure SyncWebFilter; + procedure SyncWebAGC; + procedure SyncWebAGCTop; + procedure SyncWebBand; + procedure SyncWebSpan; + procedure SyncWebVolume; + procedure SyncWebWfAGC; + procedure SyncWebWfNF; + procedure SyncWebRun; + procedure SyncWebMute; + procedure SyncWebCtun; + procedure SyncWebNR; + procedure SyncWebNB; + procedure SyncWebANF; + procedure BtnWfAGCClick(Sender: TObject); + procedure BtnWfNFClick(Sender: TObject); + procedure BtnHidePanelClick(Sender: TObject); + procedure PositionVfoOverlay; + procedure OnModeFilterSelect(Mode: Integer; FilterBW: Integer); + procedure PbSpectrumDblClick(Sender: TObject); + procedure TrkDriveChange(Sender: TObject); + procedure TrkVolumeChange(Sender: TObject); + procedure BtnAGCModeClick(Sender: TObject); + procedure TrkAGCChange(Sender: TObject); + procedure PbFwdPowerPaint(Sender: TObject); + procedure PbSWRPaint(Sender: TObject); + procedure PbSpectrumPaint(Sender: TObject); + procedure PbRulerPaint(Sender: TObject); + procedure PbWaterfallPaint(Sender: TObject); + procedure MeterTimerTick(Sender: TObject); + procedure SpectrumTimerTick(Sender: TObject); + procedure RightPanelResize(Sender: TObject); + procedure AfterShowTick(Sender: TObject); + + published + // Обработчики событий формы — должны быть в published для RTTI/LFM + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.lfm} + +// =========================================================================== +// Общая функция декодирования типа платы — используется везде +// =========================================================================== + +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; + +// =========================================================================== +// Sync helpers +// =========================================================================== + +constructor TDeviceFoundSync.Create(AForm: TObject; + const D: THPSDRDevice; const E: string); +begin + inherited Create; + FForm := AForm; + FDev := D; + FEntry := E; +end; + +procedure TDeviceFoundSync.Execute; +begin + TMainForm(FForm).DoAddDevice(FDev, FEntry); +end; + +constructor TStatusUISync.Create(AForm: TObject; + FW, SW, SV: Double; PLL: Boolean); +begin + inherited Create; + FForm := AForm; + FFwdW := FW; + FSWRV := SW; + FSupplyV := SV; + FPLLLock := PLL; +end; + +procedure TStatusUISync.Execute; +begin + TMainForm(FForm).DoUpdateStatus(FFwdW, FSWRV, FSupplyV, FPLLLock); +end; + +constructor TDDCSeqSync.Create(AForm: TObject; Idx: Integer; Seq: LongWord); +begin + inherited Create; + FForm := AForm; + FDDCIdx := Idx; + FSeq := Seq; +end; + +procedure TDDCSeqSync.Execute; +begin + TMainForm(FForm).DoUpdateDDCSeqOrNoDevice(FDDCIdx, FSeq); +end; + +// =========================================================================== +// FormCreate / FormDestroy +// =========================================================================== + + +// =========================================================================== +// Settings helpers +// =========================================================================== + +procedure TMainForm.RestoreWindowBounds; +var + L, T, Wd, Ht: Integer; +begin + FSettings.LoadWindowBounds(L, T, Wd, Ht); + if (Wd > 400) and (Ht > 300) then + begin + Left := L; + Top := T; + Width := Wd; + Height := Ht; + end; +end; + +function TMainForm.MakeBandSettings: TBandSettings; +begin + Result.VfoA := FVfoA; + Result.VfoB := FVfoB; + Result.Mode := FMode; + Result.FilterIdx := FFilter; + Result.FilterBW := FFilterBW; + Result.AGCMode := FAGCMode; + Result.AGCTop := FAGCTop; + Result.CTun := FCTun; + Result.SpanHz := FSpanHz; + // Waterfall AGC/NF — глобальные (не диапазонные) +end; + +function TMainForm.MakeGlobalSettings: TGlobalSettings; +begin + Result.Volume := FVolume; + Result.DriveLevel := FDriveLevel; + Result.ActiveVfo := FActiveVfo; + Result.NREnabled := BtnNR.Tag = 1; + Result.NBEnabled := BtnNB.Tag = 1; + Result.ANFEnabled := BtnANF.Tag = 1; + Result.AGCSlope := 0; + Result.AGCHangThreshold := 100; + Result.WfAGCEnabled := FWfAGCEnabled; + Result.WfNFEnabled := FWfNFEnabled; + Result.LastBand := FCurrentBand; + Result.SampleRate := FSampleRate; +end; + +procedure TMainForm.SaveCurrentBand; +begin + if not FDevConnected then Exit; + FBandCache[FCurrentBand] := MakeBandSettings; + FSettings.SaveBand(FDevMAC, FCurrentBand, FBandCache[FCurrentBand]); +end; + +procedure TMainForm.RestoreBand(BandIdx: Integer); +var + B: TBandSettings; + i: Integer; +begin + if (BandIdx < 0) or (BandIdx >= CFG_BAND_COUNT) then Exit; + B := FBandCache[BandIdx]; + + // --- Кнопки диапазонов --- + for i := 0 to BAND_COUNT - 1 do + StyleButton(BtnBand[i], i = BandIdx); + // Сбрасываем waterfall AGC/NF при смене диапазона + FWfHigh := -50.0; + FWfLow := -120.0; + // Сбрасываем EMA буфер — иначе старый спектр "просочится" в новый диапазон + ResetWfAvgBuf; + + // --- Режим: сначала устанавливаем FMode, потом кнопки и WDSP --- + FMode := B.Mode; + for i := 0 to MODE_COUNT - 1 do + StyleButton(BtnMode[i], i = FMode); + if FWDSPReady then + FDSPEngine.SetMode(FMode); + + // --- Фильтр --- + FFilter := B.FilterIdx; + FFilterBW := B.FilterBW; + UpdateFilterButtons; // обновляет кнопки фильтра + ApplyModeFilter; // применяет Lo/Hi в WDSP с учётом нового FMode + + // --- AGC --- + FAGCMode := B.AGCMode; + FAGCTop := B.AGCTop; + for i := 0 to 4 do + StyleButton(BtnAGCMode[i], i = FAGCMode); + TrkAGC.Position := FAGCTop; + LblAGCTop.Caption := Format('%ddB', [FAGCTop]); + if FWDSPReady then + begin + FDSPEngine.SetAGCTop(FAGCTop); + FDSPEngine.SetAGC(TWDSPAGCMode(FAGCMode), 50.0); + end; + + // --- CTUN --- + FCTun := B.CTun; + StyleButton(BtnCTun, FCTun); + if FWDSPReady and not FCTun then + FDSPEngine.SetShift(0.0); + + // --- Sample Rate / Span --- + // SampleRate — глобальный, не per-band. Не восстанавливаем из диапазона. + // Обновляем только FSpanHz для отображения (берём текущий FSampleRate) + FSpanHz := FSampleRate; + StyleButton(BtnSpan48k, FSampleRate = 48000); + StyleButton(BtnSpan96k, FSampleRate = 96000); + StyleButton(BtnSpan192k, FSampleRate = 192000); + StyleButton(BtnSpan384k, FSampleRate = 384000); + StyleButton(BtnSpan768k, FSampleRate = 768000); + StyleButton(BtnSpan1536k, FSampleRate = 1536000); + + // --- VFO A: центрируем на новой частоте, сбрасываем shift --- + FCenterFreq := B.VfoA; // DDC = центр диапазона + FVfoB := B.VfoB; + FreqDispB.Frequency := Round(FVfoB); + + // ApplyVfoA обновит сеть, FreqDisp, shift, перерисует + ApplyVfoA(Round(B.VfoA)); +end; + +procedure TMainForm.SaveAllAndExit; +begin + if FDevConnected then + begin + SaveCurrentBand; + FSettings.SaveGlobal(FDevMAC, MakeGlobalSettings); + FSettings.Save; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +var + bi_: Integer; +begin + FVfoA := 14200000; + FVfoB := 7100000; + FActiveVfo := 0; + FMode := 1; + FFilter := 5; + FAGCMode := 1; // MEDIUM + FAGCTop := 90; // −90 dBm + // default: зависит от режима, будет сброшен в UpdateFilterButtons + FCTun := False; + FFilterBW := 2700; + FSpecDrag := False; + FDriveLevel := 100; + FRunning := False; + FTransmitting := False; + FMuted := False; + FVolume := 70; + FCenterFreq := FVfoA; + FSpanHz := 192000; + FSampleRate := 192000; + FCurrentBand := 5; // 20m по умолчанию + // Waterfall normalization + FWfHigh := -50.0; // начальная верхняя граница dBm + // WF avg buffer — инициализируем значением шумового пола + // FWfAvgBuf инициализируется в ResetSpectrumBuf + FWfLow := -120.0; // начальная нижняя граница dBm + FWfAGCEnabled := False; + FWfNFEnabled := False; + FDevConnected := False; + FillChar(FDevMAC, SizeOf(FDevMAC), 0); + + // Инициализируем кэш диапазонов умолчаниями + for bi_ := 0 to CFG_BAND_COUNT - 1 do + TSettingsManager.DefaultBand(bi_, FBandCache[bi_]); + FCurrentBand := 5; + + // Загружаем JSON настройки + FSettings := TSettingsManager.Create; + FSettings.Load; + // Восстанавливаем размер/позицию окна при старте (до подключения устройства) + RestoreWindowBounds; + // S-метр позиционируем после рестора размера окна + // (будет пересчитан в первом тике SpectrumTimerTick) + FLastSMeter := -130; + + // Создаём веб-сервер (логин: admin, пароль: hpsdr — менять здесь) + FWebServer := TWebServer.Create('admin', 'hpsdr'); + FWebServer.OnFreq := WebOnFreq; + FWebServer.OnMode := WebOnMode; + FWebServer.OnFilter := WebOnFilter; + FWebServer.OnAGC := WebOnAGC; + FWebServer.OnAGCTop := WebOnAGCTop; + FWebServer.OnBand := WebOnBand; + FWebServer.OnSpan := WebOnSpan; + FWebServer.OnVolume := WebOnVolume; + FWebServer.OnWfAGC := WebOnWfAGC; + FWebServer.OnWfNF := WebOnWfNF; + FWebServer.OnRun := WebOnRun; + FWebServer.OnMute := WebOnMute; + FWebServer.OnCtun := WebOnCtun; + FWebServer.OnNR := WebOnNR; + FWebServer.OnNB := WebOnNB; + FWebServer.OnANF := WebOnANF; + FWebServer.Start; + FSMeterPeak := -130; + FSMeterMin := -130; + FSMeterAvg := -130; + FRXPacketCount := 0; + FActiveDDC := 0; + FLastDDCSeq := 0; + FLastDDCIndex := 0; + FLastFwdW := 0; + FLastSWR := 1; + FDeviceCount := 0; + FDeviceDialog := TDeviceDialog.Create(Self); + FDeviceDialog.OnDiscover := BtnDiscoverFromDialog; + FVfoOverlay := TVfoOverlay.Create(Self); + FVfoOverlay.OnSelect := OnModeFilterSelect; + FVfoOverlay.Visible := False; + FPanelHidden := False; + + FSpectrumBitmap := TBitmap.Create; + FWaterfallBitmap := TBitmap.Create; + FWaterfallTemp := TBitmap.Create; + ResetSpectrumBuf; + + FNetwork := THPSDRNetwork.Create; + FNetwork.OnDeviceFound := OnDeviceFound; + FNetwork.OnHPStatus := OnHPStatusCB; + FNetwork.OnDDCIQ := OnDDCIQCB; + FNetwork.OnMicPacket := OnMicPacketCB; + + BuildUI; + ResizeSMeter; + ApplyDarkTheme; + UpdateVfoDisplay; + UpdateFilterButtons; + + // DSP Engine — создаём объект, Open вызовется при нажатии START + // (FDSPEngine.Open загружает libwdsp и занимает ~1-2 сек) + FWDSPReady := False; + FDSPEngine := TWDSPEngine.Create(192000, 48000, 1024); + FDSPEngine.OnAudio := OnAudioReady; + FDSPEngine.OnSpectrum := OnSpectrumReady; + + // Audio output — создаём объект сейчас, открываем после показа формы + // (Pa_Initialize на Linux пишет в stderr до перехвата сигналов FPC) + FAudioOut := TAudioOutput.Create(48000); + + FMeterTimer := TTimer.Create(Self); + FMeterTimer.Interval := 100; + FMeterTimer.OnTimer := MeterTimerTick; + FMeterTimer.Enabled := True; + + + FSpectrumTimer := TTimer.Create(Self); + FSpectrumTimer.Interval := 50; + FSpectrumTimer.OnTimer := SpectrumTimerTick; + FSpectrumTimer.Enabled := True; + + // Однократный таймер — инициализация аудио после показа формы + FAfterShowTimer := TTimer.Create(Self); + FAfterShowTimer.Interval := 200; + FAfterShowTimer.OnTimer := AfterShowTick; + FAfterShowTimer.Enabled := True; + + OnMouseWheel := FormMouseWheel; + + // Проверяем и при необходимости добавляем исключение в Windows Firewall + // (UDP входящий трафик для HPSDR Protocol 2) + {$IFDEF WINDOWS} + FirewallEnsureAllowed(ParamStr(0), 'OpenHPSDR Transceiver'); + {$ENDIF} +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FMeterTimer.Enabled := False; + FSpectrumTimer.Enabled := False; + if FNetwork.Running then + FNetwork.SetRunAndFreq(False, FCenterFreq, FCenterFreq, 0); + FNetwork.Disconnect; + FNetwork.Free; + FAudioOut.Close; + FAudioOut.Free; + FDSPEngine.Close; + FDSPEngine.Free; + FSpectrumBitmap.Free; + FWaterfallBitmap.Free; + FWaterfallTemp.Free; + + // Сохраняем настройки при закрытии + if FDevConnected then + begin + SaveCurrentBand; + FSettings.SaveGlobal(FDevMAC, MakeGlobalSettings); + end; + // Размер окна сохраняем всегда (не зависит от подключения) + FSettings.SaveWindowBounds(Left, Top, Width, Height); + FSettings.Save; + FSettings.Free; + FWebServer.Stop; + FWebServer.Free; +end; + +procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); +begin + // Останавливаем трансивер как при нажатии STOP + if FNetwork.Connected then + begin + if FRunning then + begin + FNetwork.UpdateState(FCenterFreq, FCenterFreq, 0, False, True, True); + FNetwork.SetRunAndFreq(False, FCenterFreq, FCenterFreq, 0); + FRunning := False; + FTransmitting := False; + if FWDSPReady then FDSPEngine.SetTXRun(False); + end; + FNetwork.Disconnect; + end; + CloseAction := caFree; +end; + +// =========================================================================== +// Build UI (без анонимных процедур и inline var) +// =========================================================================== + +procedure TMainForm.BuildUI; +const + BTN_H = 26; + BTN_SM = 24; + LEFT_W = 232; +var + i, X, Y, W: Integer; + B: TFlatButton; + + function MakeBtn(Parent: TWinControl; const Cap: string; + ALeft, ATop, AW, AH: Integer; Handler: TNotifyEvent): TFlatButton; + begin + Result := TFlatButton.Create(Self); + Result.Parent := Parent; + Result.Caption := Cap; + Result.Left := ALeft; + Result.Top := ATop; + Result.Width := AW; + Result.Height := AH; + Result.OnClick := Handler; + StyleButton(Result, False); + end; + + procedure MakeLbl(Parent: TWinControl; const Cap: string; ALeft, ATop: Integer); + var + L: TLabel; + begin + L := TLabel.Create(Self); + L.Parent := Parent; + L.Caption := Cap; + L.Left := ALeft; + L.Top := ATop; + L.Font.Color := CLR_TEXTDIM; + L.Font.Name := 'Courier New'; + L.Font.Size := 7; + end; + +begin + // ---- Toolbar ---- + PanelToolbar := TPanel.Create(Self); + PanelToolbar.Parent := Self; + PanelToolbar.Align := alTop; + PanelToolbar.Height := 36; + PanelToolbar.BevelOuter := bvNone; + + X := 4; + BtnDiscover := MakeBtn(PanelToolbar, 'DISCOVER', X, 3, 80, BTN_H, BtnDiscoverClick); + BtnStartStop := MakeBtn(PanelToolbar, 'START', X+84, 3, 76, BTN_H, BtnStartStopClick); + + // ---- Status bar ---- + StatusBar1 := TStatusBar.Create(Self); + StatusBar1.Parent := Self; + StatusBar1.Align := alBottom; + StatusBar1.SimplePanel := False; + with StatusBar1.Panels do + begin + Add; Items[0].Width := 150; Items[0].Text := 'IP: --'; + Add; Items[1].Width := 120; Items[1].Text := 'Board: --'; + Add; Items[2].Width := 320; Items[2].Text := 'Supply: -- | FWD: -- | SWR: --'; + Add; Items[3].Width := 250; Items[3].Text := 'RX: waiting...'; + Add; Items[4].Width := 200; Items[4].Text := 'Not connected'; + end; + + // ---- Left panel ---- + PanelLeft := TPanel.Create(Self); + PanelLeft.Parent := Self; + PanelLeft.Align := alLeft; + PanelLeft.Width := LEFT_W; + PanelLeft.BevelOuter := bvNone; + + Y := 2; + + // VFO A + PanelVfoA := TPanel.Create(Self); + PanelVfoA.Parent := PanelLeft; + PanelVfoA.SetBounds(0, Y, LEFT_W, 56); + PanelVfoA.BevelOuter := bvNone; + + LblVfoALabel := TLabel.Create(Self); + LblVfoALabel.Parent := PanelVfoA; + LblVfoALabel.Caption := 'VFO-A'; + LblVfoALabel.Left := 4; LblVfoALabel.Top := 2; + LblVfoALabel.Font.Name := 'Courier New'; LblVfoALabel.Font.Size := 7; + LblVfoALabel.Font.Color := CLR_TEXTDIM; + + FreqDispA := TFreqDisplay.Create(Self); + FreqDispA.Parent := PanelVfoA; + FreqDispA.SetBounds(0, 14, LEFT_W, 36); + FreqDispA.FontSize := 20; + FreqDispA.FontName := 'Courier New'; + FreqDispA.Frequency := Round(FVfoA); + FreqDispA.ColorNormal := CLR_FREQ; + FreqDispA.ColorHover := TColor($0040DDFF); + FreqDispA.ColorDim := CLR_TEXTDIM; + FreqDispA.OnChange := FreqDispAChanged; + + Inc(Y, 58); + + // VFO B + PanelVfoB := TPanel.Create(Self); + PanelVfoB.Parent := PanelLeft; + PanelVfoB.SetBounds(0, Y, LEFT_W, 46); + PanelVfoB.BevelOuter := bvNone; + + LblVfoBLabel := TLabel.Create(Self); + LblVfoBLabel.Parent := PanelVfoB; + LblVfoBLabel.Caption := 'VFO-B'; + LblVfoBLabel.Left := 4; LblVfoBLabel.Top := 2; + LblVfoBLabel.Font.Name := 'Courier New'; LblVfoBLabel.Font.Size := 7; + LblVfoBLabel.Font.Color := CLR_TEXTDIM; + + FreqDispB := TFreqDisplay.Create(Self); + FreqDispB.Parent := PanelVfoB; + FreqDispB.SetBounds(0, 14, LEFT_W, 28); + FreqDispB.FontSize := 14; + FreqDispB.FontName := 'Courier New'; + FreqDispB.Frequency := Round(FVfoB); + FreqDispB.ColorNormal := CLR_FREQ_DIM; + FreqDispB.ColorHover := TColor($0040DDFF); + FreqDispB.ColorDim := CLR_TEXTDIM; + FreqDispB.OnChange := FreqDispBChanged; + + Inc(Y, 50); + + // VFO buttons + PanelVfoButtons := TPanel.Create(Self); + PanelVfoButtons.Parent := PanelLeft; + PanelVfoButtons.SetBounds(0, Y, LEFT_W, BTN_H + 4); + PanelVfoButtons.BevelOuter := bvNone; + + BtnVfoSwap := MakeBtn(PanelVfoButtons, 'A<>B', 2, 2, 72, BTN_H, BtnVfoSwapClick); + BtnVfoACopyB := MakeBtn(PanelVfoButtons, 'A>B', 78, 2, 72, BTN_H, BtnVfoACopyBClick); + BtnVfoBCopyA := MakeBtn(PanelVfoButtons, 'B>A', 154, 2, 72, BTN_H, BtnVfoBCopyAClick); + + Inc(Y, BTN_H + 8); + + // Band selector + PanelBands := TPanel.Create(Self); + PanelBands.Parent := PanelLeft; + PanelBands.SetBounds(0, Y, LEFT_W, 74); + PanelBands.BevelOuter := bvNone; + MakeLbl(PanelBands, 'BAND', 4, 2); + W := (LEFT_W - 6) div 6; + for i := 0 to BAND_COUNT - 1 do + begin + B := MakeBtn(PanelBands, BAND_NAMES[i], + 2 + (i mod 6) * W, + 16 + (i div 6) * 27, + W - 2, BTN_SM, BtnBandClick); + B.Tag := i; + BtnBand[i] := B; + end; + + Inc(Y, 76); + + // Mode selector + PanelMode := TPanel.Create(Self); + PanelMode.Parent := PanelLeft; + PanelMode.SetBounds(0, Y, LEFT_W, 74); + PanelMode.BevelOuter := bvNone; + MakeLbl(PanelMode, 'MODE', 4, 2); + W := (LEFT_W - 6) div 4; + for i := 0 to MODE_COUNT - 1 do + begin + B := MakeBtn(PanelMode, MODE_NAMES[i], + 2 + (i mod 4) * W, + 16 + (i div 4) * 27, + W - 2, BTN_SM, BtnModeClick); + B.Tag := i; + BtnMode[i] := B; + StyleButton(B, i = FMode); + end; + + Inc(Y, 76); + + // Filter selector (10 кнопок в 2 ряда по 5) + PanelFilter := TPanel.Create(Self); + PanelFilter.Parent := PanelLeft; + PanelFilter.SetBounds(0, Y, LEFT_W, 74); + PanelFilter.BevelOuter := bvNone; + MakeLbl(PanelFilter, 'FILTER', 4, 2); + W := (LEFT_W - 6) div 5; + for i := 0 to FILT_COUNT - 1 do + begin + B := MakeBtn(PanelFilter, '---', + 2 + (i mod 5) * W, + 16 + (i div 5) * 27, + W - 2, BTN_SM, BtnFilterClick); + B.Tag := i; + BtnFilter[i] := B; + end; + + Inc(Y, 76); + + // CTUN button + BtnCTun := MakeBtn(PanelLeft, 'CTUN', 2, Y, LEFT_W div 3 - 2, BTN_H, BtnCTunClick); + BtnCTun.Tag := 0; + StyleButton(BtnCTun, FCTun); + + Inc(Y, BTN_H + 4); + + // RX controls + PanelRX := TPanel.Create(Self); + PanelRX.Parent := PanelLeft; + PanelRX.SetBounds(0, Y, LEFT_W, 120); + PanelRX.BevelOuter := bvNone; + MakeLbl(PanelRX, 'RX', 4, 2); + + // AGC mode — 5 кнопок в ряд + MakeLbl(PanelRX, 'AGC', 4, 18); + W := (LEFT_W - 36) div 5; + BtnAGCMode[0] := MakeBtn(PanelRX,'FAST', 34+0*(W+1),14,W,BTN_SM,BtnAGCModeClick); BtnAGCMode[0].Tag:=0; + BtnAGCMode[1] := MakeBtn(PanelRX,'MED', 34+1*(W+1),14,W,BTN_SM,BtnAGCModeClick); BtnAGCMode[1].Tag:=1; + BtnAGCMode[2] := MakeBtn(PanelRX,'SLOW', 34+2*(W+1),14,W,BTN_SM,BtnAGCModeClick); BtnAGCMode[2].Tag:=2; + BtnAGCMode[3] := MakeBtn(PanelRX,'LONG', 34+3*(W+1),14,W,BTN_SM,BtnAGCModeClick); BtnAGCMode[3].Tag:=3; + BtnAGCMode[4] := MakeBtn(PanelRX,'OFF', 34+4*(W+1),14,W,BTN_SM,BtnAGCModeClick); BtnAGCMode[4].Tag:=4; + for i := 0 to 4 do StyleButton(BtnAGCMode[i], i = FAGCMode); + + // AGC level slider + MakeLbl(PanelRX, 'THRESH', 4, 41); + TrkAGC := TTrackBar.Create(Self); + TrkAGC.Parent := PanelRX; TrkAGC.Left := 56; TrkAGC.Top := 37; + TrkAGC.Width := LEFT_W - 96; TrkAGC.Height := 20; + TrkAGC.Min := 20; TrkAGC.Max := 120; // 20..120 → −20..-120 dBm + TrkAGC.Position := FAGCTop; + TrkAGC.TickStyle := tsNone; TrkAGC.Reversed := True; + TrkAGC.OnChange := TrkAGCChange; + + LblAGCTop := TLabel.Create(Self); + LblAGCTop.Parent := PanelRX; + LblAGCTop.Left := LEFT_W - 38; LblAGCTop.Top := 41; + LblAGCTop.Caption := Format('-%ddB', [FAGCTop]); + LblAGCTop.Font.Color := CLR_TEXT; LblAGCTop.Font.Name := 'Courier New'; + LblAGCTop.Font.Size := 7; + + // VOL + MakeLbl(PanelRX, 'VOL', 4, 65); + TrkVolume := TTrackBar.Create(Self); + TrkVolume.Parent := PanelRX; TrkVolume.Left := 34; TrkVolume.Top := 61; + TrkVolume.Width := LEFT_W - 38; TrkVolume.Height := 20; + TrkVolume.Min := 0; TrkVolume.Max := 100; + TrkVolume.Position := FVolume; TrkVolume.TickStyle := tsNone; + TrkVolume.OnChange := TrkVolumeChange; + + // NR NB ANF MUTE + W := (LEFT_W - 8) div 4; + BtnNR := MakeBtn(PanelRX, 'NR', 2, 88, W, BTN_SM, BtnNRClick); + BtnNB := MakeBtn(PanelRX, 'NB', W+4, 88, W, BTN_SM, BtnNBClick); + BtnANF := MakeBtn(PanelRX, 'ANF',2*W+6, 88, W, BTN_SM, BtnANFClick); + BtnMute:= MakeBtn(PanelRX, 'MUTE',3*W+8,88, W, BTN_SM, BtnMuteClick); + + Inc(Y, 124); + + // S-Meter + + Inc(Y, 52); + + // TX controls + PanelTX := TPanel.Create(Self); + PanelTX.Parent := PanelLeft; + PanelTX.SetBounds(0, Y, LEFT_W, 104); + PanelTX.BevelOuter := bvNone; + MakeLbl(PanelTX, 'TX', 4, 2); + + LblDrv := TLabel.Create(Self); + LblDrv.Parent := PanelTX; LblDrv.Left := 4; LblDrv.Top := 17; + LblDrv.Caption := 'DRV'; LblDrv.Font.Color := CLR_TEXTDIM; + LblDrv.Font.Name := 'Courier New'; LblDrv.Font.Size := 7; + + TrkDrive := TTrackBar.Create(Self); + TrkDrive.Parent := PanelTX; TrkDrive.Left := 34; TrkDrive.Top := 14; + TrkDrive.Width := 150; TrkDrive.Height := 22; + TrkDrive.Min := 0; TrkDrive.Max := 100; TrkDrive.Position := 50; + TrkDrive.TickStyle := tsNone; TrkDrive.OnChange := TrkDriveChange; + + BtnMOX := MakeBtn(PanelTX, 'MOX', 2, 38, 70, 32, BtnMOXClick); + BtnMOX.Font.Size := 12; BtnMOX.Font.Bold := True; + + LblFwdPwr := TLabel.Create(Self); + LblFwdPwr.Parent := PanelTX; LblFwdPwr.Left := 80; LblFwdPwr.Top := 42; + LblFwdPwr.Caption := '0W'; LblFwdPwr.Font.Color := CLR_METER_ON; + LblFwdPwr.Font.Name := 'Courier New'; LblFwdPwr.Font.Size := 8; + + LblSWRVal := TLabel.Create(Self); + LblSWRVal.Parent := PanelTX; LblSWRVal.Left := 140; LblSWRVal.Top := 42; + LblSWRVal.Caption := 'SWR:1.0'; LblSWRVal.Font.Color := CLR_TEXTDIM; + LblSWRVal.Font.Name := 'Courier New'; LblSWRVal.Font.Size := 8; + + MakeLbl(PanelTX, 'PWR', 4, 76); + PbFwdPower := TPaintBox.Create(Self); + PbFwdPower.Parent := PanelTX; + PbFwdPower.SetBounds(34, 74, LEFT_W - 38, 12); + PbFwdPower.OnPaint := PbFwdPowerPaint; + + MakeLbl(PanelTX, 'SWR', 4, 92); + PbSWR := TPaintBox.Create(Self); + PbSWR.Parent := PanelTX; + PbSWR.SetBounds(34, 90, LEFT_W - 38, 12); + PbSWR.OnPaint := PbSWRPaint; + + // ---- Right panel ---- + PanelRight := TPanel.Create(Self); + PanelRight.Parent := Self; + PanelRight.Align := alClient; + PanelRight.BevelOuter := bvNone; + PanelRight.OnResize := RightPanelResize; + + PanelSpanButtons := TPanel.Create(Self); + PanelSpanButtons.Parent := PanelRight; + PanelSpanButtons.Align := alTop; + PanelSpanButtons.Height := 30; + PanelSpanButtons.BevelOuter := bvNone; + + LblSpan := TLabel.Create(Self); + LblSpan.Parent := PanelSpanButtons; LblSpan.Left := 4; LblSpan.Top := 8; + LblSpan.Caption := 'SPAN:'; LblSpan.Font.Color := CLR_TEXTDIM; + LblSpan.Font.Name := 'Courier New'; LblSpan.Font.Size := 7; + + BtnSpan48k := MakeBtn(PanelSpanButtons, '48k', 50, 3, 46, BTN_SM, BtnSpanClick); + BtnSpan96k := MakeBtn(PanelSpanButtons, '96k', 99, 3, 46, BTN_SM, BtnSpanClick); + BtnSpan192k := MakeBtn(PanelSpanButtons, '192k', 148, 3, 52, BTN_SM, BtnSpanClick); + BtnSpan384k := MakeBtn(PanelSpanButtons, '384k', 203, 3, 52, BTN_SM, BtnSpanClick); + BtnSpan768k := MakeBtn(PanelSpanButtons, '768k', 258, 3, 52, BTN_SM, BtnSpanClick); + BtnSpan1536k := MakeBtn(PanelSpanButtons, '1536k', 313, 3, 58, BTN_SM, BtnSpanClick); + BtnSpan48k.Tag := 48000; + BtnSpan96k.Tag := 96000; + BtnSpan192k.Tag := 192000; + BtnSpan384k.Tag := 384000; + BtnSpan768k.Tag := 768000; + BtnSpan1536k.Tag := 1536000; + StyleButton(BtnSpan192k, True); + + // Waterfall AGC + Noise Floor кнопки справа в той же панели + BtnWfAGC := MakeBtn(PanelSpanButtons, 'WF AGC', 379, 3, 62, BTN_SM, BtnWfAGCClick); + BtnWfNF := MakeBtn(PanelSpanButtons, 'WF NF', 445, 3, 58, BTN_SM, BtnWfNFClick); + BtnHidePanel := MakeBtn(PanelSpanButtons, '◀ HIDE', 510, 3, 64, BTN_SM, BtnHidePanelClick); + + // Большой S-метр — на главной форме поверх двух панелей + // S-метр: Parent=Self, перекрывает Toolbar+SpanButtons вертикально + PanelSMeterRight := TPanel.Create(Self); + PanelSMeterRight.Parent := Self; + PanelSMeterRight.BevelOuter := bvNone; + PanelSMeterRight.Color := CLR_PANEL; + PbSMeterRight := TPaintBox.Create(Self); + PbSMeterRight.Parent := PanelSMeterRight; + PbSMeterRight.Align := alClient; + PbSMeterRight.OnPaint := PbSMeterRightPaint; + PbSMeterRight.Color := CLR_PANEL; + + PbSpectrum := TPaintBox.Create(Self); + PbSpectrum.Parent := PanelRight; + PbSpectrum.OnPaint := PbSpectrumPaint; + PbSpectrum.OnMouseDown := PbSpectrumMouseDown; + PbSpectrum.OnDblClick := PbSpectrumDblClick; + PbSpectrum.OnMouseMove := PbSpectrumMouseMove; + PbSpectrum.OnMouseUp := PbSpectrumMouseUp; + + PbRuler := TPaintBox.Create(Self); + PbRuler.Parent := PanelRight; + PbRuler.OnPaint := PbRulerPaint; + PbRuler.Cursor := crDefault; + + PbWaterfall := TPaintBox.Create(Self); + PbWaterfall.Parent := PanelRight; + PbWaterfall.OnPaint := PbWaterfallPaint; + PbWaterfall.OnMouseDown := PbWaterfallMouseDown; + PbWaterfall.OnMouseMove := PbWaterfallMouseMove; + PbWaterfall.OnMouseUp := PbWaterfallMouseUp; + + // Initial layout + ResizeSpectrumPanels; +end; + +// =========================================================================== +// Resize handler (normal method instead of anonymous procedure) +// =========================================================================== + +procedure TMainForm.RightPanelResize(Sender: TObject); +begin + ResizeSpectrumPanels; +end; + +procedure TMainForm.ResizeSMeter; +// PanelSMeterRight на главной форме (Parent=Self). +// По Y: от самого верха формы до низа PanelSpanButtons (Toolbar+Span = 66px). +// По X: 40% ширины PanelRight, прижат к правому краю. +const + LEFT_PANEL_W = 232; // ширина левой панели (LEFT_W) + MARGIN = 3; +var + FW, FH: Integer; + RightW: Integer; // ширина PanelRight + SMW: Integer; // ширина S-метра + SMLeft: Integer; + SMTop: Integer; + SMBot: Integer; +begin + if (PanelSMeterRight = nil) or (PanelToolbar = nil) or + (PanelSpanButtons = nil) then Exit; + + FW := ClientWidth; + // Ширина зоны спектра (PanelRight) + RightW := FW - LEFT_PANEL_W; + if RightW < 200 then Exit; + + // Ширина S-метра = 40% от PanelRight + SMW := Round(RightW * 0.40); + + // X: прижат к правому краю формы + SMLeft := FW - SMW - MARGIN; + + // Y: от верха формы+margin до низа PanelSpanButtons-margin + SMTop := MARGIN; + SMBot := PanelToolbar.Height + PanelSpanButtons.Height - MARGIN; + + PanelSMeterRight.SetBounds(SMLeft, SMTop, SMW, SMBot - SMTop); + PanelSMeterRight.BringToFront; +end; + +procedure TMainForm.ResizeSpectrumPanels; +var + RW, RH, SH, WH, TopOff: Integer; +begin + if PanelRight = nil then Exit; + RW := PanelRight.ClientWidth; + RH := PanelRight.ClientHeight; + TopOff := PanelSpanButtons.Height; + // S-метр позиционируется отдельно в ResizeSMeter + ResizeSMeter; + RH := RH - TopOff; + if RH < 10 then Exit; + + SH := RH * 4 div 10; + WH := RH - SH - 18; + if WH < 10 then WH := 10; + + PbSpectrum.SetBounds(0, TopOff, RW, SH); + PbRuler.SetBounds (0, TopOff + SH, RW, 18); + PbWaterfall.SetBounds(0, TopOff + SH + 18, RW, WH); + + // Обновляем переменные размеров + FSpectrumWidth := RW; + FSpectrumHeight := SH; + FWaterfallHeight := WH; + + // Пересоздаём bitmap точно под новый размер + if (FSpectrumBitmap <> nil) and (RW > 0) and (SH > 0) then + begin + FSpectrumBitmap.SetSize(RW, SH); + // Заливаем фоном чтобы не было артефактов от старого содержимого + FSpectrumBitmap.Canvas.Brush.Color := CLR_BG; + FSpectrumBitmap.Canvas.FillRect(Rect(0, 0, RW, SH)); + end; + if (FWaterfallBitmap <> nil) and (RW > 0) and (WH > 0) then + begin + FWaterfallBitmap.SetSize(RW, WH); + FWaterfallBitmap.Canvas.Brush.Color := clBlack; + FWaterfallBitmap.Canvas.FillRect(Rect(0, 0, RW, WH)); + FWaterfallTemp.SetSize(RW, WH); + FWaterfallTemp.Canvas.Brush.Color := clBlack; + FWaterfallTemp.Canvas.FillRect(Rect(0, 0, RW, WH)); + end; + + // Немедленно перерисовываем с новыми размерами + if RW > 0 then + begin + DrawSpectrum; + PbSpectrum.Invalidate; + if PbRuler <> nil then PbRuler.Invalidate; + PbWaterfall.Invalidate; + end; +end; + +// =========================================================================== +// Dark Theme +// =========================================================================== + +procedure TMainForm.ApplyDarkTheme; + procedure DP(P: TPanel); + begin + P.Color := CLR_PANEL; P.Font.Color := CLR_TEXT; + end; +begin + Color := CLR_BG; Font.Color := CLR_TEXT; + DP(PanelToolbar); DP(PanelLeft); + DP(PanelVfoA); DP(PanelVfoB); DP(PanelVfoButtons); + DP(PanelBands); DP(PanelMode); DP(PanelFilter); + DP(PanelRX); DP(PanelTX); + DP(PanelRight); DP(PanelSpanButtons); + + + PbSpectrum.Color := CLR_BG; + PbWaterfall.Color := CLR_BG; + if PanelSMeterRight <> nil then PanelSMeterRight.Color := CLR_PANEL; + if PbSMeterRight <> nil then PbSMeterRight.Color := CLR_PANEL; + PbFwdPower.Color := CLR_BG; + PbSWR.Color := CLR_BG; +end; + +procedure TMainForm.StyleButton(B: TFlatButton; Active: Boolean); +begin + B.Active := Active; + B.ClrNorm := CLR_INACTIVE; + B.ClrActive := CLR_ACTIVE; + B.ClrHot := TColor($00323232); + B.ClrBorder := TColor($00505050); + B.ClrText := CLR_TEXT; + B.ClrTextAct := TColor($0000FF88); + B.Font.Name := 'Courier New'; + B.Font.Size := 8; +end; + +// =========================================================================== +// VFO +// =========================================================================== + +function TMainForm.FormatFreq(Hz: Double): string; +var + Mhz, KHz, Rest: Integer; +begin + Mhz := Trunc(Hz / 1000000); + KHz := Trunc((Hz - Mhz * 1000000) / 1000); + Rest := Trunc(Hz) mod 1000; + Result := Format('%3d.%3.3d.%3.3d', [Mhz, KHz, Rest]); +end; + +procedure TMainForm.UpdateVfoDisplay; +begin + FreqDispA.Frequency := Round(FVfoA); + FreqDispB.Frequency := Round(FVfoB); + if FActiveVfo = 0 then + begin + FreqDispA.ColorNormal := CLR_FREQ; FreqDispA.FontSize := 20; + FreqDispB.ColorNormal := CLR_FREQ_DIM; FreqDispB.FontSize := 14; + FreqDispA.Height := 36; + FreqDispB.Height := 28; + end else begin + FreqDispA.ColorNormal := CLR_FREQ_DIM; FreqDispA.FontSize := 14; + FreqDispB.ColorNormal := CLR_FREQ; FreqDispB.FontSize := 20; + FreqDispA.Height := 28; + FreqDispB.Height := 36; + end; + // FCenterFreq обновляется через ApplyVfoA, здесь не трогаем + + // При изменении частоты — обновляем HP пакет с новыми частотами и ALEX + if FNetwork.Connected and FNetwork.Running then + begin + FNetwork.UpdateState(FCenterFreq, FCenterFreq, FDriveLevel, + FTransmitting, True, True); + FNetwork.SendFullHP; + end; + + // WDSP: частота NCO задаётся через HPSDR железо (DDC), не через WDSP напрямую +end; + +// =========================================================================== +// Helpers +// =========================================================================== + +// Замена MulDiv (Windows API) — простая целочисленная пропорция +function TMainForm.ScaleX(X, Total, Width: Integer): Integer; +begin + if Total = 0 then Result := 0 + else Result := Round(X / Total * Width); +end; + +// =========================================================================== +// Drawing +// =========================================================================== + + +procedure TMainForm.DrawBarMeter(ACanvas: TCanvas; R: TRect; + Value, MaxVal: Double; BarColor: TColor); +var + Pct, BarW: Integer; +begin + ACanvas.Brush.Color := TColor($00080808); + ACanvas.FillRect(R); + + if MaxVal > 0 then + Pct := Round(Max(0.0, Min(1.0, Value / MaxVal)) * (R.Right - R.Left - 2)) + else + Pct := 0; + + BarW := Pct; + ACanvas.Brush.Color := BarColor; + ACanvas.Pen.Color := BarColor; + ACanvas.FillRect(Rect(R.Left+1, R.Top+1, R.Left+1+BarW, R.Bottom-1)); + + ACanvas.Brush.Style := bsClear; + ACanvas.Pen.Color := CLR_BORDER; + ACanvas.Rectangle(R); +end; + +procedure TMainForm.ResetWfAvgBuf; +var i: Integer; +begin + for i := 0 to 1023 do FWfAvgBuf[i] := -120.0; + FWfHigh := -50.0; + FWfLow := -120.0; +end; + +procedure TMainForm.ResetSpectrumBuf; +var i: Integer; +begin + for i := 0 to 1023 do FSpectrumBuf[i] := -130.0; + for i := 0 to 1023 do FWfAvgBuf[i] := -120.0; + FWfHigh := -50.0; + FWfLow := -120.0; +end; + +procedure TMainForm.FillDemoSpectrum; +var + i: Integer; + FreqOff, Noise, Sig: Double; +begin + for i := 0 to FSpectrumWidth - 1 do + begin + if FSpectrumWidth > 1 then + FreqOff := (i / (FSpectrumWidth - 1) - 0.5) * FSpanHz + else + FreqOff := 0; + Noise := -110 + (Random - 0.5) * 6; + if Abs(FreqOff) < 2000 then + Sig := -50 - Abs(FreqOff) / 200 + else + Sig := -999; + FSpectrumBuf[i mod 1024] := Max(Noise, Sig); + end; +end; + +procedure TMainForm.DrawMarkerLine(C: TCanvas; W, H: Integer); +var + MX: Integer; + MarkerFreq: Double; + MarkerLbl: string; +begin + MX := Round(FMarkerX / 1000.0 * W); + if (MX < 0) or (MX >= W) then Exit; + + MarkerFreq := (FCenterFreq - FSpanHz / 2) + FMarkerX / 1000.0 * FSpanHz; + MarkerLbl := FormatFreq(Round(MarkerFreq)); + + C.Pen.Color := TColor($004444FF); // красный (BGR формат) + C.Pen.Width := 1; + C.Pen.Style := psSolid; + C.MoveTo(MX, 0); + C.LineTo(MX, H); + + C.Font.Color := TColor($004444FF); + C.Font.Size := 7; + C.Font.Name := 'Courier New'; + if MX + 4 + C.TextWidth(MarkerLbl) < W then + C.TextOut(MX + 4, 4, MarkerLbl) + else + C.TextOut(MX - 4 - C.TextWidth(MarkerLbl), 4, MarkerLbl); +end; + +procedure TMainForm.DrawSpectrumGradient(const SpPts: array of TPoint; W, H: Integer); +// Полупрозрачный градиент под кривой спектра через TLazIntfImage. +// Каждый пиксель ниже кривой: Alpha = (1 - T²) × 18000, T = глубина [0..1]. +// Цвет: зелёно-бирюзовый (Thetis-стиль). Смешивается с существующим фоном. +var + Img: TLazIntfImage; + FC: TFPColor; + Row, Col: Integer; + YcurveAt: Integer; + GradH: Integer; + T: Double; + Alpha16: Integer; + YCurve: array of Integer; +begin + if FSpectrumBitmap = nil then Exit; + + SetLength(YCurve, W); + for Col := 0 to W - 1 do + YCurve[Col] := SpPts[Col].Y; + + Img := FSpectrumBitmap.CreateIntfImage; + try + for Row := 0 to H - 1 do + for Col := 0 to W - 1 do + begin + YcurveAt := YCurve[Col]; + if Row < YcurveAt then Continue; + + GradH := H - YcurveAt; + if GradH < 1 then GradH := 1; + + T := (Row - YcurveAt) / GradH; + Alpha16 := Round((1.0 - T * T) * 18000); + if Alpha16 <= 0 then Continue; + + FC := Img.Colors[Col, Row]; + FC.Green := Min(65535, FC.Green + Alpha16 * 2); + FC.Blue := Min(65535, FC.Blue + Alpha16); + Img.Colors[Col, Row] := FC; + end; + + FSpectrumBitmap.LoadFromIntfImage(Img); + finally + Img.Free; + end; +end; + +procedure TMainForm.DrawSpectrum; +var + C: TCanvas; + i, X, Yp, W, H: Integer; + DBmin, DBmax, FreqStart, FreqHz: Double; + dB: Double; + // filter band + VfoX: Integer; + Lo_Hz: Double; + Hi_Hz: Double; + Half: Double; + X1, X2: Integer; + // AGC lines + AGCy: Integer; // порог AGC Threshold + AGCHangY: Integer; // уровень AGC Hang + // spectrum trace + SrcF: Double; + S0, S1: Integer; + Frac: Double; + dBv: Double; + SpPts: array of TPoint; +begin + // Используем актуальные размеры bitmap (обновлены в ResizeSpectrumPanels) + if (FSpectrumBitmap = nil) then Exit; + W := FSpectrumBitmap.Width; + H := FSpectrumBitmap.Height; + if (W <= 0) or (H <= 0) then Exit; + + C := FSpectrumBitmap.Canvas; + DBmin := -130.0; DBmax := -20.0; + + C.Brush.Color := TColor($00050505); + C.FillRect(Rect(0, 0, W, H)); + + // dB grid + C.Font.Size := 7; C.Font.Name := 'Courier New'; C.Font.Color := CLR_TEXTDIM; + dB := -30.0; + while dB >= DBmin do + begin + Yp := Round((DBmax - dB) / (DBmax - DBmin) * H); + C.Pen.Color := CLR_BORDER; + C.MoveTo(0, Yp); C.LineTo(W-1, Yp); + C.TextOut(1, Yp - 9, Format('%4.0f', [dB])); + dB := dB - 10; + end; + + // Frequency grid — только вертикальные линии (метки в PbRuler) + FreqStart := FCenterFreq - FSpanHz / 2; + for i := 0 to 8 do + begin + X := ScaleX(i, 8, W); + C.Pen.Color := CLR_BORDER; + C.MoveTo(X, 0); C.LineTo(X, H); + end; + + // Полоса фильтра и VFO маркер + begin + Half := FFilterBW / 2; + // При CTUN OFF FCenterFreq=FVfoA → VfoX автоматически = W/2 + VfoX := Round((FVfoA - FCenterFreq + FSpanHz / 2) / FSpanHz * W); + case FMode of + 0: begin Lo_Hz := -FFilterBW; Hi_Hz := -100; end; + 1: begin Lo_Hz := 100; Hi_Hz := FFilterBW; end; + else begin Lo_Hz := -Half; Hi_Hz := Half; end; + end; + X1 := Max(0, Min(W-1, VfoX + Round(Lo_Hz / FSpanHz * W))); + X2 := Max(0, Min(W-1, VfoX + Round(Hi_Hz / FSpanHz * W))); + // Закрашенная полоса + C.Brush.Color := TColor($00102020); + C.Brush.Style := bsSolid; + C.Pen.Style := psClear; + if X2 > X1 then C.FillRect(Rect(X1, 0, X2, H)); + C.Pen.Style := psSolid; + // Края полосы + C.Pen.Color := TColor($0040FFCC); + C.Pen.Width := 1; + C.MoveTo(X1, 0); C.LineTo(X1, H); + C.MoveTo(X2, 0); C.LineTo(X2, H); + // Маркер VFO + C.Pen.Color := TColor($0000AAFF); + C.Pen.Width := 2; + C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - 12); + C.Brush.Color := TColor($0000AAFF); + C.Brush.Style := bsSolid; + C.Pen.Width := 1; + C.Polygon([Point(VfoX-5,0), Point(VfoX+5,0), Point(VfoX,8)]); + end; + + // AGC lines — Thresh (amber) + HangLevel (cyan dashed), как в piHPSDR + if FWDSPReady then + begin + // --- Thresh: GetRXAAGCThresh → dBm позиция на дисплее --- + AGCy := Round((DBmax - FDSPEngine.AGCThresh) / (DBmax - DBmin) * H); + if (AGCy >= 0) and (AGCy < H) then + begin + C.Pen.Color := TColor($0000AAFF); // янтарный + C.Pen.Width := 1; + C.Pen.Style := psDash; + C.MoveTo(0, AGCy); C.LineTo(W, AGCy); + C.Pen.Style := psSolid; + C.Font.Color := TColor($0000AAFF); + C.Font.Size := 6; + C.TextOut(4, AGCy - 9, 'AGC T'); + end; + // --- HangLevel: GetRXAAGCHangLevel → dBm позиция --- + AGCHangY := Round((DBmax - FDSPEngine.AGCHangLevel) / (DBmax - DBmin) * H); + if (AGCHangY >= 0) and (AGCHangY < H) and + (Abs(AGCHangY - AGCy) > 4) then // не рисуем если совпадают + begin + C.Pen.Color := TColor($00FFCC00); // голубой cyan + C.Pen.Width := 1; + C.Pen.Style := psDot; + C.MoveTo(0, AGCHangY); C.LineTo(W, AGCHangY); + C.Pen.Style := psSolid; + C.Font.Color := TColor($00FFCC00); + C.Font.Size := 6; + C.TextOut(4, AGCHangY + 2, 'AGC H'); + end; + end + else + begin + // WDSP не готов — рисуем по FAGCTop как раньше + AGCy := Round((DBmax - (-FAGCTop)) / (DBmax - DBmin) * H); + if (AGCy >= 0) and (AGCy < H) then + begin + C.Pen.Color := TColor($0000AAFF); + C.Pen.Width := 1; + C.Pen.Style := psDash; + C.MoveTo(0, AGCy); C.LineTo(W, AGCy); + C.Pen.Style := psSolid; + C.Font.Color := TColor($0000AAFF); + C.Font.Size := 6; + C.TextOut(4, AGCy - 9, Format('AGC -%ddB', [FAGCTop])); + end; + end; + + // Spectrum trace — Thetis стиль: полигон-заливка + яркая линия поверх + begin + SetLength(SpPts, W + 2); + for i := 0 to W - 1 do + begin + SrcF := i * 1023.0 / Max(1, W - 1); + S0 := Min(Trunc(SrcF), 1023); + S1 := Min(S0 + 1, 1023); + Frac := SrcF - S0; + dBv := FSpectrumBuf[S0] * (1.0 - Frac) + FSpectrumBuf[S1] * Frac; + SpPts[i] := Point(i, Max(0, Min(H-1, + Round((DBmax - dBv) / (DBmax - DBmin) * H)))); + end; + SpPts[W] := Point(W-1, H); + SpPts[W+1] := Point(0, H); + + // Заливка — полупрозрачный градиент под кривой + C.Brush.Style := bsSolid; + C.Pen.Style := psClear; + DrawSpectrumGradient(SpPts, W, H); + + // Линия спектра — яркий Thetis-зелёный + C.Pen.Style := psSolid; + C.Pen.Color := TColor($0040FF80); + C.Pen.Width := 1; + C.MoveTo(SpPts[0].X, SpPts[0].Y); + for i := 1 to W - 1 do + C.LineTo(SpPts[i].X, SpPts[i].Y); + end; + + // Маркер правой кнопки — красная вертикальная линия + частота + if FMarkerActive then + DrawMarkerLine(C, W, H); +end; + +procedure TMainForm.DrawWaterfall; +// Алгоритм как в Thetis/PowerSDR: +// +// 1. EMA (Exponential Moving Average) спектра → FWfAvgBuf +// Сглаживает шум: каждый пиксель усредняется по времени с α=0.25 +// Это ключ к "чистому" водопаду — рисуем усреднённое, а не сырой FFT +// +// 2. WF AGC (FWfHigh): верхняя граница — "белое" +// Цель: чуть выше пика усреднённого спектра +// Медленный LP-фильтр α=0.02 (реагирует за ~50 кадров) +// +// 3. NF Track (FWfLow): нижняя граница — "чёрное" +// Цель: шумовой пол = медиана нижних 30% усреднённого спектра +// Очень медленный LP-фильтр α=0.005 (~200 кадров) +// +// Нормировка: V = (avg_dB - WfLow) / (WfHigh - WfLow) → 0..255 → палитра +var + W, H, X: Integer; + dB, frac, WatSrcF: Double; + WatS0, WatS1, V: Integer; + Col: LongWord; + Tmp: TBitmap; + Img: TLazIntfImage; + FC: TFPColor; + // AGC/NF + AvgDB: Double; + PeakDB: Double; + SortedSum: Double; + NF30Count: Integer; + // Sorted sample для медианы NF + NFSum: Double; + NFCount: Integer; + + WfHigh: Double; + WfLow: Double; +const + // EMA для сглаживания спектра (чем меньше — тем медленнее/чище) + ALPHA_SPEC = 0.25; // сглаживание спектра по времени + // Скорость слежения High/Low + ALPHA_HIGH = 0.02; // AGC верхней границы + ALPHA_LOW = 0.005; // NF нижней границы (очень медленно) +begin + if (FWaterfallBitmap = nil) or (FWaterfallTemp = nil) then Exit; + W := FWaterfallBitmap.Width; + H := FWaterfallBitmap.Height; + if (W <= 0) or (H <= 0) then Exit; + if (FWaterfallTemp.Width <> W) or (FWaterfallTemp.Height <> H) then + begin + FWaterfallTemp.SetSize(W, H); + FWaterfallTemp.Canvas.Brush.Color := clBlack; + FWaterfallTemp.Canvas.FillRect(0, 0, W, H); + end; + + // ================================================================ + // Шаг 1: EMA — обновляем FWfAvgBuf из FSpectrumBuf + // avg[i] = avg[i] * (1-α) + spec[i] * α + // ================================================================ + PeakDB := -200.0; + NFSum := 0.0; + NFCount := 0; + for X := 0 to 1023 do + begin + AvgDB := FWfAvgBuf[X] * (1.0 - ALPHA_SPEC) + FSpectrumBuf[X] * ALPHA_SPEC; + FWfAvgBuf[X] := AvgDB; + if AvgDB > PeakDB then PeakDB := AvgDB; + end; + + // ================================================================ + // Шаг 2: Оценка NF — берём нижние 30% бинов (самые тихие) + // Сортировка дорого — используем threshold подход: + // суммируем всё что ниже текущего FWfLow + 15dB margin + // ================================================================ + for X := 0 to 1023 do + begin + AvgDB := FWfAvgBuf[X]; + if AvgDB < FWfLow + 15.0 then // бины близко к шуму + begin + NFSum := NFSum + AvgDB; + Inc(NFCount); + end; + end; + + // ================================================================ + // Шаг 3: Обновляем High/Low (только если включены) + // ================================================================ + if FWfAGCEnabled then + begin + // Target high = пик + 5dB (небольшой запас чтобы пик не "белел") + if PeakDB > FWfHigh then + // Быстрый attack: сигнал вырос — моментально поднимаем потолок + FWfHigh := PeakDB + 5.0 + else + // Медленный decay: сигнал ушёл — медленно опускаем + FWfHigh := FWfHigh + ALPHA_HIGH * ((PeakDB + 5.0) - FWfHigh); + end; + + if FWfNFEnabled then + begin + if NFCount > 10 then + begin + // Target low = средний NF бин - 5dB (чуть ниже пола = "чёрное") + FWfLow := FWfLow + ALPHA_LOW * ((NFSum / NFCount - 5.0) - FWfLow); + end; + end; + + // Защита от схлопывания + WfHigh := FWfHigh; + WfLow := FWfLow; + if WfHigh < WfLow + 15.0 then WfHigh := WfLow + 15.0; + if WfHigh > 0.0 then WfHigh := 0.0; // разумный предел + if WfLow < -160 then WfLow := -160; + + // ================================================================ + // Шаг 4: Скролл — двойной буфер + // ================================================================ + FWaterfallTemp.Canvas.Draw(0, 1, FWaterfallBitmap); + + // ================================================================ + // ================================================================ + // Шаг 5: Новая строка через TLazIntfImage из FWfAvgBuf + // Рисуем УСРЕДНЁННЫЙ спектр — не сырой! + // ================================================================ + Img := FWaterfallTemp.CreateIntfImage; + try + for X := 0 to W - 1 do + begin + WatSrcF := X * 1023.0 / Max(1, W - 1); + WatS0 := Min(Trunc(WatSrcF), 1023); + WatS1 := Min(WatS0 + 1, 1023); + frac := WatSrcF - WatS0; + // Берём из усреднённого буфера, не из сырого FSpectrumBuf + dB := FWfAvgBuf[WatS0] * (1.0 - frac) + FWfAvgBuf[WatS1] * frac; + + V := Round(Max(0.0, Min(1.0, (dB - WfLow) / (WfHigh - WfLow))) * 255); + Col := WFALL_PALETTE[V]; + FC.Red := Byte(Col) shl 8; + FC.Green := Byte(Col shr 8) shl 8; + FC.Blue := Byte(Col shr 16) shl 8; + FC.Alpha := $FFFF; + Img.Colors[X, 0] := FC; + end; + FWaterfallTemp.LoadFromIntfImage(Img); + finally + Img.Free; + end; + + // ================================================================ + // Шаг 6: Swap буферов + // ================================================================ + Tmp := FWaterfallBitmap; + FWaterfallBitmap := FWaterfallTemp; + FWaterfallTemp := Tmp; +end; + +// =========================================================================== +// Широкий S-метр — точная копия Thetis/PowerSDR стиля +// Структура (высота H): +// верх (H*35%): dBm шкала (-120..-20..0), тики, цифровое значение слева +// середина (H*35%): полоса сигнала (зелёный бар + широкий пик + белый маркер) +// низ (H*30%): S-шкала (S1..S9..+60), S-значение слева +// =========================================================================== +procedure TMainForm.DrawSMeterWide(ACanvas: TCanvas; R: TRect; + Value, Peak, MinVal: Double; + out ZX1, ZX2, ZY1, ZY2: Integer); +const + DB_MIN = -127.0; // левый край шкалы + DB_MAX = -0.0; // правый край + DB_S9 = -73.0; // граница S9 (зелёная/оранжевая) + DB_OVR = -43.0; // граница "красной" зоны (+30 over S9) + + // dBm верхняя шкала: 7 меток + DBM_MARKS: array[0..6] of Double = (-120,-100,-80,-60,-40,-20,0); + DBM_LABELS: array[0..6] of string = ('-120','-100','-80','-60','-40','-20','0'); + + // S-шкала нижняя: 9 меток + S_MARKS_DBM: array[0..8] of Double = (-121,-115,-109,-103,-93,-83,-73,-53,-33); + S_MARKS_LBL: array[0..8] of string = ('S1','S3','S5','S7','S9','+10','+20','+40','+60'); + + // Цвета (BGR в TColor) + CLR_SMETER_BG = TColor($00181818); // фон = CLR_PANEL + CLR_BAR_GREEN = TColor($00091F00); // тёмно-зелёный бар до S9 (RGB 0,31,9) + CLR_BAR_OVER = TColor($00091528); // тёмно-красный бар после S9 (RGB 40,21,9) — тот же тон что зелёный но красн. + CLR_PEAK_FILL = TColor($00796F75); // светло-серый заполнитель пика (RGB 117,111,121) + CLR_PEAK_MARKER = TColor($00F8F8FF); // белый пик-маркер (RGB 255,248,248) + CLR_BAR_ORANGE = TColor($000A1A28); // оранжевая зона (>S9) + CLR_BAR_RED = TColor($00000832); // красная зона (>+30) + CLR_TICK_GREEN = TColor($00708070); // тики зелёной зоны + CLR_TICK_WHITE = TColor($00E0E0DC); // тики белые (dBm шкала) + CLR_TICK_BLUE = TColor($0070A090); // тики S9+ зоны + CLR_LABEL_DBM = TColor($0096D8DC); // цифровое значение dBm (желтоватый) + CLR_LABEL_S = TColor($00F0F0F0); // S-значение — белый + CLR_SCALE_DBM = TColor($00D0DCDC); // метки dBm шкалы (бело-серые) + CLR_SCALE_S_GREEN = TColor($00E0E0E0); // метки S1..S9 — белые + CLR_SCALE_S_BLUE = TColor($0090D090); // метки +10..+60 — как S1..S9 оригинал (желт-зелён) + CLR_BORDER = TColor($00303028); // рамки + + LEFT_INFO = 62; // ширина левой информационной колонки (dBm + S-value) + TICK_LONG = 5; // длина длинного тика + TICK_MED = 3; // длина среднего тика + +var + W, H: Integer; + BX, BW: Integer; // начало и ширина зоны шкалы + Y_UPPER_MID: Integer; // середина верхней зоны (метки dBm) + Y_BAR_TOP: Integer; // верх полосы сигнала + Y_BAR_BOT: Integer; // низ полосы сигнала + Y_LOWER_MID: Integer; // середина нижней зоны (метки S) + BarEnd: Integer; // правый край текущего сигнала + PeakLeft: Integer; // левый край peak fill + PeakRight: Integer; // правый край peak fill (= белый маркер) + MinX: Integer; // позиция минимума + S9X, OvrX: Integer; // позиции границ зон + i, X, TW: Integer; + Lbl: string; + SNum: Integer; + + function DBtoX(dB: Double): Integer; inline; + begin + Result := BX + Round((dB - DB_MIN) / (DB_MAX - DB_MIN) * BW); + if Result < BX then Result := BX; + if Result > BX + BW then Result := BX + BW; + end; + + procedure HLine(Y, X1, X2: Integer; C: TColor); + begin + ACanvas.Pen.Color := C; + ACanvas.MoveTo(X1, Y); ACanvas.LineTo(X2, Y); + end; + + procedure VLine(X, Y1, Y2: Integer; C: TColor); + begin + ACanvas.Pen.Color := C; + ACanvas.MoveTo(X, Y1); ACanvas.LineTo(X, Y2); + end; + + procedure FillBar(X1, Y1, X2, Y2: Integer; C: TColor); + begin + ACanvas.Brush.Color := C; + ACanvas.Brush.Style := bsSolid; + ACanvas.Pen.Style := psClear; + if X2 > X1 then ACanvas.FillRect(Rect(X1, Y1, X2, Y2)); + ACanvas.Pen.Style := psSolid; + end; + +begin + W := R.Right - R.Left; + H := R.Bottom - R.Top; + // Инициализируем out-параметры + ZX1 := 0; ZX2 := 0; ZY1 := 0; ZY2 := 0; + if (W < 80) or (H < 16) then Exit; + + // --- Геометрия --- + BX := R.Left + LEFT_INFO; + BW := W - LEFT_INFO - 4; + + Y_UPPER_MID := R.Top + H * 3 div 10; // центр верхней зоны меток + Y_BAR_TOP := R.Top + H * 36 div 100; // верх бара + Y_BAR_BOT := R.Top + H * 66 div 100; // низ бара + Y_LOWER_MID := R.Top + H * 80 div 100; // центр нижней зоны меток + + S9X := DBtoX(DB_S9); + OvrX := DBtoX(DB_OVR); + + // ================================================================ + // ФОН + // ================================================================ + ACanvas.Brush.Color := CLR_SMETER_BG; + ACanvas.Brush.Style := bsSolid; + ACanvas.Pen.Style := psClear; + ACanvas.FillRect(R); + ACanvas.Pen.Style := psSolid; + + // Лёгкий цветной фон зон шкалы в полосе бара + FillBar(BX, Y_BAR_TOP, S9X, Y_BAR_BOT, TColor($00061006)); // тёмно-зелёный + FillBar(S9X, Y_BAR_TOP, OvrX, Y_BAR_BOT, TColor($000A1006)); // тёмно-жёлтый + FillBar(OvrX, Y_BAR_TOP, BX + BW, Y_BAR_BOT, TColor($00060A10)); // тёмно-красный + + // ================================================================ + // ПОЛОСА СИГНАЛА + // ================================================================ + BarEnd := DBtoX(Value); // текущий уровень + PeakLeft := DBtoX(MinVal); // левый край зоны = отслеживаемый минимум + PeakRight:= DBtoX(Peak); // правый край зоны = отслеживаемый пик + + // Заполняем out-параметры зоны для alpha-blend (после возврата) + ZX1 := Max(BX + 1, Min(PeakLeft, PeakRight)); + ZX2 := Min(BX + BW - 1, Max(PeakLeft, PeakRight)); + ZY1 := Y_BAR_TOP + 1; + ZY2 := Y_BAR_BOT - 1; + + // Бар: зелёный до S9, красноватый после S9 — в том же тёмном стиле + if BarEnd > BX then + begin + if BarEnd <= S9X then + // Весь бар в зелёной зоне + FillBar(BX, Y_BAR_TOP + 1, BarEnd, Y_BAR_BOT - 1, CLR_BAR_GREEN) + else + begin + // Зелёная часть до S9 + FillBar(BX, Y_BAR_TOP + 1, S9X, Y_BAR_BOT - 1, CLR_BAR_GREEN); + // Красноватая часть после S9 + FillBar(S9X, Y_BAR_TOP + 1, BarEnd, Y_BAR_BOT - 1, CLR_BAR_OVER); + end; + end; + + // Белый маркер пика (2px) — правый край зоны + if (PeakRight > BX) and (PeakRight <= BX + BW) then + begin + ACanvas.Pen.Color := CLR_PEAK_MARKER; + ACanvas.Pen.Width := 2; + ACanvas.MoveTo(PeakRight, Y_BAR_TOP); + ACanvas.LineTo(PeakRight, Y_BAR_BOT); + ACanvas.Pen.Width := 1; + end; + + // Рамка полосы + ACanvas.Brush.Style := bsClear; + ACanvas.Pen.Color := CLR_BORDER; + ACanvas.Rectangle(BX, Y_BAR_TOP, BX + BW, Y_BAR_BOT); + + // ================================================================ + // ВЕРХНЯЯ ШКАЛА — dBm метки (-120..-100..-20..0) + // ================================================================ + ACanvas.Font.Name := 'Courier New'; + ACanvas.Font.Size := 6; + ACanvas.Font.Style := []; + ACanvas.Brush.Style:= bsClear; + + for i := 0 to 6 do + begin + X := DBtoX(DBM_MARKS[i]); + // Длинный тик вверх от полосы + VLine(X, Y_BAR_TOP - TICK_LONG, Y_BAR_TOP - 1, CLR_TICK_WHITE); + // Метка + Lbl := DBM_LABELS[i]; + TW := ACanvas.TextWidth(Lbl); + ACanvas.Font.Color := CLR_SCALE_DBM; + ACanvas.TextOut(X - TW div 2, Y_BAR_TOP - TICK_LONG - ACanvas.TextHeight(Lbl) - 1, Lbl); + end; + + // Мелкие тики каждые 10 dB между основными (каждые 5) + i := -125; + while i < 0 do + begin + X := DBtoX(i); + VLine(X, Y_BAR_TOP - TICK_MED, Y_BAR_TOP - 1, CLR_TICK_GREEN); + Inc(i, 5); + end; + + // ================================================================ + // НИЖНЯЯ ШКАЛА — S1..S9..+60 + // ================================================================ + for i := 0 to 8 do + begin + X := DBtoX(S_MARKS_DBM[i]); + // Тик вниз от полосы + if S_MARKS_DBM[i] >= DB_S9 then + VLine(X, Y_BAR_BOT + 1, Y_BAR_BOT + TICK_LONG, CLR_TICK_BLUE) + else + VLine(X, Y_BAR_BOT + 1, Y_BAR_BOT + TICK_LONG, CLR_TICK_GREEN); + // Метка + Lbl := S_MARKS_LBL[i]; + TW := ACanvas.TextWidth(Lbl); + if S_MARKS_DBM[i] >= DB_S9 then + ACanvas.Font.Color := CLR_SCALE_S_BLUE + else + ACanvas.Font.Color := CLR_SCALE_S_GREEN; + ACanvas.TextOut(X - TW div 2, Y_BAR_BOT + TICK_LONG + 1, Lbl); + end; + + // ================================================================ + // ЛЕВАЯ КОЛОНКА — цифровое значение + // ================================================================ + // dBm значение (крупно, вверху) + ACanvas.Font.Size := 8; + ACanvas.Font.Style := [fsBold]; + ACanvas.Font.Color := CLR_LABEL_DBM; + Lbl := Format('%6.1f', [Value]); + ACanvas.TextOut(R.Left + 1, R.Top + 1, Lbl); + + // 'dBm' мелко под значением + ACanvas.Font.Size := 6; + ACanvas.Font.Style := []; + ACanvas.Font.Color := TColor($00507070); + ACanvas.TextOut(R.Left + 1, Y_BAR_TOP - ACanvas.TextHeight('dBm') - 1, 'dBm'); + + // S-значение (внизу) + ACanvas.Font.Size := 8; + ACanvas.Font.Style := [fsBold]; + ACanvas.Font.Color := CLR_LABEL_S; + if Value < -93.0 then + begin + SNum := Round((Value - (-127.0)) / 6.0); + if SNum < 1 then SNum := 1; + if SNum > 9 then SNum := 9; + Lbl := Format('S%d', [SNum]); + end + else + begin + SNum := Round(Value - (-93.0)); + Lbl := Format('S9+%d', [SNum]); + end; + ACanvas.TextOut(R.Left + 1, Y_BAR_BOT + TICK_LONG + 1, Lbl); +end; + +// Полупрозрачная белая заливка зоны X1..X2, Y1..Y2. +// Вызывается ПОСЛЕ DrawSMeterWide — FSmBitmap уже содержит нарисованный фон. +// Используем TLazIntfImage для попиксельного alpha-blend. +procedure TMainForm.DrawSMeterZone(ACanvas: TCanvas; R: TRect; + X1, X2, Y1, Y2: Integer); +const + ALPHA = 16384; // ~25% осветления (от 0..65535) +var + Img: TLazIntfImage; + FC: TFPColor; + IX, IY: Integer; +begin + if (X2 <= X1) or (FSmBitmap = nil) then Exit; + // Получаем IntfImage из off-screen bitmap + Img := FSmBitmap.CreateIntfImage; + try + for IY := Y1 to Y2 - 1 do + for IX := X1 to X2 - 1 do + begin + FC := Img.Colors[IX, IY]; + FC.Red := Min(65535, FC.Red + ALPHA); + FC.Green := Min(65535, FC.Green + ALPHA); + FC.Blue := Min(65535, FC.Blue + ALPHA); + Img.Colors[IX, IY] := FC; + end; + // Записываем изменения обратно в bitmap + FSmBitmap.LoadFromIntfImage(Img); + finally + Img.Free; + end; +end; + +procedure TMainForm.PbSMeterRightPaint(Sender: TObject); +var + W, H: Integer; + ZX1, ZX2, ZY1, ZY2: Integer; +begin + W := PbSMeterRight.Width; + H := PbSMeterRight.Height; + if (W <= 0) or (H <= 0) then Exit; + + // Создаём/пересоздаём off-screen буфер + if (FSmBitmap = nil) or (FSmBitmap.Width <> W) or (FSmBitmap.Height <> H) then + begin + FreeAndNil(FSmBitmap); + FSmBitmap := TBitmap.Create; + FSmBitmap.SetSize(W, H); + end; + + // Рисуем основной S-метр в off-screen буфер + DrawSMeterWide(FSmBitmap.Canvas, Rect(0, 0, W, H), + FLastSMeter, FSMeterPeak, FSMeterMin, + ZX1, ZX2, ZY1, ZY2); + + // Полупрозрачная белая заливка зоны Min..Peak поверх нарисованного + DrawSMeterZone(FSmBitmap.Canvas, Rect(0, 0, W, H), ZX1, ZX2, ZY1, ZY2); + + // Выводим на экран одним блоком (без мерцания) + PbSMeterRight.Canvas.Draw(0, 0, FSmBitmap); +end; + + +procedure TMainForm.PbFwdPowerPaint(Sender: TObject); +begin + DrawBarMeter(PbFwdPower.Canvas, Rect(0,0,PbFwdPower.Width,PbFwdPower.Height), + FLastFwdW, 150, CLR_METER_ON); +end; + +procedure TMainForm.PbSWRPaint(Sender: TObject); +begin + DrawBarMeter(PbSWR.Canvas, Rect(0,0,PbSWR.Width,PbSWR.Height), + FLastSWR - 1.0, 4.0, CLR_AMBER); +end; + +procedure TMainForm.PbSpectrumPaint(Sender: TObject); +begin + if (FSpectrumBitmap.Width > 0) and (FSpectrumBitmap.Height > 0) then + PbSpectrum.Canvas.Draw(0, 0, FSpectrumBitmap) + else + begin + PbSpectrum.Canvas.Brush.Color := CLR_BG; + PbSpectrum.Canvas.FillRect(Rect(0,0,PbSpectrum.Width,PbSpectrum.Height)); + end; +end; + +// --------------------------------------------------------------------------- +// Ruler — полоса частотных меток между спектром и водопадом +// --------------------------------------------------------------------------- +procedure TMainForm.DrawRuler; +var + C: TCanvas; + W, H: Integer; + i, X: Integer; + FreqStart, + FreqHz: Double; + VfoX: Integer; + Lbl: string; + TW: Integer; +begin + if PbRuler = nil then Exit; + W := PbRuler.Width; + H := PbRuler.Height; + if (W <= 0) or (H <= 0) then Exit; + + C := PbRuler.Canvas; + + // Фон — чуть светлее чем BG, отделяет спектр от водопада + C.Brush.Color := TColor($00141414); + C.FillRect(Rect(0, 0, W, H)); + + // Верхняя граница — тонкая линия + C.Pen.Color := CLR_BORDER; + C.Pen.Width := 1; + C.MoveTo(0, 0); C.LineTo(W, 0); + // Нижняя граница + C.MoveTo(0, H-1); C.LineTo(W, H-1); + + C.Font.Name := 'Courier New'; + C.Font.Size := 7; + + FreqStart := FCenterFreq - FSpanHz / 2; + + // 8 делений — 9 точек (0..8) + for i := 0 to 8 do + begin + X := ScaleX(i, 8, W); + + // Вертикальный тик + C.Pen.Color := CLR_BORDER; + C.MoveTo(X, 0); + C.LineTo(X, H div 2); + + // Частотная метка — центрируем под тиком + FreqHz := FreqStart + i * FSpanHz / 8; + Lbl := Format('%.3f', [FreqHz / 1e6]); + TW := C.TextWidth(Lbl); + C.Font.Color := TColor($00888888); + C.TextOut(X - TW div 2, H div 2 - 1, Lbl); + end; + + // VFO маркер — яркий треугольник/линия + VfoX := Round((FVfoA - FCenterFreq + FSpanHz / 2) / FSpanHz * W); + if (VfoX >= 0) and (VfoX < W) then + begin + C.Pen.Color := TColor($0000FF80); // яркий зелёный + C.Pen.Width := 2; + C.MoveTo(VfoX, 0); + C.LineTo(VfoX, H - 1); + C.Pen.Width := 1; + end; +end; + +procedure TMainForm.PbRulerPaint(Sender: TObject); +begin + DrawRuler; +end; +procedure TMainForm.PbWaterfallPaint(Sender: TObject); +begin + if (FWaterfallBitmap.Width > 0) and (FWaterfallBitmap.Height > 0) then + PbWaterfall.Canvas.Draw(0, 0, FWaterfallBitmap) + else + begin + PbWaterfall.Canvas.Brush.Color := CLR_BG; + PbWaterfall.Canvas.FillRect(Rect(0,0,PbWaterfall.Width,PbWaterfall.Height)); + end; + // Маркер рисуем поверх bitmap на Canvas — не трогаем bitmap чтобы не портить водопад + if FMarkerActive then + DrawMarkerLine(PbWaterfall.Canvas, PbWaterfall.Width, PbWaterfall.Height); +end; + +// =========================================================================== +// Timers +// =========================================================================== + +procedure TMainForm.MeterTimerTick(Sender: TObject); +const + AVG_ALPHA = 0.25; // EMA для сглаженного среднего уровня + ZONE_DB = 6.0; // полуширина зоны вокруг среднего (дБ) + // Адаптивный alpha: базовый + ускорение при большой разнице + PEAK_BASE = 0.06; // базовая скорость пика + MIN_BASE = 0.06; // базовая скорость минимума + ACCEL_FACTOR = 0.018; // ускорение на каждый dB разницы + MAX_ALPHA = 0.85; // максимальная скорость (не мгновенно) +var + PeakTarget, MinTarget: Double; + PeakDiff, MinDiff: Double; + PeakAlpha, MinAlpha: Double; +begin + if not FRunning then + begin + if PbSMeterRight <> nil then PbSMeterRight.Invalidate; + Exit; + end; + + + // Сглаженное среднее (EMA) + FSMeterAvg := FSMeterAvg * (1.0 - AVG_ALPHA) + FLastSMeter * AVG_ALPHA; + + // Цели для Peak и Min + PeakTarget := Max(FLastSMeter, FSMeterAvg + ZONE_DB); + MinTarget := Min(FLastSMeter, FSMeterAvg - ZONE_DB); + + // Адаптивный alpha: чем дальше от цели — тем быстрее догоняем + PeakDiff := Abs(PeakTarget - FSMeterPeak); + MinDiff := Abs(MinTarget - FSMeterMin); + PeakAlpha := Min(MAX_ALPHA, PEAK_BASE + PeakDiff * ACCEL_FACTOR); + MinAlpha := Min(MAX_ALPHA, MIN_BASE + MinDiff * ACCEL_FACTOR); + + FSMeterPeak := FSMeterPeak + PeakAlpha * (PeakTarget - FSMeterPeak); + FSMeterMin := FSMeterMin + MinAlpha * (MinTarget - FSMeterMin); + + if PbSMeterRight <> nil then PbSMeterRight.Invalidate; +end; + +procedure TMainForm.SpectrumTimerTick(Sender: TObject); +var + NowTick: QWord; + ElapsedTick: QWord; +begin + // Синхронизируем размеры если PaintBox изменился (после ресайза) + if (PbSpectrum.Width <> FSpectrumWidth) or + (PbSpectrum.Height <> FSpectrumHeight) or + (FSpectrumWidth = 0) then + ResizeSpectrumPanels; + ResizeSMeter; + if FSpectrumWidth <= 0 then Exit; + + // Проверка таймаута — трансивер не отвечает + if FRunning and FNetwork.Running then + begin + NowTick := GetTickCount64; + ElapsedTick := NowTick - FRXStartTime; + // Ждём первый пакет 5 секунд после старта + if (FRXLastPktTime = 0) and (ElapsedTick > 5000) then + begin + BtnStartStop.Caption := 'START'; + StyleButton(BtnStartStop, False); + FRunning := False; + FNetwork.SetRunAndFreq(False, FCenterFreq, FCenterFreq, 0); + StatusBar1.Panels[4].Text := 'ТРАНСИВЕР НЕДОСТУПЕН'; + BtnMOX.Enabled := False; + Exit; + end; + // После первого пакета — следим чтобы поток не прерывался более 3 сек + if (FRXLastPktTime > 0) and ((NowTick - FRXLastPktTime) > 3000) then + begin + BtnStartStop.Caption := 'START'; + StyleButton(BtnStartStop, False); + FRunning := False; + FNetwork.SetRunAndFreq(False, FCenterFreq, FCenterFreq, 0); + StatusBar1.Panels[4].Text := 'ПОТЕРЯ СВЯЗИ С ТРАНСИВЕРОМ'; + BtnMOX.Enabled := False; + Exit; + end; + end; + + if FRunning then + begin + // Обновляем StatusBar из таймера — без Synchronize в сетевом потоке + StatusBar1.Panels[3].Text := + Format('RX DDC%d | seq=%d | pkts=%d', + [FLastDDCIndex, FLastDDCSeq, FRXPacketCount]); + + if FWDSPReady then + begin + FDSPEngine.UpdateSpectrum; + FLastSMeter := FDSPEngine.GetSMeterDBm; + FDSPEngine.SetSpectrumWidth(FSpectrumWidth); // актуальная ширина для SetAGC/SetAGCTop + FDSPEngine.UpdateAGCLines(FSpectrumWidth); + end; + // Обновляем оверлей если видим + if Assigned(FVfoOverlay) and FVfoOverlay.Visible then + begin + FVfoOverlay.UpdateSMeter(FLastSMeter); + FVfoOverlay.UpdateVfo(FVfoA); + PositionVfoOverlay; + end; + // Рисуем спектр и скроллим водопад только во время работы + DrawSpectrum; + DrawWaterfall; + PbSpectrum.Invalidate; + PbRuler.Invalidate; + PbWaterfall.Invalidate; + FSpectrumDirty := False; + end + else + begin + // Не подключены — показываем чистый экран (без анимации) + if not FNetwork.Connected then + begin + // Очищаем до фона один раз при отключении + // (просто не вызываем Draw* — бitmaps остаются как были) + // Но при первом старте покажем пустой фон: + if FSpectrumBitmap.Width <> FSpectrumWidth then + begin + FSpectrumBitmap.SetSize(FSpectrumWidth, FSpectrumHeight); + ResetSpectrumBuf; + DrawSpectrum; + PbSpectrum.Invalidate; + end; + end + else + begin + // Подключены, но не запущены — статичный спектр (шум) + DrawSpectrum; + PbSpectrum.Invalidate; + FSpectrumDirty := False; + end; + end; + + // Если во время drag накопились грязные кадры — сбрасываем + if FSpectrumDirty then + begin + DrawSpectrum; + DrawWaterfall; + PbSpectrum.Invalidate; + PbRuler.Invalidate; + PbWaterfall.Invalidate; + FSpectrumDirty := False; + end; + + // Пушим текущее состояние в веб-клиенты (если есть) + if Assigned(FWebServer) then + FWebServer.PushSpectrum( + FSpectrumBuf, 1024, + FWfAvgBuf, + FLastSMeter, + FVfoA, FMode, FFilterBW, FAGCMode, FAGCTop, + FSpanHz, FVolume, + FWfAGCEnabled, FWfNFEnabled, + FCurrentBand, + FRunning and FNetwork.Connected, + FRunning, FMuted, FCTun, + BtnNR.Tag = 1, BtnNB.Tag = 1, BtnANF.Tag = 1, + FCenterFreq, FFilter); +end; + +// =========================================================================== +// Network callbacks → sync helpers +// =========================================================================== + +procedure TMainForm.OnDeviceFound(const Dev: THPSDRDevice); +var + BoardName, Entry: string; + Sync: TDeviceFoundSync; + M: TThreadMethod; +begin + BoardName := BoardTypeName(Dev.BoardType); + Entry := Format('%s %s FW:%d DDC:%d', + [Dev.IPAddress, BoardName, + Dev.FirmwareVersion, Dev.NumDDCs]); + Sync := TDeviceFoundSync.Create(Self, Dev, Entry); + try + M := Sync.Execute; + TThread.Synchronize(nil, M); + finally + Sync.Free; + end; +end; + +procedure TMainForm.DoAddDevice(const Dev: THPSDRDevice; const Entry: string); +var + Idx: Integer; +begin + Idx := Length(FDevices); + SetLength(FDevices, Idx + 1); + FDevices[Idx].Dev := Dev; + FDevices[Idx].Display := Entry; + Inc(FDeviceCount); + + if Assigned(FDeviceDialog) then + FDeviceDialog.AddDiscovered(Dev.IPAddress, Entry, Dev.BoardType); + + StatusBar1.Panels[4].Text := Format('Found: %s', [Dev.IPAddress]); +end; + +procedure TMainForm.OnHPStatusCB(const Status: THighPriorityStatus); +var + ExcPwr, FwdPwr, RevPwr: Word; + SupplyV, FwdW, SWRV: Double; + Sync: TStatusUISync; + M: TThreadMethod; +begin + ExcPwr := (Status.ExciterPwr0Hi shl 8) or Status.ExciterPwr0Lo; + FwdPwr := (Status.FwdPwrAlex0Hi shl 8) or Status.FwdPwrAlex0Lo; + RevPwr := (Status.RevPwrAlex0Hi shl 8) or Status.RevPwrAlex0Lo; + SupplyV := ADCToSupplyVolts((Status.SupplyVoltsHi shl 8) or Status.SupplyVoltsLo); + // FLastSMeter обновляется только из WDSP (GetSMeterDBm) в SpectrumTimerTick — + // ExciterPwr это мощность TX, не уровень принятого сигнала. + FwdW := ADCToWatts100(FwdPwr); + if FwdW > 0 then + SWRV := 1 + Sqrt(RevPwr / FwdPwr) + else + SWRV := 1.0; + Sync := TStatusUISync.Create(Self, FwdW, SWRV, SupplyV, + (Status.StatusBits and HPS_PLL_LOCKED) <> 0); + try + M := Sync.Execute; + TThread.Synchronize(nil, M); + finally + Sync.Free; + end; +end; + +procedure TMainForm.DoUpdateStatus(FwdW, SWRV, SupplyV: Double; PLLLock: Boolean); +var + PLLStr: string; +begin + FLastFwdW := FwdW; + FLastSWR := SWRV; + LblFwdPwr.Caption := Format('%.0fW', [FwdW]); + LblSWRVal.Caption := Format('SWR:%.1f', [SWRV]); + if PLLLock then PLLStr := 'PLL OK' else PLLStr := 'PLL?'; + StatusBar1.Panels[2].Text := + Format('Supply: %.1fV | FWD: %.0fW | SWR: %.1f | %s', + [SupplyV, FwdW, SWRV, PLLStr]); + // Panels[3] зарезервирована для RX stats (DDC seq/pkt count) +end; + +procedure TMainForm.OnDDCIQCB(DDCIndex: Integer; const Data: TDDCIQPacket); +var + SamplesPerFrame: Integer; +begin + // Вызывается из сетевого потока — UI не трогаем напрямую + + // Счётчик принятых пакетов + Inc(FRXPacketCount); + FRXLastPktTime := GetTickCount64; // фиксируем время последнего пакета + + // 1. Подаём IQ данные в DSP — только с активного DDC + if (DDCIndex = FActiveDDC) and FWDSPReady then + begin + SamplesPerFrame := (Integer(Data.SamplesPerFrame[0]) shl 8) or + Integer(Data.SamplesPerFrame[1]); + if SamplesPerFrame <= 0 then SamplesPerFrame := 238; // fallback + FDSPEngine.PushDDCPacket(Data.IQData, 0, SamplesPerFrame); + end; + + // 2. Запоминаем последний seq — StatusBar обновит таймер (без Synchronize в горячем пути) + FLastDDCSeq := (LongWord(Data.Seq[0]) shl 24) or (LongWord(Data.Seq[1]) shl 16) + or (LongWord(Data.Seq[2]) shl 8) or LongWord(Data.Seq[3]); + FLastDDCIndex := DDCIndex; +end; + +procedure TMainForm.DoUpdateDDCSeq(DDCIdx: Integer; Seq: LongWord); +begin + StatusBar1.Panels[3].Text := + Format('RX DDC%d | seq=%d | pkts=%d', [DDCIdx, Seq, FRXPacketCount]); +end; + +procedure TMainForm.OnMicPacketCB(const Data: TMicDataPacket); +begin + // TODO: WDSP TXA +end; + +// =========================================================================== +// Button handlers +// =========================================================================== + +{ Поток открытия — отдельный класс, без анонимных процедур } +// Открываем WDSP в фоновом потоке чтобы не блокировать UI при нажатии START +type + TWDSPOpenThread = class(TThread) + private + FForm: TMainForm; + FResult: Boolean; + procedure SyncDone; + protected + procedure Execute; override; + public + constructor Create(AForm: TMainForm); + end; + +constructor TWDSPOpenThread.Create(AForm: TMainForm); +begin + inherited Create(False); + FForm := AForm; + FResult := False; + FreeOnTerminate := True; +end; + +procedure TWDSPOpenThread.Execute; +var + M: TThreadMethod; +begin + try + FResult := FForm.FDSPEngine.Open; + except + FResult := False; + end; + M := SyncDone; + TThread.Synchronize(nil, M); +end; + +procedure TWDSPOpenThread.SyncDone; +begin + FForm.OnWDSPOpenDone(FResult); +end; + +type + TDiscoverThread = class(TThread) + private + FNet: THPSDRNetwork; + FForm: TMainForm; + protected + procedure Execute; override; + public + constructor Create(ANet: THPSDRNetwork; AForm: TMainForm); + end; + +constructor TDiscoverThread.Create(ANet: THPSDRNetwork; AForm: TMainForm); +begin + FNet := ANet; + FForm := AForm; + FreeOnTerminate := True; + inherited Create(False); +end; + +procedure TDiscoverThread.Execute; +var + Devs: THPSDRDeviceArray; + Sync: TDDCSeqSync; + M: TThreadMethod; +begin + Devs := FNet.Discover(2000); + if Length(Devs) = 0 then + begin + // DDCIdx = -1 is the sentinel for "no device found" + Sync := TDDCSeqSync.Create(FForm, -1, 0); + try + M := Sync.Execute; + TThread.Synchronize(nil, M); + finally + Sync.Free; + end; + end; + // Devices found are signalled via OnDeviceFound callback during Discover() +end; + +{ Перегруженный DoUpdateDDCSeq принимает -1 как «нет устройств» } +procedure TMainForm.DoUpdateDDCSeqOrNoDevice(DDCIdx: Integer; Seq: LongWord); +begin + if DDCIdx = -1 then + begin + if Assigned(FDeviceDialog) then + begin + FDeviceDialog.ClearDiscovered; + FDeviceDialog.AddDiscovered('', '-- no device found --'); + end; + StatusBar1.Panels[4].Text := 'No hardware found'; + end + else + StatusBar1.Panels[3].Text := Format('DDC%d seq=%d', [DDCIdx, Seq]); +end; + +procedure TMainForm.BtnDiscoverClick(Sender: TObject); +begin + // Открываем диалог выбора устройства + if not Assigned(FDeviceDialog) then + FDeviceDialog := TDeviceDialog.Create(Self); + FDeviceDialog.OnDiscover := BtnDiscoverFromDialog; + FDeviceDialog.ShowModal; + // Результат диалога не обрабатываем здесь — START сам спросит если нужно +end; + +procedure TMainForm.BtnDiscoverFromDialog(Sender: TObject); +// Запускается когда пользователь нажимает DISCOVER внутри диалога +begin + SetLength(FDevices, 0); + FDeviceCount := 0; + StatusBar1.Panels[4].Text := 'Discovering...'; + FNetwork.DirectIP := ''; + TDiscoverThread.Create(FNetwork, Self); +end; + +procedure TMainForm.BtnStartStopClick(Sender: TObject); +var + Idx: Integer; + Dev: THPSDRDevice; + GenPkt: TGeneralPacket; + DUCPkt: TDUCSpecificPacket; + G_Settings: TGlobalSettings; + AutoIP: string; +begin + if FNetwork.Connected then + begin + // --- STOP --- + if FRunning then + begin + FNetwork.UpdateState(FCenterFreq, FCenterFreq, 0, False, True, True); + FNetwork.SetRunAndFreq(False, FCenterFreq, FCenterFreq, 0); + FRunning := False; + FTransmitting := False; + if FWDSPReady then FDSPEngine.SetTXRun(False); + StyleButton(BtnMOX, False); + end; + FRXPacketCount := 0; + FActiveDDC := 0; + StatusBar1.Panels[3].Text := 'RX: waiting...'; + ResetSpectrumBuf; + DrawSpectrum; + PbSpectrum.Invalidate; + FNetwork.Disconnect; + BtnStartStop.Caption := 'START'; + StyleButton(BtnStartStop, False); + StatusBar1.Panels[4].Text := 'Not connected'; + StatusBar1.Panels[0].Text := 'IP: --'; + StatusBar1.Panels[1].Text := 'Board: --'; + BtnMOX.Enabled := False; + Exit; + end; + + // --- START --- + AutoIP := ''; + FPendingBoardType := 0; + if Assigned(FDeviceDialog) then + AutoIP := FDeviceDialog.GetAutoStartIP; + + if AutoIP <> '' then + begin + FPendingIP := AutoIP; + FPendingBoardType := FDeviceDialog.GetAutoStartBoardType; + end + else + begin + if not Assigned(FDeviceDialog) then + FDeviceDialog := TDeviceDialog.Create(Self); + FDeviceDialog.OnDiscover := BtnDiscoverFromDialog; + if FDeviceDialog.ShowModal <> mrOk then Exit; + if not FDeviceDialog.DialogResult.Accepted then Exit; + FPendingIP := FDeviceDialog.DialogResult.IPAddress; + FPendingBoardType := FDeviceDialog.GetSavedBoardType( + FDeviceDialog.DialogResult.SavedIdx); + end; + + // Создаём запись устройства из IP + BoardType из диалога если есть + FillChar(Dev, SizeOf(Dev), 0); + Dev.IPAddress := FPendingIP; + Dev.BoardType := FPendingBoardType; + + // --- Открываем WDSP асинхронно чтобы не блокировать UI --- + FPendingDev := Dev; + BtnStartStop.Enabled := False; + StatusBar1.Panels[3].Text := 'Opening WDSP...'; + if FWDSPReady then + // WDSP уже открыт — сразу подключаемся + DoConnectDevice(Dev) + else + // Открываем в фоновом потоке + TWDSPOpenThread.Create(Self); +end; + +procedure TMainForm.OnWDSPOpenDone(Success: Boolean); +begin + // Вызывается из TWDSPOpenThread.SyncDone — уже в главном потоке + FWDSPReady := Success; + if not Success then + StatusBar1.Panels[3].Text := 'WDSP: demo mode (libwdsp not loaded)'; + DoConnectDevice(FPendingDev); +end; + +procedure TMainForm.DoConnectDevice(const Dev: THPSDRDevice); +var + GenPkt: TGeneralPacket; + DUCPkt: TDUCSpecificPacket; + G_Settings: TGlobalSettings; +begin + BtnStartStop.Enabled := True; + + if not FNetwork.Connect(Dev) then + begin + ShowMessage('Failed to connect to ' + Dev.IPAddress + + IfThen(FNetwork.LastError <> '', ': ' + FNetwork.LastError, '')); + Exit; + end; + + // --- Загружаем настройки устройства по MAC --- + Move(FNetwork.Device.MAC[0], FDevMAC[0], 6); + FDevConnected := True; + FSettings.LoadDevice(FDevMAC, G_Settings, FBandCache); + FVolume := G_Settings.Volume; + FDriveLevel := G_Settings.DriveLevel; + FActiveVfo := G_Settings.ActiveVfo; + FCurrentBand := G_Settings.LastBand; + // SampleRate — глобальный, загружаем до RestoreBand + if G_Settings.SampleRate > 0 then + begin + FSampleRate := G_Settings.SampleRate; + FSpanHz := FSampleRate; + end; + BtnNR.Tag := Ord(G_Settings.NREnabled); StyleButton(BtnNR, G_Settings.NREnabled); + BtnNB.Tag := Ord(G_Settings.NBEnabled); StyleButton(BtnNB, G_Settings.NBEnabled); + BtnANF.Tag := Ord(G_Settings.ANFEnabled); StyleButton(BtnANF, G_Settings.ANFEnabled); + FWfAGCEnabled := G_Settings.WfAGCEnabled; StyleButton(BtnWfAGC, FWfAGCEnabled); + FWfNFEnabled := G_Settings.WfNFEnabled; StyleButton(BtnWfNF, FWfNFEnabled); + RestoreBand(FCurrentBand); + + StatusBar1.Panels[0].Text := 'IP: ' + FNetwork.Device.IPAddress; + StatusBar1.Panels[1].Text := 'Board: ' + BoardTypeName(FNetwork.Device.BoardType); + + // General packet + FillChar(GenPkt, SizeOf(GenPkt), 0); + GenPkt.Command := CMD_GENERAL; + GenPkt.Flags37 := $08; + GenPkt.Flags38 := $01; + GenPkt.PAConfig := $01; + if FNetwork.Device.BoardType = 5 then + GenPkt.AlexEnable := $03 + else + GenPkt.AlexEnable := $01; + FNetwork.SendGeneralPacket(GenPkt); + + if FNetwork.Device.BoardType in [3, 4, 5] then + FActiveDDC := 2 + else + FActiveDDC := 0; + + FNetwork.ConfigureDDCs(1, FSampleRate div 1000, 0); + + // Синхронизируем samplerate WDSP если нужно + if FWDSPReady and (FDSPEngine.SampleRate <> FSampleRate) then + begin + FWDSPReady := False; + FDSPEngine.ChangeSampleRate(FSampleRate); + FWDSPReady := FDSPEngine.Initialized; + end; + + if FWDSPReady then + begin + FDSPEngine.SetMode(FMode); + FDSPEngine.SetVolume(FVolume / 100.0); + ApplyModeFilter; + // ChangeSampleRate пересоздаёт WDSP-канал — восстанавливаем все настройки + FDSPEngine.SetAGCTop(FAGCTop); + FDSPEngine.SetAGC(TWDSPAGCMode(FAGCMode), 50.0); + // SetAGC вызывает UpdateAGCLines внутри — линии на спектре обновятся + end; + + // DUC specific + FillChar(DUCPkt, SizeOf(DUCPkt), 0); + DUCPkt.NumDACs := 1; + DUCPkt.SidetoneLevel := 50; + DUCPkt.SidetoneFreqLo := 600; + DUCPkt.KeyerSpeed := 20; + DUCPkt.KeyerWeight := 50; + DUCPkt.DUC0RateHi := Hi(192); + DUCPkt.DUC0RateLo := Lo(192); + DUCPkt.DUC0Bits := 24; + FNetwork.SendDUCSpecific(DUCPkt); + + FNetwork.UpdateState(FCenterFreq, FCenterFreq, FDriveLevel, False, True, True); + FNetwork.SetRunAndFreq(True, FCenterFreq, FCenterFreq, FDriveLevel); + FRunning := True; + FRXStartTime := GetTickCount64; + FRXLastPktTime := 0; + + // Принудительно обновляем AGC линии — гарантированно после всех SetAGC вызовов + if FWDSPReady then + FDSPEngine.UpdateAGCLines(FSpectrumWidth); // ещё не получили ни одного пакета + + BtnStartStop.Caption := 'STOP'; + StyleButton(BtnStartStop, True); + StatusBar1.Panels[4].Text := 'RUNNING ' + FormatFreq(FVfoA); + BtnMOX.Enabled := True; +end; + + +procedure TMainForm.FreqDispAChanged(Sender: TObject; NewFreq: Int64); +begin + ApplyVfoA(NewFreq); +end; + +procedure TMainForm.FreqDispBChanged(Sender: TObject; NewFreq: Int64); +begin + FVfoB := NewFreq; + if FActiveVfo = 1 then + begin + FCenterFreq := FVfoB; + FCenterFreq := FVfoB; + if FNetwork.Connected and FNetwork.Running then + begin + FNetwork.UpdateState(FVfoB, FVfoB, FDriveLevel, FTransmitting, True, True); + FNetwork.SendFullHP; + end; + end; +end; + +// --------------------------------------------------------------------------- +// UpdateFilterButtons — обновляет подписи кнопок фильтра под текущий режим +// --------------------------------------------------------------------------- +procedure TMainForm.UpdateFilterButtons; +var + i: Integer; + Names: array[0..FILT_COUNT-1] of string; + DefIdx: Integer; +begin + case FMode of + 0, 1: begin + for i := 0 to FILT_COUNT-1 do Names[i] := FILT_SSB_NAMES[i]; + DefIdx := FILT_SSB_DEF; + end; + 3, 4: begin + for i := 0 to FILT_COUNT-1 do Names[i] := FILT_CW_NAMES[i]; + DefIdx := FILT_CW_DEF; + end; + 5: begin + for i := 0 to FILT_COUNT-1 do Names[i] := FILT_FM_NAMES[i]; + DefIdx := FILT_FM_DEF; + end; + else begin + for i := 0 to FILT_COUNT-1 do Names[i] := FILT_AM_NAMES[i]; + DefIdx := FILT_AM_DEF; + end; + end; + + FFilter := DefIdx; + case FMode of + 0, 1: FFilterBW := FILT_SSB_BW[DefIdx]; + 3, 4: FFilterBW := FILT_CW_BW[DefIdx]; + 5: FFilterBW := FILT_FM_BW[DefIdx]; + else FFilterBW := FILT_AM_BW[DefIdx]; + end; + + for i := 0 to FILT_COUNT-1 do + begin + BtnFilter[i].Caption := Names[i]; + StyleButton(BtnFilter[i], i = FFilter); + end; +end; + +// --------------------------------------------------------------------------- +// ApplyVfoA — единая точка смены частоты VFO A +// +// CTUN ВЫКЛ (классический режим): +// FCenterFreq = FVfoA — спектр центрирован на VFO, маркер всегда в центре +// +// CTUN ВКЛ (piHPSDR/Thetis режим): +// FCenterFreq статичен — спектр/водопад не двигаются +// FVfoA движется по дисплею (маркер гуляет) +// Перецентрирование — только когда КРАЙ ПОЛОСЫ ФИЛЬТРА выходит за край дисплея +// (по образцу OpenHPSDR/PowerSDR: "re-centering occurs as the edge of the passband +// hits the edge of the display") +// --------------------------------------------------------------------------- +procedure TMainForm.ApplyVfoA(NewFreq: Int64); +var + Offset: Double; + FiltLo: Double; + FiltHi: Double; + HalfSpan: Double; + Scrolled: Boolean; +begin + FVfoA := NewFreq; + Scrolled := False; + + if not FCTun then + begin + // ---- CTUN OFF ---- + // DDC = VFO, сдвига нет + FCenterFreq := FVfoA; + if FWDSPReady then + FDSPEngine.SetShift(0.0); + end + else + begin + // ---- CTUN ON ---- + // DDC (FCenterFreq) стоит на месте. + // SetRXAShiftFreq сдвигает спектр внутри WDSP так чтобы + // демодулятор принимал сигнал на FVfoA, а не на FCenterFreq. + // Shift = FVfoA - FCenterFreq (в Гц) + Offset := FVfoA - FCenterFreq; + if FWDSPReady then + FDSPEngine.SetShift(Offset); + + // Проверяем не вышла ли полоса фильтра за край дисплея + HalfSpan := FSpanHz / 2; + case FMode of + 0: begin FiltLo := Offset - FFilterBW; FiltHi := Offset - 100; end; + 1: begin FiltLo := Offset + 100; FiltHi := Offset + FFilterBW; end; + else begin FiltLo := Offset - FFilterBW/2; FiltHi := Offset + FFilterBW/2; end; + end; + + if (FiltHi > HalfSpan) or (FiltLo < -HalfSpan) then + begin + // Полоса вышла за край → прокручиваем центр + if FiltHi > HalfSpan then + FCenterFreq := FVfoA - HalfSpan * 0.5 + else + FCenterFreq := FVfoA + HalfSpan * 0.5; + // Пересчитываем сдвиг после прокрутки + if FWDSPReady then + FDSPEngine.SetShift(FVfoA - FCenterFreq); + // DDC перестраивается на новый FCenterFreq + Scrolled := True; + end; + end; + + // Обновляем VFO дисплей + FreqDispA.Frequency := Round(FVfoA); + + // DDC: передаём FCenterFreq (при CTUN OFF = FVfoA, при CTUN ON = фиксирован) + if FNetwork.Connected and FNetwork.Running then + begin + FNetwork.UpdateState(FCenterFreq, FCenterFreq, FDriveLevel, FTransmitting, True, True); + FNetwork.SendFullHP; + end; + + // Перерисовываем спектр всегда (маркер и полоса двигаются) + // Если идёт drag — не вызываем Draw напрямую, таймер подхватит + if FSpecDrag then + FSpectrumDirty := True + else + begin + DrawSpectrum; + PbSpectrum.Invalidate; + if Scrolled then + begin + DrawWaterfall; + PbWaterfall.Invalidate; + end; + end; +end; + +// --------------------------------------------------------------------------- +// CTUN toggle +// --------------------------------------------------------------------------- +procedure TMainForm.BtnCTunClick(Sender: TObject); +begin + FCTun := not FCTun; + StyleButton(BtnCTun, FCTun); + FBandCache[FCurrentBand].CTun := FCTun; + if not FCTun then + begin + // Выключили CTUN: центрируемся на VFO, shift=0 + FCenterFreq := FVfoA; + if FWDSPReady then + FDSPEngine.SetShift(0.0); + if FNetwork.Connected and FNetwork.Running then + begin + FNetwork.UpdateState(FCenterFreq, FCenterFreq, FDriveLevel, FTransmitting, True, True); + FNetwork.SendFullHP; + end; + end + else + begin + // Включили CTUN: фиксируем текущее положение дисплея + // FCenterFreq остаётся как есть — спектр не прыгает + end; + DrawSpectrum; + DrawWaterfall; + PbSpectrum.Invalidate; + PbWaterfall.Invalidate; +end; + +// --------------------------------------------------------------------------- +// Клик/драг по спектру/водопаду +// --------------------------------------------------------------------------- + +// Перевод X пикселя в частоту +function PixelToFreq(PixelX, PanelWidth: Integer; + CenterFreq, SpanHz: Double): Double; +begin + Result := CenterFreq + (PixelX / PanelWidth - 0.5) * SpanHz; +end; + +procedure TMainForm.DoSpectrumClick(PixelX: Integer; PanelWidth: Integer); +var + ClickFreq: Int64; + StepHz: Int64; +begin + if PanelWidth <= 0 then Exit; + StepHz := 100; + // Пиксель → частота через текущий центр дисплея (FCenterFreq) + ClickFreq := Round(FCenterFreq + (PixelX / PanelWidth - 0.5) * FSpanHz); + ClickFreq := (ClickFreq div StepHz) * StepHz; + ApplyVfoA(ClickFreq); +end; + +procedure TMainForm.DoSpectrumDrag(PixelX: Integer; PanelWidth: Integer); +var + dPix: Integer; + dFreq: Double; +begin + if PanelWidth <= 0 then Exit; + dPix := PixelX - FSpecDragX0; + dFreq := dPix / PanelWidth * FSpanHz; + if FCTun then + begin + // CTUN ON: drag двигает окно просмотра (FCenterFreq/DDC) + // VFO остаётся, shift обновляется = FVfoA - новый FCenterFreq + FCenterFreq := FSpecDragFreq - dFreq; + if FWDSPReady then + FDSPEngine.SetShift(FVfoA - FCenterFreq); + if FNetwork.Connected and FNetwork.Running then + begin + FNetwork.UpdateState(FCenterFreq, FCenterFreq, FDriveLevel, FTransmitting, True, True); + FNetwork.SendFullHP; + end; + FSpectrumDirty := True; // таймер перерисует в ближайшем тике + end + else + begin + // CTUN OFF: drag двигает VFO, FCenterFreq следует через ApplyVfoA + ApplyVfoA(Round(FSpecDragFreq - dFreq)); + end; +end; + +// Спектр +procedure TMainForm.PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + begin + // Левая кнопка: сбрасываем маркер если активен + if FMarkerActive then + begin + FMarkerActive := False; + PbSpectrum.Invalidate; + PbWaterfall.Invalidate; + end; + FSpecDrag := True; + FSpecDragX0 := X; + if FCTun then FSpecDragFreq := FCenterFreq + else FSpecDragFreq := FVfoA; + PbSpectrum.Cursor := crSizeWE; + end + else if Button = mbRight then + begin + // Правая кнопка: toggle маркера + if FMarkerActive and (Abs(Round(X / PbSpectrum.Width * 1000) - FMarkerX) < 8) then + begin + // Клик рядом с текущим маркером — убираем + FMarkerActive := False; + end + else + begin + // Ставим маркер в новое место + FMarkerActive := True; + FMarkerX := Round(X / PbSpectrum.Width * 1000); + end; + PbSpectrum.Invalidate; + PbWaterfall.Invalidate; + end; +end; + +procedure TMainForm.PbSpectrumMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); +begin + if FSpecDrag and (ssLeft in Shift) then + DoSpectrumDrag(X, PbSpectrum.Width); + // Маркер следует за курсором — обновление произойдёт в ближайшем тике таймера (50ms) + if FMarkerActive then + FMarkerX := Round(X / PbSpectrum.Width * 1000); +end; + +procedure TMainForm.PbSpectrumMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + begin + if (Abs(X - FSpecDragX0) < 4) then + DoSpectrumClick(X, PbSpectrum.Width); // это был клик, не драг + FSpecDrag := False; + PbSpectrum.Cursor := crDefault; + end; +end; + +// Водопад (аналогично) +procedure TMainForm.PbWaterfallMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + begin + if FMarkerActive then + begin + FMarkerActive := False; + PbSpectrum.Invalidate; + PbWaterfall.Invalidate; + end; + FSpecDrag := True; + FSpecDragX0 := X; + if FCTun then FSpecDragFreq := FCenterFreq + else FSpecDragFreq := FVfoA; + PbWaterfall.Cursor := crSizeWE; + end + else if Button = mbRight then + begin + if FMarkerActive and (Abs(Round(X / PbWaterfall.Width * 1000) - FMarkerX) < 8) then + FMarkerActive := False + else + begin + FMarkerActive := True; + FMarkerX := Round(X / PbWaterfall.Width * 1000); + end; + PbSpectrum.Invalidate; + PbWaterfall.Invalidate; + end; +end; + +procedure TMainForm.PbWaterfallMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); +begin + if FSpecDrag and (ssLeft in Shift) then + DoSpectrumDrag(X, PbWaterfall.Width); + if FMarkerActive then + FMarkerX := Round(X / PbWaterfall.Width * 1000); +end; + +procedure TMainForm.PbWaterfallMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + begin + if (Abs(X - FSpecDragX0) < 4) then + DoSpectrumClick(X, PbWaterfall.Width); + FSpecDrag := False; + PbWaterfall.Cursor := crDefault; + end; +end; + +procedure TMainForm.BtnBandClick(Sender: TObject); +var + NewBand: Integer; +begin + NewBand := (Sender as TFlatButton).Tag; + if (NewBand < 0) or (NewBand >= BAND_COUNT) then Exit; + if NewBand = FCurrentBand then Exit; // уже на этом диапазоне + + // Сохраняем настройки текущего диапазона перед сменой + if FDevConnected then + begin + SaveCurrentBand; + FSettings.Save; + end; + + // Переключаем диапазон + FCurrentBand := NewBand; + + // Восстанавливаем настройки нового диапазона + RestoreBand(FCurrentBand); +end; + +procedure TMainForm.ApplyModeFilter; +var + Lo, Hi, Half: Integer; +begin + Half := FFilterBW div 2; + case FMode of + 0: begin Lo := -FFilterBW; Hi := -100; end; // LSB: верхний срез -100 Гц + 1: begin Lo := 100; Hi := FFilterBW; end; // USB + 2: begin Lo := -Half; Hi := Half; end; // DSB + 3: begin Lo := -Half; Hi := Half; end; // CWL + 4: begin Lo := -Half; Hi := Half; end; // CWU + 5: begin Lo := -Half; Hi := Half; end; // FM + 6: begin Lo := -Half; Hi := Half; end; // AM + 7: begin Lo := -Half; Hi := Half; end; // SAM + else Lo := -Half; Hi := Half; + end; + if FWDSPReady then + FDSPEngine.SetFilter(Lo, Hi); +end; + +procedure TMainForm.BtnModeClick(Sender: TObject); +var + i, N: Integer; +begin + N := (Sender as TFlatButton).Tag; + FMode := N; + for i := 0 to MODE_COUNT - 1 do StyleButton(BtnMode[i], i = FMode); + if FWDSPReady then + FDSPEngine.SetMode(N); + UpdateFilterButtons; // обновляем подписи и дефолт фильтра под новый режим + ApplyModeFilter; +end; + +procedure TMainForm.BtnFilterClick(Sender: TObject); +var + i, N: Integer; +begin + N := (Sender as TFlatButton).Tag; + FFilter := N; + // Устанавливаем полосу по текущему режиму + case FMode of + 0, 1: FFilterBW := FILT_SSB_BW[N]; + 3, 4: FFilterBW := FILT_CW_BW[N]; + 5: FFilterBW := FILT_FM_BW[N]; + else FFilterBW := FILT_AM_BW[N]; // DSB, AM, SAM + end; + for i := 0 to FILT_COUNT - 1 do StyleButton(BtnFilter[i], i = FFilter); + ApplyModeFilter; +end; + +procedure TMainForm.BtnVfoSwapClick(Sender: TObject); +var Tmp: Double; +begin + Tmp := FVfoA; FVfoA := FVfoB; FVfoB := Tmp; + UpdateVfoDisplay; + UpdateFilterButtons; + if FRunning then FNetwork.SetRunAndFreq(True, FCenterFreq, FCenterFreq, FDriveLevel); +end; + +procedure TMainForm.BtnVfoACopyBClick(Sender: TObject); +begin + FVfoB := FVfoA; UpdateVfoDisplay; +end; + +procedure TMainForm.BtnVfoBCopyAClick(Sender: TObject); +begin + FVfoA := FVfoB; UpdateVfoDisplay; + if FRunning then FNetwork.SetRunAndFreq(True, FCenterFreq, FCenterFreq, FDriveLevel); +end; + +procedure TMainForm.BtnMOXClick(Sender: TObject); +begin + FTransmitting := not FTransmitting; + if FTransmitting then + begin + BtnMOX.ClrNorm := TColor($00000044); + BtnMOX.ClrText := TColor($000000FF); + BtnMOX.ClrTextAct := TColor($000000FF); + BtnMOX.Active := True; + end else + StyleButton(BtnMOX, False); + if FWDSPReady then FDSPEngine.SetTXRun(FTransmitting); +end; + +procedure TMainForm.BtnMuteClick(Sender: TObject); +begin + FMuted := not FMuted; + StyleButton(BtnMute, FMuted); + if FMuted then BtnMute.Caption := 'UNMUTE' + else BtnMute.Caption := 'MUTE'; + if FWDSPReady then FDSPEngine.SetMute(FMuted); +end; + +procedure TMainForm.BtnNRClick(Sender: TObject); +begin + (Sender as TFlatButton).Tag := 1 - (Sender as TFlatButton).Tag; + StyleButton(Sender as TFlatButton, (Sender as TFlatButton).Tag = 1); + if FWDSPReady then FDSPEngine.SetNR((Sender as TFlatButton).Tag = 1); +end; + +procedure TMainForm.BtnNBClick(Sender: TObject); +begin + (Sender as TFlatButton).Tag := 1 - (Sender as TFlatButton).Tag; + StyleButton(Sender as TFlatButton, (Sender as TFlatButton).Tag = 1); + if FWDSPReady then FDSPEngine.SetNB((Sender as TFlatButton).Tag = 1); +end; + +procedure TMainForm.BtnANFClick(Sender: TObject); +begin + (Sender as TFlatButton).Tag := 1 - (Sender as TFlatButton).Tag; + StyleButton(Sender as TFlatButton, (Sender as TFlatButton).Tag = 1); + if FWDSPReady then FDSPEngine.SetANF((Sender as TFlatButton).Tag = 1); +end; + + +procedure TMainForm.BtnWfAGCClick(Sender: TObject); +begin + FWfAGCEnabled := not FWfAGCEnabled; + StyleButton(BtnWfAGC, FWfAGCEnabled); + if not FWfAGCEnabled then + FWfHigh := -50.0; // сбрасываем к умолчанию при выключении +end; + +procedure TMainForm.BtnWfNFClick(Sender: TObject); +begin + FWfNFEnabled := not FWfNFEnabled; + StyleButton(BtnWfNF, FWfNFEnabled); + if not FWfNFEnabled then + FWfLow := -120.0; +end; + +procedure TMainForm.BtnHidePanelClick(Sender: TObject); +begin + FPanelHidden := not FPanelHidden; + PanelLeft.Visible := not FPanelHidden; + if FPanelHidden then + begin + BtnHidePanel.Caption := '▶ SHOW'; + // PbSpectrum — TGraphicControl, не TWinControl, используем PanelRight + FVfoOverlay.Parent := PanelRight; + FVfoOverlay.Width := 260; + FVfoOverlay.Height := 130; + FVfoOverlay.SetState(FMode, FFilterBW, FVfoA, FLastSMeter); + FVfoOverlay.Visible := True; + FVfoOverlay.BringToFront; + PositionVfoOverlay; + end + else + begin + BtnHidePanel.Caption := '◀ HIDE'; + FVfoOverlay.Visible := False; + end; + ResizeSMeter; +end; + +procedure TMainForm.PositionVfoOverlay; +var + VfoX, OW, SpTop: Integer; +begin + if not Assigned(FVfoOverlay) or not FVfoOverlay.Visible then Exit; + OW := FVfoOverlay.Width; + SpTop := PbSpectrum.Top; // смещение PbSpectrum внутри PanelRight + + if PbSpectrum.Width > 0 then + VfoX := Round((FVfoA - FCenterFreq + FSpanHz / 2) / FSpanHz * PbSpectrum.Width) + else + VfoX := PbSpectrum.Width div 2; + + // Всегда справа от VFO-линии + FVfoOverlay.Left := Min(PanelRight.Width - OW - 4, VfoX + 6); + FVfoOverlay.Top := SpTop + 6; +end; + +procedure TMainForm.PbSpectrumDblClick(Sender: TObject); +begin + // Двойной клик — ничего не делаем (оверлей всегда виден при скрытой панели) +end; + +procedure TMainForm.OnModeFilterSelect(Mode: Integer; FilterBW: Integer); +begin + FMode := Mode; + FFilterBW := FilterBW; + if FWDSPReady then + begin + FDSPEngine.SetMode(FMode); + ApplyModeFilter; + end; + if Assigned(FVfoOverlay) and FVfoOverlay.Visible then + begin + FVfoOverlay.SetState(FMode, FFilterBW, FVfoA, FLastSMeter); + PositionVfoOverlay; // перепозиционируем при смене LSB↔USB + end; +end; + +procedure TMainForm.BtnSpanClick(Sender: TObject); +var + NewRate: Integer; + DDCRate: Word; +begin + NewRate := (Sender as TFlatButton).Tag; + if NewRate = FSampleRate then Exit; + + FSampleRate := NewRate; + FSpanHz := NewRate; + DDCRate := NewRate div 1000; + + // Обновляем кнопки сразу — UI отзывчив + StyleButton(BtnSpan48k, FSampleRate = 48000); + StyleButton(BtnSpan96k, FSampleRate = 96000); + StyleButton(BtnSpan192k, FSampleRate = 192000); + StyleButton(BtnSpan384k, FSampleRate = 384000); + StyleButton(BtnSpan768k, FSampleRate = 768000); + StyleButton(BtnSpan1536k, FSampleRate = 1536000); + Application.ProcessMessages; + + FBandCache[FCurrentBand].SpanHz := FSpanHz; // для обратной совместимости + // SampleRate — глобальный: сохраняем в global settings + if FDevConnected then + FSettings.SaveGlobal(FDevMAC, MakeGlobalSettings); + + // 1. Останавливаем WDSP и сбрасываем очередь старых пакетов + if FWDSPReady then + begin + FWDSPReady := False; + FDSPEngine.ChangeSampleRate(NewRate); // Close + FlushQueue + Open + end; + + // 2. Отправляем новый rate трансиверу + // (после остановки DSP — новые пакеты сразу идут с правильным rate) + if FNetwork.Connected then + FNetwork.ConfigureDDCs(1, DDCRate, 0); + + // 3. Восстанавливаем настройки DSP + FWDSPReady := FDSPEngine.Initialized; + if FWDSPReady then + begin + FDSPEngine.SetMode(FMode); + FDSPEngine.SetVolume(FVolume / 100.0); + ApplyModeFilter; + // ChangeSampleRate пересоздаёт WDSP-канал — восстанавливаем AGC + FDSPEngine.SetAGCTop(FAGCTop); + FDSPEngine.SetAGC(TWDSPAGCMode(FAGCMode), 50.0); + FDSPEngine.UpdateAGCLines(FSpectrumWidth); + if FNetwork.Connected then + FDSPEngine.SetShift(FVfoA - FCenterFreq); + end; +end; + +// =========================================================================== +// Веб-интерфейс: callbacks от TWebServer (вызываются из WS-потока) +// Все изменения состояния выполняем через TThread.Synchronize чтобы +// не трогать UI и WDSP из чужого потока. +// =========================================================================== + +procedure TMainForm.WebOnFreq(Hz: Double); +begin + FWebSyncFreq := Hz; + FWebSyncM := SyncWebFreq; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebFreq; +begin + FVfoA := FWebSyncFreq; + if not FCTun then FCenterFreq := FVfoA; + UpdateVfoDisplay; + if FWDSPReady then + begin + FDSPEngine.SetShift(FVfoA - FCenterFreq); + if FRunning then + FNetwork.SetRunAndFreq(True, FCenterFreq, FCenterFreq, FDriveLevel); + end; +end; + +procedure TMainForm.WebOnMode(Mode: Integer); +begin + FWebSyncInt := Mode; + FWebSyncM := SyncWebMode; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebMode; +var i: Integer; +begin + if (FWebSyncInt < 0) or (FWebSyncInt >= MODE_COUNT) then Exit; + FMode := FWebSyncInt; + for i := 0 to MODE_COUNT - 1 do StyleButton(BtnMode[i], i = FMode); + if FWDSPReady then FDSPEngine.SetMode(FMode); + UpdateFilterButtons; + ApplyModeFilter; + FBandCache[FCurrentBand].Mode := FMode; +end; + +procedure TMainForm.WebOnFilter(BW: Integer); +begin + FWebSyncInt := BW; + FWebSyncM := SyncWebFilter; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebFilter; +var + best, dist, i, j: Integer; + BW_arr: array[0..FILT_COUNT-1] of Integer; + Idx: Integer; +begin + // Negative value = -(idx+1) means filter index was passed directly + if FWebSyncInt < 0 then + begin + Idx := (-FWebSyncInt) - 1; + if (Idx >= 0) and (Idx < FILT_COUNT) then + begin + FFilter := Idx; + case FMode of + 0,1: FFilterBW := FILT_SSB_BW[Idx]; + 3,4: FFilterBW := FILT_CW_BW[Idx]; + 5: FFilterBW := FILT_FM_BW[Idx]; + else FFilterBW := FILT_AM_BW[Idx]; + end; + for j := 0 to FILT_COUNT-1 do StyleButton(BtnFilter[j], j = FFilter); + ApplyModeFilter; + FBandCache[FCurrentBand].FilterBW := FFilterBW; + end; + Exit; + end; + // Positive value = bandwidth in Hz, find closest filter + FFilterBW := FWebSyncInt; + case FMode of + 0,1: for i := 0 to FILT_COUNT-1 do BW_arr[i] := FILT_SSB_BW[i]; + 3,4: for i := 0 to FILT_COUNT-1 do BW_arr[i] := FILT_CW_BW[i]; + 5: for i := 0 to FILT_COUNT-1 do BW_arr[i] := FILT_FM_BW[i]; + else for i := 0 to FILT_COUNT-1 do BW_arr[i] := FILT_AM_BW[i]; + end; + best := 0; dist := MaxInt; + for i := 0 to FILT_COUNT-1 do + if Abs(BW_arr[i] - FWebSyncInt) < dist then + begin + dist := Abs(BW_arr[i] - FWebSyncInt); + best := i; + end; + FFilter := best; + for j := 0 to FILT_COUNT-1 do StyleButton(BtnFilter[j], j = FFilter); + ApplyModeFilter; + FBandCache[FCurrentBand].FilterBW := FFilterBW; +end; + +procedure TMainForm.WebOnAGC(Mode: Integer); +begin + FWebSyncInt := Mode; + FWebSyncM := SyncWebAGC; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebAGC; +var i: Integer; +begin + if (FWebSyncInt < 0) or (FWebSyncInt > 4) then Exit; + FAGCMode := FWebSyncInt; + for i := 0 to 4 do StyleButton(BtnAGCMode[i], i = FAGCMode); + if FWDSPReady then + FDSPEngine.SetAGC(TWDSPAGCMode(FAGCMode), 50.0); + FBandCache[FCurrentBand].AGCMode := FAGCMode; +end; + +procedure TMainForm.WebOnAGCTop(DB: Integer); +begin + FWebSyncInt := DB; + FWebSyncM := SyncWebAGCTop; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebAGCTop; +begin + FAGCTop := Max(20, Min(120, FWebSyncInt)); + TrkAGC.Position := FAGCTop; + LblAGCTop.Caption := Format('%ddB', [FAGCTop]); + if FWDSPReady then + begin + FDSPEngine.SetAGCTop(FAGCTop); + FDSPEngine.SetAGC(TWDSPAGCMode(FAGCMode), 50.0); + end; + FBandCache[FCurrentBand].AGCTop := FAGCTop; +end; + +procedure TMainForm.WebOnBand(Idx: Integer); +begin + FWebSyncInt := Idx; + FWebSyncM := SyncWebBand; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebBand; +begin + if (FWebSyncInt < 0) or (FWebSyncInt >= BAND_COUNT) then Exit; + if FWebSyncInt = FCurrentBand then Exit; + if FDevConnected then begin SaveCurrentBand; FSettings.Save; end; + FCurrentBand := FWebSyncInt; + RestoreBand(FCurrentBand); +end; + +procedure TMainForm.WebOnSpan(Hz: Integer); +begin + FWebSyncInt := Hz; + FWebSyncM := SyncWebSpan; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebSpan; +var + ValidSpans: array[0..5] of Integer; + Found: Boolean; + i: Integer; + Btn: TFlatButton; +begin + ValidSpans[0]:=48000; ValidSpans[1]:=96000; ValidSpans[2]:=192000; + ValidSpans[3]:=384000; ValidSpans[4]:=768000; ValidSpans[5]:=1536000; + Found := False; + for i := 0 to 5 do + if ValidSpans[i] = FWebSyncInt then begin Found := True; Break; end; + if not Found then Exit; + if FWebSyncInt = FSampleRate then Exit; + Btn := nil; + if FWebSyncInt = 48000 then Btn := BtnSpan48k + else if FWebSyncInt = 96000 then Btn := BtnSpan96k + else if FWebSyncInt = 192000 then Btn := BtnSpan192k + else if FWebSyncInt = 384000 then Btn := BtnSpan384k + else if FWebSyncInt = 768000 then Btn := BtnSpan768k + else if FWebSyncInt = 1536000 then Btn := BtnSpan1536k; + if Assigned(Btn) then BtnSpanClick(Btn); +end; + +procedure TMainForm.WebOnVolume(V: Integer); +begin + FWebSyncInt := V; + FWebSyncM := SyncWebVolume; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebVolume; +begin + FVolume := Max(0, Min(100, FWebSyncInt)); + TrkVolume.Position := FVolume; + if FWDSPReady then FDSPEngine.SetVolume(FVolume / 100.0); +end; + +procedure TMainForm.WebOnWfAGC(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebWfAGC; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebWfAGC; +begin + FWfAGCEnabled := FWebSyncBool; + StyleButton(BtnWfAGC, FWfAGCEnabled); +end; + +procedure TMainForm.WebOnWfNF(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebWfNF; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebWfNF; +begin + FWfNFEnabled := FWebSyncBool; + StyleButton(BtnWfNF, FWfNFEnabled); +end; + +// ── Run ──────────────────────────────────────────────────────────────────── + +procedure TMainForm.WebOnRun(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebRun; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebRun; +begin + // Toggle only if state differs + if FWebSyncBool <> FRunning then + BtnStartStopClick(nil); +end; + +// ── Mute ─────────────────────────────────────────────────────────────────── + +procedure TMainForm.WebOnMute(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebMute; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebMute; +begin + if FWebSyncBool <> FMuted then + BtnMuteClick(nil); +end; + +// ── CTUN ────────────────────────────────────────────────────────────────── + +procedure TMainForm.WebOnCtun(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebCtun; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebCtun; +begin + if FWebSyncBool <> FCTun then + BtnCTunClick(nil); +end; + +// ── NR ──────────────────────────────────────────────────────────────────── + +procedure TMainForm.WebOnNR(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebNR; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebNR; +begin + if FWebSyncBool <> (BtnNR.Tag = 1) then + BtnNRClick(nil); +end; + +// ── NB ──────────────────────────────────────────────────────────────────── + +procedure TMainForm.WebOnNB(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebNB; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebNB; +begin + if FWebSyncBool <> (BtnNB.Tag = 1) then + BtnNBClick(nil); +end; + +// ── ANF ─────────────────────────────────────────────────────────────────── + +procedure TMainForm.WebOnANF(On_: Boolean); +begin + FWebSyncBool := On_; + FWebSyncM := SyncWebANF; + TThread.Synchronize(nil, FWebSyncM); +end; + +procedure TMainForm.SyncWebANF; +begin + if FWebSyncBool <> (BtnANF.Tag = 1) then + BtnANFClick(nil); +end; + +procedure TMainForm.TrkDriveChange(Sender: TObject); +begin + FDriveLevel := Round(TrkDrive.Position / 100.0 * 255); + if FWDSPReady then + FDSPEngine.SetDriveLevel(TrkDrive.Position / 100.0); +end; + +procedure TMainForm.TrkVolumeChange(Sender: TObject); +begin + FVolume := TrkVolume.Position; + if FWDSPReady then + FDSPEngine.SetVolume(FVolume / 100.0); +end; + +// =========================================================================== +// Mouse wheel — перестройка VFO +// =========================================================================== + +procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +// Колёсико на форме/спектре/водопаде — меняет VFO с квантованием +// Шаг зависит от модификаторов: Ctrl+Shift=1МГц, Ctrl=1кГц, Shift=10Гц, иначе 100Гц +// Квантование: результат выровнен до кратного шагу (как в FreqDisplay) +// CTUN логика: через ApplyVfoA +var + Step: Int64; + Delta: Int64; + Base: Int64; + NewFreq: Int64; +begin + if (ssCtrl in Shift) and (ssShift in Shift) then Step := 1000000 + else if ssCtrl in Shift then Step := 1000 + else if ssShift in Shift then Step := 10 + else Step := 100; + + Delta := 1; + if WheelDelta < 0 then Delta := -1; + + // Квантование (та же логика что в FreqDisplay.ChangeByDigit) + Base := (Round(FVfoA) div Step) * Step; + if Delta > 0 then + NewFreq := Base + Step + else + begin + if Round(FVfoA) = Base then + NewFreq := Base - Step + else + NewFreq := Base; // снэп к нижней границе + end; + + NewFreq := Max(30000, Min(60000000, NewFreq)); + ApplyVfoA(NewFreq); + + Handled := True; +end; + + +procedure TMainForm.BtnAGCModeClick(Sender: TObject); +const + AGCModes: array[0..4] of TWDSPAGCMode = ( + agcFast, agcMedium, agcSlow, agcLong, agcOff); +var + i, N: Integer; +begin + N := (Sender as TFlatButton).Tag; + FAGCMode := N; + for i := 0 to 4 do StyleButton(BtnAGCMode[i], i = N); + if FWDSPReady then + FDSPEngine.SetAGC(AGCModes[N], 50.0); + FBandCache[FCurrentBand].AGCMode := FAGCMode; +end; + +procedure TMainForm.TrkAGCChange(Sender: TObject); +begin + FAGCTop := TrkAGC.Position; + LblAGCTop.Caption := Format('%ddB', [FAGCTop]); + if FWDSPReady then + begin + FDSPEngine.SetAGCTop(FAGCTop); + FDSPEngine.SetAGC(TWDSPAGCMode(FAGCMode), 50.0); + end; + // Обновляем кэш диапазона + FBandCache[FCurrentBand].AGCTop := FAGCTop; + DrawSpectrum; + PbSpectrum.Invalidate; +end; + +// =========================================================================== +// DSP/Audio callbacks — вызываются из рабочих потоков +// =========================================================================== + +procedure TMainForm.OnAudioReady(const Left, Right: array of Single; + Count: Integer); +var + MonoBuf: array[0..1023] of Single; + i: Integer; +begin + if Assigned(FWebServer) and FWebServer.WebClientActive then + begin + for i := 0 to Count - 1 do + MonoBuf[i] := (Left[i] + Right[i]) * 0.5; + FWebServer.PushAudio(@MonoBuf[0], Count); + Exit; + end; + FAudioOut.Write(Left, Right, Count); +end; + +procedure TMainForm.OnSpectrumReady(const Pixels: array of Single; + Count: Integer); +var + i, N: Integer; +begin + // Храним RAW данные от WDSP (всегда 1024 точки). + // Интерполяция на ширину экрана делается в DrawSpectrum/DrawWaterfall. + // Вызывается из DSP-потока — Single-запись атомарна. + N := Min(Count, 1024); + for i := 0 to N - 1 do + FSpectrumBuf[i] := Pixels[i]; +end; + + +procedure TMainForm.AfterShowTick(Sender: TObject); +begin + // Вызывается один раз через 200 мс после старта формы + FAfterShowTimer.Enabled := False; + + // Открываем PortAudio — теперь FPC уже перехватывает сигналы + try + if not FAudioOut.Open then + StatusBar1.Panels[3].Text := 'Audio: ' + FAudioOut.LastError + else + StatusBar1.Panels[3].Text := 'Audio OK (PortAudio)'; + except + on E: Exception do + StatusBar1.Panels[3].Text := 'Audio: ' + E.Message; + end; +end; + + +end. diff --git a/README.md b/README.md index bb28c3a..92abdbb 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,2 @@ -# ewsdr +# EWSDR diff --git a/Settings.pas b/Settings.pas new file mode 100644 index 0000000..db38cab --- /dev/null +++ b/Settings.pas @@ -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. diff --git a/VfoOverlay.pas b/VfoOverlay.pas new file mode 100644 index 0000000..9913821 --- /dev/null +++ b/VfoOverlay.pas @@ -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. diff --git a/WDSP.pas b/WDSP.pas new file mode 100644 index 0000000..e39185c --- /dev/null +++ b/WDSP.pas @@ -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. diff --git a/WDSPEngine.pas b/WDSPEngine.pas new file mode 100644 index 0000000..f0c4453 --- /dev/null +++ b/WDSPEngine.pas @@ -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. diff --git a/WebPageHtml.pas b/WebPageHtml.pas new file mode 100644 index 0000000..9c9654f --- /dev/null +++ b/WebPageHtml.pas @@ -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 := + // ── : мета, шрифты, CSS ────────────────────────────────────────── + '' + + '' + + '' + + 'HPSDR Web Remote' + + '' + + '' + + '' + + + // ── : разметка панелей ──────────────────────────────────────────── + '
' + + + // Тулбар 1: громкость, AGC, режимы, DSP кнопки + '
' + + '🔊' + + '
70
' + + '|' + + '
RF90dB
' + + '|' + + '' + + '|' + + '
TX50
' + + '|' + + '
' + + '' + + '' + + '' + + '' + + '' + + '' + + '' + + '
' + + + // Тулбар 2: S-метр, VFO A/B, RX/TX, диапазон, CW + '
' + + '' + + '
' + + '' + + '
' + + '
' + + '' + + '' + + '' + + '
' + + '' + + '' + + '
' + + '
' + + '
' + + '' + + '' + + '' + + '' + + '' + + '
' + + '
' + + + // Спектр / частотная линейка / водопад / статусбар + '
' + + '
' + + '
' + + '
connecting...
' + + '
' + + + // ── '; +end; + +end. diff --git a/WebServer.pas b/WebServer.pas new file mode 100644 index 0000000..c3dce14 --- /dev/null +++ b/WebServer.pas @@ -0,0 +1,1131 @@ +unit WebServer; + +{ + WebServer.pas — HTTP + WebSocket сервер для удалённого управления трансивером. + + Архитектура (по образцу OpenWebRX): + ───────────────────────────────── + HTTP GET / → index.html (см. WebPageHtml) + HTTP GET /ws → Upgrade: WebSocket + WebSocket сессия: + • Сервер → клиент: + - каждые ~50 ms: бинарный фрейм типа 'S' + 1024×Float32 спектр + - каждые ~50 ms: бинарный фрейм типа 'W' + N×Float32 waterfall строка + - каждые ~100ms: бинарный фрейм типа 'A' + Opus-пакет (48kHz mono) + - каждые ~200ms: JSON-текст со state (freq, mode, smeter, …) + • Клиент → сервер: JSON-команды + "cmd":"freq","hz":14200000 + "cmd":"mode","mode":1 + "cmd":"filter","bw":2700 + "cmd":"agc","mode":1 + "cmd":"agctop","db":90 + "cmd":"band","idx":5 + "cmd":"span","hz":192000 + "cmd":"volume","v":70 + "cmd":"wfagc","on":true + "cmd":"wfnf","on":true + + Аудио: 48kHz mono Float32 → Opus (20ms frames, 32 kbps) + Спектр: 1024 Float32 dBm значений + Авторизация: Basic Auth через HTTP заголовок при первом запросе + + Зависимости: WebUtils, WsClient, WebPageHtml + RTL + libopus (динамическая загрузка) + Платформы: Windows + Linux (Winsock2 / BSD sockets) + + ИСПРАВЛЕНИЯ: + - (Windows build fix) SyncObjs перенесён в конец блока uses — устраняет + конфликт идентификатора Create с символами из WinSock2 в {$MODE Delphi}. + - (Windows runtime fix) Добавлены WSAStartup/WSACleanup в конструктор и + деструктор — без этого socket/bind/listen возвращают WSANOTINITIALISED. + - (Linux shutdown fix) В Stop: перед SockClose вызывается SockShutdown для + listen-сокета и для каждого клиентского сокета. На Linux закрытие + дескриптора не прерывает блокирующий fpAccept/fpRecv в чужом потоке — + только shutdown(SHUT_RDWR) гарантированно разблокирует их, позволяя + потокам выйти и WaitFor завершиться без зависания. +} + +{$IFDEF FPC} + {$MODE Delphi} + {$LONGSTRINGS ON} +{$ENDIF} + +interface + +uses + Classes, SysUtils, Math, + WebUtils, WsClient, WebPageHtml + {$IFDEF WINDOWS}, Windows, WinSock2{$ELSE}, BaseUnix, Sockets{$ENDIF}, + SyncObjs; // ← после платформенных юнитов: исключает конфликт идентификатора Create + +const + WEB_PORT = 8080; + OPUS_SAMPLE_RATE = 48000; + OPUS_FRAME_MS = 20; + OPUS_FRAME_SAMP = OPUS_SAMPLE_RATE * OPUS_FRAME_MS div 1000; // 960 samples + OPUS_BITRATE = 32000; + OPUS_CHANNELS = 1; + MAX_WS_CLIENTS = 4; + WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; + + // Типы бинарных фреймов (первый байт = тип) + WS_MSG_SPECTRUM = Byte(Ord('S')); // S + 1024×Float32 + WS_MSG_WATERFALL = Byte(Ord('W')); // W + N×Float32 + WS_MSG_AUDIO = Byte(Ord('A')); // A + Opus bytes + WS_MSG_AUDIO_PCM = Byte(Ord('P')); // P + N×Float32 (mono 48k) + WS_MSG_STATE = Byte(Ord('J')); // J + JSON text + +type + // ── Opus dynamic binding ────────────────────────────────────────────────── + POpusEncoder = Pointer; + + TOpus_encoder_create = function(Fs, channels, application: Integer; + error: PInteger): POpusEncoder; cdecl; + TOpus_encoder_destroy = procedure(st: POpusEncoder); cdecl; + TOpus_encode_float = function(st: POpusEncoder; + pcm: PSingle; frame_size: Integer; + data: PByte; max_data_bytes: Integer): Integer; cdecl; + TOpus_encoder_ctl_set = function(st: POpusEncoder; + request: Integer; value: Integer): Integer; cdecl; + + // ── Callbacks в MainForm ────────────────────────────────────────────────── + TWebCmdFreq = procedure(Hz: Double) of object; + TWebCmdMode = procedure(Mode: Integer) of object; + TWebCmdFilter = procedure(BW: Integer) of object; + TWebCmdAGC = procedure(Mode: Integer) of object; + TWebCmdAGCTop = procedure(DB: Integer) of object; + TWebCmdBand = procedure(Idx: Integer) of object; + TWebCmdSpan = procedure(Hz: Integer) of object; + TWebCmdVolume = procedure(V: Integer) of object; + TWebCmdWfAGC = procedure(On_: Boolean) of object; + TWebCmdWfNF = procedure(On_: Boolean) of object; + TWebCmdRun = procedure(On_: Boolean) of object; + TWebCmdMute = procedure(On_: Boolean) of object; + TWebCmdCtun = procedure(On_: Boolean) of object; + TWebCmdNR = procedure(On_: Boolean) of object; + TWebCmdNB = procedure(On_: Boolean) of object; + TWebCmdANF = procedure(On_: Boolean) of object; + + // ── Главный класс сервера ───────────────────────────────────────────────── + TWebServer = class + private + // ── Opus ── + FOpusLib: THandle; + FOpusEnc: POpusEncoder; + FOpusCreate: TOpus_encoder_create; + FOpusDestroy: TOpus_encoder_destroy; + FOpusEncode: TOpus_encode_float; + FOpusCtl: TOpus_encoder_ctl_set; + FOpusBuf: array[0..OPUS_FRAME_SAMP-1] of Single; + FOpusBufPos: Integer; + FOpusOut: array[0..3999] of Byte; + FOpusReady: Boolean; + + // ── TCP ── + FListenSock: TSocket; + FClients: array[0..MAX_WS_CLIENTS-1] of TWsClient; + FClientCount: Integer; + FClientLock: TCriticalSection; + + // ── Потоки ── + FAcceptThread: TThread; + FPushThread: TThread; + FRunning: Boolean; + + // ── Авторизация ── + FAuthToken: string; // Base64(user:pass) + + // ── Состояние (обновляется из MainForm) ── + FSpectrumBuf: array[0..1023] of Single; + FWfBuf: array[0..1023] of Single; + FWfCount: Integer; + FSMeter: Double; + FFreq: Double; + FMode: Integer; + FFilterBW: Integer; + FAGCMode: Integer; + FAGCTop: Integer; + FSpanHz: Double; + FVolume: Integer; + FWfAGC: Boolean; + FWfNF: Boolean; + FBandIdx: Integer; + FConnected: Boolean; + FTrxRunning: Boolean; + FMuted: Boolean; + FCtun: Boolean; + FNR: Boolean; + FNB: Boolean; + FANF: Boolean; + FCenterHz: Double; + FFilterIdx: Integer; + FStateLock: TCriticalSection; + + // ── Callbacks ── + FOnFreq: TWebCmdFreq; + FOnMode: TWebCmdMode; + FOnFilter: TWebCmdFilter; + FOnAGC: TWebCmdAGC; + FOnAGCTop: TWebCmdAGCTop; + FOnBand: TWebCmdBand; + FOnSpan: TWebCmdSpan; + FOnVolume: TWebCmdVolume; + FOnWfAGC: TWebCmdWfAGC; + FOnWfNF: TWebCmdWfNF; + FOnRun: TWebCmdRun; + FOnMute: TWebCmdMute; + FOnCtun: TWebCmdCtun; + FOnNR: TWebCmdNR; + FOnNB: TWebCmdNB; + FOnANF: TWebCmdANF; + + FWebClientActive: Boolean; + + // ── Внутренние методы ── + function LoadOpus: Boolean; + procedure UnloadOpus; + function InitListen: Boolean; + procedure AcceptLoop; + procedure PushLoop; + procedure HandleClient(Client: TWsClient); + procedure ProcessCommand(Client: TWsClient; const Json: string); + procedure BroadcastBinary(const Data; Len: Integer); + procedure BroadcastText(const S: string); + procedure RemoveClient(Client: TWsClient); + function BuildStateJson: string; + function CheckAuth(const Header: string): Boolean; + procedure SendHttp(Client: TWsClient; Code: Integer; const ContentType, Body: string); + // Stub-методы (реализация встроена в HandleClient) + procedure DoHandshake(Client: TWsClient); + procedure ProcessWsFrame(Client: TWsClient; const Data: array of Byte; Len: Integer; Opcode: Byte); + + public + constructor Create(const Username, Password: string); + destructor Destroy; override; + + function Start: Boolean; + procedure Stop; + + // Вызывается из DSP-потока (аудио, 48kHz mono) + procedure PushAudio(const Samples: PSingle; Count: Integer); + // Вызывается из таймера спектра (UI thread) + procedure PushSpectrum( + const Buf: array of Single; Count: Integer; + const WfBuf_: array of Single; + SMeter: Double; + Freq: Double; Mode, FilterBW, AGCMode, AGCTop: Integer; + SpanHz: Double; Volume: Integer; + WfAGC, WfNF: Boolean; BandIdx: Integer; + TrxConnected: Boolean; + TrxRunning, Muted, Ctun, NR, NB, ANF: Boolean; + CenterHz: Double; FilterIdx: Integer); + + property WebClientActive: Boolean read FWebClientActive; + + property OnFreq: TWebCmdFreq read FOnFreq write FOnFreq; + property OnMode: TWebCmdMode read FOnMode write FOnMode; + property OnFilter: TWebCmdFilter read FOnFilter write FOnFilter; + property OnAGC: TWebCmdAGC read FOnAGC write FOnAGC; + property OnAGCTop: TWebCmdAGCTop read FOnAGCTop write FOnAGCTop; + property OnBand: TWebCmdBand read FOnBand write FOnBand; + property OnSpan: TWebCmdSpan read FOnSpan write FOnSpan; + property OnVolume: TWebCmdVolume read FOnVolume write FOnVolume; + property OnWfAGC: TWebCmdWfAGC read FOnWfAGC write FOnWfAGC; + property OnWfNF: TWebCmdWfNF read FOnWfNF write FOnWfNF; + property OnRun: TWebCmdRun read FOnRun write FOnRun; + property OnMute: TWebCmdMute read FOnMute write FOnMute; + property OnCtun: TWebCmdCtun read FOnCtun write FOnCtun; + property OnNR: TWebCmdNR read FOnNR write FOnNR; + property OnNB: TWebCmdNB read FOnNB write FOnNB; + property OnANF: TWebCmdANF read FOnANF write FOnANF; + end; + +implementation + +{ ═══════════════════════════════════════════════════════════════════════════ + Внутренние классы потоков + ═══════════════════════════════════════════════════════════════════════════ } + +type + TAcceptThread = class(TThread) + private FServer: TWebServer; + protected procedure Execute; override; + public constructor Create(AServer: TWebServer); + end; + + TPushThread = class(TThread) + private FServer: TWebServer; + protected procedure Execute; override; + public constructor Create(AServer: TWebServer); + end; + + TClientThread = class(TThread) + private FServer: TWebServer; FClient: TWsClient; + protected procedure Execute; override; + public constructor Create(AServer: TWebServer; AClient: TWsClient); + end; + +constructor TAcceptThread.Create(AServer: TWebServer); +begin + inherited Create(True); + FServer := AServer; + FreeOnTerminate := False; +end; + +procedure TAcceptThread.Execute; +begin + FServer.AcceptLoop; +end; + +constructor TPushThread.Create(AServer: TWebServer); +begin + inherited Create(True); + FServer := AServer; + FreeOnTerminate := False; +end; + +procedure TPushThread.Execute; +begin + FServer.PushLoop; +end; + +constructor TClientThread.Create(AServer: TWebServer; AClient: TWsClient); +begin + inherited Create(True); + FServer := AServer; + FClient := AClient; + FreeOnTerminate := True; +end; + +procedure TClientThread.Execute; +begin + FServer.HandleClient(FClient); +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + TWebServer — конструктор / деструктор + ═══════════════════════════════════════════════════════════════════════════ } + +constructor TWebServer.Create(const Username, Password: string); +{$IFDEF WINDOWS} +var + WSAData: TWSAData; +{$ENDIF} +begin + {$IFDEF WINDOWS} + // Инициализация Winsock2 — обязательна перед любыми вызовами socket API + WSAStartup($0202, WSAData); + {$ENDIF} + inherited Create; + FAuthToken := Base64EncodeStr(Username + ':' + Password); + FListenSock := SOCK_INVALID; + FRunning := False; + FClientCount := 0; + FOpusReady := False; + FOpusBufPos := 0; + FWebClientActive := False; + FClientLock := TCriticalSection.Create; + FStateLock := TCriticalSection.Create; + // Начальные значения состояния + FFreq := 14200000; + FMode := 1; + FFilterBW:= 2700; + FAGCMode := 1; + FAGCTop := 90; + FSpanHz := 192000; + FVolume := 70; + FSMeter := -120; + FBandIdx := 5; +end; + +destructor TWebServer.Destroy; +begin + Stop; + FClientLock.Free; + FStateLock.Free; + inherited; + {$IFDEF WINDOWS} + // Освобождение ресурсов Winsock2 + WSACleanup; + {$ENDIF} +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Загрузка / выгрузка Opus + ═══════════════════════════════════════════════════════════════════════════ } + +function TWebServer.LoadOpus: Boolean; +const + {$IFDEF WINDOWS} LIBNAME = 'libopus-0.dll'; + {$ELSE} LIBNAME = 'libopus.so.0'; + {$ENDIF} +var Err: Integer; +begin + Result := False; + FOpusLib := LoadLibrary(LIBNAME); + if FOpusLib = 0 then Exit; + + FOpusCreate := TOpus_encoder_create( GetProcAddress(FOpusLib, 'opus_encoder_create')); + FOpusDestroy := TOpus_encoder_destroy(GetProcAddress(FOpusLib, 'opus_encoder_destroy')); + FOpusEncode := TOpus_encode_float( GetProcAddress(FOpusLib, 'opus_encode_float')); + FOpusCtl := TOpus_encoder_ctl_set(GetProcAddress(FOpusLib, 'opus_encoder_ctl')); + + if not Assigned(FOpusCreate) or not Assigned(FOpusEncode) then + begin + FreeLibrary(FOpusLib); FOpusLib := 0; Exit; + end; + + FOpusEnc := FOpusCreate(OPUS_SAMPLE_RATE, OPUS_CHANNELS, + 2101 {OPUS_APPLICATION_AUDIO}, @Err); + if (FOpusEnc = nil) or (Err <> 0) then + begin + FreeLibrary(FOpusLib); FOpusLib := 0; Exit; + end; + // OPUS_SET_BITRATE_REQUEST = 4002 + if Assigned(FOpusCtl) then + FOpusCtl(FOpusEnc, 4002, OPUS_BITRATE); + + FOpusBufPos := 0; + FOpusReady := True; + Result := True; +end; + +procedure TWebServer.UnloadOpus; +begin + if FOpusReady and Assigned(FOpusDestroy) and (FOpusEnc <> nil) then + FOpusDestroy(FOpusEnc); + FOpusEnc := nil; + FOpusReady := False; + if FOpusLib <> 0 then + begin + FreeLibrary(FOpusLib); + FOpusLib := 0; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Start / Stop + ═══════════════════════════════════════════════════════════════════════════ } + +function TWebServer.InitListen: Boolean; +var + Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; + One: Integer; +begin + Result := False; + {$IFDEF WINDOWS} + FListenSock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); + {$ELSE} + FListenSock := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP); + {$ENDIF} + if FListenSock = SOCK_INVALID then Exit; + + One := 1; + {$IFDEF WINDOWS} + setsockopt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One)); + FillChar(Addr, SizeOf(Addr), 0); + Addr.sin_family := AF_INET; + Addr.sin_port := htons(WEB_PORT); + Addr.sin_addr.S_addr := INADDR_ANY; + if bind(FListenSock, @Addr, SizeOf(Addr)) = SOCKET_ERROR then Exit; + if listen(FListenSock, 5) = SOCKET_ERROR then Exit; + {$ELSE} + fpSetSockOpt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One)); + FillChar(Addr, SizeOf(Addr), 0); + Addr.sin_family := AF_INET; + Addr.sin_port := htons(WEB_PORT); + Addr.sin_addr.s_addr := htonl(INADDR_ANY); + if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then Exit; + if fpListen(FListenSock, 5) <> 0 then Exit; + {$ENDIF} + Result := True; +end; + +function TWebServer.Start: Boolean; +begin + Result := False; + if FRunning then Exit; + if not LoadOpus then ; // Opus опционален — продолжаем без него + if not InitListen then Exit; + FRunning := True; + FAcceptThread := TAcceptThread.Create(Self); + TAcceptThread(FAcceptThread).Start; + FPushThread := TPushThread.Create(Self); + TPushThread(FPushThread).Start; + Result := True; +end; + +procedure TWebServer.Stop; +var i: Integer; +begin + if not FRunning then Exit; + FRunning := False; + + // ── Шаг 1: shutdown + close listen-сокета ──────────────────────────────── + // SockShutdown ОБЯЗАТЕЛЕН перед SockClose на Linux: закрытие дескриптора + // не прерывает fpAccept в AcceptThread — только shutdown разблокирует его. + // На Windows это тоже корректно (SD_BOTH). + if FListenSock <> SOCK_INVALID then + begin + SockShutdown(FListenSock); + SockClose(FListenSock); + FListenSock := SOCK_INVALID; + end; + + // ── Шаг 2: shutdown всех клиентских сокетов ────────────────────────────── + // Разблокирует все HandleClient, заблокированные в Client.Recv (fpRecv). + // FreeOnTerminate=True у TClientThread — они освободятся сами после выхода. + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if FClients[i] <> nil then + begin + FClients[i].State := wsClosed; + SockShutdown(FClients[i].Socket); // ← разблокирует fpRecv в клиентском потоке + end; + finally + FClientLock.Leave; + end; + + // ── Шаг 3: ждём завершения фоновых потоков ─────────────────────────────── + // После shutdown потоки получат ошибку из recv/accept и выйдут сами. + if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end; + if FPushThread <> nil then begin FPushThread.WaitFor; FreeAndNil(FPushThread); end; + + // ── Шаг 4: освобождаем клиентов ────────────────────────────────────────── + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do FreeAndNil(FClients[i]); + FClientCount := 0; + finally + FClientLock.Leave; + end; + + UnloadOpus; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Accept loop + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TWebServer.AcceptLoop; +var + CSock: TSocket; + Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; + ALen: {$IFDEF WINDOWS}Integer{$ELSE}TSockLen{$ENDIF}; + Client: TWsClient; + T: TClientThread; +begin + while FRunning do + begin + ALen := SizeOf(Addr); + {$IFDEF WINDOWS} + CSock := accept(FListenSock, @Addr, @ALen); + {$ELSE} + CSock := fpAccept(FListenSock, @Addr, @ALen); + {$ENDIF} + if CSock = SOCK_INVALID then + begin + if FRunning then Sleep(10); + Continue; + end; + if FClientCount >= MAX_WS_CLIENTS then + begin + SockClose(CSock); + Continue; + end; + Client := TWsClient.Create(CSock); + FClientLock.Enter; + try + FClients[FClientCount] := Client; + Inc(FClientCount); + finally + FClientLock.Leave; + end; + T := TClientThread.Create(Self, Client); + T.Start; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + HTTP / WebSocket обработчик клиента + ═══════════════════════════════════════════════════════════════════════════ } + +function TWebServer.CheckAuth(const Header: string): Boolean; +var + Pos_: Integer; + Token, HeaderLC: string; +begin + Result := False; + HeaderLC := LowerCase(Header); + Pos_ := System.Pos('authorization: basic ', HeaderLC); + if Pos_ = 0 then Exit; + Token := Copy(Header, Pos_ + 21, 200); + Pos_ := System.Pos(#13, Token); if Pos_ > 0 then Token := Copy(Token, 1, Pos_ - 1); + Pos_ := System.Pos(#10, Token); if Pos_ > 0 then Token := Copy(Token, 1, Pos_ - 1); + Token := Trim(Token); + Result := (Token = FAuthToken); +end; + +procedure TWebServer.SendHttp(Client: TWsClient; Code: Integer; + const ContentType, Body: string); +var + StatusText, Response: string; +begin + case Code of + 200: StatusText := 'OK'; + 401: StatusText := 'Unauthorized'; + 404: StatusText := 'Not Found'; + else StatusText := 'Error'; + end; + Response := Format('HTTP/1.1 %d %s'#13#10 + + 'Content-Type: %s'#13#10 + + 'Content-Length: %d'#13#10 + + 'Connection: close'#13#10 + + #13#10 + '%s', [Code, StatusText, ContentType, Length(Body), Body]); + Client.SendRaw(Response[1], Length(Response)); +end; + +procedure TWebServer.HandleClient(Client: TWsClient); +var + R, HeaderEnd: Integer; + Header, HeaderLC, Key, Path, AcceptKey: string; + Response: string; + WsHandled: Boolean; + IsWsRequest: Boolean; + // WS frame parsing + B0, B1: Byte; + Masked: Boolean; + PayLen: Integer; + Mask: array[0..3] of Byte; + Payload: array of Byte; + Opcode: Byte; + i, Need: Integer; + j: Integer; + P1, P2: Integer; + KPos, KEnd: Integer; + Consumed: Integer; + Raw: array[0..8191] of Byte; + RawLen: Integer; +begin + WsHandled := False; + RawLen := 0; + + // ── Фаза 1: чтение HTTP-запроса ────────────────────────────────────────── + Header := ''; + repeat + R := SockRecv(Client.Socket, @Raw[RawLen], SizeOf(Raw) - RawLen, 0); + if R <= 0 then begin Client.State := wsClosed; Break; end; + Inc(RawLen, R); + SetLength(Header, RawLen); + Move(Raw[0], Header[1], RawLen); + HeaderEnd := System.Pos(#13#10#13#10, Header); + until (HeaderEnd > 0) or (RawLen >= SizeOf(Raw)); + + if (Client.State = wsClosed) or (HeaderEnd = 0) then + begin + RemoveClient(Client); Exit; + end; + + Header := Copy(Header, 1, HeaderEnd + 3); + HeaderLC := LowerCase(Header); + + // Извлечь путь + Path := ''; + if System.Pos('GET /', Header) > 0 then + begin + P1 := System.Pos('GET ', Header) + 4; + P2 := System.Pos(' HTTP', Header); + if P2 > P1 then Path := Copy(Header, P1, P2 - P1); + end; + + IsWsRequest := (Path = '/ws') and (System.Pos('upgrade: websocket', HeaderLC) > 0); + + // Basic Auth (только для HTTP-страниц; WS handshake без авторизации) + if (not IsWsRequest) and (not CheckAuth(Header)) then + begin + Response := 'HTTP/1.1 401 Unauthorized'#13#10 + + 'WWW-Authenticate: Basic realm="HPSDR"'#13#10 + + 'Content-Length: 0'#13#10 + + 'Connection: close'#13#10#13#10; + Client.SendRaw(Response[1], Length(Response)); + RemoveClient(Client); Exit; + end; + + // WebSocket upgrade + if System.Pos('upgrade: websocket', HeaderLC) > 0 then + begin + KPos := System.Pos('sec-websocket-key: ', HeaderLC); + if KPos > 0 then + begin + Key := Copy(Header, KPos + 19, 100); + KEnd := System.Pos(#13, Key); + if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1); + Key := Trim(Key); + end; + AcceptKey := Base64EncodeBytes(SHA1(Key + WS_GUID), 20); + Response := 'HTTP/1.1 101 Switching Protocols'#13#10 + + 'Upgrade: websocket'#13#10 + + 'Connection: Upgrade'#13#10 + + 'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10; + Client.SendRaw(Response[1], Length(Response)); + Client.State := wsOpen; + + FStateLock.Enter; + FWebClientActive := True; + FStateLock.Leave; + + Client.SendText(BuildStateJson); + WsHandled := True; + end + else if Path = '/' then + begin + SendHttp(Client, 200, 'text/html; charset=utf-8', GetIndexHtml); + RemoveClient(Client); Exit; + end + else + begin + SendHttp(Client, 404, 'text/plain', 'Not Found'); + RemoveClient(Client); Exit; + end; + + if not WsHandled then begin RemoveClient(Client); Exit; end; + + // ── Фаза 2: цикл WebSocket-сообщений ───────────────────────────────────── + Client.BufLen := 0; + while FRunning and (Client.State = wsOpen) do + begin + R := Client.Recv; + if R <= 0 then Break; + + while Client.BufLen >= 2 do + begin + B0 := Client.BufData[0]; + B1 := Client.BufData[1]; + Opcode := B0 and $0F; + Masked := (B1 and $80) <> 0; + PayLen := B1 and $7F; + + Need := 2; + if PayLen = 126 then Inc(Need, 2) + else if PayLen = 127 then Inc(Need, 8); + if Masked then Inc(Need, 4); + + if Client.BufLen < Need then Break; + + i := 2; + if PayLen = 126 then + begin + PayLen := (Client.BufData[2] shl 8) or Client.BufData[3]; + Inc(i, 2); + end + else if PayLen = 127 then + begin + PayLen := (Client.BufData[6] shl 24) or (Client.BufData[7] shl 16) or + (Client.BufData[8] shl 8) or Client.BufData[9]; + Inc(i, 8); + end; + + if Client.BufLen < Need + PayLen then Break; + + if Masked then + begin + Mask[0] := Client.BufData[i]; Mask[1] := Client.BufData[i+1]; + Mask[2] := Client.BufData[i+2]; Mask[3] := Client.BufData[i+3]; + Inc(i, 4); + end; + + SetLength(Payload, PayLen); + if PayLen > 0 then + begin + Move(Client.BufData[i], Payload[0], PayLen); + if Masked then + for j := 0 to PayLen - 1 do + Payload[j] := Payload[j] xor Mask[j and 3]; + end; + + Consumed := i + PayLen; + if Client.BufLen > Consumed then + Move(Client.BufData[Consumed], Client.BufData[0], Client.BufLen - Consumed); + Client.BufLen := Client.BufLen - Consumed; + + case Opcode of + $01: // Text → команда + begin + SetLength(Header, PayLen); + if PayLen > 0 then Move(Payload[0], Header[1], PayLen); + ProcessCommand(Client, Header); + end; + $08: // Close + begin + Client.State := wsClosed; + Break; + end; + $09: // Ping → Pong + Client.SendWsFrame($0A, Payload[0], PayLen); + end; + end; + end; + + FStateLock.Enter; + FWebClientActive := (FClientCount > 1); + FStateLock.Leave; + + RemoveClient(Client); +end; + +procedure TWebServer.RemoveClient(Client: TWsClient); +var i, j: Integer; +begin + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if FClients[i] = Client then + begin + FClients[i].Free; + for j := i to FClientCount - 2 do FClients[j] := FClients[j+1]; + FClients[FClientCount-1] := nil; + Dec(FClientCount); + Break; + end; + FWebClientActive := False; + for i := 0 to FClientCount - 1 do + if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then + begin FWebClientActive := True; Break; end; + finally + FClientLock.Leave; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Обработка JSON-команд от браузера + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TWebServer.ProcessCommand(Client: TWsClient; const Json: string); +var + Cmd: string; + HzF: Double; + HzI, ModeValue, BW, DB, Idx, V: Integer; + On_: Boolean; +begin + Cmd := JsonGetStr(Json, 'cmd'); + + if Cmd = 'freq' then + begin + HzF := JsonGetFloat(Json, 'hz', FFreq); + FStateLock.Enter; FFreq := HzF; FStateLock.Leave; + if Assigned(FOnFreq) then FOnFreq(HzF); + end + else if Cmd = 'mode' then + begin + ModeValue := JsonGetInt(Json, 'mode', FMode); + FStateLock.Enter; FMode := ModeValue; FStateLock.Leave; + if Assigned(FOnMode) then FOnMode(ModeValue); + end + else if Cmd = 'filter' then + begin + BW := JsonGetInt(Json, 'bw', FFilterBW); + FStateLock.Enter; FFilterBW := BW; FStateLock.Leave; + if Assigned(FOnFilter) then FOnFilter(BW); + end + else if Cmd = 'agc' then + begin + ModeValue := JsonGetInt(Json, 'mode', FAGCMode); + FStateLock.Enter; FAGCMode := ModeValue; FStateLock.Leave; + if Assigned(FOnAGC) then FOnAGC(ModeValue); + end + else if Cmd = 'agctop' then + begin + DB := JsonGetInt(Json, 'db', FAGCTop); + FStateLock.Enter; FAGCTop := DB; FStateLock.Leave; + if Assigned(FOnAGCTop) then FOnAGCTop(DB); + end + else if Cmd = 'band' then + begin + Idx := JsonGetInt(Json, 'idx', FBandIdx); + FStateLock.Enter; FBandIdx := Idx; FStateLock.Leave; + if Assigned(FOnBand) then FOnBand(Idx); + end + else if Cmd = 'span' then + begin + HzI := JsonGetInt(Json, 'hz', Round(FSpanHz)); + FStateLock.Enter; FSpanHz := HzI; FStateLock.Leave; + if Assigned(FOnSpan) then FOnSpan(HzI); + end + else if Cmd = 'volume' then + begin + V := JsonGetInt(Json, 'v', FVolume); + FStateLock.Enter; FVolume := V; FStateLock.Leave; + if Assigned(FOnVolume) then FOnVolume(V); + end + else if Cmd = 'wfagc' then + begin + On_ := JsonGetBool(Json, 'on', FWfAGC); + FStateLock.Enter; FWfAGC := On_; FStateLock.Leave; + if Assigned(FOnWfAGC) then FOnWfAGC(On_); + end + else if Cmd = 'wfnf' then + begin + On_ := JsonGetBool(Json, 'on', FWfNF); + FStateLock.Enter; FWfNF := On_; FStateLock.Leave; + if Assigned(FOnWfNF) then FOnWfNF(On_); + end + else if Cmd = 'set_run' then + begin + On_ := JsonGetBool(Json, 'on', FTrxRunning); + FStateLock.Enter; FTrxRunning := On_; FStateLock.Leave; + if Assigned(FOnRun) then FOnRun(On_); + end + else if Cmd = 'set_mute' then + begin + On_ := JsonGetBool(Json, 'on', FMuted); + FStateLock.Enter; FMuted := On_; FStateLock.Leave; + if Assigned(FOnMute) then FOnMute(On_); + end + else if Cmd = 'set_ctun' then + begin + On_ := JsonGetBool(Json, 'on', FCtun); + FStateLock.Enter; FCtun := On_; FStateLock.Leave; + if Assigned(FOnCtun) then FOnCtun(On_); + end + else if Cmd = 'set_nr' then + begin + On_ := JsonGetBool(Json, 'on', FNR); + FStateLock.Enter; FNR := On_; FStateLock.Leave; + if Assigned(FOnNR) then FOnNR(On_); + end + else if Cmd = 'set_nb' then + begin + On_ := JsonGetBool(Json, 'on', FNB); + FStateLock.Enter; FNB := On_; FStateLock.Leave; + if Assigned(FOnNB) then FOnNB(On_); + end + else if Cmd = 'set_anf' then + begin + On_ := JsonGetBool(Json, 'on', FANF); + FStateLock.Enter; FANF := On_; FStateLock.Leave; + if Assigned(FOnANF) then FOnANF(On_); + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Push-цикл — рассылает спектр / водопад / состояние всем клиентам + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TWebServer.PushLoop; +var + Tick, StateLastTick: QWord; + SpecBuf: array[0..4096] of Byte; + WfBuf: array[0..4096] of Byte; + i: Integer; + HasClients: Boolean; +begin + StateLastTick := GetTickCount64; + while FRunning do + begin + Sleep(50); // 20 fps + Tick := GetTickCount64; + + FClientLock.Enter; + HasClients := FClientCount > 0; + FClientLock.Leave; + + if not HasClients then Continue; + + FStateLock.Enter; + try + SpecBuf[0] := WS_MSG_SPECTRUM; + for i := 0 to 1023 do + PSingle(Pointer(PByte(@SpecBuf[1]) + i*4))^ := FSpectrumBuf[i]; + + WfBuf[0] := WS_MSG_WATERFALL; + for i := 0 to 1023 do + PSingle(Pointer(PByte(@WfBuf[1]) + i*4))^ := FWfBuf[i]; + finally + FStateLock.Leave; + end; + + BroadcastBinary(SpecBuf[0], 1 + 1024*4); + BroadcastBinary(WfBuf[0], 1 + 1024*4); + + if Tick - StateLastTick >= 200 then + begin + StateLastTick := Tick; + BroadcastText(BuildStateJson); + end; + end; +end; + +procedure TWebServer.BroadcastBinary(const Data; Len: Integer); +var i: Integer; +begin + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then + FClients[i].SendBinary(Data, Len); + finally + FClientLock.Leave; + end; +end; + +procedure TWebServer.BroadcastText(const S: string); +var i: Integer; +begin + FClientLock.Enter; + try + for i := 0 to FClientCount - 1 do + if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then + FClients[i].SendText(S); + finally + FClientLock.Leave; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Формирование JSON-состояния + ═══════════════════════════════════════════════════════════════════════════ } + +function TWebServer.BuildStateJson: string; +const + MODE_N: array[0..7] of string = + ('LSB','USB','DSB','CWL','CWU','FM','AM','SAM'); +begin + FStateLock.Enter; + try + Result := Format( + '{"vfo_a_hz":%.0f,"mode":%d,"mode_name":"%s",' + + '"filter":%d,"filter_bw":%d,' + + '"agc_mode":%d,"agc_top":%d,' + + '"span_hz":%.0f,"center_hz":%.0f,"volume":%d,' + + '"wf_agc":%s,"wf_nf":%s,"band_idx":%d,"smeter_dbm":%.1f,' + + '"running":%s,"mute":%s,"ctun":%s,' + + '"nr":%s,"nb":%s,"anf":%s,"connected":%s}', + [FFreq, FMode, MODE_N[FMode mod 8], + FFilterIdx, FFilterBW, + FAGCMode, FAGCTop, + FSpanHz, FCenterHz, FVolume, + BoolToStr(FWfAGC, 'true', 'false'), + BoolToStr(FWfNF, 'true', 'false'), + FBandIdx, FSMeter, + BoolToStr(FTrxRunning, 'true', 'false'), + BoolToStr(FMuted, 'true', 'false'), + BoolToStr(FCtun, 'true', 'false'), + BoolToStr(FNR, 'true', 'false'), + BoolToStr(FNB, 'true', 'false'), + BoolToStr(FANF, 'true', 'false'), + BoolToStr(FConnected, 'true', 'false') + ]); + finally + FStateLock.Leave; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Аудио push (вызывается из DSP-потока) + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TWebServer.PushAudio(const Samples: PSingle; Count: Integer); +var + HasWs: Boolean; + i, n, Enc: Integer; + Pkt: array of Byte; +begin + if not FRunning then begin AudioLog('EXIT: FRunning=false'); Exit; end; + FClientLock.Enter; + HasWs := FClientCount > 0; + FClientLock.Leave; + if not HasWs then begin AudioLog('EXIT: FClientCount=0'); Exit; end; + if (Samples = nil) or (Count <= 0) then begin AudioLog('EXIT: Samples nil/Count=0'); Exit; end; + if not FOpusReady then begin AudioLog('EXIT: FOpusReady=false'); Exit; end; + + i := 0; + while i < Count do + begin + n := Count - i; + if n > OPUS_FRAME_SAMP - FOpusBufPos then + n := OPUS_FRAME_SAMP - FOpusBufPos; + Move(Samples[i], FOpusBuf[FOpusBufPos], n * SizeOf(Single)); + Inc(FOpusBufPos, n); + Inc(i, n); + if FOpusBufPos >= OPUS_FRAME_SAMP then + begin + Enc := FOpusEncode(FOpusEnc, @FOpusBuf[0], OPUS_FRAME_SAMP, + @FOpusOut[0], SizeOf(FOpusOut)); + if Enc > 0 then + begin + SetLength(Pkt, 1 + Enc); + Pkt[0] := WS_MSG_AUDIO; + Move(FOpusOut[0], Pkt[1], Enc); + BroadcastBinary(Pkt[0], Length(Pkt)); + AudioLog('SENT opus bytes=' + IntToStr(Enc) + ' clients=' + IntToStr(FClientCount)); + end + else + AudioLog('ENCODE FAILED Enc=' + IntToStr(Enc)); + FOpusBufPos := 0; + end; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Обновление состояния из MainForm (UI thread, из таймера спектра) + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TWebServer.PushSpectrum( + const Buf: array of Single; Count: Integer; + const WfBuf_: array of Single; + SMeter: Double; + Freq: Double; Mode, FilterBW, AGCMode, AGCTop: Integer; + SpanHz: Double; Volume: Integer; + WfAGC, WfNF: Boolean; BandIdx: Integer; + TrxConnected: Boolean; + TrxRunning, Muted, Ctun, NR, NB, ANF: Boolean; + CenterHz: Double; FilterIdx: Integer); +var N, i: Integer; +begin + if not FRunning then Exit; + N := Min(Count, 1024); + FStateLock.Enter; + try + for i := 0 to N-1 do FSpectrumBuf[i] := Buf[i]; + for i := 0 to Min(High(WfBuf_), 1023) do FWfBuf[i] := WfBuf_[i]; + FSMeter := SMeter; + FFreq := Freq; + FMode := Mode; + FFilterBW := FilterBW; + FAGCMode := AGCMode; + FAGCTop := AGCTop; + FSpanHz := SpanHz; + FVolume := Volume; + FWfAGC := WfAGC; + FWfNF := WfNF; + FBandIdx := BandIdx; + FConnected := TrxConnected; + FTrxRunning := TrxRunning; + FMuted := Muted; + FCtun := Ctun; + FNR := NR; + FNB := NB; + FANF := ANF; + FCenterHz := CenterHz; + FFilterIdx := FilterIdx; + finally + FStateLock.Leave; + end; +end; + +{ ═══════════════════════════════════════════════════════════════════════════ + Stub-методы (реализация встроена в HandleClient) + ═══════════════════════════════════════════════════════════════════════════ } + +procedure TWebServer.DoHandshake(Client: TWsClient); +begin + // Not used separately — handshake is in HandleClient +end; + +procedure TWebServer.ProcessWsFrame(Client: TWsClient; + const Data: array of Byte; Len: Integer; Opcode: Byte); +begin + // Not used separately — frame processing is inlined in HandleClient +end; + +end. diff --git a/WebUtils.pas b/WebUtils.pas new file mode 100644 index 0000000..d9111e6 --- /dev/null +++ b/WebUtils.pas @@ -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. diff --git a/WinFirewall.pas b/WinFirewall.pas new file mode 100644 index 0000000..0f14dd1 --- /dev/null +++ b/WinFirewall.pas @@ -0,0 +1,268 @@ +unit WinFirewall; + +{ + WinFirewall.pas — управление правилами Windows Firewall для HPSDR-приложения. + + Логика работы: + 1. Сначала пробуем добавить все недостающие правила через COM без elevation. + Если программа запущена с правами администратора — всё добавится сразу. + 2. Если COM не удался (нет прав) — собираем ВСЕ недостающие правила в одну + batch-команду и вызываем UAC elevation ОДИН РАЗ. + + Создаёт до 4 правил (каждое проверяется по имени, дубли не добавляются): + " UDP In" — входящий UDP (HPSDR Protocol 2) + " UDP Out" — исходящий UDP (HPSDR Protocol 2) + " TCP In" — входящий TCP (WebSocket/HTTP сервер) + " 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. diff --git a/WsClient.pas b/WsClient.pas new file mode 100644 index 0000000..aa5c46e --- /dev/null +++ b/WsClient.pas @@ -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. diff --git a/ewsdr.lpi b/ewsdr.lpi new file mode 100644 index 0000000..b950b1f --- /dev/null +++ b/ewsdr.lpi @@ -0,0 +1,95 @@ + + + + + + + + <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> diff --git a/ewsdr.lpr b/ewsdr.lpr new file mode 100644 index 0000000..cbebb4d --- /dev/null +++ b/ewsdr.lpr @@ -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. diff --git a/hpsdr_devices.ini b/hpsdr_devices.ini new file mode 100644 index 0000000..ec2535f --- /dev/null +++ b/hpsdr_devices.ini @@ -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 diff --git a/hpsdr_settings.json b/hpsdr_settings.json new file mode 100644 index 0000000..c3240dd --- /dev/null +++ b/hpsdr_settings.json @@ -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" : {} + } + } +} \ No newline at end of file diff --git a/project1.ico b/project1.ico new file mode 100644 index 0000000..86b1038 Binary files /dev/null and b/project1.ico differ