src/engine/e_sound.pas

   1 unit e_sound;
   2
   3 interface
   4
   5 uses
   6   sdl2 in '../lib/sdl2/sdl2.pas',
   7   SDL2_mixer in '../lib/sdl2/SDL2_mixer.pas',
   8   e_log,
   9   SysUtils;
  10
  11 type
  12   TSoundRec = record
  13     Data: Pointer;
  14     Sound: PMix_Chunk;
  15     Loop: Boolean;
  16   end;
  17
  18   TBasicSound = class (TObject)
  19   private
  20     FChannel: Integer; // <0: no channel allocated
  21
  22   protected
  23     FID: DWORD;
  24     FLoop: Boolean;
  25     FPosition: DWORD;
  26     FPriority: Integer;
  27
  28     function RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean;
  29
  30   public
  31     constructor Create();
  32     destructor Destroy(); override;
  33     procedure SetID(ID: DWORD);
  34     procedure FreeSound();
  35     function IsPlaying(): Boolean;
  36     procedure Stop();
  37     function IsPaused(): Boolean;
  38     procedure Pause(Enable: Boolean);
  39     function GetVolume(): Single;
  40     procedure SetVolume(Volume: Single);
  41     function GetPan(): Single;
  42     procedure SetPan(Pan: Single);
  43     function IsMuted(): Boolean;
  44     procedure Mute(Enable: Boolean);
  45     function GetPosition(): DWORD;
  46     procedure SetPosition(aPos: DWORD);
  47     procedure SetPriority(priority: Integer);
  48   end;
  49
  50 const
  51   NO_SOUND_ID = DWORD(-1);
  52
  53 function e_InitSoundSystem(): Boolean;
  54
  55 function e_LoadSound(FileName: string; var ID: DWORD; bLoop: Boolean): Boolean;
  56 function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean;
  57
  58 // returns channel number or -1
  59 function e_PlaySound(ID: DWORD): Integer;
  60 function e_PlaySoundPan(ID: DWORD; Pan: Single): Integer;
  61 function e_PlaySoundVolume(ID: DWORD; Volume: Single): Integer;
  62 function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Integer;
  63
  64 procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean);
  65 procedure e_MuteChannels(Enable: Boolean);
  66 procedure e_StopChannels();
  67
  68 procedure e_DeleteSound(ID: DWORD);
  69 procedure e_RemoveAllSounds();
  70 procedure e_ReleaseSoundSystem();
  71 procedure e_SoundUpdate();
  72
  73 var
  74   e_SoundsArray: array of TSoundRec = nil;
  75
  76 implementation
  77
  78 uses
  79   g_window, g_options, BinEditor;
  80
  81 const
  82   N_CHANNELS = 512;
  83
  84 var
  85   SoundMuted: Boolean = False;
  86   SoundInitialized: Boolean = False;
  87
  88
  89 function e_InitSoundSystem(): Boolean;
  90 var
  91   res: Integer;
  92 begin
  93   if SoundInitialized then begin Result := true; Exit end;
  94
  95   Result := False;
  96   SoundInitialized := False;
  97
  98   // we need module player
  99   if (Mix_Init(MIX_INIT_MOD) and MIX_INIT_MOD) <> MIX_INIT_MOD then
 100   begin
 101     e_WriteLog('Error initializing SDL module player:', MSG_FATALERROR);
 102     e_WriteLog(Mix_GetError(), MSG_FATALERROR);
 103     //Exit;
 104   end;
 105
 106   res := Mix_OpenAudio(44100, AUDIO_S16LSB, 2, 512);
 107   if res = -1 then
 108   begin
 109     e_WriteLog('Error initializing SDL mixer:', MSG_FATALERROR);
 110     e_WriteLog(Mix_GetError(), MSG_FATALERROR);
 111     Exit;
 112   end;
 113
 114   Mix_AllocateChannels(N_CHANNELS);
 115
 116   SoundInitialized := True;
 117   Result := True;
 118 end;
 119
 120 function FindESound(): DWORD;
 121 var
 122   i: Integer;
 123
 124 begin
 125   if e_SoundsArray <> nil then
 126     for i := 0 to High(e_SoundsArray) do
 127       if e_SoundsArray[i].Sound = nil then
 128       begin
 129         Result := i;
 130         Exit;
 131       end;
 132
 133   if e_SoundsArray = nil then
 134     begin
 135       SetLength(e_SoundsArray, 16);
 136       Result := 0;
 137     end
 138   else
 139     begin
 140       Result := High(e_SoundsArray) + 1;
 141       SetLength(e_SoundsArray, Length(e_SoundsArray) + 16);
 142     end;
 143 end;
 144
 145 function e_LoadSound(FileName: String; var ID: DWORD; bLoop: Boolean): Boolean;
 146 var
 147   find_id: DWORD;
 148 begin
 149   Result := False;
 150   if not SoundInitialized then Exit;
 151
 152   e_WriteLog('Loading sound '+FileName+'...', MSG_NOTIFY);
 153
 154   find_id := FindESound();
 155
 156   e_SoundsArray[find_id].Sound := Mix_LoadWAV(PAnsiChar(FileName));
 157   if e_SoundsArray[find_id].Sound = nil then Exit;
 158
 159   e_SoundsArray[find_id].Data := nil;
 160   e_SoundsArray[find_id].Loop := bLoop;
 161
 162   ID := find_id;
 163
 164   Result := True;
 165 end;
 166
 167 function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean;
 168 var
 169   find_id: DWORD;
 170   rw: PSDL_RWops;
 171 begin
 172   Result := False;
 173   if not SoundInitialized then Exit;
 174
 175   rw := SDL_RWFromConstMem(pData, Length);
 176   if rw = nil then Exit;
 177
 178   find_id := FindESound();
 179
 180   e_SoundsArray[find_id].Sound := Mix_LoadWAV_RW(rw, 0);
 181   SDL_FreeRW(rw);
 182   if e_SoundsArray[find_id].Sound = nil then Exit;
 183
 184   e_SoundsArray[find_id].Data := pData;
 185   e_SoundsArray[find_id].Loop := bLoop;
 186
 187   ID := find_id;
 188
 189   Result := True;
 190 end;
 191
 192 function e_PlaySound (ID: DWORD): Integer;
 193 var
 194   res: Integer;
 195 begin
 196   Result := -1;
 197   if not SoundInitialized then Exit;
 198
 199   if {(e_SoundsArray[ID].nRefs >= gMaxSimSounds) or} (e_SoundsArray[ID].Sound = nil) then Exit;
 200
 201   if e_SoundsArray[ID].Loop then
 202     res := Mix_PlayChannel(-1, e_SoundsArray[ID].Sound, -1)
 203   else
 204     res := Mix_PlayChannel(-1, e_SoundsArray[ID].Sound, 0);
 205
 206   if SoundMuted and (res >= 0) then Mix_Volume(res, 0);
 207
 208   Result := res;
 209 end;
 210
 211 function e_PlaySoundPan(ID: DWORD; Pan: Single): Integer;
 212 var
 213   chan: Integer;
 214   l, r: UInt8;
 215 begin
 216   Result := -1;
 217   chan := e_PlaySound(ID);
 218   if chan < 0 then Exit;
 219
 220   if not SoundMuted then
 221   if Pan < -1.0 then Pan := -1.0 else if Pan > 1.0 then Pan := 1.0;
 222   Pan := Pan+1.0; // 0..2
 223   l := trunc(127.0*(2.0-Pan));
 224   r := trunc(127.0*Pan);
 225   Mix_SetPanning(chan, l, r);
 226
 227   Result := chan;
 228 end;
 229
 230 function e_PlaySoundVolume(ID: DWORD; Volume: Single): Integer;
 231 var
 232   chan: Integer;
 233 begin
 234   Result := -1;
 235   chan := e_PlaySound(ID);
 236   if chan < 0 then Exit;
 237
 238   if Volume < 0 then Volume := 0 else if Volume > 1 then Volume := 1;
 239   if not SoundMuted then Mix_Volume(chan, trunc(Volume*MIX_MAX_VOLUME));
 240
 241   Result := chan;
 242 end;
 243
 244 function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Integer;
 245 var
 246   chan: Integer;
 247   l, r: UInt8;
 248 begin
 249   Result := -1;
 250   chan := e_PlaySound(ID);
 251   if chan < 0 then Exit;
 252
 253   if Pan < -1.0 then Pan := -1.0 else if Pan > 1.0 then Pan := 1.0;
 254   Pan := Pan+1.0; // 0..2
 255   l := trunc(127.0*(2.0-Pan));
 256   r := trunc(127.0*Pan);
 257   Mix_SetPanning(chan, l, r);
 258
 259   if Volume < 0 then Volume := 0 else if Volume > 1 then Volume := 1;
 260   if not SoundMuted then Mix_Volume(chan, trunc(Volume*MIX_MAX_VOLUME));
 261
 262   Result := chan;
 263 end;
 264
 265 procedure e_DeleteSound(ID: DWORD);
 266 begin
 267   if e_SoundsArray[ID].Sound = nil then Exit;
 268   if e_SoundsArray[ID].Data <> nil then FreeMem(e_SoundsArray[ID].Data);
 269
 270   Mix_FreeChunk(e_SoundsArray[ID].Sound);
 271
 272   e_SoundsArray[ID].Sound := nil;
 273   e_SoundsArray[ID].Data := nil;
 274 end;
 275
 276 //TODO
 277 procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean);
 278 {
 279 var
 280   i: Integer;
 281   Chan: FMOD_CHANNEL;
 282   vol: Single;
 283 }
 284 begin
 285   // Mix_Volume(-1, volm);
 286 {
 287   for i := 0 to N_CHANNELS-1 do
 288   begin
 289     Chan := nil;
 290     res := FMOD_System_GetChannel(F_System, i, Chan);
 291
 292     if (res = FMOD_OK) and (Chan <> nil) then
 293     begin
 294       res := FMOD_Channel_GetVolume(Chan, vol);
 295
 296       if res = FMOD_OK then
 297       begin
 298         if setMode then
 299           vol := SoundMod
 300         else
 301           vol := vol * SoundMod;
 302
 303         res := FMOD_Channel_SetVolume(Chan, vol);
 304
 305         if res <> FMOD_OK then
 306         begin
 307         end;
 308       end;
 309     end;
 310   end;
 311 }
 312 end;
 313
 314 //TODO
 315 procedure e_MuteChannels(Enable: Boolean);
 316 {
 317 var
 318   res: FMOD_RESULT;
 319   i: Integer;
 320   Chan: FMOD_CHANNEL;
 321 }
 322 begin
 323 {
 324   if Enable = SoundMuted then
 325     Exit;
 326
 327   SoundMuted := Enable;
 328
 329   for i := 0 to N_CHANNELS-1 do
 330   begin
 331     Chan := nil;
 332     res := FMOD_System_GetChannel(F_System, i, Chan);
 333
 334     if (res = FMOD_OK) and (Chan <> nil) then
 335     begin
 336       res := FMOD_Channel_SetMute(Chan, Enable);
 337
 338       if res <> FMOD_OK then
 339       begin
 340       end;
 341     end;
 342   end;
 343 }
 344 end;
 345
 346 procedure e_StopChannels();
 347 begin
 348   Mix_HaltChannel(-1);
 349 end;
 350
 351 procedure e_RemoveAllSounds();
 352 var
 353   i: Integer;
 354 begin
 355   if SoundInitialized then e_StopChannels();
 356
 357   for i := 0 to High(e_SoundsArray) do
 358     if e_SoundsArray[i].Sound <> nil then
 359       e_DeleteSound(i);
 360
 361   SetLength(e_SoundsArray, 0);
 362   e_SoundsArray := nil;
 363 end;
 364
 365 procedure e_ReleaseSoundSystem();
 366 begin
 367   e_RemoveAllSounds();
 368
 369   if SoundInitialized then
 370   begin
 371     Mix_CloseAudio();
 372     SoundInitialized := False;
 373   end;
 374 end;
 375
 376 procedure e_SoundUpdate();
 377 begin
 378   //FMOD_System_Update(F_System);
 379 end;
 380
 381 { TBasicSound: }
 382
 383 constructor TBasicSound.Create();
 384 begin
 385   FID := NO_SOUND_ID;
 386   FLoop := False;
 387   FChannel := -1;
 388   FPosition := 0;
 389   FPriority := 128;
 390 end;
 391
 392 destructor TBasicSound.Destroy();
 393 begin
 394   FreeSound();
 395   inherited;
 396 end;
 397
 398 procedure TBasicSound.FreeSound();
 399 begin
 400   if FID = NO_SOUND_ID then Exit;
 401   Stop();
 402   FID := NO_SOUND_ID;
 403   FLoop := False;
 404   FPosition := 0;
 405 end;
 406
 407 // aPos: msecs
 408 function TBasicSound.RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean;
 409 var
 410   oldloop: Boolean;
 411 begin
 412   Result := False;
 413   if (FID = NO_SOUND_ID) or not SoundInitialized then Exit;
 414   oldloop := e_SoundsArray[FID].Loop;
 415   e_SoundsArray[FID].Loop := FLoop;
 416   Result := (e_PlaySoundPanVolume(FID, Pan, Volume) >= 0);
 417   e_SoundsArray[FID].Loop := oldloop;
 418   //TODO: aPos
 419 end;
 420
 421 procedure TBasicSound.SetID(ID: DWORD);
 422 begin
 423   FreeSound();
 424   FID := ID;
 425   FLoop := e_SoundsArray[ID].Loop;
 426 end;
 427
 428 function TBasicSound.IsPlaying(): Boolean;
 429 begin
 430   Result := False;
 431   if FChannel < 0 then Exit;
 432   Result := (Mix_Playing(FChannel) > 0);
 433 end;
 434
 435 procedure TBasicSound.Stop();
 436
 437 begin
 438   if FChannel < 0 then Exit;
 439   //GetPosition();
 440   Mix_HaltChannel(FChannel);
 441   FChannel := -1;
 442 end;
 443
 444 function TBasicSound.IsPaused(): Boolean;
 445 begin
 446   Result := False;
 447   if FChannel < 0 then Exit;
 448   Result := (Mix_Paused(FChannel) > 0);
 449 end;
 450
 451 procedure TBasicSound.Pause(Enable: Boolean);
 452 begin
 453   if FChannel < 0 then Exit;
 454   if Mix_Paused(FChannel) > 0 then
 455   begin
 456     if Enable then Mix_Resume(FChannel);
 457   end
 458   else
 459   begin
 460     if not Enable then Mix_Pause(FChannel);
 461   end;
 462   {
 463   if Enable then
 464   begin
 465     res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS);
 466     if res <> FMOD_OK then
 467     begin
 468     end;
 469   end;
 470   }
 471 end;
 472
 473 //TODO
 474 function TBasicSound.GetVolume(): Single;
 475 begin
 476   Result := 0.0;
 477   if FChannel < 0 then Exit;
 478 {
 479   res := FMOD_Channel_GetVolume(FChannel, vol);
 480   if res <> FMOD_OK then
 481   begin
 482     Exit;
 483   end;
 484   Result := vol;
 485 }
 486 end;
 487
 488 procedure TBasicSound.SetVolume(Volume: Single);
 489 begin
 490   if FChannel < 0 then Exit;
 491
 492   if Volume < 0 then Volume := 0 else if Volume > 1 then Volume := 1;
 493   Mix_Volume(FChannel, trunc(Volume*MIX_MAX_VOLUME));
 494 end;
 495
 496 //TODO
 497 function TBasicSound.GetPan(): Single;
 498 begin
 499   Result := 0.0;
 500   if FChannel < 0 then Exit;
 501 {
 502   res := FMOD_Channel_GetPan(FChannel, pan);
 503   if res <> FMOD_OK then
 504   begin
 505     Exit;
 506   end;
 507   Result := pan;
 508 }
 509 end;
 510
 511 procedure TBasicSound.SetPan(Pan: Single);
 512 var
 513   l, r: UInt8;
 514 begin
 515   if FChannel < 0 then Exit;
 516
 517   if Pan < -1.0 then Pan := -1.0 else if Pan > 1.0 then Pan := 1.0;
 518   Pan := Pan+1.0; // 0..2
 519   l := trunc(127.0*(2.0-Pan));
 520   r := trunc(127.0*Pan);
 521   Mix_SetPanning(FChannel, l, r);
 522 end;
 523
 524 //TODO
 525 function TBasicSound.IsMuted(): Boolean;
 526 begin
 527   Result := False;
 528   if FChannel < 0 then Exit;
 529 {
 530   res := FMOD_Channel_GetMute(FChannel, b);
 531   if res <> FMOD_OK then
 532   begin
 533     Exit;
 534   end;
 535   Result := b;
 536 }
 537 end;
 538
 539 //TODO
 540 procedure TBasicSound.Mute(Enable: Boolean);
 541 begin
 542   if FChannel < 0 then Exit;
 543 {
 544   res := FMOD_Channel_SetMute(FChannel, Enable);
 545   if res <> FMOD_OK then
 546   begin
 547   end;
 548 }
 549 end;
 550
 551 //TODO
 552 function TBasicSound.GetPosition(): DWORD;
 553 begin
 554   Result := 0;
 555   if FChannel < 0 then Exit;
 556 {
 557   res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS);
 558   if res <> FMOD_OK then
 559   begin
 560     Exit;
 561   end;
 562   Result := FPosition;
 563 }
 564 end;
 565
 566 //TODO
 567 procedure TBasicSound.SetPosition(aPos: DWORD);
 568 begin
 569   FPosition := aPos;
 570   if FChannel < 0 then Exit;
 571 {
 572   res := FMOD_Channel_SetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS);
 573   if res <> FMOD_OK then
 574   begin
 575   end;
 576 }
 577 end;
 578
 579 //TODO
 580 procedure TBasicSound.SetPriority(priority: Integer);
 581 begin
 582 {
 583   if (FChannel <> nil) and (FPriority <> priority) and
 584      (priority >= 0) and (priority <= 256) then
 585   begin
 586     FPriority := priority;
 587     res := FMOD_Channel_SetPriority(FChannel, priority);
 588     if res <> FMOD_OK then
 589     begin
 590     end;
 591   end;
 592 }
 593 end;
 594
 595 end.