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