ASSounds.pas

unit assounds;

{ **************************************************************************** }
{ Rejbrand AlgoSim sound manipulation library                                  }
{ Copyright © 2017 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  SysUtils, Windows, Types, Classes, MMSystem;

const
  TELEPHONY_SAMPLE_RATE = 8000;
  EXTRA_LOW_QUALITY_SAMPLE_RATE = 11025;
  VOICE_SAMPLE_RATE = 16000;
  LOW_QUALITY_SAMPLE_RATE = 22050;
  MEDIUM_QUALITY_SAMPLE_RATE = 32000;
  CD_QUALITY_SAMPLE_RATE = 44100;
  HIGH_QUALITY_SAMPLE_RATE = 48000;
  DVD_QUALITY_SAMPLE_RATE = 96000;

  SPEAKER_FRONT_LEFT = $1;
  SPEAKER_FRONT_RIGHT = $2;
  SPEAKER_FRONT_CENTER = $4;
  SPEAKER_LOW_FREQUENCY = $8;
  SPEAKER_BACK_LEFT = $10;
  SPEAKER_BACK_RIGHT = $20;
  SPEAKER_FRONT_LEFT_OF_CENTER = $40;
  SPEAKER_FRONT_RIGHT_OF_CENTER = $80;
  SPEAKER_BACK_CENTER = $100;
  SPEAKER_SIDE_LEFT = $200;
  SPEAKER_SIDE_RIGHT = $400;
  SPEAKER_TOP_CENTER = $800;
  SPEAKER_TOP_FRONT_LEFT = $1000;
  SPEAKER_TOP_FRONT_CENTER = $2000;
  SPEAKER_TOP_FRONT_RIGHT = $4000;
  SPEAKER_TOP_BACK_LEFT = $8000;
  SPEAKER_TOP_BACK_CENTER = $10000;
  SPEAKER_TOP_BACK_RIGHT = $20000;

  KSAUDIO_SPEAKER_MONO = SPEAKER_FRONT_CENTER;
  KSAUDIO_SPEAKER_STEREO = SPEAKER_FRONT_LEFT or SPEAKER_FRONT_RIGHT;
  KSAUDIO_SPEAKER_QUAD = SPEAKER_FRONT_LEFT or SPEAKER_FRONT_RIGHT or
    SPEAKER_BACK_LEFT or SPEAKER_BACK_RIGHT;
  KSAUDIO_SPEAKER_SURROUND = SPEAKER_FRONT_LEFT or SPEAKER_FRONT_RIGHT or
    SPEAKER_FRONT_CENTER or SPEAKER_BACK_CENTER;
  KSAUDIO_SPEAKER_5POINT1 = SPEAKER_FRONT_LEFT or SPEAKER_FRONT_RIGHT or
    SPEAKER_FRONT_CENTER or SPEAKER_LOW_FREQUENCY or SPEAKER_BACK_LEFT or
    SPEAKER_BACK_RIGHT;
  KSAUDIO_SPEAKER_7POINT1 = SPEAKER_FRONT_LEFT or SPEAKER_FRONT_RIGHT or
    SPEAKER_FRONT_CENTER or SPEAKER_LOW_FREQUENCY or SPEAKER_BACK_LEFT or
    SPEAKER_BACK_RIGHT or SPEAKER_FRONT_LEFT_OF_CENTER or
    SPEAKER_FRONT_RIGHT_OF_CENTER;
  KSAUDIO_SPEAKER_5POINT1_SURROUND = SPEAKER_FRONT_LEFT or SPEAKER_FRONT_RIGHT or
    SPEAKER_FRONT_CENTER or SPEAKER_LOW_FREQUENCY or SPEAKER_SIDE_LEFT or
    SPEAKER_SIDE_RIGHT;
  KSAUDIO_SPEAKER_7POINT1_SURROUND = SPEAKER_FRONT_LEFT or SPEAKER_FRONT_RIGHT or
    SPEAKER_FRONT_CENTER or SPEAKER_LOW_FREQUENCY or SPEAKER_BACK_LEFT or
    SPEAKER_BACK_RIGHT or SPEAKER_SIDE_LEFT or SPEAKER_SIDE_RIGHT;

type
  ESoundException = class(Exception);
  ESoundIOException = class(ESoundException);

  T8BitSample = Byte;
  T16BitSample = SmallInt;
  T24BitSample = packed record
    B1, B2, B3: Byte
  end;
  T32BitSample = Integer;

{$POINTERMATH ON}
  P8BitSample = ^T8BitSample;
  P16BitSample = ^T16BitSample;
  P24BitSample = ^T24BitSample;
  P32BitSample = ^T32BitSample;
{$POINTERMATH OFF}

  T8BitStereoSamples = packed record
    Left, Right: T8BitSample;
  end;
  T16BitStereoSamples = packed record
    Left, Right: T16BitSample;
  end;
  T24BitStereoSamples = packed record
    Left, Right: T24BitSample;
  end;
  T32BitStereoSamples = packed record
    Left, Right: T32BitSample;
  end;

{$POINTERMATH ON}
  P8BitStereoSamples = ^T8BitStereoSamples;
  P16BitStereoSamples = ^T16BitStereoSamples;
  P24BitStereoSamples = ^T24BitStereoSamples;
  P32BitStereoSamples = ^T32BitStereoSamples;
{$POINTERMATH OFF}

  TWaveFormatType = (wftAuto, wftBasic, wftExtensible);

  TSoundPlaybackEventType = (pevStart, pevPause, pevResume, pevStop, pevEnd);
  TSoundPlaybackEvent = procedure(APlayerID: NativeInt;
    EventType: TSoundPlaybackEventType) of object;

  PASSound = ^TASSound;
  TASSound = record
  strict private class var
    FOnPlaybackEvent: TSoundPlaybackEvent;
    FWave: HWAVEOUT;
    FWaveHeader: TWaveHdr;
    FCallbackWndClass: Word;
    FCallbackWindow: HWND;
    FBuffer: TASSound;
    class function CallbackWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
      lParam: LPARAM): LPARAM; static; stdcall;
    class procedure Cleanup; static;
    class function GetIsPlaying: Boolean; static; inline;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  private
    FSampleFrequency: Integer;
    FBitsPerSample: Integer;
    FChannelCount: Integer;
    FChannelMask: Cardinal;
    FData: TArray<Byte>;
    FPlayerID: NativeInt;
    FStartTime: Double;
    function GetData: PByte; inline;
    function GetDuration: Double; inline;
    procedure SetDuration(const Value: Double);
    function GetSampleLength: Integer; inline;
    procedure SetSampleLength(const Value: Integer);
    function GetDataLength: UInt64; inline;
    function GetBytesPerSample: Integer; inline;
    function SampleIndexFromTimestamp(const ATime: Double): Integer; inline;
    function ByteIndexFromTimestamp(const ATime: Double): Integer; inline;
    procedure SetBytesPerSample(const Value: Integer);
    procedure ConvertSample(ASource, ATarget: PByte; AFromWidth, AToWidth: Integer);
    procedure SetBitsPerSample(const Value: Integer);
    function GetMaxValue: Integer;
    function GetMaxFraction: Double;
    function GetIsSilent: Boolean;
    function GetPosition: Double;
  public
    constructor CreateUsingTime(ASampleFrequency, ABytesPerSample, AChannelCount: Integer;
      AChannelMask: Cardinal; ADuration: Double; AInitialize: Boolean = True);
    constructor CreateUsingSamples(ASampleFrequency, ABytesPerSample, AChannelCount: Integer;
      AChannelMask: Cardinal; ASampleCount: Integer; AInitialize: Boolean = True);

    property SampleFrequency: Integer read FSampleFrequency;
    property BitsPerSample: Integer read FBitsPerSample write SetBitsPerSample;
    property BytesPerSample: Integer read GetBytesPerSample write SetBytesPerSample;
    property ChannelCount: Integer read FChannelCount;
    property ChannelMask: Cardinal read FChannelMask write FChannelMask;
    property Data: PByte read GetData;
    property Duration: Double read GetDuration write SetDuration;
    property SampleLength: Integer read GetSampleLength write SetSampleLength;
    property DataLength: UInt64 read GetDataLength;
    property MaxValue: Integer read GetMaxValue;
    property MaxFraction: Double read GetMaxFraction;
    property IsSilent: Boolean read GetIsSilent;
    property Position: Double read GetPosition;
    property PlayerID: NativeInt read FPlayerID write FPlayerID;

    function Clone: TASSound;
    procedure Clear;

    procedure Play(const AStartTime: Double = 0.0);
    procedure Pause;
    procedure Restart;
    class procedure Stop; static;
    class function WaitFor(ATimeout: Cardinal = INFINITE): Boolean; static;
    class property Playing: Boolean read GetIsPlaying;
    class property OnPlaybackEvent: TSoundPlaybackEvent read FOnPlaybackEvent write FOnPlaybackEvent;

    class operator Add(const Left, Right: TASSound): TASSound;
    class operator Subtract(const Left, Right: TASSound): TASSound;
    class operator Multiply(const Left, Right: TASSound): TASSound;
    class operator Multiply(const Left: Double; const Right: TASSound): TASSound;
    class operator Equal(const Left, Right: TASSound): Boolean;
    class operator NotEqual(const Left, Right: TASSound): Boolean;

    procedure SaveToFile(const AFileName: TFileName;
      AWaveFormatType: TWaveFormatType = wftAuto);

    procedure CopyToClipboard;

    /// <summary>Appends a sound to the end of the current sound.</summary>
    /// <param name="ASound">The sound to append to the end of the current
    ///  sound.</param>
    /// <remarks><c>ASound</c> must have the same sample rate, bit depth, channel
    ///  count, and channel mask as <c>Self</c>.</remarks>
    /// <exception cref="ESoundException">Raised if <c>Self</c> and <c>ASound</c>
    ///  have different sample rates, bit depths, channel counts, or channel
    ///  masks.</exception>
    procedure Append(const ASound: TASSound);

    /// <summary>Superposes a sound on the current sound.</summary>
    /// <param name="ASound">The sound to superpose on the current sound.</param>
    /// <param name="ABeginningAt">The time, in seconds, from the beginning of
    ///  <c>Self</c>, at which to start <c>ASound</c>. This value must be zero
    ///  or positive.</param>
    /// <param name="ACoeff1">The coefficient in front of the sample of
    ///  <c>Self</c> in the linear combination for the output sample.</param>
    /// <param name="ACoeff2">The coefficient in front of the sample of
    ///  <c>ASound</c> in the linear combination for the output sample.</param>
    /// <remarks><c>ASound</c> must have the same sample rate, bit depth, channel
    ///  count, and channel mask as <c>Self</c>. In addition, the bit depth must
    ///  be 8, 16, or 32. If <c>Self.Duration < ABeginningAt + ASound.Duration</c>,
    ///  <c>Self</c> is extended with silence at the end until <c>ASound</c>
    ///  fits completely within <c>Self</c> starting at <c>ABeginningAt</c>.
    ///  </remarks>
    /// <returns>A reference to <c>Self</c>.</returns>
    /// <exception cref="ESoundException">Raised if <c>Self</c> and <c>ASound</c>
    ///  have different sample rates, bit depths, channel counts, or channel
    ///  masks; also raised if <c>Self</c>'s bit depth isn't 8, 16, or 32.
    ///  Finally, this is raised if <c>ABeginningAt</c> is negative.</exception>
    function Superpose(const ASound: TASSound; const ABeginningAt: Double = 0;
      const ACoeff1: Double = 0.5; const ACoeff2: Double = 0.5): TASSound;

    /// <summary>Produces the reversed version of the sound.</summary>
    /// <returns>The reversed version of the sound.</returns>
    /// <remarks>The original sound isn't altered by this method.</remarks>
    function Reverse: TASSound;

    /// <summary>Produces a version of the sound with echo.</summary>
    /// <param name="ADelay">The delay, in seconds, between the original sound
    ///  and its echo. This value must be zero or positive.</param>
    /// <param name="AIntensity">The intensity of the echo. This value must lie
    ///  within [0, 1]. A general sample of the result is a convex combination
    ///  of the original sound's sample and the echo's sample; this parameter is
    ///  the coefficient of the echo in that convex combination. Consequently,
    ///  if this value is zero, only the original sound is heard. If this value
    ///  is one, only the echo is heard. If this value is 0.5, the original
    ///  sound and the echo have the same intensity.</param>
    /// <returns>A version of the sound with echo. The duration of the result
    ///  equals <c>Self.Duration + ADelay</c>.</returns>
    /// <exception cref="ESoundException">Raised if the delay is negative, if
    ///  the intensity is negative or greater than one, or if the sample rate
    ///  has a value different from 8, 16, and 32.</exception>
    /// <remarks>The original sound isn't altered by this method.</remarks>
    function Echo(const ADelay: Double = 0.4; const AIntensity: Double = 0.4): TASSound;

    /// <summary>Scales each sample of the sound by a given factor.</summary>
    /// <param name="AFactor">The factor to scale each sample by. This value
    ///  must lie within [0, 1].</param>
    /// <exception cref="ESoundException">Raised if <c>AFactor</c> is negative
    ///  or greater than one. Also raised if the bit depth isn't 8, 16, or 32.
    ///  </exception>
    /// <returns>A reference to <c>Self</c>.</returns>
    function ScaleAmplitude(const AFactor: Double): TASSound;

    /// <summary>Extracts, as a single-channel sound, a specified channel of the
    ///  sound.</summary>
    /// <param name="AChannelIndex">The zero-based index of the channel to
    ///  extract. This value must lie within [0, <c>Self.ChannelCount - 1</c>].
    ///  </param>
    /// <returns>The specified channel of <c>Self</c>, as a single-channel sound.
    ///  </returns>
    /// <exception cref="ESoundException">Raised if <c>AChannelIndex</c> is
    ///  negative or greater than or equal to <c>Self.ChannelCount</c>.
    ///  </exception>
    /// <remarks>The original sound isn't altered by this method.</remarks>
    function ExtractChannel(const AChannelIndex: Integer): TASSound;

    /// <summary>Returns a version of the sound with a specified bit depth.
    ///  </summary>
    /// <param name="ABitsPerSample">The number of bits per sample of the result.
    ///  </param>
    /// <exception cref="ESoundException">Raised if <c>Self.BitsPerSample</c> is
    ///  different from <c>ABitsPerSample</c> and either value is different from
    ///  8, 16, and 32.</exception>
    /// <remarks>The original sound isn't altered by this method.</remarks>
    function ConvertTo(const ABitsPerSample: Integer): TASSound;
  end;

