2
\$\begingroup\$

I have developed an audio recording and playback base device in Free Pascal. This device is built on Free Pascal's TThread class and utilizes the low-level audio API provided by SDL2, distinct from the higher-level mixer API.

Audio Components (recording and playback) should be within external classes, facilitating composition. It supports the operation of a single recording thread and an optional playback thread, allowing serial recordings (and playback if needed). So, the implementation assumes approximately 4-second recordings and its respective playback in each recording session.

The TAudioDevice.Execute method acts as the central control point. It waits indefinitely for triggers from either StartRecording or StartPlayback PRTLEvent events, and subsequently emits notifications through RecordingFinished or PlaybackFinished events, depending on the operation in progress.

This device was designed to record and save participants speaking single words, but may be expended to record multiple words (in a serial fashion, with different visual components for each recording session, by adding loading functionality).

I have hard coded indexes for SDL audio devices for now. It assumes that the machine have at least one recording device and on playback device. Better device management is possible, but not a need right now.

I would appreciate feedback on the following aspects:

  • Code structure and organization.
  • Error handling and exception management, especially regarding threads.
  • Resource management and cleanup.
  • Any potential performance bottlenecks or improvements.
  • Suggestions for code optimization and clarity.
unit sdl.app.audio.recorder.devices;

{$mode objfpc}{$H+}

interface

uses
  Classes, SDL2, ctypes, fgl, fpwavwriter;

type


  TDevices = specialize TFPGMap<PAnsiChar, PSDL_AudioSpec>;

  { TAudioDevice }

  TAudioDevice = class (TThread)
  strict private
    FMsg: string;
    FStarter : TObject;
    FRTLEventMainThread : PRTLEvent;
    procedure BufferFinished;
    procedure PrintMessage;
    function GetAudioSpec: TSDL_AudioSpec;
    function GetOpened: Boolean;
  protected
    FDesiredAudioSpec: TSDL_AudioSpec;
    FAudioSpec: TSDL_AudioSpec;
    FDeviceId: TSDL_AudioDeviceID;
    FDevices : TDevices;
    function BytesPerSample : cint;
    function FileSize : cint;
    procedure Execute; override;
    procedure ListDevices(AIsCapture : cint; ADevices: TDevices);
    procedure StartDevice(AStarter : TObject);
    procedure DeviceFinished(Sender: TObject); virtual; abstract;
  public
    constructor Create;
    destructor Destroy; override;
    function Open: Boolean; virtual; abstract;
    procedure Close; virtual;
    procedure Log(const AMsg: string; AppendLineEnd: boolean = true);
    property AudioSpec: TSDL_AudioSpec read GetAudioSpec;
    property DeviceId: TSDL_AudioDeviceID read FDeviceId;
    property Opened : Boolean read GetOpened;
    property Starter : TObject read FStarter;
    property Msg : string read FMsg write FMsg;
  end;

  { TAudioRecorderComponent }

  TAudioRecorderComponent = class sealed (TAudioDevice)
  private
    FOnRecordingFinished: TNotifyEvent;
    procedure SetOnRecordingFinished(AValue: TNotifyEvent);
  protected
    procedure DeviceFinished(Sender: TObject); override;
  public
    function CanRecord : Boolean;
    function HasRecording : Boolean;
    function Open: Boolean; override;
    procedure Close; override;
    procedure SaveToFile(AFilename : string); overload;
    procedure StartRecording(AStarter : TObject);
    property OnRecordingFinished : TNotifyEvent read FOnRecordingFinished write SetOnRecordingFinished;
  end;

  { TAudioPlaybackComponent }

  TAudioPlaybackComponent = class sealed (TAudioDevice)
  private
    FOnPlaybackFinished: TNotifyEvent;
    procedure SetOnPlaybackFinished(AValue: TNotifyEvent);
  protected
    procedure DeviceFinished(Sender: TObject); override;
  public
    function Open: Boolean; override;
    procedure StartPlayback(AStarter : TObject);
    property OnPlaybackFinished : TNotifyEvent read FOnPlaybackFinished write SetOnPlaybackFinished;
  end;

implementation

uses SysUtils, sdl.app.output, fpwavformat
  //, sdl.app.stimulus.contract
  , session.loggers.writerow
  , session.pool;

const
  MAX_RECORDING_SECONDS = 4;
  RECORDING_BUFFER_SECONDS = MAX_RECORDING_SECONDS + 1;


var
  GPRecordingBuffer: PUInt8 = nil;
  GBufferByteSize: Uint32;
  GBufferBytePosition: Uint32;
  GBufferByteMaxPosition: Uint32;
  ACriticalSection : TRTLCriticalSection;

procedure TAudioDevice.Execute;
  function DoWork : Boolean;
  begin
    while not Terminated do begin
      SDL_LockAudioDevice(FDeviceId);
      if (GBufferBytePosition > GBufferByteMaxPosition) then begin
        SDL_PauseAudioDevice(FDeviceId, 1);
        SDL_UnlockAudioDevice(FDeviceId);
        Break
      end;
      SDL_UnlockAudioDevice(FDeviceId);
      Log(GBufferBytePosition.ToString);
    end;
    EnterCriticalSection(ACriticalSection);
    Synchronize(@BufferFinished);
    LeaveCriticalSection(ACriticalSection);
  end;
