src/editor/f_addresource_sound.pas

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