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