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   ModPlug_SetSettings(@Settings); // update settings just in case
  94   Result := TModPlugLoader.Create();
  95 end;
  96
  97 (* TModPlugLoader *)
  98
  99 function TModPlugLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 100 begin
 101   Result := False;
 102
 103   FFile := ModPlug_Load(Data, Len);
 104   if FFile = nil then
 105   begin
 106     e_LogWriteln('ModPlug: ERROR: ModPlug_Load failed');
 107     Exit;
 108   end;
 109
 110   FFormat.SampleRate := 44100;
 111   FFormat.SampleBits := 16;
 112   FFormat.Channels := 2;
 113   FStreaming := True; // modules are always streaming
 114
 115   Result := True;
 116 end;
 117
 118 function TModPlugLoader.Load(FName: string; SStreaming: Boolean): Boolean;
 119 var
 120   S: TStream = nil;
 121   Data: Pointer;
 122   Len: LongInt;
 123 begin
 124   Result := False;
 125
 126   try
 127     S := openDiskFileRO(FName);
 128     // ayy just read the entire file
 129     Data := GetMem(S.Size);
 130     if Data = nil then
 131       raise Exception.Create('out of memory');
 132     Len := S.Read(Data^, S.Size);
 133     if Len < 0 then
 134       raise Exception.Create('what the fuck');
 135     Result := Load(Data, Len, SStreaming)
 136   except
 137     on E: Exception do
 138       e_LogWritefln('ModPlug: ERROR: could not read file `%s`: %s', [FName, E.Message]);
 139   end;
 140
 141   if Data <> nil then FreeMem(Data);
 142   if S <> nil then S.Free();
 143 end;
 144
 145 function TModPlugLoader.SetPosition(Pos: LongWord): Boolean;
 146 begin
 147   Result := False;
 148   if FFile = nil then Exit;
 149   ModPlug_Seek(FFile, Pos);
 150   Result := True;
 151 end;
 152
 153 function TModPlugLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 154 var
 155   Cnt: LongInt;
 156 begin
 157   Result := 0;
 158   if FFile = nil then Exit;
 159
 160   Cnt := ModPlug_Read(FFile, Buf, Len);
 161   if Cnt < 0 then Exit;
 162
 163   if FLooping and (Cnt < Len) then
 164   begin
 165     // assume it just ended and restart, because modplug only loops if the
 166     // module tells it to
 167     ModPlug_Seek(FFile, 0);
 168     // this used to be Result := Cnt + Read(FFile, Buf + Cnt, Len - Cnt)
 169     // but the difference appears to be negligible
 170     Result := ModPlug_Read(FFile, Buf, Len);
 171   end
 172   else
 173     Result := Len;
 174 end;
 175
 176 function TModPlugLoader.GetAll(var OutPtr: Pointer): LongWord;
 177 begin
 178   Result := 0; // modules are always streaming, so this don't make sense
 179 end;
 180
 181 procedure TModPlugLoader.Free();
 182 begin
 183   if FFile <> nil then
 184   begin
 185     ModPlug_Unload(FFile);
 186     FFile := nil;
 187   end;
 188 end;
 189
 190 initialization
 191   e_AddSoundLoader(TModPlugLoaderFactory.Create());
 192 end.