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: удаляет лишние сэмплы - output buffer size defaults to 128 frames (низкая латентность) } {$IFDEF FPC} {$MODE Delphi} {$PACKRECORDS C} {$ENDIF} interface uses Classes, SysUtils, Math, SyncObjs, DynLibs; const MY_AUDIO_BUFFER_SIZE = 128; // default 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; TPaDeviceInfo = record structVersion: Integer; name: PAnsiChar; hostApi: Integer; maxInputChannels: Integer; maxOutputChannels: Integer; defaultLowInputLatency: TPaTime; defaultLowOutputLatency: TPaTime; defaultHighInputLatency: TPaTime; defaultHighOutputLatency:TPaTime; defaultSampleRate: Double; end; PPaDeviceInfo = ^TPaDeviceInfo; TPa_Initialize = function: TPaError; cdecl; TPa_Terminate = function: TPaError; cdecl; TPa_GetDefaultOutputDevice = function: TPaDeviceIndex; cdecl; TPa_GetDeviceCount = function: TPaDeviceIndex; cdecl; TPa_GetDeviceInfo = function(device: TPaDeviceIndex): PPaDeviceInfo; 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; FOutputBufferSize: 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; FDeviceIndex: Integer; // -1 = default output device // PortAudio functions FPa_Initialize: TPa_Initialize; FPa_Terminate: TPa_Terminate; FPa_GetDefaultOutputDevice: TPa_GetDefaultOutputDevice; FPa_GetDeviceCount: TPa_GetDeviceCount; FPa_GetDeviceInfo: TPa_GetDeviceInfo; 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; procedure SetOutputBufferSize(V: Integer); public constructor Create(SampleRate: Integer = 48000); destructor Destroy; override; function Initialize: Boolean; // загружает PA, вызывает Pa_Initialize (без открытия стрима) function Open: Boolean; procedure Close; // Перечисление устройств вывода: заполняет Names списком имён. // Возвращает True если PA инициализирована и устройства доступны. // Indices[i] — индекс PA устройства для Names[i]. function EnumOutputDevices(Names: TStrings; out Indices: array of Integer; out Count: Integer): Boolean; // Найти индекс устройства по имени (-1 если не найдено) function FindDeviceByName(const AName: string): Integer; // Пишем стерео double сэмплы — как audio_write() в оригинале procedure WriteDouble(Left, Right: Double); // Convenience: массив Single procedure Write(const Left, Right: array of Single; Count: Integer); procedure Clear; property IsOpen: Boolean read FOpen; property LastError: string read GetLastError; property DeviceIndex: Integer read FDeviceIndex write FDeviceIndex; property SampleRate: Integer read FSampleRate write FSampleRate; property OutputBufferSize: Integer read FOutputBufferSize write SetOutputBufferSize; end; // Глобальный callback (cdecl, не метод) function PaOutCallback(inputBuffer, outputBuffer: Pointer; framesPerBuffer: LongWord; timeInfo: Pointer; statusFlags: LongWord; userData: Pointer): LongInt; cdecl; implementation const {$IFDEF DARWIN} PA_LIBS: array[0..3] of AnsiString = ( 'libportaudio.dylib', 'libportaudio.2.dylib', '/usr/local/lib/libportaudio.dylib', '/opt/homebrew/lib/libportaudio.dylib' ); {$ELSE} {$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..5] of AnsiString = ( 'portaudio_x64.dll', 'portaudio_x86.dll', 'portaudio.dll', 'libportaudio-2.dll', 'libportaudio.dll', 'libportaudio64.dll' ); {$ENDIF} {$ENDIF} PA_NO_ERROR = 0; PA_FLOAT32 = LongWord(1); PA_NO_FLAG = LongWord(0); PA_CONTINUE = LongInt(0); PA_NO_DEV = TPaDeviceIndex(-1); // Callback modeled after pa_out_cb from piHPSDR/portaudio.c 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; FOutputBufferSize := MY_AUDIO_BUFFER_SIZE; FDeviceIndex := -1; // -1 = default output device 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 {$IFDEF WINDOWS} FLastError := 'PortAudio DLL not found. Put portaudio_x64.dll, portaudio.dll, or libportaudio-2.dll next to ewsdr.exe'; {$ELSE} {$IFDEF DARWIN} FLastError := 'libportaudio not found. Install via: brew install portaudio'; {$ELSE} FLastError := 'libportaudio not found. sudo apt install libportaudio2'; {$ENDIF} {$ENDIF} 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_GetDeviceCount := TPa_GetDeviceCount(GetProcAddress(FLibHandle, 'Pa_GetDeviceCount')); FPa_GetDeviceInfo := TPa_GetDeviceInfo(GetProcAddress(FLibHandle, 'Pa_GetDeviceInfo')); 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_Terminate) or not Assigned(FPa_GetDefaultOutputDevice) or not Assigned(FPa_GetDeviceCount) or not Assigned(FPa_GetDeviceInfo) or not Assigned(FPa_OpenStream) or not Assigned(FPa_StartStream) or not Assigned(FPa_StopStream) or not Assigned(FPa_CloseStream) or not Assigned(FPa_GetErrorText) then begin FLastError := 'libportaudio: symbols not found'; FreeLibrary(FLibHandle); FLibHandle := NilHandle; Exit; end; Result := True; end; // --------------------------------------------------------------------------- // Initialize — загружает PA библиотеку и вызывает Pa_Initialize без открытия стрима. // Нужно для перечисления устройств в настройках до старта аудио. // --------------------------------------------------------------------------- function TAudioOutput.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; // --------------------------------------------------------------------------- // EnumOutputDevices — перечисляет устройства вывода. // Names получает имена устройств; Indices — соответствующие PA-индексы; // Count — реальное количество (может быть меньше Length(Indices)). // --------------------------------------------------------------------------- function TAudioOutput.EnumOutputDevices(Names: TStrings; out Indices: array of Integer; out Count: Integer): Boolean; var I, N: Integer; Info: PPaDeviceInfo; DevName: string; begin Count := 0; Result := False; if not Initialize then Exit; if not Assigned(FPa_GetDeviceCount) or not Assigned(FPa_GetDeviceInfo) then begin FLastError := 'PortAudio device enumeration is not available'; Exit; end; N := FPa_GetDeviceCount(); if N < 0 then begin FLastError := 'Pa_GetDeviceCount: '; if Assigned(FPa_GetErrorText) then FLastError := FLastError + string(FPa_GetErrorText(N)) else FLastError := FLastError + IntToStr(N); Exit; end; if N = 0 then begin FLastError := 'No PortAudio devices found'; Exit; end; for I := 0 to N - 1 do begin Info := FPa_GetDeviceInfo(I); if Info = nil then Continue; if Info^.maxOutputChannels <= 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 — возвращает PA device index по имени (-1 если не найден). // --------------------------------------------------------------------------- function TAudioOutput.FindDeviceByName(const AName: string): Integer; var I, N: Integer; Info: PPaDeviceInfo; 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^.maxOutputChannels <= 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 — точная последовательность как в audio_open_output() // --------------------------------------------------------------------------- function TAudioOutput.Open: Boolean; var OutParam: TPaStreamParameters; Err: TPaError; Dev: TPaDeviceIndex; Info: PPaDeviceInfo; begin Result := False; if FOpen then begin Result := True; Exit; end; if not Initialize then Exit; // загрузка PA + Pa_Initialize // Выбор устройства: FDeviceIndex или default if FDeviceIndex >= 0 then Dev := FDeviceIndex else begin Dev := FPa_GetDefaultOutputDevice(); end; if Dev = PA_NO_DEV then begin FLastError := 'No output device available'; 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 часто ломает WASAPI/MME; берём значение от устройства. Info := FPa_GetDeviceInfo(Dev); if (Info <> nil) and (Info^.defaultLowOutputLatency > 0.0) then OutParam.suggestedLatency := Info^.defaultLowOutputLatency else OutParam.suggestedLatency := 0.050; {$ELSE} OutParam.suggestedLatency := 0.0; // на Linux ALSA справляется с минимумом {$ENDIF} Err := FPa_OpenStream( @FStream, nil, // no input @OutParam, FSampleRate, FOutputBufferSize, 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.SetOutputBufferSize(V: Integer); begin if V <= 128 then V := 128 else if V <= 256 then V := 256 else V := 512; FOutputBufferSize := V; 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; procedure TAudioOutput.Clear; begin FMutex.Enter; try FInPt := 0; FOutPt := 0; FillChar(FBuf, SizeOf(FBuf), 0); finally FMutex.Leave; end; end; // WriteDouble — modeled after audio_write() from 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.