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 FixSoundEndian (Buf: PUInt8; Len: UInt32; format: UInt16; rate: cint; chan: UInt8): Boolean;
  83   const
  84     {$IFDEF FPC_LITTLE_ENDIAN}
  85       TARGET_AUDIO_S16 = AUDIO_S16LSB;
  86       TARGET_AUDIO_U16 = AUDIO_U16LSB;
  87     {$ELSE}
  88       TARGET_AUDIO_S16 = AUDIO_S16MSB;
  89       TARGET_AUDIO_U16 = AUDIO_U16MSB;
  90     {$ENDIF}
  91   var cvt: TSDL_AudioCVT; tformat: UInt16;
  92 begin
  93   case format of
  94     AUDIO_U16LSB, AUDIO_U16MSB: tformat := TARGET_AUDIO_U16;
  95     AUDIO_S16LSB, AUDIO_S16MSB: tformat := TARGET_AUDIO_S16;
  96   else tformat := format
  97   end;
  98   Result := True;
  99   if format <> tformat then
 100   begin
 101     Result := False;
 102     if SDL_BuildAudioCVT(@cvt, format, chan, rate, tformat, chan, rate) <> -1 then
 103     begin
 104       cvt.buf := Buf;
 105       cvt.len := Len;
 106       assert(cvt.len_mult = 1);
 107       Result := SDL_ConvertAudio(@cvt) = 0;
 108       assert(cvt.len_ratio = 1);
 109       assert(cvt.len = Len)
 110     end
 111   end
 112 end;
 113
 114 function LoadWavRW (Loader: TWAVLoader; RW: PSDL_RWops): Boolean;
 115   var
 116     Spec: TSDL_AudioSpec;
 117     Len: UInt32;
 118     Buf: PUInt8;
 119 begin
 120   Result := False;
 121 {$IFDEF USE_SDL2}
 122   if SDL_LoadWAV_RW(RW, 0, @Spec, @Buf, @Len) <> nil then
 123 {$ELSE}
 124   if SDL_LoadWAV_RW(RW, 0, @Spec, PUInt8(@Buf), @Len) <> nil then
 125 {$ENDIF}
 126   begin
 127     Result := FixSoundEndian(Buf, Len, Spec.format, Spec.freq, Spec.channels);
 128     if Result = True then
 129     begin
 130       with Loader do
 131       begin
 132         FFormat.SampleRate := Spec.freq;
 133         {$IFDEF USE_SDL2}
 134           FFormat.SampleBits := SDL_AUDIO_BITSIZE(Spec.format);
 135         {$ELSE}
 136           FFormat.SampleBits := Spec.format and $FF;
 137         {$ENDIF}
 138         FFormat.Channels := Spec.channels;
 139         FStreaming := False; // never stream wavs
 140         FDataLen := Len;
 141         FData := Buf;
 142       end
 143     end
 144     else
 145     begin
 146       SDL_FreeWav(Buf)
 147     end
 148   end
 149 end;
 150
 151 function TWAVLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
 152   var
 153     RW: PSDL_RWops;
 154 begin
 155   RW := SDL_RWFromConstMem(Data, Len);
 156   Result := LoadWavRW(Self, RW);
 157   if Result = False then
 158     e_LogWriteln('Could not load WAV: ' + SDL_GetError());
 159   SDL_RWclose(RW);
 160 end;
 161
 162 function TWAVLoader.Load(FName: string; SStreaming: Boolean): Boolean;
 163   var
 164     RW: PSDL_RWops;
 165 begin
 166   RW := SDL_RWFromFile(PChar(FName), 'rb');
 167   if RW <> nil then
 168   begin
 169     Result := LoadWavRW(Self, RW);
 170     if Result = False then
 171       e_LogWritefln('Could not load WAV file `%s`: %s', [FName, SDL_GetError()]);
 172   end
 173   else
 174   begin
 175     e_LogWritefln('Could not open WAV file `%s`: %s', [FName, SDL_GetError()]);
 176     Result := False
 177   end;
 178   SDL_RWclose(RW);
 179 end;
 180
 181 function TWAVLoader.SetPosition(Pos: LongWord): Boolean;
 182 begin
 183   Result := False; // makes no sense when not streaming
 184 end;
 185
 186 function TWAVLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 187 begin
 188   if FDataLen < Len then
 189     Len := FDataLen;
 190   if FData <> nil then
 191   begin
 192     Move(FData^, Buf^, Len);
 193     Result := Len;
 194   end
 195   else
 196     Result := 0;
 197 end;
 198
 199 function TWAVLoader.GetAll(var OutPtr: Pointer): LongWord;
 200 begin
 201   OutPtr := FData;
 202   Result := FDataLen;
 203 end;
 204
 205 procedure TWAVLoader.Free();
 206 begin
 207   if FData <> nil then
 208     SDL_FreeWAV(FData); // SDL allocates inside the DLL, so we need this
 209 end;
 210
 211 initialization
 212   e_AddSoundLoader(TWAVLoaderFactory.Create());
 213 end.