1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
21 uses e_soundfile
, XMP
;
24 // a module loader that uses libxmp-lite
26 TXMPLoader
= class (TSoundLoader
)
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;
39 TXMPLoaderFactory
= class (TSoundLoaderFactory
)
41 function MatchHeader(Data
: Pointer; Len
: LongWord): Boolean; override;
42 function MatchExtension(FName
: string): Boolean; override;
43 function GetLoader(): TSoundLoader
; override;
48 uses sysutils
, utils
, e_sound
, e_log
;
50 (* TXMPLoaderFactory *)
52 function TXMPLoaderFactory
.MatchHeader(Data
: Pointer; Len
: LongWord): Boolean;
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
62 Ctx
:= xmp_create_context();
63 Err
:= xmp_load_module_from_memory(Ctx
, Data
, Len
);
67 xmp_release_module(Ctx
);
71 xmp_free_context(Ctx
);
74 function TXMPLoaderFactory
.MatchExtension(FName
: string): Boolean;
78 Ext
:= GetFilenameExt(FName
);
79 Result
:= (Ext
= '.it') or (Ext
= '.xm') or (Ext
= '.mod') or (Ext
= '.s3m');
82 function TXMPLoaderFactory
.GetLoader(): TSoundLoader
;
84 Result
:= TXMPLoader
.Create();
89 function TXMPLoader
.Load(Data
: Pointer; Len
: LongWord; SStreaming
: Boolean): Boolean;
97 FXMP
:= xmp_create_context();
98 if FXMP
= nil then Exit
;
101 Err
:= xmp_load_module_from_memory(FXMP
, Data
, Len
);
103 raise Exception
.Create('xmp_load_module_from_memory failed');
105 if xmp_start_player(FXMP
, 48000, 0) <> 0 then
106 raise Exception
.Create('xmp_start_player failed');
108 if e_MusicLerp
then Interp
:= XMP_INTERP_LINEAR
109 else Interp
:= XMP_INTERP_NEAREST
;
110 xmp_set_player(FXMP
, XMP_PLAYER_INTERP
, Interp
);
112 FFormat
.SampleRate
:= 48000;
113 FFormat
.SampleBits
:= 16;
114 FFormat
.Channels
:= 2;
116 FStreaming
:= True; // modules are always streaming
122 e_LogWriteln('TXMPLoader.Load() error: ' + E
.Message);
123 if Err
= 0 then xmp_release_module(FXMP
);
124 xmp_free_context(FXMP
);
130 function TXMPLoader
.Load(FName
: string; SStreaming
: Boolean): Boolean;
138 FXMP
:= xmp_create_context();
139 if FXMP
= nil then Exit
;
142 Err
:= xmp_load_module(FXMP
, PChar(FName
));
144 raise Exception
.Create('xmp_load_module failed');
146 if xmp_start_player(FXMP
, 48000, 0) <> 0 then
147 raise Exception
.Create('xmp_start_player failed');
149 if e_MusicLerp
then Interp
:= XMP_INTERP_LINEAR
150 else Interp
:= XMP_INTERP_NEAREST
;
151 xmp_set_player(FXMP
, XMP_PLAYER_INTERP
, Interp
);
153 FFormat
.SampleRate
:= 48000;
154 FFormat
.SampleBits
:= 16;
155 FFormat
.Channels
:= 2;
157 FStreaming
:= True; // modules are always streaming
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
);
171 function TXMPLoader
.SetPosition(Pos
: LongWord): Boolean;
174 if FXMP
= nil then Exit
;
175 Result
:= xmp_set_position(FXMP
, Pos
) = 0;
178 function TXMPLoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
183 if FXMP
= nil then Exit
;
188 if xmp_play_buffer(FXMP
, Buf
, Len
, LoopN
) = 0 then
192 function TXMPLoader
.GetAll(var OutPtr
: Pointer): LongWord;
194 Result
:= 0; // modules are always streaming, so this don't make sense
197 procedure TXMPLoader
.Free();
203 xmp_end_player(FXMP
);
204 xmp_release_module(FXMP
);
206 xmp_free_context(FXMP
);
213 e_AddSoundLoader(TXMPLoaderFactory
.Create());