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';
51 e_Soundfont
: string = '';
55 uses sysutils
, utils
, e_sound
, e_log
, ctypes
{$IFDEF WINDOWS}, windirs
{$ENDIF};
58 FluidSettings
: pfluid_settings_t
= nil;
60 function FindDefaultSoundfont(): string;
63 SfNames
: array [0..1] of string = (
64 // creative soundfonts
72 SysDir
:= GetWindowsSpecialDir(CSIDL_SYSTEM
, False);
73 for I
:= Low(SfNames
) to High(SfNames
) do
75 S
:= SysDir
+ SfNames
[I
];
78 e_LogWriteln('FluidSynth: Found system soundfont ' + S
);
83 Result
:= DEFAULT_SOUNDFONT
;
87 Result
:= DEFAULT_SOUNDFONT
;
91 (* TFluidLoaderFactory *)
93 function TFluidLoaderFactory
.MatchHeader(Data
: Pointer; Len
: LongWord): Boolean;
97 MIDIHDR
= $6468544D; // 'MThd'
100 if Len
< 14 then Exit
; // the header is at least 4+4+6 bytes
102 Result
:= ((P
+0)^ = MIDIHDR
) and ((P
+1)^ <> 0); // header length is not 0
105 function TFluidLoaderFactory
.MatchExtension(FName
: string): Boolean;
109 Ext
:= GetFilenameExt(FName
);
110 Result
:= (Ext
= '.mid') or (Ext
= '.midi');
113 function TFluidLoaderFactory
.GetLoader(): TSoundLoader
;
115 if e_Soundfont
= '' then e_Soundfont
:= FindDefaultSoundfont();
116 Result
:= TFluidLoader
.Create();
121 function TFluidLoader
.Load(Data
: Pointer; Len
: LongWord; SStreaming
: Boolean): Boolean;
128 FSynth
:= new_fluid_synth(FluidSettings
);
130 raise Exception
.Create('new_fluid_synth failed');
131 Ret
:= fluid_synth_sfload(FSynth
, PChar(e_Soundfont
), 1);
132 if Ret
= FLUID_FAILED
then
133 raise Exception
.Create('fluid_synth_sfload failed');
134 FPlayer
:= new_fluid_player(FSynth
);
135 if FPlayer
= nil then
136 raise Exception
.Create('new_fluid_player failed');
137 Ret
:= fluid_player_add_mem(FPlayer
, Data
, Len
);
138 if Ret
= FLUID_FAILED
then
139 raise Exception
.Create('fluid_player_add failed');
140 fluid_player_play(FPlayer
);
144 e_LogWriteln('FluidSynth: Load(Data) failed: ' + E
.Message);
145 if FPlayer
<> nil then delete_fluid_player(FPlayer
);
146 if FSynth
<> nil then delete_fluid_synth(FSynth
);
154 fluid_player_set_loop(FPlayer
, -1);
155 FFormat
.SampleRate
:= 44100;
156 FFormat
.SampleBits
:= 16;
157 FFormat
.Channels
:= 2;
163 function TFluidLoader
.Load(FName
: string; SStreaming
: Boolean): Boolean;
170 FSynth
:= new_fluid_synth(FluidSettings
);
172 raise Exception
.Create('new_fluid_synth failed');
173 Ret
:= fluid_synth_sfload(FSynth
, PChar(e_Soundfont
), 1);
174 if Ret
= FLUID_FAILED
then
175 raise Exception
.Create('fluid_synth_sfload failed');
176 FPlayer
:= new_fluid_player(FSynth
);
177 if FPlayer
= nil then
178 raise Exception
.Create('new_fluid_player failed');
179 Ret
:= fluid_player_add(FPlayer
, PChar(FName
));
180 if Ret
= FLUID_FAILED
then
181 raise Exception
.Create('fluid_player_add failed');
182 fluid_player_play(FPlayer
);
186 e_LogWriteln('FluidSynth: Load(Data) failed: ' + E
.Message);
187 if FPlayer
<> nil then delete_fluid_player(FPlayer
);
188 if FSynth
<> nil then delete_fluid_synth(FSynth
);
196 fluid_player_set_loop(FPlayer
, -1);
197 FFormat
.SampleRate
:= 44100;
198 FFormat
.SampleBits
:= 16;
199 FFormat
.Channels
:= 2;
205 function TFluidLoader
.SetPosition(Pos
: LongWord): Boolean;
207 Result
:= False; // unsupported?
210 function TFluidLoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
215 if (FSynth
= nil) or (FPlayer
= nil) then Exit
;
216 Ret
:= fluid_synth_write_s16(FSynth
, Len
div 4, Buf
, 0, 2, Buf
, 1, 2);
217 if Ret
= FLUID_OK
then Result
:= Len
;
220 function TFluidLoader
.GetAll(var OutPtr
: Pointer): LongWord;
222 Result
:= 0; // midis are always streaming, so this don't make sense
225 procedure TFluidLoader
.Free();
227 if FPlayer
<> nil then
229 fluid_player_stop(FPlayer
);
230 delete_fluid_player(FPlayer
);
232 if FSynth
<> nil then delete_fluid_synth(FSynth
);
238 FluidSettings
:= new_fluid_settings();
239 if FluidSettings
<> nil then
241 fluid_settings_setint(FluidSettings
, PChar('synth.midi-channels'), 16);
242 fluid_settings_setint(FluidSettings
, PChar('synth.cpu-cores'), 0);
243 fluid_settings_setnum(FluidSettings
, PChar('synth.sample-rate'), 44100);
244 fluid_settings_setnum(FluidSettings
, PChar('synth.gain'), 1);
245 fluid_settings_setstr(FluidSettings
, PChar('player.timing-source'), PChar('sample'));
246 e_AddSoundLoader(TFluidLoaderFactory
.Create());
249 if FluidSettings
<> nil then
250 delete_fluid_settings(FluidSettings
);