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