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.