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, version 3 of the License ONLY.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
16 unit e_soundfile_vorbis
;
20 uses e_soundfile
, vorbis
, classes
;
25 TVorbisLoader
= class (TSoundLoader
)
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;
42 function LoadStream(Stream
: TStream
): Boolean;
45 TVorbisLoaderFactory
= class (TSoundLoaderFactory
)
47 function MatchHeader(Data
: Pointer; Len
: LongWord): Boolean; override;
48 function MatchExtension(FName
: string): Boolean; override;
49 function GetLoader(): TSoundLoader
; override;
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;
67 0: s
.Seek(off
, soBeginning
); // SEEK_SET
68 1: s
.Seek(off
, soCurrent
); // SEEK_CUR
69 2: s
.Seek(off
, soEnd
); // SEEK_END
77 function streamRead(buf
: Pointer; sz
, nmemb
: csize_t
; h
: Pointer): csize_t
; cdecl;
85 Result
:= S
.Read(buf
^, sz
*nmemb
) div sz
;
91 function streamTell(h
: Pointer): clong
; cdecl;
102 oggIO
: ov_callbacks
= (
105 close
: nil; // the loader's gonna handle that
109 (* TVorbisLoaderFactory *)
111 function TVorbisLoaderFactory
.MatchHeader(Data
: Pointer; Len
: LongWord): Boolean;
113 OGG_HEADER
= $5367674F; // 'OggS'
120 if Len
< 27 then // header is at least 27 bytes
122 if PLongWord(Data
)^ <> OGG_HEADER
then
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
);
133 function TVorbisLoaderFactory
.MatchExtension(FName
: string): Boolean;
135 Result
:= GetFilenameExt(FName
) = '.ogg';
138 function TVorbisLoaderFactory
.GetLoader(): TSoundLoader
;
140 Result
:= TVorbisLoader
.Create();
145 function TVorbisLoader
.LoadStream(Stream
: TStream
): Boolean;
152 Ret
:= ov_open_callbacks(Stream
, FOgg
, nil, 0, oggIO
);
155 e_LogWriteln('OGG: Load(Data) failed: ov_open_callbacks failed');
159 Info
:= ov_info(FOgg
, -1);
162 e_LogWriteln('OGG: Load(Data) failed: ov_info returned NULL');
167 FFormat
.SampleRate
:= Info
^.rate
;
168 FFormat
.Channels
:= Info
^.channels
;
169 FFormat
.SampleBits
:= 16;
178 function TVorbisLoader
.Load(Data
: Pointer; Len
: LongWord; Loop
: Boolean): Boolean;
184 // TODO: have to make a dupe here because Data gets deallocated after loading
185 // this is obviously very shit
187 if FBuf
= nil then Exit
;
188 Move(Data
^, FBuf
^, Len
);
190 S
:= TSFSMemoryStreamRO
.Create(FBuf
, Len
{, True});
191 Result
:= LoadStream(S
);
194 if not Result
and (S
<> nil) then
202 function TVorbisLoader
.Load(FName
: string; Loop
: Boolean): Boolean;
209 S
:= openDiskFileRO(FName
);
210 Result
:= LoadStream(S
);
214 e_LogWritefln('OGG: ERROR: could not read file `%s`: %s', [FName
, E
.Message]);
217 if not Result
and (S
<> nil) then
221 function TVorbisLoader
.Finished(): Boolean;
226 function TVorbisLoader
.Restart(): Boolean;
229 if not FOpen
or (ov_seekable(FOgg
) = 0) then Exit
;
231 Result
:= ov_pcm_seek(FOgg
, 0) = 0;
234 function TVorbisLoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
239 if not FOpen
then Exit
;
240 Ret
:= ov_read_ext(FOgg
, Buf
, Len
, False, 2, True);
241 if Ret
< 0 then Exit
;
252 procedure TVorbisLoader
.Free();
265 e_AddSoundLoader(TVorbisLoaderFactory
.Create());