unit dgSoundEngine;
// ---------------------------------------------------------------------------//
// Copyright © 2005-2011 DunconGames. All rights reserved. BSD License. Authors: Duncon, simsmen (02.08.2011)
// Для AC97 кодеков в режиме эмуляции - max 16 источников.
// ---------------------------------------------------------------------------//
// Histiry:
//  2009.12.00 Duncon - Вниманее добавленна функция автологирования ошибок
//    С текущей версии двиг будет обходить все ошибки записывая их в лог
//    (SoundEngineErrorLog.txt) который матерелизуется рядом с exe в случае возникновения оных.
//    Отрубать по необходимости в dgSoundUses procedure LogMe.. И initialization .. if seFileExist..
// ---------------------------------------------------------------------------//

interface
{$IF CompilerVersion>16}{$DEFINE dgR}{$IFEND}
uses dgSoundUses;
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      TdgSoundDevice type      '}{$ENDIF}
type
  TdgSoundDevice = class//(TdgSoundDevice)
    constructor Create;
    destructor Destroy; override;
  private
    fUseDevice: PAnsiChar; //Устройство используемое для вывода звука
    fDeviceList: array[0..12] of PAnsiChar;//тут бум хранить все устройства в системе способные вывести звук
    fDeviceListCount: Byte;
    fMaxQuantitySources: Word;
  public
    function GetDevice: String;// override;
    function GetDeviceCount: Byte;// override;
    function GetDeviceBy(const aIndex: Byte): String;// override;
    function GetEAXSupported: Boolean;// override;
    function GetMaxQuantitySources: Word;// override;
    procedure SetDevice(const aName: String);// override;
    procedure SetDeviceA(const aName: PAnsiChar);// override;

    property EAXSupported: Boolean read GetEAXSupported;
    property UseDevice: String read GetDevice write SetDevice;
  end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      TdgListener      '}{$ENDIF}
  TdgListener = class//(TdgListener)
    constructor Create;
  private
    fDistanceModel: Integer;
    fGain: Single; //[0.0..1.0] = 1.0
    fPosition, fDirection, fUp, fVelocity: TdgVector3f; //fVelocity (скорость) - отвечает за Эффект Доплера
    //- EAX ------------ * - дефолтовое значение зависит от выбранного эффекта
    fEAXSupported, //Поддерживается ли EAX
      fEAXOn: Boolean; // Включён ли
    fEAXEnvironment: Byte; //[0..25] = 0
    fEAXEnvironmentSize, //[1.0..100.0] * meters
      fEAXEnvironmentDiffusion: Single; //[0.0..1.0] *
    fEAXRoom, //[-10000..0] = * mB
      fEAXRoomHF: Integer; //[-10000..0] = *
    fEAXDecayTime, //[0.1..20.0] = * seconds
      fEAXDecayHFRatio: Single; //[0.1..2.0] = *
    fEAXReflections: Integer; //[-10000..1000] = * mB
    fEAXReflectionsDelay: Single; //[0.0..0.3] = * seconds
    fEAXReverb: Integer; //[-10000..2000] = * mB
    fEAXReverbDelay, //[0.0..0.1] = * seconds
      fEAXRolloffFactor, //[0.0..10.0] = 0.0
      fEAXAirAbsorptionHF: Single; //[-100.0..0.0] = -5.0 mB/m
    fEAXDecayTimeScale, //True
      fEAXReflectionsScale, //True
      fEAXReflectionsDelayScale, //True
      fEAXReverbScale, //True
      fEAXReverbDelayScale, //True
      fEAXDecayHFLimit: Boolean; // = *
  public
    function GetGain: Single;// override;
    function GetUp: TdgVector3f;// override;
    function GetPosition: TdgVector3f;// override;
    function GetVelocity: TdgVector3f;// override;
    function GetDirection: TdgVector3f;// override;
    function GetDistanceModel: Integer;// override;
    procedure ApplyOrientation;// override;
    procedure ApplyParameters;// override;
    procedure SetGain(const aValue: Single);// override;
    procedure SetUp(const aValue: TdgVector3f);// override;
    procedure SetPosition(const aValue: TdgVector3f);// override;
    procedure SetVelocity(const aValue: TdgVector3f);// override;
    procedure SetDirection(const aValue: TdgVector3f);// override;
    procedure SetOrientation(const aDirection, aUp: TdgVector3f);// override;
    procedure SetDistanceModel(const aValue: Integer);// override;

    function GetEAXOn: Boolean;// override;
    function GetEAXEnvironment: Byte;// override;
    function GetEAXEnvironmentSize: Single;// override;
    function GetEAXEnvironmentDiffusion: Single;// override;
    function GetEAXRoom: Integer;// override;
    function GetEAXRoomHF: Integer;// override;
    function GetEAXDecayTime: Single;// override;
    function GetEAXDecayHFRatio: Single;// override;
    function GetEAXReflections: Integer;// override;
    function GetEAXReflectionsDelay: Single;// override;
    function GetEAXReverb: Integer;// override;
    function GetEAXReverbDelay: Single;// override;
    function GetEAXRolloffFactor: Single;// override;
    function GetEAXAirAbsorptionHF: Single;// override;
    function GetEAXDecayTimeScale: Boolean;// override;
    function GetEAXReflectionsScale: Boolean;// override;
    function GetEAXReflectionsDelayScale: Boolean;// override;
    function GetEAXReverbScale: Boolean;// override;
    function GetEAXReverbDelayScale: Boolean;// override;
    function GetEAXDecayHFLimit: Boolean;// override;
    procedure SetEAXOn(const aValue: Boolean);// override;
    procedure SetEAXEnvironment(const aValue: Byte);// override;
    procedure SetEAXEnvironmentSize(const aValue: Single);// override;
    procedure SetEAXEnvironmentDiffusion(const aValue: Single);// override;
    procedure SetEAXRoom(const aValue: Integer);// override;
    procedure SetEAXRoomHF(const aValue: Integer);// override;
    procedure SetEAXDecayTime(const aValue: Single);// override;
    procedure SetEAXDecayHFRatio(const aValue: Single);// override;
    procedure SetEAXReflections(const aValue: Integer);// override;
    procedure SetEAXReflectionsDelay(const aValue: Single);// override;
    procedure SetEAXReverb(const aValue: Integer);// override;
    procedure SetEAXReverbDelay(const aValue: Single);// override;
    procedure SetEAXRolloffFactor(const aValue: Single);// override;
    procedure SetEAXAirAbsorptionHF(const aValue: Single);// override;
    procedure SetEAXDecayTimeScale(const aValue: Boolean);// override;
    procedure SetEAXReflectionsScale(const aValue: Boolean);// override;
    procedure SetEAXReflectionsDelayScale(const aValue: Boolean);// override;
    procedure SetEAXReverbScale(const aValue: Boolean);// override;
    procedure SetEAXReverbDelayScale(const aValue: Boolean);// override;
    procedure SetEAXDecayHFLimit(const aValue: Boolean);// override;
    procedure SetDefaultEAXParameters;// override;

    property Gain: Single read GetGain write SetGain;
    property Velocity: TdgVector3f read GetVelocity write SetVelocity;
    property Up: TdgVector3f read GetUp write SetUp;
    property Direction: TdgVector3f read GetDirection write SetDirection;
    property Position: TdgVector3f read GetPosition write SetPosition;
    property DistanceModel: Integer read GetDistanceModel write SetDistanceModel; //AL_NONE, AL_INVERSE_DISTANCE, AL_INVERSE_DISTANCE_CLAMPED.

    property EAXOn: Boolean read GetEAXOn write SetEAXOn;
    property EAXEnvironment: Byte read GetEAXEnvironment write SetEAXEnvironment;
    property EAXEnvironmentSize: Single read GetEAXEnvironmentSize write SetEAXEnvironmentSize;
    property EAXEnvironmentDiffusion: Single read GetEAXEnvironmentDiffusion write SetEAXEnvironmentDiffusion;
    property EAXRoom: Integer read GetEAXRoom write SetEAXRoom;
    property EAXRoomHF: Integer read GetEAXRoomHF write SetEAXRoomHF;
    property EAXDecayTime: Single read GetEAXDecayTime write SetEAXDecayTime;
    property EAXDecayHFRatio: Single read GetEAXDecayHFRatio write SetEAXDecayHFRatio;
    property EAXReflections: Integer read GetEAXReflections write SetEAXReflections;
    property EAXReflectionsDelay: Single read GetEAXReflectionsDelay write SetEAXReflectionsDelay;
    property EAXReverb: Integer read GetEAXReverb write SetEAXReverb;
    property EAXReverbDelay: Single read GetEAXReverbDelay write SetEAXReverbDelay;
    property EAXRolloffFactor: Single read GetEAXRolloffFactor write SetEAXRolloffFactor;
    property EAXAirAbsorptionHF: Single read GetEAXAirAbsorptionHF write SetEAXAirAbsorptionHF;
    property EAXDecayTimeScale: Boolean read GetEAXDecayTimeScale write SetEAXDecayTimeScale;
    property EAXReflectionsScale: Boolean read GetEAXReflectionsScale write SetEAXReflectionsScale;
    property EAXReflectionsDelayScale: Boolean read GetEAXReflectionsDelayScale write SetEAXReflectionsDelayScale;
    property EAXReverbScale: Boolean read GetEAXReverbScale write SetEAXReverbScale;
    property EAXReverbDelayScale: Boolean read GetEAXReverbDelayScale write SetEAXReverbDelayScale;
    property EAXDecayHFLimit: Boolean read GetEAXDecayHFLimit write SetEAXDecayHFLimit;
  end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      TdgOGGSound      '}{$ENDIF}
  PByteArray = ^TByteArray;
  TByteArray = array[0..32767] of Byte;
  TNoiseData = array[0..4096] of Smallint;
  PNoiseData = ^TNoiseData;
