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