src/engine/e_soundfile_fluid.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   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.
   6  *
   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.
  11  *
  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/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit e_soundfile_fluid;
  17
  18 interface
  19
  20 uses e_soundfile, fluidsynth;
  21
  22 type
  23   // a midi loader that uses fluidsynth
  24
  25   TFluidLoader = class (TSoundLoader)
  26   public
  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;
  33
  34   private
  35     FSynth: pfluid_synth_t;
  36     FPlayer: pfluid_player_t;
  37   end;
  38
  39   TFluidLoaderFactory = class (TSoundLoaderFactory)
  40   public
  41     function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
  42     function MatchExtension(FName: string): Boolean; override;
  43     function GetLoader(): TSoundLoader; override;
  44   end;
  45
  46 const
  47   DEFAULT_SOUNDFONT = 'data/soundfont.sf2';
  48
  49 implementation
  50
  51 uses sysutils, utils, e_sound, e_log, ctypes{$IFDEF WINDOWS}, windirs{$ENDIF};
  52
  53 var
  54   FluidSettings: pfluid_settings_t = nil;
  55
  56 function FindDefaultSoundfont(): string;
  57 {$IFDEF WINDOWS}
  58 var
  59   SfNames: array [0..1] of string = (
  60     // creative soundfonts
  61     'ct4mgm.sf2',
  62     'ct2mgm.sf2'
  63     // gm.dls unsupported
  64   );
  65   I: Integer;
  66   SysDir, S: string;
  67 begin
  68   SysDir := GetWindowsSpecialDir(CSIDL_SYSTEM, False);
  69   for I := Low(SfNames) to High(SfNames) do
  70   begin
  71     S := SysDir + SfNames[I];
  72     if FileExists(S) then
  73     begin
  74       e_LogWriteln('FluidSynth: Found system soundfont ' + S);
  75       Result := S;
  76       exit;
  77     end;
  78   end;
  79   Result := DEFAULT_SOUNDFONT;
  80 end;
  81 {$ELSE}
  82 begin
  83   Result := DEFAULT_SOUNDFONT;
  84 end;
  85 {$ENDIF}
  86
  87 (* TFluidLoaderFactory *)
  88
  89 function TFluidLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
  90 var
  91   P: PLongWord;
  92 const
  93   MIDIHDR = $6468544D; // 'MThd'
  94 begin
  95   Result := False;
  96   if Len < 14 then Exit; // the header is at least 4+4+6 bytes
  97   P := Data;
  98   Result := ((P+0)^ = MIDIHDR) and ((P+1)^ <> 0); // header length is not 0
  99 end;
 100
 101 function TFluidLoaderFactory.MatchExtension(FName: string): Boolean;
 102 var
 103   Ext: string;
 104 begin
 105   Ext := GetFilenameExt(FName);
 106   Result := (Ext = '.mid') or (Ext = '.midi');
 107 end;
 108
 109 function TFluidLoaderFactory.GetLoader(): TSoundLoader;
 110 begin
 111   if e_SoundFont = '' then e_SoundFont := FindDefaultSoundfont();
 112   Result := TFluidLoader.Create();
 113 end;
 114
 115 (* TFluidLoader *)
 116
 117 function TFluidLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 118 var
 119   Ret: cint;
 120 begin
 121   Result := False;
 122
 123   try
 124     FSynth := new_fluid_synth(FluidSettings);
 125     if FSynth = nil then
 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);
 137   except
 138     on E: Exception do
 139     begin
 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);
 143       FPlayer := nil;
 144       FSynth := nil;
 145       Exit;
 146     end;
 147   end;
 148
 149   if FLooping then
 150     fluid_player_set_loop(FPlayer, -1);
 151   FFormat.SampleRate := 44100;
 152   FFormat.SampleBits := 16;
 153   FFormat.Channels := 2;
 154   FStreaming := True;
 155
 156   Result := True;
 157 end;
 158
 159 function TFluidLoader.Load(FName: string; SStreaming: Boolean): Boolean;
 160 var
 161   Ret: cint;
 162 begin
 163   Result := False;
 164
 165   try
 166     FSynth := new_fluid_synth(FluidSettings);
 167     if FSynth = nil then
 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);
 179   except
 180     on E: Exception do
 181     begin
 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);
 185       FPlayer := nil;
 186       FSynth := nil;
 187       Exit;
 188     end;
 189   end;
 190
 191   if FLooping then
 192     fluid_player_set_loop(FPlayer, -1);
 193   FFormat.SampleRate := 44100;
 194   FFormat.SampleBits := 16;
 195   FFormat.Channels := 2;
 196   FStreaming := True;
 197
 198   Result := True;
 199 end;
 200
 201 function TFluidLoader.SetPosition(Pos: LongWord): Boolean;
 202 begin
 203   Result := False; // unsupported?
 204 end;
 205
 206 function TFluidLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 207 var
 208   Ret: cint;
 209 begin
 210   Result := 0;
 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;
 214 end;
 215
 216 function TFluidLoader.GetAll(var OutPtr: Pointer): LongWord;
 217 begin
 218   Result := 0; // midis are always streaming, so this don't make sense
 219 end;
 220
 221 procedure TFluidLoader.Free();
 222 begin
 223   if FPlayer <> nil then
 224   begin
 225     fluid_player_stop(FPlayer);
 226     delete_fluid_player(FPlayer);
 227   end;
 228   if FSynth <> nil then delete_fluid_synth(FSynth);
 229   FPlayer := nil;
 230   FSynth := nil;
 231 end;
 232
 233 initialization
 234   FluidSettings := new_fluid_settings();
 235   if FluidSettings <> nil then
 236   begin
 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());
 245   end;
 246 finalization
 247   if FluidSettings <> nil then
 248     delete_fluid_settings(FluidSettings);
 249 end.
 250