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