///////////////////////////////////////////////////////////////////////
// Copyright (C) Andru 2007                                          //
// mail: dr.andru@gmail.com                                          //
// site: http://andru.2x4.ru                                         //
//                                                                   //
// OMEGA Engine is free software.                                    //
//                                                                   //
// You may redistribute it and/or modify it under the terms of the   //
// GNU General Public License, as published by the Free Software     //
// Foundation; either version 2 of the License, or (at your option)  //
// any later version.                                                //
//                                                                   //
// this module is distributed in the hope that it will be useful,    //
// but WITHOUT ANY WARRANTY; without even the implied warranty of    //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.              //
// See the GNU General Public License for more details.              //
//                                                                   //
// You should have received a copy of the GNU General Public License //
// along with this module.  If not, write to:                        //
// 	The Free Software Foundation, Inc.,                              //
// 	51 Franklin Street, Fifth Floor                                  //
// 	Boston, MA  02110-1301, USA.                                     //
///////////////////////////////////////////////////////////////////////
unit SOUND_WAVE;

{$I DEFINES.pas}

interface

uses
  Windows,
  minClasses,
  minFile,

  ENGINE_TYPES,
  ENGINE_VAR,
  ENGINE_CONST,

  ENGINE_LOG,
  ENGINE_UTILS,

  UTILS;

function mmioStringToFOURCC(sz: PChar; uFlags: UINT): DWORD; stdcall;

type
  IDirectSoundBuffer = interface;
  IDirectSound       = interface;

  TDSBUFFERDESC = packed record
    dwSize          : DWORD;
    dwFlags         : DWORD;
    dwBufferBytes   : DWORD;
    dwReserved      : DWORD;
    lpwfxFormat     : Pointer;
    guid3DAlgorithm : TGUID;
  end;

//  PIDirectSound       = ^IDirectSound;
//  PIDirectSoundBuffer = ^IDirectSoundBuffer;

  IDirectSound = interface (IUnknown)
    ['{279AFA83-4981-11CE-A521-0020AF0BE560}']
    function CreateSoundBuffer(const lpDSBufferDesc: TDSBufferDesc;
        out lpIDirectSoundBuffer: IDirectSoundBuffer;
        pUnkOuter: IUnknown) : HResult; stdcall;
    function GetCaps(lpDSCaps: Pointer) : HResult; stdcall;
    function DuplicateSoundBuffer(lpDsbOriginal: IDirectSoundBuffer;
        out lpDsbDuplicate: IDirectSoundBuffer) : HResult; stdcall;
    function SetCooperativeLevel(hwnd: HWND; dwLevel: DWORD) : HResult; stdcall;
    function Compact: HResult; stdcall;
    function GetSpeakerConfig(var lpdwSpeakerConfig: DWORD) : HResult; stdcall;
    function SetSpeakerConfig(dwSpeakerConfig: DWORD) : HResult; stdcall;
    function Initialize(lpGuid: PGUID) : HResult; stdcall;
  end;

  IDirectSoundBuffer = interface (IUnknown)
    ['{279AFA85-4981-11CE-A521-0020AF0BE560}']
    function GetCaps(lpDSCaps: Pointer) : HResult; stdcall;
    function GetCurrentPosition
        (lpdwPlayPosition, lpdwReadPosition : PDWORD) : HResult; stdcall;
    function GetFormat(lpwfxFormat: Pointer; dwSizeAllocated: DWORD;
        lpdwSizeWritten: PDWORD) : HResult; stdcall;
    function GetVolume(var lplVolume: integer) : HResult; stdcall;
    function GetPan(var lplPan: integer) : HResult; stdcall;
    function GetFrequency(var lpdwFrequency: DWORD) : HResult; stdcall;
    function GetStatus(var lpdwStatus: DWORD) : HResult; stdcall;
    function Initialize(lpDirectSound: IDirectSound;
        const lpcDSBufferDesc: TDSBufferDesc) : HResult; stdcall;
    function Lock(dwWriteCursor, dwWriteBytes: DWORD;
        var lplpvAudioPtr1: Pointer; var lpdwAudioBytes1: DWORD;
        var lplpvAudioPtr2: Pointer; var lpdwAudioBytes2: DWORD;
        dwFlags: DWORD) : HResult; stdcall;
    function Play(dwReserved1,dwReserved2,dwFlags: DWORD) : HResult; stdcall;
    function SetCurrentPosition(dwPosition: DWORD) : HResult; stdcall;
    function SetFormat(lpcfxFormat: Pointer) : HResult; stdcall;
    function SetVolume(lVolume: integer) : HResult; stdcall;
    function SetPan(lPan: integer) : HResult; stdcall;
    function SetFrequency(dwFrequency: DWORD) : HResult; stdcall;
    function Stop: HResult; stdcall;
    function Unlock(lpvAudioPtr1: Pointer; dwAudioBytes1: DWORD;
        lpvAudioPtr2: Pointer; dwAudioBytes2: DWORD) : HResult; stdcall;
    function Restore: HResult; stdcall;
  end;

  TChunk = record
    ckid   : DWORD;
    ckSize : Integer;
  end;

  PWaveFormatEx = ^TWaveFormatEx;
  {$EXTERNALSYM tWAVEFORMATEX}
  tWAVEFORMATEX = packed record
    wFormatTag: Word;         { format type }
    nChannels: Word;          { number of channels (i.e. mono, stereo, etc.) }
    nSamplesPerSec: DWORD;    { sample rate }
    nAvgBytesPerSec: DWORD;   { for buffer estimation }
    nBlockAlign: Word;        { block size of data }
    wBitsPerSample: Word;     { number of bits per sample of mono data }
    cbSize: Word;             { the count in bytes of the size of }
  end;

  CSound = class
  public
    FName       : PChar;
    Stream      : TMemoryStream;
    StreamPos   : DWORD;
    WaveFormat  : TWAVEFORMATEX;
    WaveStart   : DWORD;
    WaveSize    : DWORD;
    DataSamples : DWORD;

    procedure   ReadData;
    procedure   LoadFromFile;
    procedure   LoadFromStream;
    procedure   CreateDSBuffer;
  public
    buffCount   : Integer;
    buffCurrent : Integer;
    Buffers     : array of IDirectSoundBuffer;

    constructor Create( aFileName : PChar;   abuffCount : Integer = 1 ); overload;
    constructor Create( aStream   : TMemoryStream; abuffCount : Integer = 1 ); overload;
    function    getBuffer : Integer;
    destructor  Destroy;

