src/engine/e_sound_al.inc

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 interface
  16
  17 uses
  18   AL,
  19   {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
  20   e_soundfile,
  21   e_log,
  22   SysUtils;
  23
  24 type
  25   TSoundRec = record
  26     Loader: TSoundLoader;
  27     alBuffer: ALuint;
  28     isMusic: Boolean;
  29     Loops: Boolean;
  30     nRefs: Integer;
  31   end;
  32
  33   TBasicSound = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  34   private
  35     FSource: Integer;
  36     FOldGain: ALfloat;
  37     FMuted: Boolean;
  38
  39     function InvalidSource(): Boolean; inline;
  40
  41   protected
  42     FID: DWORD;
  43     FMusic: Boolean;
  44     FPosition: DWORD;
  45
  46     function RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean;
  47
  48   public
  49     constructor Create();
  50     destructor Destroy(); override;
  51     procedure SetID(ID: DWORD);
  52     procedure FreeSound();
  53     function IsPlaying(): Boolean;
  54     procedure Stop();
  55     function IsPaused(): Boolean;
  56     procedure Pause(Enable: Boolean);
  57     function GetVolume(): Single;
  58     procedure SetVolume(Volume: Single);
  59     function GetPan(): Single;
  60     procedure SetPan(Pan: Single);
  61     function IsMuted(): Boolean;
  62     procedure Mute(Enable: Boolean);
  63     function GetPosition(): DWORD;
  64     procedure SetPosition(aPos: DWORD);
  65     procedure SetPriority(priority: Integer);
  66   end;
  67
  68 const
  69   NO_SOUND_ID = DWORD(-1);
  70
  71 function e_InitSoundSystem(NoOutput: Boolean = False): Boolean;
  72
  73 function e_LoadSound(FileName: string; var ID: DWORD; isMusic: Boolean; ForceNoLoop: Boolean = False): Boolean;
  74 function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; isMusic: Boolean; ForceNoLoop: Boolean = False): Boolean;
  75
  76 function e_PlaySound(ID: DWORD): Integer;
  77 function e_PlaySoundPan(ID: DWORD; Pan: Single): Integer;
  78 function e_PlaySoundVolume(ID: DWORD; Volume: Single): Integer;
  79 function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Integer;
  80
  81 procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean);
  82 procedure e_MuteChannels(Enable: Boolean);
  83 procedure e_StopChannels();
  84
  85 procedure e_DeleteSound(ID: DWORD);
  86 procedure e_RemoveAllSounds();
  87 procedure e_ReleaseSoundSystem();
  88 procedure e_SoundUpdate();
  89
  90 var
  91   e_SoundFormat: TSoundFormat; // desired sound format
  92   e_SoundsArray: array of TSoundRec = nil;
  93   e_ZeroPosition: array [0..2] of ALfloat = (0, 0, 0);
  94   e_ALError: ALenum = 0;
  95   e_SoundFont: string = '';
  96   e_MusicLerp: Boolean = True;
  97
  98 implementation
  99
 100 uses
 101   g_options, utils;
 102
 103 const
 104   NUM_SOURCES = 255; // + 1 stereo
 105   NUM_STREAM_BUFFERS = 8;
 106   STREAM_BUFSIZE = 8192;
 107   MUSIC_SOURCE = 0;
 108
 109 var
 110   SoundMuted: Boolean = False;
 111   CurStream: DWORD = NO_SOUND_ID;
 112   alDevice: PALCdevice = nil;
 113   alContext: PALCcontext = nil;
 114   // sources for everything
 115   alSources: array [0..NUM_SOURCES] of ALuint;
 116   // last TBasicSound that has played on each source
 117   alOwners: array [0..NUM_SOURCES] of TBasicSound;
 118   // buffers for the music stream
 119   alStreamBufs: array [0..NUM_STREAM_BUFFERS-1] of ALuint;
 120   alStreamData: array [0..STREAM_BUFSIZE-1] of Byte;
 121   alStreamAvail: Integer = NUM_STREAM_BUFFERS;
 122
 123 {$IFNDEF OPENAL_SINGLETHREADED}
 124 var
 125   StreamThread: TThreadID = NilThreadId;
 126   StreamThreadRunning: Boolean = False;
 127   StreamLock: TRTLCriticalSection;
 128   StreamBufTime: Integer = 10; // time to sleep between buffer checks
 129
 130 procedure UpdateStreamSource(Src: Integer); forward;
 131
 132 function StreamThreadProc(Param: Pointer): PtrInt;
 133 begin
 134   while StreamThreadRunning do
 135   begin
 136     EnterCriticalSection(StreamLock);
 137     UpdateStreamSource(MUSIC_SOURCE);
 138     LeaveCriticalSection(StreamLock);
 139     Sleep(StreamBufTime);
 140   end;
 141   Result := 0;
 142 end;
 143 {$ENDIF}
 144
 145 function CheckALError(): Boolean;
 146 begin
 147   e_ALError := alGetError();
 148   Result := e_ALError <> AL_NO_ERROR;
 149 end;
 150
 151 function GetALError(): string;
 152 begin
 153   Result := '';
 154   case e_ALError of
 155     AL_NO_ERROR:          Result := '';
 156     AL_INVALID_NAME:      Result := 'AL_INVALID_NAME';
 157     AL_INVALID_ENUM:      Result := 'AL_INVALID_ENUM';
 158     AL_INVALID_VALUE:     Result := 'AL_INVALID_VALUE';
 159     AL_INVALID_OPERATION: Result := 'AL_INVALID_OPERATION';
 160     AL_OUT_OF_MEMORY:     Result := 'AL_OUT_OF_MEMORY';
 161     else                  Result := Format('unknown error %x', [e_ALError]);
 162   end;
 163 end;
 164
 165 function e_InitSoundSystem(NoOutput: Boolean = False): Boolean;
 166 var
 167   alExt, alRend, alVendor, alVer: string;
 168   WantDev: string = '';
 169   WantAttrs: array [0..4] of ALCint = (
 170     ALC_STEREO_SOURCES, 1,
 171     ALC_MONO_SOURCES, NUM_SOURCES,
 172     0
 173   );
 174 begin
 175   Result := False;
 176
 177   WantDev := alcGetString(nil, ALC_DEVICE_SPECIFIER);
 178   e_LogWritefln('AL: available devices: %s', [WantDev]);
 179
 180   // TODO: open a dummy device when NoOutput is true or something
 181   WantDev := alcGetString(nil, ALC_DEFAULT_DEVICE_SPECIFIER);
 182   e_LogWritefln('AL: trying to open device %s', [WantDev]);
 183
 184   alDevice := alcOpenDevice(PChar(WantDev));
 185   if alDevice = nil then
 186   begin
 187     e_LogWritefln('AL: ERROR: could not open device %s: %s', [WantDev, GetALError()]);
 188     exit;
 189   end;
 190
 191   alContext := alcCreateContext(alDevice, WantAttrs);
 192   if alContext = nil then
 193   begin
 194     e_LogWritefln('AL: ERROR: could not create context: %s', [GetALError()]);
 195     alcCloseDevice(alDevice);
 196     alDevice := nil;
 197     exit;
 198   end;
 199
 200   alcMakeContextCurrent(alContext);
 201
 202   // TODO: actually parse these from alc attributes or something
 203   e_SoundFormat.SampleRate := 48000;
 204   e_SoundFormat.SampleBits := 16;
 205   e_SoundFormat.Channels := 2;
 206
 207   alVendor := alGetString(AL_VENDOR);
 208   alRend := alGetString(AL_RENDERER);
 209   alVer := alGetString(AL_VERSION);
 210   alExt := alGetString(AL_EXTENSIONS);
 211
 212   e_LogWriteln('AL INFO:');
 213   e_LogWriteln('  Version:  '    + alVer);
 214   e_LogWriteln('  Vendor:   '    + alVendor);
 215   e_LogWriteln('  Renderer: '    + alRend);
 216   e_LogWriteln('  Device:   '    + WantDev);
 217   e_LogWriteln('  Sample rate: ' + IntToStr(e_SoundFormat.SampleRate));
 218   e_LogWriteln('  Extensions:');
 219   e_LogWriteln('    ' + alExt);
 220
 221   ZeroMemory(@alSources[0], sizeof(alSources));
 222   ZeroMemory(@alOwners[0], sizeof(alOwners));
 223   ZeroMemory(@alStreamBufs[0], sizeof(alStreamBufs));
 224   ZeroMemory(@alStreamData[0], sizeof(alStreamData));
 225   CurStream := NO_SOUND_ID;
 226
 227   alGetError(); // reset the goddamn error state
 228   alGenSources(1, @alSources[0]); // generate the music source
 229   if CheckALError() then
 230     e_LogWriteln('AL: ERROR: alGenSources() for music failed: ' + GetALError());
 231
 232   alStreamAvail := 0;
 233   alGenBuffers(NUM_STREAM_BUFFERS, @alStreamBufs[0]); // generate buffers for the music stream
 234   if CheckALError() then
 235     e_LogWriteln('AL: ERROR: alGenSources() for music failed: ' + GetALError())
 236   else
 237     alStreamAvail := NUM_STREAM_BUFFERS;
 238
 239   {$IFNDEF OPENAL_SINGLETHREADED}
 240   InitCriticalSection(StreamLock);
 241   StreamThreadRunning := True;
 242   StreamThread := BeginThread(Addr(StreamThreadProc));
 243   {$ENDIF}
 244
 245   Result := True;
 246 end;
 247
 248 function FindESound(): DWORD;
 249 var
 250   i: Integer;
 251
 252 begin
 253   if e_SoundsArray <> nil then
 254     for i := 0 to High(e_SoundsArray) do
 255       if (e_SoundsArray[i].alBuffer = 0) and (e_SoundsArray[i].Loader = nil) then
 256       begin
 257         Result := i;
 258         Exit;
 259       end;
 260
 261   if e_SoundsArray = nil then
 262     begin
 263       SetLength(e_SoundsArray, 16);
 264       Result := 0;
 265     end
 266   else
 267     begin
 268       Result := High(e_SoundsArray) + 1;
 269       SetLength(e_SoundsArray, Length(e_SoundsArray) + 16);
 270     end;
 271 end;
 272
 273 function GetALSoundFormat(Fmt: TSoundFormat): ALenum; inline;
 274 begin
 275   if Fmt.Channels = 2 then
 276   begin
 277     if Fmt.SampleBits = 16 then
 278       Result := AL_FORMAT_STEREO16
 279     else
 280       Result := AL_FORMAT_STEREO8;
 281   end
 282   else
 283   begin
 284     if Fmt.SampleBits = 16 then
 285       Result := AL_FORMAT_MONO16
 286     else
 287       Result := AL_FORMAT_MONO8;
 288   end;
 289 end;
 290
 291 function GetALSourceState(S: ALuint): ALint; inline;
 292 begin
 293   alGetSourcei(S, AL_SOURCE_STATE, Result);
 294 end;
 295
 296 function LoadEntireSound(var Snd: TSoundRec; Loader: TSoundLoader): Boolean;
 297 var
 298   Frame: Pointer;
 299   Data: Pointer;
 300   Rx: LongWord;
 301   DataLen, OldLen: LongWord;
 302 const
 303   CHUNK_SIZE = 65536 * 2 * 2;
 304 begin
 305   Result := False;
 306
 307   Frame := GetMem(CHUNK_SIZE);
 308   if Frame = nil then exit;
 309
 310   Data := nil;
 311   DataLen := 0;
 312
 313   repeat
 314     Rx := Loader.FillBuffer(Frame, CHUNK_SIZE);
 315     if Rx = 0 then break;
 316
 317     OldLen := DataLen;
 318     DataLen := DataLen + Rx;
 319     Data := ReAllocMem(Data, DataLen);
 320     if Data = nil then begin FreeMem(Frame); exit; end;
 321
 322     Move(Frame^, (Data + OldLen)^, Rx);
 323   until Loader.Finished();
 324
 325   FreeMem(Frame);
 326
 327   alGenBuffers(1, Addr(Snd.alBuffer));
 328   if CheckALError() then
 329   begin
 330     e_LogWritefln('AL: Could not create AL buffer: %s', [GetALError()]);
 331     FreeMem(Data);
 332     exit;
 333   end;
 334
 335   alBufferData(
 336     Snd.alBuffer,
 337     GetALSoundFormat(Loader.Format),
 338     Data,
 339     DataLen,
 340     Loader.Format.SampleRate
 341   );
 342
 343   FreeMem(Data);
 344
 345   if CheckALError() then
 346   begin
 347     e_LogWriteln('AL: Could not fill AL buffer: ' + GetALError());
 348     alDeleteBuffers(1, Addr(Snd.alBuffer));
 349     Snd.alBuffer := 0;
 350     exit;
 351   end;
 352
 353   Result := True;
 354 end;
 355
 356 function e_LoadSound(FileName: String; var ID: DWORD; isMusic: Boolean; ForceNoLoop: Boolean = False): Boolean;
 357 var
 358   find_id: DWORD;
 359   Loader: TSoundLoader;
 360 begin
 361   ID := NO_SOUND_ID;
 362   Result := False;
 363
 364   find_id := FindESound();
 365
 366   e_SoundsArray[find_id].Loader := nil;
 367   e_SoundsArray[find_id].isMusic := isMusic;
 368   e_SoundsArray[find_id].Loops := isMusic and not ForceNoLoop;
 369   e_SoundsArray[find_id].nRefs := 0;
 370
 371   Loader := e_GetSoundLoader(FileName);
 372   if Loader = nil then
 373   begin
 374     e_LogWritefln('Could not find loader for sound `%s`', [FileName]);
 375     exit;
 376   end;
 377
 378   if not Loader.Load(FileName, e_SoundsArray[find_id].Loops) then
 379   begin
 380     e_LogWritefln('Could not load sound `%s`', [FileName]);
 381     exit;
 382   end;
 383
 384   alGetError(); // reset error state, god damn it
 385
 386   if not isMusic then
 387   begin
 388     if not LoadEntireSound(e_SoundsArray[find_id], Loader) then
 389       e_LogWritefln('AL: Could not buffer sound effect `%s`', [FileName]);
 390     // don't need this anymore
 391     Loader.Free();
 392     Loader := nil;
 393   end
 394   else
 395   begin
 396     e_SoundsArray[find_id].alBuffer := 0;
 397     e_SoundsArray[find_id].Loader := Loader;
 398   end;
 399
 400   ID := find_id;
 401   Result := True;
 402 end;
 403
 404 function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; isMusic: Boolean; ForceNoLoop: Boolean = False): Boolean;
 405 var
 406   find_id: DWORD;
 407   Loader: TSoundLoader;
 408 begin
 409   ID := NO_SOUND_ID;
 410   Result := False;
 411
 412   find_id := FindESound();
 413
 414   e_SoundsArray[find_id].Loader := nil;
 415   e_SoundsArray[find_id].isMusic := isMusic;
 416   e_SoundsArray[find_id].Loops := isMusic and not ForceNoLoop;
 417   e_SoundsArray[find_id].nRefs := 0;
 418
 419   Loader := e_GetSoundLoader(pData, LongWord(Length));
 420   if Loader = nil then
 421   begin
 422     e_LogWritefln('Could not find loader for sound `%p`', [pData]);
 423     exit;
 424   end;
 425
 426   if not Loader.Load(pData, LongWord(Length), e_SoundsArray[find_id].Loops) then
 427   begin
 428     e_LogWritefln('Could not load sound `%p`', [pData]);
 429     exit;
 430   end;
 431
 432   alGetError(); // reset error state, god damn it
 433
 434   if not isMusic then
 435   begin
 436     if not LoadEntireSound(e_SoundsArray[find_id], Loader) then
 437       e_LogWritefln('AL: Could not buffer sound effect `%p`', [pData]);
 438     // don't need this anymore
 439     Loader.Free();
 440     Loader := nil;
 441   end
 442   else
 443   begin
 444     e_SoundsArray[find_id].alBuffer := 0;
 445     e_SoundsArray[find_id].Loader := Loader;
 446   end;
 447
 448   // the calling side won't free this, the loader will get a copy, so fuck it
 449   FreeMem(pData);
 450   ID := find_id;
 451   Result := True;
 452 end;
 453
 454 function FindSourceForSound(ID: DWORD): Integer;
 455 var
 456   S: Integer;
 457 begin
 458   Result := -1;
 459   if ID > High(e_SoundsArray) then
 460     exit;
 461
 462   if e_SoundsArray[ID].Loader <> nil then
 463   begin
 464     // first source is for streaming sounds
 465     // it always exists
 466     alOwners[MUSIC_SOURCE] := nil;
 467     Result := MUSIC_SOURCE;
 468     exit;
 469   end;
 470
 471   for S := 1 to High(alSources) do
 472     if alSources[S] = 0 then
 473     begin
 474       alOwners[S] := nil; // TBasicSounds will set this if needed
 475       Result := S;
 476       break;
 477     end;
 478
 479   if Result = -1 then Exit; // no voices left
 480
 481   alGetError(); // reset error state
 482   alGenSources(1, @alSources[Result]);
 483   if CheckALError() then
 484   begin
 485     e_LogWriteln('AL: FindSourceForSound(): alGenSources() failed: ' + GetALError());
 486     Result := -1;
 487   end;
 488 end;
 489
 490 procedure AssignSound(ID: DWORD; Src: ALuint); inline;
 491 var
 492   S: ALint;
 493 begin
 494   alGetError(); // reset error state
 495
 496   if e_SoundsArray[ID].Loader <> nil then
 497   begin
 498     // this is a stream
 499     {$IFNDEF OPENAL_SINGLETHREADED}
 500     // lock the stream so the stream thread doesn't shit itself
 501     EnterCriticalSection(StreamLock);
 502     // number of stereo samples / samplerate =
 503     // time until buffer runs out
 504     StreamBufTime :=
 505       (STREAM_BUFSIZE div (2 * e_SoundsArray[ID].Loader.Format.SampleBits div 8)) div
 506       (e_SoundsArray[ID].Loader.Format.SampleRate div 1000) - 1;
 507     if StreamBufTime < 1 then StreamBufTime := 1;
 508     {$ENDIF}
 509     // reset position
 510     e_SoundsArray[ID].Loader.Restart();
 511     if CurStream <> ID then // changing streams
 512     begin
 513       alSourceStop(Src); // this should mark all buffers as processed
 514       alGetSourcei(Src, AL_BUFFERS_PROCESSED, S);
 515       // unqueue all buffers
 516       if S > 0 then
 517       begin
 518         alSourceUnqueueBuffers(Src, S, @alStreamBufs[alStreamAvail]);
 519         alStreamAvail := NUM_STREAM_BUFFERS;
 520       end;
 521     end;
 522     // this shit is playing now
 523     CurStream := ID;
 524     {$IFNDEF OPENAL_SINGLETHREADED}
 525     // unlock the stream
 526     LeaveCriticalSection(StreamLock);
 527     {$ENDIF}
 528   end
 529   else
 530   begin
 531     // this is a full chunk, assign local buffer
 532     alSourcei(Src, AL_BUFFER, e_SoundsArray[ID].alBuffer);
 533     // these can loop
 534     if (e_SoundsArray[ID].Loops) then
 535       alSourcei(Src, AL_LOOPING, AL_TRUE)
 536     else
 537       alSourcei(Src, AL_LOOPING, AL_FALSE);
 538   end;
 539
 540   alSourcei(Src, AL_SOURCE_RELATIVE, AL_TRUE);
 541 end;
 542
 543 function e_PlaySound(ID: DWORD): Integer;
 544 begin
 545   Result := FindSourceForSound(ID);
 546   if Result >= 0 then
 547   begin
 548     AssignSound(ID, alSources[Result]);
 549     alSourcef(alSources[Result], AL_GAIN, 1);
 550     alSourcefv(alSources[Result], AL_POSITION, e_ZeroPosition);
 551     alSourcePlay(alSources[Result]);
 552   end;
 553 end;
 554
 555 function e_PlaySoundPan(ID: DWORD; Pan: Single): Integer;
 556 var
 557   Pos: array [0..2] of ALfloat;
 558 begin
 559   Result := FindSourceForSound(ID);
 560   if Result >= 0 then
 561   begin
 562     Pos[0] := Pan;
 563     Pos[1] := 0;
 564     Pos[2] := 0;
 565     AssignSound(ID, alSources[Result]);
 566     alSourcef(alSources[Result], AL_GAIN, 1);
 567     alSourcefv(alSources[Result], AL_POSITION, Pos);
 568     alSourcePlay(alSources[Result]);
 569   end;
 570 end;
 571
 572 function e_PlaySoundVolume(ID: DWORD; Volume: Single): Integer;
 573 begin
 574   Result := FindSourceForSound(ID);
 575   if Result >= 0 then
 576   begin
 577     AssignSound(ID, alSources[Result]);
 578     alSourcef(alSources[Result], AL_GAIN, Volume);
 579     alSourcefv(alSources[Result], AL_POSITION, e_ZeroPosition);
 580     alSourcePlay(alSources[Result]);
 581   end;
 582 end;
 583
 584 function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Integer;
 585 var
 586   Pos: array [0..2] of ALfloat;
 587 begin
 588   Result := FindSourceForSound(ID);
 589   if Result >= 0 then
 590   begin
 591     Pos[0] := Pan;
 592     Pos[1] := 0;
 593     Pos[2] := 0;
 594     AssignSound(ID, alSources[Result]);
 595     alSourcefv(alSources[Result], AL_POSITION, Pos);
 596     alSourcef(alSources[Result], AL_GAIN, Volume);
 597     alSourcePlay(alSources[Result]);
 598   end;
 599 end;
 600
 601 procedure e_DeleteSound(ID: DWORD);
 602 begin
 603   if ID > High(e_SoundsArray) then
 604     exit;
 605   if (e_SoundsArray[ID].alBuffer <> 0) then
 606   begin
 607     alDeleteBuffers(1, Addr(e_SoundsArray[ID].alBuffer));
 608     e_SoundsArray[ID].alBuffer := 0;
 609   end;
 610   if (e_SoundsArray[ID].Loader <> nil) then
 611   begin
 612     e_SoundsArray[ID].Loader.Free();
 613     e_SoundsArray[ID].Loader := nil;
 614     if ID = CurStream then
 615       CurStream := NO_SOUND_ID;
 616   end;
 617 end;
 618
 619 procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean);
 620 var
 621   S: Integer;
 622   V: ALfloat;
 623 begin
 624   // TODO: replace manual volume calculations everywhere with
 625   //       alListenerf(AL_GAIN) or something
 626   if setMode then
 627   begin
 628     for S := 1 to High(alSources) do
 629       if alSources[S] <> 0 then
 630         alSourcef(alSources[S], AL_GAIN, SoundMod)
 631   end
 632   else
 633   begin
 634     for S := 1 to High(alSources) do
 635       if alSources[S] <> 0 then
 636       begin
 637         alGetSourcef(alSources[S], AL_GAIN, V);
 638         alSourcef(alSources[S], AL_GAIN, V * SoundMod);
 639       end;
 640   end;
 641 end;
 642
 643 procedure e_MuteChannels(Enable: Boolean);
 644 begin
 645   if Enable = SoundMuted then
 646     Exit;
 647
 648   SoundMuted := Enable;
 649 end;
 650
 651 procedure e_StopChannels();
 652 var
 653   S: Integer;
 654 begin
 655   alGetError(); // reset error state
 656   for S := Low(alSources) to High(alSources) do
 657     if (alSources[S] <> 0) and (GetALSourceState(alSources[S]) = AL_PLAYING) then
 658     begin
 659       alSourceStop(alSources[S]);
 660       alDeleteSources(1, @alSources[S]);
 661       alSources[S] := 0;
 662     end;
 663 end;
 664
 665 procedure e_RemoveAllSounds();
 666 var
 667   i: Integer;
 668 begin
 669   for i := 0 to High(e_SoundsArray) do
 670     if e_SoundsArray[i].alBuffer <> 0 then
 671       e_DeleteSound(i);
 672   SetLength(e_SoundsArray, 0);
 673   e_SoundsArray := nil;
 674   CurStream := NO_SOUND_ID;
 675 end;
 676
 677 procedure e_ReleaseSoundSystem();
 678 begin
 679   {$IFNDEF OPENAL_SINGLETHREADED}
 680   if StreamThread <> NilThreadId then
 681   begin
 682     StreamThreadRunning := False;
 683     WaitForThreadTerminate(StreamThread, 66666);
 684     StreamThread := NilThreadId;
 685     DoneCriticalSection(StreamLock);
 686   end;
 687   {$ENDIF}
 688
 689   e_RemoveAllSounds();
 690
 691   alcMakeContextCurrent(nil);
 692   alcDestroyContext(alContext);
 693   alcCloseDevice(alDevice);
 694
 695   alDevice := nil;
 696   alContext := nil;
 697 end;
 698
 699 procedure UpdateStreamSource(Src: Integer);
 700 var
 701   OutLen: LongWord;
 702   Buf: ALuint;
 703   S: Integer;
 704 begin
 705   if alSources[Src] = 0 then Exit;
 706
 707   alGetError(); // reset error state
 708
 709   alGetSourcei(alSources[Src], AL_BUFFERS_PROCESSED, S);
 710   // unqueue processed buffers
 711   if S > 0 then
 712   begin
 713     alSourceUnqueueBuffers(alSources[Src], S, @alStreamBufs[alStreamAvail]);
 714     alStreamAvail := alStreamAvail + S;
 715   end;
 716
 717   alGetError(); // reset error state
 718
 719   if (alStreamAvail > 0) and (CurStream <> NO_SOUND_ID) then
 720   begin
 721     // some buffers have freed up, advance stream playback
 722     OutLen := e_SoundsArray[CurStream].Loader.FillBuffer(@alStreamData[0], STREAM_BUFSIZE);
 723     if OutLen = 0 then Exit; // ran out of stream
 724     Buf := alStreamBufs[alStreamAvail-1];
 725     Dec(alStreamAvail);
 726     // upload
 727     alBufferData(
 728       Buf,
 729       GetALSoundFormat(e_SoundsArray[CurStream].Loader.Format),
 730       @alStreamData[0],
 731       OutLen,
 732       e_SoundsArray[CurStream].Loader.Format.SampleRate
 733     );
 734     // attach
 735     alSourceQueueBuffers(alSources[Src], 1, @Buf);
 736     // restart if needed
 737     S := GetALSourceState(alSources[Src]);
 738     if (S = AL_STOPPED) or (S = AL_INITIAL) then
 739       alSourcePlay(alSources[Src]);
 740   end;
 741 end;
 742
 743 procedure e_SoundUpdate();
 744 var
 745   S: Integer;
 746 begin
 747   alGetError(); // reset error state
 748
 749   // clear out all stopped sources
 750   for S := 1 to High(alSources) do
 751     if (alSources[S] <> 0) and (GetALSourceState(alSources[S]) = AL_STOPPED) then
 752     begin
 753       alDeleteSources(1, @alSources[S]);
 754       alSources[S] := 0;
 755       alOwners[S] := nil;
 756     end;
 757
 758   {$IFDEF OPENAL_SINGLETHREADED}
 759   // update the stream sources
 760   UpdateStreamSource(MUSIC_SOURCE);
 761   {$ENDIF}
 762 end;
 763
 764 { TBasicSound: }
 765
 766 constructor TBasicSound.Create();
 767 begin
 768   FID := NO_SOUND_ID;
 769   FMusic := False;
 770   FSource := -1;
 771   FPosition := 0;
 772   FMuted := False;
 773   FOldGain := 1;
 774 end;
 775
 776 destructor TBasicSound.Destroy();
 777 begin
 778   FreeSound();
 779   inherited;
 780 end;
 781
 782 function TBasicSound.InvalidSource(): Boolean; inline;
 783 begin
 784   Result := (FSource < 0) or (alSources[FSource] = 0) or (alOwners[FSource] <> self);
 785 end;
 786
 787 procedure TBasicSound.FreeSound();
 788 begin
 789   if FID = NO_SOUND_ID then
 790     Exit;
 791
 792   Stop();
 793   FID := NO_SOUND_ID;
 794   FMusic := False;
 795   FPosition := 0;
 796 end;
 797
 798 function TBasicSound.RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean;
 799 begin
 800   Result := False;
 801   if FID = NO_SOUND_ID then Exit;
 802
 803   if e_SoundsArray[FID].nRefs >= gMaxSimSounds then
 804   begin
 805     Result := True;
 806     Exit;
 807   end;
 808
 809   FSource := e_PlaySoundPanVolume(FID, Pan, Volume);
 810   if FSource >= 0 then
 811   begin
 812     alOwners[FSource] := self;
 813     Result := True;
 814   end;
 815 end;
 816
 817 procedure TBasicSound.SetID(ID: DWORD);
 818 begin
 819   FreeSound();
 820
 821   if ID > High(e_SoundsArray) then
 822     exit;
 823
 824   FID := ID;
 825   FMusic := e_SoundsArray[ID].isMusic;
 826 end;
 827
 828 function TBasicSound.IsPlaying(): Boolean;
 829 begin
 830   Result := False;
 831   if InvalidSource() then
 832     Exit;
 833   Result := GetALSourceState(alSources[FSource]) = AL_PLAYING;
 834 end;
 835
 836 procedure TBasicSound.Stop();
 837 begin
 838   if FID = CurStream then
 839     CurStream := NO_SOUND_ID;
 840   if InvalidSource() then
 841     Exit;
 842   GetPosition();
 843   alSourceStop(alSources[FSource]);
 844 end;
 845
 846 function TBasicSound.IsPaused(): Boolean;
 847 begin
 848   Result := False;
 849   if InvalidSource() then
 850     Exit;
 851   Result := GetALSourceState(alSources[FSource]) = AL_PAUSED;
 852 end;
 853
 854 procedure TBasicSound.Pause(Enable: Boolean);
 855 begin
 856   if InvalidSource() then
 857     Exit;
 858   if Enable then
 859     alSourcePause(alSources[FSource])
 860   else
 861     alSourcePlay(alSources[FSource]);
 862 end;
 863
 864 function TBasicSound.GetVolume(): Single;
 865 begin
 866   Result := 0.0;
 867   if InvalidSource() then
 868     Exit;
 869   alGetSourcef(alSources[FSource], AL_GAIN, Result);
 870 end;
 871
 872 procedure TBasicSound.SetVolume(Volume: Single);
 873 begin
 874   if InvalidSource() then
 875     Exit;
 876   alSourcef(alSources[FSource], AL_GAIN, Volume);
 877 end;
 878
 879 function TBasicSound.GetPan(): Single;
 880 var
 881   Pos: array [0..2] of ALfloat = (0, 0, 0);
 882 begin
 883   Result := 0.0;
 884   if InvalidSource() then
 885     Exit;
 886   alGetSourcefv(alSources[FSource], AL_POSITION, Pos);
 887   Result := Pos[0];
 888 end;
 889
 890 procedure TBasicSound.SetPan(Pan: Single);
 891 var
 892   Pos: array [0..2] of ALfloat;
 893 begin
 894   if InvalidSource() then
 895     Exit;
 896   Pos[0] := Pan;
 897   Pos[1] := 0;
 898   Pos[2] := 0;
 899   alSourcefv(alSources[FSource], AL_POSITION, Pos);
 900 end;
 901
 902 function TBasicSound.IsMuted(): Boolean;
 903 begin
 904   if InvalidSource() then
 905     Result := False
 906   else
 907     Result := FMuted;
 908 end;
 909
 910 procedure TBasicSound.Mute(Enable: Boolean);
 911 begin
 912   if InvalidSource() then
 913     Exit;
 914    if Enable then
 915    begin
 916      FOldGain := GetVolume();
 917      FMuted := True;
 918      SetVolume(0);
 919    end
 920    else if FMuted then
 921    begin
 922      FMuted := False;
 923      SetVolume(FOldGain);
 924    end;
 925 end;
 926
 927 function TBasicSound.GetPosition(): DWORD;
 928 var
 929   Bytes: ALint;
 930 begin
 931   Result := 0;
 932   if InvalidSource() then
 933     Exit;
 934   alGetSourcei(alSources[FSource], AL_BYTE_OFFSET, Bytes);
 935   FPosition := Bytes;
 936   Result := FPosition;
 937 end;
 938
 939 procedure TBasicSound.SetPosition(aPos: DWORD);
 940 begin
 941   FPosition := aPos;
 942   if InvalidSource() then
 943     Exit;
 944   alSourcei(alSources[FSource], AL_BYTE_OFFSET, aPos);
 945 end;
 946
 947 procedure TBasicSound.SetPriority(priority: Integer);
 948 begin
 949 end;
 950
 951 end.