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,
 285   SectionName,
 286   ResourceName: string;
 287   SoundData: Pointer;
 288   ResLength: Integer;
 289   ok: Boolean;
 290 begin
 291   Result := False;
 292   ok := False;
 293
 294   // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
 295   g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 296
 297   WAD := TWADFile.Create();
 298   WAD.ReadFile(FileName);
 299
 300   if WAD.GetResource(SectionName, ResourceName, SoundData, ResLength) then
 301     begin
 302       if e_LoadSoundMem(SoundData, ResLength, ID, isMusic) then
 303         ok := True
 304       else
 305         FreeMem(SoundData);
 306     end
 307   else
 308   begin
 309     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 310   end;
 311
 312   WAD.Free();
 313   if (not ok) then
 314   begin
 315 {$IFNDEF HEADLESS}
 316     if isMusic then
 317       e_WriteLog(Format('Error loading music %s', [Resource]), MSG_WARNING)
 318     else
 319       e_WriteLog(Format('Error loading sound %s', [Resource]), MSG_WARNING);
 320     Exit;
 321 {$ENDIF}
 322   end;
 323   Result := True;
 324 end;
 325
 326 function g_Sound_CreateWADEx(SoundName: ShortString; Resource: string; isMusic: Boolean = False): Boolean;
 327 var
 328   WAD: TWADFile;
 329   FileName, SectionName, ResourceName: string;
 330   SoundData: Pointer;
 331   ResLength: Integer;
 332   find_id: DWORD;
 333   ok: Boolean;
 334 begin
 335   Result := False;
 336   ok := False;
 337
 338   // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
 339   g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 340
 341   find_id := FindSound();
 342
 343   WAD := TWADFile.Create();
 344   WAD.ReadFile(FileName);
 345
 346   if WAD.GetResource(SectionName, ResourceName, SoundData, ResLength) then
 347     begin
 348       if e_LoadSoundMem(SoundData, ResLength, SoundArray[find_id].ID, isMusic) then
 349         begin
 350           SoundArray[find_id].Name := SoundName;
 351           SoundArray[find_id].IsMusic := isMusic;
 352           ok := True;
 353         end
 354       else
 355         FreeMem(SoundData);
 356     end
 357   else
 358   begin
 359     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 360   end;
 361
 362   WAD.Free();
 363   if (not ok) then
 364   begin
 365 {$IFNDEF HEADLESS}
 366     if isMusic then
 367       e_WriteLog(Format('Error loading music %s', [Resource]), MSG_WARNING)
 368     else
 369       e_WriteLog(Format('Error loading sound %s', [Resource]), MSG_WARNING);
 370     Exit;
 371 {$ENDIF}
 372   end;
 373   Result := True;
 374 end;
 375
 376 procedure g_Sound_Delete(SoundName: ShortString);
 377 var
 378   a: DWORD;
 379 begin
 380   if (SoundArray = nil) or (SoundName = '') then
 381     Exit;
 382
 383   for a := 0 to High(SoundArray) do
 384     if SoundArray[a].Name = SoundName then
 385     begin
 386       e_DeleteSound(SoundArray[a].ID);
 387       SoundArray[a].Name := '';
 388       SoundArray[a].ID := 0;
 389       SoundArray[a].IsMusic := False;
 390     end;
 391 end;
 392
 393 function g_Sound_Exists(SoundName: string): Boolean;
 394 var
 395   a: DWORD;
 396 begin
 397   Result := False;
 398
 399   if SoundName = '' then
 400     Exit;
 401
 402   if SoundArray <> nil then
 403     for a := 0 to High(SoundArray) do
 404       if SoundArray[a].Name = SoundName then
 405       begin
 406         Result := True;
 407         Break;
 408       end;
 409 end;
 410
 411 function g_Sound_Get(var ID: DWORD; SoundName: ShortString): Boolean;
 412 var
 413   a: DWORD;
 414 begin
 415   Result := False;
 416
 417   if SoundName = '' then
 418     Exit;
 419
 420   if SoundArray <> nil then
 421     for a := 0 to High(SoundArray) do
 422       if SoundArray[a].Name = SoundName then
 423       begin
 424         ID := SoundArray[a].ID;
 425         Result := True;
 426         Break;
 427       end;
 428 end;
 429
 430 procedure g_Sound_SetupAllVolumes(SoundVol, MusicVol: Byte);
 431 var
 432   Svol, Mvol: Single;
 433   sm: Boolean;
 434 begin
 435   Mvol := 0; // shut up, compiler
 436   if (gSoundLevel = SoundVol) and (gMusicLevel = MusicVol) then
 437     Exit;
 438
 439   if gSoundLevel > 0 then
 440     begin
 441       Svol := SoundVol / gSoundLevel;
 442       sm := False;
 443     end
 444   else
 445     begin
 446       Svol := SoundVol / 255.0;
 447       sm := True;
 448     end;
 449
 450   if gMusic <> nil then
 451     if gMusicLevel > 0 then
 452       Mvol := gMusic.GetVolume() * MusicVol / gMusicLevel
 453     else
 454       Mvol := MusicVol / 255.0;
 455
 456   e_ModifyChannelsVolumes(Svol, sm);
 457
 458   if gMusic <> nil then
 459     gMusic.SetVolume(Mvol);
 460
 461   gSoundLevel := SoundVol;
 462   gMusicLevel := MusicVol;
 463 end;
 464
 465 { TPlayableSound: }
 466
 467 constructor TPlayableSound.Create();
 468 begin
 469   inherited;
 470   FName := '';
 471 end;
 472
 473 destructor TPlayableSound.Destroy();
 474 begin
 475   inherited;
 476 end;
 477
 478 function TPlayableSound.Play(Force: Boolean = False): Boolean;
 479 begin
 480   if Force or not IsPlaying() then
 481     begin
 482       Stop();
 483       Result := RawPlay(0.0, gSoundLevel/255.0, FPosition);
 484     end
 485   else
 486     Result := False;
 487 end;
 488
 489 function TPlayableSound.PlayAt(X, Y: Integer): Boolean;
 490 var
 491   Pan, Vol: Single;
 492 begin
 493   if PlaySoundAt(X, Y, Pan, Vol) then
 494     begin
 495       Stop();
 496       Result := RawPlay(Pan, Vol * (gSoundLevel/255.0), FPosition);
 497     end
 498   else
 499     Result := False;
 500 end;
 501
 502 function TPlayableSound.PlayPanVolume(Pan, Volume: Single; Force: Boolean = False): Boolean;
 503 begin
 504   if Force or not IsPlaying() then
 505     begin
 506       Stop();
 507       Result := RawPlay(Pan, Volume * (gSoundLevel/255.0), FPosition);
 508     end
 509   else
 510     Result := False;
 511 end;
 512
 513 function TPlayableSound.PlayVolumeAt(X, Y: Integer; Volume: Single): Boolean;
 514 var
 515   Pan, Vol: Single;
 516 begin
 517   if PlaySoundAt(X, Y, Pan, Vol, Volume) then
 518     begin
 519       Stop();
 520       Result := RawPlay(Pan, Volume * Vol * (gSoundLevel/255.0), FPosition);
 521     end
 522   else
 523     Result := False;
 524 end;
 525
 526 function TPlayableSound.SetCoords(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     SetVolume(Volume * Vol * (gSoundLevel/255.0));
 533     SetPan(Pan);
 534     Result := True;
 535   end
 536   else
 537   begin
 538     SetVolume(0.0);
 539     SetPan(0.0);
 540     Result := False;
 541   end;
 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 end.