end;

type
  TSound = record
    Sound : CSound;
    Next  : Pointer;
end;
EPSound = ^TSound;
PSound  = Pointer;

const
  WAVE_FORMAT_PCM   = 1;
  WAVE_FORMAT_ADPCM = 2;

const
  DS_OK                       = $00000000;
  DSSCL_PRIORITY              = $00000002;

  DSBCAPS_PRIMARYBUFFER       = $00000001;
  DSBCAPS_STATIC              = $00000002;

  DSBCAPS_CTRLFREQUENCY       = $00000020;
  DSBCAPS_CTRLPAN             = $00000040;
  DSBCAPS_CTRLVOLUME          = $00000080;
  DSBCAPS_GETCURRENTPOSITION2 = $00010000;

  DSFX_LOCHARDWARE            = $00000001;
  DSFX_LOCSOFTWARE            = $00000002;

  DSBSTATUS_PLAYING           = $00000001;
  DSBSTATUS_BUFFERLOST        = $00000002;

  DSBPLAY_LOOPING             = $00000001;

var
  DSoundDLL         : HMODULE;
  DirectSoundCreate : function (lpGuid: PGUID; out ppDS: IDirectSound; pUnkOuter: IUnknown): HResult; stdcall;

  SoundInit   : Boolean;
  SndManager  : EPSound;
  SndCount : Integer;

  SoundActive : Boolean;

function  Snd_Init : Boolean; stdcall;
procedure Snd_DeInit; stdcall;

procedure Snd_Active( Active : Boolean ); stdcall;

function  Snd_LoadFromFile(
                            FileName    : PChar;
                            BufferCount : Integer ) : PSound; stdcall;
function Snd_LoadFromMemory(
                             Memory      : PMemory;
                             BufferCount : Integer ) : PSound; stdcall;
