src/game/g_sound.pas

   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, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit g_sound;
  18
  19 interface
  20
  21 uses
  22   e_sound;
  23
  24 const
  25   SOUND_MINDIST = 400;
  26   SOUND_MAXDIST = 1000;
  27
  28 type
  29   TPlayableSound = class(TBasicSound)
  30   private
  31     FName: String;
  32
  33   public
  34     constructor Create();
  35     destructor Destroy(); override;
  36     function Play(Force: Boolean = False): Boolean;
  37     function PlayAt(X, Y: Integer): Boolean;
  38     function PlayPanVolume(Pan, Volume: Single; Force: Boolean = False): Boolean;
  39     function PlayVolumeAt(X, Y: Integer; Volume: Single): Boolean;
  40     function PlayVolumeAtRect (X, Y, W, H: Integer; Volume: Single): Boolean;
  41     function SetByName(SN: String): Boolean;
  42     function SetCoords(X, Y: Integer; Volume: Single): Boolean;
  43     function SetCoordsRect (X, Y, W, H: Integer; Volume: Single): Boolean;
  44
  45     property Loop: Boolean read FMusic write FMusic;
  46     property Name: String read FName;
  47   end;
  48
  49   TMusic = class(TBasicSound)
  50   private
  51     FName: String;
  52     FSpecPause: Boolean; // Ñïåö-ïàóçà. "Ñèëüíåå" îáû÷íîé
  53     FNoMusic: Boolean;
  54
  55     procedure SetSpecPause(Enable: Boolean);
  56
  57   public
  58     constructor Create();
  59     destructor Destroy(); override;
  60     function Play(Force: Boolean = False): Boolean;
  61     function SetByName(SN: String): Boolean;
  62     function IsPaused(): Boolean;
  63     procedure Pause(Enable: Boolean);
  64
  65     property Name: String read FName;
  66     property SpecPause: Boolean read FSpecPause write SetSpecPause;
  67     property NoMusic: Boolean read FNoMusic;
  68   end;
  69
  70 function g_Sound_PlayEx(SoundName: ShortString): Boolean;
  71 function g_Sound_PlayExPanVolume(SoundName: ShortString; Pan: Single; Volume: Single): Boolean;
  72 function g_Sound_PlayAt(ID: DWORD; X, Y: Integer): Boolean;
  73 function g_Sound_PlayExAt(SoundName: ShortString; X, Y: Integer): Boolean;
  74
  75 function g_Sound_CreateWAD(var ID: DWORD; Resource: string; isMusic: Boolean = False): Boolean;
  76 function g_Sound_CreateWADEx(SoundName: ShortString; Resource: string; isMusic: Boolean = False; ForceNoLoop: Boolean = False): Boolean;
  77 function g_Sound_CreateFile(var ID: DWORD; FileName: string; isMusic: Boolean = False): Boolean;
  78 function g_Sound_CreateFileEx(SoundName: ShortString; FileName: string; isMusic: Boolean = False; ForceNoLoop: Boolean = False): Boolean;
  79
  80 procedure g_Sound_Delete(SoundName: ShortString);
  81 function g_Sound_Exists(SoundName: string): Boolean;
  82 function g_Sound_Get(var ID: DWORD; SoundName: ShortString): Boolean;
  83
  84 procedure g_Sound_SetupAllVolumes(SoundVol, MusicVol: Byte);
  85
  86 implementation
  87
  88 uses
  89   e_log, SysUtils, g_console, g_options, wadreader,
  90   g_game, g_basic, g_items, g_map, Math,
  91   g_language;
  92
  93 type
  94   TGameSound = record
  95     Name:     ShortString;
  96     ID:       DWORD;
  97     IsMusic:  Boolean;
  98   end;
  99
 100 var
 101   SoundArray: Array of TGameSound;
 102   //SoundsMuted: Boolean = False;
 103
 104
 105 function FindSound(): DWORD;
 106 var
 107   i: integer;
 108 begin
 109   if SoundArray <> nil then
 110     for i := 0 to High(SoundArray) do
 111       if SoundArray[i].Name = '' then
 112       begin
 113         Result := i;
 114         Exit;
 115       end;
 116
 117   if SoundArray = nil then
 118     begin
 119       SetLength(SoundArray, 8);
 120       Result := 0;
 121     end
 122   else
 123     begin
 124       Result := High(SoundArray) + 1;
 125       SetLength(SoundArray, Length(SoundArray) + 8);
 126     end;
 127 end;
 128
 129 function g_Sound_PlayEx(SoundName: ShortString): Boolean;
 130 var
 131   a: DWORD;
 132 begin
 133   Result := False;
 134   if SoundArray = nil then
 135     Exit;
 136
 137   for a := 0 to High(SoundArray) do
 138     if SoundArray[a].Name = SoundName then
 139     begin
 140       Result := (e_PlaySoundVolume(SoundArray[a].ID, gSoundLevel/255.0) >= 0);
 141       Exit;
 142     end;
 143
 144   e_WriteLog(Format(_lc[I_GAME_ERROR_SOUND], [SoundName]), TMsgType.Warning);
 145 end;
 146
 147 function g_Sound_PlayExPanVolume(SoundName: ShortString; Pan: Single; Volume: Single): Boolean;
 148 var
 149   a: DWORD;
 150 begin
 151   Result := False;
 152   if SoundArray = nil then
 153     Exit;
 154
 155   for a := 0 to High(SoundArray) do
 156     if SoundArray[a].Name = SoundName then
 157     begin
 158       Result := (e_PlaySoundPanVolume(SoundArray[a].ID, Pan, Volume * (gSoundLevel/255.0)) >= 0);
 159       Exit;
 160     end;
 161
 162   e_WriteLog(Format(_lc[I_GAME_ERROR_SOUND], [SoundName]), TMsgType.Warning);
 163 end;
 164
 165 function PlaySoundAtRect (X, Y, W, H: Integer; out Pan, Volume: Single; InVolume: Single = 1.0): Boolean;
 166   var
 167     len1, len2: Integer;
 168     pan1, pan2: Single;
 169     sMaxDist: Single;
 170
 171   procedure CalcDest (const p: THearPoint; out pan: Single; out len: Integer);
 172     var XX, YY, lx, rx: Integer;
 173   begin
 174     pan := 0.0; len := gMaxDist;
 175     if p.Active then
 176     begin
 177       XX := Max(X, Min(X + W, p.Coords.X));
 178       YY := Max(Y, Min(Y + H, p.Coords.Y));
 179       len := Round(Hypot(XX - p.Coords.X, YY - p.Coords.Y));
 180       if sMaxDist < SOUND_MINDIST then
 181       begin
 182         lx := X - SOUND_MINDIST;
 183         rx := X + W + SOUND_MINDIST;
 184         if p.Coords.X < lx then
 185           pan := (lx - p.Coords.X) / sMaxDist
 186         else if p.Coords.X > rx then
 187           pan := (rx - p.Coords.X) / sMaxDist
 188       end
 189     end
 190   end;
 191
 192 begin
 193   ASSERT((W >= 0) and (H >= 0));
 194   ASSERT((InVolume >= 0.0) and (InVolume <= 1.0));
 195   sMaxDist := SOUND_MAXDIST * InVolume;
 196   X := Max(0, Min(X, gMapInfo.Width));
 197   Y := Max(0, Min(Y, gMapInfo.Height));
 198   CalcDest(gHearPoint1, pan1, len1);
 199   CalcDest(gHearPoint2, pan2, len2);
 200   if len2 < len1 then
 201   begin
 202     len1 := len2;
 203     pan1 := pan2;
 204   end;
 205   if len1 >= sMaxDist then
 206   begin
 207     Pan := 0.0;
 208     Volume := 0.0;
 209     Result := False
 210   end
 211   else
 212   begin
 213     Pan := pan1;
 214     Volume := 1.0 - len1 / sMaxDist;
 215     Result := True
 216   end
 217 end;
 218
 219 function PlaySoundAt(X, Y: Integer; out Pan: Single; out Volume: Single; InVolume: Single = 1.0): Boolean;
 220 begin
 221   Result := PlaySoundAtRect(X, Y, 0, 0, Pan, Volume, InVolume)
 222 end;
 223
 224 function g_Sound_PlayAt(ID: DWORD; X, Y: Integer): Boolean;
 225 var
 226   Pan, Vol: Single;
 227 begin
 228   if PlaySoundAt(X, Y, Pan, Vol) then
 229     Result := (e_PlaySoundPanVolume(ID, Pan, Vol * (gSoundLevel/255.0)) >= 0)
 230   else
 231     Result := False;
 232 end;
 233
 234 function g_Sound_PlayExAt(SoundName: ShortString; X, Y: Integer): Boolean;
 235 var
 236   a: DWORD;
 237   Pan, Vol: Single;
 238 begin
 239   Result := False;
 240
 241   if SoundArray = nil then
 242     Exit;
 243
 244   for a := 0 to High(SoundArray) do
 245     if SoundArray[a].Name = SoundName then
 246     begin
 247       if PlaySoundAt(X, Y, Pan, Vol) then
 248         Result := (e_PlaySoundPanVolume(SoundArray[a].ID, Pan, Vol * (gSoundLevel/255.0)) >= 0);
 249       Exit;
 250     end;
 251
 252   e_WriteLog(Format(_lc[I_GAME_ERROR_SOUND], [SoundName]), TMsgType.Warning);
 253 end;
 254
 255 function g_Sound_CreateFile(var ID: DWORD; FileName: string; isMusic: Boolean = False): Boolean;
 256 begin
 257   Result := e_LoadSound(FileName, ID, isMusic);
 258 end;
 259
 260 function g_Sound_CreateFileEx(SoundName: ShortString; FileName: string; isMusic: Boolean = False; ForceNoLoop: Boolean = False): Boolean;
 261 var
 262   find_id: DWORD;
 263 begin
 264   Result := False;
 265
 266   find_id := FindSound();
 267
 268   if not e_LoadSound(FileName, SoundArray[find_id].ID, isMusic, ForceNoLoop) then
 269     Exit;
 270
 271   SoundArray[find_id].Name := SoundName;
 272   SoundArray[find_id].IsMusic := isMusic;
 273
 274   Result := True;
 275 end;
 276
 277 function g_Sound_CreateWAD(var ID: DWORD; Resource: string; isMusic: Boolean = False): Boolean;
 278 var
 279   WAD: TWADFile;
 280   FileName: string;
 281   SoundData: Pointer;
 282   ResLength: Integer;
 283   ok: Boolean;
 284 begin
 285   Result := False;
 286   ok := False;
 287
 288   // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
 289   FileName := g_ExtractWadName(Resource);
 290
 291   WAD := TWADFile.Create();
 292   WAD.ReadFile(FileName);
 293
 294   if WAD.GetResource(g_ExtractFilePathName(Resource), SoundData, ResLength) then
 295     begin
 296       if e_LoadSoundMem(SoundData, ResLength, ID, isMusic) then
 297         ok := True
 298       else
 299         FreeMem(SoundData);
 300     end
 301   else
 302   begin
 303     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 304   end;
 305
 306   WAD.Free();
 307   if (not ok) then
 308   begin
 309 {$IFNDEF HEADLESS}
 310     if isMusic then
 311       e_WriteLog(Format('Error loading music %s', [Resource]), TMsgType.Warning)
 312     else
 313       e_WriteLog(Format('Error loading sound %s', [Resource]), TMsgType.Warning);
 314     Exit;
 315 {$ENDIF}
 316   end;
 317   Result := True;
 318 end;
 319
 320 function g_Sound_CreateWADEx(SoundName: ShortString; Resource: string; isMusic: Boolean = False; ForceNoLoop: Boolean = False): Boolean;
 321 var
 322   WAD: TWADFile;
 323   FileName: string;
 324   SoundData: Pointer;
 325   ResLength: Integer;
 326   find_id: DWORD;
 327   ok: Boolean;
 328 begin
 329   Result := False;
 330   ok := False;
 331
 332   // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
 333   FileName := g_ExtractWadName(Resource);
 334
 335   find_id := FindSound();
 336
 337   WAD := TWADFile.Create();
 338   WAD.ReadFile(FileName);
 339
 340   if WAD.GetResource(g_ExtractFilePathName(Resource), SoundData, ResLength) then
 341     begin
 342       if e_LoadSoundMem(SoundData, ResLength, SoundArray[find_id].ID, isMusic, ForceNoLoop) then
 343         begin
 344           SoundArray[find_id].Name := SoundName;
 345           SoundArray[find_id].IsMusic := isMusic;
 346           ok := True;
 347         end
 348       else
 349         FreeMem(SoundData);
 350     end
 351   else
 352   begin
 353     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 354   end;
 355
 356   WAD.Free();
 357   if (not ok) then
 358   begin
 359 {$IFNDEF HEADLESS}
 360     if isMusic then
 361       e_WriteLog(Format('Error loading music %s', [Resource]), TMsgType.Warning)
 362     else
 363       e_WriteLog(Format('Error loading sound %s', [Resource]), TMsgType.Warning);
 364     Exit;
 365 {$ENDIF}
 366   end;
 367   Result := True;
 368 end;
 369
 370 procedure g_Sound_Delete(SoundName: ShortString);
 371 var
 372   a: DWORD;
 373 begin
 374   if (SoundArray = nil) or (SoundName = '') then
 375     Exit;
 376
 377   for a := 0 to High(SoundArray) do
 378     if SoundArray[a].Name = SoundName then
 379     begin
 380       e_DeleteSound(SoundArray[a].ID);
 381       SoundArray[a].Name := '';
 382       SoundArray[a].ID := 0;
 383       SoundArray[a].IsMusic := False;
 384     end;
 385 end;
 386
 387 function g_Sound_Exists(SoundName: string): Boolean;
 388 var
 389   a: DWORD;
 390 begin
 391   Result := False;
 392
 393   if SoundName = '' then
 394     Exit;
 395
 396   if SoundArray <> nil then
 397     for a := 0 to High(SoundArray) do
 398       if SoundArray[a].Name = SoundName then
 399       begin
 400         Result := True;
 401         Break;
 402       end;
 403 end;
 404
 405 function g_Sound_Get(var ID: DWORD; SoundName: ShortString): Boolean;
 406 var
 407   a: DWORD;
 408 begin
 409   Result := False;
 410
 411   if SoundName = '' then
 412     Exit;
 413
 414   if SoundArray <> nil then
 415     for a := 0 to High(SoundArray) do
 416       if SoundArray[a].Name = SoundName then
 417       begin
 418         ID := SoundArray[a].ID;
 419         Result := True;
 420         Break;
 421       end;
 422 end;
 423
 424 procedure g_Sound_SetupAllVolumes(SoundVol, MusicVol: Byte);
 425 var
 426   Svol, Mvol: Single;
 427   sm: Boolean;
 428 begin
 429   Mvol := 0; // shut up, compiler
 430   if (gSoundLevel = SoundVol) and (gMusicLevel = MusicVol) then
 431     Exit;
 432
 433   if gSoundLevel > 0 then
 434     begin
 435       Svol := SoundVol / gSoundLevel;
 436       sm := False;
 437     end
 438   else
 439     begin
 440       Svol := SoundVol / 255.0;
 441       sm := True;
 442     end;
 443
 444   if gMusic <> nil then
 445     if gMusicLevel > 0 then
 446       Mvol := gMusic.GetVolume() * MusicVol / gMusicLevel
 447     else
 448       Mvol := MusicVol / 255.0;
 449
 450   e_ModifyChannelsVolumes(Svol, sm);
 451
 452   if gMusic <> nil then
 453     gMusic.SetVolume(Mvol);
 454
 455   gSoundLevel := SoundVol;
 456   gMusicLevel := MusicVol;
 457 end;
 458
 459 { TPlayableSound: }
 460
 461 constructor TPlayableSound.Create();
 462 begin
 463   inherited;
 464   FName := '';
 465 end;
 466
 467 destructor TPlayableSound.Destroy();
 468 begin
 469   inherited;
 470 end;
 471
 472 function TPlayableSound.Play(Force: Boolean = False): Boolean;
 473 begin
 474   if Force or not IsPlaying() then
 475     begin
 476       Stop();
 477       Result := RawPlay(0.0, gSoundLevel/255.0, FPosition);
 478     end
 479   else
 480     Result := False;
 481 end;
 482
 483 function TPlayableSound.PlayAt(X, Y: Integer): Boolean;
 484 var
 485   Pan, Vol: Single;
 486 begin
 487   if PlaySoundAt(X, Y, Pan, Vol) then
 488     begin
 489       Stop();
 490       Result := RawPlay(Pan, Vol * (gSoundLevel/255.0), FPosition);
 491     end
 492   else
 493     Result := False;
 494 end;
 495
 496 function TPlayableSound.PlayPanVolume(Pan, Volume: Single; Force: Boolean = False): Boolean;
 497 begin
 498   if Force or not IsPlaying() then
 499     begin
 500       Stop();
 501       Result := RawPlay(Pan, Volume * (gSoundLevel/255.0), FPosition);
 502     end
 503   else
 504     Result := False;
 505 end;
 506
 507 function TPlayableSound.PlayVolumeAtRect (X, Y, W, H: Integer; Volume: Single): Boolean;
 508   var Pan, Vol: Single;
 509 begin
 510   Result := False;
 511   if PlaySoundAtRect(X, Y, W, H, Pan, Vol, Volume) then
 512   begin
 513     Stop;
 514     Result := RawPlay(Pan, Volume * Vol * (gSoundLevel / 255.0), FPosition)
 515   end
 516 end;
 517
 518 function TPlayableSound.PlayVolumeAt (X, Y: Integer; Volume: Single): Boolean;
 519 begin
 520   Result := Self.PlayVolumeAtRect(X, Y, 0, 0, Volume)
 521 end;
 522
 523 function TPlayableSound.SetCoordsRect (X, Y, W, H: Integer; Volume: Single): Boolean;
 524   var Pan, Vol: Single;
 525 begin
 526   if PlaySoundAtRect(X, Y, W, H, Pan, Vol, Volume) then
 527   begin
 528     SetVolume(Volume * Vol * (gSoundLevel / 255.0));
 529     SetPan(Pan);
 530     Result := True
 531   end
 532   else
 533   begin
 534     SetVolume(0.0);
 535     SetPan(0.0);
 536     Result := False
 537   end;
 538 end;
 539
 540 function TPlayableSound.SetCoords(X, Y: Integer; Volume: Single): Boolean;
 541 begin
 542   Result := Self.SetCoordsRect(X, Y, 0, 0, Volume)
 543 end;
 544
 545 function TPlayableSound.SetByName(SN: String): Boolean;
 546 var
 547   id: DWORD;
 548 begin
 549   if g_Sound_Get(id, SN) then
 550     begin
 551       SetID(id);
 552       FName := SN;
 553       Result := True;
 554     end
 555   else
 556     Result := False;
 557 end;
 558
 559 { TMusic: }
 560
 561 constructor TMusic.Create();
 562 begin
 563   inherited;
 564   FName := '';
 565   FSpecPause := False;
 566   FNoMusic := True;
 567 end;
 568
 569 destructor TMusic.Destroy();
 570 begin
 571   inherited;
 572 end;
 573
 574 function TMusic.Play(Force: Boolean = False): Boolean;
 575 begin
 576   if FNoMusic then
 577   begin
 578     Result := True;
 579     Exit;
 580   end;
 581
 582   if Force or not IsPlaying() then
 583     begin
 584       Stop();
 585       Result := RawPlay(0.0, gMusicLevel/255.0, FPosition);
 586       if Result then
 587         SetPriority(0);
 588       if Result and FSpecPause then
 589         Pause(True);
 590     end
 591   else
 592     Result := False;
 593 end;
 594
 595 function TMusic.SetByName(SN: String): Boolean;
 596 var
 597   id: DWORD;
 598 begin
 599   if SN = '' then
 600   begin
 601     FNoMusic := True;
 602     Result := True;
 603     Exit;
 604   end;
 605
 606   if g_Sound_Get(id, SN) then
 607     begin
 608       SetID(id);
 609       FName := SN;
 610       FNoMusic := False;
 611       FSpecPause := False;
 612       Result := True;
 613     end
 614   else
 615     Result := False;
 616 end;
 617
 618 function TMusic.IsPaused(): Boolean;
 619 begin
 620   Result := inherited IsPaused();
 621   Result := Result or FSpecPause;
 622 end;
 623
 624 procedure TMusic.Pause(Enable: Boolean);
 625 begin
 626 // Îòêëþ÷àåì ïàóçó, òîëüêî åñëè íå áûëî ñïåö-ïàóçû:
 627   if Enable or (not FSpecPause) then
 628     inherited Pause(Enable);
 629 end;
 630
 631 procedure TMusic.SetSpecPause(Enable: Boolean);
 632 begin
 633   FSpecPause := Enable;
 634   Pause(Enable);
 635 end;
 636
 637 end.