DEADSOFTWARE

flush screenshot after writing
[d2df-sdl.git] / 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;
18 interface
20 uses e_soundfile;
22 type
23 // a WAV loader that just uses SDL_LoadWAV
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;
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;
45 implementation
47 uses
48 {$IFDEF USE_SDL}
49 SDL,
50 {$ELSE}
51 SDL2,
52 {$ENDIF}
53 utils, ctypes, e_log;
55 (* TWAVLoaderFactory *)
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;
70 function TWAVLoaderFactory.MatchExtension(FName: string): Boolean;
71 begin
72 // TODO: ehhh
73 Result := GetFilenameExt(FName) = '.wav';
74 end;
76 function TWAVLoaderFactory.GetLoader(): TSoundLoader;
77 begin
78 Result := TWAVLoader.Create();
79 end;
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;
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;
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;
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;
181 function TWAVLoader.SetPosition(Pos: LongWord): Boolean;
182 begin
183 Result := False; // makes no sense when not streaming
184 end;
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;
199 function TWAVLoader.GetAll(var OutPtr: Pointer): LongWord;
200 begin
201 OutPtr := FData;
202 Result := FDataLen;
203 end;
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;
211 initialization
212 e_AddSoundLoader(TWAVLoaderFactory.Create());
213 end.