function SineTone(const AFreq, AAmplitude, ADuration: Double;
  ABitsPerSample: Integer = 32;
  ASampleFrequency: Integer = HIGH_QUALITY_SAMPLE_RATE): TASSound;

function WhiteNoise(const AAmplitude, ADuration: Double;
  ASampleFrequency: Integer = HIGH_QUALITY_SAMPLE_RATE): TASSound;

function MultichannelSound(const ASounds: array of TASSound;
  AChannelMask: Cardinal): TASSound;

function FadeSound(const ASound1, ASound2: TASSound;
  const ADuration: Double = 1): TASSound;

type
  TWaveFunction = reference to function(const t: Double): Double;

function GenerateSound(AWaveFunction: TWaveFunction;
  const AAmplitude, AFromTime, AToTime: Double;
  ASampleFrequency: Integer = HIGH_QUALITY_SAMPLE_RATE): TASSound;

function LoadSoundFromStream(AStream: TStream; const AFileName: string = ''): TASSound;
procedure WriteSoundToStream(const ASound: TASSound; AStream: TStream;
  AWaveFormatType: TWaveFormatType = wftAuto);

function LoadSoundFromFile(const AFileName: TFileName): TASSound;
procedure SaveSoundToFile(const ASound: TASSound; const AFileName: TFileName;
  AWaveFormatType: TWaveFormatType = wftAuto);

implementation

uses
  Math, Clipbrd;

type
  PWaveFormatExtensible = ^TWaveFormatExtensible;
  TWaveFormatExtensible = record
    Format: TWaveFormatEx;
    Samples: record
      case Integer of
        0: (wValidBitsPerSample: Word);
        1: (wSamplesPerBlock: Word);
        2: (wReserved: Word)
      end;
    dwChannelMask: DWORD;
    SubFormat: TGUID;
  end;

