src/engine/e_soundfile_ogg.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_ogg;
  18
  19 interface
  20
  21 uses e_soundfile, vorbis, classes;
  22
  23 type
  24   // OGG Vorbis loader
  25
  26   TOGGLoader = 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   TOGGLoaderFactory = 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 (* TOGGLoaderFactory *)
 111
 112 function TOGGLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
 113 const
 114   OGG_HEADER = $5367674F; // 'OggS'
 115 begin
 116   if Len < 27 then // header is at least 27 bytes
 117   begin
 118     Result := False;
 119     exit;
 120   end;
 121   Result := (PLongWord(Data)^ = OGG_HEADER);
 122 end;
 123
 124 function TOGGLoaderFactory.MatchExtension(FName: string): Boolean;
 125 begin
 126   Result := GetFilenameExt(FName) = '.ogg';
 127 end;
 128
 129 function TOGGLoaderFactory.GetLoader(): TSoundLoader;
 130 begin
 131   Result := TOGGLoader.Create();
 132 end;
 133
 134 (* TOGGLoader *)
 135
 136 function TOGGLoader.LoadEntireStream(): Pointer;
 137 var
 138   Samples: ogg_int64_t;
 139   Ret: clong;
 140 begin
 141   Result := nil;
 142
 143   Samples := ov_pcm_total(FOgg, -1);
 144   if Samples < 0 then Exit;
 145
 146   FTotal := Samples * 2 * FFormat.Channels;
 147   Result := GetMem(FTotal);
 148   if Result = nil then Exit;
 149
 150   Ret := ov_read_ext(FOgg, Result, FTotal, False, 2, True);
 151   if Ret < 0 then
 152   begin
 153     FreeMem(Result);
 154     Result := nil;
 155   end
 156   else
 157     FTotal := Ret;
 158 end;
 159
 160 function TOGGLoader.LoadStream(Stream: TStream; SStreaming: Boolean): Boolean;
 161 var
 162   Ret, Bit: clong;
 163   Info: pvorbis_info;
 164   FullBuf: Pointer;
 165 begin
 166   Result := False;
 167
 168   Ret := ov_open_callbacks(Stream, FOgg, nil, 0, oggIO);
 169   if Ret < 0 then
 170   begin
 171     e_LogWriteln('OGG: Load(Data) failed: ov_open_callbacks failed');
 172     Exit;
 173   end;
 174
 175   Info := ov_info(FOgg, -1);
 176   if Info = nil then
 177   begin
 178     e_LogWriteln('OGG: Load(Data) failed: ov_info returned NULL');
 179     ov_clear(FOgg);
 180     Exit;
 181   end;
 182
 183   FFormat.SampleRate := Info^.rate;
 184   FFormat.Channels := Info^.channels;
 185   FFormat.SampleBits := 16;
 186
 187   if not SStreaming then
 188   begin
 189     FullBuf := LoadEntireStream();
 190
 191     if FullBuf = nil then
 192     begin
 193       e_LogWriteln('OGG: Load(Data) failed: couldn''t allocate for non-streaming chunk');
 194       ov_clear(FOgg);
 195       FTotal := 0;
 196       Exit;
 197     end;
 198
 199     ov_clear(FOgg);
 200     Stream.Destroy();
 201
 202     FreeMem(FBuf);
 203     FBuf := FullBuf;
 204   end
 205   else
 206   begin
 207     FTotal := 0;
 208     FOpen := True;
 209     FData := Stream;
 210   end;
 211
 212   FStreaming := SStreaming;
 213   Result := True;
 214 end;
 215
 216 function TOGGLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 217 var
 218   S: TStream;
 219 begin
 220   Result := False;
 221
 222   // TODO: have to make a dupe here because Data gets deallocated after loading
 223   //       this is obviously very shit
 224   FBuf := GetMem(Len);
 225   if FBuf = nil then Exit;
 226   Move(Data^, FBuf^, Len);
 227
 228   S := TSFSMemoryStreamRO.Create(FBuf, Len{, True});
 229   Result := LoadStream(S, SStreaming);
 230
 231   if not Result and (S <> nil) then
 232   begin
 233     S.Destroy();
 234     FreeMem(FBuf);
 235     FBuf := nil;
 236   end;
 237 end;
 238
 239 function TOGGLoader.Load(FName: string; SStreaming: Boolean): Boolean;
 240 var
 241   S: TStream = nil;
 242 begin
 243   Result := False;
 244
 245   try
 246     S := openDiskFileRO(FName);
 247     Result := LoadStream(S, SStreaming);
 248   except
 249     on E: Exception do
 250       e_LogWritefln('OGG: ERROR: could not read file `%s`: %s', [FName, E.Message]);
 251   end;
 252
 253   if not Result and (S <> nil) then
 254     S.Destroy();
 255 end;
 256
 257 function TOGGLoader.SetPosition(Pos: LongWord): Boolean;
 258 begin
 259   Result := False;
 260   if not FOpen or (ov_seekable(FOgg) = 0) then Exit;
 261   Result := ov_pcm_seek(FOgg, Pos) = 0;
 262 end;
 263
 264 function TOGGLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 265 var
 266   Ret: clong;
 267 begin
 268   Result := 0;
 269   if not FOpen or not FStreaming then Exit;
 270   Ret := ov_read_ext(FOgg, Buf, Len, False, 2, True);
 271   if Ret < 0 then Exit;
 272   Result := Ret;
 273 end;
 274
 275 function TOGGLoader.GetAll(var OutPtr: Pointer): LongWord;
 276 begin
 277   Result := 0;
 278   if FStreaming or (FTotal = 0) then Exit;
 279   Result := FTotal;
 280   OutPtr := FBuf;
 281 end;
 282
 283 procedure TOGGLoader.Free();
 284 begin
 285   if FOpen then
 286     ov_clear(FOgg);
 287   if FData <> nil then
 288     FData.Destroy();
 289   if FBuf <> nil then
 290     FreeMem(FBuf);
 291   FData := nil;
 292   FBuf := nil;
 293   FOpen := False;
 294   FTotal := 0;
 295   FStreaming := False;
 296 end;
 297
 298 initialization
 299   e_AddSoundLoader(TOGGLoaderFactory.Create());
 300 end.