DEADSOFTWARE

Fix preferences sync
[d2df-sdl.git] / src / engine / e_soundfile_vorbis.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_vorbis;
18 interface
20 uses e_soundfile, vorbis, classes;
22 type
23 // Ogg Vorbis loader
25 TVorbisLoader = class (TSoundLoader)
26 public
27 function Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean; override; overload;
28 function Load(FName: string; Loop: Boolean): Boolean; override; overload;
29 function Finished(): Boolean; override;
30 function Restart(): Boolean; override;
31 function FillBuffer(Buf: Pointer; Len: LongWord): LongWord; override;
32 procedure Free(); override;
34 private
35 FOgg: OggVorbis_File;
36 FData: TStream;
37 FBuf: Pointer;
38 FOpen: Boolean;
39 FFinished: Boolean;
40 FLooping: Boolean;
42 function LoadStream(Stream: TStream): Boolean;
43 end;
45 TVorbisLoaderFactory = class (TSoundLoaderFactory)
46 public
47 function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
48 function MatchExtension(FName: string): Boolean; override;
49 function GetLoader(): TSoundLoader; override;
50 end;
52 implementation
54 uses sysutils, utils, e_log, xstreams, ogg, ctypes;
56 (* Reader functions for ov_callbacks *)
58 function streamSeek(h: Pointer; off: ogg_int64_t; whence: cint): cint; cdecl;
59 var
60 S: TStream;
61 begin
62 Result := -1;
63 if h = nil then Exit;
64 S:= TStream(h);
65 try
66 case whence of
67 0: s.Seek(off, soBeginning); // SEEK_SET
68 1: s.Seek(off, soCurrent); // SEEK_CUR
69 2: s.Seek(off, soEnd); // SEEK_END
70 end;
71 Result := 0;
72 except
73 Result := -1;
74 end;
75 end;
77 function streamRead(buf: Pointer; sz, nmemb: csize_t; h: Pointer): csize_t; cdecl;
78 var
79 S: TStream;
80 begin
81 Result := 0;
82 if h = nil then Exit;
83 S:= TStream(h);
84 try
85 Result := S.Read(buf^, sz*nmemb) div sz;
86 except
87 Result := 0;
88 end;
89 end;
91 function streamTell(h: Pointer): clong; cdecl;
92 var
93 S: TStream;
94 begin
95 Result := -1;
96 if h = nil then Exit;
97 S := TStream(h);
98 Result := S.Position;
99 end;
101 var
102 oggIO: ov_callbacks = (
103 read: streamRead;
104 seek: streamSeek;
105 close: nil; // the loader's gonna handle that
106 tell: streamTell;
107 );
109 (* TVorbisLoaderFactory *)
111 function TVorbisLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
112 const
113 OGG_HEADER = $5367674F; // 'OggS'
114 var
115 S: TStream;
116 F: OggVorbis_File;
117 begin
118 Result := False;
120 if Len < 27 then // header is at least 27 bytes
121 Exit;
122 if PLongWord(Data)^ <> OGG_HEADER then
123 Exit;
125 // now we gotta check that this is indeed a vorbis file and not an opus file
127 S := TSFSMemoryStreamRO.Create(Data, Len);
128 Result := ov_test_callbacks(S, F, nil, 0, oggIO) = 0;
129 if Result then ov_clear(F);
130 S.Free();
131 end;
133 function TVorbisLoaderFactory.MatchExtension(FName: string): Boolean;
134 begin
135 Result := GetFilenameExt(FName) = '.ogg';
136 end;
138 function TVorbisLoaderFactory.GetLoader(): TSoundLoader;
139 begin
140 Result := TVorbisLoader.Create();
141 end;
143 (* TVorbisLoader *)
145 function TVorbisLoader.LoadStream(Stream: TStream): Boolean;
146 var
147 Ret: clong;
148 Info: pvorbis_info;
149 begin
150 Result := False;
152 Ret := ov_open_callbacks(Stream, FOgg, nil, 0, oggIO);
153 if Ret < 0 then
154 begin
155 e_LogWriteln('OGG: Load(Data) failed: ov_open_callbacks failed');
156 Exit;
157 end;
159 Info := ov_info(FOgg, -1);
160 if Info = nil then
161 begin
162 e_LogWriteln('OGG: Load(Data) failed: ov_info returned NULL');
163 ov_clear(FOgg);
164 Exit;
165 end;
167 FFormat.SampleRate := Info^.rate;
168 FFormat.Channels := Info^.channels;
169 FFormat.SampleBits := 16;
170 FOpen := True;
171 FData := Stream;
173 FStreaming := True;
174 FFinished := False;
175 Result := True;
176 end;
178 function TVorbisLoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
179 var
180 S: TStream;
181 begin
182 Result := False;
184 // TODO: have to make a dupe here because Data gets deallocated after loading
185 // this is obviously very shit
186 FBuf := GetMem(Len);
187 if FBuf = nil then Exit;
188 Move(Data^, FBuf^, Len);
190 S := TSFSMemoryStreamRO.Create(FBuf, Len{, True});
191 Result := LoadStream(S);
192 FLooping := Loop;
194 if not Result and (S <> nil) then
195 begin
196 S.Free();
197 FreeMem(FBuf);
198 FBuf := nil;
199 end;
200 end;
202 function TVorbisLoader.Load(FName: string; Loop: Boolean): Boolean;
203 var
204 S: TStream = nil;
205 begin
206 Result := False;
208 try
209 S := openDiskFileRO(FName);
210 Result := LoadStream(S);
211 FLooping := Loop;
212 except
213 on E: Exception do
214 e_LogWritefln('OGG: ERROR: could not read file `%s`: %s', [FName, E.Message]);
215 end;
217 if not Result and (S <> nil) then
218 S.Free();
219 end;
221 function TVorbisLoader.Finished(): Boolean;
222 begin
223 Result := FFinished;
224 end;
226 function TVorbisLoader.Restart(): Boolean;
227 begin
228 Result := False;
229 if not FOpen or (ov_seekable(FOgg) = 0) then Exit;
230 FFinished := False;
231 Result := ov_pcm_seek(FOgg, 0) = 0;
232 end;
234 function TVorbisLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
235 var
236 Ret: clong;
237 begin
238 Result := 0;
239 if not FOpen then Exit;
240 Ret := ov_read_ext(FOgg, Buf, Len, False, 2, True);
241 if Ret < 0 then Exit;
242 if Ret = 0 then
243 begin
244 if FLooping then
245 ov_pcm_seek(FOgg, 0)
246 else
247 FFinished := True;
248 end;
249 Result := Ret;
250 end;
252 procedure TVorbisLoader.Free();
253 begin
254 if FOpen then
255 ov_clear(FOgg);
256 if FData <> nil then
257 FData.Free();
258 FData := nil;
259 FOpen := False;
260 FStreaming := False;
261 FFinished := False;
262 end;
264 initialization
265 e_AddSoundLoader(TVorbisLoaderFactory.Create());
266 end.