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