begin
  NameThreadForDebugging(ClassName);
  FRTLEventMainThread := RTLEventCreate;
  while not Terminated do begin
    Log(ClassName+': Waiting for main ...');
    RTLEventWaitFor(FRTLEventMainThread);
    Log(ClassName+': Working ...');
    SDL_PauseAudioDevice(FDeviceId, 0);
    DoWork;
  end;
  Log(ClassName+': Terminated ...');
end;

procedure AudioRecorderCallback(AUserdata: Pointer;
  AStream: PUInt8; ALen: Integer); cdecl;
begin
  Move(AStream^, GPRecordingBuffer[GBufferBytePosition], ALen);
  Inc(GBufferBytePosition, ALen);
end;

procedure AudioPlaybackCallback(AUserdata: Pointer;
  AStream: PUInt8; ALen: Integer); cdecl;
begin
  Move(GPRecordingBuffer[GBufferBytePosition], AStream^, ALen);
  Inc(GBufferBytePosition, ALen);
end;

procedure TAudioDevice.ListDevices(AIsCapture : cint; ADevices: TDevices);
var
  LDeviceName: PAnsiChar;
  i: Integer;
  LRecordingDeviceCount: cint;
  //LString : string;
begin
  LRecordingDeviceCount := SDL_GetNumAudioDevices(AIsCapture);
  if LRecordingDeviceCount < 0 then begin
    raise
      Exception.Create(TAudioDevice.ClassName+'.Open error: No devices found.');
    Exit;
  end;
  for i := 0 to LRecordingDeviceCount-1 do begin
    LDeviceName := SDL_GetAudioDeviceName(i, AIsCapture);
    //LString := StrPas(LDeviceName);
    SDL_GetAudioDeviceSpec(i, AIsCapture, @FDesiredAudioSpec);
    FDesiredAudioSpec.format := AUDIO_S16SYS;
    FDesiredAudioSpec.freq:= 44100;
    FDesiredAudioSpec.samples := 1024;
    if AIsCapture = 1 then begin
      FDesiredAudioSpec.callback:=@AudioRecorderCallback;
    end else begin
      FDesiredAudioSpec.callback:=@AudioPlaybackCallback;
    end;
    ADevices[LDeviceName] := @FDesiredAudioSpec;
  end;
end;

constructor TAudioDevice.Create;
begin
  FDeviceId := 0;
  FillChar(FAudioSpec, SizeOf(FAudioSpec), 0);
  FillChar(FDesiredAudioSpec, SizeOf(FDesiredAudioSpec), 0);
  FDevices := TDevices.Create;
  FreeOnTerminate := True;
  inherited Create(False);
end;

destructor TAudioDevice.Destroy;
begin
  Close;
  FDevices.Free;
  RTLEventDestroy(FRTLEventMainThread);
  inherited Destroy;
end;

procedure TAudioDevice.Close;
begin
  if FDeviceId <> 0 then
  begin
    SDL_CloseAudioDevice(FDeviceId);
    FDeviceId := 0;
    FillChar(FAudioSpec, SizeOf(FAudioSpec), 0);
    FillChar(FDesiredAudioSpec, SizeOf(FDesiredAudioSpec), 0);
  end;
end;

procedure TAudioDevice.BufferFinished;
begin
  DeviceFinished(Self);
end;

procedure TAudioDevice.PrintMessage;
begin
  Print(Msg);
end;

procedure TAudioDevice.Log(const AMsg: string; AppendLineEnd: boolean);
var
  s: String;
begin
  EnterCriticalsection(ACriticalSection);
  s:=AMsg;
  if AppendLineEnd then
    s:=s+LineEnding;
  Msg:=s;
  Synchronize(@PrintMessage);
  LeaveCriticalsection(ACriticalSection);
end;

function TAudioDevice.GetAudioSpec: TSDL_AudioSpec;
begin
  Result := FAudioSpec
end;

function TAudioDevice.GetOpened: Boolean;
begin
  Result := FDeviceId <> 0;
end;

function TAudioDevice.BytesPerSample: cint;
begin
  Result := FAudioSpec.channels * (SDL_AUDIO_BITSIZE(FAudioSpec.format) div 8);
end;

function TAudioDevice.FileSize: cint; // kilobytes
begin
  with FAudioSpec do begin
    Result := RECORDING_BUFFER_SECONDS *
      freq * SDL_AUDIO_BITSIZE(format) div 8 div 1024;
    Print(Result.ToString);
  end;
end;

procedure TAudioDevice.StartDevice(AStarter: TObject);
begin
  GBufferBytePosition := 0;
  FStarter := AStarter;
  RTLEventSetEvent(FRTLEventMainThread);
end;

