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 = 100; // 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     e_LogWritefln('sleep time = %d', [StreamBufTime]);
 509     {$ENDIF}
 510     // reset position
 511     e_SoundsArray[ID].Loader.Restart();
 512     if CurStream <> ID then // changing streams
 513     begin
 514       alSourceStop(Src); // this should mark all buffers as processed
 515       alGetSourcei(Src, AL_BUFFERS_PROCESSED, S);
 516       // unqueue all buffers
 517       if S > 0 then
 518       begin
 519         alSourceUnqueueBuffers(Src, S, @alStreamBufs[alStreamAvail]);
 520         alStreamAvail := NUM_STREAM_BUFFERS;
 521       end;
 522     end;
 523     // this shit is playing now
 524     CurStream := ID;
 525     {$IFNDEF OPENAL_SINGLETHREADED}
 526     // unlock the stream
 527     LeaveCriticalSection(StreamLock);
 528     {$ENDIF}
 529   end
 530   else
 531   begin
 532     // this is a full chunk, assign local buffer
 533     alSourcei(Src, AL_BUFFER, e_SoundsArray[ID].alBuffer);
 534     // these can loop
 535     if (e_SoundsArray[ID].Loops) then
 536       alSourcei(Src, AL_LOOPING, AL_TRUE)
 537     else
 538       alSourcei(Src, AL_LOOPING, AL_FALSE);
 539   end;
 540
 541   alSourcei(Src, AL_SOURCE_RELATIVE, AL_TRUE);
 542 end;
 543
 544 function e_PlaySound(ID: DWORD): Integer;
 545 begin
 546   Result := FindSourceForSound(ID);
 547   if Result >= 0 then
 548   begin
 549     AssignSound(ID, alSources[Result]);
 550     alSourcef(alSources[Result], AL_GAIN, 1);
 551     alSourcefv(alSources[Result], AL_POSITION, e_ZeroPosition);
 552     alSourcePlay(alSources[Result]);
 553   end;
 554 end;
 555
 556 function e_PlaySoundPan(ID: DWORD; Pan: Single): Integer;
 557 var
 558   Pos: array [0..2] of ALfloat;
 559 begin
 560   Result := FindSourceForSound(ID);
 561   if Result >= 0 then
 562   begin
 563     Pos[0] := Pan;
 564     Pos[1] := 0;
 565     Pos[2] := 0;
 566     AssignSound(ID, alSources[Result]);
 567     alSourcef(alSources[Result], AL_GAIN, 1);
 568     alSourcefv(alSources[Result], AL_POSITION, Pos);
 569     alSourcePlay(alSources[Result]);
 570   end;
 571 end;
 572
 573 function e_PlaySoundVolume(ID: DWORD; Volume: Single): Integer;
 574 begin
 575   Result := FindSourceForSound(ID);
 576   if Result >= 0 then
 577   begin
 578     AssignSound(ID, alSources[Result]);
 579     alSourcef(alSources[Result], AL_GAIN, Volume);
 580     alSourcefv(alSources[Result], AL_POSITION, e_ZeroPosition);
 581     alSourcePlay(alSources[Result]);
 582   end;
 583 end;
 584
 585 function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Integer;
 586 var
 587   Pos: array [0..2] of ALfloat;
 588 begin
 589   Result := FindSourceForSound(ID);
 590   if Result >= 0 then
 591   begin
 592     Pos[0] := Pan;
 593     Pos[1] := 0;
 594     Pos[2] := 0;
 595     AssignSound(ID, alSources[Result]);
 596     alSourcefv(alSources[Result], AL_POSITION, Pos);
 597     alSourcef(alSources[Result], AL_GAIN, Volume);
 598     alSourcePlay(alSources[Result]);
 599   end;
 600 end;
 601
 602 procedure e_DeleteSound(ID: DWORD);
 603 begin
 604   if ID > High(e_SoundsArray) then
 605     exit;
 606   if (e_SoundsArray[ID].alBuffer <> 0) then
 607   begin
 608     alDeleteBuffers(1, Addr(e_SoundsArray[ID].alBuffer));
 609     e_SoundsArray[ID].alBuffer := 0;
 610   end;
 611   if (e_SoundsArray[ID].Loader <> nil) then
 612   begin
 613     e_SoundsArray[ID].Loader.Free();
 614     e_SoundsArray[ID].Loader := nil;
 615     if ID = CurStream then
 616       CurStream := NO_SOUND_ID;
 617   end;
 618 end;
 619
 620 procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean);
 621 var
 622   S: Integer;
 623   V: ALfloat;
 624 begin
 625   // TODO: replace manual volume calculations everywhere with
 626   //       alListenerf(AL_GAIN) or something
 627   if setMode then
 628   begin
 629     for S := 1 to High(alSources) do
 630       if alSources[S] <> 0 then
 631         alSourcef(alSources[S], AL_GAIN, SoundMod)
 632   end
 633   else
 634   begin
 635     for S := 1 to High(alSources) do
 636       if alSources[S] <> 0 then
 637       begin
 638         alGetSourcef(alSources[S], AL_GAIN, V);
 639         alSourcef(alSources[S], AL_GAIN, V * SoundMod);
 640       end;
 641   end;
 642 end;
 643
 644 procedure e_MuteChannels(Enable: Boolean);
 645 begin
 646   if Enable = SoundMuted then
 647     Exit;
 648
 649   SoundMuted := Enable;
 650 end;
 651
 652 procedure e_StopChannels();
 653 var
 654   S: Integer;
 655 begin
 656   alGetError(); // reset error state
 657   for S := Low(alSources) to High(alSources) do
 658     if (alSources[S] <> 0) and (GetALSourceState(alSources[S]) = AL_PLAYING) then
 659     begin
 660       alSourceStop(alSources[S]);
 661       alDeleteSources(1, @alSources[S]);
 662       alSources[S] := 0;
 663     end;
 664 end;
 665
 666 procedure e_RemoveAllSounds();
 667 var
 668   i: Integer;
 669 begin
 670   for i := 0 to High(e_SoundsArray) do
 671     if e_SoundsArray[i].alBuffer <> 0 then
 672       e_DeleteSound(i);
 673   SetLength(e_SoundsArray, 0);
 674   e_SoundsArray := nil;
 675   CurStream := NO_SOUND_ID;
 676 end;
 677
 678 procedure e_ReleaseSoundSystem();
 679 begin
 680   {$IFNDEF OPENAL_SINGLETHREADED}
 681   if StreamThread <> NilThreadId then
 682   begin
 683     StreamThreadRunning := False;
 684     WaitForThreadTerminate(StreamThread, 66666);
 685     StreamThread := NilThreadId;
 686     DoneCriticalSection(StreamLock);
 687   end;
 688   {$ENDIF}
 689
 690   e_RemoveAllSounds();
 691
 692   alcMakeContextCurrent(nil);
 693   alcDestroyContext(alContext);
 694   alcCloseDevice(alDevice);
 695
 696   alDevice := nil;
 697   alContext := nil;
 698 end;
 699
 700 procedure UpdateStreamSource(Src: Integer);
 701 var
 702   OutLen: LongWord;
 703   Buf: ALuint;
 704   S: Integer;
 705 begin
 706   if alSources[Src] = 0 then Exit;
 707
 708   alGetError(); // reset error state
 709
 710   alGetSourcei(alSources[Src], AL_BUFFERS_PROCESSED, S);
 711   // unqueue processed buffers
 712   if S > 0 then
 713   begin
 714     alSourceUnqueueBuffers(alSources[Src], S, @alStreamBufs[alStreamAvail]);
 715     alStreamAvail := alStreamAvail + S;
 716   end;
 717
 718   alGetError(); // reset error state
 719
 720   if (alStreamAvail > 0) and (CurStream <> NO_SOUND_ID) then
 721   begin
 722     // some buffers have freed up, advance stream playback
 723     OutLen := e_SoundsArray[CurStream].Loader.FillBuffer(@alStreamData[0], STREAM_BUFSIZE);
 724     if OutLen = 0 then Exit; // ran out of stream
 725     Buf := alStreamBufs[alStreamAvail-1];
 726     Dec(alStreamAvail);
 727     // upload
 728     alBufferData(
 729       Buf,
 730       GetALSoundFormat(e_SoundsArray[CurStream].Loader.Format),
 731       @alStreamData[0],
 732       OutLen,
 733       e_SoundsArray[CurStream].Loader.Format.SampleRate
 734     );
 735     // attach
 736     alSourceQueueBuffers(alSources[Src], 1, @Buf);
 737     // restart if needed
 738     S := GetALSourceState(alSources[Src]);
 739     if (S = AL_STOPPED) or (S = AL_INITIAL) then
 740       alSourcePlay(alSources[Src]);
 741   end;
 742 end;
 743
 744 procedure e_SoundUpdate();
 745 var
 746   S: Integer;
 747 begin
 748   alGetError(); // reset error state
 749
 750   // clear out all stopped sources
 751   for S := 1 to High(alSources) do
 752     if (alSources[S] <> 0) and (GetALSourceState(alSources[S]) = AL_STOPPED) then
 753     begin
 754       alDeleteSources(1, @alSources[S]);
 755       alSources[S] := 0;
 756       alOwners[S] := nil;
 757     end;
 758
 759   {$IFDEF OPENAL_SINGLETHREADED}
 760   // update the stream sources
 761   UpdateStreamSource(MUSIC_SOURCE);
 762   {$ENDIF}
 763 end;
 764
 765 { TBasicSound: }
 766
 767 constructor TBasicSound.Create();
 768 begin
 769   FID := NO_SOUND_ID;
 770   FMusic := False;
 771   FSource := -1;
 772   FPosition := 0;
 773   FMuted := False;
 774   FOldGain := 1;
 775 end;
 776
 777 destructor TBasicSound.Destroy();
 778 begin
 779   FreeSound();
 780   inherited;
 781 end;
 782
 783 function TBasicSound.InvalidSource(): Boolean; inline;
 784 begin
 785   Result := (FSource < 0) or (alSources[FSource] = 0) or (alOwners[FSource] <> self);
 786 end;
 787
 788 procedure TBasicSound.FreeSound();
 789 begin
 790   if FID = NO_SOUND_ID then
 791     Exit;
 792
 793   Stop();
 794   FID := NO_SOUND_ID;
 795   FMusic := False;
 796   FPosition := 0;
 797 end;
 798
 799 function TBasicSound.RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean;
 800 begin
 801   Result := False;
 802   if FID = NO_SOUND_ID then Exit;
 803
 804   if e_SoundsArray[FID].nRefs >= gMaxSimSounds then
 805   begin
 806     Result := True;
 807     Exit;
 808   end;
 809
 810   FSource := e_PlaySoundPanVolume(FID, Pan, Volume);
 811   if FSource >= 0 then
 812   begin
 813     alOwners[FSource] := self;
 814     Result := True;
 815   end;
 816 end;
 817
 818 procedure TBasicSound.SetID(ID: DWORD);
 819 begin
 820   FreeSound();
 821
 822   if ID > High(e_SoundsArray) then
 823     exit;
 824
 825   FID := ID;
 826   FMusic := e_SoundsArray[ID].isMusic;
 827 end;
 828
 829 function TBasicSound.IsPlaying(): Boolean;
 830 begin
 831   Result := False;
 832   if InvalidSource() then
 833     Exit;
 834   Result := GetALSourceState(alSources[FSource]) = AL_PLAYING;
 835 end;
 836
 837 procedure TBasicSound.Stop();
 838 begin
 839   if FID = CurStream then
 840     CurStream := NO_SOUND_ID;
 841   if InvalidSource() then
 842     Exit;
 843   GetPosition();
 844   alSourceStop(alSources[FSource]);
 845 end;
 846
 847 function TBasicSound.IsPaused(): Boolean;
 848 begin
 849   Result := False;
 850   if InvalidSource() then
 851     Exit;
 852   Result := GetALSourceState(alSources[FSource]) = AL_PAUSED;
 853 end;
 854
 855 procedure TBasicSound.Pause(Enable: Boolean);
 856 begin
 857   if InvalidSource() then
 858     Exit;
 859   if Enable then
 860     alSourcePause(alSources[FSource])
 861   else
 862     alSourcePlay(alSources[FSource]);
 863 end;
 864
 865 function TBasicSound.GetVolume(): Single;
 866 begin
 867   Result := 0.0;
 868   if InvalidSource() then
 869     Exit;
 870   alGetSourcef(alSources[FSource], AL_GAIN, Result);
 871 end;
 872
 873 procedure TBasicSound.SetVolume(Volume: Single);
 874 begin
 875   if InvalidSource() then
 876     Exit;
 877   alSourcef(alSources[FSource], AL_GAIN, Volume);
 878 end;
 879
 880 function TBasicSound.GetPan(): Single;
 881 var
 882   Pos: array [0..2] of ALfloat = (0, 0, 0);
 883 begin
 884   Result := 0.0;
 885   if InvalidSource() then
 886     Exit;
 887   alGetSourcefv(alSources[FSource], AL_POSITION, Pos);
 888   Result := Pos[0];
 889 end;
 890
 891 procedure TBasicSound.SetPan(Pan: Single);
 892 var
 893   Pos: array [0..2] of ALfloat;
 894 begin
 895   if InvalidSource() then
 896     Exit;
 897   Pos[0] := Pan;
 898   Pos[1] := 0;
 899   Pos[2] := 0;
 900   alSourcefv(alSources[FSource], AL_POSITION, Pos);
 901 end;
 902
 903 function TBasicSound.IsMuted(): Boolean;
 904 begin
 905   if InvalidSource() then
 906     Result := False
 907   else
 908     Result := FMuted;
 909 end;
 910
 911 procedure TBasicSound.Mute(Enable: Boolean);
 912 begin
 913   if InvalidSource() then
 914     Exit;
 915    if Enable then
 916    begin
 917      FOldGain := GetVolume();
 918      FMuted := True;
 919      SetVolume(0);
 920    end
 921    else if FMuted then
 922    begin
 923      FMuted := False;
 924      SetVolume(FOldGain);
 925    end;
 926 end;
 927
 928 function TBasicSound.GetPosition(): DWORD;
 929 var
 930   Bytes: ALint;
 931 begin
 932   Result := 0;
 933   if InvalidSource() then
 934     Exit;
 935   alGetSourcei(alSources[FSource], AL_BYTE_OFFSET, Bytes);
 936   FPosition := Bytes;
 937   Result := FPosition;
 938 end;
 939
 940 procedure TBasicSound.SetPosition(aPos: DWORD);
 941 begin
 942   FPosition := aPos;
 943   if InvalidSource() then
 944     Exit;
 945   alSourcei(alSources[FSource], AL_BYTE_OFFSET, aPos);
 946 end;
 947
 948 procedure TBasicSound.SetPriority(priority: Integer);
 949 begin
 950 end;
 951
 952 end.