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