const
  WAVE_FORMAT_EXTENSIBLE = $FFFE;

  KSDATAFORMAT_SUBTYPE_ANALOG: TGUID = '{6dba3190-67bd-11cf-a0f7-0020afd156e4}';
  KSDATAFORMAT_SUBTYPE_PCM: TGUID = '{00000001-0000-0010-8000-00aa00389b71}';
  KSDATAFORMAT_SUBTYPE_IEEE_FLOAT: TGUID = '{00000003-0000-0010-8000-00aa00389b71}';
  KSDATAFORMAT_SUBTYPE_DRM: TGUID = '{00000009-0000-0010-8000-00aa00389b71}';
  KSDATAFORMAT_SUBTYPE_ALAW: TGUID = '{00000006-0000-0010-8000-00aa00389b71}';
  KSDATAFORMAT_SUBTYPE_MULAW: TGUID = '{00000007-0000-0010-8000-00aa00389b71}';
  KSDATAFORMAT_SUBTYPE_ADPCM: TGUID = '{00000002-0000-0010-8000-00aa00389b71}';
  KSDATAFORMAT_SUBTYPE_MPEG: TGUID = '{00000050-0000-0010-8000-00aa00389b71}';

{ TASSound }

class constructor TASSound.ClassCreate;
const
  WndClassName = 'ASSoundMsgWndClass';
  WndName = 'ASSoundMsgWnd';
var
  wc: TWndClass;
begin
  FillChar(wc, sizeof(wc), 0);
  wc.lpfnWndProc := @CallbackWndProc;
  wc.hInstance := HInstance;
  wc.lpszClassName := WndClassName;
  FCallbackWndClass := Windows.RegisterClass(wc);
  if FCallbackWndClass <> 0 then
    FCallbackWindow := CreateWindow(WndClassName, WndName, 0, 0, 0, 0, 0, HWND_MESSAGE, 0,
      HInstance, nil);
end;

class destructor TASSound.ClassDestroy;
begin
  Stop;
  if FCallbackWindow <> 0 then
    DestroyWindow(FCallbackWindow);
end;

class function TASSound.CallbackWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LPARAM;
begin
  Result := 0;
  case uMsg of
    MM_WOM_OPEN: ;
    MM_WOM_CLOSE: ;
    MM_WOM_DONE:
      begin
        Cleanup;
        if Assigned(FOnPlaybackEvent) then
          FOnPlaybackEvent(NativeInt(PWaveHdr(lParam).dwUser), pevStop);
      end;
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

class function TASSound.GetIsPlaying: Boolean;
begin
  Result := FWave <> 0;
end;

procedure TASSound.Pause;
var
  MMres: MMRESULT;
begin

  if FWave = 0 then
    Exit;

  MMres := waveOutPause(FWave);

  case MMres of
    MMSYSERR_NOERROR: ;
    MMSYSERR_INVALHANDLE:
      raise ESoundException.Create('Couldn''t pause audio playback: Specified device handle is invalid.');
    MMSYSERR_NODRIVER:
      raise ESoundException.Create('Couldn''t pause audio playback: No device driver is present.');
    MMSYSERR_NOMEM:
      raise ESoundException.Create('Couldn''t pause audio playback: Unable to allocate or lock memory.');
    MMSYSERR_NOTSUPPORTED:
      raise ESoundException.Create('Couldn''t pause audio playback: Specified device is synchronous and does not support pausing.');
    else
      raise ESoundException.Create('Couldn''t pause audio playback: Unknown error.');
  end;

  if Assigned(FOnPlaybackEvent) then
    FOnPlaybackEvent(FPlayerID, pevPause);

end;

procedure TASSound.Play(const AStartTime: Double);
var
  WaveFormat: TWaveFormatEx;
  MMres: MMRESULT;
  Offset: Integer;
begin

  if FData = nil then
    raise ESoundException.Create('No audio data.');

  if FCallbackWindow = 0 then
    raise ESoundException.Create('No callback window.');

  if AStartTime >= Duration then
    Exit;

  if Playing then
    raise ESoundException.Create('An audio stream is already playing.');

  FStartTime := AStartTime;

  FBuffer := Self.Clone;

  WaveFormat.wFormatTag := WAVE_FORMAT_PCM;
  WaveFormat.nChannels := FBuffer.ChannelCount;
  WaveFormat.nSamplesPerSec := FBuffer.SampleFrequency;
  WaveFormat.nAvgBytesPerSec := FBuffer.ChannelCount * FBuffer.BytesPerSample * FBuffer.SampleFrequency;
  WaveFormat.nBlockAlign := FBuffer.ChannelCount * FBuffer.BytesPerSample;
  WaveFormat.wBitsPerSample := FBuffer.BitsPerSample;
  WaveFormat.cbSize := 0;

  Offset := FBuffer.ByteIndexFromTimestamp(AStartTime);
  if Offset >= Length(FData) then
    Exit;

  MMres := waveOutOpen(@FWave, WAVE_MAPPER, @WaveFormat, FCallbackWindow, 0,
    CALLBACK_WINDOW);

  if MMres <> MMSYSERR_NOERROR then
    FWave := 0;

  case MMres of
    MMSYSERR_NOERROR: ;
    MMSYSERR_ALLOCATED:
      raise ESoundException.Create('Couldn''t open sound device: Specified resource is already allocated.');
    MMSYSERR_BADDEVICEID:
      raise ESoundException.Create('Couldn''t open sound device: Specified device identifier is out of range.');
    MMSYSERR_NODRIVER:
      raise ESoundException.Create('Couldn''t open sound device: No device driver is present.');
    MMSYSERR_NOMEM:
      raise ESoundException.Create('Couldn''t open sound device: Unable to allocate or lock memory.');
    WAVERR_BADFORMAT:
      raise ESoundException.Create('Couldn''t open sound device: Unsupported waveform audio format.');
    WAVERR_SYNC:
      raise ESoundException.Create('Couldn''t open sound device: Device is synchronous.');
    else
      raise ESoundException.Create('Couldn''t open sound device: Unknown error.');
  end;

  try

    FillChar(FWaveHeader, sizeof(FWaveHeader), 0);
    FWaveHeader.lpData := PAnsiChar(FBuffer.FData) + Offset;
    FWaveHeader.dwBufferLength := Length(FBuffer.FData) - Offset;
    FWaveHeader.dwUser := NativeUInt(FPlayerID);

    MMres := waveOutPrepareHeader(FWave, @FWaveHeader, sizeof(FWaveHeader));

    case MMres of
      MMSYSERR_NOERROR: ;
      MMSYSERR_INVALHANDLE:
        raise ESoundException.Create('Couldn''t prepare wave header: Specified device handle is invalid.');
      MMSYSERR_NODRIVER:
        raise ESoundException.Create('Couldn''t prepare wave header: No device driver is present.');
      MMSYSERR_NOMEM:
        raise ESoundException.Create('Couldn''t prepare wave header: Unable to allocate or lock memory.');
      else
        raise ESoundException.Create('Couldn''t prepare wave header: Unknown error.');
    end;

    try

      MMres := waveOutWrite(FWave, @FWaveHeader, sizeof(FWaveHeader));

      case MMres of
        MMSYSERR_NOERROR: ;
        MMSYSERR_INVALHANDLE:
          raise ESoundException.Create('Couldn''t send wave data: Specified device handle is invalid.');
        MMSYSERR_NODRIVER:
          raise ESoundException.Create('Couldn''t send wave data: No device driver is present.');
        MMSYSERR_NOMEM:
          raise ESoundException.Create('Couldn''t send wave data: Unable to allocate or lock memory.');
        WAVERR_UNPREPARED:
          raise ESoundException.Create('Couldn''t send wave data: Wave header has not been prepared.');
        else
          raise ESoundException.Create('Couldn''t send wave data: Unknown error.');
      end;

    except
      waveOutUnprepareHeader(FWave, @FWaveHeader, sizeof(FWaveHeader));
      raise;
    end;

  except
    waveOutClose(FWave);
    FWave := 0;
    raise;
  end;

  if Assigned(FOnPlaybackEvent) then
    FOnPlaybackEvent(FPlayerID, pevStart);

end;

class procedure TASSound.Cleanup;
var
  MMres: MMRESULT;
