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