ewsdr/AudioOutput.pas

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}
const
  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.