begin

  if FWave = 0 then
    Exit;

  MMres := waveOutUnprepareHeader(FWave, @FWaveHeader, sizeof(FWaveHeader));

  case MMres of
    MMSYSERR_NOERROR: ;
    MMSYSERR_INVALHANDLE:
      raise ESoundException.Create('Couldn''t unprepare wave header: Specified device handle is invalid.');
    MMSYSERR_NODRIVER:
      raise ESoundException.Create('Couldn''t unprepare wave header: No device driver is present.');
    MMSYSERR_NOMEM:
      raise ESoundException.Create('Couldn''t unprepare wave header: Unable to allocate or lock memory.');
    WAVERR_STILLPLAYING:
      raise ESoundException.Create('Couldn''t unprepare wave header: Audio still playing.');
    else
      raise ESoundException.Create('Couldn''t unprepare wave header: Unknown error.');
  end;

  MMres := waveOutClose(FWave);

  case MMres of
    MMSYSERR_NOERROR: ;
    MMSYSERR_INVALHANDLE:
      raise ESoundException.Create('Couldn''t close wave header: Specified device handle is invalid.');
    MMSYSERR_NODRIVER:
      raise ESoundException.Create('Couldn''t close wave header: No device driver is present.');
    MMSYSERR_NOMEM:
      raise ESoundException.Create('Couldn''t close wave header: Unable to allocate or lock memory.');
    WAVERR_STILLPLAYING:
      raise ESoundException.Create('Couldn''t close wave header: Audio still playing.');
    else
      raise ESoundException.Create('Couldn''t close wave header: Unknown error.');
  end;

  FWave := 0;
  FBuffer.Clear;

end;

procedure TASSound.Restart;
var
  MMres: MMRESULT;
begin

  if FWave = 0 then
    Exit;

  MMres := waveOutRestart(FWave);

  case MMres of
    MMSYSERR_NOERROR: ;
    MMSYSERR_INVALHANDLE:
      raise ESoundException.Create('Couldn''t resume audio playback: Specified device handle is invalid.');
    MMSYSERR_NODRIVER:
      raise ESoundException.Create('Couldn''t resume audio playback: No device driver is present.');
    MMSYSERR_NOMEM:
      raise ESoundException.Create('Couldn''t resume audio playback: Unable to allocate or lock memory.');
    MMSYSERR_NOTSUPPORTED:
      raise ESoundException.Create('Couldn''t resume audio playback: Specified device is synchronous and does not support pausing.');
    else
      raise ESoundException.Create('Couldn''t resume audio playback: Unknown error.');
  end;

  if Assigned(FOnPlaybackEvent) then
    FOnPlaybackEvent(FPlayerID, pevResume);

end;

function TASSound.Reverse: TASSound;
var
  s: PByte;
  _s: PByte;
  i: Integer;
begin
  Result := TASSound.CreateUsingSamples(SampleFrequency, BytesPerSample,
    ChannelCount, ChannelMask, SampleLength, False);
  s := Result.Data;
  _s := Data + Length(FData) - ChannelCount * BytesPerSample;
  for i := 0 to SampleLength - 1 do
  begin
    Move(_s^, s^, ChannelCount * BytesPerSample);
    Inc(s, ChannelCount * BytesPerSample);
    Dec(_s, ChannelCount * BytesPerSample);
  end;
end;

class procedure TASSound.Stop;
var
  MMres: MMRESULT;
begin

  if FWave = 0 then
    Exit;

  MMres := waveOutReset(FWave);

  case MMres of
    MMSYSERR_NOERROR: ;
    MMSYSERR_INVALHANDLE:
      raise ESoundException.Create('Couldn''t reset audio playback: Specified device handle is invalid.');
    MMSYSERR_NODRIVER:
      raise ESoundException.Create('Couldn''t reset audio playback: No device driver is present.');
    MMSYSERR_NOMEM:
      raise ESoundException.Create('Couldn''t reset audio playback: Unable to allocate or lock memory.');
    MMSYSERR_NOTSUPPORTED:
      raise ESoundException.Create('Couldn''t reset audio playback: Specified device is synchronous and does not support pausing.');
    else
      raise ESoundException.Create('Couldn''t reset audio playback: Unknown error.');
  end;

end;

class operator TASSound.Subtract(const Left, Right: TASSound): TASSound;
begin
  Result := Left.Clone.Superpose(Right, 0, 1, -1);
end;

function TASSound.Superpose(const ASound: TASSound; const ABeginningAt,
  ACoeff1, ACoeff2: Double): TASSound;
var
  FirstByteIndex: Integer;
  FirstSampleIndex: Integer;
  s: PByte;
  s8: P8BitSample absolute s;
  s16: P16BitSample absolute s;
  s32: P32BitSample absolute s;
  _s: PByte;
  _s8: P8BitSample absolute _s;
  _s16: P16BitSample absolute _s;
  _s32: P32BitSample absolute _s;
  i: Integer;
begin

  if
    (Self.SampleFrequency <> ASound.SampleFrequency)
      or
    (Self.BitsPerSample <> ASound.BitsPerSample)
      or
    (Self.ChannelCount <> ASound.ChannelCount)
      or
    (Self.ChannelMask <> ASound.ChannelMask)
  then
    raise ESoundException.Create('Cannot superpose two sounds with different sample rates, bit depths, channel counts, or channel masks.');

  if not (BitsPerSample in [8, 16, 32]) then
    raise ESoundException.CreateFmt('Unsupported bit depth %d.', [BitsPerSample]);

  if ABeginningAt < 0 then
    raise ESoundException.Create('Time index must be non-negative.');

  FirstByteIndex := ByteIndexFromTimestamp(ABeginningAt);
  FirstSampleIndex := SampleIndexFromTimestamp(ABeginningAt);
  if FirstSampleIndex + ASound.SampleLength > Self.SampleLength then
    SampleLength := FirstSampleIndex + ASound.SampleLength;

  s := Data + FirstByteIndex;
  _s := ASound.Data;

  for i := 0 to ASound.SampleLength * FChannelCount - 1 do
    case BitsPerSample of
      8: s8[i] := 128 + Round(ACoeff1 * (s8[i] - 128) + ACoeff2 * (_s8[i] - 128));
      16: s16[i] := Round(ACoeff1 * s16[i] + ACoeff2 * _s16[i]);
      32: s32[i] := Round(ACoeff1 * s32[i] + ACoeff2 * _s32[i]);
    end;

  Result := Self;

end;

class function TASSound.WaitFor(ATimeout: Cardinal): Boolean;
var
  Msg: TMsg;
  Start: UInt64;
begin
  Start := GetTickCount64;
  FillChar(Msg, sizeof(Msg), 0);
  while TASSound.Playing and (GetTickCount64 - Start < ATimeout) and
    not PeekMessage(Msg, FCallbackWindow, MM_WOM_DONE, MM_WOM_DONE, PM_NOREMOVE) do
    Sleep(100);
  Result := Msg.message = MM_WOM_DONE;
end;

class operator TASSound.Add(const Left, Right: TASSound): TASSound;
begin
  Result := Left.Clone.Superpose(Right, 0, 1, 1);
end;

procedure TASSound.Append(const ASound: TASSound);
var
  OldDataLength: Integer;
begin

  if
    (Self.SampleFrequency <> ASound.SampleFrequency) or
    (Self.BitsPerSample <> ASound.BitsPerSample) or
    (Self.ChannelCount <> ASound.ChannelCount) or
    (Self.ChannelMask <> ASound.ChannelMask)
  then
    raise ESoundException.Create('Cannot combine two sounds with different sample rates, bit depths, channel counts, or channel masks.');

  if Self.Data = ASound.Data then
  begin
    OldDataLength := Self.DataLength;
    SetLength(FData, 2 * OldDataLength);
    Move(ASound.Data[0], Self.Data[OldDataLength], OldDataLength);
  end
  else
  begin
    OldDataLength := Self.DataLength;
    SetLength(FData, Self.DataLength + ASound.DataLength);
    Move(ASound.Data[0], Self.Data[OldDataLength], ASound.DataLength);
  end;

end;

function TASSound.Clone: TASSound;
begin
  Result.FSampleFrequency := Self.FSampleFrequency;
  Result.FBitsPerSample := Self.FBitsPerSample;
  Result.FChannelCount := Self.FChannelCount;
  Result.FChannelMask := Self.FChannelMask;
  SetLength(Result.FData, Length(Self.FData));
  Move(Self.FData[0], Result.FData[0], Length(Self.FData));
end;

procedure TASSound.Clear;
begin
  Self.SetDuration(0);
end;

procedure TASSound.ConvertSample(ASource, ATarget: PByte; AFromWidth,
  AToWidth: Integer);
var
  val: Double;
