src/game/g_sound.pas

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