src/engine/e_soundfile_opus.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_opus;
  17
  18 interface
  19
  20 uses e_soundfile, opus, classes;
  21
  22 type
  23   // Opus loader
  24
  25   TOpusLoader = 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   private
  34     FOpus: POggOpusFile;
  35     FBuf: Pointer;
  36     FFinished: Boolean;
  37     FLooping: Boolean;
  38   end;
  39
  40   TOpusLoaderFactory = class (TSoundLoaderFactory)
  41   public
  42     function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
  43     function MatchExtension(FName: string): Boolean; override;
  44     function GetLoader(): TSoundLoader; override;
  45   end;
  46
  47 implementation
  48
  49 uses sysutils, utils, e_log, xstreams, ogg, ctypes;
  50
  51 function TOpusLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
  52 const
  53   OGG_HEADER = $5367674F; // 'OggS'
  54 var
  55   F: POggOpusFile = nil;
  56 begin
  57   Result := False;
  58
  59   if Len < 27 then // header is at least 27 bytes
  60     Exit;
  61   if PLongWord(Data)^ <> OGG_HEADER then
  62     Exit;
  63
  64   // now we gotta check that this is indeed an opus file and not a vorbis file
  65
  66   F := op_test_memory(Data, Len, nil);
  67   Result := F <> nil;
  68   if Result then op_free(F);
  69 end;
  70
  71 function TOpusLoaderFactory.MatchExtension(FName: string): Boolean;
  72 begin
  73   Result := GetFilenameExt(FName) = '.opus';
  74 end;
  75
  76 function TOpusLoaderFactory.GetLoader(): TSoundLoader;
  77 begin
  78   Result := TOpusLoader.Create();
  79 end;
  80
  81 (* TOpusLoader *)
  82
  83 function TOpusLoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
  84 begin
  85   Result := False;
  86
  87   FBuf := GetMem(Len);
  88   if FBuf = nil then
  89   begin
  90     e_LogWriteln('Opus: Load(Data) failed: out of memory on copy');
  91     Exit;
  92   end;
  93   Move(Data^, FBuf^, Len);
  94
  95   FOpus := op_open_memory(FBuf, Len, nil);
  96   if FOpus = nil then
  97   begin
  98     Free();
  99     e_LogWriteln('Opus: Load(Data) failed: op_open_memory failed');
 100     Exit;
 101   end;
 102
 103   FFormat.Channels := 2; // we use ov_read_stereo
 104   FFormat.SampleBits := 16;
 105   FFormat.SampleRate := 48000; // is this even correct?
 106   FStreaming := True; // opus is always streaming
 107   FFinished := False;
 108   FLooping := Loop;
 109
 110   Result := True;
 111 end;
 112
 113 function TOpusLoader.Load(FName: string; Loop: Boolean): Boolean;
 114 begin
 115   Result := False;
 116
 117   FOpus := op_open_file(PChar(FName), nil);
 118   if FOpus = nil then
 119   begin
 120     e_LogWritefln('Opus: Load(%s) failed: op_open_file failed', [FName]);
 121     Exit;
 122   end;
 123
 124   FFormat.Channels := 2; // we use ov_read_stereo
 125   FFormat.SampleBits := 16;
 126   FFormat.SampleRate := 48000; // is this even correct?
 127   FStreaming := True; // opus is always streaming
 128   FFinished := False;
 129   FLooping := Loop;
 130
 131   Result := True;
 132 end;
 133
 134 function TOpusLoader.Finished(): Boolean;
 135 begin
 136   Result := FFinished;
 137 end;
 138
 139 function TOpusLoader.Restart(): Boolean;
 140 begin
 141   Result := False;
 142   if (FOpus = nil) or (op_seekable(FOpus) = 0) then Exit;
 143   Result := op_pcm_seek(FOpus, 0) = 0;
 144   FFinished := False;
 145 end;
 146
 147 function TOpusLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 148 var
 149   Ret: cint;
 150   Rx: Integer;
 151 begin
 152   Result := 0;
 153   if FOpus = nil then Exit;
 154
 155   Rx := 0;
 156
 157   while Rx < Len do
 158   begin
 159     Ret := op_read_stereo(FOpus, Buf + Rx, (Len - Rx) div 2);
 160     if Ret = OP_HOLE then continue;
 161     if Ret < 0 then break;
 162     if Ret = 0 then
 163     begin
 164       if FLooping then
 165         op_pcm_seek(FOpus, 0)
 166       else
 167       begin
 168         FFinished := True;
 169         break;
 170       end;
 171     end;
 172     Rx := Rx + Ret * 4;
 173   end;
 174
 175   Result := Rx;
 176 end;
 177
 178 procedure TOpusLoader.Free();
 179 begin
 180   if FOpus <> nil then
 181     op_free(FOpus);
 182   if FBuf <> nil then
 183     FreeMem(FBuf);
 184   FOpus := nil;
 185   FBuf := nil;
 186   FStreaming := False;
 187   FFinished := False;
 188   FLooping := False;
 189 end;
 190
 191 initialization
 192   e_AddSoundLoader(TOpusLoaderFactory.Create());
 193 end.