begin

  case AFromWidth of
    1: val := (P8BitSample(ASource)^ - $80) / $80;
    2: val := P16BitSample(ASource)^ / High(T16BitSample);
    4: val := P32BitSample(ASource)^ / High(T32BitSample);
  else
    raise ESoundException.Create('Unsupported source bit depth.');
  end;

  case AToWidth of
    1: P8BitSample(ATarget)^ := Round($80 + $80 * val);
    2: P16BitSample(ATarget)^ := Round(High(T16BitSample) * val);
    4: P32BitSample(ATarget)^ := Round(High(T32BitSample) * val);
  else
    raise ESoundException.Create('Unsupported target bit depth.');
  end;

end;

function TASSound.ConvertTo(const ABitsPerSample: Integer): TASSound;
var
  BPS, BPS_: Integer;
  i: Integer;
  p, p_: PByte;
begin

  if ABitsPerSample = Self.BitsPerSample then
    Exit(Self.Clone);

  BPS := BytesPerSample;
  BPS_ := ABitsPerSample div 8;

  Result := TASSound.CreateUsingSamples(FSampleFrequency, BPS_,
    FChannelCount, FChannelMask, SampleLength, False);

  p := Self.Data;
  p_ := Result.Data;
  for i := 0 to SampleLength * FChannelCount - 1 do
  begin
    ConvertSample(p, p_, BPS, BPS_);
    Inc(p, BPS);
    Inc(p_, BPS_);
  end;

end;

procedure TASSound.CopyToClipboard;
var
  hglbAudio: NativeUInt;
  lckAudio: Pointer;
  MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  try
    WriteSoundToStream(Self, MS);
    hglbAudio := GlobalAlloc(GMEM_MOVEABLE, MS.Size);
    if hglbAudio = 0 then
      RaiseLastOSError;
    try
      lckAudio := GlobalLock(hglbAudio);
      if lckAudio = nil then
        RaiseLastOSError;
      try
        CopyMemory(lckAudio, MS.Memory, ms.Size);
      finally
        if not GlobalUnlock(hglbAudio) and (GetLastError <> NO_ERROR) then
          RaiseLastOSError;
      end;
    except
      GlobalFree(hglbAudio);
      raise;
    end;
    Clipboard.SetAsHandle(CF_WAVE, hglbAudio); // transfer of ownership (to OS)
    SysUtils.Beep;
  finally
    MS.Free;
  end;
end;

constructor TASSound.CreateUsingTime(ASampleFrequency, ABytesPerSample,
  AChannelCount: Integer; AChannelMask: Cardinal; ADuration: Double;
  AInitialize: Boolean = True);
begin
  CreateUsingSamples(ASampleFrequency, ABytesPerSample, AChannelCount,
    AChannelMask, Round(ASampleFrequency * ADuration), AInitialize);
end;

function TASSound.Echo(const ADelay, AIntensity: Double): TASSound;
var
  Delta, DeltaChs, i: Integer;
  s: PByte;
  s8: P8BitSample absolute s;
  s16: P16BitSample absolute s;
  s32: P32BitSample absolute s;
  _s: PByte;
  _s8: P8BitSample absolute _s;
  _s16: P16BitSample absolute _s;
  _s32: P32BitSample absolute _s;
  InvIntensity: Double;
begin

  if ADelay < 0 then
    raise ESoundException.Create('The delay cannot be negative.');

  if not InRange(AIntensity, 0, 1) then
    raise ESoundException.Create('The intensity of the echo must lie within [0, 1].');

  InvIntensity := 1 - AIntensity;

  Result := TASSound.CreateUsingTime(SampleFrequency, BytesPerSample, ChannelCount,
    ChannelMask, Duration + ADelay, False);

  Delta := Result.SampleLength - Self.SampleLength;
  DeltaChs := Delta * ChannelCount;
  s := Self.Data;
  _s := Result.Data;
  case BitsPerSample of
    16:
      begin
        if Delta <= SampleLength then
        begin
          for i := 0 to DeltaChs - 1 do
            _s16[i] := Round(InvIntensity * s16[i]);
          for i := DeltaChs to SampleLength*ChannelCount - 1 do
            _s16[i] := Round(InvIntensity * s16[i] + AIntensity * s16[i - DeltaChs]);
          for i := SampleLength*ChannelCount to Result.SampleLength*ChannelCount - 1 do
            _s16[i] := Round(AIntensity * s16[i - DeltaChs]);
        end
        else
        begin
          for i := 0 to SampleLength*ChannelCount - 1 do
            _s16[i] := Round(InvIntensity * s16[i]);
          for i := DeltaChs to Result.SampleLength*ChannelCount - 1 do
            _s16[i] := Round(AIntensity * s16[i - DeltaChs]);
        end;
      end;
    32:
      begin
        if Delta <= SampleLength then
        begin
          for i := 0 to DeltaChs - 1 do
            _s32[i] := Round(InvIntensity * s32[i]);
          for i := DeltaChs to SampleLength*ChannelCount - 1 do
            _s32[i] := Round(InvIntensity * s32[i] + AIntensity * s32[i - DeltaChs]);
          for i := SampleLength*ChannelCount to Result.SampleLength*ChannelCount - 1 do
            _s32[i] := Round(AIntensity * s32[i - DeltaChs]);
        end
        else
        begin
          for i := 0 to SampleLength*ChannelCount - 1 do
            _s32[i] := Round(InvIntensity * s32[i]);
          for i := DeltaChs to Result.SampleLength*ChannelCount - 1 do
            _s32[i] := Round(AIntensity * s32[i - DeltaChs]);
        end;
      end;
  else
    raise ESoundException.Create('Unsupported audio format.');
  end;

end;

class operator TASSound.Equal(const Left, Right: TASSound): Boolean;
begin
  Result :=
    (Left.FSampleFrequency = Right.FSampleFrequency)
      and
    (Left.FBitsPerSample = Right.FBitsPerSample)
      and
    (Left.FChannelCount = Right.FChannelCount)
      and
    (Left.FChannelMask = Right.FChannelMask)
      and
    (Left.DataLength = Right.DataLength)
      and
    CompareMem(Left.Data, Right.Data, Left.DataLength);
end;

function TASSound.ExtractChannel(const AChannelIndex: Integer): TASSound;
var
  i: Integer;
  s: PByte;
  s8: P8BitSample absolute s;
  s16: P16BitSample absolute s;
  s24: P24BitSample absolute s;
  s32: P32BitSample absolute s;
begin

  if not InRange(AChannelIndex, 0, FChannelCount - 1) then
    raise ESoundException.Create('The sound does not contain a channel with the specified index.');

  Result := TASSound.CreateUsingSamples(FSampleFrequency, BytesPerSample, 1,
    KSAUDIO_SPEAKER_MONO, SampleLength, False);

  s := Self.Data + AChannelIndex * BytesPerSample;
  for i := 0 to Result.SampleLength - 1 do
  begin
    case Result.BitsPerSample of
      8: P8BitSample(Result.Data)[i] := s8^;
      16: P16BitSample(Result.Data)[i] := s16^;
      24: P24BitSample(Result.Data)[i] := s24^;
      32: P32BitSample(Result.Data)[i] := s32^;
    end;
    Inc(s, FChannelCount * BytesPerSample);
  end;

end;

constructor TASSound.CreateUsingSamples(ASampleFrequency, ABytesPerSample,
  AChannelCount: Integer; AChannelMask: Cardinal; ASampleCount: Integer;
  AInitialize: Boolean = True);
const
  ByteMax =
    {$IFDEF WIN64}
      2147483647
    {$ELSE}
      1073741824
    {$ENDIF};
begin

  if ASampleFrequency <= 0 then
    raise ESoundException.Create('Sample rate must be positive.');

  if ABytesPerSample <= 0 then
    raise ESoundException.Create('Number of bytes per sample must be positive.');

  if AChannelCount <= 0 then
    raise ESoundException.Create('Number of channels must be positive.');

  if ASampleCount < 0 then
    raise ESoundException.Create('Sample count must be non-negative.');

  FSampleFrequency := ASampleFrequency;
  FBitsPerSample := 8 * ABytesPerSample;
  FChannelCount := AChannelCount;
  FChannelMask := AChannelMask;

  if ASampleCount > ByteMax div (AChannelCount * ABytesPerSample) then
    raise ESoundException.Create('Sound is too large.');

  SetLength(FData, AChannelCount * ABytesPerSample * ASampleCount);

  if AInitialize and (ABytesPerSample = 1) then
    FillChar(FData[0], Length(FData), 128);

end;

function TASSound.GetBytesPerSample: Integer;
begin
  Result := FBitsPerSample div 8;
end;