//------------------------------------------------------------------------------
  TdgOGGSound = class//(TdgOGGSound)
    constructor Create;
    destructor Destroy; override;
  private
    Data: PChar; //PCM
    fBufferSize: Word;
    fName, fPath: String;//AnsiString; //Path содержит полный путь и имя
    fFormat: Integer;
    fSource: Cardinal;
    fRepeatCount: Word;
    fTimeStart: Double; //позиция с которой стартует воспроизведение = 0
    fOggTimer: TdgTimer;
    fOggStream: TdgStream;
    fOggFile: OGGVorbis_File;
    fVorbisInfo: Vorbis_Info;
    fops_callbacks: ov_callbacks;
    fBuffers: array[0..1] of Cardinal;
    fLoop, fPause, fInMem, fUse: Boolean;
    fPosition, fDirection, fVelocity: TdgVector3f; //fVelocity (скорость) - отвечает за Эффект Доплера
    fPitch, //[0.5-2.0] = 1.0
      fGain, //[0.0..1.0] = 1.0
      fMaxDistance, //[0, +inf] = 10000.0 на каком расстоянии перестает расчитываться источник
      fRollOffFactor, //[0, 10.0] = 1.0
      fReferenceDistance, //[0, +inf] = 1.0 по ходу это минимальная дитнанция, не изучал
      fMinGane, //[0, 1.0] = 0.0  минимальное значение всегда обеспечиваемое источнику
      fMaxGane, //[0, 1.0] = 1.0
      fConeOuterGain, //[0.0f, 1.0f] = 0.0
      fConeInnerAngle, //[0-360] = 360.0
      fConeOuterAngle: Single; //[0-360] = 360.0
    fSourseRelative, // = FALSE
      fEAXSupported: Boolean; //Поддерживается ли EAX
    //- EAX - Source -----------------------------------------------------------
    fEAXDirect, //[-10000..1000] = 0
      fEAXDirectHF, //[-10000..0] = 0
      fEAXRoom, //[-10000..1000] = 0
      fEAXRoomHF, //[-10000..0] = 0
      fEAXObstruction: Integer; //[-10000..0] = 0
    fEAXObstructionLFRatio: Single; //[0.0..1.0] = 0.0
    fEAXOcclusion: Integer; //[-10000..0] = 0
    fEAXOcclusionLFRatio, //[0.0..1.0] = 0.25
      fEAXOcclusionRoomRatio, //[0.0..10.0] = 0.5
      fEAXRolloffFactor, //[0.0..10.0] = 0.0
      fEAXAbsorptionFactor: Single; //[0.0..10.0] = 1.0
    fEAXOutsideVolumeHF: Integer; //[-10000..0] = 0
    fEAXDirectHFAuto, fEAXRoomAuto, fEAXRoomHFAuto: Boolean; //True
  public
    function Playing: Boolean;// override;
    function Playback: Boolean;// override;
    function Stream(const Buffer: Cardinal): Boolean;// override;
    procedure Connect;
    procedure Disconnect;
    procedure Stop;// override;
    procedure Pause;// override;
    procedure Update;// override;
    procedure ApplyParameters;// override;
    procedure SetDefaultParameters;// override;
    procedure TimerTime(Sender: TObject);// override;
    procedure Play(StopIfPlay: Boolean = True; RepeatTimes: Word = 0);// override;
    procedure LoadFromFile(const aFileName: String; const aInMemory: Boolean = True);// override;
    function GetNoiseLevel: Smallint;// override;
    function GetNoiseGraph(Amplitude: Word): TNoiseData;// override;
    function GetName: String;// override;
    function GetPath: String;// override;
    function GetUse: Boolean;// override;
    function GetGain: Single;// override;
    function GetPitch: Single;// override;
    function GetLoop: Boolean;// override;
    function GetMinGane: Single;// override;
    function GetMaxGane: Single;// override;
    function GetFrequency: Integer;// override;
    function GetInMemory: Boolean;// override;
    function GetTimeStart: Double;// override;
    function GetTimeTotal: Double;// override;
    function GetTimeOffset: Double;// override;
    function GetMaxDistance: Single;// override;
    function GetRollOffFactor: Single;// override;
    function GetConeOuterGain: Single;// override;
    function GetConeInnerAngle: Single;// override;
    function GetConeOuterAngle: Single;// override;
    function GetReferenceDistance: Single;// override;
    function GetPosition: TdgVector3f;// override;
    function GetVelocity: TdgVector3f;// override;
    function GetDirection: TdgVector3f;// override;
    function GetSourseRelative: Boolean;// override;
    procedure SetGain(const aValue: Single);// override;
    procedure SetPitch(const aValue: Single);// override;
    procedure SetName(const aValue: String);// override;
    procedure SetPath(const aValue: String);// override;
    procedure SetLoop(const aValue: Boolean);// override;
    procedure SetMinGain(const aValue: Single);// override;
    procedure SetMaxGain(const aValue: Single);// override;
    procedure SetFrequency(const aValue: Integer);// override;
    procedure SetTimeStart(const pos: Double);// override;
    procedure SetTimeOffset(const pos: Double);// override;
    procedure SetInMemory(const aValue: Boolean);// override;
    procedure SetMaxDistance(const aValue: Single);// override;
    procedure SetRollOffFactor(const aValue: Single);// override;
    procedure SetConeOuterGain(const aValue: Single);// override;
    procedure SetConeInnerAngle(const aValue: Single);// override;
    procedure SetConeOuterAngle(const aValue: Single);// override;
    procedure SetReferenceDistance(const aValue: Single);// override;
    procedure SetSourseRelative(const aValue: Boolean);// override;
    procedure SetVelocity(const aValue: TdgVector3f);// override;
    procedure SetPosition(const aValue: TdgVector3f);// override;
    procedure SetDirection(const aValue: TdgVector3f);// override;

    function GetEAXDirect: Integer;// override;
    function GetEAXDirectHF: Integer;// override;
    function GetEAXRoom: Integer;// override;
    function GetEAXRoomHF: Integer;// override;
    function GetEAXObstruction: Integer;// override;
    function GetEAXObstructionLFRatio: Single;// override;
    function GetEAXOcclusion: Integer;// override;
    function GetEAXOcclusionLFRatio: Single;// override;
    function GetEAXOcclusionRoomRatio: Single;// override;
    function GetEAXRolloffFactor: Single;// override;
    function GetEAXAbsorptionFactor: Single;// override;
    function GetEAXOutsideVolumeHF: Integer;// override;
    function GetEAXDirectHFAuto: Boolean;// override;
    function GetEAXRoomAuto: Boolean;// override;
    function GetEAXRoomHFAuto: Boolean;// override;
    procedure SetEAXOn;// override;
    procedure SetEAXDirect(const aValue: Integer);// override;
    procedure SetEAXDirectHF(const aValue: Integer);// override;
    procedure SetEAXRoom(const aValue: Integer);// override;
    procedure SetEAXRoomHF(const aValue: Integer);// override;
    procedure SetEAXObstruction(const aValue: Integer);// override;
    procedure SetEAXObstructionLFRatio(const aValue: Single);// override;
    procedure SetEAXOcclusion(const aValue: Integer);// override;
    procedure SetEAXOcclusionLFRatio(const aValue: Single);// override;
    procedure SetEAXOcclusionRoomRatio(const aValue: Single);// override;
    procedure SetEAXRolloffFactor(const aValue: Single);// override;
    procedure SetEAXAbsorptionFactor(const aValue: Single);// override;
    procedure SetEAXOutsideVolumeHF(const aValue: Integer);// override;
    procedure SetEAXDirectHFAuto(const aValue: Boolean);// override;
    procedure SetEAXRoomAuto(const aValue: Boolean);// override;
    procedure SetEAXRoomHFAuto(const aValue: Boolean);// override;

    property use: Boolean read GetUse;
    property Name: String read GetName write SetName;
    property Path: String read GetPath write SetPath;
    property InMemory: Boolean read GetInMemory write SetInMemory;
    property SourceRelative: Boolean read GetSourseRelative write SetSourseRelative;
    property TimeOffset: Double read GetTimeOffset write SetTimeOffset;
    property TimeStart: Double read GetTimeStart write SetTimeStart;
    property TimeTotal: Double read GetTimeTotal;
    property Gain: Single read GetGain write SetGain;
    property loop: Boolean read GetLoop write SetLoop;
    property Pitch: Single read GetPitch write SetPitch;
    property MinGane: Single read GetMinGane write SetMinGain;
    property MaxGane: Single read GetMaxGane write SetMaxGain;
    property Frequency: Integer read GetFrequency write SetFrequency;
    property Position: TdgVector3f read GetPosition write SetPosition;
    property Velocity: TdgVector3f read GetVelocity write SetVelocity;
    property Direction: TdgVector3f read GetDirection write SetDirection;
    property MaxDistance: Single read GetMaxDistance write SetMaxDistance;
    property RollOffFactor: Single read GetRollOffFactor write SetRollOffFactor;
    property ConeOuterGain: Single read GetConeOuterGain write SetConeOuterGain;
    property ConeInnerAngle: Single read GetConeInnerAngle write SetConeInnerAngle;
    property ConeOuterAngle: Single read GetConeOuterAngle write SetConeOuterAngle;
    property ReferenceDistance: Single read GetReferenceDistance write SetReferenceDistance;

    property EAXDirect: Integer read GetEAXDirect write SetEAXDirect;
    property EAXDirectHF: Integer read GetEAXDirectHF write SetEAXDirectHF;
    property EAXRoom: Integer read GetEAXRoom write SetEAXRoom;
    property EAXRoomHF: Integer read GetEAXRoomHF write SetEAXRoomHF;
    property EAXObstruction: Integer read GetEAXObstruction write SetEAXObstruction;
    property EAXObstructionLFRatio: Single read GetEAXObstructionLFRatio write SetEAXObstructionLFRatio;
    property EAXOcclusion: Integer read GetEAXOcclusion write SetEAXOcclusion;
    property EAXOcclusionLFRatio: Single read GetEAXOcclusionLFRatio write SetEAXOcclusionLFRatio;
    property EAXOcclusionRoomRatio: Single read GetEAXOcclusionRoomRatio write SetEAXOcclusionRoomRatio;
    property EAXRolloffFactor: Single read GetEAXRolloffFactor write SetEAXRolloffFactor;
    property EAXAbsorptionFactor: Single read GetEAXAbsorptionFactor write SetEAXAbsorptionFactor;
    property EAXOutsideVolumeHF: Integer read GetEAXOutsideVolumeHF write SetEAXOutsideVolumeHF;
    property EAXDirectHFAuto: Boolean read GetEAXDirectHFAuto write SetEAXDirectHFAuto;
    property EAXRoomAuto: Boolean read GetEAXRoomAuto write SetEAXRoomAuto;
    property EAXRoomHFAuto: Boolean read GetEAXRoomHFAuto write SetEAXRoomHFAuto;
  end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      TdgSounds type       '}{$ENDIF}
  TdgSounds = class//(TdgSounds)
    constructor Create;
    destructor Destroy; override;
  private
    fSoundList: TdgList;
  public
    function GetCount: Integer;// override;
    function GetIndex(const aName: String): Integer;// override;
    function GetSound(const aName: String): TdgOGGSound;// override;
    function GetSoundBy(const aIndex: Integer): TdgOGGSound;// override;
    function AddSound(aFileName: String; const aInMemory: Boolean = True): Boolean;// override;
    procedure AddSoundsFromFolder(const aPath: String; const aInMemory: Boolean = True); // override;
    procedure StopAllSounds;// override;
    procedure PauseAllSounds;// override;
    procedure DeleteAllSounds;// override;
    procedure UnPauseAllSounds;// override;
    procedure DeleteSound(const aName: String);// override;
    procedure Assign(const aNewSoundName, copyFromSound: String);// override;
    procedure Duplicate(const aNewSoundName, copyFromSound: String);// override;

    property Count: Integer read getCount;
    property Items[const aIndex: Integer]: TdgOGGSound read GetSoundBy;
    property Sound[const aName: String]: TdgOGGSound read GetSound; default;
  end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
