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