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, cmem,
  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     {$IFDEF USE_SDL2}
  93     AUDIO_S32LSB, AUDIO_S32MSB: tformat := AUDIO_S16SYS; (* 32bit not supported in al core *)
  94     AUDIO_F32LSB, AUDIO_F32MSB: tformat := AUDIO_S16SYS; (* float not supported in al core *)
  95     {$ENDIF}
  96   else result := false (* unsupported format *)
  97   end;
  98   if (result = true) and (format <> tformat) then
  99   begin
 100     Result := False;
 101     if SDL_BuildAudioCVT(@cvt, format, chan, rate, tformat, chan, rate) <> -1 then
 102     begin
 103       {$IFDEF USE_SDL2}
 104         buf := SDL_realloc(buf, len * cvt.len_mult);
 105       {$ELSE}
 106         buf := realloc(buf, len * cvt.len_mult);
 107       {$ENDIF}
 108       cvt.len := len;
 109       cvt.buf := buf;
 110       result := SDL_ConvertAudio(@cvt) = 0;
 111       len := cvt.len_cvt;
 112       format := tformat
 113     end
 114   end
 115 end;
 116
 117 function LoadWavRW (Loader: TWAVLoader; RW: PSDL_RWops): Boolean;
 118   var
 119     Spec: TSDL_AudioSpec;
 120     Len: UInt32;
 121     Buf: PUInt8;
 122 begin
 123   Result := False;
 124 {$IFDEF USE_SDL2}
 125   if SDL_LoadWAV_RW(RW, 0, @Spec, @Buf, @Len) <> nil then
 126 {$ELSE}
 127   if SDL_LoadWAV_RW(RW, 0, @Spec, PUInt8(@Buf), @Len) <> nil then
 128 {$ENDIF}
 129   begin
 130     Result := ConvertSound(Buf, Len, Spec.format, Spec.freq, Spec.channels);
 131     if Result = True then
 132     begin
 133       with Loader do
 134       begin
 135         FFormat.SampleRate := Spec.freq;
 136         {$IFDEF USE_SDL2}
 137           FFormat.SampleBits := SDL_AUDIO_BITSIZE(Spec.format);
 138         {$ELSE}
 139           FFormat.SampleBits := Spec.format and $FF;
 140         {$ENDIF}
 141         FFormat.Channels := Spec.channels;
 142         FDataPos := 0;
 143         FDataLen := Len;
 144         FData := Buf;
 145       end
 146     end
 147     else
 148     begin
 149       SDL_FreeWav(Buf)
 150     end
 151   end
 152 end;
 153
 154 function TWAVLoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
 155   var
 156     RW: PSDL_RWops;
 157 begin
 158   RW := SDL_RWFromConstMem(Data, Len);
 159   Result := LoadWavRW(Self, RW);
 160   if Result = False then
 161     e_LogWriteln('Could not load WAV: ' + SDL_GetError());
 162   SDL_RWclose(RW);
 163   FStreaming := False;
 164   FLooping := Loop;
 165 end;
 166
 167 function TWAVLoader.Load(FName: string; Loop: Boolean): Boolean;
 168   var
 169     RW: PSDL_RWops;
 170 begin
 171   RW := SDL_RWFromFile(PChar(FName), 'rb');
 172   if RW <> nil then
 173   begin
 174     Result := LoadWavRW(Self, RW);
 175     if Result = False then
 176       e_LogWritefln('Could not load WAV file `%s`: %s', [FName, SDL_GetError()]);
 177   end
 178   else
 179   begin
 180     e_LogWritefln('Could not open WAV file `%s`: %s', [FName, SDL_GetError()]);
 181     Result := False
 182   end;
 183   SDL_RWclose(RW);
 184   FStreaming := False;
 185   FLooping := Loop;
 186 end;
 187
 188 function TWAVLoader.Finished(): Boolean;
 189 begin
 190   Result := FDataPos >= FDataLen;
 191 end;
 192
 193 function TWAVLoader.Restart(): Boolean;
 194 begin
 195   Result := True;
 196   FDataPos := 0;
 197 end;
 198
 199 function TWAVLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 200 var
 201   OutPos: LongWord;
 202   Tx: LongWord;
 203 begin
 204   OutPos := 0;
 205   Result := 0;
 206
 207   while (FDataPos < FDataLen) and (OutPos < Len) do
 208   begin
 209     Tx := nmin(FDataLen - FDataPos, Len - OutPos);
 210     Move((FData + FDataPos)^, (Buf + OutPos)^, Tx);
 211
 212     FDataPos := FDataPos + Tx;
 213     OutPos := OutPos + Tx;
 214     Result := Result + Tx;
 215
 216     if (FDataPos >= FDataLen) and FLooping then
 217       FDataPos := 0;
 218   end;
 219 end;
 220
 221 procedure TWAVLoader.Free();
 222 begin
 223   if FData <> nil then
 224     SDL_FreeWAV(FData); // SDL allocates inside the DLL, so we need this
 225   FDataPos := 0;
 226   FData := nil;
 227   FDataLen := 0;
 228 end;
 229
 230 initialization
 231   e_AddSoundLoader(TWAVLoaderFactory.Create());
 232 end.