procedure Snd_Free( var Sound : PSound ); stdcall;
procedure Snd_FreeAll; stdcall;
procedure Snd_SetBuffersCount( Sound : PSound; Count : Integer ); stdcall;
function Snd_Play(
                   Sound     : PSound;
                   Pan       : Integer;
                   Volume    : Integer;
                   Frequency : Integer;
                   Loop      : Boolean ) : Integer; stdcall;
procedure Snd_PlayID(
                      Sound     : PSound;
                      ID        : Integer;
                      Pan       : Integer;
                      Volume    : Integer;
                      Frequency : Integer;
                      Loop      : Boolean ); stdcall;
procedure Snd_ChangeParam(
                           Sound     : PSound;
                           ID        : Integer;
                           Pan       : Integer;
                           Volume    : Integer;
                           Frequency : Integer ); stdcall;
procedure Snd_Stop( Sound : PSound ); stdcall;
procedure Snd_StopID( Sound : PSound; ID : Integer ); stdcall;
procedure Snd_StopAll; stdcall;

//----------------------------------------------------------------------------//
                                 IMPLEMENTATION
//----------------------------------------------------------------------------//

function mmioStringToFOURCC; external 'winmm.dll' name 'mmioStringToFOURCCA';

var
  DSound    : IDirectSound;
  DSoundBD  : TDSBufferDesc;
  DSoundPB  : IDirectSoundBuffer;
  DSoundWFX : TWAVEFORMATEX;

function Snd_Init;
Begin                                                          

Result := FALSE;
DSoundDLL         := LoadLibrary( 'DSound.dll' );
DirectSoundCreate := GetProcAddress( DSoundDLL, 'DirectSoundCreate' );
if DSoundDLL = 0 Then Exit;

if DirectSoundCreate( nil, DSound, nil ) <> DS_OK then
  begin
    FreeLibrary( DSoundDLL );
    DSoundDLL := 0;
    E_Error( ERR_SND_CANT_LOAD );
    Exit;
  end;

if DSound.SetCooperativeLevel( wnd_HWND, DSSCL_PRIORITY ) <> DS_OK Then
    E_Error( ERR_SND_CANT_COOPERATIVE );

FillChar( DSoundBD, SizeOf( TDSBUFFERDESC ), 0 );
DSoundBD.dwSize  := SizeOf( TDSBUFFERDESC );
DSoundBD.dwFlags := DSBCAPS_PRIMARYBUFFER +
                    DSBCAPS_CTRLPAN       +
                    DSBCAPS_CTRLVOLUME;

DSound.CreateSoundBuffer( DSoundBD, DSoundPB, nil );

FillChar( DSoundWFX, SizeOf( TWAVEFORMATEX ), 0 );
DSoundWFX.wFormatTag      := WAVE_FORMAT_PCM;
DSoundWFX.nChannels       := 2;
DSoundWFX.nSamplesPerSec  := 41000;
DSoundWFX.wBitsPerSample  := 16;
DSoundWFX.nBlockAlign     := DSoundWFX.wBitsPerSample div 8 * DSoundWFX.nChannels;
DSoundWFX.nAvgBytesPerSec := DSoundWFX.nSamplesPerSec * DSoundWFX.nBlockAlign;

DSoundPB.SetFormat( @DSoundWFX );

SoundInit   := TRUE;
SoundActive := TRUE;
Result      := TRUE;

if app_Log Then
  LOG_AddMessage( LOGT_ENGINE, LOG_SND_SUCCESSFUL );

end;

procedure Snd_DeInit;
Begin

if SoundInit Then
  begin
    DSoundPB.Stop;
    DSoundPB := NIL;
    DSound   := NIL;

    FreeLibrary( DSoundDLL );

    if app_Log Then
      LOG_AddMessage( LOGT_ENGINE, LOG_SND_SUCCESSFUL2 );
  end;

End;

procedure Snd_Active;
Begin
SoundActive := Active;
End;

function Snd_LoadFromFile;
  var
    new : EPSound;
begin

FileName := PChar( String( app_Dir ) + String( FileName ) );

Result := nil;
if not SoundInit Then exit;

new := SndManager;
while new^.Next <> nil do
  new := new^.Next;

