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