var
  SoundDevice: TdgSoundDevice;
  Listener: TdgListener;
  Sounds: TdgSounds;
  seFunc: record
    LogMe: procedure(txt: String; Rewr: Boolean = False);
    IntToStr: function(Value: Integer): String;
    SingleToStr: function(const aValue: Single; const aCutLength: Byte = 2): String;
    dgVector3f: function(const aX, aY, aZ: TdgFloat): TdgVector3f;
    SameStr: function(const S1, S2: String): Boolean;
    FileExists: function (const FileName: String): Boolean;
    ExtractFileName: function (const FileName: String): String;
    ExtractFileExt: function(const FileName: String): String;
    ExtractFileDir: function(const FileName: string): string;
    FindFirst: function(const Path: string; Attr: Integer; var  F: TSearchRec): Integer;
    FindNext: function(var F: TSearchRec): Integer;
    FindClose: procedure(var F: TSearchRec);
  end;

implementation

var
  vEAXSupported: Boolean;

{$IFDEF dgR}{$REGION '      TdgSoundDevice      '}{$ENDIF}
constructor TdgSoundDevice.Create;
  //----------------------------------------------------------------------------
  function StrCopy(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
  asm
    sub   edx, eax
    test  eax, 1
    push  eax
    jz    @loop
    movzx ecx, byte ptr[eax+edx]
    mov   [eax], cl
    test  ecx, ecx
    jz    @ret
    inc   eax
  @loop:
    movzx ecx, byte ptr[eax+edx]
    test  ecx, ecx
    jz    @move0
    movzx ecx, word ptr[eax+edx]
    mov   [eax], cx
    add   eax, 2
    cmp   ecx, 255
    ja    @loop
  @ret:
    pop   eax
    ret
  @move0:
    mov   [eax], cl
    pop   eax
  end;
  //----------------------------------------------------------------------------
  function StrMove(Dest: PAnsiChar; const Source: PAnsiChar; Count: Cardinal): PAnsiChar;
  begin
    Result := Dest;
    Move(Source^, Dest^, Count * SizeOf(AnsiChar));
  end;
  //----------------------------------------------------------------------------
  function AnsiStrAlloc(Size: Cardinal): PAnsiChar;
  begin
    Inc(Size, SizeOf(Cardinal));
    GetMem(Result, Size);
    Cardinal(Pointer(Result)^) := Size;
    Inc(Result, SizeOf(Cardinal));
  end;
  //----------------------------------------------------------------------------
  function StrNew(const Str: PAnsiChar): PAnsiChar;
  var
    Size: Cardinal;
  begin
    if Str = nil then Result := nil else
    begin
      Size := length(Str) + 1;
      Result := StrMove(AnsiStrAlloc(Size), Str, Size);
    end;
  end;
  //----------------------------------------------------------------------------
var
  i, b: Word;
  Count: Integer;
  s: PAnsiChar;
begin
  inherited Create;
  s := 'Generic Software';
  if alcIsExtensionPresent(nil, 'ALC_ENUMERATION_EXT') then
    s := alcGetString(nil, ALC_DEVICE_SPECIFIER); //указатель на массив всех устройств
  //else die(no sound)
  fDeviceListCount := 0;
  for b := 0 to 12 do
  begin
    Count := 0; //считаем длинну от начала указателя
    for i := 0 to fDeviceListCount do Count := Count + Length(fDeviceList[i]);
    StrCopy(s, @s[Count+b]); //копируем следующий участок памяти
    if length(s) = 0 then break;
    fDeviceList[fDeviceListCount] := StrNew(s);
    inc(fDeviceListCount);
  end;
  s := alcGetString(nil, ALC_DEFAULT_DEVICE_SPECIFIER);
  if s = 'Generic Hardware' then s := 'Generic Software'; //Антиглюк связанный с дешевым бортовым звуком - чтоб EAX работал
  SetDeviceA(s);
end;
//------------------------------------------------------------------------------
destructor TdgSoundDevice.Destroy;
  procedure StrDispose(Str: PAnsiChar);
  begin
    if Str <> nil then begin
      Dec(Str, SizeOf(Cardinal));
      FreeMem(Str, Cardinal(Pointer(Str)^));
    end;
  end;
var
  b: Byte;
  Device, Context: PPointer;
begin
  for b := fDeviceListCount downto 0 do StrDispose(fDeviceList[b]);
  Context := alcGetCurrentContext;
  Device := alcGetContextsDevice(Context);
  alcDestroyContext(Context);
  alcCloseDevice(Device);
  inherited Destroy;
end;
//------------------------------------------------------------------------------
function TdgSoundDevice.GetDevice: String;
begin
  Result := String(fUseDevice);
end;
//------------------------------------------------------------------------------
function TdgSoundDevice.GetDeviceCount: Byte;
begin
  Result := fDeviceListCount;
end;
//------------------------------------------------------------------------------
function TdgSoundDevice.GetDeviceBy(const aIndex: Byte): String;
begin
  Result := String(fDeviceList[aIndex]);
end;
//------------------------------------------------------------------------------
function TdgSoundDevice.GetEAXSupported: Boolean;
begin
  Result := vEAXSupported;
end;
//------------------------------------------------------------------------------
function TdgSoundDevice.GetMaxQuantitySources: Word;
begin
  Result := fMaxQuantitySources;
end;
//------------------------------------------------------------------------------
procedure TdgSoundDevice.SetDevice(const aName: String);
begin
  SetDeviceA(PAnsiChar(AnsiString(aName)));
end;
//------------------------------------------------------------------------------
procedure TdgSoundDevice.SetDeviceA(const aName: PAnsiChar);
var
  i: Integer;
  Device, Context: PPointer;
  Sources: array[1..260] of Cardinal;
begin
  if Sounds <> nil then for i := Sounds.Count-1 downto 0 do Sounds.Items[i].Disconnect;
  Context := alcGetCurrentContext;
  if Context <> nil then begin
    Device := alcGetContextsDevice(Context);
    alcDestroyContext(Context);
    alcCloseDevice(Device);
  end;
  fUseDevice := aName;
  Device := alcOpenDevice(aName);
  Context := alcCreateContext(Device, nil);
  alcMakeContextCurrent(Context);

  fMaxQuantitySources := 1;
  while fMaxQuantitySources < 260 do begin
    alGenSources(1, @Sources[fMaxQuantitySources]);
    if alGetError <> AL_NO_ERROR then Break;
    inc(fMaxQuantitySources);
  end;
  dec(fMaxQuantitySources);
  for i := fMaxQuantitySources downto 1 do alDeleteSources(1, @Sources[i]);

  vEAXSupported := False;
  if alIsExtensionPresent('EAX2.0') then
  begin
    eaxSet := alGetProcAddress('EAXSet');
    //eaxGet := alGetProcAddress('EAXGet'); //Двиг работает в 1 сторону, так быстрее
    vEAXSupported := True;
  end;
  if Sounds <> nil then begin
    Listener.SetEAXOn(Listener.fEAXOn);
    Listener.ApplyParameters;
    for i := Sounds.Count-1 downto 0 do Sounds.Items[i].Connect;
  end;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      TdgListener      '}{$ENDIF}
//------------------------------------------------------------------------------
constructor TdgListener.Create;
begin
  inherited;
  SetGain(1.0);
  fDistanceModel := AL_NONE;
  fEAXSupported := vEAXSupported;
  fEAXEnvironment := 0; //EAX_Generic
  fPosition := seFunc.dgVector3f(0,0,0);
  SetEAXOn(False); //Задаём начальные установки без включения
  //ApplyParameters;
end;
//------------------------------------------------------------------------------
procedure TdgListener.ApplyParameters;
begin
  SetGain(fGain);
  SetPosition(fPosition);
  SetVelocity(fVelocity);
  ApplyOrientation;
  if not fEAXSupported or not Listener.EAXOn then Exit;
  SetEAXEnvironment(fEAXEnvironment);
  SetEAXEnvironmentSize(fEAXEnvironmentSize);
  SetEAXEnvironmentDiffusion(fEAXEnvironmentDiffusion);
  SetEAXRoom(fEAXRoom);
  SetEAXRoomHF(fEAXRoomHF);
  SetEAXDecayTime(fEAXDecayTime);
  SetEAXDecayHFRatio(fEAXDecayHFRatio);
  SetEAXReflections(fEAXReflections);
  SetEAXReflectionsDelay(fEAXReflectionsDelay);
  SetEAXReverb(fEAXReverb);
  SetEAXReverbDelay(fEAXReverbDelay);
  SetEAXRolloffFactor(fEAXRolloffFactor);
  SetEAXAirAbsorptionHF(fEAXAirAbsorptionHF);
  SetEAXDecayTimeScale(fEAXDecayTimeScale);
  SetEAXReflectionsScale(fEAXReflectionsScale);
  SetEAXReflectionsDelayScale(fEAXReflectionsDelayScale);
  SetEAXReverbScale(fEAXReverbScale);
  SetEAXReverbDelayScale(fEAXReverbDelayScale);
  SetEAXDecayHFLimit(fEAXDecayHFLimit);
end;
//------------------------------------------------------------------------------
procedure TdgListener.ApplyOrientation;
var
  fori: array[0..5] of Single;
begin
  fori[0] := fDirection.X; //аналог at
  fori[1] := fDirection.Y;
  fori[2] := fDirection.Z;
  fori[3] := fUp.X;
  fori[4] := fUp.Y;
  fori[5] := fUp.Z;
  alListenerfv($100F, @fori); //Indicate listener orientation. * at/up
end;
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      Get      '}{$ENDIF}
function TdgListener.GetDistanceModel: Integer;
begin
  Result := fDistanceModel;
end;
//------------------------------------------------------------------------------
function TdgListener.GetVelocity: TdgVector3f;
begin
  Result := fVelocity;
end;
//------------------------------------------------------------------------------
function TdgListener.GetPosition: TdgVector3f;
begin
  Result := FPosition;
end;
//------------------------------------------------------------------------------
function TdgListener.GetDirection: TdgVector3f;
begin
  Result := fDirection;
end;
//------------------------------------------------------------------------------
function TdgListener.GetUp: TdgVector3f;
begin
  Result := fUp;
end;
//------------------------------------------------------------------------------
function TdgListener.GetGain: Single;
begin
  Result := fGain;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      Set      '}{$ENDIF}
procedure TdgListener.SetDistanceModel(const aValue: Integer);
begin
  alDistanceModel(aValue);
  fDistanceModel := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetVelocity(const aValue: TdgVector3f);
var
  fvel: array[0..2] of Single;
begin
  fVelocity := aValue;
  fvel[0] := aValue.X;
  fvel[1] := aValue.Y;
  fvel[2] := aValue.Z;
  alListenerfv($1006, @fvel);
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetOrientation(const aDirection, aUp: TdgVector3f);
var
  fori: array[0..5] of Single;
begin
  fori[0] := aDirection.X; //аналог at
  fori[1] := aDirection.Y;
  fori[2] := aDirection.Z;
  fori[3] := aUp.X;
  fori[4] := aUp.Y;
  fori[5] := aUp.Z;
  alListenerfv($100F, @fori); //Indicate listener orientation. * at/up
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetPosition(const aValue: TdgVector3f);
var
  fpos: array[0..2] of Single;
begin
  fPosition := aValue;
  fpos[0] := aValue.X;
  fpos[1] := aValue.Y;
  fpos[2] := aValue.Z;
  alListenerfv($1004, @fpos);
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetDirection(const aValue: TdgVector3f);
begin
  fDirection := aValue;
  ApplyOrientation;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetUp(const aValue: TdgVector3f);
begin
  fUp := aValue;
  ApplyOrientation;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetGain(const aValue: Single);
begin
  alListenerf(AL_GAIN, aValue);
  fGain := aValue;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      GetEAX      '}{$ENDIF}
function TdgListener.GetEAXEnvironment: Byte;
begin
  Result := fEAXEnvironment;
end;
 //------------------------------------------------------------------------------
function TdgListener.GetEAXOn: Boolean;
begin
  Result := fEAXOn;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXEnvironmentSize: Single;
begin
  Result := fEAXEnvironmentSize;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXEnvironmentDiffusion: Single;
begin
  Result := fEAXEnvironmentDiffusion;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXRoom: Integer;
begin
  Result := fEAXRoom;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXRoomHF: Integer;
begin
  Result := fEAXRoomHF;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXDecayTime: Single;
begin
  Result := fEAXDecayTime;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXDecayHFRatio: Single;
begin
  Result := fEAXDecayHFRatio;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReflections: Integer;
begin
  Result := fEAXReflections;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReflectionsDelay: Single;
begin
  Result := fEAXReflectionsDelay;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReverb: Integer;
begin
  Result := fEAXReverb;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReverbDelay: Single;
begin
  Result := fEAXReverbDelay;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXRolloffFactor: Single;
begin
  Result := fEAXRolloffFactor;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXAirAbsorptionHF: Single;
begin
  Result := fEAXAirAbsorptionHF;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXDecayTimeScale: Boolean;
begin
  Result := fEAXDecayTimeScale;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReflectionsScale: Boolean;
begin
  Result := fEAXReflectionsScale;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReflectionsDelayScale: Boolean;
begin
  Result := fEAXReflectionsDelayScale;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReverbScale: Boolean;
begin
  Result := fEAXReverbScale;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXReverbDelayScale: Boolean;
begin
  Result := fEAXReverbDelayScale;
end;
//------------------------------------------------------------------------------
function TdgListener.GetEAXDecayHFLimit: Boolean;
begin
  Result := fEAXDecayHFLimit;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      SetEAX      '}{$ENDIF}
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXEnvironment(const aValue: Byte);
begin
  if not fEAXSupported then Exit;
  fEAXEnvironment := aValue;
  if fEAXOn then SetEAXOn(True);
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXOn(const aValue: Boolean);
var
  i: Integer;
begin
  if not fEAXSupported then Exit;
  fEAXOn := aValue;
  if aValue then begin //on
    eaxSet(EAX_ListenerProperties, EAX_ListenerEnvironment or DSPROPERTY_EAXLISTENER_DEFERRED, 0, @fEAXEnvironment, SizeOf(Cardinal));
    for i := Sounds.Count-1 downto 0 do Sounds.Items[i].SetEAXOn;
    eaxSet(EAX_ListenerProperties, DSPROPERTY_EAXLISTENER_COMMITDEFERREDSETTINGS, 0, nil, 0);
    Exit;
  end;
  SetEAXEnvironmentSize(7.5);
  SetEAXEnvironmentDiffusion(1.0);
  SetEAXRoom(-10000);
  SetEAXRoomHF(-10000);
  SetEAXDecayTime(1.0);
  SetEAXDecayHFRatio(1.0);
  SetEAXReflections(-2602);
  SetEAXReflectionsDelay(0.007);
  SetEAXReverb(200);
  SetEAXReverbDelay(0.011);
  SetEAXRolloffFactor(0.0);
  SetEAXAirAbsorptionHF(-5.0);
  SetEAXDecayTimeScale(True);
  SetEAXReflectionsScale(True);
  SetEAXReflectionsDelayScale(True);
  SetEAXReverbScale(True);
  SetEAXReverbDelayScale(True);
  SetEAXDecayHFLimit(True);
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXEnvironmentSize(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 12, 0, @aValue, SizeOf(Single));
  fEAXEnvironmentSize := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXEnvironmentDiffusion(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 13, 0, @aValue, SizeOf(Single));
  fEAXEnvironmentDiffusion := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXRoom(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 2, 0, @aValue, SizeOf(Integer));
  fEAXRoom := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXRoomHF(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 3, 0, @aValue, SizeOf(Integer));
  fEAXRoomHF := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXDecayTime(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 5, 0, @aValue, SizeOf(Single));
  fEAXDecayTime := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXDecayHFRatio(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 6, 0, @aValue, SizeOf(Single));
  fEAXDecayHFRatio := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReflections(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 7, 0, @aValue, SizeOf(Integer));
  fEAXReflections := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReflectionsDelay(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 8, 0, @aValue, SizeOf(Single));
  fEAXReflectionsDelay := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReverb(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 9, 0, @aValue, SizeOf(Integer));
  fEAXReverb := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReverbDelay(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 10, 0, @aValue, SizeOf(Single));
  fEAXReverbDelay := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXRolloffFactor(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 4, 0, @aValue, SizeOf(Single));
  fEAXRolloffFactor := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXAirAbsorptionHF(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, 14, 0, @aValue, SizeOf(Single));
  fEAXAirAbsorptionHF := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXDecayTimeScale(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, $00000001, 0, @aValue, SizeOf(Boolean));
  fEAXDecayTimeScale := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReflectionsScale(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, $00000002, 0, @aValue, SizeOf(Boolean));
  fEAXReflectionsScale := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReflectionsDelayScale(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, $00000004, 0, @aValue, SizeOf(Boolean));
  fEAXReflectionsDelayScale := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReverbScale(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, $00000008, 0, @aValue, SizeOf(Boolean));
  fEAXReverbScale := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXReverbDelayScale(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, $00000010, 0, @aValue, SizeOf(Boolean));
  fEAXReverbDelayScale := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetEAXDecayHFLimit(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_ListenerProperties, $00000020, 0, @aValue, SizeOf(Boolean));
  fEAXDecayHFLimit := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgListener.SetDefaultEAXParameters;
begin
  if (not fEAXSupported) or (not fEAXOn) then Exit;
  fEAXRolloffFactor := 0.0;
  fEAXAirAbsorptionHF := -5.0;
  fEAXDecayTimeScale := True;
  fEAXReflectionsScale := True;
  fEAXReflectionsDelayScale := True;
  fEAXReverbScale := True;
  fEAXReverbDelayScale := True;
  //изменяемые параметры
  fEAXEnvironmentDiffusion := 1.0;
  fEAXRoom := -1000;
  fEAXDecayHFLimit := True;
  case fEAXEnvironment of
    0: begin //EAX_Generic
        fEAXEnvironmentSize := 7.5;
        fEAXRoomHF := -100;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.83;
        fEAXReflections := -2602;
        fEAXReflectionsDelay := 0.007;
        fEAXReverb := 200;
        fEAXReverbDelay := 0.011;
      end;
    1: begin //EAX_PaddedCell
        fEAXEnvironmentSize := 1.4;
        fEAXRoomHF := -6000;
        fEAXDecayTime := 0.17;
        fEAXDecayHFRatio := 0.1;
        fEAXReflections := -1204;
        fEAXReflectionsDelay := 0.001;
        fEAXReverb := 207;
        fEAXReverbDelay := 0.002;
      end;
    2: begin //EAX_Room
        fEAXEnvironmentSize := 1.9;
        fEAXRoomHF := -454;
        fEAXDecayTime := 0.4;
        fEAXDecayHFRatio := 0.83;
        fEAXReflections := -1646;
        fEAXReflectionsDelay := 0.002;
        fEAXReverb := 53;
        fEAXReverbDelay := 0.003;
      end;
    3: begin //EAX_BathRoom
        fEAXEnvironmentSize := 1.4;
        fEAXRoomHF := -1200;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.54;
        fEAXReflections := -370;
        fEAXReflectionsDelay := 0.007;
        fEAXReverb := 1030;
        fEAXReverbDelay := 0.011;
      end;
    4: begin //EAX_LivingRoom
        fEAXEnvironmentSize := 2.5;
        fEAXRoomHF := -6000;
        fEAXDecayTime := 0.5;
        fEAXDecayHFRatio := 0.1;
        fEAXReflections := -1376;
        fEAXReflectionsDelay := 0.003;
        fEAXReverb := -1104;
        fEAXReverbDelay := 0.004;
      end;
    5: begin //EAX_StoneRoom
        fEAXEnvironmentSize := 11.6;
        fEAXRoomHF := -300;
        fEAXDecayTime := 2.31;
        fEAXDecayHFRatio := 0.64;
        fEAXReflections := -711;
        fEAXReflectionsDelay := 0.012;
        fEAXReverb := 83;
        fEAXReverbDelay := 0.017;
      end;
    6: begin //EAX_Auditorium
        fEAXEnvironmentSize := 21.6;
        fEAXRoomHF := -476;
        fEAXDecayTime := 4.32;
        fEAXDecayHFRatio := 0.59;
        fEAXReflections := -789;
        fEAXReflectionsDelay := 0.02;
        fEAXReverb := -289;
        fEAXReverbDelay := 0.03;
      end;
    7: begin //EAX_ConcertHall
        fEAXEnvironmentSize := 19.6;
        fEAXRoomHF := -500;
        fEAXDecayTime := 3.92;
        fEAXDecayHFRatio := 0.7;
        fEAXReflections := -1230;
        fEAXReflectionsDelay := 0.02;
        fEAXReverb := -2;
        fEAXReverbDelay := 0.029;
      end;
    8: begin //EAX_Cave
        fEAXEnvironmentSize := 14.6;
        fEAXRoomHF := 0;
        fEAXDecayTime := 2.91;
        fEAXDecayHFRatio := 1.3;
        fEAXReflections := -602;
        fEAXReflectionsDelay := 0.015;
        fEAXReverb := -302;
        fEAXReverbDelay := 0.022;
        fEAXDecayHFLimit := False;
      end;
    9: begin //EAX_Arena
        fEAXEnvironmentSize := 36.2;
        fEAXRoomHF := -698;
        fEAXDecayTime := 7.24;
        fEAXDecayHFRatio := 0.33;
        fEAXReflections := -1166;
        fEAXReflectionsDelay := 0.02;
        fEAXReverb := 16;
        fEAXReverbDelay := 0.03;
      end;
    10: begin //EAX_Hangar
        fEAXEnvironmentSize := 50.3;
        fEAXRoomHF := -1000;
        fEAXDecayTime := 10.05;
        fEAXDecayHFRatio := 0.23;
        fEAXReflections := -602;
        fEAXReflectionsDelay := 0.02;
        fEAXReverb := 198;
        fEAXReverbDelay := 0.03;
      end;
    11: begin //EAX_CarpetedHallway
        fEAXEnvironmentSize := 1.9;
        fEAXRoomHF := -4000;
        fEAXDecayTime := 0.3;
        fEAXDecayHFRatio := 0.1;
        fEAXReflections := -1831;
        fEAXReflectionsDelay := 0.002;
        fEAXReverb := -1630;
        fEAXReverbDelay := 0.03;
      end;
    12: begin //EAX_Hallway
        fEAXEnvironmentSize := 1.8;
        fEAXRoomHF := -300;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.59;
        fEAXReflections := -1219;
        fEAXReflectionsDelay := 0.007;
        fEAXReverb := 441;
        fEAXReverbDelay := 0.011;
      end;
    13: begin //EAX_StoneCorridor
        fEAXEnvironmentSize := 13.5;
        fEAXRoomHF := -237;
        fEAXDecayTime := 2.7;
        fEAXDecayHFRatio := 0.79;
        fEAXReflections := -1214;
        fEAXReflectionsDelay := 0.013;
        fEAXReverb := 395;
        fEAXReverbDelay := 0.02;
      end;
    14: begin //EAX_Alley
        fEAXEnvironmentSize := 7.5;
        fEAXEnvironmentDiffusion := 0.3;
        fEAXRoomHF := -270;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.86;
        fEAXReflections := -1204;
        fEAXReflectionsDelay := 0.007;
        fEAXReverb := -4;
        fEAXReverbDelay := 0.011;
      end;
    15: begin //EAX_Forest
        fEAXEnvironmentSize := 38.0;
        fEAXEnvironmentDiffusion := 0.3;
        fEAXRoomHF := -3300;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.54;
        fEAXReflections := -2560;
        fEAXReflectionsDelay := 0.162;
        fEAXReverb := -229;
        fEAXReverbDelay := 0.088;
      end;
    16: begin //EAX_City
        fEAXEnvironmentSize := 7.5;
        fEAXEnvironmentDiffusion := 0.5;
        fEAXRoomHF := -800;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.67;
        fEAXReflections := -2273;
        fEAXReflectionsDelay := 0.007;
        fEAXReverb := -1691;
        fEAXReverbDelay := 0.011;
      end;
    17: begin //EAX_Mountains
        fEAXEnvironmentSize := 100.0;
        fEAXEnvironmentDiffusion := 0.27;
        fEAXRoomHF := -2500;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.21;
        fEAXReflections := -2780;
        fEAXReflectionsDelay := 0.3;
        fEAXReverb := -1434;
        fEAXReverbDelay := 0.1;
        fEAXDecayHFLimit := False;
      end;
    18: begin //EAX_Quarry
        fEAXEnvironmentSize := 17.5;
        fEAXRoomHF := -1000;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.83;
        fEAXReflections := -10000;
        fEAXReflectionsDelay := 0.061;
        fEAXReverb := 500;
        fEAXReverbDelay := 0.025;
      end;
    19: begin //EAX_Plain
        fEAXEnvironmentSize := 42.5;
        fEAXEnvironmentDiffusion := 0.21;
        fEAXRoomHF := -2000;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.5;
        fEAXReflections := -2466;
        fEAXReflectionsDelay := 0.179;
        fEAXReverb := -1926;
        fEAXReverbDelay := 0.1;
      end;
    20: begin //EAX_ParkingLot
        fEAXEnvironmentSize := 8.3;
        fEAXRoomHF := 0;
        fEAXDecayTime := 1.65;
        fEAXDecayHFRatio := 1.5;
        fEAXReflections := -1363;
        fEAXReflectionsDelay := 0.008;
        fEAXReverb := -1153;
        fEAXReverbDelay := 0.012;
        fEAXDecayHFLimit := False;
      end;
    21: begin //EAX_SewerPipe
        fEAXEnvironmentSize := 1.7;
        fEAXEnvironmentDiffusion := 0.8;
        fEAXRoomHF := -1000;
        fEAXDecayTime := 2.81;
        fEAXDecayHFRatio := 0.14;
        fEAXReflections := 429;
        fEAXReflectionsDelay := 0.014;
        fEAXReverb := 1023;
        fEAXReverbDelay := 0.021;
      end;
    22: begin //EAX_UnderWater
        fEAXEnvironmentSize := 1.8;
        fEAXRoomHF := -4000;
        fEAXDecayTime := 1.49;
        fEAXDecayHFRatio := 0.1;
        fEAXReflections := -449;
        fEAXReflectionsDelay := 0.007;
        fEAXReverb := 1700;
        fEAXReverbDelay := 0.011;
      end;
    23: begin //EAX_Drugged
        fEAXEnvironmentSize := 1.9;
        fEAXEnvironmentDiffusion := 0.5;
        fEAXRoomHF := 0;
        fEAXDecayTime := 8.39;
        fEAXDecayHFRatio := 1.39;
        fEAXReflections := -115;
        fEAXReflectionsDelay := 0.002;
        fEAXReverb := 985;
        fEAXReverbDelay := 0.03;
        fEAXDecayHFLimit := False;
      end;
    24: begin //EAX_Dizzy
        fEAXEnvironmentSize := 1.8;
        fEAXEnvironmentDiffusion := 0.6;
        fEAXRoomHF := -400;
        fEAXDecayTime := 17.23;
        fEAXDecayHFRatio := 0.56;
        fEAXReflections := -1713;
        fEAXReflectionsDelay := 0.02;
        fEAXReverb := -613;
        fEAXReverbDelay := 0.03;
        fEAXDecayHFLimit := False;
      end;
    25: begin //EAX_Psychotic
        fEAXEnvironmentSize := 1.0;
        fEAXEnvironmentDiffusion := 0.5;
        fEAXRoomHF := -151;
        fEAXDecayTime := 7.56;
        fEAXDecayHFRatio := 0.91;
        fEAXReflections := -626;
        fEAXReflectionsDelay := 0.02;
        fEAXReverb := 774;
        fEAXReverbDelay := 0.03;
        fEAXDecayHFLimit := False;
      end;
  end;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 

{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      TdgOGGSound       '}{$ENDIF}
//------------------------------------------------------------------------------
constructor TdgOGGSound.Create;
begin
  inherited;
  fEAXSupported := vEAXSupported;
  alGenBuffers(2, @fBuffers);
  fOggTimer := TdgTimer.Create;
  fOggTimer.OnTimer := TimerTime;
  fUse := False;
  fLoop := False;
  fPause := False;
  fTimeStart := 0;
  SetDefaultParameters;
  fops_callbacks.read_func := ops_read_func;
  fops_callbacks.seek_func := ops_seek_func;
  fops_callbacks.close_func := ops_close_func;
  fops_callbacks.tell_func := ops_tell_func;
end;
//------------------------------------------------------------------------------
destructor TdgOGGSound.Destroy;
begin
  if fUse then Stop;
  FreeMem(Data);
  alDeleteBuffers(2, @fBuffers);
  fOggTimer.Free;
  if Assigned(fOggStream) then fOggStream.Free;
  inherited;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.Connect;
begin
  alGenBuffers(2, @fBuffers);
  if not fUse then Exit;
  alGenSources(1, @fSource);
  ApplyParameters;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.Disconnect;
begin
  if fUse then alDeleteSources(1, @fSource);
  alDeleteBuffers(2, @fBuffers);
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.LoadFromFile(const aFileName: String; const aInMemory: Boolean = True);
var
  i: Int64;
  cError: Integer;
begin
  if Assigned(fOggStream) then fOggStream.Free;
  fInMem := aInMemory;
  if aInMemory then fOggStream := TdgMemoryStream.Create(aFileName)
  else fOggStream := TdgFileStream.Create(aFileName);
  cError := ov_open_callbacks(fOggStream, fOggFile, nil, 0, fops_callbacks); //Функция забирает ссылку на контейнер с данными
  if cError <> 0 then
  begin
    seLogMe('Could not open Ogg stream. Called in TdgOGGSound.LoadFromFile (ov_open_callbacks) ' + aFileName);
    Exit;
  end;
  i := fOggFile.end_v;
  while i > 32767 do i := Round(i / 2);
  fBufferSize := i*2;
  fVorbisInfo := ov_info(fOggFile, -1)^;
  if fVorbisInfo.channels = 1 then fFormat := AL_FORMAT_MONO16 else fFormat := AL_FORMAT_STEREO16;
  GetMem(Data, fBufferSize + SizeOf(Integer));
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.Update;//Thanks ilya2nd
var
  Processed: Integer;
  Buffer, QueuedBuffers: Cardinal;
begin
  alGetSourcei(fSource, AL_BUFFERS_PROCESSED, @Processed);
  if Processed > 0 then repeat
    alSourceUnqueueBuffers(fSource, 1, @Buffer);
    if Stream(Buffer) then alSourceQueueBuffers(fSource, 1, @Buffer)
    else if floop or (fRepeatCount > 0) then begin
      ov_time_seek(fOggFile, fTimestart);
      Stream(Buffer);
      alSourceQueueBuffers(fSource, 1, @Buffer);
      if fRepeatCount > 0 then fRepeatCount := fRepeatCount - 1;
    end;
    dec(Processed);
  until Processed <= 0;
  if not Playing then begin
    alGetSourcei(fSource, AL_BUFFERS_QUEUED, @QueuedBuffers);
    if QueuedBuffers > 0 then alSourcePlay(fSource);
  end;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.TimerTime(Sender: TObject);
begin
  Update;
  if not Playing then
    if not Playback then
      if not fLoop then Stop;
end;
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      HelpFunc      '}{$ENDIF}
//------------------------------------------------------------------------------
function TdgOGGSound.Stream(const Buffer: Cardinal): Boolean;
var
  Size, Section, Res: Integer;
begin
  Size := 0;
  while (Size < fBufferSize) do begin
    Res := ov_read(fOggFile, PByteArray(Data)^[Size], fBufferSize - Size, 0, 2, 1, @Section);
    if Res > 0 then inc(Size, Res) else break;
  end;
  if Size = 0 then begin Result := False; { FreeMem(Data); } Exit; end;
  alBufferData(Buffer, fFormat, Data{PCM}, Size, fVorbisInfo.Rate);
  Result := True;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.Playing: Boolean;
var
  State: Integer;
begin
  alGetSourcei(fSource, AL_SOURCE_STATE, @State);
  Result := (State = AL_PLAYING);
end;
//------------------------------------------------------------------------------
function TdgOGGSound.Playback: Boolean;
begin
  if Playing then begin Result := True; Exit; end;
  if not Stream(fBuffers[0]) or not Stream(fBuffers[1]) then begin Result := False; Exit; end;
  alSourceQueueBuffers(fSource, 2, @fBuffers);
  alSourcePlay(fSource);
  Result := True;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      Func      '}{$ENDIF}
procedure TdgOGGSound.Play(StopIfPlay: Boolean = True; RepeatTimes: Word = 0);
begin
  if fPause then fPause := False
  else if StopIfPlay then if fUse then Stop;
  if not fUse then begin
    alGenSources(1, @fSource);
    ApplyParameters;
    fUse := True;
    fRepeatCount := RepeatTimes;
    ov_time_seek(fOggFile, fTimeStart);
  end;
  fOggTimer.Active := True;
  alSourcef(fSource, AL_GAIN, fGain);
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.Stop;
begin
  if not fUse then Exit;
  alSourcef(fSource, AL_GAIN, 0.0);
  fOggTimer.Active := False;
  alDeleteSources(1, @fSource);
  ov_time_seek(fOggFile, fTimeStart);
  fUse := False;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.Pause;
begin
  if not fUse then Exit;
  alSourcef(fSource, AL_GAIN, 0.0);
  fOGGTimer.Active := False;
  fPause := True;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.ApplyParameters;
begin
  SetPitch(fPitch);
  Setgain(fGain);
  SetmaxDistance(fMaxDistance);
  SetRollOffFactor(fRollOffFactor);
  SetReferenceDistance(fReferenceDistance);
  SetMinGain(fMinGane);
  SetMaxGain(fMaxGane);
  SetConeOuterGain(fConeOuterGain);
  SetConeInnerAngle(fConeInnerAngle);
  SetConeOuterAngle(fConeOuterAngle);
  SetSourseRelative(fSourseRelative);
  alSourcefv(fSource, $1004, @fPosition);
  if not fEAXSupported or not Listener.EAXOn then Exit;
  SetEAXDirect(fEAXDirect);
  SetEAXDirectHF(fEAXDirectHF);
  SetEAXRoom(fEAXRoom);
  SetEAXRoomHF(fEAXRoomHF);
  SetEAXObstruction(fEAXObstruction);
  SetEAXObstructionLFRatio(fEAXObstructionLFRatio);
  SetEAXOcclusion(fEAXOcclusion);
  SetEAXOcclusionLFRatio(fEAXOcclusionLFRatio);
  SetEAXOcclusionRoomRatio(fEAXOcclusionRoomRatio);
  SetEAXRolloffFactor(fEAXRolloffFactor);
  SetEAXAbsorptionFactor(fEAXAbsorptionFactor);
  SetEAXOutsideVolumeHF(fEAXOutsideVolumeHF);
  SetEAXDirectHFAuto(fEAXDirectHFAuto);
  SetEAXRoomAuto(fEAXRoomAuto);
  SetEAXRoomHFAuto(fEAXRoomHFAuto);
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetDefaultParameters;
begin
  fPitch := 1.0;
  fGain := 1.0;
  fMaxDistance := 10000.0;
  fRollOffFactor := 1.0;
  fReferenceDistance := 1.0;
  fMinGane := 0.0;
  fMaxGane := 1.0;
  fConeOuterGain := 0.0;
  fConeInnerAngle := 360.0;
  fConeOuterAngle := 360.0;
  fSourseRelative := False;
  fPosition := seFunc.dgVector3f(0,0,0);
  if not fEAXSupported or not Listener.EAXOn then Exit;
  fEAXDirect := 0;
  fEAXDirectHF := 0;
  fEAXRoom := 0;
  fEAXRoomHF := 0;
  fEAXObstruction := 0;
  fEAXObstructionLFRatio := 0.0;
  fEAXOcclusion := 0;
  fEAXOcclusionLFRatio := 0.25;
  fEAXOcclusionRoomRatio := 0.5;
  fEAXRolloffFactor := 0.0;
  fEAXAbsorptionFactor := 1.0;
  fEAXOutsideVolumeHF := 0;
  fEAXDirectHFAuto := True;
  fEAXRoomAuto := True;
  fEAXRoomHFAuto := True;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      Get      '}{$ENDIF}
function TdgOGGSound.GetNoiseLevel: Smallint;//Thanks Fantom
var
  NoiseData: PNoiseData;
  len, s, c, j, i, max: Integer;
begin
  NoiseData := PNoiseData(Data);
  len := 4096; //Length(NoiseData^) - 1;
  for i:=0 to len do begin //сглаживаем скачки
    s := 0;
    c := 0;
    for j:=-10 to 10 do
      if (i+j>=0) and (i+j<=len) then begin
        s := s + NoiseData[i+j];
        inc(c);
      end;
    s := round(s/c);
    NoiseData[i] := s;
  end;
  max:=-32768; //ищем максимум
  for i := 0 to len do
    if NoiseData^[i] > max then max := NoiseData^[i];
  Result := max;
end;
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      Get      '}{$ENDIF}
function TdgOGGSound.GetNoiseGraph(Amplitude: Word): TNoiseData;//Thanks Fantom
var
  tmpBuf: TNoiseData;
  NoiseData: PNoiseData;
  len, s, c, j, i, max, min: Integer;
begin
  NoiseData := PNoiseData(Data);
  len := 4096; //Length(NoiseData^) - 1;
  for i:=0 to len do begin //сглаживаем скачки
    s := 0;
    c := 0;
    for j:=-10 to 10 do
      if (i+j>=0) and (i+j<=len) then begin
        s := s + NoiseData[i+j];
        inc(c);
      end;
    s := round(s/c);
    NoiseData[i] := s;
  end;
  max := -32768;
  min := 32767;
  for i := 0 to len do begin //ищем минимум и максимум
    tmpBuf[i] := NoiseData^[i];
    if NoiseData^[i] > max then max := NoiseData^[i];
    if NoiseData^[i] < min then min := NoiseData^[i];
  end;
  if min<>max then //нормируем значения к заданной амплитуде
    for i:=0 to len do tmpBuf[i] := trunc((tmpBuf[i]-min)/(max-min)*Amplitude);
  Result := tmpBuf;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetInMemory: Boolean;
begin
  Result := fInMem;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetUse: Boolean;
begin
  Result := fUse;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetGain: Single;
begin
  Result := fGain;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetMaxDistance: Single;
begin
  Result := fMaxDistance;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetRollOffFactor: Single;
begin
  Result := fRollOffFactor;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetConeOuterGain: Single;
begin
  Result := fConeOuterGain;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetConeInnerAngle: Single;
begin
  Result := fConeInnerAngle;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetConeOuterAngle: Single;
begin
  Result := fConeOuterAngle;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetReferenceDistance: Single;
begin
  Result := fReferenceDistance;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetMinGane: Single;
begin
  Result := fMinGane;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetMaxGane: Single;
begin
  Result := fMaxGane;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetFrequency: Integer;
begin
  Result := fVorbisInfo.Rate;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetPitch: Single;
begin
  Result := fPitch;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetPosition: TdgVector3f;
begin
  Result := fPosition;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetDirection: TdgVector3f;
begin
  Result := fDirection;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetVelocity: TdgVector3f;
begin
  Result := fVelocity;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetName: String;
begin
  Result := fName;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetPath: String;
begin
  Result := fPath;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetSourseRelative: Boolean;
begin
  Result := fSourseRelative;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetLoop: Boolean;
begin
  Result := fLoop;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetTimeStart: Double;
begin
  Result := fTimeStart;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetTimeOffset: Double;
begin
  Result := ov_time_tell(fOggFile);
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetTimeTotal: Double;
begin
  Result := ov_time_total(fOggFile, 0);
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      Set      '}{$ENDIF}
procedure TdgOGGSound.SetInMemory(const aValue: Boolean);
begin
  fInMem := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetPosition(const aValue: TdgVector3f);
var
  fpos: array[0..2] of Single;
begin
  fPosition := aValue;
  fpos[0] := aValue.X;
  fpos[1] := aValue.Y;
  fpos[2] := aValue.Z;
  alSourcefv(fSource, $1004, @fpos);
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetDirection(const aValue: TdgVector3f);
var
  fdir: array[0..2] of Single;
begin
  fDirection := aValue;
  fdir[0] := aValue.X;
  fdir[1] := aValue.Y;
  fdir[2] := aValue.Z;
  alSourcefv(fSource, $1005, @fdir); //Specify the current direction as forward vector.
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetVelocity(const aValue: TdgVector3f);
var
  fvel: array[0..2] of Single;
begin
  fVelocity := aValue;
  fvel[0] := aValue.X;
  fvel[1] := aValue.Y;
  fvel[2] := aValue.Z;
  alSourcefv(fSource, $1006, @fvel);
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetTimeStart(const pos: Double);
begin
  fTimeStart := pos;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetTimeOffset(const pos: Double);
begin
  ov_time_seek(fOggFile, pos);
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetLoop(const aValue: Boolean);
begin
  fLoop := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetName(const aValue: String);
begin
  fName := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetPath(const aValue: String);
begin
  fPath := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetGain(const aValue: Single);
begin
  alSourcef(fSource, AL_GAIN, aValue);
  fGain := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetPitch(const aValue: Single); //Range:[0.5-2.0] Default:1.0 Specify the pitch to be applied, either at source, or on mixer results, at listener.
begin
  alSourcef(fSource, $1003, aValue);
  fPitch := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetMinGain(const aValue: Single); //Indicate minimum source attenuation Range:[0.0 - 1.0] * Logarthmic
begin
  alSourcef(fSource, $100D, aValue);
  fMinGane := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetMaxGain(const aValue: Single); //Indicate maximum source attenuation Range:[0.0 - 1.0] * Logarthmic
begin
  alSourcef(fSource, $100E, aValue);
  fMaxGane := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetFrequency(const aValue: Integer);
begin
  fVorbisInfo.Rate := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetReferenceDistance(const aValue: Single); // Range: [0.0 - +inf] Default is 1.0
begin
  alSourcef(fSource, $1020, aValue);
  fReferenceDistance := aValue;
end;
//------------------------------------------------------------------------------!!!
procedure TdgOGGSound.SetRollOffFactor(const aValue: Single);
begin
  alSourcef(fSource, $1021, aValue);
  fRollOffFactor := aValue;
  //Зачем-то дважды констанкта была определена - 21 по спесификации верная вроде
  //AL_ROLLOFF_FACTOR = $1021; // source specific rolloff factor * Type: ALfloat * Range: [0.0 - +inf]
  //AL_ROLLOFF_FACTOR	= $1008; // Indicate the rolloff factor for the source. Type: ALfloat * Range:[0.0 - ] * Default: 1.0 <--- эта в комментах
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetMaxDistance(const aValue: Single); //Indicate distance above which sources are not attenuated using the inverse clamped distance model. Default: +inf  Range:  0.0 - +inf
begin
  alSourcef(fSource, $1023, aValue);
  fMaxDistance := aValue;
end;
//------------------------------------------------------------------------------!!!
procedure TdgOGGSound.SetConeOuterGain(const aValue: Single); //Directional source, outer cone gain. * Default:0.0 * Range: [0.0 - 1.0] * Logarithmic
begin
  alSourcef(fSource, $1022, aValue);
  fConeOuterGain := aValue;
   //В исходниках EAX 2.0 Panel почему-то задают вот так? хз зачем..
  //alSourcef(Source, AL_CONE_OUTER_GAIN, power(10, Value/2000.0));
 //(SetConeOutsideVolume)
//alSourcef(m_uiSource, AL_CONE_OUTER_GAIN, (float)pow(10, (float)Value/2000.0f)); in C++
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetConeInnerAngle(const aValue: Single); //Directional source, inner cone angle, in degrees. Range:[0-360] Default:360
begin
  alSourcef(fSource, $1001, aValue);
  fConeInnerAngle := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetConeOuterAngle(const aValue: Single); //Directional source, outer cone angle, in degrees. Range:[0-360] Default:360
begin
  alSourcef(fSource, $1002, aValue);
  fConeOuterAngle := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetSourseRelative(const aValue: Boolean);
begin
  alSourcefv(fSource, $202, @aValue);
  fSourseRelative := aValue;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      GetEAX      '}{$ENDIF}
function TdgOGGSound.GetEAXDirect: Integer;
begin
  Result := fEAXDirect;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXDirectHF: Integer;
begin
  Result := fEAXDirectHF;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXRoom: Integer;
begin
  Result := fEAXRoom;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXRoomHF: Integer;
begin
  Result := fEAXRoomHF;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXObstruction: Integer;
begin
  Result := fEAXObstruction;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXObstructionLFRatio: Single;
begin
  Result := fEAXObstructionLFRatio;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXOcclusion: Integer;
begin
  Result := fEAXOcclusion;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXOcclusionLFRatio: Single;
begin
  Result := fEAXOcclusionLFRatio;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXOcclusionRoomRatio: Single;
begin
  Result := fEAXOcclusionRoomRatio;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXRolloffFactor: Single;
begin
  Result := fEAXRolloffFactor;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXAbsorptionFactor: Single;
begin
  Result := fEAXAbsorptionFactor;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXOutsideVolumeHF: Integer;
begin
  Result := fEAXOutsideVolumeHF;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXDirectHFAuto: Boolean;
begin
  Result := fEAXDirectHFAuto;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXRoomAuto: Boolean;
begin
  Result := fEAXRoomAuto;
end;
//------------------------------------------------------------------------------
function TdgOGGSound.GetEAXRoomHFAuto: Boolean;
begin
  Result := fEAXRoomHFAuto;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      SetEAX      '}{$ENDIF}
procedure TdgOGGSound.SetEAXOn;
begin
  if fUse then EAXSet(EAX_BufferProperties, DSPROPERTY_EAXBUFFER_COMMITDEFERREDSETTINGS, fSource, nil, 0);
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXDirect(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 2, fSource, @aValue, SizeOf(Integer));
  fEAXDirect := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXDirectHF(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 3, fSource, @aValue, SizeOf(Integer));
  fEAXDirectHF := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXRoom(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 4, fSource, @aValue, SizeOf(Integer));
  fEAXRoom := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXRoomHF(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 5, fSource, @aValue, SizeOf(Integer));
  fEAXRoomHF := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXObstruction(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 7, fSource, @aValue, SizeOf(Integer));
  fEAXObstruction := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXObstructionLFRatio(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 8, fSource, @aValue, SizeOf(Single));
  fEAXObstructionLFRatio := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXOcclusion(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 9, fSource, @aValue, SizeOf(Integer));
  fEAXOcclusion := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXOcclusionLFRatio(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 10, fSource, @aValue, SizeOf(Single));
  fEAXOcclusionLFRatio := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXOcclusionRoomRatio(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 11, fSource, @aValue, SizeOf(Single));
  fEAXOcclusionRoomRatio := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXRolloffFactor(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 6, fSource, @aValue, SizeOf(Single));
  fEAXRolloffFactor := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXAbsorptionFactor(const aValue: Single);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 13, fSource, @aValue, SizeOf(Single));
  fEAXAbsorptionFactor := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXOutsideVolumeHF(const aValue: Integer);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, 12, fSource, @aValue, SizeOf(Integer));
  fEAXOutsideVolumeHF := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXDirectHFAuto(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, $00000001, fSource, @aValue, SizeOf(Boolean));
  fEAXDirectHFAuto := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXRoomAuto(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, $00000002, fSource, @aValue, SizeOf(Boolean));
  fEAXRoomAuto := aValue;
