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 implementation
  51
  52 uses sysutils, utils, e_sound, e_log, ctypes{$IFDEF WINDOWS}, windirs{$ENDIF};
  53
  54 var
  55   FluidSettings: pfluid_settings_t = nil;
  56
  57 function FindDefaultSoundfont(): string;
  58 {$IFDEF WINDOWS}
  59 var
  60   SfNames: array [0..1] of string = (
  61     // creative soundfonts
  62     'ct4mgm.sf2',
  63     'ct2mgm.sf2'
  64     // gm.dls unsupported
  65   );
  66   I: Integer;
  67   SysDir, S: string;
  68 begin
  69   SysDir := GetWindowsSpecialDir(CSIDL_SYSTEM, False);
  70   for I := Low(SfNames) to High(SfNames) do
  71   begin
  72     S := SysDir + SfNames[I];
  73     if FileExists(S) then
  74     begin
  75       e_LogWriteln('FluidSynth: Found system soundfont ' + S);
  76       Result := S;
  77       exit;
  78     end;
  79   end;
  80   Result := DEFAULT_SOUNDFONT;
  81 end;
  82 {$ELSE}
  83 begin
  84   Result := DEFAULT_SOUNDFONT;
  85 end;
  86 {$ENDIF}
  87
  88 (* TFluidLoaderFactory *)
  89
  90 function TFluidLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
  91 var
  92   P: PLongWord;
  93 const
  94   MIDIHDR = $6468544D; // 'MThd'
  95 begin
  96   Result := False;
  97   if Len < 14 then Exit; // the header is at least 4+4+6 bytes
  98   P := Data;
  99   Result := ((P+0)^ = MIDIHDR) and ((P+1)^ <> 0); // header length is not 0
 100 end;
 101
 102 function TFluidLoaderFactory.MatchExtension(FName: string): Boolean;
 103 var
 104   Ext: string;
 105 begin
 106   Ext := GetFilenameExt(FName);
 107   Result := (Ext = '.mid') or (Ext = '.midi');
 108 end;
 109
 110 function TFluidLoaderFactory.GetLoader(): TSoundLoader;
 111 begin
 112   if e_SoundFont = '' then e_SoundFont := FindDefaultSoundfont();
 113   Result := TFluidLoader.Create();
 114 end;
 115
 116 (* TFluidLoader *)
 117
 118 function TFluidLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 119 var
 120   Ret: cint;
 121 begin
 122   Result := False;
 123
 124   try
 125     FSynth := new_fluid_synth(FluidSettings);
 126     if FSynth = nil then
 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);
 138   except
 139     on E: Exception do
 140     begin
 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);
 144       FPlayer := nil;
 145       FSynth := nil;
 146       Exit;
 147     end;
 148   end;
 149
 150   if FLooping then
 151     fluid_player_set_loop(FPlayer, -1);
 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; SStreaming: 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 FLooping then
 193     fluid_player_set_loop(FPlayer, -1);
 194   FFormat.SampleRate := 44100;
 195   FFormat.SampleBits := 16;
 196   FFormat.Channels := 2;
 197   FStreaming := True;
 198
 199   Result := True;
 200 end;
 201
 202 function TFluidLoader.SetPosition(Pos: LongWord): Boolean;
 203 begin
 204   Result := False; // unsupported?
 205 end;
 206
 207 function TFluidLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 208 var
 209   Ret: cint;
 210 begin
 211   Result := 0;
 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;
 215 end;
 216
 217 function TFluidLoader.GetAll(var OutPtr: Pointer): LongWord;
 218 begin
 219   Result := 0; // midis are always streaming, so this don't make sense
 220 end;
 221
 222 procedure TFluidLoader.Free();
 223 begin
 224   if FPlayer <> nil then
 225   begin
 226     fluid_player_stop(FPlayer);
 227     delete_fluid_player(FPlayer);
 228   end;
 229   if FSynth <> nil then delete_fluid_synth(FSynth);
 230   FPlayer := nil;
 231   FSynth := nil;
 232 end;
 233
 234 initialization
 235   FluidSettings := new_fluid_settings();
 236   if FluidSettings <> nil then
 237   begin
 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());
 246   end;
 247 finalization
 248   if FluidSettings <> nil then
 249     delete_fluid_settings(FluidSettings);
 250 end.
 251