src/editor/f_addresource_sound.pas

   1 unit f_addresource_sound;
   2
   3 {$INCLUDE ../shared/a_modes.inc}
   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, utils;
  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, WADEDITOR, e_log, f_main, g_language
  47 {$IFNDEF NOSOUND}, fmod, fmodtypes, fmoderrors;{$ELSE};{$ENDIF}
  48
  49 {$R *.lfm}
  50
  51 {$IFDEF NOSOUND}
  52 // fuck my life
  53 const
  54   FMOD_OK = 0;
  55
  56 type
  57   FMOD_SYSTEM = Pointer;
  58   FMOD_CHANNEL = Pointer;
  59   FMOD_SOUND = Pointer;
  60   FMOD_CREATESOUNDEXINFO = Pointer;
  61   FMOD_RESULT = Integer;
  62 {$ENDIF}
  63
  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;
  70
  71 procedure TAddSoundForm.FormCreate(Sender: TObject);
  72 var
  73   res: FMOD_RESULT;
  74   ver: Cardinal;
  75
  76 begin
  77   Inherited;
  78
  79   res := FMOD_OK;
  80
  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!');
  86
  87     res := FMOD_System_GetVersion(F_System, ver);
  88     if res <> FMOD_OK then
  89       raise Exception.Create('FMOD_System_GetVersion failed!');
  90
  91     if ver < FMOD_VERSION then
  92       raise Exception.Create('FMOD version is too old! Need '+IntToStr(FMOD_VERSION));
  93
  94     res := FMOD_System_SetOutput(F_System, FMOD_OUTPUTTYPE_WINMM);
  95     if res <> FMOD_OK then
  96       raise Exception.Create('FMOD_System_SetOutput failed!');
  97
  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!');
 102
 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!');
 106
 107   except
 108     Application.MessageBox(FMOD_ErrorString(res), 'Initialization', MB_OK or MB_ICONHAND);
 109     raise;
 110   end;
 111 {$ENDIF}
 112
 113   FSpectrum := TMiniSpectrum.Create(pSpectrum);
 114   FSpectrum.Align := alClient;
 115   FSpectrum.Enabled := True;
 116   FSpectrum.Style := ssBlock;
 117 end;
 118
 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;
 127
 128 begin
 129   Result := False;
 130   SoundData := nil;
 131   Sound := nil;
 132   Channel := nil;
 133 {$IFNDEF NOSOUND}
 134   g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 135
 136   WAD := TWADEditor_1.Create;
 137   WAD.ReadFile(FileName);
 138
 139   if WAD.GetResource(SectionName, 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);
 145
 146       res := FMOD_System_CreateStream(F_System, SoundData,
 147         FMOD_LOOP_OFF or FMOD_2D or FMOD_OPENMEMORY,
 148         @soundExInfo, Sound);
 149
 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;
 165
 166   WAD.Free();
 167   Result := True;
 168 {$ENDIF}
 169 end;
 170
 171 procedure TAddSoundForm.bbPlayClick(Sender: TObject);
 172 var
 173   res: FMOD_RESULT;
 174
 175 begin
 176   Inherited;
 177
 178   if FResourceSelected then
 179   begin
 180     if Playing then
 181       bbStop.Click();
 182
 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;
 195
 196     Playing := True;
 197
 198     FMOD_Channel_SetVolume(Channel, 1.0);
 199
 200     FSpectrum.SetChannel(Channel);
 201 {$ENDIF}
 202   end;
 203 end;
 204
 205 procedure TAddSoundForm.ShowSpectrum;
 206 begin
 207   if FSpectrum.Enabled then
 208     FSpectrum.Draw();
 209 end;
 210
 211 procedure TAddSoundForm.TimerTimer(Sender: TObject);
 212 var
 213   res: FMOD_RESULT;
 214   b: LongBool;
 215
 216 begin
 217   Inherited;
 218 {$IFNDEF NOSOUND}
 219   FMOD_System_Update(F_System);
 220
 221   ShowSpectrum();
 222
 223   res := FMOD_Channel_IsPlaying(Channel, b);
 224   if (res <> FMOD_OK) or (not b) then
 225     bbStop.Click();
 226 {$ENDIF}
 227 end;
 228
 229 procedure TAddSoundForm.FormDestroy(Sender: TObject);
 230 var
 231   res: FMOD_RESULT;
 232
 233 begin
 234   Inherited;
 235
 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;
 245
 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;
 254
 255 procedure Sound_StopRelease();
 256 begin
 257   Playing := False;
 258 {$IFNDEF NOSOUND}
 259   if Channel <> nil then
 260     FMOD_Channel_Stop(Channel);
 261
 262   if Sound <> nil then
 263     FMOD_Sound_Release(Sound);
 264 {$ENDIF}
 265   if SoundData <> nil then
 266     FreeMem(SoundData);
 267
 268   SoundData := nil;
 269   Sound := nil;
 270   Channel := nil;
 271 end;
 272
 273 procedure TAddSoundForm.FormClose(Sender: TObject;
 274                                   var Action: TCloseAction);
 275 begin
 276   Inherited;
 277
 278   Timer.Enabled := False;
 279
 280   FSpectrum.SetChannel(nil);
 281   Sound_StopRelease();
 282 end;
 283
 284 procedure TAddSoundForm.bbStopClick(Sender: TObject);
 285 begin
 286   Inherited;
 287
 288   FSpectrum.SetChannel(nil);
 289   Sound_StopRelease();
 290 end;
 291
 292 procedure TAddSoundForm.FormActivate(Sender: TObject);
 293 var
 294   FileName, SectionName, ResourceName: String;
 295   a: Integer;
 296
 297 begin
 298   Inherited;
 299
 300   Timer.Enabled := True;
 301
 302 // Уже есть выбранный ресурс:
 303   if FSetResource <> '' then
 304   begin
 305     g_ProcessResourceStr(FSetResource, FileName, SectionName, ResourceName);
 306
 307     if FileName = '' then
 308       FileName := _lc[I_WAD_SPECIAL_MAP];
 309
 310     if SectionName = '' then
 311       SectionName := '..';
 312
 313   // WAD файл:
 314     a := cbWADList.Items.IndexOf(win2utf(FileName));
 315     if a <> -1 then
 316     begin
 317       cbWADList.ItemIndex := a;
 318       cbWADList.OnChange(nil);
 319     end;
 320
 321   // Секция:
 322     a := cbSectionsList.Items.IndexOf(win2utf(SectionName));
 323     if a <> -1 then
 324     begin
 325       cbSectionsList.ItemIndex := a;
 326       cbSectionsList.OnChange(nil);
 327     end;
 328
 329   // Ресурс:
 330     a := lbResourcesList.Items.IndexOf(win2utf(ResourceName));
 331     if a <> -1 then
 332     begin
 333       lbResourcesList.ItemIndex := a;
 334       lbResourcesList.OnClick(nil);
 335     end;
 336   end;
 337 end;
 338
 339 procedure TAddSoundForm.bOKClick(Sender: TObject);
 340 begin
 341   inherited;
 342
 343   ModalResult := mrOk;
 344 end;
 345
 346 procedure TAddSoundForm.bEmptyClick(Sender: TObject);
 347 begin
 348   FResourceName := '';
 349   ModalResult := mrOk;
 350 end;
 351
 352 end.