end;
//------------------------------------------------------------------------------
procedure TdgOGGSound.SetEAXRoomHFAuto(const aValue: Boolean);
begin
  if not fEAXSupported then Exit;
  eaxSet(EAX_BufferProperties, $00000004, fSource, @aValue, SizeOf(Boolean));
  fEAXRoomHFAuto := aValue;
end;
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 

{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
{$IFDEF dgR}{$REGION '      TdgSounds       '}{$ENDIF}
//------------------------------------------------------------------------------
constructor TdgSounds.Create;
begin
  inherited Create;
  fSoundList := TdgList.Create(vStartQuantity);
end;
//------------------------------------------------------------------------------
destructor TdgSounds.Destroy;
begin
  DeleteAllSounds;//Duncon: simsmen - не трож!
  fSoundList.Free;
  inherited;
end;
//------------------------------------------------------------------------------
function TdgSounds.getCount: Integer;
begin
  Result := fSoundList.Count;
end;
//------------------------------------------------------------------------------
function TdgSounds.GetSoundBy(const aIndex: Integer): TdgOGGSound;
begin
  Result := TdgOGGSound(fSoundList.Items[aIndex]);
end;
//------------------------------------------------------------------------------
function TdgSounds.GetIndex(const aName: String): Integer;
var
  i, c: Integer;
begin
  Result := -1;
  c := fSoundList.Count - 1;
  if c < 0 then Exit;
  for i := c downto 0 do
    if seFunc.SameStr(TdgOGGSound(fSoundList.Items[i]).GetName, aName) then
    begin
      Result := i;
      Exit;
    end;
end;
//------------------------------------------------------------------------------
function TdgSounds.GetSound(const aName: String): TdgOGGSound;
begin
  Result := TdgOGGSound(fSoundList.Items[GetIndex(aName)]);
end;
//------------------------------------------------------------------------------
function TdgSounds.AddSound(aFileName: String; const aInMemory: Boolean = True): Boolean;
var
  s: String;
  og: TdgOGGSound;
begin
  Result := False;
  s := seFunc.ExtractFileName(aFileName);
  if seFunc.SameStr('.ogg', seExtractFileExt(s)) then System.Delete(s, Length(s)-3, Length(s))
  else aFileName := aFileName + '.ogg';
  if GetIndex(s) <> -1 then Exit;
  og := TdgOGGSound.Create;
  with og do begin
    Name := s;
    Path := aFileName;
    LoadFromFile(aFileName, InMemory);
  end;
  fSoundList.Add(og);
  Result := True;
end;
//------------------------------------------------------------------------------
procedure TdgSounds.AddSoundsFromFolder(const aPath: String; const aInMemory: Boolean = True);
var
  SR: TSearchRec;
begin
  if seFindFirst(aPath + '*.*', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Attr <> faDirectory) and seFunc.SameStr('.ogg', seExtractFileExt(SR.Name)) then
        Sounds.AddSound(aPath + SR.Name, aInMemory);
    until seFindNext(SR) <> 0;
    seFindClose(SR);
  end;
end;
//------------------------------------------------------------------------------
procedure TdgSounds.DeleteAllSounds;
var
  i, c: Integer;
begin
  c := fSoundList.Count - 1;
  if c < 0 then Exit;
  for i := c downto 0 do begin
    TdgOGGSound(fSoundList.Items[i]).Free;
    fSoundList.Delete(i);
  end;
end;
//------------------------------------------------------------------------------
procedure TdgSounds.PauseAllSounds;
var
  i, c: Integer;
begin
  c := fSoundList.Count - 1;
  if c < 0 then Exit;
  for i := c downto 0 do TdgOGGSound(fSoundList.Items[i]).Pause;
end;
//------------------------------------------------------------------------------
procedure TdgSounds.UnPauseAllSounds;
var
  i, c: Integer;
begin
  c := fSoundList.Count - 1;
  if c < 0 then Exit;
  for i := c downto 0 do TdgOGGSound(fSoundList.Items[i]).Play;
end;
//------------------------------------------------------------------------------
procedure TdgSounds.StopAllSounds;
var
  i, c: Integer;
begin
  c := fSoundList.Count - 1;
  if c < 0 then Exit;
  for i := c downto 0 do TdgOGGSound(fSoundList.Items[i]).Stop;
end;
//------------------------------------------------------------------------------
procedure TdgSounds.DeleteSound(const aName: String);
var
  i: Integer;
begin
  i := GetIndex(aName);
  if i < 0 then Exit;
  TdgOGGSound(fSoundList.Items[i]).Free;
  fSoundList.Delete(i);
end;
//------------------------------------------------------------------------------
procedure TdgSounds.Assign(const aNewSoundName, copyFromSound: String);
var
  og, fs: TdgOGGSound;
begin
  fs := Sounds[copyFromSound];
  og := TdgOGGSound.Create;
  with og do begin
    Name := aNewSoundName;
    Path := fs.Path;
    InMemory := fs.InMemory;
    LoadFromFile(fs.Path, InMemory);
    Gain := fs.Gain; 
  end;
  fSoundList.Add(og);
end;
//------------------------------------------------------------------------------
procedure TdgSounds.Duplicate(const aNewSoundName, copyFromSound: String);//Для совместимости
begin
  Assign(aNewSoundName, copyFromSound);
end;
//------------------------------------------------------------------------------
{$IFDEF dgR}{$ENDREGION}{$ENDIF} 
//------------------------------------------------------------------------------
initialization
  with seFunc do begin
    LogMe := seLogMe;
    IntToStr := seIntToStr;
    SingleToStr := seSingleToStr;
    dgVector3f := sedgVector3f;
    SameStr := seSameStr;
    FileExists := seFileExists;
    ExtractFileName := seExtractFileName;
    ExtractFileExt := seExtractFileExt;
    ExtractFileDir := seExtractFileDir;
    FindFirst := seFindFirst;
    FindNext := seFindNext;
    FindClose := seFindClose;
  end;
  SoundDevice := TdgSoundDevice.Create;
  Listener := TdgListener.Create;
  Listener.SetDefaultEAXParameters;
  Sounds := TdgSounds.Create;
//------------------------------------------------------------------------------
finalization
  Sounds.StopAllSounds;
  Sounds.Free;
  Listener.Free;
  SoundDevice.Free;
//------------------------------------------------------------------------------

end.
