Delphi SDL2 sound generator

sdl_test.pas

unit sdl_test;

interface

uses
  System.Classes, System.Generics.Collections, System.Math,
  sdl2;

procedure main;

const
  AMPLITUDE = 28000;
  FREQUENCY = 44100;

type
  TBeepObject = record
    freq: Double;
    samplesLeft: Integer;
  end;

  TBeeper = class
  private
    v: Double;
    beeps: TQueue<TBeepObject>;
  public
    constructor Create;
    destructor Destroy; override;

    procedure beep(freq: Double; duration: Integer);
    procedure generateSamples(stream: PSmallInt; length: Integer);
    procedure wait;
  end;

implementation

procedure audio_callback(Abeeper: TBeeper; AStream: PByte;
  ALength: Integer); cdecl;
begin
  // Sint16 *stream = (Sint16*) _stream;
  // int length = _length / 2;

  Abeeper.generateSamples(PSmallInt(AStream), ALength div 2);
end;

procedure main;
const
  duration = 400;
  Hz = 425;
var
  beeper: TBeeper;
  i: Integer;
begin
  SDL_Init(SDL_INIT_AUDIO);

  beeper := TBeeper.Create();
  try
    for i := 0 to 5 do
    begin
      beeper.beep(Hz, duration);
      beeper.wait();
      beeper.beep(0, duration);
      beeper.wait();
    end;
  finally
    beeper.Free;
  end;
end;

{ TBeeper }

procedure TBeeper.beep(freq: Double; duration: Integer);
var
  bo: TBeepObject;
begin
  bo.freq := freq;
  bo.samplesLeft := duration * FREQUENCY div 1000;

  SDL_LockAudio();
  try
    beeps.Enqueue(bo);
  finally
    SDL_UnlockAudio();
  end;
end;

constructor TBeeper.Create;
var
  desiredSpec, obtainedSpec: TSDL_AudioSpec;
begin
  beeps := TQueue<TBeepObject>.Create;

  desiredSpec.freq := FREQUENCY;
  desiredSpec.format := AUDIO_S16;
  desiredSpec.channels := 1;
  desiredSpec.samples := 2048;
  desiredSpec.callback := @audio_callback;
  desiredSpec.userdata := self;

  // you might want to look for errors here
  SDL_OpenAudio(@desiredSpec, @obtainedSpec);

  // start play audio
  SDL_PauseAudio(0);
end;

destructor TBeeper.Destroy;
begin
  SDL_CloseAudio();
  beeps.Free;
  inherited;
end;

procedure TBeeper.generateSamples(stream: PSmallInt; length: Integer);
var
  i, samplesToDo: Integer;
  bo: TBeepObject;
begin
  i := 0;
  while (i < length) do
  begin
    if (beeps.Count = 0) then
    begin
      while (i < length) do
      begin
        // PSmallInt(NativeUInt(stream) + i * SizeOf(SmallInt))^ := 0;
        stream^ := 0;
        Inc(stream);
        Inc(i);
      end;
      exit;
    end;

    bo := beeps.Dequeue();

    samplesToDo := min(i + bo.samplesLeft, length);
    bo.samplesLeft := bo.samplesLeft - (samplesToDo - i);

    while (i < samplesToDo) do
    begin
      // PSmallInt(NativeUInt(stream) + i * SizeOf(SmallInt))^ := Trunc(AMPLITUDE * sin(v * 2 * pi / FREQUENCY));
      stream^ := Trunc(AMPLITUDE * sin(v * 2 * pi / FREQUENCY));
      Inc(stream);
      Inc(i);
      v := v + bo.freq;
    end;

    if (bo.samplesLeft > 0) then
      beeps.Enqueue(bo);

  end;
end;

procedure TBeeper.wait;
var
  size: Integer;
begin
  repeat
    SDL_Delay(20);

    SDL_LockAudio();
    try
      size := beeps.Count;
    finally
      SDL_UnlockAudio();
    end;
  until not(size > 0);
end;

end.