function TASSound.GetData: PByte;
begin
  Result := Pointer(FData);
end;

function TASSound.GetDataLength: UInt64;
begin
  Result := Length(FData);
end;

function TASSound.GetDuration: Double;
begin
  if (FData = nil) or (SampleFrequency = 0) then
    Result := 0.0
  else
    Result := GetSampleLength / SampleFrequency;
end;

function TASSound.GetMaxFraction: Double;
begin
  case BitsPerSample of
    8:
      Result := MaxValue / 128;
    16:
      Result := MaxValue / High(T16BitSample);
    32:
      Result := MaxValue / High(T32BitSample);
    else
      raise ESoundException.Create('Unsupported bit depth.');
  end;
end;

function TASSound.GetMaxValue: Integer;
var
  s: PByte;
  s8: P8BitSample absolute s;
  s16: P16BitSample absolute s;
  s32: P32BitSample absolute s;
  i: Integer;
begin

  if DataLength = 0 then
    Exit(0);

  s := Data;

  case BitsPerSample of
    8:
      begin
        Result := Abs(s8[0] - 128);
        for i := 1 to SampleLength * ChannelCount - 1 do
          if Abs(s8[i] - 128) > Result then
            Result := Abs(s8[i] - 128);
      end;
    16:
      begin
        Result := Abs(s16[0]);
        for i := 1 to SampleLength * ChannelCount - 1 do
          if Abs(s16[i]) > Result then
            Result := Abs(s16[i]);
      end;
    32:
      begin
        Result := Abs(s32[0]);
        for i := 1 to SampleLength * ChannelCount - 1 do
          if Abs(s32[i]) > Result then
            Result := Abs(s32[i]);
      end;
    else
      raise ESoundException.Create('Unsupported bit depth.');
  end;

end;

function TASSound.GetPosition: Double;
var
  MMTime: TMMTime;
  MMRes: MMRESULT;
begin

  if FWave = 0 then
    Exit(0.0);

  FillChar(MMTime, sizeof(MMTime), 0);
  MMTime.wType := TIME_MS;
  MMRes := waveOutGetPosition(FWave, @MMTime, sizeof(MMTime));

  if MMRes <> MMSYSERR_NOERROR then
    Exit(0.0);

  case MMTime.wType of
    TIME_MS:
      Result := MMTime.ms / 1000;
    TIME_SAMPLES:
      if SampleFrequency = 0 then
        Result := 0.
      else
        Result := MMTime.sample / SampleFrequency;
    TIME_BYTES:
      if BytesPerSample * SampleFrequency = 0 then
        Result := 0.0
      else
        Result := MMTime.cb / (ChannelCount * BytesPerSample * SampleFrequency);
  else
    Result := 0.0;
  end;

  Result := FStartTime + Result;

end;

function TASSound.GetSampleLength: Integer;
begin
  if (FData = nil) or (ChannelCount = 0) or (BytesPerSample = 0) then
    Result := 0
  else
    Result := Length(FData) div (ChannelCount * BytesPerSample);
end;

function TASSound.SampleIndexFromTimestamp(const ATime: Double): Integer;
begin
  Result := Round(ATime * FSampleFrequency);
end;


function TASSound.ByteIndexFromTimestamp(const ATime: Double): Integer;
begin
  Result := SampleIndexFromTimestamp(ATime) * BytesPerSample * FChannelCount;
end;

class operator TASSound.Multiply(const Left: Double;
  const Right: TASSound): TASSound;
begin
  Result := Right.Clone.ScaleAmplitude(Left);
end;

function TASSound.GetIsSilent: Boolean;
begin
  Result := MaxFraction < 0.0001;
end;

class operator TASSound.Multiply(const Left, Right: TASSound): TASSound;
begin
  Result := Left.Clone.Superpose(Right);
end;

class operator TASSound.NotEqual(const Left, Right: TASSound): Boolean;
begin
  Result := not (Left = Right);
end;

procedure TASSound.SaveToFile(const AFileName: TFileName;
  AWaveFormatType: TWaveFormatType);
begin
  SaveSoundToFile(Self, AFileName, AWaveFormatType);
end;

function TASSound.ScaleAmplitude(const AFactor: Double): TASSound;
var
  s: PByte;
  s8: P8BitSample absolute s;
  s16: P16BitSample absolute s;
  s32: P32BitSample absolute s;
  i: Integer;
begin

  if not InRange(AFactor, 0, 1) then
    raise ESoundException.Create('Scaling factor must lie within [0, 1].');

  if not (BitsPerSample in [8, 16, 32]) then
    raise ESoundException.CreateFmt('Unsupported bit depth %d.', [BitsPerSample]);

  s := Data;
  case BitsPerSample of
    8:
      for i := 0 to SampleLength * ChannelCount - 1 do
      begin
        s8^ := Round(AFactor * (s8^ - 128)) + 128;
        Inc(s8);
      end;
    16:
      for i := 0 to SampleLength * ChannelCount - 1 do
      begin
        s16^ := Round(AFactor * s16^);
        Inc(s16);
      end;
    32:
      for i := 0 to SampleLength * ChannelCount - 1 do
      begin
        s32^ := Round(AFactor * s32^);
        Inc(s32);
      end;
  end;

  Result := Self;

end;

procedure TASSound.SetBitsPerSample(const Value: Integer);
begin
  if Value mod 8 = 0 then
    SetBytesPerSample(Value div 8)
  else
    raise ESoundException.Create('Unsupported number of bits per sample, must be a multiple of 8.');
end;

procedure TASSound.SetBytesPerSample(const Value: Integer);
var
  BPS: Integer;
  NewData: TArray<Byte>;
  p, p_: PByte;
  i: Integer;
begin

  BPS := BytesPerSample;

  if Value = BPS then
    Exit;

  SetLength(NewData, Value * FChannelCount * SampleLength);

  p := @Self.FData[0];
  p_ := @NewData[0];
  for i := 0 to SampleLength * FChannelCount - 1 do
  begin
    ConvertSample(p, p_, BPS, Value);
    Inc(p, BPS);
    Inc(p_, Value);
  end;

  FData := NewData;
  Self.FBitsPerSample := 8 * Value;

end;

procedure TASSound.SetDuration(const Value: Double);
begin
  SetSampleLength(Round(SampleFrequency * Value));
end;

procedure TASSound.SetSampleLength(const Value: Integer);
var
  OldDataLength, DataLength: Integer;
begin
  OldDataLength := Length(FData);
  DataLength := Value * BytesPerSample * FChannelCount;
  SetLength(FData, DataLength);
  if DataLength > OldDataLength then
    FillChar(FData[OldDataLength], DataLength - OldDataLength,
      IfThen(BytesPerSample = 1, 128, 0));
end;

function SineTone(const AFreq, AAmplitude, ADuration: Double;
  ABitsPerSample: Integer = 32;
  ASampleFrequency: Integer = HIGH_QUALITY_SAMPLE_RATE): TASSound;
var
  i: Integer;
  s: PByte;
  s8: P8BitSample absolute s;
  s16: P16BitSample absolute s;
  s32: P32BitSample absolute s;
  omega: Double;
begin

  if not ABitsPerSample in [8, 16, 32] then
    raise ESoundException.Create('Unsupported bit depth.');

  Result := TASSound.CreateUsingTime(ASampleFrequency, ABitsPerSample div 8, 1,
    KSAUDIO_SPEAKER_MONO, ADuration, False);
  s := Result.Data;
  omega := 2 * pi * AFreq / ASampleFrequency;

  case ABitsPerSample of
    8:
      for i := 0 to Result.SampleLength - 1 do
        s8[i] := 128 + Round(AAmplitude * 128 * Sin(omega * i));
    16:
      for i := 0 to Result.SampleLength - 1 do
        s16[i] := Round(AAmplitude * High(T16BitSample) * Sin(omega * i));
    32:
      for i := 0 to Result.SampleLength - 1 do
        s32[i] := Round(AAmplitude * High(T32BitSample) * Sin(omega * i));
  end;

end;

function WhiteNoise(const AAmplitude, ADuration: Double;
  ASampleFrequency: Integer = HIGH_QUALITY_SAMPLE_RATE): TASSound;
var
  i: Integer;
  Samples: P32BitSample;
begin
  Result := TASSound.CreateUsingTime(ASampleFrequency, 4, 1, KSAUDIO_SPEAKER_MONO,
    ADuration, False);
  Samples := P32BitSample(Result.Data);
  for i := 0 to Result.SampleLength - 1 do
    Samples[i] := Round(AAmplitude * RandomRange(low(Integer), high(Integer)))