Mem_Get( new^.Next, SizeOf( TSound ) );
EPSound( new^.Next )^.Sound := CSound.Create( FileName, BufferCount );
EPSound( new^.Next )^.Next  := nil;

INC( SndCount );
Result := new^.Next;

End;

function Snd_LoadFromMemory;
  var
    new : EPSound;
    Stm : TMemoryStream;
begin

Result := nil;
if not SoundInit Then exit;

new := SndManager;
while new^.Next <> nil do
  new := new^.Next;

Stm := TMemoryStream.Create;
Stm.Write( Memory^.Ptr^, Memory^.Size );
Stm.Seek( 0, 0 );

Mem_Get( new^.Next, SizeOf( TSound ) );
EPSound( new^.Next )^.Sound := CSound.Create( Stm, BufferCount );
Stm.Free;
EPSound( new^.Next )^.Next  := nil;

INC( SndCount );
Result := new^.Next;

End;

procedure Snd_Free;
  var
    old : EPSound;
Begin

old := SndManager;
while old^.Next <> Sound do
  old := old^.Next;

old^.Next := EPSound( old^.Next )^.Next;

EPSound( old^.Next )^.Sound.Free;
Mem_Free( old^.Next );

DEC( SndCount );
Sound  := nil;

if app_Log Then
  LOG_AddMessage( LOGT_APP, LOG_SND_FREE_SOUND );

End;

procedure Snd_FreeAll;
  var
    old : EPSound;
Begin
SndCount := 0;
while SndManager <> nil do
  begin
    old := SndManager.Next;
    SndManager.Sound.Free;
    Mem_Free( SndManager );
    SndManager := old;
    INC( SndCount );
  end;
  Mem_Get( Pointer( SndManager ), SizeOf( TSound ) );
  SndManager^.Sound := nil;
  SndManager^.Next  := nil;

if ( app_Log ) and ( SndCount > 0 ) Then
  LOG_AddMessage( LOGT_ENGINE, PChar( LOG_FREE_SOUNDS + '[' + U_IntToStr( SndCount ) + ']' ) );
End;

procedure Snd_SetBuffersCount;
  var
    i : Integer;
Begin

if Sound = nil Then exit;
SetLength( EPSound( Sound )^.Sound.Buffers, Count );
for i := EPSound( Sound )^.Sound.buffCount to Count - 1 do
  DSound.DuplicateSoundBuffer( EPSound( Sound )^.Sound.Buffers[ 0 ],
                               EPSound( Sound )^.Sound.Buffers[ i ] );

EPSound( Sound )^.Sound.buffCount := Count;

End;

function Snd_Play;
Begin

if ( not SoundInit ) or ( not SoundActive ) Then exit;

Result := -1;
if Sound = nil Then exit;
Result := EPSound( Sound )^.Sound.getBuffer;
if Result = -1 Then exit;
EPSound( Sound )^.Sound.Buffers[ Result ].SetPan      ( Pan                                         );
EPSound( Sound )^.Sound.Buffers[ Result ].SetVolume   ( Volume                                      );
EPSound( Sound )^.Sound.Buffers[ Result ].SetFrequency( Frequency                                   );
EPSound( Sound )^.Sound.Buffers[ Result ].Play        ( 0, 0, DSBPLAY_LOOPING * Byte( Loop = TRUE ) );

End;

procedure Snd_PlayID;
Begin

if ( not SoundInit ) or ( not SoundActive ) Then exit;

if ( Sound = nil ) or ( not assigned( EPSound( Sound )^.Sound.Buffers[ ID ] ) ) Then exit;
EPSound( Sound )^.Sound.Buffers[ ID ].SetPan      ( Pan                                         );
EPSound( Sound )^.Sound.Buffers[ ID ].SetVolume   ( Volume                                      );
EPSound( Sound )^.Sound.Buffers[ ID ].SetFrequency( Frequency                                   );
EPSound( Sound )^.Sound.Buffers[ ID ].Play        ( 0, 0, DSBPLAY_LOOPING * Byte( Loop = TRUE ) );

End;

procedure Snd_ChangeParam;
Begin

