DEADSOFTWARE

c6406d0769f032f19fa96621a193538f9106a6a0
[d2df-editor.git] / src / editor / f_addresource_sound.pas
1 unit f_addresource_sound;
3 {$INCLUDE ../shared/a_modes.inc}
5 interface
7 uses
8 LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
9 Graphics, Controls, Forms, Dialogs, f_addresource,
10 ExtCtrls, StdCtrls, spectrum, Buttons, ComCtrls, utils;
12 type
13 TAddSoundForm = class (TAddResourceForm)
14 pSpectrum: TPanel;
15 bbPlay: TBitBtn;
16 bbStop: TBitBtn;
17 Timer: TTimer;
18 bEmpty: TButton;
20 procedure FormCreate(Sender: TObject);
21 procedure bbPlayClick(Sender: TObject);
22 procedure TimerTimer(Sender: TObject);
23 procedure FormDestroy(Sender: TObject);
24 procedure FormClose(Sender: TObject; var Action: TCloseAction);
25 procedure bbStopClick(Sender: TObject);
26 procedure FormActivate(Sender: TObject);
27 procedure bOKClick(Sender: TObject);
28 procedure bEmptyClick(Sender: TObject);
30 private
31 FSpectrum: TMiniSpectrum;
32 FSetResource: String;
34 procedure ShowSpectrum();
36 public
37 property SetResource: String read FSetResource write FSetResource;
38 end;
40 var
41 AddSoundForm: TAddSoundForm;
43 implementation
45 uses
46 BinEditor, WADEDITOR, e_log, f_main, g_language
47 {$IFNDEF NOSOUND}, fmod, fmodtypes, fmoderrors;{$ELSE};{$ENDIF}
49 {$R *.lfm}
51 {$IFDEF NOSOUND}
52 // fuck my life
53 const
54 FMOD_OK = 0;
56 type
57 FMOD_SYSTEM = Pointer;
58 FMOD_CHANNEL = Pointer;
59 FMOD_SOUND = Pointer;
60 FMOD_CREATESOUNDEXINFO = Pointer;
61 FMOD_RESULT = Integer;
62 {$ENDIF}
64 var
65 F_System: FMOD_SYSTEM;
66 SoundData: Pointer = nil;
67 Sound: FMOD_SOUND = nil;
68 Channel: FMOD_CHANNEL = nil;
69 Playing: Boolean = False;
71 procedure TAddSoundForm.FormCreate(Sender: TObject);
72 var
73 res: FMOD_RESULT;
74 ver: Cardinal;
76 begin
77 Inherited;
79 res := FMOD_OK;
81 {$IFNDEF NOSOUND}
82 try
83 res := FMOD_System_Create(F_System);
84 if res <> FMOD_OK then
85 raise Exception.Create('FMOD_System_Create failed!');
87 res := FMOD_System_GetVersion(F_System, ver);
88 if res <> FMOD_OK then
89 raise Exception.Create('FMOD_System_GetVersion failed!');
91 if ver < FMOD_VERSION then
92 raise Exception.Create('FMOD version is too old! Need '+IntToStr(FMOD_VERSION));
94 res := FMOD_System_SetOutput(F_System, FMOD_OUTPUTTYPE_WINMM);
95 if res <> FMOD_OK then
96 raise Exception.Create('FMOD_System_SetOutput failed!');
98 res := FMOD_System_SetSoftwareFormat(F_System, 48000,
99 FMOD_SOUND_FORMAT_PCM16, 0, 0, FMOD_DSP_RESAMPLER_LINEAR);
100 if res <> FMOD_OK then
101 raise Exception.Create('FMOD_System_SetSoftwareFormat failed!');
103 res := FMOD_System_Init(F_System, 64, FMOD_INIT_NORMAL, nil);
104 if res <> FMOD_OK then
105 raise Exception.Create('FMOD_System_Init failed!');
107 except
108 Application.MessageBox(FMOD_ErrorString(res), 'Initialization', MB_OK or MB_ICONHAND);
109 raise;
110 end;
111 {$ENDIF}
113 FSpectrum := TMiniSpectrum.Create(pSpectrum);
114 FSpectrum.Align := alClient;
115 FSpectrum.Enabled := True;
116 FSpectrum.Style := ssBlock;
117 end;
119 function CreateSoundWAD(Resource: String): Boolean;
120 var
121 WAD: TWADEditor_1;
122 FileName, SectionName, ResourceName: String;
123 ResLength: Integer;
124 sz: LongWord;
125 soundExInfo: FMOD_CREATESOUNDEXINFO;
126 res: FMOD_RESULT;
128 begin
129 Result := False;
130 SoundData := nil;
131 Sound := nil;
132 Channel := nil;
133 {$IFNDEF NOSOUND}
134 g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
136 WAD := TWADEditor_1.Create;
137 WAD.ReadFile(FileName);
139 if WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), SoundData, ResLength) then
140 begin
141 sz := SizeOf(FMOD_CREATESOUNDEXINFO);
142 FillMemory(@soundExInfo, sz, 0);
143 soundExInfo.cbsize := sz;
144 soundExInfo.length := LongWord(ResLength);
146 res := FMOD_System_CreateStream(F_System, SoundData,
147 FMOD_LOOP_OFF or FMOD_2D or FMOD_OPENMEMORY,
148 @soundExInfo, Sound);
150 if res <> FMOD_OK then
151 begin
152 e_WriteLog(Format('Error creating sound %s', [Resource]), MSG_WARNING);
153 e_WriteLog(FMOD_ErrorString(res), MSG_WARNING);
154 WAD.Free();
155 Exit;
156 end;
157 end
158 else
159 begin
160 e_WriteLog(Format('Error loading sound %s', [Resource]), MSG_WARNING);
161 e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
162 WAD.Free();
163 Exit;
164 end;
166 WAD.Free();
167 Result := True;
168 {$ENDIF}
169 end;
171 procedure TAddSoundForm.bbPlayClick(Sender: TObject);
172 var
173 res: FMOD_RESULT;
175 begin
176 Inherited;
178 if FResourceSelected then
179 begin
180 if Playing then
181 bbStop.Click();
183 if not CreateSoundWAD(FFullResourceName) then
184 Exit;
185 {$IFNDEF NOSOUND}
186 res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE,
187 Sound, False, Channel);
188 if res <> FMOD_OK then
189 begin
190 Application.MessageBox(FMOD_ErrorString(res),
191 PChar(_lc[I_MSG_SOUND_ERROR]),
192 MB_OK or MB_ICONHAND);
193 Exit;
194 end;
196 Playing := True;
198 FMOD_Channel_SetVolume(Channel, 1.0);
200 FSpectrum.SetChannel(Channel);
201 {$ENDIF}
202 end;
203 end;
205 procedure TAddSoundForm.ShowSpectrum;
206 begin
207 if FSpectrum.Enabled then
208 FSpectrum.Draw();
209 end;
211 procedure TAddSoundForm.TimerTimer(Sender: TObject);
212 var
213 res: FMOD_RESULT;
214 b: LongBool;
216 begin
217 Inherited;
218 {$IFNDEF NOSOUND}
219 FMOD_System_Update(F_System);
221 ShowSpectrum();
223 res := FMOD_Channel_IsPlaying(Channel, b);
224 if (res <> FMOD_OK) or (not b) then
225 bbStop.Click();
226 {$ENDIF}
227 end;
229 procedure TAddSoundForm.FormDestroy(Sender: TObject);
230 var
231 res: FMOD_RESULT;
233 begin
234 Inherited;
236 FSpectrum.Free;
237 {$IFNDEF NOSOUND}
238 res := FMOD_System_Close(F_System);
239 if res <> FMOD_OK then
240 begin
241 e_WriteLog('Error closing FMOD system!', MSG_FATALERROR);
242 e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR);
243 Exit;
244 end;
246 res := FMOD_System_Release(F_System);
247 if res <> FMOD_OK then
248 begin
249 e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR);
250 e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR);
251 end;
252 {$ENDIF}
253 end;
255 procedure Sound_StopRelease();
256 begin
257 Playing := False;
258 {$IFNDEF NOSOUND}
259 if Channel <> nil then
260 FMOD_Channel_Stop(Channel);
262 if Sound <> nil then
263 FMOD_Sound_Release(Sound);
264 {$ENDIF}
265 if SoundData <> nil then
266 FreeMem(SoundData);
268 SoundData := nil;
269 Sound := nil;
270 Channel := nil;
271 end;
273 procedure TAddSoundForm.FormClose(Sender: TObject;
274 var Action: TCloseAction);
275 begin
276 Inherited;
278 Timer.Enabled := False;
280 FSpectrum.SetChannel(nil);
281 Sound_StopRelease();
282 end;
284 procedure TAddSoundForm.bbStopClick(Sender: TObject);
285 begin
286 Inherited;
288 FSpectrum.SetChannel(nil);
289 Sound_StopRelease();
290 end;
292 procedure TAddSoundForm.FormActivate(Sender: TObject);
293 var
294 FileName, SectionName, ResourceName: String;
295 a: Integer;
297 begin
298 Inherited;
300 Timer.Enabled := True;
302 // Уже есть выбранный ресурс:
303 if FSetResource <> '' then
304 begin
305 g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
307 if FileName = '' then
308 FileName := _lc[I_WAD_SPECIAL_MAP];
310 if SectionName = '' then
311 SectionName := '..';
313 // WAD файл:
314 a := cbWADList.Items.IndexOf(FileName);
315 if a <> -1 then
316 begin
317 cbWADList.ItemIndex := a;
318 cbWADList.OnChange(nil);
319 end;
321 // Секция:
322 a := cbSectionsList.Items.IndexOf(SectionName);
323 if a <> -1 then
324 begin
325 cbSectionsList.ItemIndex := a;
326 cbSectionsList.OnChange(nil);
327 end;
329 // Ресурс:
330 a := lbResourcesList.Items.IndexOf(ResourceName);
331 if a <> -1 then
332 begin
333 lbResourcesList.ItemIndex := a;
334 lbResourcesList.OnClick(nil);
335 end;
336 end;
337 end;
339 procedure TAddSoundForm.bOKClick(Sender: TObject);
340 begin
341 inherited;
343 ModalResult := mrOk;
344 end;
346 procedure TAddSoundForm.bEmptyClick(Sender: TObject);
347 begin
348 FResourceName := '';
349 ModalResult := mrOk;
350 end;
352 end.