end;

function MultichannelSound(const ASounds: array of TASSound;
  AChannelMask: Cardinal): TASSound;
var
  i: Integer;
  s: PByte;
  s8: P8BitSample absolute s;
  s16: P16BitSample absolute s;
  s24: P24BitSample absolute s;
  s32: P32BitSample absolute s;
  n: Integer;
begin

  if Length(ASounds) = 0 then
    raise ESoundException.Create('Cannot create a multichannel sound from zero individual channels.');

  Result := TASSound.CreateUsingSamples(ASounds[0].SampleFrequency,
    ASounds[0].BytesPerSample, Length(ASounds), AChannelMask,
    ASounds[0].SampleLength, False);

  for i := 1 to High(ASounds) do
    if
      (ASounds[i].SampleFrequency <> Result.SampleFrequency) or
      (ASounds[i].BitsPerSample <> Result.BitsPerSample) or
      (ASounds[i].SampleLength <> Result.SampleLength) or
      (ASounds[i].ChannelCount <> 1)
    then
      raise ESoundException.Create('Cannot create a multichannel sound from an array of sounds with non-equal sample frequencies, bits per sample, or durations, or with multiple channels themselves.');

  s := Result.Data;
  for i := 0 to Result.SampleLength - 1 do
    for n := 0 to Result.ChannelCount - 1 do
    begin
      case Result.BitsPerSample of
        8: s8^ := P8BitSample(ASounds[n].Data)[i];
        16: s16^ := P16BitSample(ASounds[n].Data)[i];
        24: s24^ := P24BitSample(ASounds[n].Data)[i];
        32: s32^ := P32BitSample(ASounds[n].Data)[i];
      end;
      Inc(s, Result.BytesPerSample);
    end;

end;

function FadeSound(const ASound1, ASound2: TASSound;
  const ADuration: Double = 1): TASSound;
var
  OverlapSampleLength: Integer;
  BytesPerGroup: Integer;

  L{eft}: PByte;
  L8: P8BitSample absolute L;
  L16: P16BitSample absolute L;
  L32: P32BitSample absolute L;

  R{right}: PByte;
  R8: P8BitSample absolute R;
  R16: P16BitSample absolute R;
  R32: P32BitSample absolute R;

  S{sample}: PByte;
  S8: P8BitSample absolute S;
  S16: P16BitSample absolute S;
  S32: P32BitSample absolute S;
  i: Integer;

  t: Double;
  dt: Double;
begin

  if
    (ASound1.SampleFrequency <> ASound2.SampleFrequency) or
    (ASound1.BitsPerSample <> ASound2.BitsPerSample) or
    (ASound1.ChannelCount <> ASound2.ChannelCount) or
    (ASound1.ChannelMask <> ASound2.ChannelMask)
  then
    raise ESoundException.Create('Cannot fade two sounds with different sample rates, bit depths, channel counts, or channel masks.');

  if not ASound1.BitsPerSample in [8, 16, 32] then
    raise ESoundException.Create('Unsupported bit depth.');

  OverlapSampleLength := Round(ADuration * ASound1.SampleFrequency);
  BytesPerGroup := ASound1.ChannelCount * ASound1.BytesPerSample;

  if OverlapSampleLength > ASound1.SampleLength then
    raise ESoundException.Create('The duration of the overlap exceeds the duration of the first sound.');

  if OverlapSampleLength > ASound2.SampleLength then
    raise ESoundException.Create('The duration of the overlap exceeds the duration of the second sound.');

  Result := TASSound.CreateUsingSamples(ASound1.SampleFrequency,
    ASound1.BytesPerSample, ASound1.ChannelCount, ASound1.ChannelMask,
    ASound1.SampleLength + ASound2.SampleLength - OverlapSampleLength, False);

  Move(ASound1.Data^, Result.Data^,
    (ASound1.SampleLength - OverlapSampleLength) * BytesPerGroup);

  Move(ASound2.Data[OverlapSampleLength * BytesPerGroup],
    Result.Data[ASound1.DataLength],
    (ASound2.SampleLength - OverlapSampleLength) * BytesPerGroup);

  L := ASound1.Data + (ASound1.SampleLength - OverlapSampleLength) * BytesPerGroup;
  R := ASound2.Data;
  S := Result.Data + (ASound1.SampleLength - OverlapSampleLength) * BytesPerGroup;

  t := 0;
  dt := 1 / (OverlapSampleLength * ASound1.ChannelCount);

  case ASound1.BitsPerSample of
    8:
      for i := 0 to OverlapSampleLength * ASound1.ChannelCount - 1 do
      begin
        S8^ := 128 + Round((1 - t) * (L8^ - 128) + t * (R8^ - 128));
        Inc(L8);
        Inc(R8);
        Inc(S8);
        t := t + dt;
      end;
    16:
      for i := 0 to OverlapSampleLength * ASound1.ChannelCount - 1 do
      begin
        S16^ := Round((1 - t) * L16^ + t * R16^);
        Inc(L16);
        Inc(R16);
        Inc(S16);
        t := t + dt;
      end;
    32:
      for i := 0 to OverlapSampleLength * ASound1.ChannelCount - 1 do
      begin
        S32^ := Round((1 - t) * L32^ + t * R32^);
        Inc(L32);
        Inc(R32);
        Inc(S32);
        t := t + dt;
      end;
  end;

end;

function GenerateSound(AWaveFunction: TWaveFunction;
  const AAmplitude, AFromTime, AToTime: Double;
  ASampleFrequency: Integer = HIGH_QUALITY_SAMPLE_RATE): TASSound;
var
  i: Integer;
  Samples: P32BitSample;
begin
  Result := TASSound.CreateUsingTime(ASampleFrequency, 4, 1, KSAUDIO_SPEAKER_MONO,
    AToTime - AFromTime, False);
  Samples := P32BitSample(Result.Data);
  for i := 0 to Result.SampleLength - 1 do
    Samples[i] := Round(AAmplitude * MaxInt * AWaveFunction(i / ASampleFrequency));
end;

function bitcount(X: Cardinal): Word;
begin
  Result := 0;
  while X <> 0 do
  begin
    Inc(Result, X and 1);
    X := X shr 1;
  end;
end;

type
  TRiffChunkHeader = packed record
    Ident:
      packed record
        case Boolean of
          False: (val: Cardinal);
          True: (chrs: array[0..3] of AnsiChar)
      end;
    Len: Cardinal;
  end;
  TRiffHeader = packed record
    RiffChunkHeader: TRiffChunkHeader;
    RiffType: Cardinal;
  end;

const
  FCC_RIFF = $46464952;
  FCC_WAVE = $45564157;
  FCC_fmt_ = $20746D66;
  FCC_data = $61746164;

procedure WriteSoundToStream(const ASound: TASSound; AStream: TStream;
  AWaveFormatType: TWaveFormatType = wftAuto);
const
  PadByte: Byte = 0;
var
  ExtensibleFormat: Boolean;
  fhdr: TRiffHeader;
  chdr: TRiffChunkHeader;
  wfext: TWaveFormatExtensible;
