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}
16 unit e_soundfile_fluid
;
20 uses e_soundfile
, fluidsynth
;
23 // a midi loader that uses fluidsynth
25 TFluidLoader
= class (TSoundLoader
)
27 function Load(Data
: Pointer; Len
: LongWord; SStreaming
: Boolean): Boolean; override; overload
;
28 function Load(FName
: string; SStreaming
: Boolean): Boolean; override; overload
;
29 function SetPosition(Pos
: LongWord): Boolean; override;
30 function FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord; override;
31 function GetAll(var OutPtr
: Pointer): LongWord; override;
32 procedure Free(); override;
35 FSynth
: pfluid_synth_t
;
36 FPlayer
: pfluid_player_t
;
39 TFluidLoaderFactory
= class (TSoundLoaderFactory
)
41 function MatchHeader(Data
: Pointer; Len
: LongWord): Boolean; override;
42 function MatchExtension(FName
: string): Boolean; override;
43 function GetLoader(): TSoundLoader
; override;
47 DEFAULT_SOUNDFONT
= 'data/soundfont.sf2';
51 uses sysutils
, utils
, e_sound
, e_log
, ctypes
{$IFDEF WINDOWS}, windirs
{$ENDIF};
54 FluidSettings
: pfluid_settings_t
= nil;
56 function FindDefaultSoundfont(): string;
59 SfNames
: array [0..1] of string = (
60 // creative soundfonts
68 SysDir
:= GetWindowsSpecialDir(CSIDL_SYSTEM
, False);
69 for I
:= Low(SfNames
) to High(SfNames
) do
71 S
:= SysDir
+ SfNames
[I
];
74 e_LogWriteln('FluidSynth: Found system soundfont ' + S
);
79 Result
:= DEFAULT_SOUNDFONT
;
83 Result
:= DEFAULT_SOUNDFONT
;
87 (* TFluidLoaderFactory *)
89 function TFluidLoaderFactory
.MatchHeader(Data
: Pointer; Len
: LongWord): Boolean;
93 MIDIHDR
= $6468544D; // 'MThd'
96 if Len
< 14 then Exit
; // the header is at least 4+4+6 bytes
98 Result
:= ((P
+0)^ = MIDIHDR
) and ((P
+1)^ <> 0); // header length is not 0
101 function TFluidLoaderFactory
.MatchExtension(FName
: string): Boolean;
105 Ext
:= GetFilenameExt(FName
);
106 Result
:= (Ext
= '.mid') or (Ext
= '.midi');
109 function TFluidLoaderFactory
.GetLoader(): TSoundLoader
;
111 if e_SoundFont
= '' then e_SoundFont
:= FindDefaultSoundfont();
112 Result
:= TFluidLoader
.Create();
117 function TFluidLoader
.Load(Data
: Pointer; Len
: LongWord; SStreaming
: Boolean): Boolean;
124 FSynth
:= new_fluid_synth(FluidSettings
);
126 raise Exception
.Create('new_fluid_synth failed');
127 Ret
:= fluid_synth_sfload(FSynth
, PChar(e_SoundFont
), 1);
128 if Ret
= FLUID_FAILED
then
129 raise Exception
.Create('fluid_synth_sfload failed');
130 FPlayer
:= new_fluid_player(FSynth
);
131 if FPlayer
= nil then
132 raise Exception
.Create('new_fluid_player failed');
133 Ret
:= fluid_player_add_mem(FPlayer
, Data
, Len
);
134 if Ret
= FLUID_FAILED
then
135 raise Exception
.Create('fluid_player_add failed');
136 fluid_player_play(FPlayer
);
140 e_LogWriteln('FluidSynth: Load(Data) failed: ' + E
.Message);
141 if FPlayer
<> nil then delete_fluid_player(FPlayer
);
142 if FSynth
<> nil then delete_fluid_synth(FSynth
);
150 fluid_player_set_loop(FPlayer
, -1);
151 FFormat
.SampleRate
:= 44100;
152 FFormat
.SampleBits
:= 16;
153 FFormat
.Channels
:= 2;
159 function TFluidLoader
.Load(FName
: string; SStreaming
: Boolean): Boolean;
166 FSynth
:= new_fluid_synth(FluidSettings
);
168 raise Exception
.Create('new_fluid_synth failed');
169 Ret
:= fluid_synth_sfload(FSynth
, PChar(e_SoundFont
), 1);
170 if Ret
= FLUID_FAILED
then
171 raise Exception
.Create('fluid_synth_sfload failed');
172 FPlayer
:= new_fluid_player(FSynth
);
173 if FPlayer
= nil then
174 raise Exception
.Create('new_fluid_player failed');
175 Ret
:= fluid_player_add(FPlayer
, PChar(FName
));
176 if Ret
= FLUID_FAILED
then
177 raise Exception
.Create('fluid_player_add failed');
178 fluid_player_play(FPlayer
);
182 e_LogWriteln('FluidSynth: Load(Data) failed: ' + E
.Message);
183 if FPlayer
<> nil then delete_fluid_player(FPlayer
);
184 if FSynth
<> nil then delete_fluid_synth(FSynth
);
192 fluid_player_set_loop(FPlayer
, -1);
193 FFormat
.SampleRate
:= 44100;
194 FFormat
.SampleBits
:= 16;
195 FFormat
.Channels
:= 2;
201 function TFluidLoader
.SetPosition(Pos
: LongWord): Boolean;
203 Result
:= False; // unsupported?
206 function TFluidLoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
211 if (FSynth
= nil) or (FPlayer
= nil) then Exit
;
212 Ret
:= fluid_synth_write_s16(FSynth
, Len
div 4, Buf
, 0, 2, Buf
, 1, 2);
213 if Ret
= FLUID_OK
then Result
:= Len
;
216 function TFluidLoader
.GetAll(var OutPtr
: Pointer): LongWord;
218 Result
:= 0; // midis are always streaming, so this don't make sense
221 procedure TFluidLoader
.Free();
223 if FPlayer
<> nil then
225 fluid_player_stop(FPlayer
);
226 delete_fluid_player(FPlayer
);
228 if FSynth
<> nil then delete_fluid_synth(FSynth
);
234 FluidSettings
:= new_fluid_settings();
235 if FluidSettings
<> nil then
237 fluid_settings_setint(FluidSettings
, PChar('synth.midi-channels'), 16);
238 fluid_settings_setint(FluidSettings
, PChar('synth.cpu-cores'), 1);
239 fluid_settings_setnum(FluidSettings
, PChar('synth.sample-rate'), 44100);
240 fluid_settings_setnum(FluidSettings
, PChar('synth.gain'), 1);
241 fluid_settings_setint(FluidSettings
, PChar('synth.reverb.active'), 0);
242 fluid_settings_setint(FluidSettings
, PChar('synth.chorus.active'), 0);
243 fluid_settings_setstr(FluidSettings
, PChar('player.timing-source'), PChar('sample'));
244 e_AddSoundLoader(TFluidLoaderFactory
.Create());
247 if FluidSettings
<> nil then
248 delete_fluid_settings(FluidSettings
);