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;
96 FXMP
:= xmp_create_context();
97 if FXMP
= nil then Exit
;
100 Err
:= xmp_load_module_from_memory(FXMP
, Data
, Len
);
102 raise Exception
.Create('xmp_load_module_from_memory failed');
104 if xmp_start_player(FXMP
, 48000, 0) <> 0 then
105 raise Exception
.Create('xmp_start_player failed');
107 FFormat
.SampleRate
:= 48000;
108 FFormat
.SampleBits
:= 16;
109 FFormat
.Channels
:= 2;
111 FStreaming
:= True; // modules are always streaming
117 e_LogWriteln('TXMPLoader.Load() error: ' + E
.Message);
118 if Err
= 0 then xmp_release_module(FXMP
);
119 xmp_free_context(FXMP
);
125 function TXMPLoader
.Load(FName
: string; SStreaming
: Boolean): Boolean;
132 FXMP
:= xmp_create_context();
133 if FXMP
= nil then Exit
;
136 Err
:= xmp_load_module(FXMP
, PChar(FName
));
138 raise Exception
.Create('xmp_load_module failed');
140 if xmp_start_player(FXMP
, 48000, 0) <> 0 then
141 raise Exception
.Create('xmp_start_player failed');
143 FFormat
.SampleRate
:= 48000;
144 FFormat
.SampleBits
:= 16;
145 FFormat
.Channels
:= 2;
147 FStreaming
:= True; // modules are always streaming
153 e_LogWritefln('TXMPLoader.Load(%s) error: %s', [FName
, E
.Message]);
154 if Err
= 0 then xmp_release_module(FXMP
);
155 xmp_free_context(FXMP
);
161 function TXMPLoader
.SetPosition(Pos
: LongWord): Boolean;
164 if FXMP
= nil then Exit
;
165 Result
:= xmp_set_position(FXMP
, Pos
) = 0;
168 function TXMPLoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
173 if FXMP
= nil then Exit
;
178 if xmp_play_buffer(FXMP
, Buf
, Len
, LoopN
) = 0 then
182 function TXMPLoader
.GetAll(var OutPtr
: Pointer): LongWord;
184 Result
:= 0; // modules are always streaming, so this don't make sense
187 procedure TXMPLoader
.Free();
193 xmp_end_player(FXMP
);
194 xmp_release_module(FXMP
);
196 xmp_free_context(FXMP
);
203 e_AddSoundLoader(TXMPLoaderFactory
.Create());