begin

  ExtensibleFormat :=
    (AWaveFormatType = wftExtensible)
      or
    (
      (AWaveFormatType = wftAuto)
        and
      (
        (ASound.FChannelCount > 2)
          or
        (ASound.FBitsPerSample > 16)
          or
        not (ASound.FChannelMask in [KSAUDIO_SPEAKER_MONO, KSAUDIO_SPEAKER_STEREO])
      )
    );

  wfext.Format.wFormatTag := IfThen(ExtensibleFormat, WAVE_FORMAT_EXTENSIBLE, WAVE_FORMAT_PCM);
  wfext.Format.nChannels := ASound.FChannelCount;
  wfext.Format.nSamplesPerSec := ASound.FSampleFrequency;
  wfext.Format.nAvgBytesPerSec := ASound.BytesPerSample * ASound.FSampleFrequency * ASound.FChannelCount;
  wfext.Format.nBlockAlign := ASound.BytesPerSample * ASound.FChannelCount;
  wfext.Format.wBitsPerSample := ASound.FBitsPerSample;
  wfext.Format.cbSize := IfThen(ExtensibleFormat, 22, 0);
  wfext.Samples.wValidBitsPerSample := ASound.FBitsPerSample;
  wfext.dwChannelMask := ASound.FChannelMask;
  wfext.SubFormat := KSDATAFORMAT_SUBTYPE_PCM;

  // RIFF header
  fhdr.RiffChunkHeader.Ident.val := FCC_RIFF;
  fhdr.RiffChunkHeader.Len := sizeof(fhdr.RiffType) +                          {RIFF type}
    sizeof(chdr.Ident.val) + sizeof(chdr.Len) +                                {fmt_ chunk header}
    IfThen(ExtensibleFormat, sizeof(TWaveFormatExtensible), sizeof(TWaveFormatEx)) +    {fmt_ chunk data}
    sizeof(chdr.Ident.val) + sizeof(chdr.Len) +                                {data_ chunk header}
    Integer(ASound.DataLength) +                                               {data_ chunk data}
    IfThen(Odd(ASound.DataLength), 1, 0);                                      {data_ chunk pad Byte}
  fhdr.RiffType := FCC_WAVE;
  AStream.Write(fhdr, sizeof(fhdr));

  // fmt_ chunk
  chdr.Ident.val := FCC_fmt_;
  chdr.Len := IfThen(ExtensibleFormat, sizeof(TWaveFormatExtensible), sizeof(TWaveFormatEx));
  AStream.Write(chdr, sizeof(chdr));
  AStream.Write(wfext, chdr.Len);

  // data chunk
  chdr.Ident.val := FCC_data;
  chdr.Len := ASound.DataLength;
  AStream.Write(chdr, sizeof(chdr));
  AStream.Write(ASound.Data^, ASound.DataLength);

  if Odd(ASound.DataLength) then
    AStream.Write(PadByte, 1);

end;

function LoadSoundFromStream(AStream: TStream; const AFileName: string = ''): TASSound;
var
  fhdr: TRiffHeader;
  chdr: TRiffChunkHeader;
  wfext: TWaveFormatExtensible;
  wfex: TWaveFormatEx absolute wfext;
  wfpcm: TPCMWaveFormat absolute wfext;
  wf: TWaveFormat absolute wfext;
  readlen: Cardinal;
begin

  if (AStream.Read(fhdr, sizeof(fhdr)) <> sizeof(fhdr)) or (fhdr.RiffChunkHeader.Ident.val <> FCC_RIFF) then
    raise ESoundIOException.CreateFmt('The specified file "%s" appears not to be a RIFF file.', [AFileName]);
  if fhdr.RiffType <> FCC_WAVE then
    raise ESoundIOException.CreateFmt('The specified file "%s" appears not to be a RIFF WAVE file.', [AFileName]);

  while AStream.Position < AStream.Size do
  begin

    if AStream.Read(chdr, sizeof(chdr)) <> sizeof(chdr) then
      raise ESoundIOException.CreateFmt('The specified RIFF WAVE file "%s" appears to be corrupt.', [AFileName]);

    if chdr.Ident.val = FCC_fmt_ then
    begin

      if chdr.Len < sizeof(TWaveFormat) then
        raise ESoundIOException.CreateFmt('The format chunk of the RIFF WAVE file "%s" is too small.', [AFileName]);

      if chdr.Len >= sizeof(TWaveFormatExtensible) then
      begin
        if AStream.Read(wfext, sizeof(wfext)) <> sizeof(wfext) then
          raise ESoundIOException.CreateFmt('The format chunk of the RIFF WAVE file "%s" is not complete.', [AFileName]);
        readlen := sizeof(wfext);
      end
      else if chdr.Len >= sizeof(TWaveFormatEx) then
      begin
        if AStream.Read(wfex, sizeof(wfex)) <> sizeof(wfex) then
          raise ESoundIOException.CreateFmt('The format chunk of the RIFF WAVE file "%s" is not complete.', [AFileName]);
        readlen := sizeof(wfex);
      end
      else if chdr.Len >= sizeof(TPCMWaveFormat) then
      begin
        if AStream.Read(wfpcm, sizeof(wfpcm)) <> sizeof(wfpcm) then
          raise ESoundIOException.CreateFmt('The format chunk of the RIFF WAVE file "%s" is not complete.', [AFileName]);
        readlen := sizeof(wfpcm);
      end
      else
      begin
        if AStream.Read(wf, sizeof(wf)) <> sizeof(wf) then
          raise ESoundIOException.CreateFmt('The format chunk of the RIFF WAVE file "%s" is not complete.', [AFileName]);
        readlen := sizeof(wf);
      end;

      if (wf.wFormatTag <> WAVE_FORMAT_PCM) and (wf.wFormatTag <> WAVE_FORMAT_EXTENSIBLE) then
          raise ESoundIOException.CreateFmt('The specified RIFF WAVE file "%s" has an unsupported data format.', [AFileName]);

      // Read format information
      Result.FSampleFrequency := wf.nSamplesPerSec;
      Result.FBitsPerSample := 8 * wf.nBlockAlign div wf.nChannels;
      Result.FChannelCount := wf.nChannels;

      // Default channel mask for the given number of channels
      // If wf.nChannels > 2, readlen should be >= sizeof(wfext)
      case wf.nChannels of
        1: Result.FChannelMask := KSAUDIO_SPEAKER_MONO;
        2: Result.FChannelMask := KSAUDIO_SPEAKER_STEREO;
        4: Result.FChannelMask := KSAUDIO_SPEAKER_QUAD;
        6: Result.FChannelMask := KSAUDIO_SPEAKER_5POINT1;
        8: Result.FChannelMask := KSAUDIO_SPEAKER_7POINT1_SURROUND;
      else
        Result.FChannelMask := 0;
      end;

      // Check correctness
      if wf.nAvgBytesPerSec <> wf.nBlockAlign * wf.nSamplesPerSec then
        raise ESoundIOException.CreateFmt('The specified RIFF WAVE file "%s" contains contradictory format information.', [AFileName]);

      if readlen >= sizeof(wfpcm) then
      begin
        if wfpcm.wBitsPerSample <> 8 * wf.nBlockAlign div wf.nChannels then
          raise ESoundIOException.CreateFmt('The specified RIFF WAVE file "%s" contains contradictory format information.', [AFileName]);
      end;

      if wf.wFormatTag = WAVE_FORMAT_EXTENSIBLE then
      begin

        if (readlen < sizeof(wfext)) or (wfex.cbSize < 22) then
          raise ESoundIOException.CreateFmt('The extensible format structure in the specified RIFF WAVE file "%s" is not complete.', [AFileName]);

        if not IsEqualGUID(wfext.SubFormat, KSDATAFORMAT_SUBTYPE_PCM) then
          raise ESoundIOException.CreateFmt('The specified RIFF WAVE file "%s" has an unsupported (extensible) data format.', [AFileName]);

        if wfext.Samples.wValidBitsPerSample <> wfex.wBitsPerSample then
          raise ESoundIOException.CreateFmt('The specified RIFF WAVE file "%s" has an unsupported number of valid bits per sample.', [AFileName]);

        if bitcount(wfext.dwChannelMask) <> wf.nChannels  then
          raise ESoundIOException.CreateFmt('The channel mask in the specified RIFF WAVE file "%s" doesn''t match the specified number of channels.', [AFileName]);

        Result.FChannelMask := wfext.dwChannelMask;

      end;

      AStream.Seek(chdr.Len - readlen, soCurrent);

    end

    else if chdr.Ident.val = FCC_data then
    begin
      SetLength(Result.FData, chdr.Len);
      if Cardinal(AStream.Read(Result.Data^, chdr.Len)) <> chdr.Len then
        raise ESoundIOException.CreateFmt('The specified RIFF WAVE file "%s" appears to be truncated.', [AFileName]);
    end

    else
      AStream.Seek(chdr.Len, soCurrent);

    if Odd(chdr.Len) then
      AStream.Seek(1, soFromCurrent);

  end;

end;

function LoadSoundFromFile(const AFileName: TFileName): TASSound;
var
  FS: TFileStream;
begin

  FS := TFileStream.Create(AFileName, fmOpenRead);
  try
    Result := LoadSoundFromStream(FS, AFileName);
  finally
    FS.Free;
  end;

end;

procedure SaveSoundToFile(const ASound: TASSound; const AFileName: TFileName;
  AWaveFormatType: TWaveFormatType = wftAuto);
var
  FS: TFileStream;
begin

  FS := TFileStream.Create(AFileName, fmCreate);
  try
    WriteSoundToStream(ASound, FS, AWaveFormatType);
  finally
    FS.Free;
  end;

end;

end.