1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
28 TPlayableSound
= class(TBasicSound
)
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;
44 property Loop
: Boolean read FMusic write FMusic
;
45 property Name
: String read FName
;
48 TMusic
= class(TBasicSound
)
51 FSpecPause
: Boolean; // Ñïåö-ïàóçà. "Ñèëüíåå" îáû÷íîé
54 procedure SetSpecPause(Enable
: Boolean);
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);
64 property Name
: String read FName
;
65 property SpecPause
: Boolean read FSpecPause write SetSpecPause
;
66 property NoMusic
: Boolean read FNoMusic
;
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;
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;
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;
83 procedure g_Sound_SetupAllVolumes(SoundVol
, MusicVol
: Byte);
88 e_log
, SysUtils
, g_console
, g_options
, wadreader
,
89 g_game
, g_basic
, g_items
, g_map
, Math
,
100 SoundArray
: Array of TGameSound
;
101 //SoundsMuted: Boolean = False;
104 function FindSound(): DWORD
;
108 if SoundArray
<> nil then
109 for i
:= 0 to High(SoundArray
) do
110 if SoundArray
[i
].Name
= '' then
116 if SoundArray
= nil then
118 SetLength(SoundArray
, 8);
123 Result
:= High(SoundArray
) + 1;
124 SetLength(SoundArray
, Length(SoundArray
) + 8);
128 function g_Sound_PlayEx(SoundName
: ShortString
): Boolean;
133 if SoundArray
= nil then
136 for a
:= 0 to High(SoundArray
) do
137 if SoundArray
[a
].Name
= SoundName
then
139 Result
:= (e_PlaySoundVolume(SoundArray
[a
].ID
, gSoundLevel
/255.0) >= 0);
143 e_WriteLog(Format(_lc
[I_GAME_ERROR_SOUND
], [SoundName
]), TMsgType
.Warning
);
146 function g_Sound_PlayExPanVolume(SoundName
: ShortString
; Pan
: Single; Volume
: Single): Boolean;
151 if SoundArray
= nil then
154 for a
:= 0 to High(SoundArray
) do
155 if SoundArray
[a
].Name
= SoundName
then
157 Result
:= (e_PlaySoundPanVolume(SoundArray
[a
].ID
, Pan
, Volume
* (gSoundLevel
/255.0)) >= 0);
161 e_WriteLog(Format(_lc
[I_GAME_ERROR_SOUND
], [SoundName
]), TMsgType
.Warning
);
164 function PlaySoundAtRect (X
, Y
, W
, H
: Integer; out Pan
, Volume
: Single; InVolume
: Single = 1.0): Boolean;
170 procedure CalcDest (const p
: THearPoint
; out pan
: Single; out len
: Integer);
171 var XX
, YY
, lx
, rx
: Integer;
173 pan
:= 0.0; len
:= gMaxDist
;
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
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
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
);
204 if len1
>= sMaxDist
then
213 Volume
:= 1.0 - len1
/ sMaxDist
;
218 function PlaySoundAt(X
, Y
: Integer; out Pan
: Single; out Volume
: Single; InVolume
: Single = 1.0): Boolean;
220 Result
:= PlaySoundAtRect(X
, Y
, 0, 0, Pan
, Volume
, InVolume
)
223 function g_Sound_PlayAt(ID
: DWORD
; X
, Y
: Integer): Boolean;
227 if PlaySoundAt(X
, Y
, Pan
, Vol
) then
228 Result
:= (e_PlaySoundPanVolume(ID
, Pan
, Vol
* (gSoundLevel
/255.0)) >= 0)
233 function g_Sound_PlayExAt(SoundName
: ShortString
; X
, Y
: Integer): Boolean;
240 if SoundArray
= nil then
243 for a
:= 0 to High(SoundArray
) do
244 if SoundArray
[a
].Name
= SoundName
then
246 if PlaySoundAt(X
, Y
, Pan
, Vol
) then
247 Result
:= (e_PlaySoundPanVolume(SoundArray
[a
].ID
, Pan
, Vol
* (gSoundLevel
/255.0)) >= 0);
251 e_WriteLog(Format(_lc
[I_GAME_ERROR_SOUND
], [SoundName
]), TMsgType
.Warning
);
254 function g_Sound_CreateFile(var ID
: DWORD
; FileName
: string; isMusic
: Boolean = False): Boolean;
256 Result
:= e_LoadSound(FileName
, ID
, isMusic
);
259 function g_Sound_CreateFileEx(SoundName
: ShortString
; FileName
: string; isMusic
: Boolean = False; ForceNoLoop
: Boolean = False): Boolean;
265 find_id
:= FindSound();
267 if not e_LoadSound(FileName
, SoundArray
[find_id
].ID
, isMusic
, ForceNoLoop
) then
270 SoundArray
[find_id
].Name
:= SoundName
;
271 SoundArray
[find_id
].IsMusic
:= isMusic
;
276 function g_Sound_CreateWAD(var ID
: DWORD
; Resource
: string; isMusic
: Boolean = False): Boolean;
287 // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
288 FileName
:= g_ExtractWadName(Resource
);
290 WAD
:= TWADFile
.Create();
291 WAD
.ReadFile(FileName
);
293 if WAD
.GetResource(g_ExtractFilePathName(Resource
), SoundData
, ResLength
) then
295 if e_LoadSoundMem(SoundData
, ResLength
, ID
, isMusic
) then
302 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
310 e_WriteLog(Format('Error loading music %s', [Resource
]), TMsgType
.Warning
)
312 e_WriteLog(Format('Error loading sound %s', [Resource
]), TMsgType
.Warning
);
319 function g_Sound_CreateWADEx(SoundName
: ShortString
; Resource
: string; isMusic
: Boolean = False; ForceNoLoop
: Boolean = False): Boolean;
331 // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY);
332 FileName
:= g_ExtractWadName(Resource
);
334 find_id
:= FindSound();
336 WAD
:= TWADFile
.Create();
337 WAD
.ReadFile(FileName
);
339 if WAD
.GetResource(g_ExtractFilePathName(Resource
), SoundData
, ResLength
) then
341 if e_LoadSoundMem(SoundData
, ResLength
, SoundArray
[find_id
].ID
, isMusic
, ForceNoLoop
) then
343 SoundArray
[find_id
].Name
:= SoundName
;
344 SoundArray
[find_id
].IsMusic
:= isMusic
;
352 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
360 e_WriteLog(Format('Error loading music %s', [Resource
]), TMsgType
.Warning
)
362 e_WriteLog(Format('Error loading sound %s', [Resource
]), TMsgType
.Warning
);
369 procedure g_Sound_Delete(SoundName
: ShortString
);
373 if (SoundArray
= nil) or (SoundName
= '') then
376 for a
:= 0 to High(SoundArray
) do
377 if SoundArray
[a
].Name
= SoundName
then
379 e_DeleteSound(SoundArray
[a
].ID
);
380 SoundArray
[a
].Name
:= '';
381 SoundArray
[a
].ID
:= 0;
382 SoundArray
[a
].IsMusic
:= False;
386 function g_Sound_Exists(SoundName
: string): Boolean;
392 if SoundName
= '' then
395 if SoundArray
<> nil then
396 for a
:= 0 to High(SoundArray
) do
397 if SoundArray
[a
].Name
= SoundName
then
404 function g_Sound_Get(var ID
: DWORD
; SoundName
: ShortString
): Boolean;
410 if SoundName
= '' then
413 if SoundArray
<> nil then
414 for a
:= 0 to High(SoundArray
) do
415 if SoundArray
[a
].Name
= SoundName
then
417 ID
:= SoundArray
[a
].ID
;
423 procedure g_Sound_SetupAllVolumes(SoundVol
, MusicVol
: Byte);
428 Mvol
:= 0; // shut up, compiler
429 if (gSoundLevel
= SoundVol
) and (gMusicLevel
= MusicVol
) then
432 if gSoundLevel
> 0 then
434 Svol
:= SoundVol
/ gSoundLevel
;
439 Svol
:= SoundVol
/ 255.0;
443 if gMusic
<> nil then
444 if gMusicLevel
> 0 then
445 Mvol
:= gMusic
.GetVolume() * MusicVol
/ gMusicLevel
447 Mvol
:= MusicVol
/ 255.0;
449 e_ModifyChannelsVolumes(Svol
, sm
);
451 if gMusic
<> nil then
452 gMusic
.SetVolume(Mvol
);
454 gSoundLevel
:= SoundVol
;
455 gMusicLevel
:= MusicVol
;
460 constructor TPlayableSound
.Create();
466 destructor TPlayableSound
.Destroy();
471 function TPlayableSound
.Play(Force
: Boolean = False): Boolean;
473 if Force
or not IsPlaying() then
476 Result
:= RawPlay(0.0, gSoundLevel
/255.0, FPosition
);
482 function TPlayableSound
.PlayAt(X
, Y
: Integer): Boolean;
486 if PlaySoundAt(X
, Y
, Pan
, Vol
) then
489 Result
:= RawPlay(Pan
, Vol
* (gSoundLevel
/255.0), FPosition
);
495 function TPlayableSound
.PlayPanVolume(Pan
, Volume
: Single; Force
: Boolean = False): Boolean;
497 if Force
or not IsPlaying() then
500 Result
:= RawPlay(Pan
, Volume
* (gSoundLevel
/255.0), FPosition
);
506 function TPlayableSound
.PlayVolumeAtRect (X
, Y
, W
, H
: Integer; Volume
: Single): Boolean;
507 var Pan
, Vol
: Single;
510 if PlaySoundAtRect(X
, Y
, W
, H
, Pan
, Vol
, Volume
) then
513 Result
:= RawPlay(Pan
, Volume
* Vol
* (gSoundLevel
/ 255.0), FPosition
)
517 function TPlayableSound
.PlayVolumeAt (X
, Y
: Integer; Volume
: Single): Boolean;
519 Result
:= Self
.PlayVolumeAtRect(X
, Y
, 0, 0, Volume
)
522 function TPlayableSound
.SetCoordsRect (X
, Y
, W
, H
: Integer; Volume
: Single): Boolean;
523 var Pan
, Vol
: Single;
525 if PlaySoundAtRect(X
, Y
, W
, H
, Pan
, Vol
, Volume
) then
527 SetVolume(Volume
* Vol
* (gSoundLevel
/ 255.0));
539 function TPlayableSound
.SetCoords(X
, Y
: Integer; Volume
: Single): Boolean;
541 Result
:= Self
.SetCoordsRect(X
, Y
, 0, 0, Volume
)
544 function TPlayableSound
.SetByName(SN
: String): Boolean;
548 if g_Sound_Get(id
, SN
) then
560 constructor TMusic
.Create();
568 destructor TMusic
.Destroy();
573 function TMusic
.Play(Force
: Boolean = False): Boolean;
581 if Force
or not IsPlaying() then
584 Result
:= RawPlay(0.0, gMusicLevel
/255.0, FPosition
);
587 if Result
and FSpecPause
then
594 function TMusic
.SetByName(SN
: String): Boolean;
605 if g_Sound_Get(id
, SN
) then
617 function TMusic
.IsPaused(): Boolean;
619 Result
:= inherited IsPaused();
620 Result
:= Result
or FSpecPause
;
623 procedure TMusic
.Pause(Enable
: Boolean);
625 // Îòêëþ÷àåì ïàóçó, òîëüêî åñëè íå áûëî ñïåö-ïàóçû:
626 if Enable
or (not FSpecPause
) then
627 inherited Pause(Enable
);
630 procedure TMusic
.SetSpecPause(Enable
: Boolean);
632 FSpecPause
:= Enable
;
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');