DEADSOFTWARE

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