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;
  17
  18 interface
  19
  20 uses e_soundfile, vorbis, classes;
  21
  22 type
  23   // Ogg Vorbis loader
  24
  25   TVorbisLoader = 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
  34   private
  35     FOgg: OggVorbis_File;
  36     FData: TStream;
  37     FBuf: Pointer;
  38     FTotal: LongWord;
  39     FOpen: Boolean;
  40
  41     function LoadStream(Stream: TStream; SStreaming: Boolean): Boolean;
  42     function LoadEntireStream(): Pointer;
  43   end;
  44
  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;
  51
  52 implementation
  53
  54 uses sysutils, utils, e_log, xstreams, ogg, ctypes;
  55
  56 (* Reader functions for ov_callbacks *)
  57
  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;
  76
  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;
  90
  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;
 100
 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   );
 108
 109 (* TVorbisLoaderFactory *)
 110
 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;
 119
 120   if Len < 27 then // header is at least 27 bytes
 121     Exit;
 122   if PLongWord(Data)^ <> OGG_HEADER then
 123     Exit;
 124
 125   // now we gotta check that this is indeed a vorbis file and not an opus file
 126
 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;
 132
 133 function TVorbisLoaderFactory.MatchExtension(FName: string): Boolean;
 134 begin
 135   Result := GetFilenameExt(FName) = '.ogg';
 136 end;
 137
 138 function TVorbisLoaderFactory.GetLoader(): TSoundLoader;
 139 begin
 140   Result := TVorbisLoader.Create();
 141 end;
 142
 143 (* TVorbisLoader *)
 144
 145 function TVorbisLoader.LoadEntireStream(): Pointer;
 146 var
 147   Samples: ogg_int64_t;
 148   Ret: clong;
 149 begin
 150   Result := nil;
 151
 152   Samples := ov_pcm_total(FOgg, -1);
 153   if Samples < 0 then Exit;
 154
 155   FTotal := Samples * 2 * FFormat.Channels;
 156   Result := GetMem(FTotal);
 157   if Result = nil then Exit;
 158
 159   Ret := ov_read_ext(FOgg, Result, FTotal, False, 2, True);
 160   if Ret < 0 then
 161   begin
 162     FreeMem(Result);
 163     Result := nil;
 164   end
 165   else
 166     FTotal := Ret;
 167 end;
 168
 169 function TVorbisLoader.LoadStream(Stream: TStream; SStreaming: Boolean): Boolean;
 170 var
 171   Ret: clong;
 172   Info: pvorbis_info;
 173   FullBuf: Pointer;
 174 begin
 175   Result := False;
 176
 177   Ret := ov_open_callbacks(Stream, FOgg, nil, 0, oggIO);
 178   if Ret < 0 then
 179   begin
 180     e_LogWriteln('OGG: Load(Data) failed: ov_open_callbacks failed');
 181     Exit;
 182   end;
 183
 184   Info := ov_info(FOgg, -1);
 185   if Info = nil then
 186   begin
 187     e_LogWriteln('OGG: Load(Data) failed: ov_info returned NULL');
 188     ov_clear(FOgg);
 189     Exit;
 190   end;
 191
 192   FFormat.SampleRate := Info^.rate;
 193   FFormat.Channels := Info^.channels;
 194   FFormat.SampleBits := 16;
 195
 196   if not SStreaming then
 197   begin
 198     FullBuf := LoadEntireStream();
 199
 200     if FullBuf = nil then
 201     begin
 202       e_LogWriteln('OGG: Load(Data) failed: couldn''t allocate for non-streaming chunk');
 203       ov_clear(FOgg);
 204       FTotal := 0;
 205       Exit;
 206     end;
 207
 208     ov_clear(FOgg);
 209     Stream.Free();
 210
 211     FreeMem(FBuf);
 212     FBuf := FullBuf;
 213   end
 214   else
 215   begin
 216     FTotal := 0;
 217     FOpen := True;
 218     FData := Stream;
 219   end;
 220
 221   FStreaming := SStreaming;
 222   Result := True;
 223 end;
 224
 225 function TVorbisLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 226 var
 227   S: TStream;
 228 begin
 229   Result := False;
 230
 231   // TODO: have to make a dupe here because Data gets deallocated after loading
 232   //       this is obviously very shit
 233   FBuf := GetMem(Len);
 234   if FBuf = nil then Exit;
 235   Move(Data^, FBuf^, Len);
 236
 237   S := TSFSMemoryStreamRO.Create(FBuf, Len{, True});
 238   Result := LoadStream(S, SStreaming);
 239
 240   if not Result and (S <> nil) then
 241   begin
 242     S.Free();
 243     FreeMem(FBuf);
 244     FBuf := nil;
 245   end;
 246 end;
 247
 248 function TVorbisLoader.Load(FName: string; SStreaming: Boolean): Boolean;
 249 var
 250   S: TStream = nil;
 251 begin
 252   Result := False;
 253
 254   try
 255     S := openDiskFileRO(FName);
 256     Result := LoadStream(S, SStreaming);
 257   except
 258     on E: Exception do
 259       e_LogWritefln('OGG: ERROR: could not read file `%s`: %s', [FName, E.Message]);
 260   end;
 261
 262   if not Result and (S <> nil) then
 263     S.Free();
 264 end;
 265
 266 function TVorbisLoader.SetPosition(Pos: LongWord): Boolean;
 267 begin
 268   Result := False;
 269   if not FOpen or (ov_seekable(FOgg) = 0) then Exit;
 270   Result := ov_pcm_seek(FOgg, Pos) = 0;
 271 end;
 272
 273 function TVorbisLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 274 var
 275   Ret: clong;
 276 begin
 277   Result := 0;
 278   if not FOpen or not FStreaming then Exit;
 279   Ret := ov_read_ext(FOgg, Buf, Len, False, 2, True);
 280   if Ret < 0 then Exit;
 281   if FLooping and (Ret = 0) then
 282     ov_pcm_seek(FOgg, 0);
 283   Result := Ret;
 284 end;
 285
 286 function TVorbisLoader.GetAll(var OutPtr: Pointer): LongWord;
 287 begin
 288   Result := 0;
 289   if FStreaming or (FTotal = 0) then Exit;
 290   Result := FTotal;
 291   OutPtr := FBuf;
 292 end;
 293
 294 procedure TVorbisLoader.Free();
 295 begin
 296   if FOpen then
 297     ov_clear(FOgg);
 298   if FData <> nil then
 299     FData.Free();
 300   if FBuf <> nil then
 301     FreeMem(FBuf);
 302   FData := nil;
 303   FBuf := nil;
 304   FOpen := False;
 305   FTotal := 0;
 306   FStreaming := False;
 307 end;
 308
 309 initialization
 310   e_AddSoundLoader(TVorbisLoaderFactory.Create());
 311 end.