DLSound.pas
上传用户:yj_qiu
上传日期:2022-08-08
资源大小:23636k
文件大小:7k
源码类别:

游戏引擎

开发平台:

Delphi

  1. (*
  2.  @Abstract(Simple Audiere-based audio unit)
  3.  (C) 2006-2008 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
  4.  The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
  5.  Created: May 16, 2007 <br>
  6.  Unit contains simple audiere-based sound and music implementation
  7. *)
  8. {$Include GDefines.inc}
  9. {$Include C2Defines.inc}
  10. unit DLSound;
  11. interface
  12. uses
  13.   BaseMsg, BaseTypes, Basics,
  14.   Timer,
  15.   SysUtils,
  16.   TextFile,
  17.   Audiere;
  18. const
  19.   // Sounds collection capacity increment step
  20.   SoundsCapacityStep = 16;
  21.   // Default minimal delay between sound play
  22.   DefaultDelay: TSecond = 0.150;
  23. type
  24.   TAdrSound = packed record
  25.     Name: string[43];
  26.     MinDelay: TSecond;
  27.     TimeStamp: Timer.TTimeMark;
  28.     Volume: Single;
  29.     Device: TAdrAudioDevice;
  30.     Stream: TAdrOutputStream;
  31.     Source: TAdrSampleSource;
  32.   end;
  33.   // Sound management class
  34.   TAudiereSound = class(TSubsystem)
  35.   private
  36.     FTimer: TTimer;
  37.     MasterVolume: Single;
  38.     FSounds: array of TAdrSound;
  39.     TotalSounds: Integer;
  40.     function IndexOf(const Name: string): Integer;
  41.     procedure UnloadByIndex(Index: Integer);
  42.   public
  43.     constructor Create(ATimer: TTimer);
  44.     destructor Destroy; override;
  45.     procedure HandleMessage(const Msg: TMessage); override;
  46.     { Loads a sound from file FileName. If AStreamin is false the file will completely loaded into memory.
  47.       The loaded sound later can be referenced by Name. }
  48.     procedure Load(const Name, FileName: string; AStreaming: Boolean);
  49.     // Frees a sound with the given name
  50.     procedure UnLoad(const Name: string);
  51.     // Sets volume of the named sound. If name is empty master (affecting all sounds) volume will be changed.
  52.     procedure SetVolume(const Name: string; Value: Integer);
  53.     // Enables or disables repeating of the named sound
  54.     procedure SetRepeat(const Name: string; Value: Boolean);
  55.     // Sets minimal delay between two possible subsequent Play() calls of the named sound
  56.     procedure SetDelay(const Name: string; Value: Double);
  57.     // Plays the named sound. Many instances of the same sound can be played simultaneously.
  58.     procedure Play(const Name: string);
  59.     // Stops the sound playback
  60.     procedure Stop(const Name: string);
  61.   end;
  62. implementation
  63. { TAudiereSound }
  64. function TAudiereSound.IndexOf(const Name: string): Integer;
  65. begin
  66.   Result := TotalSounds-1;
  67.   while (Result >= 0) and (FSounds[Result].Name <> Name) do Dec(Result);
  68. end;
  69. procedure TAudiereSound.UnloadByIndex(Index: Integer);
  70. begin
  71.   Assert((Index >= 0) and (Index < TotalSounds), '');
  72.   if (Index < 0) or (Index >= TotalSounds) then Exit;
  73.   
  74.   FSounds[Index].Stream.Stop;
  75. //  if Assigned(FSounds[Index].Stream) then FreeAndNil(FSounds[Index].Stream);
  76. //  if Assigned(FSounds[Index].Source) then FreeAndNil(FSounds[Index].Source);
  77. //  if Assigned(FSounds[Index].Device) then FreeAndNil(FSounds[Index].Device);
  78.   Dec(TotalSounds);
  79.   FSounds[Index] := FSounds[TotalSounds];
  80. end;
  81. constructor TAudiereSound.Create(ATimer: TTimer);
  82. var s: PChar;
  83. begin
  84.   Assert(Assigned(ATimer), 'TAudiereSound.Create: ATimer should be assigned');
  85.   MasterVolume := 0.5;
  86.   s := AdrGetVersion;
  87.   Log.Log('Audiere version: ' + s, lkNotice);
  88.   s := AdrGetSupportedFileFormats;   Log.Log('  formats supported: ' + s);   s := AdrGetSupportedAudioDevices;   Log.Log('  devices supported: ' + s);   FTimer := ATimer; end;
  89. destructor TAudiereSound.Destroy;
  90. var i: Integer;
  91. begin
  92.   for i := TotalSounds-1 downto 0 do UnloadByIndex(i);
  93.   inherited;
  94. end;
  95. procedure TAudiereSound.Load(const Name, FileName: string; AStreaming: Boolean);
  96. begin
  97.   if IndexOf(Name) <> -1 then begin
  98.     Log.Log('TAudiereSound.Load: Sound "' + Name + '" already defined', lkError);
  99.     Exit;
  100.   end;
  101.   if Length(FSounds) <= TotalSounds then SetLength(FSounds, Length(FSounds) + SoundsCapacityStep);
  102.   FSounds[TotalSounds].Stream := nil;
  103.   FSounds[TotalSounds].Name   := Name;
  104.   FSounds[TotalSounds].Volume := 0.5;
  105.   FSounds[TotalSounds].Device := AdrOpenDevice('', '');
  106.   if Assigned(FSounds[TotalSounds].Device) then begin
  107.     FSounds[TotalSounds].Source := AdrOpenSampleSource(PChar(Filename), FF_AUTODETECT);
  108.     if Assigned(FSounds[TotalSounds].Source) then
  109.       FSounds[TotalSounds].Stream := AdrOpenSound(FSounds[TotalSounds].Device, FSounds[TotalSounds].Source, AStreaming);
  110.   end;
  111.   if FSounds[TotalSounds].Stream = nil then begin
  112. //    if Assigned(FSounds[TotalSounds].Source) then FreeAndNil(FSounds[TotalSounds].Source);
  113. //    if Assigned(FSounds[TotalSounds].Device) then FreeAndNil(FSounds[TotalSounds].Device);
  114.     Log.Log('TAudiereSound.Load: Error loading sound file "' + FileName + '"', lkError);
  115.   end else begin
  116.     FSounds[TotalSounds].Stream.SetVolume(FSounds[TotalSounds].Volume * MasterVolume);
  117.     FSounds[TotalSounds].TimeStamp.Signature := NullSignature;
  118.     FSounds[TotalSounds].MinDelay := DefaultDelay;
  119.     Inc(TotalSounds);
  120.   end;
  121. end;
  122. procedure TAudiereSound.UnLoad(const Name: string);
  123. var i: Integer;
  124. begin
  125.   i := IndexOf(Name);
  126.   if i >= 0 then UnloadByIndex(i) else begin
  127.     Log.Log('TAudiereSound.UnLoad: Sound "' + Name + '" not found', lkWarning); 
  128.   end;
  129. end;
  130. procedure TAudiereSound.SetVolume(const Name: string; Value: Integer);
  131. var i: Integer;
  132. begin
  133.   if Name = '' then begin
  134.     MasterVolume := MinS(1, Value/100);
  135.     for i := 0 to TotalSounds-1 do FSounds[i].Stream.SetVolume(FSounds[i].Volume * MasterVolume);
  136.   end else begin
  137.     i := IndexOf(Name);
  138.     if i >= 0 then begin
  139.       FSounds[i].Volume := MinS(1, Value/100);
  140.       FSounds[i].Stream.SetVolume(FSounds[i].Volume * MasterVolume);
  141.     end else begin
  142.       Log.Log('TAudiereSound.SetVolume: Sound "' + Name + '" not found', lkWarning); 
  143.     end;
  144.   end;
  145. end;
  146. procedure TAudiereSound.SetRepeat(const Name: string; Value: Boolean);
  147. var i: Integer;
  148. begin
  149.   i := IndexOf(Name);
  150.   if i >= 0 then
  151.     FSounds[i].Stream.SetRepeat(Value) else begin
  152.       Log.Log('TAudiereSound.SetRepeat: Sound "' + Name + '" not found', lkWarning); 
  153.     end;
  154. end;
  155. procedure TAudiereSound.SetDelay(const Name: string; Value: Double);
  156. var i: Integer;
  157. begin
  158.   i := IndexOf(Name);
  159.   if i >= 0 then
  160.     FSounds[i].MinDelay := Value else begin
  161.       Log.Log('TAudiereSound.SetDelay: Sound "' + Name + '" not found', lkWarning); 
  162.     end;
  163. end;
  164. procedure TAudiereSound.Play(const Name: string);
  165. var i: Integer;
  166. begin
  167.   i := IndexOf(Name);
  168.   if i >= 0 then begin
  169.     if FTimer.IsIntervalPassed(FSounds[i].Timestamp, True, FSounds[i].MinDelay) then begin
  170.       FSounds[i].Stream.Reset;
  171.       FSounds[i].Stream.Play;
  172.     end;
  173.   end else
  174.     Log.Log('TAudiereSound.Play: Sound "' + Name + '" not found', lkWarning);
  175. end;
  176. procedure TAudiereSound.Stop(const Name: string);
  177. var i: Integer;
  178. begin
  179.   i := IndexOf(Name);
  180.   if i >= 0 then
  181.     FSounds[i].Stream.Stop else begin
  182.       Log.Log('TAudiereSound.Stop: Sound "' + Name + '" not found', lkWarning);
  183.     end;
  184. end;
  185. procedure TAudiereSound.HandleMessage(const Msg: TMessage);
  186. begin
  187. //  if
  188. end;
  189. end.