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, sz: Integer;
 109   soundExInfo: FMOD_CREATESOUNDEXINFO;
 110   res: FMOD_RESULT;
 111
 112 begin
 113   Result := False;
 114
 115   SoundData := nil;
 116   Sound := nil;
 117   Channel := nil;
 118
 119   g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 120
 121   WAD := TWADEditor_1.Create;
 122   WAD.ReadFile(FileName);
 123
 124   if WAD.GetResource(SectionName, ResourceName, SoundData, ResLength) then
 125     begin
 126       sz := SizeOf(FMOD_CREATESOUNDEXINFO);
 127       FillMemory(@soundExInfo, sz, 0);
 128       soundExInfo.cbsize := sz;
 129       soundExInfo.length := ResLength;
 130
 131       res := FMOD_System_CreateStream(F_System, SoundData,
 132         FMOD_LOOP_OFF + FMOD_2D + FMOD_SOFTWARE + FMOD_OPENMEMORY,
 133         @soundExInfo, Sound);
 134
 135       if res <> FMOD_OK then
 136       begin
 137         e_WriteLog(Format('Error creating sound %s', [Resource]), MSG_WARNING);
 138         e_WriteLog(FMOD_ErrorString(res), MSG_WARNING);
 139         WAD.Free();
 140         Exit;
 141       end;
 142     end
 143   else
 144     begin
 145       e_WriteLog(Format('Error loading sound %s', [Resource]), MSG_WARNING);
 146       e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 147       WAD.Free();
 148       Exit;
 149     end;
 150
 151   WAD.Free();
 152   Result := True;
 153 end;
 154
 155 procedure TAddSoundForm.bbPlayClick(Sender: TObject);
 156 var
 157   res: FMOD_RESULT;
 158
 159 begin
 160   Inherited;
 161
 162   if FResourceSelected then
 163   begin
 164     if Playing then
 165       bbStop.Click();
 166
 167     if not CreateSoundWAD(FFullResourceName) then
 168       Exit;
 169
 170     res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE,
 171              Sound, False, Channel);
 172     if res <> FMOD_OK then
 173     begin
 174       Application.MessageBox(FMOD_ErrorString(res),
 175                              PChar(_lc[I_MSG_SOUND_ERROR]),
 176                              MB_OK or MB_ICONHAND);
 177       Exit;
 178     end;
 179
 180     Playing := True;
 181
 182     FMOD_Channel_SetVolume(Channel, 1.0);
 183
 184     FSpectrum.SetChannel(Channel);
 185   end;
 186 end;
 187
 188 procedure TAddSoundForm.ShowSpectrum;
 189 begin
 190   if FSpectrum.Enabled then
 191     FSpectrum.Draw();
 192 end;
 193
 194 procedure TAddSoundForm.TimerTimer(Sender: TObject);
 195 var
 196   res: FMOD_RESULT;
 197   b: LongBool;
 198
 199 begin
 200   Inherited;
 201
 202   FMOD_System_Update(F_System);
 203
 204   ShowSpectrum();
 205
 206   res := FMOD_Channel_IsPlaying(Channel, b);
 207   if (res <> FMOD_OK) or (not b) then
 208     bbStop.Click();
 209 end;
 210
 211 procedure TAddSoundForm.FormDestroy(Sender: TObject);
 212 var
 213   res: FMOD_RESULT;
 214
 215 begin
 216   Inherited;
 217
 218   FSpectrum.Free;
 219
 220   res := FMOD_System_Close(F_System);
 221   if res <> FMOD_OK then
 222   begin
 223     e_WriteLog('Error closing FMOD system!', MSG_FATALERROR);
 224     e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR);
 225     Exit;
 226   end;
 227
 228   res := FMOD_System_Release(F_System);
 229   if res <> FMOD_OK then
 230   begin
 231     e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR);
 232     e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR);
 233   end;
 234 end;
 235
 236 procedure Sound_StopRelease();
 237 begin
 238   Playing := False;
 239
 240   if Channel <> nil then
 241     FMOD_Channel_Stop(Channel);
 242
 243   if Sound <> nil then
 244     FMOD_Sound_Release(Sound);
 245
 246   if SoundData <> nil then
 247     FreeMem(SoundData);
 248
 249   SoundData := nil;
 250   Sound := nil;
 251   Channel := nil;
 252 end;
 253
 254 procedure TAddSoundForm.FormClose(Sender: TObject;
 255                                   var Action: TCloseAction);
 256 begin
 257   Inherited;
 258
 259   Timer.Enabled := False;
 260
 261   FSpectrum.SetChannel(nil);
 262   Sound_StopRelease();
 263 end;
 264
 265 procedure TAddSoundForm.bbStopClick(Sender: TObject);
 266 begin
 267   Inherited;
 268
 269   FSpectrum.SetChannel(nil);
 270   Sound_StopRelease();
 271 end;
 272
 273 procedure TAddSoundForm.FormActivate(Sender: TObject);
 274 var
 275   FileName, SectionName, ResourceName: String;
 276   a: Integer;
 277
 278 begin
 279   Inherited;
 280
 281   Timer.Enabled := True;
 282
 283 // Уже есть выбранный ресурс:
 284   if FSetResource <> '' then
 285   begin
 286     g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
 287
 288     if FileName = '' then
 289       FileName := _lc[I_WAD_SPECIAL_MAP];
 290
 291     if SectionName = '' then
 292       SectionName := '..';
 293
 294   // WAD файл:
 295     a := cbWADList.Items.IndexOf(FileName);
 296     if a <> -1 then
 297     begin
 298       cbWADList.ItemIndex := a;
 299       cbWADList.OnChange(nil);
 300     end;
 301
 302   // Секция:
 303     a := cbSectionsList.Items.IndexOf(SectionName);
 304     if a <> -1 then
 305     begin
 306       cbSectionsList.ItemIndex := a;
 307       cbSectionsList.OnChange(nil);
 308     end;
 309
 310   // Ресурс:
 311     a := lbResourcesList.Items.IndexOf(ResourceName);
 312     if a <> -1 then
 313     begin
 314       lbResourcesList.ItemIndex := a;
 315       lbResourcesList.OnClick(nil);
 316     end;
 317   end;
 318 end;
 319
 320 procedure TAddSoundForm.bOKClick(Sender: TObject);
 321 begin
 322   inherited;
 323
 324   ModalResult := mrOk;
 325 end;
 326
 327 procedure TAddSoundForm.bEmptyClick(Sender: TObject);
 328 begin
 329   FResourceName := '';
 330   ModalResult := mrOk;
 331 end;
 332
 333 end.