src/game/g_sound.pas

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