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; Loop: Boolean): Boolean; override; overload;
  28     function Load(FName: string; Loop: Boolean): Boolean; override; overload;
  29     function Finished(): Boolean; override;
  30     function Restart(): Boolean; override;
  31     function FillBuffer(Buf: Pointer; Len: LongWord): 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; Loop: 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 Loop then
 150     fluid_player_set_loop(FPlayer, -1);
 151
 152   FFormat.SampleRate := 44100;
 153   FFormat.SampleBits := 16;
 154   FFormat.Channels := 2;
 155   FStreaming := True;
 156
 157   Result := True;
 158 end;
 159
 160 function TFluidLoader.Load(FName: string; Loop: Boolean): Boolean;
 161 var
 162   Ret: cint;
 163 begin
 164   Result := False;
 165
 166   try
 167     FSynth := new_fluid_synth(FluidSettings);
 168     if FSynth = nil then
 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);
 180   except
 181     on E: Exception do
 182     begin
 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);
 186       FPlayer := nil;
 187       FSynth := nil;
 188       Exit;
 189     end;
 190   end;
 191
 192   if Loop then
 193     fluid_player_set_loop(FPlayer, -1);
 194
 195   FFormat.SampleRate := 44100;
 196   FFormat.SampleBits := 16;
 197   FFormat.Channels := 2;
 198   FStreaming := True;
 199
 200   Result := True;
 201 end;
 202
 203 function TFluidLoader.Finished(): Boolean;
 204 begin
 205   Result := fluid_player_get_status(FPlayer) = FLUID_PLAYER_DONE;
 206 end;
 207
 208 function TFluidLoader.Restart(): Boolean;
 209 begin
 210   Result := False;
 211   // fluid_player_seek() is only supported in full 2.x.x, and I ain't compiling that shit
 212   // if (FSynth <> nil) and (FPlayer <> nil) then
 213   // begin
 214   //   fluid_synth_system_reset(FSynth);
 215   //   fluid_player_seek(FPlayer, 0);
 216   //   fluid_player_play(FPlayer);
 217   //   Result := True;
 218   // end;
 219 end;
 220
 221 function TFluidLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 222 var
 223   Ret: cint;
 224 begin
 225   Result := 0;
 226   if (FSynth = nil) or (FPlayer = nil) then Exit;
 227   Ret := fluid_synth_write_s16(FSynth, Len div 4, Buf, 0, 2, Buf, 1, 2);
 228   if Ret = FLUID_OK then Result := Len;
 229 end;
 230
 231 procedure TFluidLoader.Free();
 232 begin
 233   if FPlayer <> nil then
 234   begin
 235     fluid_player_stop(FPlayer);
 236     delete_fluid_player(FPlayer);
 237   end;
 238   if FSynth <> nil then delete_fluid_synth(FSynth);
 239   FPlayer := nil;
 240   FSynth := nil;
 241 end;
 242
 243 initialization
 244   FluidSettings := new_fluid_settings();
 245   if FluidSettings <> nil then
 246   begin
 247     fluid_settings_setint(FluidSettings, PChar('synth.midi-channels'), 16);
 248     fluid_settings_setint(FluidSettings, PChar('synth.cpu-cores'), 1);
 249     fluid_settings_setnum(FluidSettings, PChar('synth.sample-rate'), 44100);
 250     fluid_settings_setnum(FluidSettings, PChar('synth.gain'), 1);
 251     fluid_settings_setint(FluidSettings, PChar('synth.reverb.active'), 0);
 252     fluid_settings_setint(FluidSettings, PChar('synth.chorus.active'), 0);
 253     fluid_settings_setstr(FluidSettings, PChar('player.timing-source'), PChar('sample'));
 254     e_AddSoundLoader(TFluidLoaderFactory.Create());
 255   end;
 256 finalization
 257   if FluidSettings <> nil then
 258     delete_fluid_settings(FluidSettings);
 259 end.
 260