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, either version 3 of the License, or
6 * (at your option) any later version.
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.
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/>.
22 {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
34 TBasicSound = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
36 FChannel: FMOD_CHANNEL;
44 function RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean;
48 destructor Destroy(); override;
49 procedure SetID(ID: DWORD);
50 procedure FreeSound();
51 function IsPlaying(): Boolean;
53 function IsPaused(): Boolean;
54 procedure Pause(Enable: Boolean);
55 function GetVolume(): Single;
56 procedure SetVolume(Volume: Single);
57 function GetPan(): Single;
58 procedure SetPan(Pan: Single);
59 function IsMuted(): Boolean;
60 procedure Mute(Enable: Boolean);
61 function GetPosition(): DWORD;
62 procedure SetPosition(aPos: DWORD);
63 procedure SetPriority(priority: Integer);
67 NO_SOUND_ID = DWORD(-1);
69 function e_InitSoundSystem(NoOutput: Boolean = False): Boolean;
71 function e_LoadSound(FileName: string; var ID: DWORD; bLoop: Boolean): Boolean;
72 function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean;
74 function e_PlaySound(ID: DWORD): Integer;
75 function e_PlaySoundPan(ID: DWORD; Pan: Single): Integer;
76 function e_PlaySoundVolume(ID: DWORD; Volume: Single): Integer;
77 function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Integer;
79 procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean);
80 procedure e_MuteChannels(Enable: Boolean);
81 procedure e_StopChannels();
83 procedure e_DeleteSound(ID: DWORD);
84 procedure e_RemoveAllSounds();
85 procedure e_ReleaseSoundSystem();
86 procedure e_SoundUpdate();
89 e_SoundsArray: array of TSoundRec = nil;
94 g_window, g_options, utils;
100 F_System: FMOD_SYSTEM = nil;
101 SoundMuted: Boolean = False;
104 function Channel_Callback(channel: FMOD_CHANNEL; callbacktype: FMOD_CHANNEL_CALLBACKTYPE;
105 commanddata1: Pointer; commanddata2: Pointer): FMOD_RESULT; {$IFDEF WIN32} stdcall; {$ELSE} cdecl; {$ENDIF}
115 if callbacktype = FMOD_CHANNEL_CALLBACKTYPE_END then
117 res := FMOD_Channel_GetCurrentSound(channel, sound);
118 if res = FMOD_OK then
120 res := FMOD_Sound_GetUserData(sound, ud);
121 if res = FMOD_OK then
124 if id < DWORD(Length(e_SoundsArray)) then
125 if e_SoundsArray[id].nRefs > 0 then
126 Dec(e_SoundsArray[id].nRefs);
134 function TryInitWithOutput(Output: FMOD_OUTPUTTYPE; OutputName: String): FMOD_RESULT;
136 e_WriteLog('Trying with ' + OutputName + '...', TMsgType.Warning);
137 Result := FMOD_System_SetOutput(F_System, Output);
138 if Result <> FMOD_OK then
140 e_WriteLog('Error setting FMOD output to ' + OutputName + '!', TMsgType.Warning);
141 e_WriteLog(FMOD_ErrorString(Result), TMsgType.Warning);
144 Result := FMOD_System_Init(F_System, N_CHANNELS, FMOD_INIT_NORMAL, nil);
145 if Result <> FMOD_OK then
147 e_WriteLog('Error initializing FMOD system!', TMsgType.Warning);
148 e_WriteLog(FMOD_ErrorString(Result), TMsgType.Warning);
153 function e_TrySS (Freq: Integer; forceNoSound: Integer): Boolean;
157 output: FMOD_OUTPUTTYPE;
162 e_WriteLog(Format('Trying to initialize FMOD with %d', [Freq]), TMsgType.Notify);
164 res := FMOD_System_Create(F_System);
165 if res <> FMOD_OK then
167 e_WriteLog('Error creating FMOD system:', TMsgType.Fatal);
168 e_WriteLog(FMOD_ErrorString(res), TMsgType.Fatal);
172 res := FMOD_System_GetVersion(F_System, ver);
173 if res <> FMOD_OK then
175 e_WriteLog('Error getting FMOD version:', TMsgType.Fatal);
176 e_WriteLog(FMOD_ErrorString(res), TMsgType.Fatal);
180 if ver < FMOD_VERSION then
182 e_WriteLog('FMOD library version is too old! Need '+IntToStr(FMOD_VERSION), TMsgType.Fatal);
186 res := FMOD_System_SetSoftwareFormat(F_System, Freq, FMOD_SOUND_FORMAT_PCM16, 0, 0, FMOD_DSP_RESAMPLER_LINEAR);
187 if res <> FMOD_OK then
189 e_WriteLog('Error setting FMOD software format!', TMsgType.Fatal);
190 e_WriteLog(FMOD_ErrorString(res), TMsgType.Fatal);
194 if forceNoSound = 2 then
196 res := TryInitWithOutput(FMOD_OUTPUTTYPE_NOSOUND, 'OUTPUTTYPE_NOSOUND');
197 if res <> FMOD_OK then
199 e_WriteLog('FMOD: Giving up, can''t init with NOSOUND.', TMsgType.Fatal);
205 res := FMOD_System_Init(F_System, N_CHANNELS, FMOD_INIT_NORMAL, nil);
206 if res <> FMOD_OK then
208 e_WriteLog('Error initializing FMOD system!', TMsgType.Warning);
209 e_WriteLog(FMOD_ErrorString(res), TMsgType.Warning);
212 res := TryInitWithOutput(FMOD_OUTPUTTYPE_ALSA, 'OUTPUTTYPE_ALSA');
213 if res <> FMOD_OK then
214 res := TryInitWithOutput(FMOD_OUTPUTTYPE_OSS, 'OUTPUTTYPE_OSS');
216 if (res <> FMOD_OK) and (forceNoSound <> 1) then Exit;
217 if res <> FMOD_OK then
218 res := TryInitWithOutput(FMOD_OUTPUTTYPE_NOSOUND, 'OUTPUTTYPE_NOSOUND');
219 if res <> FMOD_OK then
221 e_WriteLog('FMOD: Giving up, can''t init any output.', TMsgType.Fatal);
227 res := FMOD_System_GetOutput(F_System, output);
228 if res <> FMOD_OK then
229 e_WriteLog('Error getting FMOD output!', TMsgType.Warning)
232 FMOD_OUTPUTTYPE_NOSOUND: e_WriteLog('FMOD Output Method: NOSOUND', TMsgType.Notify);
233 FMOD_OUTPUTTYPE_NOSOUND_NRT: e_WriteLog('FMOD Output Method: NOSOUND_NRT', TMsgType.Notify);
234 FMOD_OUTPUTTYPE_DSOUND: e_WriteLog('FMOD Output Method: DSOUND', TMsgType.Notify);
235 FMOD_OUTPUTTYPE_WINMM: e_WriteLog('FMOD Output Method: WINMM', TMsgType.Notify);
236 FMOD_OUTPUTTYPE_OPENAL: e_WriteLog('FMOD Output Method: OPENAL', TMsgType.Notify);
237 FMOD_OUTPUTTYPE_WASAPI: e_WriteLog('FMOD Output Method: WASAPI', TMsgType.Notify);
238 FMOD_OUTPUTTYPE_ASIO: e_WriteLog('FMOD Output Method: ASIO', TMsgType.Notify);
239 FMOD_OUTPUTTYPE_OSS: e_WriteLog('FMOD Output Method: OSS', TMsgType.Notify);
240 FMOD_OUTPUTTYPE_ALSA: e_Writelog('FMOD Output Method: ALSA', TMsgType.Notify);
241 else e_WriteLog('FMOD Output Method: Unknown', TMsgType.Notify);
244 res := FMOD_System_GetDriver(F_System, drv);
245 if res <> FMOD_OK then
246 e_WriteLog('Error getting FMOD driver!', TMsgType.Warning)
248 e_WriteLog('FMOD driver id: '+IntToStr(drv), TMsgType.Notify);
253 function e_InitSoundSystem(NoOutput: Boolean = False): Boolean;
257 Result := e_TrySS(48000, 2);
260 Result := e_TrySS(48000, 0);
261 if not Result then Result := e_TrySS(44100, 1);
264 function FindESound(): DWORD;
269 if e_SoundsArray <> nil then
270 for i := 0 to High(e_SoundsArray) do
271 if e_SoundsArray[i].Sound = nil then
277 if e_SoundsArray = nil then
279 SetLength(e_SoundsArray, 16);
284 Result := High(e_SoundsArray) + 1;
285 SetLength(e_SoundsArray, Length(e_SoundsArray) + 16);
289 function e_LoadSound(FileName: String; var ID: DWORD; bLoop: Boolean): Boolean;
299 e_WriteLog('Loading sound '+FileName+'...', TMsgType.Notify);
301 find_id := FindESound();
304 bt := FMOD_LOOP_NORMAL
309 res := FMOD_System_CreateSound(F_System, PAnsiChar(FileName),
310 bt + FMOD_2D + FMOD_HARDWARE,
311 nil, e_SoundsArray[find_id].Sound)
313 res := FMOD_System_CreateStream(F_System, PAnsiChar(FileName),
314 bt + FMOD_2D + FMOD_HARDWARE,
315 nil, e_SoundsArray[find_id].Sound);
316 if res <> FMOD_OK then
318 e_SoundsArray[find_id].Sound := nil;
322 GetMem(ud, SizeOf(DWORD));
323 DWORD(ud^) := find_id;
324 res := FMOD_Sound_SetUserData(e_SoundsArray[find_id].Sound, ud);
325 if res <> FMOD_OK then
327 e_SoundsArray[find_id].Sound := nil;
331 e_SoundsArray[find_id].Data := nil;
332 e_SoundsArray[find_id].isMusic := bLoop;
333 e_SoundsArray[find_id].nRefs := 0;
340 function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean;
346 soundExInfo: FMOD_CREATESOUNDEXINFO;
352 find_id := FindESound();
354 sz := SizeOf(FMOD_CREATESOUNDEXINFO);
355 FillMemory(@soundExInfo, sz, 0);
356 soundExInfo.cbsize := sz;
357 soundExInfo.length := Length;
360 bt := FMOD_LOOP_NORMAL
365 res := FMOD_System_CreateSound(F_System, pData,
366 bt + FMOD_2D + FMOD_HARDWARE + FMOD_OPENMEMORY,
367 @soundExInfo, e_SoundsArray[find_id].Sound)
369 res := FMOD_System_CreateStream(F_System, pData,
370 bt + FMOD_2D + FMOD_HARDWARE + FMOD_OPENMEMORY,
371 @soundExInfo, e_SoundsArray[find_id].Sound);
372 if res <> FMOD_OK then
374 e_SoundsArray[find_id].Sound := nil;
378 GetMem(ud, SizeOf(DWORD));
379 DWORD(ud^) := find_id;
380 res := FMOD_Sound_SetUserData(e_SoundsArray[find_id].Sound, ud);
381 if res <> FMOD_OK then
383 e_SoundsArray[find_id].Sound := nil;
387 e_SoundsArray[find_id].Data := pData;
388 e_SoundsArray[find_id].isMusic := bLoop;
389 e_SoundsArray[find_id].nRefs := 0;
396 function e_PlaySound(ID: DWORD): Integer;
402 if e_SoundsArray[ID].nRefs >= gMaxSimSounds then
410 res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE,
411 e_SoundsArray[ID].Sound, False, Chan);
412 if res <> FMOD_OK then
417 res := FMOD_Channel_SetCallback(Chan, Channel_Callback);
418 if res <> FMOD_OK then
424 res := FMOD_Channel_SetMute(Chan, True);
425 if res <> FMOD_OK then
430 Inc(e_SoundsArray[ID].nRefs);
434 function e_PlaySoundPan(ID: DWORD; Pan: Single): Integer;
440 if e_SoundsArray[ID].nRefs >= gMaxSimSounds then
448 res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE,
449 e_SoundsArray[ID].Sound, False, Chan);
450 if res <> FMOD_OK then
455 res := FMOD_Channel_SetPan(Chan, Pan);
456 if res <> FMOD_OK then
460 res := FMOD_Channel_SetCallback(Chan, Channel_Callback);
461 if res <> FMOD_OK then
467 res := FMOD_Channel_SetMute(Chan, True);
468 if res <> FMOD_OK then
473 Inc(e_SoundsArray[ID].nRefs);
477 function e_PlaySoundVolume(ID: DWORD; Volume: Single): Integer;
483 if e_SoundsArray[ID].nRefs >= gMaxSimSounds then
491 res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE,
492 e_SoundsArray[ID].Sound, False, Chan);
493 if res <> FMOD_OK then
498 res := FMOD_Channel_SetVolume(Chan, Volume);
499 if res <> FMOD_OK then
503 res := FMOD_Channel_SetCallback(Chan, Channel_Callback);
504 if res <> FMOD_OK then
510 res := FMOD_Channel_SetMute(Chan, True);
511 if res <> FMOD_OK then
516 Inc(e_SoundsArray[ID].nRefs);
520 function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Integer;
526 if e_SoundsArray[ID].nRefs >= gMaxSimSounds then
534 res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE,
535 e_SoundsArray[ID].Sound, False, Chan);
536 if res <> FMOD_OK then
541 res := FMOD_Channel_SetPan(Chan, Pan);
542 if res <> FMOD_OK then
546 res := FMOD_Channel_SetVolume(Chan, Volume);
547 if res <> FMOD_OK then
551 res := FMOD_Channel_SetCallback(Chan, Channel_Callback);
552 if res <> FMOD_OK then
558 res := FMOD_Channel_SetMute(Chan, True);
559 if res <> FMOD_OK then
564 Inc(e_SoundsArray[ID].nRefs);
568 procedure e_DeleteSound(ID: DWORD);
574 if e_SoundsArray[ID].Sound = nil then
577 if e_SoundsArray[ID].Data <> nil then
578 FreeMem(e_SoundsArray[ID].Data);
580 res := FMOD_Sound_GetUserData(e_SoundsArray[ID].Sound, ud);
581 if res = FMOD_OK then
586 res := FMOD_Sound_Release(e_SoundsArray[ID].Sound);
587 if res <> FMOD_OK then
589 e_WriteLog('Error releasing sound:', TMsgType.Warning);
590 e_WriteLog(FMOD_ErrorString(res), TMsgType.Warning);
593 e_SoundsArray[ID].Sound := nil;
594 e_SoundsArray[ID].Data := nil;
597 procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean);
605 for i := 0 to N_CHANNELS-1 do
608 res := FMOD_System_GetChannel(F_System, i, Chan);
610 if (res = FMOD_OK) and (Chan <> nil) then
612 res := FMOD_Channel_GetVolume(Chan, vol);
614 if res = FMOD_OK then
619 vol := vol * SoundMod;
621 res := FMOD_Channel_SetVolume(Chan, vol);
623 if res <> FMOD_OK then
631 procedure e_MuteChannels(Enable: Boolean);
638 if Enable = SoundMuted then
641 SoundMuted := Enable;
643 for i := 0 to N_CHANNELS-1 do
646 res := FMOD_System_GetChannel(F_System, i, Chan);
648 if (res = FMOD_OK) and (Chan <> nil) then
650 res := FMOD_Channel_SetMute(Chan, Enable);
652 if res <> FMOD_OK then
659 procedure e_StopChannels();
666 for i := 0 to N_CHANNELS-1 do
669 res := FMOD_System_GetChannel(F_System, i, Chan);
671 if (res = FMOD_OK) and (Chan <> nil) then
673 res := FMOD_Channel_Stop(Chan);
675 if res <> FMOD_OK then
682 procedure e_RemoveAllSounds();
687 for i := 0 to High(e_SoundsArray) do
688 if e_SoundsArray[i].Sound <> nil then
691 SetLength(e_SoundsArray, 0);
692 e_SoundsArray := nil;
695 procedure e_ReleaseSoundSystem();
702 res := FMOD_System_Close(F_System);
703 if res <> FMOD_OK then
705 e_WriteLog('Error closing FMOD system!', TMsgType.Fatal);
706 e_WriteLog(FMOD_ErrorString(res), TMsgType.Fatal);
710 res := FMOD_System_Release(F_System);
711 if res <> FMOD_OK then
713 e_WriteLog('Error releasing FMOD system!', TMsgType.Fatal);
714 e_WriteLog(FMOD_ErrorString(res), TMsgType.Fatal);
718 procedure e_SoundUpdate();
720 FMOD_System_Update(F_System);
725 constructor TBasicSound.Create();
734 destructor TBasicSound.Destroy();
740 procedure TBasicSound.FreeSound();
742 if FID = NO_SOUND_ID then
751 function TBasicSound.RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean;
757 if FID = NO_SOUND_ID then Exit;
759 if e_SoundsArray[FID].nRefs >= gMaxSimSounds then
765 res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE,
766 e_SoundsArray[FID].Sound, False, FChannel);
767 if res <> FMOD_OK then
773 res := FMOD_Channel_SetPosition(FChannel, aPos, FMOD_TIMEUNIT_MS);
774 if res <> FMOD_OK then
781 res := FMOD_Channel_SetPan(FChannel, Pan);
782 if res <> FMOD_OK then
786 res := FMOD_Channel_SetVolume(FChannel, Volume);
787 if res <> FMOD_OK then
791 res := FMOD_Channel_SetCallback(FChannel, Channel_Callback);
792 if res <> FMOD_OK then
798 res := FMOD_Channel_SetMute(FChannel, True);
799 if res <> FMOD_OK then
804 Inc(e_SoundsArray[FID].nRefs);
808 procedure TBasicSound.SetID(ID: DWORD);
812 FMusic := e_SoundsArray[ID].isMusic;
815 function TBasicSound.IsPlaying(): Boolean;
823 if FChannel = nil then
826 res := FMOD_Channel_IsPlaying(FChannel, b);
827 if res <> FMOD_OK then
835 procedure TBasicSound.Stop();
840 if FChannel = nil then
845 res := FMOD_Channel_Stop(FChannel);
846 if res <> FMOD_OK then
853 function TBasicSound.IsPaused(): Boolean;
861 if FChannel = nil then
864 res := FMOD_Channel_GetPaused(FChannel, b);
865 if res <> FMOD_OK then
873 procedure TBasicSound.Pause(Enable: Boolean);
878 if FChannel = nil then
881 res := FMOD_Channel_SetPaused(FChannel, Enable);
882 if res <> FMOD_OK then
888 res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS);
889 if res <> FMOD_OK then
895 function TBasicSound.GetVolume(): Single;
903 if FChannel = nil then
906 res := FMOD_Channel_GetVolume(FChannel, vol);
907 if res <> FMOD_OK then
915 procedure TBasicSound.SetVolume(Volume: Single);
920 if FChannel = nil then
923 res := FMOD_Channel_SetVolume(FChannel, Volume);
924 if res <> FMOD_OK then
929 function TBasicSound.GetPan(): Single;
937 if FChannel = nil then
940 res := FMOD_Channel_GetPan(FChannel, pan);
941 if res <> FMOD_OK then
949 procedure TBasicSound.SetPan(Pan: Single);
954 if FChannel = nil then
957 res := FMOD_Channel_SetPan(FChannel, Pan);
958 if res <> FMOD_OK then
963 function TBasicSound.IsMuted(): Boolean;
971 if FChannel = nil then
974 res := FMOD_Channel_GetMute(FChannel, b);
975 if res <> FMOD_OK then
983 procedure TBasicSound.Mute(Enable: Boolean);
988 if FChannel = nil then
991 res := FMOD_Channel_SetMute(FChannel, Enable);
992 if res <> FMOD_OK then
997 function TBasicSound.GetPosition(): DWORD;
1004 if FChannel = nil then
1007 res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS);
1008 if res <> FMOD_OK then
1013 Result := FPosition;
1016 procedure TBasicSound.SetPosition(aPos: DWORD);
1023 if FChannel = nil then
1026 res := FMOD_Channel_SetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS);
1027 if res <> FMOD_OK then
1032 procedure TBasicSound.SetPriority(priority: Integer);
1037 if (FChannel <> nil) and (FPriority <> priority) and
1038 (priority >= 0) and (priority <= 256) then
1040 FPriority := priority;
1041 res := FMOD_Channel_SetPriority(FChannel, priority);
1042 if res <> FMOD_OK then