src/engine/e_soundfile_xmp.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_xmp;
  17
  18 interface
  19
  20 uses e_soundfile, XMP;
  21
  22 type
  23   // a module loader that uses libxmp-lite
  24
  25   TXMPLoader = 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     FXMP: xmp_context;
  35     FLoaded: Boolean;
  36     FLooping: Boolean;
  37     FFinished: Boolean;
  38   end;
  39
  40   TXMPLoaderFactory = class (TSoundLoaderFactory)
  41   public
  42     function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
  43     function MatchExtension(FName: string): Boolean; override;
  44     function GetLoader(): TSoundLoader; override;
  45   end;
  46
  47 implementation
  48
  49 uses sysutils, utils, math, e_sound, e_log;
  50
  51 (* TXMPLoaderFactory *)
  52
  53 function TXMPLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
  54 var
  55   Ctx: xmp_context;
  56   Err: LongInt;
  57 begin
  58   // HACK: these fine gentlemen didn't provide us with a xmp_test_module_from_memory()
  59   //       so just load the module and unload it
  60
  61   Result := False;
  62
  63   Ctx := xmp_create_context();
  64   Err := xmp_load_module_from_memory(Ctx, Data, Len);
  65
  66   if Err = 0 then
  67   begin
  68     xmp_release_module(Ctx);
  69     Result := True;
  70   end;
  71
  72   xmp_free_context(Ctx);
  73 end;
  74
  75 function TXMPLoaderFactory.MatchExtension(FName: string): Boolean;
  76 var
  77   Ext: string;
  78 begin
  79   Ext := GetFilenameExt(FName);
  80   Result := (Ext = '.it') or (Ext = '.xm') or (Ext = '.mod') or (Ext = '.s3m');
  81 end;
  82
  83 function TXMPLoaderFactory.GetLoader(): TSoundLoader;
  84 begin
  85   Result := TXMPLoader.Create();
  86 end;
  87
  88 (* TXMPLoader *)
  89
  90 function TXMPLoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
  91 var
  92   Err: LongInt;
  93   Interp: LongInt;
  94 begin
  95   Result := False;
  96
  97   FLoaded := False;
  98   FXMP := xmp_create_context();
  99   if FXMP = nil then Exit;
 100
 101   try
 102     Err := xmp_load_module_from_memory(FXMP, Data, Len);
 103     if Err <> 0 then
 104       raise Exception.Create('xmp_load_module_from_memory failed');
 105
 106     if xmp_start_player(FXMP, 48000, 0) <> 0 then
 107       raise Exception.Create('xmp_start_player failed');
 108
 109     if e_MusicLerp then Interp := XMP_INTERP_LINEAR
 110     else Interp := XMP_INTERP_NEAREST;
 111     xmp_set_player(FXMP, XMP_PLAYER_INTERP, Interp);
 112
 113     FFormat.SampleRate := 48000;
 114     FFormat.SampleBits := 16;
 115     FFormat.Channels := 2;
 116
 117     FStreaming := True; // modules are always streaming
 118     FLoaded := True;
 119     FLooping := Loop;
 120     FFinished := False;
 121     Result := True;
 122   except
 123     on E: Exception do
 124     begin
 125       e_LogWriteln('TXMPLoader.Load() error: ' + E.Message);
 126       if Err = 0 then xmp_release_module(FXMP);
 127       xmp_free_context(FXMP);
 128       FXMP := nil;
 129     end;
 130   end;
 131 end;
 132
 133 function TXMPLoader.Load(FName: string; Loop: Boolean): Boolean;
 134 var
 135   Err: LongInt;
 136   Interp: LongInt;
 137 begin
 138   Result := False;
 139
 140   FLoaded := False;
 141   FXMP := xmp_create_context();
 142   if FXMP = nil then Exit;
 143
 144   try
 145     Err := xmp_load_module(FXMP, PChar(FName));
 146     if Err <> 0 then
 147       raise Exception.Create('xmp_load_module failed');
 148
 149     if xmp_start_player(FXMP, 48000, 0) <> 0 then
 150       raise Exception.Create('xmp_start_player failed');
 151
 152     if e_MusicLerp then Interp := XMP_INTERP_LINEAR
 153     else Interp := XMP_INTERP_NEAREST;
 154     xmp_set_player(FXMP, XMP_PLAYER_INTERP, Interp);
 155
 156     FFormat.SampleRate := 48000;
 157     FFormat.SampleBits := 16;
 158     FFormat.Channels := 2;
 159
 160     FStreaming := True; // modules are always streaming
 161     FLooping := Loop;
 162     FLoaded := True;
 163     FFinished := False;
 164     Result := True;
 165   except
 166     on E: Exception do
 167     begin
 168       e_LogWritefln('TXMPLoader.Load(%s) error: %s', [FName, E.Message]);
 169       if Err = 0 then xmp_release_module(FXMP);
 170       xmp_free_context(FXMP);
 171       FXMP := nil;
 172     end;
 173   end;
 174 end;
 175
 176 function TXMPLoader.Finished(): Boolean;
 177 begin
 178   Result := FFinished;
 179 end;
 180
 181 function TXMPLoader.Restart(): Boolean;
 182 begin
 183   Result := False;
 184   if FXMP = nil then Exit;
 185   Result := True;
 186   FFinished := False;
 187   xmp_restart_module(FXMP);
 188 end;
 189
 190 function TXMPLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 191 var
 192   Ret: LongInt;
 193 begin
 194   Result := 0;
 195   if FXMP = nil then Exit;
 196
 197   Ret := xmp_play_buffer(FXMP, Buf, Len, IfThen(FLooping, 0, 1));
 198
 199   if Ret = 0 then
 200     Result := Len
 201   else if (Ret = -XMP_END) and not FLooping then
 202     FFinished := True;
 203 end;
 204
 205 procedure TXMPLoader.Free();
 206 begin
 207   if FXMP <> nil then
 208   begin
 209     if FLoaded then
 210     begin
 211       xmp_end_player(FXMP);
 212       xmp_release_module(FXMP);
 213     end;
 214     xmp_free_context(FXMP);
 215     FXMP := nil;
 216   end;
 217   FLoaded := False;
 218   FLooping := False;
 219   FFinished := False;
 220 end;
 221
 222 initialization
 223   e_AddSoundLoader(TXMPLoaderFactory.Create());
 224 end.