unit l_sound;
(*************************************)
(* Sound module by XProger           *)
(*************************************)
(* site : http://XProger.mirgames.ru *)
(* mail : XProger@list.ru            *)
(*************************************)
interface

uses
 Windows, Messages, OpenGL, DirectX, mmSystem, MiniFMOD,
 l_gl, l_math, l_utils;

var
 snd_initialized : boolean = false;
 snd_Samples     : integer;
 snd_Channels    : integer;
 snd_Playing     : integer;
 snd_volume      : integer;
 snd_off         : boolean;

 function snd_Init: boolean;
 procedure snd_deInit;

 function snd_Load(const FileName: string): integer;
 function snd_Free(Sample_ID: integer): boolean;

 procedure snd_BeginUpdate;
 procedure snd_EndUpdate;

 function snd_Play(Sample_ID: integer; Loop: boolean; Pos: TVector): integer;
 function snd_Stop(var Channel_ID: integer): boolean;
 procedure snd_StopAll(Sound_ID: integer);

 function snd_SetVolume(Channel_ID: integer; Volume: integer): boolean;
 function snd_SetPos(Channel_ID: integer; Pos: TVector): boolean;
 function snd_SetFreq(Channel_ID: integer; Freq: DWORD): boolean;
 procedure snd_SetVelocity(Channel_ID: integer; Pos: TVector);

 procedure snd_SetOrientation(front, top: TVector);
 procedure snd_SetDopplerFactor(factor: single);
 procedure snd_SetRolloffFactor(factor: single);

 procedure snd_SetGlobalPos(Pos: TVector);
 procedure snd_SetGlobalVelocity(V: TVector);

 procedure snd_Update;

implementation

type
 // Элемент массива звуков
 PSample = ^TSample;
 TSample = record
  ID       : integer;
  Next     : PSample;
  flag     : boolean;
  FileName : string;
  buffer   : IDirectSoundBuffer;
 end;

 TChannel = record
  Smp_ID   : integer;
  Buffer   : IDirectSoundBuffer;
  Buffer3D : IDirectSound3DBuffer;
  Time     : DWORD;
 end;

var
 // Главный интерфейс устройства
 ids   : IDirectSound;
 // Первичный буфер
 idsbp : IDirectSoundBuffer;
 // слушатель
 idsl  : IDirectSound3DListener;
 // Максимальное кол-во каналов
 MaxChannels : integer;
 // Массив
 Sample  : PSample;
 Channel : array of TChannel;
 nID     : integer;

function GetSample(ID: integer): PSample;
var
 p : PSample;
begin
p := Sample;
while p <> nil do
 if p^.ID = ID then
  break
 else
  p := p^.Next;
Result := p;
end;

function snd_ChannelExists(Channel_ID: integer): boolean;
begin
if (not snd_initialized) or
   (Channel_ID < 0) or
   (Channel_ID >= MaxChannels) or
   (Channel[Channel_ID].Buffer = nil) then
 Result := false
else
 Result := true;
end;

//// Загрузка из *.wav файла ///////////////////////////
function LoadFromWAV(Sample: PSample; FileName: string): boolean;
var
 F : File;
 a : array [1..4] of Char;

 audio1, audio2 : Pointer;
 audiosize1, audiosize2 : DWORD;
 hr : HResult;

 bufferdesc   : TDSBufferDesc;
 waveformat   : TWaveFormatEx;
 wavedatasize : Longint;
begin
Result := false;
if not FileExists(FileName) then Exit;
// открываем файл проверяем на RIFF заголовок
AssignFile(F, FileName);
Reset(F, 1);
BlockRead(F, a, 4);
if a <> 'RIFF' then
 begin
 CloseFile(F);
 Exit;
 end;

// skip some RIFF header data
Seek(F, 8);

// check next chunk in file to be a WAVE file
BlockRead(F, a, 4);
if a <> 'WAVE' then
 begin
 CloseFile(F);
 Exit;
 end;
Seek(F, 20);

// read in some properties of the wave data in the file
with waveformat do
 begin
 // skip first bytes of WAVE header
 BlockRead(F, waveformat, SizeOf(waveformat));
 nBlockAlign     := wBitsPerSample div 8 * nChannels;
 nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
 end;

// Таких форматов не понимаем :)
if waveformat.wBitsPerSample < 8 then
 begin
 CloseFile(F);
 Exit;
 end;

Seek(F, 40);
// читаем размер данных звука
BlockRead(F, wavedatasize, 4);

// заполняем информацию о буфере
FillChar(bufferdesc, SizeOf(bufferdesc), 0);
with bufferdesc do
 begin
 dwSize := sizeof(bufferdesc);
 dwFlags := DSBCAPS_STATIC or
            //DSBCAPS_GLOBALFOCUS or
            DSBCAPS_CTRLVOLUME or
            DSBCAPS_CTRL3D or
            DSBCAPS_CTRLFREQUENCY;
 dwBufferBytes := wavedatasize;
 lpwfxFormat   := @waveformat;
 end;

// создаём буфер по той информации :)
hr := ids.CreateSoundBuffer(bufferdesc, Sample^.buffer, nil);
if hr < DS_OK then
 begin
 CloseFile(F);
 Exit;
 end;
audio2     := nil;
audiosize2 := 0;
// блокируем
hr := Sample^.buffer.Lock(0, 0,
                          audio1,
                          audiosize1,
                          audio2,
                          audiosize2,
                          DSBLOCK_ENTIREBUFFER);
if hr < DS_OK then
 begin
 CloseFile(F);
 Exit;
 end;

// заполняем
BlockRead(F, audio1^, wavedatasize);
CloseFile(F);

// разблокируем
if Sample^.buffer.Unlock(audio1, audiosize1, audio2, audiosize2) < DS_OK then
 Exit;

Result := true;
end;
////////////////////////////////////////////////////////

///////// ИНИЦИАЛИЗАЦИЯ //////////
function snd_Init: boolean;
var
 dsbufferdesc : TDSBufferDesc;
 waveformat   : TWaveFormatEx;
begin
Result := false;
if snd_initialized then Exit;
snd_initialized := false;

// создание первичного буфера
if DirectSoundCreate(nil, ids, nil) <> DS_OK then
 Exit;

ids.SetCooperativeLevel(Handle, DSSCL_EXCLUSIVE);

FillChar(dsbufferdesc, sizeof(dsbufferdesc), 0);
with dsbufferdesc do
 begin
 dwSize        := sizeof(dsbufferdesc);
 dwFlags       := DSBCAPS_CTRL3D or
                  DSBCAPS_PRIMARYBUFFER or
                  DSBCAPS_LOCSOFTWARE;
 dwBufferBytes := 0;
 dwReserved    := 0;
 lpwfxFormat   := nil;
 end;

if ids.CreateSoundBuffer(dsbufferdesc, idsbp, nil) <> DS_OK then
 Exit;

// установка выходного формата
with waveformat do
 begin
 wFormatTag      := WAVE_FORMAT_PCM;
 nChannels       := 1;
 nSamplesPerSec  := 22050;
 wBitsPerSample  := 16;
 nBlockAlign     := 2;
 nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
 end;
 
if idsbp.Play(0, 0, DSBPLAY_LOOPING) <> DS_OK then
 Exit;

if idsbp.QueryInterface(IID_IDirectSound3DListener,
                        idsl) = DS_OK then
 begin
 idsl.SetDistanceFactor(1, DS3D_DEFERRED);
 idsl.SetRolloffFactor(0.05, DS3D_DEFERRED);
 idsl.SetOrientation(0, 1, 0, 0, 0, 1, DS3D_DEFERRED);
 idsl.CommitDeferredSettings;
 end;

Sample := nil;
nID    := 0;

snd_Samples := 0;
MaxChannels := 32;
SetLength(Channel, MaxChannels);

Result := true;
snd_initialized := true; 
end;

procedure snd_deInit;
var
 i : integer;
 p : PSample;
begin
for i := 0 to MaxChannels - 1 do
 begin
 Channel[i].Buffer   := nil;
 Channel[i].Buffer3D := nil;
 Channel[i].Smp_ID   := -1;
 end;

p := Sample;
while p <> nil do
 begin
 p^.buffer := nil;
 p         := p^.Next;
 end;

snd_Samples := 0;
Sample := nil;
idsbp  := nil;
//ids    := nil;
end;

function snd_Free(Sample_ID: integer): boolean;
var
 tmp, p : PSample;
 i      : integer;
begin
Result := false;
if not snd_initialized then Exit;

tmp := GetSample(Sample_ID);
if tmp = nil then
 Exit;

for i := 0 to MaxChannels - 1 do
 if Channel[i].Smp_ID = tmp^.ID then
  with Channel[i] do
   begin
   if Buffer <> nil then
    Buffer.Stop;
   Buffer   := nil;
   Buffer3D := nil;
   Smp_ID   := -1;
   end;
tmp^.buffer := nil;

if tmp^.Next <> nil then
 tmp^ := tmp^.Next^
else
 begin
 p := Sample;
 if tmp = p then
  Sample := nil
 else
  while p <> nil do
   if p^.Next = tmp then
    begin
    p^.Next := nil;
    break;
    end
   else
    p := p^.Next;
 end;

dec(snd_Samples);

Result := true;
end;

// Функция, возврящает идентификатор звука
function snd_Load(const FileName: string): integer;
var
 tmpSample : PSample;
 p         : PSample;
 str       : string;
begin
Result := -1;
if not snd_initialized then Exit;

str := FileName;
p := Sample;
while p <> nil do
 if p^.FileName = str then
  begin
  p^.flag := false;
  Result  := p^.ID;
  Exit;
  end
 else
  p := p^.Next;

New(tmpSample);
tmpSample^.FileName := str;
 try
  if LoadFromWAV(tmpSample, str) then
   begin
   inc(nID);

   tmpSample^.Next := Sample;
   tmpSample^.ID   := nID;
   tmpSample^.flag := false;

   Sample := tmpSample;

   inc(snd_Samples);
   Result := nID;
   end
 except
 end;

if Result = -1 then
 Dispose(tmpSample);
end;

procedure snd_BeginUpdate;
var
 p : PSample;
begin
p := Sample;
while p <> nil do
 begin
 p^.flag := true;
 p       := p^.Next;
 end;
end;

procedure snd_EndUpdate; 
var
 p : PSample;
 b : boolean;
begin
p := Sample;
while p <> nil do
 if p^.flag then
  begin
  b := p^.Next = nil;
  snd_Free(p^.ID);
  if b then break;
  end
 else
  p := p^.Next;  
end;

// Проигрывает звук с ID и возвращает номер канала //
function snd_Play(Sample_ID: integer; Loop: boolean; Pos: TVector): integer;
var
 i      : integer;
 tmp    : PSample;
 Status : DWORD;

 function Play(i: integer): integer;
 var
  hr : HResult;
 begin
 Channel[i].buffer3D.SetPosition(Pos.X, Pos.Y, Pos.Z, DS3D_DEFERRED);
 ids.SetCooperativeLevel(Handle, DSSCL_NORMAL);
 if Loop then
  hr := Channel[i].Buffer.Play(0, 0, DSBPLAY_LOOPING)
 else
  hr := Channel[i].Buffer.Play(0, 0, 0);
 if hr <> DS_OK then
  Result := -1
 else
  begin
  Channel[i].Time := GetTickCount;
  Result := i;
  end;
 end;

 function Copy(i: integer): boolean;
 begin
 Result := false;
 Channel[i].Smp_ID := Sample_ID;
 // Самая тормознутая функция всей процедуры
 ids.DuplicateSoundBuffer(tmp.buffer, Channel[i].Buffer);

 if Channel[i].buffer.QueryInterface(IID_IDirectSound3DBuffer,
                                     Channel[i].buffer3D) <> DS_OK then
  begin
  Channel[i].Buffer.Restore;
  Channel[i].buffer   := nil;
  Channel[i].Buffer3D := nil;
  Exit;
  end;
 Result := true; 
 end;

begin
Result := -1;
if snd_off then Exit;
if not snd_initialized then Exit;

tmp := GetSample(Sample_ID); // ищем сэмпл
if tmp = nil then Exit;      // нет такого
                    
// Вдруг существует остановленный канал для этого звука
for i := 0 to MaxChannels - 1 do
 if (Channel[i].Buffer <> nil) and
    (Sample_ID = Channel[i].Smp_ID) then
  begin
  if (Channel[i].Buffer.GetStatus(Status) = DS_OK) and
     (Status and DSBSTATUS_PLAYING = 0) then
   begin
   Result := Play(i);
   Exit;
   end;
  end;

// Ну что ж придётся буфер выделять...
for i := 0 to MaxChannels - 1 do
 if Channel[i].Buffer = nil then
  begin
  if Copy(i) then
   Result := Play(i);
  Exit;
  end;

// Нет места, придётся мертвецов не нужных убирать
for i := 0 to MaxChannels - 1 do
 // Ищем мёртвый канал
 if Channel[i].Buffer <> nil then
  begin
  if not((Channel[i].Buffer.GetStatus(Status) = DS_OK) and
         (Status and DSBSTATUS_PLAYING <> 0)) then
   begin
   Channel[i].Buffer.Restore;
   Channel[i].Buffer   := nil;
   Channel[i].Buffer3D := nil;
   end
  else
   continue;

  if Copy(i) then
   Result := Play(i);
  Exit;
  end;    
end;

function snd_Stop(var Channel_ID: integer): boolean;
begin
Result := false;
if not snd_ChannelExists(Channel_ID) then Exit;
Result := Channel[Channel_ID].Buffer.Stop = DS_OK;
Channel[Channel_ID].Buffer.SetCurrentPosition(0);
Channel_ID := -1;
end;

procedure snd_StopAll(Sound_ID: integer);
var
 i : integer;
begin
if not snd_initialized then Exit;
// Остановить проигрывание всех звуков
if Sound_ID <= 0 then
 begin
 for i := 0 to MaxChannels - 1 do
  if Channel[i].Buffer <> nil then
   Channel[i].Buffer.Stop;
 end
else
 // Остановить каналы этого Sound_ID
 for i := 0 to MaxChannels - 1 do
  if (Channel[i].Buffer <> nil) and
     (Channel[i].Smp_ID = Sound_ID) then
   Channel[i].Buffer.Stop;
end;

function snd_SetVolume(Channel_ID: integer; Volume: integer): boolean;
begin
Result := false;
if snd_off then Exit;
if not snd_ChannelExists(Channel_ID) then Exit;
Volume := - 50 * (100 - Volume);
Result :=  Channel[Channel_ID].buffer.SetVolume(Volume) = DS_OK;
end;

function snd_SetPos(Channel_ID: integer; Pos: TVector): boolean;
begin
Result := false;
if snd_off then Exit;
if not snd_ChannelExists(Channel_ID) then Exit;
Result := Channel[Channel_ID].buffer3D.SetPosition(Pos.X, Pos.Y, Pos.Z, DS3D_DEFERRED) = DS_OK;
end;

function snd_SetFreq(Channel_ID: integer; Freq: DWORD): boolean;
begin
Result := false;
if snd_off then Exit;
if not snd_ChannelExists(Channel_ID) then Exit;
Result := Channel[Channel_ID].buffer.SetFrequency(Freq) = DS_OK;
end;

procedure snd_SetVelocity(Channel_ID: integer; Pos: TVector);
begin
if snd_off then Exit;
if not snd_ChannelExists(Channel_ID) then Exit;
Channel[Channel_ID].Buffer3D.SetVelocity(Pos.X, Pos.Y, Pos.Z, DS3D_DEFERRED);
end;

procedure snd_SetGlobalPos(Pos: TVector);
begin
if snd_off then Exit;
if not snd_initialized then Exit;
if idsl <> nil then
 idsl.SetPosition(Pos.X, Pos.Y, Pos.Z, DS3D_DEFERRED);
end;

//Скорость передвижения ушей
procedure snd_SetGlobalVelocity(V: TVector);
begin
if snd_off then Exit;
if not snd_initialized then Exit;
if idsl <> nil then
 idsl.SetVelocity(V.Y, V.Y, V.Z, DS3D_DEFERRED);
end;

procedure snd_SetOrientation(front, top: TVector);
begin
if snd_off then Exit;
if not snd_initialized then Exit;
if idsl <> nil then
 idsl.SetOrientation(front.X, front.Y, front.Z,
                     top.X, top.Y, top.Z,
                     DS3D_DEFERRED);
end;

procedure snd_SetDopplerFactor(factor: single);
begin
if snd_off then Exit;
if not snd_initialized then Exit;
if idsl <> nil then
 idsl.SetDopplerFactor(factor, DS3D_DEFERRED);
end;

procedure snd_SetRolloffFactor(factor: single);
begin
if snd_off then Exit;
if not snd_initialized then Exit;
if idsl <> nil then
 idsl.SetRolloffFactor(factor, DS3D_DEFERRED);
end;

procedure snd_Update;
var
 i      : integer;
 Status : DWORD;
 t      : DWORD;
begin
if not snd_initialized then Exit;
if idsl = nil then
 if idsbp.QueryInterface(IID_IDirectSound3DListener,
                         idsl) = DS_OK then
  begin
  idsl.SetDistanceFactor(1, DS3D_DEFERRED);
  idsl.SetRolloffFactor(0.01, DS3D_DEFERRED);
  idsl.SetOrientation(0, 1, 0, 0, 0, 1, DS3D_DEFERRED);
  end;

snd_Channels := 0;
snd_Playing  := 0;

t := GetTickCount;
for i := 0 to MaxChannels - 1 do
 if Channel[i].Buffer <> nil then
  if (Channel[i].Buffer.GetStatus(Status) = DS_OK) and
     (status and DSBSTATUS_PLAYING <> 0) then
   begin
   inc(snd_Playing);
   inc(snd_Channels);
   end
  else
   if t - Channel[i].Time > 3000 then
    begin
    Channel[i].Buffer.Restore;
    Channel[i].buffer   := nil;
    Channel[i].Buffer3D := nil;
    end
   else
    inc(snd_Channels);

idsl.CommitDeferredSettings;
end;

end.


