src/engine/e_soundfile_wav.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_wav;
  17
  18 interface
  19
  20 uses e_soundfile;
  21
  22 type
  23   // a WAV loader that just uses SDL_LoadWAV
  24
  25   TWAVLoader = 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     FData: Pointer;
  35     FDataLen: LongWord;
  36     FDataPos: LongWord;
  37     FLooping: Boolean;
  38   end;
  39
  40   TWAVLoaderFactory = 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
  50   {$IFDEF USE_SDL}
  51     SDL,
  52   {$ELSE}
  53     SDL2,
  54   {$ENDIF}
  55   utils, ctypes, e_log;
  56
  57 (* TWAVLoaderFactory *)
  58
  59 function TWAVLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
  60 var
  61   P: PByte;
  62 begin
  63   if Len < 5 then
  64   begin
  65     Result := False;
  66     exit;
  67   end;
  68   P := PByte(Data);
  69   Result := ((P+0)^ = Ord('R')) and ((P+1)^ = Ord('I')) and ((P+2)^ = Ord('F')) and ((P+3)^ = Ord('F'));
  70 end;
  71
  72 function TWAVLoaderFactory.MatchExtension(FName: string): Boolean;
  73 begin
  74   // TODO: ehhh
  75   Result := GetFilenameExt(FName) = '.wav';
  76 end;
  77
  78 function TWAVLoaderFactory.GetLoader(): TSoundLoader;
  79 begin
  80   Result := TWAVLoader.Create();
  81 end;
  82
  83 (* TWAVLoader *)
  84 function ConvertSound (var buf: PUInt8; var len: UInt32; var format: UInt16; rate: cint; chan: UInt8): Boolean;
  85   var cvt: TSDL_AudioCVT; tformat: UInt16;
  86 begin
  87   result := true;
  88   case format of
  89     AUDIO_U8,     AUDIO_S8    : tformat := AUDIO_U8; (* yes, unsigned *)
  90     AUDIO_U16LSB, AUDIO_U16MSB: tformat := AUDIO_S16SYS; (* and yes, signed *)
  91     AUDIO_S16LSB, AUDIO_S16MSB: tformat := AUDIO_S16SYS;
  92     AUDIO_S32LSB, AUDIO_S32MSB: tformat := AUDIO_S16SYS; (* 32bit not supported in al core *)
  93     AUDIO_F32LSB, AUDIO_F32MSB: tformat := AUDIO_S16SYS; (* float not supported in al core *)
  94   else result := false (* unsupported format *)
  95   end;
  96   if (result = true) and (format <> tformat) then
  97   begin
  98     Result := False;
  99     if SDL_BuildAudioCVT(@cvt, format, chan, rate, tformat, chan, rate) <> -1 then
 100     begin
 101       buf := SDL_realloc(buf, len * cvt.len_mult);
 102       cvt.len := len;
 103       cvt.buf := buf;
 104       result := SDL_ConvertAudio(@cvt) = 0;
 105       len := cvt.len_cvt;
 106       format := tformat
 107     end
 108   end
 109 end;
 110
 111 function LoadWavRW (Loader: TWAVLoader; RW: PSDL_RWops): Boolean;
 112   var
 113     Spec: TSDL_AudioSpec;
 114     Len: UInt32;
 115     Buf: PUInt8;
 116 begin
 117   Result := False;
 118 {$IFDEF USE_SDL2}
 119   if SDL_LoadWAV_RW(RW, 0, @Spec, @Buf, @Len) <> nil then
 120 {$ELSE}
 121   if SDL_LoadWAV_RW(RW, 0, @Spec, PUInt8(@Buf), @Len) <> nil then
 122 {$ENDIF}
 123   begin
 124     Result := ConvertSound(Buf, Len, Spec.format, Spec.freq, Spec.channels);
 125     if Result = True then
 126     begin
 127       with Loader do
 128       begin
 129         FFormat.SampleRate := Spec.freq;
 130         {$IFDEF USE_SDL2}
 131           FFormat.SampleBits := SDL_AUDIO_BITSIZE(Spec.format);
 132         {$ELSE}
 133           FFormat.SampleBits := Spec.format and $FF;
 134         {$ENDIF}
 135         FFormat.Channels := Spec.channels;
 136         FDataPos := 0;
 137         FDataLen := Len;
 138         FData := Buf;
 139       end
 140     end
 141     else
 142     begin
 143       SDL_FreeWav(Buf)
 144     end
 145   end
 146 end;
 147
 148 function TWAVLoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
 149   var
 150     RW: PSDL_RWops;
 151 begin
 152   RW := SDL_RWFromConstMem(Data, Len);
 153   Result := LoadWavRW(Self, RW);
 154   if Result = False then
 155     e_LogWriteln('Could not load WAV: ' + SDL_GetError());
 156   SDL_RWclose(RW);
 157   FStreaming := False;
 158   FLooping := Loop;
 159 end;
 160
 161 function TWAVLoader.Load(FName: string; Loop: Boolean): Boolean;
 162   var
 163     RW: PSDL_RWops;
 164 begin
 165   RW := SDL_RWFromFile(PChar(FName), 'rb');
 166   if RW <> nil then
 167   begin
 168     Result := LoadWavRW(Self, RW);
 169     if Result = False then
 170       e_LogWritefln('Could not load WAV file `%s`: %s', [FName, SDL_GetError()]);
 171   end
 172   else
 173   begin
 174     e_LogWritefln('Could not open WAV file `%s`: %s', [FName, SDL_GetError()]);
 175     Result := False
 176   end;
 177   SDL_RWclose(RW);
 178   FStreaming := False;
 179   FLooping := Loop;
 180 end;
 181
 182 function TWAVLoader.Finished(): Boolean;
 183 begin
 184   Result := FDataPos >= FDataLen;
 185 end;
 186
 187 function TWAVLoader.Restart(): Boolean;
 188 begin
 189   Result := True;
 190   FDataPos := 0;
 191 end;
 192
 193 function TWAVLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 194 var
 195   OutPos: LongWord;
 196   Tx: LongWord;
 197 begin
 198   OutPos := 0;
 199   Result := 0;
 200
 201   while (FDataPos < FDataLen) and (OutPos < Len) do
 202   begin
 203     Tx := nmin(FDataLen - FDataPos, Len - OutPos);
 204     Move((FData + FDataPos)^, (Buf + OutPos)^, Tx);
 205
 206     FDataPos := FDataPos + Tx;
 207     OutPos := OutPos + Tx;
 208     Result := Result + Tx;
 209
 210     if (FDataPos >= FDataLen) and FLooping then
 211       FDataPos := 0;
 212   end;
 213 end;
 214
 215 procedure TWAVLoader.Free();
 216 begin
 217   if FData <> nil then
 218     SDL_FreeWAV(FData); // SDL allocates inside the DLL, so we need this
 219   FDataPos := 0;
 220   FData := nil;
 221   FDataLen := 0;
 222 end;
 223
 224 initialization
 225   e_AddSoundLoader(TWAVLoaderFactory.Create());
 226 end.