DEADSOFTWARE

fix host error message
[d2df-sdl.git] / 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;
18 interface
20 uses e_soundfile, XMP;
22 type
23 // a module loader that uses libxmp-lite
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;
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;
45 implementation
47 uses sysutils, utils, e_sound, e_log;
49 (* TXMPLoaderFactory *)
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
59 Result := False;
61 Ctx := xmp_create_context();
62 Err := xmp_load_module_from_memory(Ctx, Data, Len);
64 if Err = 0 then
65 begin
66 xmp_release_module(Ctx);
67 Result := True;
68 end;
70 xmp_free_context(Ctx);
71 end;
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;
81 function TXMPLoaderFactory.GetLoader(): TSoundLoader;
82 begin
83 Result := TXMPLoader.Create();
84 end;
86 (* TXMPLoader *)
88 function TXMPLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
89 var
90 Err: LongInt;
91 Interp: LongInt;
92 begin
93 Result := False;
95 FLoaded := False;
96 FXMP := xmp_create_context();
97 if FXMP = nil then Exit;
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');
104 if xmp_start_player(FXMP, 48000, 0) <> 0 then
105 raise Exception.Create('xmp_start_player failed');
107 if e_MusicLerp then Interp := XMP_INTERP_LINEAR
108 else Interp := XMP_INTERP_NEAREST;
109 xmp_set_player(FXMP, XMP_PLAYER_INTERP, Interp);
111 FFormat.SampleRate := 48000;
112 FFormat.SampleBits := 16;
113 FFormat.Channels := 2;
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;
129 function TXMPLoader.Load(FName: string; SStreaming: Boolean): Boolean;
130 var
131 Err: LongInt;
132 Interp: LongInt;
133 begin
134 Result := False;
136 FLoaded := False;
137 FXMP := xmp_create_context();
138 if FXMP = nil then Exit;
140 try
141 Err := xmp_load_module(FXMP, PChar(FName));
142 if Err <> 0 then
143 raise Exception.Create('xmp_load_module failed');
145 if xmp_start_player(FXMP, 48000, 0) <> 0 then
146 raise Exception.Create('xmp_start_player failed');
148 if e_MusicLerp then Interp := XMP_INTERP_LINEAR
149 else Interp := XMP_INTERP_NEAREST;
150 xmp_set_player(FXMP, XMP_PLAYER_INTERP, Interp);
152 FFormat.SampleRate := 48000;
153 FFormat.SampleBits := 16;
154 FFormat.Channels := 2;
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;
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;
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;
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;
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;
211 initialization
212 e_AddSoundLoader(TXMPLoaderFactory.Create());
213 end.