src/engine/e_soundfile_modplug.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_modplug;
  18
  19 interface
  20
  21 uses e_soundfile, modplug;
  22
  23 type
  24   // a module loader that uses libmodplug
  25
  26   TModPlugLoader = 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   private
  35     FFile: PModPlugFile;
  36   end;
  37
  38   TModPlugLoaderFactory = class (TSoundLoaderFactory)
  39   public
  40     function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
  41     function MatchExtension(FName: string): Boolean; override;
  42     function GetLoader(): TSoundLoader; override;
  43   end;
  44
  45 implementation
  46
  47 uses sysutils, utils, e_sound, e_log, classes;
  48
  49 var
  50   Settings: ModPlug_Settings = (
  51     mFlags            : MODPLUG_ENABLE_OVERSAMPLING or MODPLUG_ENABLE_NOISE_REDUCTION;
  52     mChannels         : 2;
  53     mBits             : 16;
  54     mFrequency        : 44100;
  55     mResamplingMode   : MODPLUG_RESAMPLE_LINEAR;
  56     mStereoSeparation : 128;
  57     mMaxMixChannels   : 32;
  58     mReverbDepth      : 0;
  59     mReverbDelay      : 0;
  60     mBassAmount       : 0;
  61     mBassRange        : 0;
  62     mSurroundDepth    : 0;
  63     mSurroundDelay    : 0;
  64     mLoopCount        : -1;
  65   );
  66
  67 (* TModPlugLoaderFactory *)
  68
  69 function TModPlugLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
  70 var
  71   Mpf: PModPlugFile;
  72 begin
  73   // HACK: there's no "test" function in modplug, so just try to load that shit
  74   Result := False;
  75
  76   Mpf := ModPlug_Load(Data, Len);
  77   if Mpf = nil then Exit;
  78   ModPlug_Unload(Mpf);
  79
  80   Result := True;
  81 end;
  82
  83 function TModPlugLoaderFactory.MatchExtension(FName: string): Boolean;
  84 var
  85   Ext: string;
  86 begin
  87   Ext := GetFilenameExt(FName);
  88   Result := (Ext = '.it') or (Ext = '.xm') or (Ext = '.mod') or (Ext = '.s3m');
  89 end;
  90
  91 function TModPlugLoaderFactory.GetLoader(): TSoundLoader;
  92 begin
  93   // update interpolation setting
  94   if e_MusicLerp then
  95     Settings.mResamplingMode := MODPLUG_RESAMPLE_LINEAR
  96   else
  97     Settings.mResamplingMode := MODPLUG_RESAMPLE_NEAREST;
  98   ModPlug_SetSettings(@Settings);
  99   Result := TModPlugLoader.Create();
 100 end;
 101
 102 (* TModPlugLoader *)
 103
 104 function TModPlugLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 105 begin
 106   Result := False;
 107
 108   FFile := ModPlug_Load(Data, Len);
 109   if FFile = nil then
 110   begin
 111     e_LogWriteln('ModPlug: ERROR: ModPlug_Load failed');
 112     Exit;
 113   end;
 114
 115   FFormat.SampleRate := 44100;
 116   FFormat.SampleBits := 16;
 117   FFormat.Channels := 2;
 118   FStreaming := True; // modules are always streaming
 119
 120   Result := True;
 121 end;
 122
 123 function TModPlugLoader.Load(FName: string; SStreaming: Boolean): Boolean;
 124 var
 125   S: TStream = nil;
 126   Data: Pointer;
 127   Len: LongInt;
 128 begin
 129   Result := False;
 130
 131   try
 132     S := openDiskFileRO(FName);
 133     // ayy just read the entire file
 134     Data := GetMem(S.Size);
 135     if Data = nil then
 136       raise Exception.Create('out of memory');
 137     Len := S.Read(Data^, S.Size);
 138     if Len < 0 then
 139       raise Exception.Create('what the fuck');
 140     Result := Load(Data, Len, SStreaming)
 141   except
 142     on E: Exception do
 143       e_LogWritefln('ModPlug: ERROR: could not read file `%s`: %s', [FName, E.Message]);
 144   end;
 145
 146   if Data <> nil then FreeMem(Data);
 147   if S <> nil then S.Free();
 148 end;
 149
 150 function TModPlugLoader.SetPosition(Pos: LongWord): Boolean;
 151 begin
 152   Result := False;
 153   if FFile = nil then Exit;
 154   ModPlug_Seek(FFile, Pos);
 155   Result := True;
 156 end;
 157
 158 function TModPlugLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 159 var
 160   Cnt: LongInt;
 161 begin
 162   Result := 0;
 163   if FFile = nil then Exit;
 164
 165   Cnt := ModPlug_Read(FFile, Buf, Len);
 166   if Cnt < 0 then Exit;
 167
 168   if FLooping and (Cnt < Len) then
 169   begin
 170     // assume it just ended and restart, because modplug only loops if the
 171     // module tells it to
 172     ModPlug_Seek(FFile, 0);
 173     // this used to be Result := Cnt + Read(FFile, Buf + Cnt, Len - Cnt)
 174     // but the difference appears to be negligible
 175     Result := ModPlug_Read(FFile, Buf, Len);
 176   end
 177   else
 178     Result := Len;
 179 end;
 180
 181 function TModPlugLoader.GetAll(var OutPtr: Pointer): LongWord;
 182 begin
 183   Result := 0; // modules are always streaming, so this don't make sense
 184 end;
 185
 186 procedure TModPlugLoader.Free();
 187 begin
 188   if FFile <> nil then
 189   begin
 190     ModPlug_Unload(FFile);
 191     FFile := nil;
 192   end;
 193 end;
 194
 195 initialization
 196   e_AddSoundLoader(TModPlugLoaderFactory.Create());
 197 end.