DEADSOFTWARE

oops. add vampimg.inc.
[d2df-sdl.git] / src / engine / e_soundfile_mp3.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_mp3;
18 interface
20 uses e_soundfile, mpg123, classes;
22 type
23 // an MP3 loader that uses libmpg123
25 TMP3Loader = 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;
34 private
35 FMPG: pmpg123_handle;
36 FData: TStream;
37 FBuf: Pointer;
38 FAllSamples: Pointer;
39 FOpen: Boolean;
41 function LoadStream(Stream: TStream; SStreaming: Boolean): Boolean;
42 end;
44 TMP3LoaderFactory = class (TSoundLoaderFactory)
45 public
46 function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
47 function MatchExtension(FName: string): Boolean; override;
48 function GetLoader(): TSoundLoader; override;
49 end;
51 implementation
53 uses sysutils, utils, e_sound, e_log, ctypes, xstreams;
55 (* Reader functions for mpg123_replace_reader_handle *)
57 function streamLSeek(h: Pointer; off: coff_t; whence: cint): coff_t; cdecl;
58 var
59 S: TStream;
60 begin
61 S:= TStream(h);
62 try
63 case whence of
64 0: Result := s.Seek(off, soBeginning); // SEEK_SET
65 1: Result := s.Seek(off, soCurrent); // SEEK_CUR
66 2: Result := s.Seek(off, soEnd); // SEEK_END
67 end;
68 except
69 Result := -1;
70 end;
71 end;
73 function streamRead(h: Pointer; buf: Pointer; len: csize_t): csize_t; cdecl; // ssize_t
74 var
75 S: TStream;
76 begin
77 S:= TStream(h);
78 try
79 Result := S.Read(buf^, len);
80 except
81 Result := csize_t(-1);
82 end;
83 end;
85 (* TMP3LoaderFactory *)
88 function TMP3LoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
89 var
90 P: PByte;
91 N: LongInt;
92 begin
93 Result := False;
94 if Len < 10 then Exit; // way too short even without an ID3
96 P := PByte(Data);
98 // try to check for an ID3v2 header
99 if ((P+0)^ = $49) and ((P+1)^ = $44) and ((P+2)^ = $33) then // 'ID3'
100 begin
101 N := (P+9)^ + ((P+8)^ shl 7) + ((P+7)^ shl 14) + ((P+6)^ shl 21);
102 Result := Len > (N + 10);
103 if Result then Exit;
104 end;
106 // try to read the frame sync word, bits 0-10 should be 1
107 if ((P+0)^ = $FF) and (((P+1)^ and $E0) = $E0) then
108 begin
109 // bits 11-12: mpeg version, can't be 01
110 if (((P+1)^ and $10) = 0) and (((P+1)^ and $08) = $08) then
111 Exit;
112 // bits 13-14: layer: can't be 00
113 if ((P+1)^ and $06) = 0 then
114 Exit;
115 // bits 16-19: bitrate index: can't be 1111 or 0000
116 if (((P+2)^ and $F0) = 0) or (((P+2)^ and $F0) = $F0) then
117 Exit;
118 // bits 20-21: samplerate index: can't be 11
119 if ((P+2)^ and $0C) = $0C then
120 Exit;
121 // this is probably an MP3 then
122 Result := True;
123 end;
124 end;
126 function TMP3LoaderFactory.MatchExtension(FName: string): Boolean;
127 var
128 Ext: string;
129 begin
130 Ext := GetFilenameExt(FName);
131 Result := (Ext = '.mp3') or (Ext = '.mpeg3');
132 end;
134 function TMP3LoaderFactory.GetLoader(): TSoundLoader;
135 begin
136 Result := TMP3Loader.Create();
137 end;
139 (* TMP3Loader *)
141 function TMP3Loader.LoadStream(Stream: TStream; SStreaming: Boolean): Boolean;
142 var
143 SRate: clong;
144 SEnc, SChans: LongInt;
145 begin
146 FMPG := mpg123_new(nil, nil);
147 if FMPG = nil then
148 begin
149 e_LogWriteln('MPG123: mpg123_new() failed');
150 Exit;
151 end;
153 try
154 if mpg123_replace_reader_handle(FMPG, streamRead, streamLSeek, nil) <> MPG123_OK then
155 raise Exception.Create('mpg123_replace_header_handle failed');
156 if mpg123_open_handle(FMPG, Stream) <> MPG123_OK then
157 raise Exception.Create('mpg123_open_handle failed');
159 FOpen := True;
161 if mpg123_getformat(FMPG, @SRate, @SChans, @SEnc) <> MPG123_OK then
162 raise Exception.Create('mpg123_get_format failed');
163 if (SChans < 1) or (SChans > 2) or (SRate <= 0) then
164 raise Exception.Create('invalid format');
166 mpg123_format_none(FMPG);
167 if mpg123_format(FMPG, SRate, SChans, MPG123_ENC_SIGNED_16) <> MPG123_OK then
168 raise Exception.Create('mpg123_format failed');
169 except
170 on E: Exception do
171 begin
172 e_LogWriteln('MPG123: Load(Data) failed: ' + E.Message);
173 if FOpen then mpg123_close(FMPG);
174 mpg123_delete(FMPG);
175 FMPG := nil;
176 FOpen := False;
177 Exit;
178 end;
179 end;
181 FData := Stream;
182 FFormat.SampleRate := SRate;
183 FFormat.SampleBits := 16;
184 FFormat.Channels := SChans;
185 FStreaming := SStreaming;
187 Result := True;
188 end;
190 function TMP3Loader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
191 var
192 S: TStream;
193 begin
194 Result := False;
196 // TODO: have to make a dupe here because Data gets deallocated after loading
197 // this is obviously very shit
198 FBuf := GetMem(Len);
199 if FBuf = nil then Exit;
200 Move(Data^, FBuf^, Len);
202 S := TSFSMemoryStreamRO.Create(FBuf, Len{, True});
203 Result := LoadStream(S, SStreaming);
205 if not Result and (S <> nil) then
206 begin
207 S.Destroy();
208 FreeMem(FBuf);
209 FBuf := nil;
210 end;
211 end;
213 function TMP3Loader.Load(FName: string; SStreaming: Boolean): Boolean;
214 var
215 S: TStream = nil;
216 begin
217 Result := False;
219 try
220 S := openDiskFileRO(FName);
221 Result := LoadStream(S, SStreaming);
222 except
223 on E: Exception do
224 e_LogWritefln('MPG123: ERROR: could not read file `%s`: %s', [FName, E.Message]);
225 end;
227 if not Result and (S <> nil) then
228 S.Destroy();
229 end;
231 function TMP3Loader.SetPosition(Pos: LongWord): Boolean;
232 begin
233 Result := False;
234 if FMPG = nil then Exit;
235 Result := mpg123_seek(FMPG, Pos, 0) = MPG123_OK;
236 end;
238 function TMP3Loader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
239 var
240 Ret: LongInt;
241 Got: csize_t;
242 begin
243 Result := 0;
244 Got := 0;
245 if FMPG = nil then Exit;
246 Ret := mpg123_read(FMPG, Buf, Len, @Got);
247 if FLooping and ((Ret = MPG123_DONE) or (Got = 0)) then
248 Ret := mpg123_seek(FMPG, 0, 0); // loop
249 if Ret = MPG123_OK then
250 Result := Got;
251 end;
253 function TMP3Loader.GetAll(var OutPtr: Pointer): LongWord;
254 begin
255 Result := 0;
256 if FMPG = nil then Exit;
257 if FStreaming then Exit;
258 // TODO
259 end;
261 procedure TMP3Loader.Free();
262 begin
263 if FOpen then mpg123_close(FMPG);
264 if FMPG <> nil then mpg123_delete(FMPG);
265 if FData <> nil then FData.Destroy();
266 if FBuf <> nil then FreeMem(FBuf);
267 if FAllSamples <> nil then FreeMem(FAllSamples);
268 FOpen := False;
269 FMPG := nil;
270 FData := nil;
271 FBuf := nil;
272 FAllSamples := nil;
273 end;
275 initialization
276 if mpg123_init() = MPG123_OK then
277 e_AddSoundLoader(TMP3LoaderFactory.Create());
278 finalization
279 mpg123_exit();
280 end.