if ( Sound = nil ) or ( not assigned( EPSound( Sound )^.Sound.Buffers[ ID ] ) ) Then exit;
EPSound( Sound )^.Sound.Buffers[ ID ].SetPan      ( Pan       );
EPSound( Sound )^.Sound.Buffers[ ID ].SetVolume   ( Volume    );
EPSound( Sound )^.Sound.Buffers[ ID ].SetFrequency( Frequency );

End;

procedure Snd_Stop;
  var
    i : Integer;
Begin
if Sound = nil Then exit;
for i := 0 to EPSound( Sound )^.Sound.buffCount - 1 do
  EPSound( Sound )^.Sound.Buffers[ i ].Stop;
End;

procedure Snd_StopID;
Begin
if ( Sound = nil ) or ( not assigned( EPSound( Sound )^.Sound.Buffers[ ID ] ) ) Then exit;
EPSound( Sound )^.Sound.Buffers[ ID ].Stop;
End;

procedure Snd_StopAll;
  var
    heap : PSound;
    i    : Integer;
Begin
heap := SndManager.Next;
while heap <> nil do
  begin
    for i := 0 to EPSound( heap )^.Sound.buffCount - 1 do
      EPSound( heap )^.Sound.Buffers[ i ].Stop;
    heap := EPSound( heap )^.Next
  end;
End;

// TSound

constructor CSound.Create( aFileName : PChar; abuffCount : Integer = 1 );
  var
    i : Integer;
Begin
inherited Create;

buffCount := abuffCount;
SetLength( Buffers, buffCount );

FName := aFileName;
LoadFromFile;
CreateDSBuffer;
ReadData;
for i := 1 to buffCount - 1 do
  DSound.DuplicateSoundBuffer( Buffers[ 0 ], Buffers[ i ] )

End;

constructor CSound.Create( aStream : TMemoryStream; abuffCount : Integer = 1 );
  var
    i : Integer;
Begin
inherited Create;

buffCount := AbuffCount;
SetLength( Buffers, buffCount );

Stream := aStream;

LoadFromStream;
CreateDSBuffer;
ReadData;

for i := 1 to buffCount - 1 do
  DSound.DuplicateSoundBuffer( Buffers[ 0 ], Buffers[ i ] )

End;

destructor CSound.Destroy;
  var
    i : Integer;
begin

for i := 0 to buffCount - 1 do
  Buffers[ i ] := nil;
SetLength( Buffers, 0 );
Stream.Free;

inherited;
end;

function CSound.getBuffer;
  var
    DSERROR : HRESULT;
    Status  : DWORD;
begin

Result := -1;

if buffCount < 1 then exit;

buffCurrent := 0;

while buffCurrent <= buffCount - 1 do
  begin
    DSERROR := Buffers[ buffCurrent ].GetStatus( Status );
    if DSERROR <> DS_OK Then
      Status := 0;
    if ( Status and DSBSTATUS_PLAYING ) = 0 Then
      begin
        if ( Status and DSBSTATUS_BUFFERLOST ) <> 0 Then
          begin
            Buffers[ buffCurrent ].Restore;
            ReadData;
          end;
        Result := buffCurrent;
        break;
      end;
    inc( buffCurrent );
  end;

end;

procedure CSound.LoadFromFile;
begin

Stream := TMemoryStream.Create;
Stream.LoadFromFile( FName );
LoadFromStream;

end;

procedure CSound.LoadFromStream;
  var
    dw        : integer;
    BytesToGo : Integer;
    chunk     : TChunk;
begin

StreamPos := Stream.Position;
if ( Stream = nil ) or ( Stream.Size = 0 )  Then
  if ( FName = '' ) Then
    begin
      E_Error( SNDLOAD + ERR_CANT_FIND_FILE + FName );
      app_Work := FALSE;
      exit;
    end else
      begin
        E_Error( SNDLOAD + ERR_CANT_FIND_MEMORY );
        app_Work := FALSE;
        exit;
      end;

Stream.Read( chunk, SizeOf( chunk ) );
if chunk.ckid <> mmioStringToFourCC( 'RIFF', 0 ) Then
  begin
    E_Error( SNDLOAD + FROM_MEMORY + ERR_SND_NOT_WAVE );
    app_Work := FALSE;
    exit; 
  end;