procedure TAudioRecorderComponent.SetOnRecordingFinished(AValue: TNotifyEvent);
begin
  if FOnRecordingFinished = AValue then Exit;
  FOnRecordingFinished := AValue;
end;

procedure TAudioRecorderComponent.DeviceFinished(Sender: TObject);
begin
  if Assigned(OnRecordingFinished) then
    OnRecordingFinished(Self);
end;

function TAudioRecorderComponent.CanRecord: Boolean;
begin
  Result := Opened and (GBufferBytePosition = 0);
end;

function TAudioRecorderComponent.HasRecording: Boolean;
  function EmptyRecording : Boolean;
  var
    i : integer = 0;
    Zeros : array of Byte = nil;
  begin
    Result := True;
    SetLength(Zeros, GBufferByteSize);
    FillChar(Zeros[0], GBufferByteSize, 0);
    while (i < GBufferByteMaxPosition) and Result do begin
      if not CompareMem(GPRecordingBuffer, @Zeros[0], GBufferByteSize) then
        Result := False;
      Inc(i, GBufferByteSize);
    end;
  end;
begin
  Result := not EmptyRecording;
end;

function TAudioRecorderComponent.Open: Boolean;
var
  LBytesPerSecond: cint;
begin
  ListDevices(1, FDevices);
  FDeviceId := SDL_OpenAudioDevice(FDevices.Keys[0], 1,
    FDevices.Data[0], @FAudioSpec, SDL_AUDIO_ALLOW_FREQUENCY_CHANGE);

  Print('Name:'+StrPas(FDevices.Keys[0]));
  Print('Channels:' + FAudioSpec.channels.ToString);
  Print('Format:' + FAudioSpec.format.ToHexString);
  Print('Samples:' + FAudioSpec.samples.ToString);
  Print('Sample Rate:' + FAudioSpec.freq.ToString);
  Result := FDeviceId <> 0;
  if not Result then begin
    raise
      Exception.Create(TAudioDevice.ClassName+'.Open error: '+SDL_GetError);
    Exit;
  end;

  LBytesPerSecond := FAudioSpec.freq * BytesPerSample;
  GBufferByteSize := RECORDING_BUFFER_SECONDS * LBytesPerSecond;
  GBufferByteMaxPosition := MAX_RECORDING_SECONDS * LBytesPerSecond;
  GetMem(GPRecordingBuffer, GBufferByteSize);
end;

procedure TAudioRecorderComponent.Close;
begin
  inherited Close;
  if Assigned(GPRecordingBuffer) then begin
    FreeMem(GPRecordingBuffer, GBufferByteSize);
    GPRecordingBuffer := nil;
  end;
end;

procedure TAudioRecorderComponent.SaveToFile(AFilename: string);
var
  LWavWriter : TWavWriter;
begin
  LWavWriter := TWavWriter.Create;
  try
    if LWavWriter.StoreToFile(aFileName+'.wav') then begin
      with LWavWriter, FAudioSpec do begin
        fmt.Channels         := channels;
        fmt.SampleRate       := freq;
        fmt.BitsPerSample    := 16;
        fmt.ByteRate         :=
          fmt.SampleRate * fmt.Channels * fmt.BitsPerSample div 8;
        fmt.BlockAlign       := fmt.Channels * fmt.BitsPerSample div 8;
      end;
      LWavWriter.WriteBuf(GPRecordingBuffer^, GBufferByteSize);
      LWavWriter.FlushHeader;
    end else begin
      Print('Error creating WAV file: ' + AFileName);
    end;
  finally
    LWavWriter.Free;
  end;
end;

procedure TAudioRecorderComponent.StartRecording(AStarter: TObject);
begin
  FillChar(GPRecordingBuffer^, GBufferByteSize, 0);
  inherited StartDevice(AStarter);
end;

procedure TAudioPlaybackComponent.SetOnPlaybackFinished(AValue: TNotifyEvent);
begin
  if FOnPlaybackFinished = AValue then Exit;
  FOnPlaybackFinished := AValue;
end;

procedure TAudioPlaybackComponent.DeviceFinished(Sender: TObject);
begin
  if Assigned(OnPlaybackFinished) then
    OnPlaybackFinished(Self);
end;

function TAudioPlaybackComponent.Open: Boolean;
begin
  ListDevices(0, FDevices);
  Print(StrPas(FDevices.Keys[0]));
  FDeviceId := SDL_OpenAudioDevice(FDevices.Keys[0], 0,
    FDevices.Data[0], @FAudioSpec, SDL_AUDIO_ALLOW_FREQUENCY_CHANGE);
  Result := FDeviceId <> 0;
  if Result then begin
    { do nothing }
  end else begin
    raise Exception.Create(TAudioDevice.ClassName+'.Open error: '+SDL_GetError);
  end;
end;

procedure TAudioPlaybackComponent.StartPlayback(AStarter: TObject);
begin
  inherited StartDevice(AStarter);
end;

initialization
  InitCriticalSection(ACriticalSection);

finalization
  DoneCriticalsection(ACriticalSection);


end.
Improve this question
\$\endgroup\$

0

Reset to default

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.