ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 20:37:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

add settingsForm

Browse Source
This commit is contained in:
ew8bak
2026-03-24 21:21:30 +03:00
parent a34d25bdba
commit 7664907b3e
2 changed files with 1539 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AudioInput.pas
+501
View File
@@ -0,0 +1,501 @@
unit AudioInput;
{
PortAudio input — TX microphone capture.
Modelled after piHPSDR/portaudio.c (DL1YCF), parallel to AudioOutput.pas.
Key features:
- Mono input stream, paFloat32, 48000 Hz (fixed, как в piHPSDR)
- Pa_Initialize called once in Initialize
- Ring buffer of MY_MIC_RING_SIZE single-channel Double samples
- Callback (PaInCallback) writes mic samples into the ring buffer
- ReadSample() returns next sample, 0.0 if buffer empty
- EnumInputDevices enumerates devices with maxInputChannels > 0
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, SyncObjs, DynLibs;
const
MY_MIC_BUFFER_SIZE = 128; // PA frames per callback
MY_MIC_RING_SIZE = 9600; // ring buffer size (mono), как в piHPSDR
type
TPaError = LongInt;
TPaDeviceIndex = LongInt;
TPaTime = Double;
TPaStream = Pointer;
PPaStream = ^TPaStream;
TPaMicStreamParameters = record
device: TPaDeviceIndex;
channelCount: LongInt;
sampleFormat: LongWord;
suggestedLatency: TPaTime;
hostApiSpecificStreamInfo: Pointer;
end;
PPaMicStreamParameters = ^TPaMicStreamParameters;
TPaMicDeviceInfo = record
structVersion: Integer;
name: PAnsiChar;
hostApi: Integer;
maxInputChannels: Integer;
maxOutputChannels: Integer;
defaultLowInputLatency: TPaTime;
defaultLowOutputLatency: TPaTime;
defaultHighInputLatency: TPaTime;
defaultHighOutputLatency: TPaTime;
defaultSampleRate: Double;
end;
PPaMicDeviceInfo = ^TPaMicDeviceInfo;
TPaMicStreamCallback = function(inputBuffer, outputBuffer: Pointer;
framesPerBuffer: LongWord;
timeInfo: Pointer;
statusFlags: LongWord;
userData: Pointer): LongInt; cdecl;
TPaMic_Initialize = function: TPaError; cdecl;
TPaMic_Terminate = function: TPaError; cdecl;
TPaMic_GetDeviceCount = function: TPaDeviceIndex; cdecl;
TPaMic_GetDeviceInfo = function(device: TPaDeviceIndex): PPaMicDeviceInfo; cdecl;
TPaMic_OpenStream = function(stream: PPaStream;
inputParam: PPaMicStreamParameters;
outputParam: PPaMicStreamParameters;
sampleRate: Double;
framesPerBuffer: LongWord;
streamFlags: LongWord;
callback: TPaMicStreamCallback;
userData: Pointer): TPaError; cdecl;
TPaMic_StartStream = function(stream: TPaStream): TPaError; cdecl;
TPaMic_StopStream = function(stream: TPaStream): TPaError; cdecl;
TPaMic_CloseStream = function(stream: TPaStream): TPaError; cdecl;
TPaMic_GetErrorText = function(err: TPaError): PAnsiChar; cdecl;
{ TAudioInput }
TAudioInput = class
private
FLibHandle: TLibHandle;
FStream: TPaStream;
FSampleRate: Integer;
FOpen: Boolean;
FPAInited: Boolean;
FLastError: string;
FDeviceIndex: Integer; // -1 = нет устройства (не открывается без явного выбора)
// Ring buffer (mono double), как в piHPSDR
FBuf: array[0..MY_MIC_RING_SIZE - 1] of Double;
FInPt: Integer; // write pointer (callback writes)
FOutPt: Integer; // read pointer (main thread reads via ReadSample)
FMutex: TCriticalSection;
// PortAudio functions
FPa_Initialize: TPaMic_Initialize;
FPa_Terminate: TPaMic_Terminate;
FPa_GetDeviceCount: TPaMic_GetDeviceCount;
FPa_GetDeviceInfo: TPaMic_GetDeviceInfo;
FPa_OpenStream: TPaMic_OpenStream;
FPa_StartStream: TPaMic_StartStream;
FPa_StopStream: TPaMic_StopStream;
FPa_CloseStream: TPaMic_CloseStream;
FPa_GetErrorText: TPaMic_GetErrorText;
function LoadLib: Boolean;
function GetLastError: string;
public
constructor Create(SampleRate: Integer = 48000);
destructor Destroy; override;
// Загружает PA и вызывает Pa_Initialize (без открытия стрима)
function Initialize: Boolean;
// Открывает input stream для выбранного устройства
function Open: Boolean;
procedure Close;
// Перечисляет устройства ввода (maxInputChannels > 0).
// Names[i] — имя, Indices[i] — PA device index, Count — реальное кол-во.
function EnumInputDevices(Names: TStrings; out Indices: array of Integer;
out Count: Integer): Boolean;
// Найти PA device index по имени (-1 если не найдено)
function FindDeviceByName(const AName: string): Integer;
// Читает следующий моно-сэмпл из кольцевого буфера.
// Возвращает 0.0 если буфер пуст.
function ReadSample: Double;
property IsOpen: Boolean read FOpen;
property LastError: string read GetLastError;
property DeviceIndex: Integer read FDeviceIndex write FDeviceIndex;
property SampleRate: Integer read FSampleRate write FSampleRate;
end;
// Глобальный PA callback для input (cdecl, не метод)
function PaInCallback(inputBuffer, outputBuffer: Pointer;
framesPerBuffer: LongWord;
timeInfo: Pointer;
statusFlags: LongWord;
userData: Pointer): LongInt; cdecl;
implementation
const
{$IFDEF UNIX}
PA_IN_LIBS: array[0..3] of AnsiString = (
'libportaudio.so.2',
'libportaudio.so',
'libportaudio.so.2.0.0',
'libportaudio.so.0'
);
{$ELSE}
PA_IN_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);
// ---------------------------------------------------------------------------
// Callback — читает моно float32 из inputBuffer, пишет в кольцевой буфер.
// Точно по образцу pa_in_cb из piHPSDR/portaudio.c
// ---------------------------------------------------------------------------
function PaInCallback(inputBuffer, outputBuffer: Pointer;
framesPerBuffer: LongWord;
timeInfo: Pointer;
statusFlags: LongWord;
userData: Pointer): LongInt; cdecl;
var
Audio: TAudioInput;
In_: PSingle;
i: LongWord;
newpt: Integer;
begin
Audio := TAudioInput(userData);
In_ := PSingle(inputBuffer);
if In_ = nil then
begin
Result := PA_CONTINUE;
Exit;
end;
// Lock-free: callback только пишет FInPt, читает FOutPt.
// ReadSample только читает FInPt, пишет FOutPt — каждый указатель пишет один поток.
newpt := Audio.FInPt;
for i := 0 to framesPerBuffer - 1 do
begin
// Проверяем переполнение: если буфер полон — новый сэмпл отбрасывается
if (newpt + 1) mod MY_MIC_RING_SIZE <> Audio.FOutPt then
begin
Audio.FBuf[newpt] := In_^;
Inc(newpt);
if newpt >= MY_MIC_RING_SIZE then newpt := 0;
end;
Inc(In_);
end;
Audio.FInPt := newpt;
Result := PA_CONTINUE;
end;
// ---------------------------------------------------------------------------
constructor TAudioInput.Create(SampleRate: Integer);
begin
inherited Create;
FSampleRate := SampleRate;
FDeviceIndex := -1;
FOpen := False;
FPAInited := False;
FStream := nil;
FLibHandle := NilHandle;
FLastError := '';
FInPt := 0;
FOutPt := 0;
FillChar(FBuf, SizeOf(FBuf), 0);
FMutex := TCriticalSection.Create;
end;
destructor TAudioInput.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 TAudioInput.GetLastError: string;
begin
Result := FLastError;
end;
function TAudioInput.LoadLib: Boolean;
var
i: Integer;
begin
Result := False;
if FLibHandle <> NilHandle then begin Result := True; Exit; end;
for i := 0 to High(PA_IN_LIBS) do
begin
FLibHandle := LoadLibrary(PA_IN_LIBS[i]);
if FLibHandle <> NilHandle then Break;
end;
if FLibHandle = NilHandle then
begin
FLastError := 'libportaudio not found';
Exit;
end;
FPa_Initialize := TPaMic_Initialize (GetProcAddress(FLibHandle, 'Pa_Initialize'));
FPa_Terminate := TPaMic_Terminate (GetProcAddress(FLibHandle, 'Pa_Terminate'));
FPa_GetDeviceCount := TPaMic_GetDeviceCount(GetProcAddress(FLibHandle, 'Pa_GetDeviceCount'));
FPa_GetDeviceInfo := TPaMic_GetDeviceInfo (GetProcAddress(FLibHandle, 'Pa_GetDeviceInfo'));
FPa_OpenStream := TPaMic_OpenStream (GetProcAddress(FLibHandle, 'Pa_OpenStream'));
FPa_StartStream := TPaMic_StartStream (GetProcAddress(FLibHandle, 'Pa_StartStream'));
FPa_StopStream := TPaMic_StopStream (GetProcAddress(FLibHandle, 'Pa_StopStream'));
FPa_CloseStream := TPaMic_CloseStream (GetProcAddress(FLibHandle, 'Pa_CloseStream'));
FPa_GetErrorText := TPaMic_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;
// ---------------------------------------------------------------------------
// Initialize
// ---------------------------------------------------------------------------
function TAudioInput.Initialize: Boolean;
var
Err: TPaError;
begin
Result := False;
if not LoadLib then Exit;
if FPAInited then begin Result := True; Exit; end;
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;
Result := True;
end;
// ---------------------------------------------------------------------------
// EnumInputDevices
// ---------------------------------------------------------------------------
function TAudioInput.EnumInputDevices(Names: TStrings;
out Indices: array of Integer; out Count: Integer): Boolean;
var
I, N: Integer;
Info: PPaMicDeviceInfo;
DevName: string;
begin
Count := 0;
Result := False;
if not Initialize then Exit;
if not Assigned(FPa_GetDeviceCount) or not Assigned(FPa_GetDeviceInfo) then Exit;
N := FPa_GetDeviceCount();
if N <= 0 then Exit;
for I := 0 to N - 1 do
begin
Info := FPa_GetDeviceInfo(I);
if Info = nil then Continue;
if Info^.maxInputChannels <= 0 then Continue;
if Count >= Length(Indices) then Break;
if Info^.name <> nil then
DevName := string(AnsiString(Info^.name))
else
DevName := Format('Device %d', [I]);
Names.Add(DevName);
Indices[Count] := I;
Inc(Count);
end;
Result := Count > 0;
end;
// ---------------------------------------------------------------------------
// FindDeviceByName
// ---------------------------------------------------------------------------
function TAudioInput.FindDeviceByName(const AName: string): Integer;
var
I, N: Integer;
Info: PPaMicDeviceInfo;
DevName: string;
begin
Result := -1;
if AName = '' then Exit;
if not Initialize then Exit;
if not Assigned(FPa_GetDeviceCount) or not Assigned(FPa_GetDeviceInfo) then Exit;
N := FPa_GetDeviceCount();
for I := 0 to N - 1 do
begin
Info := FPa_GetDeviceInfo(I);
if Info = nil then Continue;
if Info^.maxInputChannels <= 0 then Continue;
if Info^.name <> nil then
DevName := string(AnsiString(Info^.name))
else
DevName := Format('Device %d', [I]);
if SameText(DevName, AName) then
begin
Result := I;
Exit;
end;
end;
end;
// ---------------------------------------------------------------------------
// Open — открывает input stream, как audio_open_input в piHPSDR
// ---------------------------------------------------------------------------
function TAudioInput.Open: Boolean;
var
InParam: TPaMicStreamParameters;
Err: TPaError;
Info: PPaMicDeviceInfo;
begin
Result := False;
if FOpen then begin Result := True; Exit; end;
if FDeviceIndex < 0 then
begin
FLastError := 'No input device selected';
Exit;
end;
if not Initialize then Exit;
FillChar(InParam, SizeOf(InParam), 0);
InParam.channelCount := 1; // Mono, как в piHPSDR
InParam.device := FDeviceIndex;
InParam.sampleFormat := PA_FLOAT32;
// suggestedLatency = defaultLowInputLatency устройства (как в piHPSDR)
Info := FPa_GetDeviceInfo(FDeviceIndex);
if Info <> nil then
InParam.suggestedLatency := Info^.defaultLowInputLatency
else
InParam.suggestedLatency := 0.0;
InParam.hostApiSpecificStreamInfo := nil;
Err := FPa_OpenStream(@FStream, @InParam, nil,
FSampleRate, MY_MIC_BUFFER_SIZE,
PA_NO_FLAG, PaInCallback, Self);
if Err <> PA_NO_ERROR then
begin
FLastError := 'Pa_OpenStream (in): ';
if Assigned(FPa_GetErrorText) then
FLastError := FLastError + string(FPa_GetErrorText(Err))
else
FLastError := FLastError + IntToStr(Err);
FStream := nil;
Exit;
end;
// Сбрасываем буфер перед стартом
FInPt := 0;
FOutPt := 0;
FillChar(FBuf, SizeOf(FBuf), 0);
Err := FPa_StartStream(FStream);
if Err <> PA_NO_ERROR then
begin
FLastError := 'Pa_StartStream (in): ';
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;
FLastError := '';
Result := True;
end;
// ---------------------------------------------------------------------------
// Close — как audio_close_input в piHPSDR
// ---------------------------------------------------------------------------
procedure TAudioInput.Close;
var Err: TPaError;
begin
if not FOpen then Exit;
if FStream <> nil then
begin
Err := FPa_StopStream(FStream);
if (Err <> PA_NO_ERROR) and Assigned(FPa_GetErrorText) then
FLastError := 'Pa_StopStream (in): ' + string(FPa_GetErrorText(Err));
Err := FPa_CloseStream(FStream);
if (Err <> PA_NO_ERROR) and Assigned(FPa_GetErrorText) then
FLastError := 'Pa_CloseStream (in): ' + string(FPa_GetErrorText(Err));
FStream := nil;
end;
FOpen := False;
end;
// ---------------------------------------------------------------------------
// ReadSample — как audio_get_next_mic_sample в piHPSDR
// ---------------------------------------------------------------------------
function TAudioInput.ReadSample: Double;
var newpt: Integer;
begin
// Lock-free: читает FOutPt, читает FInPt
if FOutPt = FInPt then
begin
Result := 0.0; // буфер пуст — тишина
Exit;
end;
Result := FBuf[FOutPt];
newpt := FOutPt + 1;
if newpt >= MY_MIC_RING_SIZE then newpt := 0;
FOutPt := newpt;
end;
end.
SettingsForm.pas
+1038
View File
File diff suppressed because it is too large Load Diff