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   e_LogWritefln('PlaySounAtRect: Pan = %s | Volume = %s | Result = %s', [Pan, Volume, Result]);
 218 end;
 219
 220 function PlaySoundAt(X, Y: Integer; out Pan: Single; out Volume: Single; InVolume: Single = 1.0): Boolean;
 221 begin
 222   Result := PlaySoundAtRect(X, Y, 0, 0, Pan, Volume, InVolume)
 223 end;
 224
 225 function g_Sound_PlayAt(ID: DWORD; X, Y: Integer): Boolean;
 226 var
 227   Pan, Vol: Single;
 228 begin
 229   if PlaySoundAt(X, Y, Pan, Vol) then
 230     Result := (e_PlaySoundPanVolume(ID, Pan, Vol * (gSoundLevel/255.0)) >= 0)
 231   else
 232     Result := False;
 233 end;
 234
 235 function g_Sound_PlayExAt(SoundName: ShortString; X, Y: Integer): Boolean;
 236 var
 237   a: DWORD;
 238   Pan, Vol: Single;
 239 begin
 240   Result := False;
 241
 242   if SoundArray = nil then
 243     Exit;
 244
 245   for a := 0 to High(SoundArray) do
 246     if SoundArray[a].Name = SoundName then
 247     begin
 248       if PlaySoundAt(X, Y, Pan, Vol) then
 249         Result := (e_PlaySoundPanVolume(SoundArray[a].ID, Pan, Vol * (gSoundLevel/255.0)) >= 0);
 250       Exit;
 251     end;
 252
 253   e_WriteLog(Format(_lc[I_GAME_ERROR_SOUND], [SoundName]), TMsgType.Warning);
 254 end;
 255
 256 function g_Sound_CreateFile(var ID: DWORD; FileName: string; isMusic: Boolean = False): Boolean;
 257 begin
 258   Result := e_LoadSound(FileName, ID, isMusic);
 259 end;
 260
 261 function g_Sound_CreateFileEx(SoundName: ShortString; FileName: string; isMusic: Boolean = False; ForceNoLoop: Boolean = False): Boolean;
 262 var
 263   find_id: DWORD;
 264 begin
 265   Result := False;
 266
 267   find_id := FindSound();
 268
 269   if not e_LoadSound(FileName, SoundArray[find_id].ID, isMusic, ForceNoLoop) then
 270     Exit;
 271
 272   SoundArray[find_id].Name := SoundName;
 273   SoundArray[find_id].IsMusic := isMusic;
 274
 275   Result := True;
 276 end;
 277
 278 function g_Sound_CreateWAD(var ID: DWORD; Resource: string; isMusic: Boolean = False): Boolean;
 279 var
 280   WAD: TWADFile;
 281   FileName: string;
 282   SoundData: Pointer;
 283   ResLength: Integer;
 284   ok: Boolean;
 285 begin
 286   Result := False;
 287   ok := False;
 288
 289   // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
 290   FileName := g_ExtractWadName(Resource);
 291
 292   WAD := TWADFile.Create();
 293   WAD.ReadFile(FileName);
 294
 295   if WAD.GetResource(g_ExtractFilePathName(Resource), SoundData, ResLength) then
 296     begin
 297       if e_LoadSoundMem(SoundData, ResLength, ID, isMusic) then
 298         ok := True
 299       else
 300         FreeMem(SoundData);
 301     end
 302   else
 303   begin
 304     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 305   end;
 306
 307   WAD.Free();
 308   if (not ok) then
 309   begin
 310 {$IFNDEF HEADLESS}
 311     if isMusic then
 312       e_WriteLog(Format('Error loading music %s', [Resource]), TMsgType.Warning)
 313     else
 314       e_WriteLog(Format('Error loading sound %s', [Resource]), TMsgType.Warning);
 315     Exit;
 316 {$ENDIF}
 317   end;
 318   Result := True;
 319 end;
 320
 321 function g_Sound_CreateWADEx(SoundName: ShortString; Resource: string; isMusic: Boolean = False; ForceNoLoop: Boolean = False): Boolean;
 322 var
 323   WAD: TWADFile;
 324   FileName: string;
 325   SoundData: Pointer;
 326   ResLength: Integer;
 327   find_id: DWORD;
 328   ok: Boolean;
 329 begin
 330   Result := False;
 331   ok := False;
 332
 333   // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
 334   FileName := g_ExtractWadName(Resource);
 335
 336   find_id := FindSound();
 337
 338   WAD := TWADFile.Create();
 339   WAD.ReadFile(FileName);
 340
 341   if WAD.GetResource(g_ExtractFilePathName(Resource), SoundData, ResLength) then
 342     begin
 343       if e_LoadSoundMem(SoundData, ResLength, SoundArray[find_id].ID, isMusic, ForceNoLoop) then
 344         begin
 345           SoundArray[find_id].Name := SoundName;
 346           SoundArray[find_id].IsMusic := isMusic;
 347           ok := True;
 348         end
 349       else
 350         FreeMem(SoundData);
 351     end
 352   else
 353   begin
 354     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 355   end;
 356
 357   WAD.Free();
 358   if (not ok) then
 359   begin
 360 {$IFNDEF HEADLESS}
 361     if isMusic then
 362       e_WriteLog(Format('Error loading music %s', [Resource]), TMsgType.Warning)
 363     else
 364       e_WriteLog(Format('Error loading sound %s', [Resource]), TMsgType.Warning);
 365     Exit;
 366 {$ENDIF}
 367   end;
 368   Result := True;
 369 end;
 370
 371 procedure g_Sound_Delete(SoundName: ShortString);
 372 var
 373   a: DWORD;
 374 begin
 375   if (SoundArray = nil) or (SoundName = '') then
 376     Exit;
 377
 378   for a := 0 to High(SoundArray) do
 379     if SoundArray[a].Name = SoundName then
 380     begin
 381       e_DeleteSound(SoundArray[a].ID);
 382       SoundArray[a].Name := '';
 383       SoundArray[a].ID := 0;
 384       SoundArray[a].IsMusic := False;
 385     end;
 386 end;
 387
 388 function g_Sound_Exists(SoundName: string): Boolean;
 389 var
 390   a: DWORD;
 391 begin
 392   Result := False;
 393
 394   if SoundName = '' then
 395     Exit;
 396
 397   if SoundArray <> nil then
 398     for a := 0 to High(SoundArray) do
 399       if SoundArray[a].Name = SoundName then
 400       begin
 401         Result := True;
 402         Break;
 403       end;
 404 end;
 405
 406 function g_Sound_Get(var ID: DWORD; SoundName: ShortString): Boolean;
 407 var
 408   a: DWORD;
 409 begin
 410   Result := False;
 411
 412   if SoundName = '' then
 413     Exit;
 414
 415   if SoundArray <> nil then
 416     for a := 0 to High(SoundArray) do
 417       if SoundArray[a].Name = SoundName then
 418       begin
 419         ID := SoundArray[a].ID;
 420         Result := True;
 421         Break;
 422       end;
 423 end;
 424
 425 procedure g_Sound_SetupAllVolumes(SoundVol, MusicVol: Byte);
 426 var
 427   Svol, Mvol: Single;
 428   sm: Boolean;
 429 begin
 430   Mvol := 0; // shut up, compiler
 431   if (gSoundLevel = SoundVol) and (gMusicLevel = MusicVol) then
 432     Exit;
 433
 434   if gSoundLevel > 0 then
 435     begin
 436       Svol := SoundVol / gSoundLevel;
 437       sm := False;
 438     end
 439   else
 440     begin
 441       Svol := SoundVol / 255.0;
 442       sm := True;
 443     end;
 444
 445   if gMusic <> nil then
 446     if gMusicLevel > 0 then
 447       Mvol := gMusic.GetVolume() * MusicVol / gMusicLevel
 448     else
 449       Mvol := MusicVol / 255.0;
 450
 451   e_ModifyChannelsVolumes(Svol, sm);
 452
 453   if gMusic <> nil then
 454     gMusic.SetVolume(Mvol);
 455
 456   gSoundLevel := SoundVol;
 457   gMusicLevel := MusicVol;
 458 end;
 459
 460 { TPlayableSound: }
 461
 462 constructor TPlayableSound.Create();
 463 begin
 464   inherited;
 465   FName := '';
 466 end;
 467
 468 destructor TPlayableSound.Destroy();
 469 begin
 470   inherited;
 471 end;
 472
 473 function TPlayableSound.Play(Force: Boolean = False): Boolean;
 474 begin
 475   if Force or not IsPlaying() then
 476     begin
 477       Stop();
 478       Result := RawPlay(0.0, gSoundLevel/255.0, FPosition);
 479     end
 480   else
 481     Result := False;
 482 end;
 483
 484 function TPlayableSound.PlayAt(X, Y: Integer): Boolean;
 485 var
 486   Pan, Vol: Single;
 487 begin
 488   if PlaySoundAt(X, Y, Pan, Vol) then
 489     begin
 490       Stop();
 491       Result := RawPlay(Pan, Vol * (gSoundLevel/255.0), FPosition);
 492     end
 493   else
 494     Result := False;
 495 end;
 496
 497 function TPlayableSound.PlayPanVolume(Pan, Volume: Single; Force: Boolean = False): Boolean;
 498 begin
 499   if Force or not IsPlaying() then
 500     begin
 501       Stop();
 502       Result := RawPlay(Pan, Volume * (gSoundLevel/255.0), FPosition);
 503     end
 504   else
 505     Result := False;
 506 end;
 507
 508 function TPlayableSound.PlayVolumeAtRect (X, Y, W, H: Integer; Volume: Single): Boolean;
 509   var Pan, Vol: Single;
 510 begin
 511   Result := False;
 512   if PlaySoundAtRect(X, Y, W, H, Pan, Vol, Volume) then
 513   begin
 514     Stop;
 515     Result := RawPlay(Pan, Volume * Vol * (gSoundLevel / 255.0), FPosition)
 516   end
 517 end;
 518
 519 function TPlayableSound.PlayVolumeAt (X, Y: Integer; Volume: Single): Boolean;
 520 begin
 521   Result := Self.PlayVolumeAtRect(X, Y, 0, 0, Volume)
 522 end;
 523
 524 function TPlayableSound.SetCoordsRect (X, Y, W, H: Integer; Volume: Single): Boolean;
 525   var Pan, Vol: Single;
 526 begin
 527   if PlaySoundAtRect(X, Y, W, H, Pan, Vol, Volume) then
 528   begin
 529     SetVolume(Volume * Vol * (gSoundLevel / 255.0));
 530     SetPan(Pan);
 531     Result := True
 532   end
 533   else
 534   begin
 535     SetVolume(0.0);
 536     SetPan(0.0);
 537     Result := False
 538   end;
 539 end;
 540
 541 function TPlayableSound.SetCoords(X, Y: Integer; Volume: Single): Boolean;
 542 begin
 543   Result := Self.SetCoordsRect(X, Y, 0, 0, Volume)
 544 end;
 545
 546 function TPlayableSound.SetByName(SN: String): Boolean;
 547 var
 548   id: DWORD;
 549 begin
 550   if g_Sound_Get(id, SN) then
 551     begin
 552       SetID(id);
 553       FName := SN;
 554       Result := True;
 555     end
 556   else
 557     Result := False;
 558 end;
 559
 560 { TMusic: }
 561
 562 constructor TMusic.Create();
 563 begin
 564   inherited;
 565   FName := '';
 566   FSpecPause := False;
 567   FNoMusic := True;
 568 end;
 569
 570 destructor TMusic.Destroy();
 571 begin
 572   inherited;
 573 end;
 574
 575 function TMusic.Play(Force: Boolean = False): Boolean;
 576 begin
 577   if FNoMusic then
 578   begin
 579     Result := True;
 580     Exit;
 581   end;
 582
 583   if Force or not IsPlaying() then
 584     begin
 585       Stop();
 586       Result := RawPlay(0.0, gMusicLevel/255.0, FPosition);
 587       if Result then
 588         SetPriority(0);
 589       if Result and FSpecPause then
 590         Pause(True);
 591     end
 592   else
 593     Result := False;
 594 end;
 595
 596 function TMusic.SetByName(SN: String): Boolean;
 597 var
 598   id: DWORD;
 599 begin
 600   if SN = '' then
 601   begin
 602     FNoMusic := True;
 603     Result := True;
 604     Exit;
 605   end;
 606
 607   if g_Sound_Get(id, SN) then
 608     begin
 609       SetID(id);
 610       FName := SN;
 611       FNoMusic := False;
 612       FSpecPause := False;
 613       Result := True;
 614     end
 615   else
 616     Result := False;
 617 end;
 618
 619 function TMusic.IsPaused(): Boolean;
 620 begin
 621   Result := inherited IsPaused();
 622   Result := Result or FSpecPause;
 623 end;
 624
 625 procedure TMusic.Pause(Enable: Boolean);
 626 begin
 627 // Îòêëþ÷àåì ïàóçó, òîëüêî åñëè íå áûëî ñïåö-ïàóçû:
 628   if Enable or (not FSpecPause) then
 629     inherited Pause(Enable);
 630 end;
 631
 632 procedure TMusic.SetSpecPause(Enable: Boolean);
 633 begin
 634   FSpecPause := Enable;
 635   Pause(Enable);
 636 end;
 637
 638 end.