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/>.
16 {$INCLUDE ../shared/a_modes.inc}
17 unit e_soundfile_fluid
;
21 uses e_soundfile
, fluidsynth
;
24 // a midi loader that uses fluidsynth
26 TFluidLoader
= class (TSoundLoader
)
28 function Load(Data
: Pointer; Len
: LongWord; SStreaming
: Boolean): Boolean; override; overload
;
29 function Load(FName
: string; SStreaming
: Boolean): Boolean; override; overload
;
30 function SetPosition(Pos
: LongWord): Boolean; override;
31 function FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord; override;
32 function GetAll(var OutPtr
: Pointer): LongWord; override;
33 procedure Free(); override;
36 FSynth
: pfluid_synth_t
;
37 FPlayer
: pfluid_player_t
;
40 TFluidLoaderFactory
= class (TSoundLoaderFactory
)
42 function MatchHeader(Data
: Pointer; Len
: LongWord): Boolean; override;
43 function MatchExtension(FName
: string): Boolean; override;
44 function GetLoader(): TSoundLoader
; override;
48 DEFAULT_SOUNDFONT
= 'data/soundfont.sf2';
52 uses sysutils
, utils
, e_sound
, e_log
, ctypes
{$IFDEF WINDOWS}, windirs
{$ENDIF};
55 FluidSettings
: pfluid_settings_t
= nil;
57 function FindDefaultSoundfont(): string;
60 SfNames
: array [0..1] of string = (
61 // creative soundfonts
69 SysDir
:= GetWindowsSpecialDir(CSIDL_SYSTEM
, False);
70 for I
:= Low(SfNames
) to High(SfNames
) do
72 S
:= SysDir
+ SfNames
[I
];
75 e_LogWriteln('FluidSynth: Found system soundfont ' + S
);
80 Result
:= DEFAULT_SOUNDFONT
;
84 Result
:= DEFAULT_SOUNDFONT
;
88 (* TFluidLoaderFactory *)
90 function TFluidLoaderFactory
.MatchHeader(Data
: Pointer; Len
: LongWord): Boolean;
94 MIDIHDR
= $6468544D; // 'MThd'
97 if Len
< 14 then Exit
; // the header is at least 4+4+6 bytes
99 Result
:= ((P
+0)^ = MIDIHDR
) and ((P
+1)^ <> 0); // header length is not 0
102 function TFluidLoaderFactory
.MatchExtension(FName
: string): Boolean;
106 Ext
:= GetFilenameExt(FName
);
107 Result
:= (Ext
= '.mid') or (Ext
= '.midi');
110 function TFluidLoaderFactory
.GetLoader(): TSoundLoader
;
112 if e_SoundFont
= '' then e_SoundFont
:= FindDefaultSoundfont();
113 Result
:= TFluidLoader
.Create();
118 function TFluidLoader
.Load(Data
: Pointer; Len
: LongWord; SStreaming
: Boolean): Boolean;
125 FSynth
:= new_fluid_synth(FluidSettings
);
127 raise Exception
.Create('new_fluid_synth failed');
128 Ret
:= fluid_synth_sfload(FSynth
, PChar(e_SoundFont
), 1);
129 if Ret
= FLUID_FAILED
then
130 raise Exception
.Create('fluid_synth_sfload failed');
131 FPlayer
:= new_fluid_player(FSynth
);
132 if FPlayer
= nil then
133 raise Exception
.Create('new_fluid_player failed');
134 Ret
:= fluid_player_add_mem(FPlayer
, Data
, Len
);
135 if Ret
= FLUID_FAILED
then
136 raise Exception
.Create('fluid_player_add failed');
137 fluid_player_play(FPlayer
);
141 e_LogWriteln('FluidSynth: Load(Data) failed: ' + E
.Message);
142 if FPlayer
<> nil then delete_fluid_player(FPlayer
);
143 if FSynth
<> nil then delete_fluid_synth(FSynth
);
151 fluid_player_set_loop(FPlayer
, -1);
152 FFormat
.SampleRate
:= 44100;
153 FFormat
.SampleBits
:= 16;
154 FFormat
.Channels
:= 2;
160 function TFluidLoader
.Load(FName
: string; SStreaming
: Boolean): Boolean;
167 FSynth
:= new_fluid_synth(FluidSettings
);
169 raise Exception
.Create('new_fluid_synth failed');
170 Ret
:= fluid_synth_sfload(FSynth
, PChar(e_SoundFont
), 1);
171 if Ret
= FLUID_FAILED
then
172 raise Exception
.Create('fluid_synth_sfload failed');
173 FPlayer
:= new_fluid_player(FSynth
);
174 if FPlayer
= nil then
175 raise Exception
.Create('new_fluid_player failed');
176 Ret
:= fluid_player_add(FPlayer
, PChar(FName
));
177 if Ret
= FLUID_FAILED
then
178 raise Exception
.Create('fluid_player_add failed');
179 fluid_player_play(FPlayer
);
183 e_LogWriteln('FluidSynth: Load(Data) failed: ' + E
.Message);
184 if FPlayer
<> nil then delete_fluid_player(FPlayer
);
185 if FSynth
<> nil then delete_fluid_synth(FSynth
);
193 fluid_player_set_loop(FPlayer
, -1);
194 FFormat
.SampleRate
:= 44100;
195 FFormat
.SampleBits
:= 16;
196 FFormat
.Channels
:= 2;
202 function TFluidLoader
.SetPosition(Pos
: LongWord): Boolean;
204 Result
:= False; // unsupported?
207 function TFluidLoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
212 if (FSynth
= nil) or (FPlayer
= nil) then Exit
;
213 Ret
:= fluid_synth_write_s16(FSynth
, Len
div 4, Buf
, 0, 2, Buf
, 1, 2);
214 if Ret
= FLUID_OK
then Result
:= Len
;
217 function TFluidLoader
.GetAll(var OutPtr
: Pointer): LongWord;
219 Result
:= 0; // midis are always streaming, so this don't make sense
222 procedure TFluidLoader
.Free();
224 if FPlayer
<> nil then
226 fluid_player_stop(FPlayer
);
227 delete_fluid_player(FPlayer
);
229 if FSynth
<> nil then delete_fluid_synth(FSynth
);
235 FluidSettings
:= new_fluid_settings();
236 if FluidSettings
<> nil then
238 fluid_settings_setint(FluidSettings
, PChar('synth.midi-channels'), 16);
239 fluid_settings_setint(FluidSettings
, PChar('synth.cpu-cores'), 1);
240 fluid_settings_setnum(FluidSettings
, PChar('synth.sample-rate'), 44100);
241 fluid_settings_setnum(FluidSettings
, PChar('synth.gain'), 1);
242 fluid_settings_setint(FluidSettings
, PChar('synth.reverb.active'), 0);
243 fluid_settings_setint(FluidSettings
, PChar('synth.chorus.active'), 0);
244 fluid_settings_setstr(FluidSettings
, PChar('player.timing-source'), PChar('sample'));
245 e_AddSoundLoader(TFluidLoaderFactory
.Create());
248 if FluidSettings
<> nil then
249 delete_fluid_settings(FluidSettings
);