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, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   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.
  12  *
  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/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit e_soundfile_vorbis;
  18
  19 interface
  20
  21 uses e_soundfile, vorbis, classes;
  22
  23 type
  24   // Ogg Vorbis loader
  25
  26   TVorbisLoader = class (TSoundLoader)
  27   public
  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;
  34
  35   private
  36     FOgg: OggVorbis_File;
  37     FData: TStream;
  38     FBuf: Pointer;
  39     FTotal: LongWord;
  40     FOpen: Boolean;
  41
  42     function LoadStream(Stream: TStream; SStreaming: Boolean): Boolean;
  43     function LoadEntireStream(): Pointer;
  44   end;
  45
  46   TVorbisLoaderFactory = class (TSoundLoaderFactory)
  47   public
  48     function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
  49     function MatchExtension(FName: string): Boolean; override;
  50     function GetLoader(): TSoundLoader; override;
  51   end;
  52
  53 implementation
  54
  55 uses sysutils, utils, e_log, xstreams, ogg, ctypes;
  56
  57 (* Reader functions for ov_callbacks *)
  58
  59 function streamSeek(h: Pointer; off: ogg_int64_t; whence: cint): cint; cdecl;
  60 var
  61   S: TStream;
  62 begin
  63   Result := -1;
  64   if h = nil then Exit;
  65   S:= TStream(h);
  66   try
  67     case whence of
  68       0: s.Seek(off, soBeginning); // SEEK_SET
  69       1: s.Seek(off, soCurrent);   // SEEK_CUR
  70       2: s.Seek(off, soEnd);       // SEEK_END
  71     end;
  72     Result := 0;
  73   except
  74     Result := -1;
  75   end;
  76 end;
  77
  78 function streamRead(buf: Pointer; sz, nmemb: csize_t; h: Pointer): csize_t; cdecl;
  79 var
  80   S: TStream;
  81 begin
  82   Result := 0;
  83   if h = nil then Exit;
  84   S:= TStream(h);
  85   try
  86     Result := S.Read(buf^, sz*nmemb) div sz;
  87   except
  88     Result := 0;
  89   end;
  90 end;
  91
  92 function streamTell(h: Pointer): clong; cdecl;
  93 var
  94   S: TStream;
  95 begin
  96   Result := -1;
  97   if h = nil then Exit;
  98   S := TStream(h);
  99   Result := S.Position;
 100 end;
 101
 102 var
 103   oggIO: ov_callbacks = (
 104     read:        streamRead;
 105     seek:        streamSeek;
 106     close:       nil; // the loader's gonna handle that
 107     tell:        streamTell;
 108   );
 109
 110 (* TVorbisLoaderFactory *)
 111
 112 function TVorbisLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
 113 const
 114   OGG_HEADER = $5367674F; // 'OggS'
 115 var
 116   S: TStream;
 117   F: OggVorbis_File;
 118 begin
 119   Result := False;
 120
 121   if Len < 27 then // header is at least 27 bytes
 122     Exit;
 123   if PLongWord(Data)^ <> OGG_HEADER then
 124     Exit;
 125
 126   // now we gotta check that this is indeed a vorbis file and not an opus file
 127
 128   S := TSFSMemoryStreamRO.Create(Data, Len);
 129   Result := ov_test_callbacks(S, F, nil, 0, oggIO) = 0;
 130   if Result then ov_clear(F);
 131   S.Free();
 132 end;
 133
 134 function TVorbisLoaderFactory.MatchExtension(FName: string): Boolean;
 135 begin
 136   Result := GetFilenameExt(FName) = '.ogg';
 137 end;
 138
 139 function TVorbisLoaderFactory.GetLoader(): TSoundLoader;
 140 begin
 141   Result := TVorbisLoader.Create();
 142 end;
 143
 144 (* TVorbisLoader *)
 145
 146 function TVorbisLoader.LoadEntireStream(): Pointer;
 147 var
 148   Samples: ogg_int64_t;
 149   Ret: clong;
 150 begin
 151   Result := nil;
 152
 153   Samples := ov_pcm_total(FOgg, -1);
 154   if Samples < 0 then Exit;
 155
 156   FTotal := Samples * 2 * FFormat.Channels;
 157   Result := GetMem(FTotal);
 158   if Result = nil then Exit;
 159
 160   Ret := ov_read_ext(FOgg, Result, FTotal, False, 2, True);
 161   if Ret < 0 then
 162   begin
 163     FreeMem(Result);
 164     Result := nil;
 165   end
 166   else
 167     FTotal := Ret;
 168 end;
 169
 170 function TVorbisLoader.LoadStream(Stream: TStream; SStreaming: Boolean): Boolean;
 171 var
 172   Ret, Bit: clong;
 173   Info: pvorbis_info;
 174   FullBuf: Pointer;
 175 begin
 176   Result := False;
 177
 178   Ret := ov_open_callbacks(Stream, FOgg, nil, 0, oggIO);
 179   if Ret < 0 then
 180   begin
 181     e_LogWriteln('OGG: Load(Data) failed: ov_open_callbacks failed');
 182     Exit;
 183   end;
 184
 185   Info := ov_info(FOgg, -1);
 186   if Info = nil then
 187   begin
 188     e_LogWriteln('OGG: Load(Data) failed: ov_info returned NULL');
 189     ov_clear(FOgg);
 190     Exit;
 191   end;
 192
 193   FFormat.SampleRate := Info^.rate;
 194   FFormat.Channels := Info^.channels;
 195   FFormat.SampleBits := 16;
 196
 197   if not SStreaming then
 198   begin
 199     FullBuf := LoadEntireStream();
 200
 201     if FullBuf = nil then
 202     begin
 203       e_LogWriteln('OGG: Load(Data) failed: couldn''t allocate for non-streaming chunk');
 204       ov_clear(FOgg);
 205       FTotal := 0;
 206       Exit;
 207     end;
 208
 209     ov_clear(FOgg);
 210     Stream.Free();
 211
 212     FreeMem(FBuf);
 213     FBuf := FullBuf;
 214   end
 215   else
 216   begin
 217     FTotal := 0;
 218     FOpen := True;
 219     FData := Stream;
 220   end;
 221
 222   FStreaming := SStreaming;
 223   Result := True;
 224 end;
 225
 226 function TVorbisLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 227 var
 228   S: TStream;
 229 begin
 230   Result := False;
 231
 232   // TODO: have to make a dupe here because Data gets deallocated after loading
 233   //       this is obviously very shit
 234   FBuf := GetMem(Len);
 235   if FBuf = nil then Exit;
 236   Move(Data^, FBuf^, Len);
 237
 238   S := TSFSMemoryStreamRO.Create(FBuf, Len{, True});
 239   Result := LoadStream(S, SStreaming);
 240
 241   if not Result and (S <> nil) then
 242   begin
 243     S.Free();
 244     FreeMem(FBuf);
 245     FBuf := nil;
 246   end;
 247 end;
 248
 249 function TVorbisLoader.Load(FName: string; SStreaming: Boolean): Boolean;
 250 var
 251   S: TStream = nil;
 252 begin
 253   Result := False;
 254
 255   try
 256     S := openDiskFileRO(FName);
 257     Result := LoadStream(S, SStreaming);
 258   except
 259     on E: Exception do
 260       e_LogWritefln('OGG: ERROR: could not read file `%s`: %s', [FName, E.Message]);
 261   end;
 262
 263   if not Result and (S <> nil) then
 264     S.Free();
 265 end;
 266
 267 function TVorbisLoader.SetPosition(Pos: LongWord): Boolean;
 268 begin
 269   Result := False;
 270   if not FOpen or (ov_seekable(FOgg) = 0) then Exit;
 271   Result := ov_pcm_seek(FOgg, Pos) = 0;
 272 end;
 273
 274 function TVorbisLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 275 var
 276   Ret: clong;
 277 begin
 278   Result := 0;
 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);
 284   Result := Ret;
 285 end;
 286
 287 function TVorbisLoader.GetAll(var OutPtr: Pointer): LongWord;
 288 begin
 289   Result := 0;
 290   if FStreaming or (FTotal = 0) then Exit;
 291   Result := FTotal;
 292   OutPtr := FBuf;
 293 end;
 294
 295 procedure TVorbisLoader.Free();
 296 begin
 297   if FOpen then
 298     ov_clear(FOgg);
 299   if FData <> nil then
 300     FData.Free();
 301   if FBuf <> nil then
 302     FreeMem(FBuf);
 303   FData := nil;
 304   FBuf := nil;
 305   FOpen := False;
 306   FTotal := 0;
 307   FStreaming := False;
 308 end;
 309
 310 initialization
 311   e_AddSoundLoader(TVorbisLoaderFactory.Create());
 312 end.