Sordie.co.uk

libsassy/libSassy.Sound.pas

Raw

{(
 )) libSassy.Sound
((    Wave sound (DirectSound) library
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015-2016
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.Sound;

interface

uses
  WinApi.Windows,
  WinApi.DirectSound,
  WinApi.ActiveX,
  WinApi.MMSystem,

  libSassy.Interfaces,
  libSassy.Arrays,
  libSassy.Errors;

type
  TSound = class;

  ESoundEngine = class(TException);

{$REGION 'TSoundEngine'}
  TSoundEngine = class(TInterface)
  private
    fDirectSound:   IDirectSound;
    fPrimaryBuffer: TSound;
    fCoOpWindow:    HWND;

    class var fDefault: TSoundEngine;
  public
    class constructor Create;
    class destructor  Destroy;

    class function Default: TSoundEngine;

    constructor Create(const ACoOpWindow: HWND; const AGUID: PGUID = nil);
    destructor  Destroy; override;

    property DirectSound:   IDirectSound read fDirectSound;
    property PrimaryBuffer: TSound       read fPrimaryBuffer;
    property CoOpWindow:    HWND         read fCoOpWindow;
  end;
{$ENDREGION}

{$REGION 'TSound'}
  TSound = class(TInterface)
  private
    fPath:   String;
    fID:     Integer;
    fEngine: TSoundEngine;

    fDirectSoundBuffer: IDirectSoundBuffer;

    function CreateBuffer    (BufferDesc: TDSBufferDesc): Boolean; inline;
    function CreateBufferSize(const Size: Integer; Format: TWaveFormatEx): Boolean;
  public
    constructor Create(AEngine: TSoundEngine; aID: Integer);
    destructor  Destroy; override;

    function Load: Boolean;

    function Status: Cardinal;

    function IsLost: Boolean; inline;
    function Restore(Reload: Boolean = True): Boolean;

    function Play(AllowInterrupt: Boolean = True; Loop: Boolean = False; Flags: Cardinal = 0): Boolean;
    function Stop: Boolean;

    property Path:              String             read fPath;
    property ID:                Integer            read fID;
    property Engine:            TSoundEngine       read fEngine;
    property DirectSoundBuffer: IDirectSoundBuffer read fDirectSoundBuffer;
  end;
{$ENDREGION}

{$REGION 'TWavFile'}
  TWavFile = packed record
    RIFF:           array[0..3] of AnsiChar;
    FileSize:       LongWord;
    RIFFType:       array[0..3] of AnsiChar;
    FmtID:          array[0..3] of AnsiChar;
    FmtSize:        LongWord;
    FormatTag:      Word;
    Channels:       Word;
    SamplesPerSec:  LongWord;
    AvgBytesPerSec: LongWord;
    BlockAlign:     Word;
    BitsPerSample:  Word;
    DataID:         array[0..3] of AnsiChar;
    DataSize:       LongWord;
  end;{of TWavFile}
{$ENDREGION}

implementation

{$REGION 'TSoundEngine'}
class constructor TSoundEngine.Create;
begin
  fDefault := nil;
end;

class destructor TSoundEngine.Destroy;
begin
  if fDefault <> nil then
    fDefault.Free;

  fDefault := nil;
end;

class function TSoundEngine.Default;
begin
  if fDefault = nil then
    fDefault := TSoundEngine.Create(0);

  Result := fDefault;
end;

constructor TSoundEngine.Create(const ACoOpWindow: HWND; const AGUID: PGUID = nil);
const
  PrimaryBufferDesc: TDSBufferDesc = (
    dwSize:  sizeof(TDSBufferDesc);
    dwFlags: DSBCAPS_PRIMARYBUFFER or DSBCAPS_CTRLVOLUME or DSBCAPS_CTRLPAN
  );
begin
  inherited Create;

  CoInitialize(nil);

  if not LoadDirectSound then
    ESoundEngine.RaiseException('Unable to load DirectSound');

  if DirectSoundCreate(AGUID, fDirectSound, nil) <> 0 then
    ESoundEngine.RaiseException('Unable to create DirectSound interface');

  fCoOpWindow := ACoOpWindow;
  fDirectSound.SetCooperativeLevel(fCoOpWindow, DSSCL_PRIORITY);

  fPrimaryBuffer := TSound.Create(Self, -1);
  fPrimaryBuffer.CreateBuffer(PrimaryBufferDesc);
end;

destructor TSoundEngine.Destroy;
begin
  fPrimaryBuffer.Free;

  fDirectSound := nil;

  inherited;
end;
{$ENDREGION}

{$REGION 'TSound'}
function TSound.CreateBuffer(BufferDesc: TDSBufferDesc): Boolean;
begin
  fDirectSoundBuffer := nil;

  Result := fEngine.fDirectSound.CreateSoundBuffer(BufferDesc, fDirectSoundBuffer, nil) = 0;
end;

function TSound.CreateBufferSize(const Size: Integer; Format: TWaveFormatEx): Boolean;
var
  BufferDesc: TDSBufferDesc;
begin
  FillChar(BufferDesc, SizeOf(BufferDesc), 0);

  with BufferDesc do
  begin
    dwSize        := SizeOf(BufferDesc);
    dwFlags       := DSBCAPS_GLOBALFOCUS or DSBCAPS_CTRLPAN or DSBCAPS_CTRLVOLUME or DSBCAPS_CTRLFREQUENCY;
    dwBufferBytes := Size;
    lpwfxFormat   := @Format;
  end;

  Result := CreateBuffer(BufferDesc);

  //if Result then fDataSize := Size else fDataSize := 0;
end;

constructor TSound.Create(AEngine: TSoundEngine; aID: Integer);
begin
  inherited Create;

  fEngine := AEngine;

  fID := aID;

  //if fID > -1 then
  //begin
  //  fPath := SFXPath + 'sfx' + IntToStr(fID).PadLeft(3, '0') + '.wav';

  //  if not Load then
  //    ESoundEngine.RaiseException('Failed to load sound "' + fPath + '"');
  //end
  //else
    fPath := '';
end;

destructor TSound.Destroy;
begin
  fDirectSoundBuffer := nil;

  inherited;
end;

function TSound.Load;
var
  WavFile:   THandle;
  WavHeader: TWavFile;
  BytesRead: Cardinal;
  Format:    TWaveFormatEx;
  SoundBuff: Pointer;
  SoundSize: Cardinal;
begin
  fDirectSoundBuffer := nil;

  WavFile := CreateFile(PWideChar(fPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if WavFile = INVALID_HANDLE_VALUE then exit(False);

  try
    ReadFile(WavFile, WavHeader, SizeOf(WavHeader), BytesRead, nil);
    if BytesRead <> SizeOf(WavHeader) then Exit(False);

    if (WavHeader.RIFF  <> 'RIFF') or (WavHeader.RIFFType <> 'WAVE')
    or (WavHeader.FmtID <> 'fmt ') or (WavHeader.DataID   <> 'data') then Exit(False);

    with Format, WavHeader do
    begin
      cbSize          := SizeOf(Format);
      wFormatTag      := FormatTag;
      nChannels       := Channels;
      nSamplesPerSec  := SamplesPerSec;
      nAvgBytesPerSec := AvgBytesPerSec;
      nBlockAlign     := BlockAlign;
      wBitsPerSample  := BitsPerSample;
    end;

    if not CreateBufferSize(WavHeader.DataSize, Format) then Exit(False);

    if fDirectSoundBuffer.Lock(0, 0, @SoundBuff, @SoundSize, nil, nil, DSBLOCK_ENTIREBUFFER) <> 0 then Exit(False);

    try
      ReadFile(WavFile, SoundBuff^, SoundSize, BytesRead, nil);
    finally
      fDirectSoundBuffer.Unlock(SoundBuff, SoundSize, nil, 0);
    end;
  finally
    CloseHandle(WavFile);
  end;

  Result := True;
end;

function TSound.Status;
begin
  if fDirectSoundBuffer = nil then
    Result := 0
  else
    fDirectSoundBuffer.GetStatus(Result);
end;

function TSound.IsLost;
begin
  Result := (Status and DSBSTATUS_BUFFERLOST) = DSBSTATUS_BUFFERLOST;
end;

function TSound.Restore;
begin
  if fDirectSoundBuffer = nil then Exit(False);
  if not IsLost then Exit(False);

  Result := fDirectSoundBuffer.Restore = 0;

  if Result and Reload then
    Result := Load;
end;

function TSound.Play;
var
  DSFlags: Cardinal;
begin
  if fDirectSoundBuffer = nil then exit(False);

  Restore;

  if Loop then DSFlags := 1 else DSFlags := 0;
  DSFlags := DSFlags or Flags;

  if AllowInterrupt then fDirectSoundBuffer.Stop;//  Playing then Position := 0;

  Result := fDirectSoundBuffer.Play(0, 0, DSFlags) = 0;
end;

function TSound.Stop;
begin
  if fDirectSoundBuffer = nil then
    Result := False
  else
    Result := fDirectSoundBuffer.Stop = 0;
end;
{$ENDREGION}

end.