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; 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;
  33
  34   private
  35     FOgg: OggVorbis_File;
  36     FData: TStream;
  37     FBuf: Pointer;
  38     FOpen: Boolean;
  39     FFinished: Boolean;
  40     FLooping: Boolean;
  41
  42     function LoadStream(Stream: TStream): Boolean;
  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.LoadStream(Stream: TStream): Boolean;
 146 var
 147   Ret: clong;
 148   Info: pvorbis_info;
 149 begin
 150   Result := False;
 151
 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;
 158
 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;
 166
 167   FFormat.SampleRate := Info^.rate;
 168   FFormat.Channels := Info^.channels;
 169   FFormat.SampleBits := 16;
 170   FOpen := True;
 171   FData := Stream;
 172
 173   FStreaming := True;
 174   FFinished := False;
 175   Result := True;
 176 end;
 177
 178 function TVorbisLoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
 179 var
 180   S: TStream;
 181 begin
 182   Result := False;
 183
 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);
 189
 190   S := TSFSMemoryStreamRO.Create(FBuf, Len{, True});
 191   Result := LoadStream(S);
 192   FLooping := Loop;
 193
 194   if not Result and (S <> nil) then
 195   begin
 196     S.Free();
 197     FreeMem(FBuf);
 198     FBuf := nil;
 199   end;
 200 end;
 201
 202 function TVorbisLoader.Load(FName: string; Loop: Boolean): Boolean;
 203 var
 204   S: TStream = nil;
 205 begin
 206   Result := False;
 207
 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;
 216
 217   if not Result and (S <> nil) then
 218     S.Free();
 219 end;
 220
 221 function TVorbisLoader.Finished(): Boolean;
 222 begin
 223   Result := FFinished;
 224 end;
 225
 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;
 233
 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;
 251
 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;
 263
 264 initialization
 265   e_AddSoundLoader(TVorbisLoaderFactory.Create());
 266 end.