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