if chunk.ckSize <> Stream.Size - SizeOf( chunk ) Then
  begin
    E_Error( SNDLOAD + ERR_DATA_CORRUPTED + FROM_MEMORY );
    app_Work := FALSE;
    exit;
  end;

Stream.Read( chunk, 4 );
if chunk.ckid <> mmioStringToFourCC( 'WAVE', 0 ) Then
  begin
    E_Error( ERR_SND_CANT_FIND_WAVE_DATA + FName );
    app_Work := FALSE;
    exit; 
  end;

repeat
  Stream.Read( chunk, 8 );
  BytesToGo := chunk.ckSize;
  if chunk.ckid = mmioStringToFourCC( 'fmt ', 0 ) Then
    begin
      if WaveFormat.wFormatTag = 0 then
        begin
          dw := chunk.cksize;
          if dw > SizeOf(TWaveFormatEx) Then
            dw := SizeOf(TWaveFormatEx);
          Stream.Read( WaveFormat, dw );
          BytesToGo := chunk.ckSize - dw;
        end;
    end else
      if chunk.ckid = mmioStringToFourCC( 'fact', 0 ) Then
        begin
          if ( DataSamples = 0 ) and ( WaveFormat.wFormatTag = WAVE_FORMAT_ADPCM ) Then
            begin
              Stream.Read( DataSamples, SizeOf( DWORD ) );
              Dec( BytesToGo, SizeOf( DWORD ) );
            end;
        end else
          if chunk.ckid = mmioStringToFourCC( 'data', 0 ) Then
            begin
              WaveSize  := chunk.cksize;
              WaveStart := Stream.Position;
              Break;
            end;

  Stream.Seek( BytesToGo, soFromCurrent );

until Stream.Position = 2048;

case WaveFormat.wFormatTag of
0: ;
WAVE_FORMAT_PCM :
  with WaveFormat do
    DataSamples := WaveSize div ( nAvgBytesPerSec div nSamplesPerSec );
WAVE_FORMAT_ADPCM:
  begin
    E_Error( SNDLOAD + ERR_DATA_UNSUPPORTED + FROM_MEMORY );
    app_Work := FALSE;
    exit;
  end;
else
  E_Error( SNDLOAD + ERR_DATA_CORRUPTED + FROM_MEMORY );
  app_Work := FALSE;
  exit;
end;

if app_Log Then
  if FName <> '' Then
    LOG_AddMessage( LOGT_APP, PChar( LOG_SND_LOAD_SUCCESSFUL + FName ) )
  else
    LOG_AddMessage( LOGT_APP, PChar( LOG_SND_LOAD_SUCCESSFUL + FROM_MEMORY ) );
End;


procedure CSound.CreateDSBuffer;
Begin

fillChar( DSoundBD, SizeOf( TDSBUFFERDESC ), 0 );
DSoundBD.dwSize  := sizeof( TDSBUFFERDESC );
DSoundBD.dwFlags := DSBCAPS_STATIC        +
                    DSBCAPS_CTRLPAN       +
                    DSBCAPS_CTRLVOLUME    +
                    DSBCAPS_CTRLFREQUENCY +
                    DSBCAPS_GETCURRENTPOSITION2;
DSoundBD.dwBufferBytes := waveSize;
DSoundBD.lpwfxFormat   := @WaveFormat;

DSound.CreateSoundBuffer( DSoundBD, Buffers[ 0 ], nil );

End;

procedure CSound.ReadData;
  var
    Block1, Block2 : Pointer;
    b1Size, b2Size : DWORD;
Begin

Stream.Seek( WaveStart + StreamPos, 0 );

Buffers[ 0 ].Lock( 0, WaveSize, Block1, b1Size, Block2, b2Size, 0 );
Stream.Read( Block1^, b1Size );
if b2Size <> 0 Then
  Stream.Read( Block2^, b2Size );
Buffers[0].Unlock( Block1, b1Size, Block2, b2Size );

End;

initialization
  Mem_Get( Pointer( SndManager ), SizeOf( TSound ) );
  SndManager^.Sound := nil;
  SndManager^.Next  := nil;

end.
