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}
17 unit e_soundfile_vorbis
;
21 uses e_soundfile
, vorbis
, classes
;
26 TVorbisLoader
= 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;
42 function LoadStream(Stream
: TStream
; SStreaming
: Boolean): Boolean;
43 function LoadEntireStream(): Pointer;
46 TVorbisLoaderFactory
= class (TSoundLoaderFactory
)
48 function MatchHeader(Data
: Pointer; Len
: LongWord): Boolean; override;
49 function MatchExtension(FName
: string): Boolean; override;
50 function GetLoader(): TSoundLoader
; override;
55 uses sysutils
, utils
, e_log
, xstreams
, ogg
, ctypes
;
57 (* Reader functions for ov_callbacks *)
59 function streamSeek(h
: Pointer; off
: ogg_int64_t
; whence
: cint
): cint
; cdecl;
68 0: s
.Seek(off
, soBeginning
); // SEEK_SET
69 1: s
.Seek(off
, soCurrent
); // SEEK_CUR
70 2: s
.Seek(off
, soEnd
); // SEEK_END
78 function streamRead(buf
: Pointer; sz
, nmemb
: csize_t
; h
: Pointer): csize_t
; cdecl;
86 Result
:= S
.Read(buf
^, sz
*nmemb
) div sz
;
92 function streamTell(h
: Pointer): clong
; cdecl;
103 oggIO
: ov_callbacks
= (
106 close
: nil; // the loader's gonna handle that
110 (* TVorbisLoaderFactory *)
112 function TVorbisLoaderFactory
.MatchHeader(Data
: Pointer; Len
: LongWord): Boolean;
114 OGG_HEADER
= $5367674F; // 'OggS'
121 if Len
< 27 then // header is at least 27 bytes
123 if PLongWord(Data
)^ <> OGG_HEADER
then
126 // now we gotta check that this is indeed a vorbis file and not an opus file
128 S
:= TSFSMemoryStreamRO
.Create(Data
, Len
);
129 Result
:= ov_test_callbacks(S
, F
, nil, 0, oggIO
) = 0;
130 if Result
then ov_clear(F
);
134 function TVorbisLoaderFactory
.MatchExtension(FName
: string): Boolean;
136 Result
:= GetFilenameExt(FName
) = '.ogg';
139 function TVorbisLoaderFactory
.GetLoader(): TSoundLoader
;
141 Result
:= TVorbisLoader
.Create();
146 function TVorbisLoader
.LoadEntireStream(): Pointer;
148 Samples
: ogg_int64_t
;
153 Samples
:= ov_pcm_total(FOgg
, -1);
154 if Samples
< 0 then Exit
;
156 FTotal
:= Samples
* 2 * FFormat
.Channels
;
157 Result
:= GetMem(FTotal
);
158 if Result
= nil then Exit
;
160 Ret
:= ov_read_ext(FOgg
, Result
, FTotal
, False, 2, True);
170 function TVorbisLoader
.LoadStream(Stream
: TStream
; SStreaming
: Boolean): Boolean;
178 Ret
:= ov_open_callbacks(Stream
, FOgg
, nil, 0, oggIO
);
181 e_LogWriteln('OGG: Load(Data) failed: ov_open_callbacks failed');
185 Info
:= ov_info(FOgg
, -1);
188 e_LogWriteln('OGG: Load(Data) failed: ov_info returned NULL');
193 FFormat
.SampleRate
:= Info
^.rate
;
194 FFormat
.Channels
:= Info
^.channels
;
195 FFormat
.SampleBits
:= 16;
197 if not SStreaming
then
199 FullBuf
:= LoadEntireStream();
201 if FullBuf
= nil then
203 e_LogWriteln('OGG: Load(Data) failed: couldn''t allocate for non-streaming chunk');
222 FStreaming
:= SStreaming
;
226 function TVorbisLoader
.Load(Data
: Pointer; Len
: LongWord; SStreaming
: Boolean): Boolean;
232 // TODO: have to make a dupe here because Data gets deallocated after loading
233 // this is obviously very shit
235 if FBuf
= nil then Exit
;
236 Move(Data
^, FBuf
^, Len
);
238 S
:= TSFSMemoryStreamRO
.Create(FBuf
, Len
{, True});
239 Result
:= LoadStream(S
, SStreaming
);
241 if not Result
and (S
<> nil) then
249 function TVorbisLoader
.Load(FName
: string; SStreaming
: Boolean): Boolean;
256 S
:= openDiskFileRO(FName
);
257 Result
:= LoadStream(S
, SStreaming
);
260 e_LogWritefln('OGG: ERROR: could not read file `%s`: %s', [FName
, E
.Message]);
263 if not Result
and (S
<> nil) then
267 function TVorbisLoader
.SetPosition(Pos
: LongWord): Boolean;
270 if not FOpen
or (ov_seekable(FOgg
) = 0) then Exit
;
271 Result
:= ov_pcm_seek(FOgg
, Pos
) = 0;
274 function TVorbisLoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
279 if not FOpen
or not FStreaming
then Exit
;
280 Ret
:= ov_read_ext(FOgg
, Buf
, Len
, False, 2, True);
281 if Ret
< 0 then Exit
;
282 if FLooping
and (Ret
= 0) then
283 ov_pcm_seek(FOgg
, 0);
287 function TVorbisLoader
.GetAll(var OutPtr
: Pointer): LongWord;
290 if FStreaming
or (FTotal
= 0) then Exit
;
295 procedure TVorbisLoader
.Free();
311 e_AddSoundLoader(TVorbisLoaderFactory
.Create());