From: fgsfds Date: Wed, 30 Aug 2017 02:52:09 +0000 (+0300) Subject: fixed wadeditor; added nosound mode; fixed codepage problems; fixed pointers; cleanup X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=3dc2fe6b3d29cd54425db8f590e922f2dce50e99;p=d2df-editor.git fixed wadeditor; added nosound mode; fixed codepage problems; fixed pointers; cleanup --- diff --git a/src/editor/Editor.lpi b/src/editor/Editor.lpi index 6125b97..db37c8d 100644 --- a/src/editor/Editor.lpi +++ b/src/editor/Editor.lpi @@ -1,11 +1,9 @@ - + - - @@ -22,6 +20,9 @@ + + + @@ -240,18 +241,12 @@ - - - - - - diff --git a/src/editor/Editor.lpr b/src/editor/Editor.lpr index 647bfae..71f5906 100644 --- a/src/editor/Editor.lpr +++ b/src/editor/Editor.lpr @@ -1,6 +1,6 @@ program Editor; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} uses Forms, Interfaces, @@ -37,10 +37,12 @@ uses f_packmap in 'f_packmap.pas' {PackMapForm}, f_maptest in 'f_maptest.pas' {MapTestForm}, f_choosetype in 'f_choosetype.pas' {ChooseTypeForm}, +{$IFNDEF NOSOUND} fmod, fmoderrors, fmodpresets, fmodtypes, +{$ENDIF} ImagingTypes, Imaging, ImagingUtility, diff --git a/src/editor/f_about.pas b/src/editor/f_about.pas index 3fdd29e..d073f58 100644 --- a/src/editor/f_about.pas +++ b/src/editor/f_about.pas @@ -1,6 +1,6 @@ unit f_about; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_activationtype.pas b/src/editor/f_activationtype.pas index 8d9a873..aee0c30 100644 --- a/src/editor/f_activationtype.pas +++ b/src/editor/f_activationtype.pas @@ -1,6 +1,6 @@ unit f_activationtype; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_addresource.pas b/src/editor/f_addresource.pas index 60fd18f..514cf5c 100644 --- a/src/editor/f_addresource.pas +++ b/src/editor/f_addresource.pas @@ -1,6 +1,6 @@ unit f_addresource; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface @@ -45,7 +45,7 @@ var implementation uses - f_main, WADSTRUCT, g_language; + f_main, WADSTRUCT, g_language, utils; {$R *.lfm} @@ -114,7 +114,7 @@ begin // Внешний WAD: if cbWADList.Text <> _lc[I_WAD_SPECIAL_MAP] then - FileName := EditorDir+'wads/'+cbWADList.Text + FileName := EditorDir+'wads/'+utf2win(cbWADList.Text) else // WAD карты: begin g_ProcessResourceStr(OpenedMap, fn, sn, rn); @@ -132,7 +132,7 @@ begin if SectionList <> nil then for i := 0 to High(SectionList) do if SectionList[i] <> '' then - cbSectionsList.Items.Add(SectionList[i]) + cbSectionsList.Items.Add(win2utf(SectionList[i])) else cbSectionsList.Items.Add('..'); end; @@ -149,7 +149,7 @@ begin // Внешний WAD: if cbWADList.Text <> _lc[I_WAD_SPECIAL_MAP] then - FileName := EditorDir+'wads/'+cbWADList.Text + FileName := EditorDir+'wads/'+utf2win(cbWADList.Text) else // WAD карты: begin g_ProcessResourceStr(OpenedMap, fn, sn, rn); @@ -160,7 +160,7 @@ begin WAD.ReadFile(FileName); if cbSectionsList.Text <> '..' then - SectionName := cbSectionsList.Text + SectionName := utf2win(cbSectionsList.Text) else SectionName := ''; @@ -173,7 +173,7 @@ begin if ResourceList <> nil then for i := 0 to High(ResourceList) do - lbResourcesList.Items.Add(ResourceList[i]); + lbResourcesList.Items.Add(win2utf(ResourceList[i])); end; procedure TAddResourceForm.lbResourcesListClick(Sender: TObject); @@ -194,14 +194,14 @@ begin if cbSectionsList.Text = '..' then SectionName := '' else - SectionName := cbSectionsList.Text; + SectionName := utf2win(cbSectionsList.Text); if cbWADList.Text[1] <> '<' then - FileName := cbWADList.Text + FileName := utf2win(cbWADList.Text) else FileName := ''; - FResourceName := FileName+':'+SectionName+'\'+lbResourcesList.Items[lbResourcesList.ItemIndex]; + FResourceName := FileName+':'+SectionName+'\'+utf2win(lbResourcesList.Items[lbResourcesList.ItemIndex]); if FileName <> '' then FFullResourceName := EditorDir+'wads/'+FResourceName diff --git a/src/editor/f_addresource_sky.pas b/src/editor/f_addresource_sky.pas index fb5bd5f..2f2c25f 100644 --- a/src/editor/f_addresource_sky.pas +++ b/src/editor/f_addresource_sky.pas @@ -1,13 +1,13 @@ unit f_addresource_sky; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface uses LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, f_addresource, - ExtCtrls, StdCtrls; + ExtCtrls, StdCtrls, utils; type TAddSkyForm = class (TAddResourceForm) @@ -35,21 +35,6 @@ uses {$R *.lfm} -procedure SwapRGB(data: Pointer; Size: Integer); -asm - mov ebx, eax - mov ecx, size - -@@loop : - mov al,[ebx+0] - mov ah,[ebx+2] - mov [ebx+2],al - mov [ebx+0],ah - add ebx,3 - dec ecx - jnz @@loop -end; - function ShowTGATexture(ResourceStr: String): TBitMap; var TGAHeader: packed record // Header type for TGA images @@ -183,7 +168,7 @@ begin SectionName := '..'; // WAD файл: - a := cbWADList.Items.IndexOf(FileName); + a := cbWADList.Items.IndexOf(win2utf(FileName)); if a <> -1 then begin cbWADList.ItemIndex := a; @@ -191,7 +176,7 @@ begin end; // Секция: - a := cbSectionsList.Items.IndexOf(SectionName); + a := cbSectionsList.Items.IndexOf(win2utf(SectionName)); if a <> -1 then begin cbSectionsList.ItemIndex := a; @@ -199,7 +184,7 @@ begin end; // Ресурс: - a := lbResourcesList.Items.IndexOf(ResourceName); + a := lbResourcesList.Items.IndexOf(win2utf(ResourceName)); if a <> -1 then begin lbResourcesList.ItemIndex := a; diff --git a/src/editor/f_addresource_sound.pas b/src/editor/f_addresource_sound.pas index 2dfc49d..55508f0 100644 --- a/src/editor/f_addresource_sound.pas +++ b/src/editor/f_addresource_sound.pas @@ -1,13 +1,13 @@ unit f_addresource_sound; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface uses LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, f_addresource, - ExtCtrls, StdCtrls, spectrum, Buttons, ComCtrls; + ExtCtrls, StdCtrls, spectrum, Buttons, ComCtrls, utils; type TAddSoundForm = class (TAddResourceForm) @@ -43,11 +43,24 @@ var implementation uses - BinEditor, fmod, fmodtypes, fmoderrors, WADEDITOR, e_log, f_main, - g_language; + BinEditor, WADEDITOR, e_log, f_main, g_language +{$IFNDEF NOSOUND}, fmod, fmodtypes, fmoderrors;{$ELSE};{$ENDIF} {$R *.lfm} +{$IFDEF NOSOUND} +// fuck my life +const + FMOD_OK = 0; + +type + FMOD_SYSTEM = Pointer; + FMOD_CHANNEL = Pointer; + FMOD_SOUND = Pointer; + FMOD_CREATESOUNDEXINFO = Pointer; + FMOD_RESULT = Integer; +{$ENDIF} + var F_System: FMOD_SYSTEM; SoundData: Pointer = nil; @@ -65,6 +78,7 @@ begin res := FMOD_OK; +{$IFNDEF NOSOUND} try res := FMOD_System_Create(F_System); if res <> FMOD_OK then @@ -94,6 +108,7 @@ begin Application.MessageBox(FMOD_ErrorString(res), 'Initialization', MB_OK or MB_ICONHAND); raise; end; +{$ENDIF} FSpectrum := TMiniSpectrum.Create(pSpectrum); FSpectrum.Align := alClient; @@ -112,11 +127,10 @@ var begin Result := False; - SoundData := nil; Sound := nil; Channel := nil; - +{$IFNDEF NOSOUND} g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName); WAD := TWADEditor_1.Create; @@ -151,6 +165,7 @@ begin WAD.Free(); Result := True; +{$ENDIF} end; procedure TAddSoundForm.bbPlayClick(Sender: TObject); @@ -167,7 +182,7 @@ begin if not CreateSoundWAD(FFullResourceName) then Exit; - +{$IFNDEF NOSOUND} res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, Sound, False, Channel); if res <> FMOD_OK then @@ -183,6 +198,7 @@ begin FMOD_Channel_SetVolume(Channel, 1.0); FSpectrum.SetChannel(Channel); +{$ENDIF} end; end; @@ -199,7 +215,7 @@ var begin Inherited; - +{$IFNDEF NOSOUND} FMOD_System_Update(F_System); ShowSpectrum(); @@ -207,6 +223,7 @@ begin res := FMOD_Channel_IsPlaying(Channel, b); if (res <> FMOD_OK) or (not b) then bbStop.Click(); +{$ENDIF} end; procedure TAddSoundForm.FormDestroy(Sender: TObject); @@ -217,7 +234,7 @@ begin Inherited; FSpectrum.Free; - +{$IFNDEF NOSOUND} res := FMOD_System_Close(F_System); if res <> FMOD_OK then begin @@ -232,18 +249,19 @@ begin e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR); e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); end; +{$ENDIF} end; procedure Sound_StopRelease(); begin Playing := False; - +{$IFNDEF NOSOUND} if Channel <> nil then FMOD_Channel_Stop(Channel); if Sound <> nil then FMOD_Sound_Release(Sound); - +{$ENDIF} if SoundData <> nil then FreeMem(SoundData); @@ -293,7 +311,7 @@ begin SectionName := '..'; // WAD файл: - a := cbWADList.Items.IndexOf(FileName); + a := cbWADList.Items.IndexOf(win2utf(FileName)); if a <> -1 then begin cbWADList.ItemIndex := a; @@ -301,7 +319,7 @@ begin end; // Секция: - a := cbSectionsList.Items.IndexOf(SectionName); + a := cbSectionsList.Items.IndexOf(win2utf(SectionName)); if a <> -1 then begin cbSectionsList.ItemIndex := a; @@ -309,7 +327,7 @@ begin end; // Ресурс: - a := lbResourcesList.Items.IndexOf(ResourceName); + a := lbResourcesList.Items.IndexOf(win2utf(ResourceName)); if a <> -1 then begin lbResourcesList.ItemIndex := a; diff --git a/src/editor/f_addresource_texture.pas b/src/editor/f_addresource_texture.pas index ce9a073..195b22d 100644 --- a/src/editor/f_addresource_texture.pas +++ b/src/editor/f_addresource_texture.pas @@ -1,13 +1,13 @@ unit f_addresource_texture; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface uses LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, f_addresource, - StdCtrls, ExtCtrls; + StdCtrls, ExtCtrls, utils; type TAddTextureForm = class (TAddResourceForm) @@ -503,8 +503,8 @@ begin for i := 0 to lbResourcesList.Count-1 do if lbResourcesList.Selected[i] then begin - AddTexture(cbWADlist.Text, cbSectionsList.Text, - lbResourcesList.Items[i], False); + AddTexture(utf2win(cbWADlist.Text), utf2win(cbSectionsList.Text), + utf2win(lbResourcesList.Items[i]), False); lbResourcesList.Selected[i] := False; end; end; diff --git a/src/editor/f_choosetype.pas b/src/editor/f_choosetype.pas index 98e8cc7..291819b 100644 --- a/src/editor/f_choosetype.pas +++ b/src/editor/f_choosetype.pas @@ -1,6 +1,6 @@ unit f_choosetype; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_keys.pas b/src/editor/f_keys.pas index dd71caa..576b573 100644 --- a/src/editor/f_keys.pas +++ b/src/editor/f_keys.pas @@ -1,6 +1,6 @@ unit f_keys; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index 9a976f6..d429811 100644 --- a/src/editor/f_main.pas +++ b/src/editor/f_main.pas @@ -1,6 +1,6 @@ unit f_main; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface @@ -8,7 +8,7 @@ uses LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ImgList, StdCtrls, Buttons, ComCtrls, ValEdit, Types, ToolWin, Menus, ExtCtrls, - CheckLst, Grids, OpenGLContext; + CheckLst, Grids, OpenGLContext, utils; type @@ -1880,6 +1880,7 @@ var ok: Boolean; FileName: String; ResourceName: String; + UResourceName: String; FullResourceName: String; SectionName: String; Data: Pointer; @@ -1911,14 +1912,15 @@ begin end; ok := True; + UResourceName := win2utf(ResourceName); // Есть ли уже такая текстура: for a := 0 to MainForm.lbTextureList.Items.Count-1 do - if ResourceName = MainForm.lbTextureList.Items[a] then + if UResourceName = MainForm.lbTextureList.Items[a] then begin if not silent then ErrorMessageBox(Format(_lc[I_MSG_TEXTURE_ALREADY], - [ResourceName])); + [UResourceName])); ok := False; end; @@ -1927,7 +1929,7 @@ begin begin if not silent then ErrorMessageBox(Format(_lc[I_MSG_RES_NAME_64], - [ResourceName])); + [UResourceName])); ok := False; end; @@ -1936,7 +1938,7 @@ begin a := -1; if aWAD = _lc[I_WAD_SPECIAL_TEXS] then begin - a := MainForm.lbTextureList.Items.Add(ResourceName); + a := MainForm.lbTextureList.Items.Add(UResourceName); if not silent then SelectTexture(a); Result := True; @@ -1950,12 +1952,12 @@ begin GetFrame(FullResourceName, Data, FrameLen, Width, Height); if g_CreateTextureMemorySize(Data, FrameLen, ResourceName, 0, 0, Width, Height, 1) then - a := MainForm.lbTextureList.Items.Add(ResourceName); + a := MainForm.lbTextureList.Items.Add(UResourceName); end else // Обычная текстура begin if g_CreateTextureWAD(ResourceName, FullResourceName) then - a := MainForm.lbTextureList.Items.Add(ResourceName); + a := MainForm.lbTextureList.Items.Add(UResourceName); end; if (a > -1) and (not silent) then SelectTexture(a); @@ -2210,7 +2212,7 @@ end; function SelectedTexture(): String; begin if MainForm.lbTextureList.ItemIndex <> -1 then - Result := MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex] + Result := utf2win(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]) else Result := ''; end; @@ -2218,7 +2220,7 @@ end; function IsSpecialTextureSel(): Boolean; begin Result := (MainForm.lbTextureList.ItemIndex <> -1) and - IsSpecialTexture(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]); + IsSpecialTexture(utf2win(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex])); end; function CopyBufferToString(var CopyBuf: TCopyRecArray): String; @@ -2595,7 +2597,7 @@ begin OpenedMap := ''; OpenedWAD := ''; - config := TConfig.CreateFile(EditorDir+'/Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); if config.ReadBool('Editor', 'Maximize', False) then WindowState := wsMaximized; @@ -4020,7 +4022,7 @@ var config: TConfig; i: Integer; begin - config := TConfig.CreateFile(EditorDir+'/Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized); config.WriteBool('Editor', 'Minimap', ShowMap); @@ -4043,7 +4045,7 @@ begin config.WriteStr('RecentFiles', IntToStr(i+1), ''); RecentFiles.Free(); - config.SaveFile(EditorDir+'/Editor.cfg'); + config.SaveFile(EditorDir+'Editor.cfg'); config.Free(); slInvalidTextures.Free; @@ -4286,11 +4288,11 @@ begin begin AddSoundForm.OKFunction := nil; AddSoundForm.lbResourcesList.MultiSelect := False; - AddSoundForm.SetResource := vleObjectProperty.Cells[1, i]; + AddSoundForm.SetResource := utf2win(vleObjectProperty.Cells[1, i]); if (AddSoundForm.ShowModal() = mrOk) then begin - vleObjectProperty.Cells[1, i] := AddSoundForm.ResourceName; + vleObjectProperty.Cells[1, i] := win2utf(AddSoundForm.ResourceName); bApplyProperty.Click(); end; Exit; @@ -5281,8 +5283,8 @@ begin begin Panel^.TextureID := SpecialTextureID(Panel^.TextureName); with MainForm.lbTextureList.Items do - if IndexOf(Panel^.TextureName) = -1 then - Add(Panel^.TextureName); + if IndexOf(win2utf(Panel^.TextureName)) = -1 then + Add(win2utf(Panel^.TextureName)); end; end; @@ -5443,11 +5445,11 @@ begin begin // Выбор файла звука/музыки: AddSoundForm.OKFunction := nil; AddSoundForm.lbResourcesList.MultiSelect := False; - AddSoundForm.SetResource := vleObjectProperty.Values[Key]; + AddSoundForm.SetResource := utf2win(vleObjectProperty.Values[Key]); if (AddSoundForm.ShowModal() = mrOk) then begin - vleObjectProperty.Values[Key] := AddSoundForm.ResourceName; + vleObjectProperty.Values[Key] := utf2win(AddSoundForm.ResourceName); bApplyProperty.Click(); end; end @@ -5751,9 +5753,9 @@ begin else gLanguage := LANGUAGE_RUSSIAN; end; - config := TConfig.CreateFile(EditorDir+'/Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); config.WriteStr('Editor', 'Language', gLanguage); - config.SaveFile(EditorDir+'/Editor.cfg'); + config.SaveFile(EditorDir+'Editor.cfg'); config.Free(); end; @@ -6057,7 +6059,9 @@ begin e_InitGL(); e_WriteLog('Loading data', MSG_NOTIFY); LoadStdFont('STDTXT', 'STDFONT', gEditorFont); + e_WriteLog('Loading more data', MSG_NOTIFY); LoadData(); + e_WriteLog('Loading even more data', MSG_NOTIFY); gDataLoaded := True; MainForm.FormResize(nil); end; diff --git a/src/editor/f_mapcheck.pas b/src/editor/f_mapcheck.pas index 0bd323d..bcb8ecf 100644 --- a/src/editor/f_mapcheck.pas +++ b/src/editor/f_mapcheck.pas @@ -1,6 +1,6 @@ unit f_mapcheck; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_mapoptimization.pas b/src/editor/f_mapoptimization.pas index 56eb889..e7aad24 100644 --- a/src/editor/f_mapoptimization.pas +++ b/src/editor/f_mapoptimization.pas @@ -1,13 +1,13 @@ unit f_mapoptimization; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface uses LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, - ComCtrls, ExtCtrls; + ComCtrls, ExtCtrls, utils; type TMapOptimizationForm = class (TForm) @@ -105,7 +105,7 @@ begin for i := 0 to High(gPanels) do if (gPanels[i].PanelType <> 0) and - (gPanels[i].TextureName = MainForm.lbTextureList.Items[a]) then + (gPanels[i].TextureName = utf2win(MainForm.lbTextureList.Items[a])) then begin ok := False; Break; @@ -114,14 +114,13 @@ begin // Нашли неиспользуемую текстуру: if ok then begin - g_DeleteTexture(MainForm.lbTextureList.Items[a]); + g_DeleteTexture(utf2win(MainForm.lbTextureList.Items[a])); if not b then begin mOptimizationResult.Lines.Add(_lc[I_OPT_DELETED_TEXTURES]); b := True; end; mOptimizationResult.Lines.Add(' '+MainForm.lbTextureList.Items[a]); - g_DeleteTexture(MainForm.lbTextureList.Items[a]); MainForm.lbTextureList.Items.Delete(a); end else diff --git a/src/editor/f_mapoptions.pas b/src/editor/f_mapoptions.pas index a194fa9..9d3a20c 100644 --- a/src/editor/f_mapoptions.pas +++ b/src/editor/f_mapoptions.pas @@ -1,13 +1,13 @@ unit f_mapoptions; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface uses SysUtils, Classes, Forms, Dialogs, Controls, StdCtrls, ComCtrls, Buttons, - f_main; + f_main, utils; type TMapOptionsForm = class (TForm) @@ -112,13 +112,13 @@ uses // Callbacks to receive results from resource choosing dialogs function SetSky: Boolean; begin - MapOptionsForm.eBack.Text := AddSkyForm.ResourceName; + MapOptionsForm.eBack.Text := win2utf(AddSkyForm.ResourceName); Result := True; end; function SetMusic: Boolean; begin - MapOptionsForm.eMusic.Text := AddSoundForm.ResourceName; + MapOptionsForm.eMusic.Text := win2utf(AddSoundForm.ResourceName); Result := True; end; @@ -128,12 +128,12 @@ var a, b: Integer; begin // General map options - eMapName.Text := gMapInfo.Name; - eMapDescription.Text := gMapInfo.Description; - eAuthor.Text := gMapInfo.Author; + eMapName.Text := win2utf(gMapInfo.Name); + eMapDescription.Text := win2utf(gMapInfo.Description); + eAuthor.Text := win2utf(gMapInfo.Author); - eBack.Text := gMapInfo.SkyName; - eMusic.Text := gMapInfo.MusicName; + eBack.Text := win2utf(gMapInfo.SkyName); + eMusic.Text := win2utf(gMapInfo.MusicName); eMapWidth.Text := IntToStr(gMapInfo.Width); eMapHeight.Text := IntToStr(gMapInfo.Height); @@ -191,11 +191,11 @@ begin with gMapInfo do begin - Name := eMapName.Text; - Description := eMapDescription.Text; - Author := eAuthor.Text; - SkyName := eBack.Text; - MusicName := eMusic.Text; + Name := utf2win(eMapName.Text); + Description := utf2win(eMapDescription.Text); + Author := utf2win(eAuthor.Text); + SkyName := utf2win(eBack.Text); + MusicName := utf2win(eMusic.Text); if Width > newWidth then MapOffset.X := 0; @@ -236,7 +236,7 @@ procedure TMapOptionsForm.bSelectBackClick(Sender: TObject); begin AddSkyForm.OKFunction := SetSky; AddSkyForm.lbResourcesList.MultiSelect := False; - AddSkyForm.SetResource := eBack.Text; + AddSkyForm.SetResource := utf2win(eBack.Text); AddSkyForm.ShowModal(); end; @@ -244,7 +244,7 @@ procedure TMapOptionsForm.bSelectMusicClick(Sender: TObject); begin AddSoundForm.OKFunction := SetMusic; AddSoundForm.lbResourcesList.MultiSelect := False; - AddSoundForm.SetResource := eMusic.Text; + AddSoundForm.SetResource := utf2win(eMusic.Text); AddSoundForm.ShowModal(); end; diff --git a/src/editor/f_maptest.pas b/src/editor/f_maptest.pas index 470da17..69f7f40 100644 --- a/src/editor/f_maptest.pas +++ b/src/editor/f_maptest.pas @@ -1,6 +1,6 @@ unit f_maptest; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface @@ -70,7 +70,7 @@ var n: Integer; begin - config := TConfig.CreateFile(EditorDir+'/Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); if rbTDM.Checked then s := 'TDM' @@ -114,7 +114,7 @@ begin config.WriteStr('TestRun', 'Exe', edD2dExe.Text); TestD2dExe := edD2dExe.Text; - config.SaveFile(EditorDir+'/Editor.cfg'); + config.SaveFile(EditorDir+'Editor.cfg'); config.Free(); Close(); end; @@ -153,7 +153,7 @@ var config: TConfig; begin - config := TConfig.CreateFile(EditorDir+'/Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); TestGameMode := config.ReadStr('TestRun', 'GameMode', 'DM'); TestLimTime := config.ReadStr('TestRun', 'LimTime', '0'); diff --git a/src/editor/f_options.pas b/src/editor/f_options.pas index 99be376..28debba 100644 --- a/src/editor/f_options.pas +++ b/src/editor/f_options.pas @@ -1,6 +1,6 @@ unit f_options; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface @@ -195,7 +195,7 @@ begin else DotSize := 1; - config := TConfig.CreateFile(EditorDir+'/Editor.cfg'); + config := TConfig.CreateFile(EditorDir+'Editor.cfg'); config.WriteInt('Editor', 'DotColor', DotColor); config.WriteBool('Editor', 'DotEnable', DotEnable); @@ -217,7 +217,7 @@ begin MainForm.RefreshRecentMenu(); end; - config.SaveFile(EditorDir+'/Editor.cfg'); + config.SaveFile(EditorDir+'Editor.cfg'); config.Free(); Close(); end; diff --git a/src/editor/f_packmap.pas b/src/editor/f_packmap.pas index c9e093e..0999e54 100644 --- a/src/editor/f_packmap.pas +++ b/src/editor/f_packmap.pas @@ -1,6 +1,6 @@ unit f_packmap; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_savemap.pas b/src/editor/f_savemap.pas index fde781f..f89ee73 100644 --- a/src/editor/f_savemap.pas +++ b/src/editor/f_savemap.pas @@ -1,6 +1,6 @@ unit f_savemap; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_saveminimap.pas b/src/editor/f_saveminimap.pas index a314ac7..07b6850 100644 --- a/src/editor/f_saveminimap.pas +++ b/src/editor/f_saveminimap.pas @@ -1,6 +1,6 @@ unit f_saveminimap; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_selectlang.pas b/src/editor/f_selectlang.pas index eac54da..bfb9998 100644 --- a/src/editor/f_selectlang.pas +++ b/src/editor/f_selectlang.pas @@ -1,6 +1,6 @@ unit f_selectlang; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/f_selectmap.pas b/src/editor/f_selectmap.pas index afa6a3e..a83e3e0 100644 --- a/src/editor/f_selectmap.pas +++ b/src/editor/f_selectmap.pas @@ -1,6 +1,6 @@ unit f_selectmap; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/g_basic.pas b/src/editor/g_basic.pas index 1433fec..e7d3a71 100644 --- a/src/editor/g_basic.pas +++ b/src/editor/g_basic.pas @@ -1,6 +1,6 @@ unit g_basic; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/g_language.pas b/src/editor/g_language.pas index 405798e..456ab9b 100644 --- a/src/editor/g_language.pas +++ b/src/editor/g_language.pas @@ -1,6 +1,6 @@ Unit g_language; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} Interface diff --git a/src/editor/g_map.pas b/src/editor/g_map.pas index b5bf888..237c247 100644 --- a/src/editor/g_map.pas +++ b/src/editor/g_map.pas @@ -1,12 +1,12 @@ Unit g_map; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} Interface Uses LCLIntf, LCLType, LMessages, g_basic, e_graphics, MAPREADER, MAPSTRUCT, - MAPWRITER, e_log, MAPDEF; + MAPWRITER, e_log, MAPDEF, utils; Type TMapObject = record @@ -1111,7 +1111,7 @@ begin for a := 0 to MainForm.lbTextureList.Items.Count-1 do begin SetLength(textures, Length(textures)+1); - s := MainForm.lbTextureList.Items[a]; + s := utf2win(MainForm.lbTextureList.Items[a]); CopyMemory(@textures[High(textures)].Resource[0], @s[1], Min(64, Length(s))); if g_GetTextureFlagByName(s) = 1 then textures[High(textures)].Anim := 1 @@ -1329,6 +1329,7 @@ begin // Записываем в WAD, если надо: if Res <> '' then begin + e_WriteLog('Fuck me (A) ' + ResName, MSG_NOTIFY); WAD.RemoveResource('', ResName); WAD.AddResource(Data, Len, ResName, ''); WAD.SaveTo(FileName); @@ -1345,16 +1346,18 @@ end; procedure AddTexture(res: String; Error: Boolean); var a: Integer; + ures: String; begin + ures := win2utf(res); with MainForm.lbTextureList do begin for a := 0 to Count-1 do - if Items[a] = res then + if Items[a] = ures then Exit; - if Error and (slInvalidTextures.IndexOf(res) = -1) then - slInvalidTextures.Add(res); - Items.Add(res); + if Error and (slInvalidTextures.IndexOf(ures) = -1) then + slInvalidTextures.Add(ures); + Items.Add(ures); end; end; @@ -1696,7 +1699,7 @@ const var map: TConfig; i, a: Integer; - s, section: String; + s, us, section: String; panel: TPanel; item: TItem; area: TArea; @@ -1731,17 +1734,17 @@ begin Continue; // Нет такой текстуры - ищем в WAD карты: - if not g_CreateTextureWAD(s, EditorDir+'/wads/'+s) then + if not g_CreateTextureWAD(s, EditorDir+'wads/'+s) then begin s := ExtractFileName(_FileName); Delete(s, Length(s)-3, 4); s := UpperCase(s) + '.WAD:TEXTURES\'+ UpperCase(map.ReadStr('Textures', 'TextureName'+IntToStr(a), '')); - if not g_CreateTextureWAD(s, EditorDir+'/wads/'+s) then + if not g_CreateTextureWAD(s, EditorDir+'wads/'+s) then Continue; end; - MainForm.lbTextureList.Items.Add(s); + MainForm.lbTextureList.Items.Add(win2utf(s)); end; // Чтение панелей: @@ -1822,9 +1825,10 @@ begin end; end; + us := win2utf(s); with MainForm.lbTextureList.Items do - if IndexOf(s) = -1 then - Add(s); + if IndexOf(us) = -1 then + Add(us); panel.TextureName := s; panel.TextureWidth := 1; panel.TextureHeight := 1; @@ -1950,8 +1954,8 @@ begin begin if Items.Count > 0 then for a := Items.Count-1 downto 0 do - if not IsSpecialTexture(Items[a]) then - g_DeleteTexture(Items[a]); + if not IsSpecialTexture(utf2win(Items[a])) then + g_DeleteTexture(utf2win(Items[a])); Clear(); end; @@ -2722,79 +2726,79 @@ end; procedure LoadData(); begin - g_CreateTextureWAD('PREVIEW', EditorDir+'/data/Editor.wad:TEXTURES\CHECKERS'); - g_CreateTextureWAD('NOTEXTURE', EditorDir+'/data/Game.wad:TEXTURES\NOTEXTURE'); - - g_CreateTextureWADSize('AREA_REDFLAG', EditorDir+'/data/Game.wad:TEXTURES\FLAGRED', 0, 0, 64, 64); - g_CreateTextureWADSize('AREA_BLUEFLAG', EditorDir+'/data/Game.wad:TEXTURES\FLAGBLUE', 0, 0, 64, 64); - g_CreateTextureWADSize('AREA_DOMFLAG', EditorDir+'/data/Game.wad:TEXTURES\FLAGDOM', 0, 0, 64, 64); - - g_CreateTextureWADSize('MONSTER_DEMON', EditorDir+'/data/Game.wad:MTEXTURES\DEMON_SLEEP', 0, 0, 64, 64); - g_CreateTextureWADSize('MONSTER_IMP', EditorDir+'/data/Game.wad:MTEXTURES\IMP_SLEEP', 0, 0, 64, 64); - g_CreateTextureWADSize('MONSTER_ZOMBY', EditorDir+'/data/Game.wad:MTEXTURES\ZOMBY_SLEEP', 0, 0, 64, 64); - g_CreateTextureWADSize('MONSTER_SERG', EditorDir+'/data/Game.wad:MTEXTURES\SERG_SLEEP', 0, 0, 64, 64); - g_CreateTextureWADSize('MONSTER_CYBER', EditorDir+'/data/Game.wad:MTEXTURES\CYBER_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_CGUN', EditorDir+'/data/Game.wad:MTEXTURES\CGUN_SLEEP', 0, 0, 64, 64); - g_CreateTextureWADSize('MONSTER_BARON', EditorDir+'/data/Game.wad:MTEXTURES\BARON_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_KNIGHT', EditorDir+'/data/Game.wad:MTEXTURES\KNIGHT_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_CACO', EditorDir+'/data/Game.wad:MTEXTURES\CACO_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_SOUL', EditorDir+'/data/Game.wad:MTEXTURES\SOUL_SLEEP', 0, 0, 64, 64); - g_CreateTextureWADSize('MONSTER_PAIN', EditorDir+'/data/Game.wad:MTEXTURES\PAIN_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_SPIDER', EditorDir+'/data/Game.wad:MTEXTURES\SPIDER_SLEEP', 0, 0, 256, 128); - g_CreateTextureWADSize('MONSTER_BSP', EditorDir+'/data/Game.wad:MTEXTURES\BSP_SLEEP', 0, 0, 128, 64); - g_CreateTextureWADSize('MONSTER_MANCUB', EditorDir+'/data/Game.wad:MTEXTURES\MANCUB_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_SKEL', EditorDir+'/data/Game.wad:MTEXTURES\SKEL_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_VILE', EditorDir+'/data/Game.wad:MTEXTURES\VILE_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_FISH', EditorDir+'/data/Game.wad:MTEXTURES\FISH_SLEEP', 0, 0, 32, 32); - g_CreateTextureWADSize('MONSTER_BARREL', EditorDir+'/data/Game.wad:MTEXTURES\BARREL_SLEEP', 0, 0, 64, 64); - g_CreateTextureWADSize('MONSTER_ROBO', EditorDir+'/data/Game.wad:MTEXTURES\ROBO_SLEEP', 0, 0, 128, 128); - g_CreateTextureWADSize('MONSTER_MAN', EditorDir+'/data/Game.wad:MTEXTURES\MAN_SLEEP', 0, 0, 64, 64); - - g_CreateTextureWADSize('ITEM_BLUESPHERE', EditorDir+'/data/Game.wad:TEXTURES\SBLUE', 0, 0, 32, 32); - g_CreateTextureWADSize('ITEM_WHITESPHERE', EditorDir+'/data/Game.wad:TEXTURES\SWHITE', 0, 0, 32, 32); - g_CreateTextureWADSize('ITEM_ARMORGREEN', EditorDir+'/data/Game.wad:TEXTURES\ARMORGREEN', 0, 0, 32, 16); - g_CreateTextureWADSize('ITEM_ARMORBLUE', EditorDir+'/data/Game.wad:TEXTURES\ARMORBLUE', 0, 0, 32, 16); - g_CreateTextureWADSize('ITEM_INVUL', EditorDir+'/data/Game.wad:TEXTURES\INVUL', 0, 0, 32, 32); - g_CreateTextureWADSize('ITEM_BOTTLE', EditorDir+'/data/Game.wad:TEXTURES\BOTTLE', 0, 0, 16, 32); - g_CreateTextureWADSize('ITEM_HELMET', EditorDir+'/data/Game.wad:TEXTURES\HELMET', 0, 0, 16, 16); - g_CreateTextureWADSize('ITEM_INVIS', EditorDir+'/data/Game.wad:TEXTURES\INVIS', 0, 0, 32, 32); - g_CreateTextureWADSize('ITEM_WEAPON_FLAMETHROWER', EditorDir+'/data/Game.wad:TEXTURES\FLAMETHROWER', 0, 0, 64, 32); - g_CreateTextureWADSize('ITEM_AMMO_FUELCAN', EditorDir+'/data/Game.wad:TEXTURES\FUELCAN', 0, 0, 16, 32); - - g_CreateTextureWAD('ITEM_MEDKIT_SMALL', EditorDir+'/data/Game.wad:TEXTURES\MED1'); - g_CreateTextureWAD('ITEM_MEDKIT_LARGE', EditorDir+'/data/Game.wad:TEXTURES\MED2'); - g_CreateTextureWAD('ITEM_WEAPON_SAW', EditorDir+'/data/Game.wad:TEXTURES\SAW'); - g_CreateTextureWAD('ITEM_WEAPON_PISTOL', EditorDir+'/data/Game.wad:TEXTURES\PISTOL'); - g_CreateTextureWAD('ITEM_WEAPON_KASTET', EditorDir+'/data/Game.wad:TEXTURES\KASTET'); - g_CreateTextureWAD('ITEM_WEAPON_SHOTGUN1', EditorDir+'/data/Game.wad:TEXTURES\SHOTGUN1'); - g_CreateTextureWAD('ITEM_WEAPON_SHOTGUN2', EditorDir+'/data/Game.wad:TEXTURES\SHOTGUN2'); - g_CreateTextureWAD('ITEM_WEAPON_CHAINGUN', EditorDir+'/data/Game.wad:TEXTURES\MGUN'); - g_CreateTextureWAD('ITEM_WEAPON_ROCKETLAUNCHER', EditorDir+'/data/Game.wad:TEXTURES\RLAUNCHER'); - g_CreateTextureWAD('ITEM_WEAPON_PLASMA', EditorDir+'/data/Game.wad:TEXTURES\PGUN'); - g_CreateTextureWAD('ITEM_WEAPON_BFG', EditorDir+'/data/Game.wad:TEXTURES\BFG'); - g_CreateTextureWAD('ITEM_WEAPON_SUPERPULEMET', EditorDir+'/data/Game.wad:TEXTURES\SPULEMET'); - g_CreateTextureWAD('ITEM_AMMO_BULLETS', EditorDir+'/data/Game.wad:TEXTURES\CLIP'); - g_CreateTextureWAD('ITEM_AMMO_BULLETS_BOX', EditorDir+'/data/Game.wad:TEXTURES\AMMO'); - g_CreateTextureWAD('ITEM_AMMO_SHELLS', EditorDir+'/data/Game.wad:TEXTURES\SHELL1'); - g_CreateTextureWAD('ITEM_AMMO_SHELLS_BOX', EditorDir+'/data/Game.wad:TEXTURES\SHELL2'); - g_CreateTextureWAD('ITEM_AMMO_ROCKET', EditorDir+'/data/Game.wad:TEXTURES\ROCKET'); - g_CreateTextureWAD('ITEM_AMMO_ROCKET_BOX', EditorDir+'/data/Game.wad:TEXTURES\ROCKETS'); - g_CreateTextureWAD('ITEM_AMMO_CELL', EditorDir+'/data/Game.wad:TEXTURES\CELL'); - g_CreateTextureWAD('ITEM_AMMO_CELL_BIG', EditorDir+'/data/Game.wad:TEXTURES\CELL2'); - g_CreateTextureWAD('ITEM_AMMO_BACKPACK', EditorDir+'/data/Game.wad:TEXTURES\BPACK'); - g_CreateTextureWAD('ITEM_KEY_RED', EditorDir+'/data/Game.wad:TEXTURES\KEYR'); - g_CreateTextureWAD('ITEM_KEY_GREEN', EditorDir+'/data/Game.wad:TEXTURES\KEYG'); - g_CreateTextureWAD('ITEM_KEY_BLUE', EditorDir+'/data/Game.wad:TEXTURES\KEYB'); - g_CreateTextureWAD('ITEM_OXYGEN', EditorDir+'/data/Game.wad:TEXTURES\OXYGEN'); - g_CreateTextureWAD('ITEM_SUIT', EditorDir+'/data/Game.wad:TEXTURES\SUIT'); - g_CreateTextureWAD('ITEM_MEDKIT_BLACK', EditorDir+'/data/Game.wad:TEXTURES\BMED'); - g_CreateTextureWAD('ITEM_JETPACK', EditorDir+'/data/Game.wad:TEXTURES\JETPACK'); - - g_CreateTextureWAD('AREA_PLAYERPOINT1', EditorDir+'/data/Editor.wad:TEXTURES\P1POINT'); - g_CreateTextureWAD('AREA_PLAYERPOINT2', EditorDir+'/data/Editor.wad:TEXTURES\P2POINT'); - g_CreateTextureWAD('AREA_DMPOINT', EditorDir+'/data/Editor.wad:TEXTURES\DMPOINT'); - g_CreateTextureWAD('AREA_REDPOINT', EditorDir+'/data/Editor.wad:TEXTURES\REDPOINT'); - g_CreateTextureWAD('AREA_BLUEPOINT', EditorDir+'/data/Editor.wad:TEXTURES\BLUEPOINT'); + g_CreateTextureWAD('PREVIEW', EditorDir+'data/Editor.wad:TEXTURES\CHECKERS'); + g_CreateTextureWAD('NOTEXTURE', EditorDir+'data/Game.wad:TEXTURES\NOTEXTURE'); + + g_CreateTextureWADSize('AREA_REDFLAG', EditorDir+'data/Game.wad:TEXTURES\FLAGRED', 0, 0, 64, 64); + g_CreateTextureWADSize('AREA_BLUEFLAG', EditorDir+'data/Game.wad:TEXTURES\FLAGBLUE', 0, 0, 64, 64); + g_CreateTextureWADSize('AREA_DOMFLAG', EditorDir+'data/Game.wad:TEXTURES\FLAGDOM', 0, 0, 64, 64); + + g_CreateTextureWADSize('MONSTER_DEMON', EditorDir+'data/Game.wad:MTEXTURES\DEMON_SLEEP', 0, 0, 64, 64); + g_CreateTextureWADSize('MONSTER_IMP', EditorDir+'data/Game.wad:MTEXTURES\IMP_SLEEP', 0, 0, 64, 64); + g_CreateTextureWADSize('MONSTER_ZOMBY', EditorDir+'data/Game.wad:MTEXTURES\ZOMBY_SLEEP', 0, 0, 64, 64); + g_CreateTextureWADSize('MONSTER_SERG', EditorDir+'data/Game.wad:MTEXTURES\SERG_SLEEP', 0, 0, 64, 64); + g_CreateTextureWADSize('MONSTER_CYBER', EditorDir+'data/Game.wad:MTEXTURES\CYBER_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_CGUN', EditorDir+'data/Game.wad:MTEXTURES\CGUN_SLEEP', 0, 0, 64, 64); + g_CreateTextureWADSize('MONSTER_BARON', EditorDir+'data/Game.wad:MTEXTURES\BARON_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_KNIGHT', EditorDir+'data/Game.wad:MTEXTURES\KNIGHT_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_CACO', EditorDir+'data/Game.wad:MTEXTURES\CACO_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_SOUL', EditorDir+'data/Game.wad:MTEXTURES\SOUL_SLEEP', 0, 0, 64, 64); + g_CreateTextureWADSize('MONSTER_PAIN', EditorDir+'data/Game.wad:MTEXTURES\PAIN_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_SPIDER', EditorDir+'data/Game.wad:MTEXTURES\SPIDER_SLEEP', 0, 0, 256, 128); + g_CreateTextureWADSize('MONSTER_BSP', EditorDir+'data/Game.wad:MTEXTURES\BSP_SLEEP', 0, 0, 128, 64); + g_CreateTextureWADSize('MONSTER_MANCUB', EditorDir+'data/Game.wad:MTEXTURES\MANCUB_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_SKEL', EditorDir+'data/Game.wad:MTEXTURES\SKEL_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_VILE', EditorDir+'data/Game.wad:MTEXTURES\VILE_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_FISH', EditorDir+'data/Game.wad:MTEXTURES\FISH_SLEEP', 0, 0, 32, 32); + g_CreateTextureWADSize('MONSTER_BARREL', EditorDir+'data/Game.wad:MTEXTURES\BARREL_SLEEP', 0, 0, 64, 64); + g_CreateTextureWADSize('MONSTER_ROBO', EditorDir+'data/Game.wad:MTEXTURES\ROBO_SLEEP', 0, 0, 128, 128); + g_CreateTextureWADSize('MONSTER_MAN', EditorDir+'data/Game.wad:MTEXTURES\MAN_SLEEP', 0, 0, 64, 64); + + g_CreateTextureWADSize('ITEM_BLUESPHERE', EditorDir+'data/Game.wad:TEXTURES\SBLUE', 0, 0, 32, 32); + g_CreateTextureWADSize('ITEM_WHITESPHERE', EditorDir+'data/Game.wad:TEXTURES\SWHITE', 0, 0, 32, 32); + g_CreateTextureWADSize('ITEM_ARMORGREEN', EditorDir+'data/Game.wad:TEXTURES\ARMORGREEN', 0, 0, 32, 16); + g_CreateTextureWADSize('ITEM_ARMORBLUE', EditorDir+'data/Game.wad:TEXTURES\ARMORBLUE', 0, 0, 32, 16); + g_CreateTextureWADSize('ITEM_INVUL', EditorDir+'data/Game.wad:TEXTURES\INVUL', 0, 0, 32, 32); + g_CreateTextureWADSize('ITEM_BOTTLE', EditorDir+'data/Game.wad:TEXTURES\BOTTLE', 0, 0, 16, 32); + g_CreateTextureWADSize('ITEM_HELMET', EditorDir+'data/Game.wad:TEXTURES\HELMET', 0, 0, 16, 16); + g_CreateTextureWADSize('ITEM_INVIS', EditorDir+'data/Game.wad:TEXTURES\INVIS', 0, 0, 32, 32); + g_CreateTextureWADSize('ITEM_WEAPON_FLAMETHROWER', EditorDir+'data/Game.wad:TEXTURES\FLAMETHROWER', 0, 0, 64, 32); + g_CreateTextureWADSize('ITEM_AMMO_FUELCAN', EditorDir+'data/Game.wad:TEXTURES\FUELCAN', 0, 0, 16, 32); + + g_CreateTextureWAD('ITEM_MEDKIT_SMALL', EditorDir+'data/Game.wad:TEXTURES\MED1'); + g_CreateTextureWAD('ITEM_MEDKIT_LARGE', EditorDir+'data/Game.wad:TEXTURES\MED2'); + g_CreateTextureWAD('ITEM_WEAPON_SAW', EditorDir+'data/Game.wad:TEXTURES\SAW'); + g_CreateTextureWAD('ITEM_WEAPON_PISTOL', EditorDir+'data/Game.wad:TEXTURES\PISTOL'); + g_CreateTextureWAD('ITEM_WEAPON_KASTET', EditorDir+'data/Game.wad:TEXTURES\KASTET'); + g_CreateTextureWAD('ITEM_WEAPON_SHOTGUN1', EditorDir+'data/Game.wad:TEXTURES\SHOTGUN1'); + g_CreateTextureWAD('ITEM_WEAPON_SHOTGUN2', EditorDir+'data/Game.wad:TEXTURES\SHOTGUN2'); + g_CreateTextureWAD('ITEM_WEAPON_CHAINGUN', EditorDir+'data/Game.wad:TEXTURES\MGUN'); + g_CreateTextureWAD('ITEM_WEAPON_ROCKETLAUNCHER', EditorDir+'data/Game.wad:TEXTURES\RLAUNCHER'); + g_CreateTextureWAD('ITEM_WEAPON_PLASMA', EditorDir+'data/Game.wad:TEXTURES\PGUN'); + g_CreateTextureWAD('ITEM_WEAPON_BFG', EditorDir+'data/Game.wad:TEXTURES\BFG'); + g_CreateTextureWAD('ITEM_WEAPON_SUPERPULEMET', EditorDir+'data/Game.wad:TEXTURES\SPULEMET'); + g_CreateTextureWAD('ITEM_AMMO_BULLETS', EditorDir+'data/Game.wad:TEXTURES\CLIP'); + g_CreateTextureWAD('ITEM_AMMO_BULLETS_BOX', EditorDir+'data/Game.wad:TEXTURES\AMMO'); + g_CreateTextureWAD('ITEM_AMMO_SHELLS', EditorDir+'data/Game.wad:TEXTURES\SHELL1'); + g_CreateTextureWAD('ITEM_AMMO_SHELLS_BOX', EditorDir+'data/Game.wad:TEXTURES\SHELL2'); + g_CreateTextureWAD('ITEM_AMMO_ROCKET', EditorDir+'data/Game.wad:TEXTURES\ROCKET'); + g_CreateTextureWAD('ITEM_AMMO_ROCKET_BOX', EditorDir+'data/Game.wad:TEXTURES\ROCKETS'); + g_CreateTextureWAD('ITEM_AMMO_CELL', EditorDir+'data/Game.wad:TEXTURES\CELL'); + g_CreateTextureWAD('ITEM_AMMO_CELL_BIG', EditorDir+'data/Game.wad:TEXTURES\CELL2'); + g_CreateTextureWAD('ITEM_AMMO_BACKPACK', EditorDir+'data/Game.wad:TEXTURES\BPACK'); + g_CreateTextureWAD('ITEM_KEY_RED', EditorDir+'data/Game.wad:TEXTURES\KEYR'); + g_CreateTextureWAD('ITEM_KEY_GREEN', EditorDir+'data/Game.wad:TEXTURES\KEYG'); + g_CreateTextureWAD('ITEM_KEY_BLUE', EditorDir+'data/Game.wad:TEXTURES\KEYB'); + g_CreateTextureWAD('ITEM_OXYGEN', EditorDir+'data/Game.wad:TEXTURES\OXYGEN'); + g_CreateTextureWAD('ITEM_SUIT', EditorDir+'data/Game.wad:TEXTURES\SUIT'); + g_CreateTextureWAD('ITEM_MEDKIT_BLACK', EditorDir+'data/Game.wad:TEXTURES\BMED'); + g_CreateTextureWAD('ITEM_JETPACK', EditorDir+'data/Game.wad:TEXTURES\JETPACK'); + + g_CreateTextureWAD('AREA_PLAYERPOINT1', EditorDir+'data/Editor.wad:TEXTURES\P1POINT'); + g_CreateTextureWAD('AREA_PLAYERPOINT2', EditorDir+'data/Editor.wad:TEXTURES\P2POINT'); + g_CreateTextureWAD('AREA_DMPOINT', EditorDir+'data/Editor.wad:TEXTURES\DMPOINT'); + g_CreateTextureWAD('AREA_REDPOINT', EditorDir+'data/Editor.wad:TEXTURES\REDPOINT'); + g_CreateTextureWAD('AREA_BLUEPOINT', EditorDir+'data/Editor.wad:TEXTURES\BLUEPOINT'); end; procedure FreeData(); diff --git a/src/editor/g_textures.pas b/src/editor/g_textures.pas index 7c13013..0ef0a81 100644 --- a/src/editor/g_textures.pas +++ b/src/editor/g_textures.pas @@ -1,6 +1,6 @@ unit g_textures; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/editor/spectrum.pas b/src/editor/spectrum.pas index d0ef098..fcedd73 100644 --- a/src/editor/spectrum.pas +++ b/src/editor/spectrum.pas @@ -1,15 +1,23 @@ unit spectrum; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface uses - LCLIntf, LCLType, LMessages, Classes, Controls, Graphics, - fmod, fmodtypes; + LCLIntf, LCLType, LMessages, Classes, Controls, Graphics + {$IFNDEF NOSOUND}, fmod, fmodtypes;{$ELSE};{$ENDIF} const N_SPECTRUM_VALUES = 512; +{$IFDEF NOSOUND} +// fuck my life + FMOD_OK = 0; + +type + FMOD_CHANNEL = Pointer; + FMOD_RESULT = Integer; +{$ENDIF} type TSpectrumStyle = (ssSmooth, ssBlock); @@ -130,7 +138,7 @@ begin {$R-} FBuffer.Canvas.Brush.Color := Color; FBuffer.Canvas.FillRect(BoundsRect); - +{$IFNDEF NOSOUND} if Enabled then begin if FChannel <> nil then @@ -182,6 +190,7 @@ begin end; end else // if Enabled ... +{$ENDIF} begin FBuffer.Canvas.Font.Color := clWhite; ARect := BoundsRect; diff --git a/src/engine/e_fixedbuffer.pas b/src/engine/e_fixedbuffer.pas deleted file mode 100644 index 51fabec..0000000 --- a/src/engine/e_fixedbuffer.pas +++ /dev/null @@ -1,300 +0,0 @@ -unit e_fixedbuffer; - -// ß íå õî÷ó òðàõàòüñÿ ñ êëàññàìè è ñîçäàíèåì ïî äâà îáúåêòà íà êàæäûé áóôåð, -// êàê â BinEditor/WADEDITOR, ïîýòîìó áóäåò òàê. Ïëþñ ôèêñèðîâàííûé ðàçìåð -// áûñòðåå. -- Primus - -interface - -uses md5asm; - -const - BUF_SIZE = 65536; - -type - TBuffer = record - Data: array [0..BUF_SIZE] of Byte; // îäèí áàéò ñâåðõó íà âñÿêèé ñëó÷àé - ReadPos: Cardinal; - WritePos: Cardinal; - Len: Cardinal; - end; - pTBuffer = ^TBuffer; - -var - RawPos: Cardinal = 0; - -procedure e_Buffer_Clear(B: pTBuffer); - - -procedure e_Buffer_Write_Generic(B: pTBuffer; var V; N: Cardinal); -procedure e_Buffer_Read_Generic(B: pTBuffer; var V; N: Cardinal); - - -procedure e_Buffer_Write(B: pTBuffer; V: Char); overload; - -procedure e_Buffer_Write(B: pTBuffer; V: Byte); overload; -procedure e_Buffer_Write(B: pTBuffer; V: Word); overload; -procedure e_Buffer_Write(B: pTBuffer; V: LongWord); overload; - -procedure e_Buffer_Write(B: pTBuffer; V: ShortInt); overload; -procedure e_Buffer_Write(B: pTBuffer; V: SmallInt); overload; -procedure e_Buffer_Write(B: pTBuffer; V: LongInt); overload; - -procedure e_Buffer_Write(B: pTBuffer; V: string); overload; - -procedure e_Buffer_Write(B: pTBuffer; V: TMD5Digest); overload; - - -function e_Buffer_Read_Char(B: pTBuffer): Char; - -function e_Buffer_Read_Byte(B: pTBuffer): Byte; -function e_Buffer_Read_Word(B: pTBuffer): Word; -function e_Buffer_Read_LongWord(B: pTBuffer): LongWord; - -function e_Buffer_Read_ShortInt(B: pTBuffer): ShortInt; -function e_Buffer_Read_SmallInt(B: pTBuffer): SmallInt; -function e_Buffer_Read_LongInt(B: pTBuffer): LongInt; - -function e_Buffer_Read_String(B: pTBuffer): string; - -function e_Buffer_Read_MD5(B: pTBuffer): TMD5Digest; - - -procedure e_Raw_Read_Generic(P: Pointer; var V; N: Cardinal); - -function e_Raw_Read_Char(P: Pointer): Char; - -function e_Raw_Read_Byte(P: Pointer): Byte; -function e_Raw_Read_Word(P: Pointer): Word; -function e_Raw_Read_LongWord(P: Pointer): LongWord; - -function e_Raw_Read_ShortInt(P: Pointer): ShortInt; -function e_Raw_Read_SmallInt(P: Pointer): SmallInt; -function e_Raw_Read_LongInt(P: Pointer): LongInt; - -function e_Raw_Read_String(P: Pointer): string; - -function e_Raw_Read_MD5(P: Pointer): TMD5Digest; - -procedure e_Raw_Seek(I: Cardinal); - -implementation - -uses Windows, SysUtils; - -procedure e_Buffer_Clear(B: pTBuffer); -begin - B^.WritePos := 0; - B^.ReadPos := 0; - B^.Len := 0; -end; - - -procedure e_Buffer_Write_Generic(B: pTBuffer; var V; N: Cardinal); -begin - if (B^.WritePos + N >= BUF_SIZE) then Exit; - if (B^.WritePos + N > B^.Len) then - B^.Len := B^.WritePos + N + 1; - - MoveMemory(Pointer(Cardinal(Addr(B^.Data)) + B^.WritePos), - @V, N); - - B^.WritePos := B^.WritePos + N; -end; -procedure e_Buffer_Read_Generic(B: pTBuffer; var V; N: Cardinal); -begin - if (B^.ReadPos + N >= BUF_SIZE) then Exit; - - MoveMemory(@V, Pointer(Cardinal(Addr(B^.Data)) + B^.ReadPos), N); - - B^.ReadPos := B^.ReadPos + N; -end; - - -procedure e_Buffer_Write(B: pTBuffer; V: Char); overload; -begin - e_Buffer_Write_Generic(B, V, 1); -end; - -procedure e_Buffer_Write(B: pTBuffer; V: Byte); overload; -begin - e_Buffer_Write_Generic(B, V, 1); -end; -procedure e_Buffer_Write(B: pTBuffer; V: Word); overload; -begin - e_Buffer_Write_Generic(B, V, 2); -end; -procedure e_Buffer_Write(B: pTBuffer; V: LongWord); overload; -begin - e_Buffer_Write_Generic(B, V, 4); -end; - -procedure e_Buffer_Write(B: pTBuffer; V: ShortInt); overload; -begin - e_Buffer_Write_Generic(B, V, 1); -end; -procedure e_Buffer_Write(B: pTBuffer; V: SmallInt); overload; -begin - e_Buffer_Write_Generic(B, V, 2); -end; -procedure e_Buffer_Write(B: pTBuffer; V: LongInt); overload; -begin - e_Buffer_Write_Generic(B, V, 4); -end; - -procedure e_Buffer_Write(B: pTBuffer; V: string); overload; -var - Len: Byte; - P: Cardinal; -begin - Len := Length(V); - e_Buffer_Write_Generic(B, Len, 1); - - if (Len = 0) then Exit; - - P := B^.WritePos + Len; - if (P >= BUF_SIZE) then - begin - Len := BUF_SIZE - B^.WritePos; - P := BUF_SIZE; - end; - - if (P > B^.Len) then B^.Len := P; - - CopyMemory(Pointer(Cardinal(Addr(B^.Data)) + B^.WritePos), - @V[1], Len); - - B^.WritePos := P; -end; - -procedure e_Buffer_Write(B: pTBuffer; V: TMD5Digest); overload; -var - I: Integer; -begin - for I := 0 to 15 do - e_Buffer_Write(B, V.v[I]); -end; - - -function e_Buffer_Read_Char(B: pTBuffer): Char; -begin - e_Buffer_Read_Generic(B, Result, 1); -end; - -function e_Buffer_Read_Byte(B: pTBuffer): Byte; -begin - e_Buffer_Read_Generic(B, Result, 1); -end; -function e_Buffer_Read_Word(B: pTBuffer): Word; -begin - e_Buffer_Read_Generic(B, Result, 2); -end; -function e_Buffer_Read_LongWord(B: pTBuffer): LongWord; -begin - e_Buffer_Read_Generic(B, Result, 4); -end; - -function e_Buffer_Read_ShortInt(B: pTBuffer): ShortInt; -begin - e_Buffer_Read_Generic(B, Result, 1); -end; -function e_Buffer_Read_SmallInt(B: pTBuffer): SmallInt; -begin - e_Buffer_Read_Generic(B, Result, 2); -end; -function e_Buffer_Read_LongInt(B: pTBuffer): LongInt; -begin - e_Buffer_Read_Generic(B, Result, 4); -end; - -function e_Buffer_Read_String(B: pTBuffer): string; -var - Len: Byte; -begin - Len := e_Buffer_Read_Byte(B); - Result := ''; - if Len = 0 then Exit; - - if B^.ReadPos + Len > B^.Len then - Len := B^.Len - B^.ReadPos; - - SetLength(Result, Len); - MoveMemory(@Result[1], Pointer(Cardinal(Addr(B^.Data)) + B^.ReadPos), Len); - - B^.ReadPos := B^.ReadPos + Len; -end; - -function e_Buffer_Read_MD5(B: pTBuffer): TMD5Digest; -var - I: Integer; -begin - for I := 0 to 15 do - Result.v[I] := e_Buffer_Read_Byte(B); -end; - -procedure e_Raw_Read_Generic(P: Pointer; var V; N: Cardinal); -begin - MoveMemory(@V, Pointer(Cardinal(P) + RawPos), N); - - RawPos := RawPos + N; -end; - -function e_Raw_Read_Char(P: Pointer): Char; -begin - e_Raw_Read_Generic(P, Result, 1); -end; - -function e_Raw_Read_Byte(P: Pointer): Byte; -begin - e_Raw_Read_Generic(P, Result, 1); -end; -function e_Raw_Read_Word(P: Pointer): Word; -begin - e_Raw_Read_Generic(P, Result, 2); -end; -function e_Raw_Read_LongWord(P: Pointer): LongWord; -begin - e_Raw_Read_Generic(P, Result, 4); -end; - -function e_Raw_Read_ShortInt(P: Pointer): ShortInt; -begin - e_Raw_Read_Generic(P, Result, 1); -end; -function e_Raw_Read_SmallInt(P: Pointer): SmallInt; -begin - e_Raw_Read_Generic(P, Result, 2); -end; -function e_Raw_Read_LongInt(P: Pointer): LongInt; -begin - e_Raw_Read_Generic(P, Result, 4); -end; - -function e_Raw_Read_String(P: Pointer): string; -var - Len: Byte; -begin - Len := e_Raw_Read_Byte(P); - Result := ''; - if Len = 0 then Exit; - - SetLength(Result, Len); - MoveMemory(@Result[1], Pointer(Cardinal(P) + RawPos), Len); - - RawPos := RawPos + Len; -end; - -function e_Raw_Read_MD5(P: Pointer): TMD5Digest; -var - I: Integer; -begin - for I := 0 to 15 do - Result.v[I] := e_Raw_Read_Byte(P); -end; - -procedure e_Raw_Seek(I: Cardinal); -begin - RawPos := I; -end; - -end. diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas index 63a9e5b..47bf110 100644 --- a/src/engine/e_graphics.pas +++ b/src/engine/e_graphics.pas @@ -13,7 +13,7 @@ * You should have received a copy of the GNU General Public License * along with this program. If not, see . *) -{$MODE DELPHI} +{$INCLUDE ../shared/a_modes.inc} unit e_graphics; interface diff --git a/src/engine/e_input.pas b/src/engine/e_input.pas deleted file mode 100644 index 6415808..0000000 --- a/src/engine/e_input.pas +++ /dev/null @@ -1,502 +0,0 @@ -Unit e_input; - -Interface - -Uses - Windows, - SysUtils, - e_log, - DirectInput; - -{type - TMouseInfo = record - X, Y: Integer; - Buttons: Array [0..3] of Boolean; - Accel: Real; - end;} - -const - e_MaxInputKeys = 256 + 32 + 6 + 6 + 4 - 1; - // 0..255 - 256 Keyboard buttons/keys - // 256..287 - 32 Joystick buttons - // 288..293 - 3 Joystick axises +/- - // 294..299 - 3 Joystick axis rotations +/- - // 300..303 - 2 Joystick sliders +/- - - e_WrongKey = 65535; - - e_IKey_Escape = DIK_ESCAPE; - e_IKey_Backspace = DIK_BACK; - e_IKey_Tab = DIK_TAB; - e_IKey_Enter = DIK_RETURN; - e_IKey_Space = DIK_SPACE; - - e_IKey_Up = DIK_UP; - e_IKey_Left = DIK_LEFT; - e_IKey_Right = DIK_RIGHT; - e_IKey_Down = DIK_DOWN; - -{procedure e_PollMouse();} -function e_InitDirectInput(hWnd: HWND): Boolean; -procedure e_ReleaseDirectInput(); -procedure e_ClearInputBuffer(); -function e_PollInput(): Boolean; -function e_KeyPressed(Key: Word): Boolean; -function e_AnyKeyPressed(): Boolean; -function e_GetFirstKeyPressed(): Word; -function e_JoystickStateToString(mode: Integer): String; - -var - {e_MouseInfo: TMouseInfo;} - e_EnableInput: Boolean = False; - e_JoystickAvailable: Boolean = False; - -Implementation - -const - CUSTOMIZABLE_JOYSTICK = True; - -type - TJoystickCustomField = record - here: Boolean; - min, center, max: Integer; - end; - - TJoystickCustom = record - X: TJoystickCustomField; (* x-axis position *) - Y: TJoystickCustomField; (* y-axis position *) - Z: TJoystickCustomField; (* z-axis position *) - - Rx: TJoystickCustomField; (* x-axis rotation *) - Ry: TJoystickCustomField; (* y-axis rotation *) - Rz: TJoystickCustomField; (* z-axis rotation *) - - Slider: Array [0..1] of TJoystickCustomField; (* extra axes positions *) - POV: Array [0..3] of TJoystickCustomField; (* POV directions *) - end; - -var - lpDI8: IDirectInput8 = nil; - lpDIKeyboard: IDirectInputDevice8 = nil; - {lpDIMouse: IDirectInputDevice8 = nil;} - lpDIJoystick: IDirectInputDevice8 = nil; - ms: TDIMOUSESTATE; - _h_Wnd: HWND; - keyBuffer: Array [0..255] of Byte; - joystickState: TDIJoyState; - joystickCustomized: Boolean = False; - joystickCustom: TJoystickCustom; - - -function GetMaxFromCenter(center: Integer): Integer; -begin - Result := center * 2; - if (Result < center) or (Result > MaxInt) then - Result := MaxInt; -end; - -function PosRelation(pos: Integer; field: TJoystickCustomField): Integer; -begin - if (not field.here) or (pos = field.center) then - Result := 0 - else - if (field.center < pos) then - begin - if (pos > (field.center + ((field.max - field.center) div 3))) then - Result := 1 - else - Result := 0; - end - else // pos < field.center - begin - if (pos < (field.center - ((field.center - field.min) div 3))) then - Result := -1 - else - Result := 0; - end; -end; - -procedure CustomizeJoystick(); -var - i: Integer; -begin - joystickCustom.X.here := (joystickState.lX <> 0); - if (joystickCustom.X.here) then - begin - joystickCustom.X.center := joystickState.lX; - joystickCustom.X.min := 0; - joystickCustom.X.max := GetMaxFromCenter(joystickCustom.X.center); - end; - - joystickCustom.Y.here := (joystickState.lY <> 0); - if (joystickCustom.Y.here) then - begin - joystickCustom.Y.center := joystickState.lY; - joystickCustom.Y.min := 0; - joystickCustom.Y.max := GetMaxFromCenter(joystickCustom.Y.center); - end; - - joystickCustom.Z.here := (joystickState.lZ <> 0); - if (joystickCustom.Z.here) then - begin - joystickCustom.Z.center := joystickState.lZ; - joystickCustom.Z.min := 0; - joystickCustom.Z.max := GetMaxFromCenter(joystickCustom.Z.center); - end; - - joystickCustom.Rx.here := (joystickState.lRx <> 0); - if (joystickCustom.Rx.here) then - begin - joystickCustom.Rx.center := joystickState.lRx; - joystickCustom.Rx.min := 0; - joystickCustom.Rx.max := GetMaxFromCenter(joystickCustom.Rx.center); - end; - - joystickCustom.Ry.here := (joystickState.lRy <> 0); - if (joystickCustom.Ry.here) then - begin - joystickCustom.Ry.center := joystickState.lRy; - joystickCustom.Ry.min := 0; - joystickCustom.Ry.max := GetMaxFromCenter(joystickCustom.Ry.center); - end; - - joystickCustom.Rz.here := (joystickState.lRz <> 0); - if (joystickCustom.Rz.here) then - begin - joystickCustom.Rz.center := joystickState.lRz; - joystickCustom.Rz.min := 0; - joystickCustom.Rz.max := GetMaxFromCenter(joystickCustom.Rz.center); - end; - - for i := 0 to 1 do - begin - joystickCustom.Slider[i].here := (joystickState.rglSlider[i] <> 0); - if (joystickCustom.Slider[i].here) then - begin - joystickCustom.Slider[i].center := joystickState.rglSlider[i]; - joystickCustom.Slider[i].min := 0; - joystickCustom.Slider[i].max := GetMaxFromCenter(joystickCustom.Slider[i].center); - end; - end; - -// TODO: POV 0..3: -// * value = $FFFFFFFF - no POV or it is in its center -// * value = Angle_In_Degrees * 100 -// * 0 - Up, 9000 - Right, 18000 - Down, 27000 - Left -// * How to customize it? - -end; - -{procedure e_PollMouse(); -begin - if (GetForegroundWindow = _h_Wnd) then - if (lpDImouse.GetDeviceState(SizeOf(TDIMOUSESTATE), @ms) <> 0) then - begin - lpDIMouse.Acquire(); - if FAILED(lpDImouse.GetDeviceState(SizeOf(TDIMOUSESTATE), @ms)) then - Exit; - end; - - if ms.lX < 0 then ms.lX := Round(ms.lX * e_MouseInfo.Accel) else - if ms.lX > 0 then ms.lX := Round(ms.lX * e_MouseInfo.Accel); - - if ms.lY < 0 then ms.lY := Round(ms.lY * e_MouseInfo.Accel) else - if ms.lY > 0 then ms.lY := Round(ms.lY * e_MouseInfo.Accel); - - e_MouseInfo.X := e_MouseInfo.X + ms.lX; - e_MouseInfo.Y := e_MouseInfo.Y + ms.lY; - - e_MouseInfo.Buttons[0] := ms.rgbButtons[0] = $080; - e_MouseInfo.Buttons[1] := ms.rgbButtons[1] = $080; - e_MouseInfo.Buttons[2] := ms.rgbButtons[2] = $080; - e_MouseInfo.Buttons[3] := ms.rgbButtons[3] = $080; -end;} - -function PollKeyboard(): Boolean; -begin - Result := False; - - if (GetForegroundWindow() = _h_Wnd) then - if (lpDIKeyboard.GetDeviceState(SizeOf(keyBuffer), @keyBuffer) <> 0) then - begin - lpDIKeyboard.Acquire(); - if FAILED(lpDIKeyboard.GetDeviceState(SizeOf(keyBuffer), @keyBuffer)) then - Exit; - end; - - Result := True; -end; - -function PollJoystick(): Boolean; -begin - Result := False; - - if (lpDIJoystick = nil) then - Exit; - - if (GetForegroundWindow() = _h_Wnd) then - if (lpDIJoystick.GetDeviceState(SizeOf(TDIJoyState), @joystickState) <> 0) then - begin - lpDIJoystick.Acquire(); - if FAILED(lpDIJoystick.GetDeviceState(SizeOf(TDIJoyState), @joystickState)) then - Exit; - end; - - if (not joystickCustomized) and CUSTOMIZABLE_JOYSTICK then - begin - CustomizeJoystick(); - joystickCustomized := True; - end; - - Result := True; -end; - -function InitJoystick(hWnd: HWND): Boolean; -begin - Result := False; - - if FAILED(lpDI8.CreateDevice(GUID_Joystick, lpDIJoystick, nil)) then - Exit; - lpDIJoystick._AddRef(); - - if FAILED(lpDIJoystick.SetDataFormat(c_dfDIJoystick)) then - Exit; - - if FAILED(lpDIJoystick.SetCooperativeLevel(hWnd, DISCL_FOREGROUND or - DISCL_NONEXCLUSIVE)) then - Exit; - lpDIJoystick.Acquire(); - - Result := True; -end; - -function e_InitDirectInput(hWnd: HWND): Boolean; -begin - Result := False; - - if FAILED(DirectInput8Create(GetModuleHandle(nil), DIRECTINPUT_VERSION, - IID_IDirectInput8, lpDI8, nil)) then - Exit; - lpDI8._AddRef(); - -// Keyboard: - if FAILED(lpDI8.CreateDevice(GUID_SysKeyboard, lpDIKeyboard, nil)) then - Exit; - lpDIKeyboard._AddRef(); - - if FAILED(lpDIKeyboard.SetDataFormat(c_dfDIKeyboard)) then - Exit; - - if FAILED(lpDIKeyboard.SetCooperativeLevel(hWnd, DISCL_FOREGROUND or - DISCL_NONEXCLUSIVE)) then - Exit; - lpDIKeyboard.Acquire(); - -// Mouse: -{ Since we don't actually need the mouse in the game, I commented this out. - if FAILED(lpDI8.CreateDevice(GUID_SysMouse, lpDIMouse, nil)) then - Exit; - lpDIMouse._AddRef(); - - if FAILED(lpDIMouse.SetDataFormat(c_dfDIMouse)) then - Exit; - - if FAILED(lpDIMouse.SetCooperativeLevel(hWnd, DISCL_FOREGROUND or DISCL_NONEXCLUSIVE)) then - Exit; - lpDIMouse.Acquire(); -} - -// Joystick: - e_JoystickAvailable := InitJoystick(hWnd); - if (not e_JoystickAvailable) then - lpDIJoystick := nil; - - e_EnableInput := True; - _h_Wnd := hWnd; - - Result := True; -end; - -procedure e_ReleaseDirectInput(); -begin - if lpDIKeyboard <> nil then - begin - lpDIKeyboard.Unacquire(); - lpDIKeyboard._Release(); - lpDIKeyboard := nil; - end; - -{ if lpDIMouse <> nil then - begin - lpDIMouse.Unacquire(); - lpDIMouse._Release(); - lpDIMouse := nil; - end; } - - if lpDIJoystick <> nil then - begin - lpDIJoystick.Unacquire(); - lpDIJoystick._Release(); - lpDIJoystick := nil; - end; - - if lpDI8 <> nil then - begin - lpDI8._Release(); - lpDI8 := nil; - end; -end; - -procedure e_ClearInputBuffer(); -var - i: Integer; - -begin - for i := 0 to 255 do - keyBuffer[i] := 0; - - FillChar(joystickState, SizeOf(TDIJoyState), 0); -end; - -function e_PollInput(): Boolean; -var - kb, js: Boolean; -begin - kb := PollKeyboard(); - js := PollJoystick(); - - Result := kb or js; -end; - -function e_KeyPressed(Key: Word): Boolean; -begin - if ((Key >= 0) and (Key <= 255)) then - begin // Keyboard buttons/keys - Result := (keyBuffer[Key] = $80); - end - else if ((Key >= 256) and (Key <= 287)) then - begin // Joystick buttons - Key := Key - 256; - Result := (joystickState.rgbButtons[Key] = $80); - end - else if (CUSTOMIZABLE_JOYSTICK) then - begin // Joystick axises and sliders - case Key of - 288: Result := (PosRelation(joystickState.lX, joystickCustom.X) = -1); // X- - 289: Result := (PosRelation(joystickState.lX, joystickCustom.X) = 1); // X+ - 290: Result := (PosRelation(joystickState.lY, joystickCustom.Y) = -1); // Y- - 291: Result := (PosRelation(joystickState.lY, joystickCustom.Y) = 1); // Y+ - 292: Result := (PosRelation(joystickState.lZ, joystickCustom.Z) = -1); // Z- - 293: Result := (PosRelation(joystickState.lZ, joystickCustom.Z) = 1); // Z+ - - 294: Result := (PosRelation(joystickState.lRx, joystickCustom.Rx) = -1); // Rx- - 295: Result := (PosRelation(joystickState.lRx, joystickCustom.Rx) = 1); // Rx+ - 296: Result := (PosRelation(joystickState.lRy, joystickCustom.Ry) = -1); // Ry- - 297: Result := (PosRelation(joystickState.lRy, joystickCustom.Ry) = 1); // Ry+ - 298: Result := (PosRelation(joystickState.lRz, joystickCustom.Rz) = -1); // Rz- - 299: Result := (PosRelation(joystickState.lRz, joystickCustom.Rz) = 1); // Rz+ - - 300: Result := (PosRelation(joystickState.rglSlider[0], joystickCustom.Slider[0]) = -1); // Slider1- - 301: Result := (PosRelation(joystickState.rglSlider[0], joystickCustom.Slider[0]) = 1); // Slider1+ - - 302: Result := (PosRelation(joystickState.rglSlider[1], joystickCustom.Slider[1]) = -1); // Slider2- - 303: Result := (PosRelation(joystickState.rglSlider[1], joystickCustom.Slider[1]) = 1); // Slider2+ - - else Result := False; - end; - end - else - Result := False; -end; - -function e_AnyKeyPressed(): Boolean; -var - k: Word; -begin - Result := False; - - for k := 0 to e_MaxInputKeys do - if e_KeyPressed(k) then - begin - Result := True; - Break; - end; -end; - -function e_GetFirstKeyPressed(): Word; -var - k: Word; -begin - Result := e_WrongKey; - - for k := 0 to e_MaxInputKeys do - if e_KeyPressed(k) then - begin - Result := k; - Break; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// - -function e_JoystickStateToString(mode: Integer): String; -var - i: Integer; -begin - Result := ''; - - if (mode = 1) then - begin - // 0..65535: Up/Left .. Down/Right: - Result := Result + 'X=' + IntToStr(joystickState.lX) + ', '; - Result := Result + 'Y=' + IntToStr(joystickState.lY) + ', '; - Result := Result + 'Z=' + IntToStr(joystickState.lZ) + '; '; - end - else if (mode = 2) then - begin - // 0..65535: Left .. Center .. Right: - Result := Result + 'Rx=' + IntToStr(joystickState.lRx) + ', '; - Result := Result + 'Ry=' + IntToStr(joystickState.lRy) + ', '; - Result := Result + 'Rz=' + IntToStr(joystickState.lRz) + '; '; - end - else if (mode = 3) then - begin - // 0..65535: Up .. Down: - Result := Result + 'Slider[0]=' + IntToStr(joystickState.rglSlider[0]) + ', '; - Result := Result + 'Slider[1]=' + IntToStr(joystickState.rglSlider[1]) + '; '; - end - else if (mode = 4) then - begin - // 0..35999: POV angle, Up = 0, Clockwise, Center = $FFFFFFFF: - Result := Result + 'POV[0]=' + IntToStr(joystickState.rgdwPOV[0]) + ', '; - Result := Result + 'POV[1]=' + IntToStr(joystickState.rgdwPOV[1]) + ', '; - Result := Result + 'POV[2]=' + IntToStr(joystickState.rgdwPOV[2]) + ', '; - Result := Result + 'POV[3]=' + IntToStr(joystickState.rgdwPOV[3]) + '; '; - end - else if (mode = 5) then - begin - // 0 or 128 ($80): NotPressed or Pressed: - for i := 0 to 7 do - Result := Result + 'B[' + IntToStr(i) + ']=' + IntToStr(joystickState.rgbButtons[i]) + ', '; - end - else if (mode = 6) then - begin - // 0 or 128 ($80): NotPressed or Pressed: - for i := 8 to 15 do - Result := Result + 'B[' + IntToStr(i) + ']=' + IntToStr(joystickState.rgbButtons[i]) + ', '; - end - else if (mode = 7) then - begin - // 0 or 128 ($80): NotPressed or Pressed: - for i := 16 to 23 do - Result := Result + 'B[' + IntToStr(i) + ']=' + IntToStr(joystickState.rgbButtons[i]) + ', '; - end - else if (mode = 8) then - begin - // 0 or 128 ($80): NotPressed or Pressed: - for i := 24 to 31 do - Result := Result + 'B[' + IntToStr(i) + ']=' + IntToStr(joystickState.rgbButtons[i]) + '; '; - end -end; - -end. diff --git a/src/engine/e_log.pas b/src/engine/e_log.pas index b2b9826..2cabc36 100644 --- a/src/engine/e_log.pas +++ b/src/engine/e_log.pas @@ -1,6 +1,6 @@ unit e_log; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} interface diff --git a/src/engine/e_sound.pas b/src/engine/e_sound.pas deleted file mode 100644 index 3e0a9fe..0000000 --- a/src/engine/e_sound.pas +++ /dev/null @@ -1,1000 +0,0 @@ -unit e_sound; - -interface - -uses - fmod, - fmodtypes, - fmoderrors, - e_log, - SysUtils, - Windows; - -type - TSoundRec = record - Data: Pointer; - Sound: FMOD_SOUND; - Loop: Boolean; - nRefs: Integer; - end; - - TBasicSound = class (TObject) - private - FChannel: FMOD_CHANNEL; - - protected - FID: DWORD; - FLoop: Boolean; - FPosition: DWORD; - FPriority: Integer; - - function RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean; - - public - constructor Create(); - destructor Destroy(); override; - procedure SetID(ID: DWORD); - procedure FreeSound(); - function IsPlaying(): Boolean; - procedure Stop(); - function IsPaused(): Boolean; - procedure Pause(Enable: Boolean); - function GetVolume(): Single; - procedure SetVolume(Volume: Single); - function GetPan(): Single; - procedure SetPan(Pan: Single); - function IsMuted(): Boolean; - procedure Mute(Enable: Boolean); - function GetPosition(): DWORD; - procedure SetPosition(aPos: DWORD); - procedure SetPriority(priority: Integer); - end; - -const - NO_SOUND_ID = DWORD(-1); - -function e_InitSoundSystem(Freq: Integer): Boolean; - -function e_LoadSound(FileName: string; var ID: DWORD; bLoop: Boolean): Boolean; -function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean; - -function e_PlaySound(ID: DWORD): Boolean; -function e_PlaySoundPan(ID: DWORD; Pan: Single): Boolean; -function e_PlaySoundVolume(ID: DWORD; Volume: Single): Boolean; -function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Boolean; - -procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean); -procedure e_MuteChannels(Enable: Boolean); -procedure e_StopChannels(); - -procedure e_DeleteSound(ID: DWORD); -procedure e_RemoveAllSounds(); -procedure e_ReleaseSoundSystem(); -procedure e_SoundUpdate(); - -var - e_SoundsArray: array of TSoundRec = nil; - -implementation - -uses - g_window, g_options; - -const - N_CHANNELS = 512; - -var - F_System: FMOD_SYSTEM = nil; - SoundMuted: Boolean = False; - - -function Channel_Callback(channel: FMOD_CHANNEL; callbacktype: FMOD_CHANNEL_CALLBACKTYPE; - commanddata1: Pointer; commanddata2: Pointer): FMOD_RESULT; stdcall; -var - res: FMOD_RESULT; - sound: FMOD_SOUND; - ud: Pointer; - id: DWORD; - -begin - res := FMOD_OK; - - if callbacktype = FMOD_CHANNEL_CALLBACKTYPE_END then - begin - res := FMOD_Channel_GetCurrentSound(channel, sound); - if res = FMOD_OK then - begin - res := FMOD_Sound_GetUserData(sound, ud); - if res = FMOD_OK then - begin - id := DWORD(ud^); - if id < DWORD(Length(e_SoundsArray)) then - if e_SoundsArray[id].nRefs > 0 then - Dec(e_SoundsArray[id].nRefs); - end; - end; - end; - - Result := res; -end; - -function e_InitSoundSystem(Freq: Integer): Boolean; -var - res: FMOD_RESULT; - ver: Cardinal; - output: FMOD_OUTPUTTYPE; - drv: Integer; - -begin - Result := False; - - res := FMOD_System_Create(F_System); - if res <> FMOD_OK then - begin - e_WriteLog('Error creating FMOD system:', MSG_FATALERROR); - e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); - Exit; - end; - - res := FMOD_System_GetVersion(F_System, ver); - if res <> FMOD_OK then - begin - e_WriteLog('Error getting FMOD version:', MSG_FATALERROR); - e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); - Exit; - end; - - if ver < FMOD_VERSION then - begin - e_WriteLog('FMOD DLL version is too old! Need '+IntToStr(FMOD_VERSION), MSG_FATALERROR); - Exit; - end; - - res := FMOD_System_SetSoftwareFormat(F_System, Freq, - FMOD_SOUND_FORMAT_PCM16, 0, 0, FMOD_DSP_RESAMPLER_LINEAR); - if res <> FMOD_OK then - begin - e_WriteLog('Error setting FMOD software format!', MSG_FATALERROR); - e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); - Exit; - end; - - res := FMOD_System_Init(F_System, N_CHANNELS, FMOD_INIT_NORMAL, nil); - if res <> FMOD_OK then - begin - e_WriteLog('Error initializing FMOD system!', MSG_WARNING); - e_WriteLog(FMOD_ErrorString(res), MSG_WARNING); - e_WriteLog('Trying with OUTPUTTYPE_NOSOUND...', MSG_WARNING); - res := FMOD_System_SetOutput(F_System, FMOD_OUTPUTTYPE_NOSOUND); - if res <> FMOD_OK then - begin - e_WriteLog('Error setting FMOD output to NOSOUND!', MSG_FATALERROR); - e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); - Exit; - end; - res := FMOD_System_Init(F_System, N_CHANNELS, FMOD_INIT_NORMAL, nil); - if res <> FMOD_OK then - begin - e_WriteLog('Error initializing FMOD system!', MSG_FATALERROR); - e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); - Exit; - end; - end; - - res := FMOD_System_GetOutput(F_System, output); - if res <> FMOD_OK then - e_WriteLog('Error getting FMOD output!', MSG_WARNING) - else - case output of - FMOD_OUTPUTTYPE_NOSOUND: e_WriteLog('FMOD Output Method: NOSOUND', MSG_NOTIFY); - FMOD_OUTPUTTYPE_NOSOUND_NRT: e_WriteLog('FMOD Output Method: NOSOUND_NRT', MSG_NOTIFY); - FMOD_OUTPUTTYPE_DSOUND: e_WriteLog('FMOD Output Method: DSOUND', MSG_NOTIFY); - FMOD_OUTPUTTYPE_WINMM: e_WriteLog('FMOD Output Method: WINMM', MSG_NOTIFY); - FMOD_OUTPUTTYPE_OPENAL: e_WriteLog('FMOD Output Method: OPENAL', MSG_NOTIFY); - FMOD_OUTPUTTYPE_WASAPI: e_WriteLog('FMOD Output Method: WASAPI', MSG_NOTIFY); - FMOD_OUTPUTTYPE_ASIO: e_WriteLog('FMOD Output Method: ASIO', MSG_NOTIFY); - else e_WriteLog('FMOD Output Method: Unknown', MSG_NOTIFY); - end; - - res := FMOD_System_GetDriver(F_System, drv); - if res <> FMOD_OK then - e_WriteLog('Error getting FMOD driver!', MSG_WARNING) - else - begin - {res := FMOD_System_GetDriverName(F_System, drv, str, 64); - if res <> FMOD_OK then - e_WriteLog('Error getting FMOD driver name!', MSG_WARNING) - else } - e_WriteLog('FMOD driver id: '+IntToStr(drv), MSG_NOTIFY); - end; - - Result := True; -end; - -function FindESound(): DWORD; -var - i: Integer; - -begin - if e_SoundsArray <> nil then - for i := 0 to High(e_SoundsArray) do - if e_SoundsArray[i].Sound = nil then - begin - Result := i; - Exit; - end; - - if e_SoundsArray = nil then - begin - SetLength(e_SoundsArray, 16); - Result := 0; - end - else - begin - Result := High(e_SoundsArray) + 1; - SetLength(e_SoundsArray, Length(e_SoundsArray) + 16); - end; -end; - -function e_LoadSound(FileName: String; var ID: DWORD; bLoop: Boolean): Boolean; -var - find_id: DWORD; - res: FMOD_RESULT; - bt: Cardinal; - ud: Pointer; - -begin - Result := False; - - e_WriteLog('Loading sound '+FileName+'...', MSG_NOTIFY); - - find_id := FindESound(); - - if bLoop then - bt := FMOD_LOOP_NORMAL - else - bt := FMOD_LOOP_OFF; - - if not bLoop then - res := FMOD_System_CreateSound(F_System, PAnsiChar(FileName), - bt + FMOD_2D + FMOD_HARDWARE, - nil, e_SoundsArray[find_id].Sound) - else - res := FMOD_System_CreateStream(F_System, PAnsiChar(FileName), - bt + FMOD_2D + FMOD_HARDWARE, - nil, e_SoundsArray[find_id].Sound); - if res <> FMOD_OK then - begin - e_SoundsArray[find_id].Sound := nil; - Exit; - end; - - GetMem(ud, SizeOf(DWORD)); - DWORD(ud^) := find_id; - res := FMOD_Sound_SetUserData(e_SoundsArray[find_id].Sound, ud); - if res <> FMOD_OK then - begin - e_SoundsArray[find_id].Sound := nil; - Exit; - end; - - e_SoundsArray[find_id].Data := nil; - e_SoundsArray[find_id].Loop := bLoop; - e_SoundsArray[find_id].nRefs := 0; - - ID := find_id; - - Result := True; -end; - -function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean; -var - find_id: DWORD; - res: FMOD_RESULT; - sz: Integer; - bt: Cardinal; - soundExInfo: FMOD_CREATESOUNDEXINFO; - ud: Pointer; - -begin - Result := False; - - find_id := FindESound(); - - sz := SizeOf(FMOD_CREATESOUNDEXINFO); - FillMemory(@soundExInfo, sz, 0); - soundExInfo.cbsize := sz; - soundExInfo.length := Length; - - if bLoop then - bt := FMOD_LOOP_NORMAL - else - bt := FMOD_LOOP_OFF; - - if not bLoop then - res := FMOD_System_CreateSound(F_System, pData, - bt + FMOD_2D + FMOD_HARDWARE + FMOD_OPENMEMORY, - @soundExInfo, e_SoundsArray[find_id].Sound) - else - res := FMOD_System_CreateStream(F_System, pData, - bt + FMOD_2D + FMOD_HARDWARE + FMOD_OPENMEMORY, - @soundExInfo, e_SoundsArray[find_id].Sound); - if res <> FMOD_OK then - begin - e_SoundsArray[find_id].Sound := nil; - Exit; - end; - - GetMem(ud, SizeOf(DWORD)); - DWORD(ud^) := find_id; - res := FMOD_Sound_SetUserData(e_SoundsArray[find_id].Sound, ud); - if res <> FMOD_OK then - begin - e_SoundsArray[find_id].Sound := nil; - Exit; - end; - - e_SoundsArray[find_id].Data := pData; - e_SoundsArray[find_id].Loop := bLoop; - e_SoundsArray[find_id].nRefs := 0; - - ID := find_id; - - Result := True; -end; - -function e_PlaySound(ID: DWORD): Boolean; -var - res: FMOD_RESULT; - Chan: FMOD_CHANNEL; - -begin - if e_SoundsArray[ID].nRefs >= gMaxSimSounds then - begin - Result := True; - Exit; - end; - - Result := False; - - res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, - e_SoundsArray[ID].Sound, False, Chan); - if res <> FMOD_OK then - begin - Exit; - end; - - res := FMOD_Channel_SetCallback(Chan, Channel_Callback); - if res <> FMOD_OK then - begin - end; - - if SoundMuted then - begin - res := FMOD_Channel_SetMute(Chan, True); - if res <> FMOD_OK then - begin - end; - end; - - Inc(e_SoundsArray[ID].nRefs); - Result := True; -end; - -function e_PlaySoundPan(ID: DWORD; Pan: Single): Boolean; -var - res: FMOD_RESULT; - Chan: FMOD_CHANNEL; - -begin - if e_SoundsArray[ID].nRefs >= gMaxSimSounds then - begin - Result := True; - Exit; - end; - - Result := False; - - res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, - e_SoundsArray[ID].Sound, False, Chan); - if res <> FMOD_OK then - begin - Exit; - end; - - res := FMOD_Channel_SetPan(Chan, Pan); - if res <> FMOD_OK then - begin - end; - - res := FMOD_Channel_SetCallback(Chan, Channel_Callback); - if res <> FMOD_OK then - begin - end; - - if SoundMuted then - begin - res := FMOD_Channel_SetMute(Chan, True); - if res <> FMOD_OK then - begin - end; - end; - - Inc(e_SoundsArray[ID].nRefs); - Result := True; -end; - -function e_PlaySoundVolume(ID: DWORD; Volume: Single): Boolean; -var - res: FMOD_RESULT; - Chan: FMOD_CHANNEL; - -begin - if e_SoundsArray[ID].nRefs >= gMaxSimSounds then - begin - Result := True; - Exit; - end; - - Result := False; - - res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, - e_SoundsArray[ID].Sound, False, Chan); - if res <> FMOD_OK then - begin - Exit; - end; - - res := FMOD_Channel_SetVolume(Chan, Volume); - if res <> FMOD_OK then - begin - end; - - res := FMOD_Channel_SetCallback(Chan, Channel_Callback); - if res <> FMOD_OK then - begin - end; - - if SoundMuted then - begin - res := FMOD_Channel_SetMute(Chan, True); - if res <> FMOD_OK then - begin - end; - end; - - Inc(e_SoundsArray[ID].nRefs); - Result := True; -end; - -function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Boolean; -var - res: FMOD_RESULT; - Chan: FMOD_CHANNEL; - -begin - if e_SoundsArray[ID].nRefs >= gMaxSimSounds then - begin - Result := True; - Exit; - end; - - Result := False; - - res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, - e_SoundsArray[ID].Sound, False, Chan); - if res <> FMOD_OK then - begin - Exit; - end; - - res := FMOD_Channel_SetPan(Chan, Pan); - if res <> FMOD_OK then - begin - end; - - res := FMOD_Channel_SetVolume(Chan, Volume); - if res <> FMOD_OK then - begin - end; - - res := FMOD_Channel_SetCallback(Chan, Channel_Callback); - if res <> FMOD_OK then - begin - end; - - if SoundMuted then - begin - res := FMOD_Channel_SetMute(Chan, True); - if res <> FMOD_OK then - begin - end; - end; - - Inc(e_SoundsArray[ID].nRefs); - Result := True; -end; - -procedure e_DeleteSound(ID: DWORD); -var - res: FMOD_RESULT; - ud: Pointer; - -begin - if e_SoundsArray[ID].Sound = nil then - Exit; - - if e_SoundsArray[ID].Data <> nil then - FreeMem(e_SoundsArray[ID].Data); - - res := FMOD_Sound_GetUserData(e_SoundsArray[ID].Sound, ud); - if res = FMOD_OK then - begin - FreeMem(ud); - end; - - res := FMOD_Sound_Release(e_SoundsArray[ID].Sound); - if res <> FMOD_OK then - begin - e_WriteLog('Error releasing sound:', MSG_WARNING); - e_WriteLog(FMOD_ErrorString(res), MSG_WARNING); - end; - - e_SoundsArray[ID].Sound := nil; - e_SoundsArray[ID].Data := nil; -end; - -procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean); -var - res: FMOD_RESULT; - i: Integer; - Chan: FMOD_CHANNEL; - vol: Single; - -begin - for i := 0 to N_CHANNELS-1 do - begin - Chan := nil; - res := FMOD_System_GetChannel(F_System, i, Chan); - - if (res = FMOD_OK) and (Chan <> nil) then - begin - res := FMOD_Channel_GetVolume(Chan, vol); - - if res = FMOD_OK then - begin - if setMode then - vol := SoundMod - else - vol := vol * SoundMod; - - res := FMOD_Channel_SetVolume(Chan, vol); - - if res <> FMOD_OK then - begin - end; - end; - end; - end; -end; - -procedure e_MuteChannels(Enable: Boolean); -var - res: FMOD_RESULT; - i: Integer; - Chan: FMOD_CHANNEL; - -begin - if Enable = SoundMuted then - Exit; - - SoundMuted := Enable; - - for i := 0 to N_CHANNELS-1 do - begin - Chan := nil; - res := FMOD_System_GetChannel(F_System, i, Chan); - - if (res = FMOD_OK) and (Chan <> nil) then - begin - res := FMOD_Channel_SetMute(Chan, Enable); - - if res <> FMOD_OK then - begin - end; - end; - end; -end; - -procedure e_StopChannels(); -var - res: FMOD_RESULT; - i: Integer; - Chan: FMOD_CHANNEL; - -begin - for i := 0 to N_CHANNELS-1 do - begin - Chan := nil; - res := FMOD_System_GetChannel(F_System, i, Chan); - - if (res = FMOD_OK) and (Chan <> nil) then - begin - res := FMOD_Channel_Stop(Chan); - - if res <> FMOD_OK then - begin - end; - end; - end; -end; - -procedure e_RemoveAllSounds(); -var - i: Integer; - -begin - for i := 0 to High(e_SoundsArray) do - if e_SoundsArray[i].Sound <> nil then - e_DeleteSound(i); - - SetLength(e_SoundsArray, 0); - e_SoundsArray := nil; -end; - -procedure e_ReleaseSoundSystem(); -var - res: FMOD_RESULT; - -begin - e_RemoveAllSounds(); - - res := FMOD_System_Close(F_System); - if res <> FMOD_OK then - begin - e_WriteLog('Error closing FMOD system!', MSG_FATALERROR); - e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); - Exit; - end; - - res := FMOD_System_Release(F_System); - if res <> FMOD_OK then - begin - e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR); - e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); - end; -end; - -procedure e_SoundUpdate(); -begin - FMOD_System_Update(F_System); -end; - -{ TBasicSound: } - -constructor TBasicSound.Create(); -begin - FID := NO_SOUND_ID; - FLoop := False; - FChannel := nil; - FPosition := 0; - FPriority := 128; -end; - -destructor TBasicSound.Destroy(); -begin - FreeSound(); - inherited; -end; - -procedure TBasicSound.FreeSound(); -begin - if FID = NO_SOUND_ID then - Exit; - - Stop(); - FID := NO_SOUND_ID; - FLoop := False; - FPosition := 0; -end; - -function TBasicSound.RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean; -var - res: FMOD_RESULT; - -begin - if e_SoundsArray[FID].nRefs >= gMaxSimSounds then - begin - Result := True; - Exit; - end; - - Result := False; - - if FID = NO_SOUND_ID then - Exit; - - res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, - e_SoundsArray[FID].Sound, False, FChannel); - if res <> FMOD_OK then - begin - FChannel := nil; - Exit; - end; - - res := FMOD_Channel_SetPosition(FChannel, aPos, FMOD_TIMEUNIT_MS); - if res <> FMOD_OK then - begin - FPosition := 0; - end - else - FPosition := aPos; - - res := FMOD_Channel_SetPan(FChannel, Pan); - if res <> FMOD_OK then - begin - end; - - res := FMOD_Channel_SetVolume(FChannel, Volume); - if res <> FMOD_OK then - begin - end; - - res := FMOD_Channel_SetCallback(FChannel, Channel_Callback); - if res <> FMOD_OK then - begin - end; - - if SoundMuted then - begin - res := FMOD_Channel_SetMute(FChannel, True); - if res <> FMOD_OK then - begin - end; - end; - - Inc(e_SoundsArray[FID].nRefs); - Result := True; -end; - -procedure TBasicSound.SetID(ID: DWORD); -begin - FreeSound(); - FID := ID; - FLoop := e_SoundsArray[ID].Loop; -end; - -function TBasicSound.IsPlaying(): Boolean; -var - res: FMOD_RESULT; - b: LongBool; - -begin - Result := False; - - if FChannel = nil then - Exit; - - res := FMOD_Channel_IsPlaying(FChannel, b); - if res <> FMOD_OK then - begin - Exit; - end; - - Result := b; -end; - -procedure TBasicSound.Stop(); -var - res: FMOD_RESULT; - -begin - if FChannel = nil then - Exit; - - GetPosition(); - - res := FMOD_Channel_Stop(FChannel); - if res <> FMOD_OK then - begin - end; - - FChannel := nil; -end; - -function TBasicSound.IsPaused(): Boolean; -var - res: FMOD_RESULT; - b: LongBool; - -begin - Result := False; - - if FChannel = nil then - Exit; - - res := FMOD_Channel_GetPaused(FChannel, b); - if res <> FMOD_OK then - begin - Exit; - end; - - Result := b; -end; - -procedure TBasicSound.Pause(Enable: Boolean); -var - res: FMOD_RESULT; - -begin - if FChannel = nil then - Exit; - - res := FMOD_Channel_SetPaused(FChannel, Enable); - if res <> FMOD_OK then - begin - end; - - if Enable then - begin - res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS); - if res <> FMOD_OK then - begin - end; - end; -end; - -function TBasicSound.GetVolume(): Single; -var - res: FMOD_RESULT; - vol: Single; - -begin - Result := 0.0; - - if FChannel = nil then - Exit; - - res := FMOD_Channel_GetVolume(FChannel, vol); - if res <> FMOD_OK then - begin - Exit; - end; - - Result := vol; -end; - -procedure TBasicSound.SetVolume(Volume: Single); -var - res: FMOD_RESULT; - -begin - if FChannel = nil then - Exit; - - res := FMOD_Channel_SetVolume(FChannel, Volume); - if res <> FMOD_OK then - begin - end; -end; - -function TBasicSound.GetPan(): Single; -var - res: FMOD_RESULT; - pan: Single; - -begin - Result := 0.0; - - if FChannel = nil then - Exit; - - res := FMOD_Channel_GetPan(FChannel, pan); - if res <> FMOD_OK then - begin - Exit; - end; - - Result := pan; -end; - -procedure TBasicSound.SetPan(Pan: Single); -var - res: FMOD_RESULT; - -begin - if FChannel = nil then - Exit; - - res := FMOD_Channel_SetPan(FChannel, Pan); - if res <> FMOD_OK then - begin - end; -end; - -function TBasicSound.IsMuted(): Boolean; -var - res: FMOD_RESULT; - b: LongBool; - -begin - Result := False; - - if FChannel = nil then - Exit; - - res := FMOD_Channel_GetMute(FChannel, b); - if res <> FMOD_OK then - begin - Exit; - end; - - Result := b; -end; - -procedure TBasicSound.Mute(Enable: Boolean); -var - res: FMOD_RESULT; - -begin - if FChannel = nil then - Exit; - - res := FMOD_Channel_SetMute(FChannel, Enable); - if res <> FMOD_OK then - begin - end; -end; - -function TBasicSound.GetPosition(): DWORD; -var - res: FMOD_RESULT; - -begin - Result := 0; - - if FChannel = nil then - Exit; - - res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS); - if res <> FMOD_OK then - begin - Exit; - end; - - Result := FPosition; -end; - -procedure TBasicSound.SetPosition(aPos: DWORD); -var - res: FMOD_RESULT; - -begin - FPosition := aPos; - - if FChannel = nil then - Exit; - - res := FMOD_Channel_SetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS); - if res <> FMOD_OK then - begin - end; -end; - -procedure TBasicSound.SetPriority(priority: Integer); -var - res: FMOD_RESULT; - -begin - if (FChannel <> nil) and (FPriority <> priority) and - (priority >= 0) and (priority <= 256) then - begin - FPriority := priority; - res := FMOD_Channel_SetPriority(FChannel, priority); - if res <> FMOD_OK then - begin - end; - end; -end; - -end. diff --git a/src/engine/e_textures.pas b/src/engine/e_textures.pas index e6246bc..52a1e92 100644 --- a/src/engine/e_textures.pas +++ b/src/engine/e_textures.pas @@ -13,7 +13,7 @@ * You should have received a copy of the GNU General Public License * along with this program. If not, see . *) -{$MODE DELPHI} +{$INCLUDE ../shared/a_modes.inc} unit e_textures; { This unit provides interface to load 24-bit and 32-bit uncompressed images diff --git a/src/shared/BinEditor.pas b/src/shared/BinEditor.pas index 43fa78f..9c5f21d 100644 --- a/src/shared/BinEditor.pas +++ b/src/shared/BinEditor.pas @@ -150,7 +150,7 @@ begin if (FPosition + varSize) > FSize then ExtendMemory(varSize); - CopyMemory(Pointer(Cardinal(FData) + FPosition), + CopyMemory(Pointer(PtrUInt(FData) + FPosition), @x, varSize); FPosition := FPosition + varSize; end; @@ -240,13 +240,13 @@ begin ExtendMemory(SizeOf(Byte) + len); // Äëèíà ñòðîêè: - CopyMemory(Pointer(Cardinal(FData) + FPosition), + CopyMemory(Pointer(PtrUInt(FData) + FPosition), @len, SizeOf(Byte)); FPosition := FPosition + SizeOf(Byte); // Ñòðîêà: if len > 0 then begin - CopyMemory(Pointer(Cardinal(FData) + FPosition), + CopyMemory(Pointer(PtrUInt(FData) + FPosition), @x[1], len); FPosition := FPosition + len; end; @@ -258,13 +258,13 @@ begin ExtendMemory(SizeOf(Cardinal) + memSize); // Äëèíà áëîêà ïàìÿòè: - CopyMemory(Pointer(Cardinal(FData) + FPosition), + CopyMemory(Pointer(PtrUInt(FData) + FPosition), @memSize, SizeOf(Cardinal)); FPosition := FPosition + SizeOf(Cardinal); // Áëîê ïàìÿòè: if memSize > 0 then begin - CopyMemory(Pointer(Cardinal(FData) + FPosition), + CopyMemory(Pointer(PtrUInt(FData) + FPosition), x, memSize); FPosition := FPosition + memSize; end; @@ -277,7 +277,7 @@ begin if aLen > 0 then begin - FillMemory(Pointer(Cardinal(FData) + FPosition), + FillMemory(Pointer(PtrUInt(FData) + FPosition), aLen, aFillSym); FPosition := FPosition + aLen; end; @@ -338,7 +338,7 @@ begin if (FPosition + varSize) <= FSize then begin CopyMemory(@x, - Pointer(Cardinal(FData) + FPosition), + Pointer(PtrUInt(FData) + FPosition), varSize); FPosition := FPosition + varSize; end @@ -403,7 +403,7 @@ begin begin // Äëèíà ñòðîêè: CopyMemory(@len, - Pointer(Cardinal(FData) + FPosition), + Pointer(PtrUInt(FData) + FPosition), SizeOf(Byte)); if (FPosition + SizeOf(Byte) + len) <= FSize then @@ -414,7 +414,7 @@ begin if len > 0 then begin CopyMemory(@x[1], - Pointer(Cardinal(FData) + FPosition), + Pointer(PtrUInt(FData) + FPosition), len); FPosition := FPosition + len; end @@ -434,7 +434,7 @@ begin begin // Äëèíà áëîêà ïàìÿòè: CopyMemory(@memSize, - Pointer(Cardinal(FData) + FPosition), + Pointer(PtrUInt(FData) + FPosition), SizeOf(Cardinal)); if (FPosition + SizeOf(Cardinal) + memSize) <= FSize then @@ -445,7 +445,7 @@ begin begin GetMem(x, memSize); CopyMemory(x, - Pointer(Cardinal(FData) + FPosition), + Pointer(PtrUInt(FData) + FPosition), memSize); FPosition := FPosition + memSize; end diff --git a/src/shared/CONFIG.pas b/src/shared/CONFIG.pas index 19c7d01..bcabf17 100644 --- a/src/shared/CONFIG.pas +++ b/src/shared/CONFIG.pas @@ -1,6 +1,6 @@ unit CONFIG; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} { ----------------------------------- diff --git a/src/shared/MAPDEF.pas b/src/shared/MAPDEF.pas index fd0d58b..2cb45aa 100644 --- a/src/shared/MAPDEF.pas +++ b/src/shared/MAPDEF.pas @@ -1,6 +1,6 @@ unit MAPDEF; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} { ----------------------------------- diff --git a/src/shared/MAPREADER.pas b/src/shared/MAPREADER.pas index 736123e..40a1fc0 100644 --- a/src/shared/MAPREADER.pas +++ b/src/shared/MAPREADER.pas @@ -1,12 +1,12 @@ unit MAPREADER; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} { ----------------------------------- -MAPREADER.PAS ВЕРСИЯ ОТ 13.11.07 +MAPREADER.PAS ÂÅÐÑÈß ÎÒ 13.11.07 -Поддержка карт версии 1 +Ïîääåðæêà êàðò âåðñèè 1 ----------------------------------- } @@ -72,9 +72,9 @@ uses SysUtils, BinEditor; var - NNF_PureName: String; // Имя текстуры без цифр в конце - NNF_FirstNum: Integer; // Число у начальной текстуры - NNF_CurrentNum: Integer; // Следующее число у текстуры + NNF_PureName: String; // Èìÿ òåêñòóðû áåç öèôð â êîíöå + NNF_FirstNum: Integer; // ×èñëî ó íà÷àëüíîé òåêñòóðû + NNF_CurrentNum: Integer; // Ñëåäóþùåå ÷èñëî ó òåêñòóðû function g_Texture_NumNameFindStart(name: String): Boolean; var @@ -87,10 +87,10 @@ begin NNF_CurrentNum := -1; for i := Length(name) downto 1 do - if (name[i] = '_') then // "_" - символ начала номерного постфикса + if (name[i] = '_') then // "_" - ñèìâîë íà÷àëà íîìåðíîãî ïîñòôèêñà begin if i = Length(name) then - begin // Нет цифр в конце строки + begin // Íåò öèôð â êîíöå ñòðîêè Exit; end else @@ -101,7 +101,7 @@ begin end; end; -// Не перевести в число: +// Íå ïåðåâåñòè â ÷èñëî: if not TryStrToInt(name, NNF_FirstNum) then Exit; @@ -152,7 +152,7 @@ begin for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do begin SetLength(Result, Length(Result)+1); - CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size); + CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size); end; TempDataBlocks := nil; @@ -176,7 +176,7 @@ begin for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do begin SetLength(Result, Length(Result)+1); - CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size); + CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size); end; TempDataBlocks := nil; @@ -215,7 +215,7 @@ begin for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do begin SetLength(Result, Length(Result)+1); - CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size); + CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size); end; TempDataBlocks := nil; @@ -239,7 +239,7 @@ begin for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do begin SetLength(Result, Length(Result)+1); - CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size); + CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size); end; TempDataBlocks := nil; @@ -263,7 +263,7 @@ begin for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do begin SetLength(Result, Length(Result)+1); - CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size); + CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size); end; TempDataBlocks := nil; @@ -287,7 +287,7 @@ begin for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do begin SetLength(Result, Length(Result)+1); - CopyMemory(@Result[High(Result)], Pointer(LongWord(TempDataBlocks[a].Data)+b*size), size); + CopyMemory(@Result[High(Result)], Pointer(PtrUInt(TempDataBlocks[a].Data)+b*size), size); end; TempDataBlocks := nil; @@ -365,7 +365,7 @@ begin end; adr := 3; - CopyMemory(@Ver, Pointer(LongWord(Data)+adr), 1); + CopyMemory(@Ver, Pointer(PtrUInt(Data)+adr), 1); FVersion := Ver; if Ver > HandledVersion() then begin @@ -378,12 +378,12 @@ begin SetLength(FDataBlocks, Length(FDataBlocks)+1); _id := High(FDataBlocks); - CopyMemory(@FDataBlocks[_id].Block, Pointer(LongWord(Data)+adr), SizeOf(TBlock)); + CopyMemory(@FDataBlocks[_id].Block, Pointer(PtrUInt(Data)+adr), SizeOf(TBlock)); adr := adr+SizeOf(TBlock); FDataBlocks[_id].Data := GetMemory(FDataBlocks[_id].Block.BlockSize); - CopyMemory(FDataBlocks[_id].Data, Pointer(LongWord(Data)+adr), FDataBlocks[_id].Block.BlockSize); + CopyMemory(FDataBlocks[_id].Data, Pointer(PtrUInt(Data)+adr), FDataBlocks[_id].Block.BlockSize); adr := adr+FDataBlocks[_id].Block.BlockSize; until FDataBlocks[_id].Block.BlockType = BLOCK_NONE; diff --git a/src/shared/MAPSTRUCT.pas b/src/shared/MAPSTRUCT.pas index 0456cf7..18cb8ed 100644 --- a/src/shared/MAPSTRUCT.pas +++ b/src/shared/MAPSTRUCT.pas @@ -1,6 +1,6 @@ unit MAPSTRUCT; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} { ----------------------------------- diff --git a/src/shared/MAPWRITER.pas b/src/shared/MAPWRITER.pas index 0759931..4c7a637 100644 --- a/src/shared/MAPWRITER.pas +++ b/src/shared/MAPWRITER.pas @@ -1,12 +1,12 @@ unit MAPWRITER; -{$MODE Delphi} +{$INCLUDE ../shared/a_modes.inc} { ----------------------------------- -MAPWRITER.PAS ВЕРСИЯ ОТ 24.09.06 +MAPWRITER.PAS ÂÅÐÑÈß ÎÒ 24.09.06 -Поддержка карт версии 1 +Ïîääåðæêà êàðò âåðñèè 1 ----------------------------------- } @@ -99,19 +99,19 @@ begin c := 3; Ver := HandledVersion(); - CopyMemory(Pointer(LongWord(Data)+c), @Ver, 1); + CopyMemory(Pointer(PtrUInt(Data)+c), @Ver, 1); c := c+1; if FDataBlocks <> nil then for a := 0 to High(FDataBlocks) do begin - CopyMemory(Pointer(LongWord(Data)+c), @FDataBlocks[a].Block, SizeOf(TBlock)); + CopyMemory(Pointer(PtrUInt(Data)+c), @FDataBlocks[a].Block, SizeOf(TBlock)); c := c+SizeOf(TBlock); - CopyMemory(Pointer(LongWord(Data)+c), FDataBlocks[a].Data, FDataBlocks[a].Block.BlockSize); + CopyMemory(Pointer(PtrUInt(Data)+c), FDataBlocks[a].Data, FDataBlocks[a].Block.BlockSize); c := c+FDataBlocks[a].Block.BlockSize; end; - ZeroMemory(Pointer(LongWord(Data)+c), SizeOf(TBlock)); + ZeroMemory(Pointer(PtrUInt(Data)+c), SizeOf(TBlock)); end; function TMapWriter.HandledVersion(): Byte; @@ -144,7 +144,7 @@ begin Data := GetMemory(Block.BlockSize); for a := 0 to High(Areas) do - CopyMemory(Pointer(LongWord(Data)+a*Size), @Areas[a], size); + CopyMemory(Pointer(PtrUInt(Data)+a*Size), @Areas[a], size); end; Result := True; @@ -173,7 +173,7 @@ begin Data := GetMemory(Block.BlockSize); for a := 0 to High(Items) do - CopyMemory(Pointer(LongWord(Data)+a*size), @Items[a], size); + CopyMemory(Pointer(PtrUInt(Data)+a*size), @Items[a], size); end; Result := True; @@ -202,7 +202,7 @@ begin Data := GetMemory(Block.BlockSize); for a := 0 to High(Monsters) do - CopyMemory(Pointer(LongWord(Data)+a*Size), @Monsters[a], size); + CopyMemory(Pointer(PtrUInt(Data)+a*Size), @Monsters[a], size); end; Result := True; @@ -231,7 +231,7 @@ begin Data := GetMemory(Block.BlockSize); for a := 0 to High(Panels) do - CopyMemory(Pointer(LongWord(Data)+a*size), @Panels[a], size); + CopyMemory(Pointer(PtrUInt(Data)+a*size), @Panels[a], size); end; Result := True; @@ -260,7 +260,7 @@ begin Data := GetMemory(Block.BlockSize); for a := 0 to High(Textures) do - CopyMemory(Pointer(LongWord(Data)+a*size), @Textures[a], size); + CopyMemory(Pointer(PtrUInt(Data)+a*size), @Textures[a], size); end; Result := True; @@ -289,7 +289,7 @@ begin Data := GetMemory(Block.BlockSize); for a := 0 to High(Triggers) do - CopyMemory(Pointer(LongWord(Data)+a*size), @Triggers[a], size); + CopyMemory(Pointer(PtrUInt(Data)+a*size), @Triggers[a], size); end; Result := True; @@ -311,7 +311,7 @@ begin Data := GetMemory(Block.BlockSize); - CopyMemory(Pointer(LongWord(Data)), @MapHeader, size); + CopyMemory(Pointer(PtrUInt(Data)), @MapHeader, size); end; Result := True; diff --git a/src/shared/WADEDITOR.pas b/src/shared/WADEDITOR.pas index 2611009..e68fd21 100644 --- a/src/shared/WADEDITOR.pas +++ b/src/shared/WADEDITOR.pas @@ -75,7 +75,7 @@ const implementation uses - SysUtils, BinEditor, ZLib, utils; + SysUtils, BinEditor, ZLib, utils, e_log; const DFWAD_OPENED_NONE = 0; @@ -122,6 +122,41 @@ begin end; end; +procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; + out OutBuf: Pointer; out OutBytes: Integer); +var + strm: TZStreamRec; + P: Pointer; +begin + FillChar(strm, sizeof(strm), 0); + OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; + GetMem(OutBuf, OutBytes); + try + strm.next_in := InBuf; + strm.avail_in := InBytes; + strm.next_out := OutBuf; + strm.avail_out := OutBytes; + deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)); + try + while deflate(strm, Z_FINISH) <> Z_STREAM_END do + begin + P := OutBuf; + Inc(OutBytes, 256); + ReallocMem(OutBuf, OutBytes); + strm.next_out := PByteF(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); + strm.avail_out := 256; + end; + finally + deflateEnd(strm); + end; + ReallocMem(OutBuf, strm.total_out); + OutBytes := strm.total_out; + except + FreeMem(OutBuf); + raise + end; +end; + procedure g_ProcessResourceStr(ResourceStr: String; var FileName, SectionName, ResourceName: String); var @@ -220,8 +255,9 @@ begin ResCompressed := nil; ResCompressedSize := 0; - Compress(Data, @Len, ResCompressed, ResCompressedSize); + CompressBuf(Data, Len, ResCompressed, ResCompressedSize); if ResCompressed = nil then Exit; + e_WriteLog('Fuck me (D)', MSG_NOTIFY); if FResData = nil then FResData := AllocMem(ResCompressedSize) else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize)); @@ -316,7 +352,7 @@ begin ResCompressed := nil; ResCompressedSize := 0; - Compress(TempResource, @OriginalSize, ResCompressed, ResCompressedSize); + CompressBuf(TempResource, OriginalSize, ResCompressed, ResCompressedSize); FreeMemory(TempResource); if ResCompressed = nil then Exit; @@ -600,8 +636,8 @@ begin else begin TempData := GetMemory(FResTable[i].Length); - CopyMemory(TempData, Pointer(LongWord(FResData)+FResTable[i].Address+6+ - LongWord(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))), + CopyMemory(TempData, Pointer(PtrUInt(FResData)+FResTable[i].Address+6+ + PtrUInt(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))), FResTable[i].Length); DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes); FreeMem(TempData); @@ -761,19 +797,19 @@ begin Exit; end; - CopyMemory(@FVersion, Pointer(LongWord(Data)+5), 1); + CopyMemory(@FVersion, Pointer(PtrUInt(Data)+5), 1); if FVersion <> DFWAD_VERSION then begin FLastError := DFWAD_ERROR_WRONGVERSION; Exit; end; - CopyMemory(@FHeader, Pointer(LongWord(Data)+6), SizeOf(TWADHeaderRec_1)); + CopyMemory(@FHeader, Pointer(PtrUInt(Data)+6), SizeOf(TWADHeaderRec_1)); SetLength(FResTable, FHeader.RecordsCount); if FResTable <> nil then begin - CopyMemory(@FResTable[0], Pointer(LongWord(Data)+6+SizeOf(TWADHeaderRec_1)), + CopyMemory(@FResTable[0], Pointer(PtrUInt(Data)+6+SizeOf(TWADHeaderRec_1)), SizeOf(TResourceTableRec_1)*FHeader.RecordsCount); for a := 0 to High(FResTable) do @@ -799,6 +835,8 @@ var begin if FResTable = nil then Exit; + e_WriteLog('Fuck me (B) ' + Section + ' ' + Resource, MSG_NOTIFY); + i := -1; b := 0; c := 0; @@ -824,6 +862,8 @@ begin if i = -1 then Exit; + e_WriteLog('Fuck me (C) ' + Section + ' ' + Resource, MSG_NOTIFY); + for a := i to High(FResTable)-1 do FResTable[a] := FResTable[a+1]; @@ -837,7 +877,7 @@ begin d := d+FResTable[a].Length; end; - CopyMemory(Pointer(LongWord(FResData)+c), Pointer(LongWord(FResData)+c+b), d); + CopyMemory(Pointer(PtrUInt(FResData)+c), Pointer(PtrUInt(FResData)+c+b), d); FDataSize := FDataSize-b; FOffset := FOffset-b; diff --git a/src/shared/a_modes.inc b/src/shared/a_modes.inc new file mode 100644 index 0000000..3290b02 --- /dev/null +++ b/src/shared/a_modes.inc @@ -0,0 +1,17 @@ +{$MODE DELPHI} + +{$INLINE ON} + +{$WARNINGS ON} +{$NOTES ON} + +{$IFDEF MSWINDOWS} + {$IFNDEF WINDOWS} + {$DEFINE WINDOWS} + {$ENDIF WINDOWS} +{$ENDIF MSWINDOWS} + +{$IF DEFINED(CPU64) OR NOT DEFINED(WINDOWS)} + {$DEFINE NOSOUND} +{$ENDIF} + diff --git a/src/shared/utils.pas b/src/shared/utils.pas index 9bb12ec..04780bb 100644 --- a/src/shared/utils.pas +++ b/src/shared/utils.pas @@ -13,7 +13,7 @@ * You should have received a copy of the GNU General Public License * along with this program. If not, see . *) -{$MODE DELPHI} +{$INCLUDE a_modes.inc} unit utils; interface @@ -22,6 +22,36 @@ uses SysUtils, Classes; +// ////////////////////////////////////////////////////////////////////////// // +type + TUtf8DecoderFast = packed record + public + const Replacement = $FFFD; // replacement char for invalid unicode + const Accept = 0; + const Reject = 12; + + private + state: LongWord; + + public + codepoint: LongWord; // decoded codepoint (valid only when decoder is in "complete" state) + + public + constructor Create (v: Boolean{fuck you, fpc}); + + procedure reset (); inline; + + function complete (): Boolean; inline; // is current character complete? take `codepoint` then + function invalid (): Boolean; inline; + function completeOrInvalid (): Boolean; inline; + + // process one byte, return `true` if codepoint is ready + function decode (b: Byte): Boolean; inline; overload; + function decode (c: AnsiChar): Boolean; inline; overload; + end; + + +// ////////////////////////////////////////////////////////////////////////// // // does filename have one of ".wad", ".pk3", ".zip" extensions? function hasWadExtension (fn: AnsiString): Boolean; @@ -48,9 +78,7 @@ function utf8to1251 (s: AnsiString): AnsiString; // `lastIsDir` should be `true` if we are searching for directory // nobody cares about shitdoze, so i'll use the same code path for it function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean; - -// returns name (the same if no file found) -function findFileCIStr (pathname: AnsiString; lastIsDir: Boolean=false): AnsiString; +function findFileCIStr (pathname: AnsiString): AnsiString; // they throws function openDiskFileRO (pathname: AnsiString): TStream; @@ -95,9 +123,283 @@ function readInt64BE (st: TStream): Int64; function readUInt64BE (st: TStream): UInt64; +type + TFormatStrFCallback = procedure (constref buf; len: SizeUInt); + +function wchar2win (wc: WideChar): AnsiChar; inline; +function utf2win (const s: AnsiString): AnsiString; +function win2utf (const s: AnsiString): AnsiString; +function digitInBase (ch: AnsiChar; base: Integer): Integer; + +// returns string in single or double quotes +// single quotes supports only pascal-style '' for single quote char +// double quotes supports c-style escapes +// function will select quote mode automatically +function quoteStr (const s: AnsiString): AnsiString; + + +// ////////////////////////////////////////////////////////////////////////// // +var + wc2shitmap: array[0..65535] of AnsiChar; + wc2shitmapInited: Boolean = false; + + +// ////////////////////////////////////////////////////////////////////////// // +const + cp1251: array[0..127] of Word = ( + $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, + $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F, + $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407, + $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457, + $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F, + $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F, + $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F, + $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F + ); + implementation +procedure initShitMap (); +var + f: Integer; +begin + for f := 0 to High(wc2shitmap) do wc2shitmap[f] := '?'; + for f := 0 to 127 do wc2shitmap[f] := AnsiChar(f); + for f := 0 to 127 do wc2shitmap[cp1251[f]] := AnsiChar(f+128); + wc2shitmapInited := true; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// fast state-machine based UTF-8 decoder; using 8 bytes of memory +// code points from invalid range will never be valid, this is the property of the state machine +const + // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ + utf8dfa: array[0..$16c-1] of Byte = ( + // maps bytes to character classes + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 00-0f + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 10-1f + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 20-2f + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 30-3f + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 40-4f + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 50-5f + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 60-6f + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 70-7f + $01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01, // 80-8f + $09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09, // 90-9f + $07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07, // a0-af + $07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07, // b0-bf + $08,$08,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02, // c0-cf + $02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02, // d0-df + $0a,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$04,$03,$03, // e0-ef + $0b,$06,$06,$06,$05,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08, // f0-ff + // maps a combination of a state of the automaton and a character class to a state + $00,$0c,$18,$24,$3c,$60,$54,$0c,$0c,$0c,$30,$48,$0c,$0c,$0c,$0c, // 100-10f + $0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$00,$0c,$0c,$0c,$0c,$0c,$00, // 110-11f + $0c,$00,$0c,$0c,$0c,$18,$0c,$0c,$0c,$0c,$0c,$18,$0c,$18,$0c,$0c, // 120-12f + $0c,$0c,$0c,$0c,$0c,$0c,$0c,$18,$0c,$0c,$0c,$0c,$0c,$18,$0c,$0c, // 130-13f + $0c,$0c,$0c,$0c,$0c,$18,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$24, // 140-14f + $0c,$24,$0c,$0c,$0c,$24,$0c,$0c,$0c,$0c,$0c,$24,$0c,$24,$0c,$0c, // 150-15f + $0c,$24,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c); + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end; + +procedure TUtf8DecoderFast.reset (); inline; begin state := Accept; codepoint := 0; end; + +function TUtf8DecoderFast.complete (): Boolean; inline; begin result := (state = Accept); end; +function TUtf8DecoderFast.invalid (): Boolean; inline; begin result := (state = Reject); end; +function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end; + +function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end; + +function TUtf8DecoderFast.decode (b: Byte): Boolean; inline; overload; +var + tp: LongWord; +begin + if (state = Reject) then begin state := Accept; codepoint := 0; end; + tp := utf8dfa[b]; + if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b; + state := utf8dfa[256+state+tp]; + if (state = Reject) then begin codepoint := Replacement; state := Accept; end; + result := (state = Accept); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function wchar2win (wc: WideChar): AnsiChar; inline; +begin + if not wc2shitmapInited then initShitMap(); + if (LongWord(wc) > 65535) then result := '?' else result := wc2shitmap[LongWord(wc)]; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function utf2win (const s: AnsiString): AnsiString; +var + f, c: Integer; + ud: TUtf8DecoderFast; +begin + for f := 1 to Length(s) do + begin + if (Byte(s[f]) > 127) then + begin + ud := TUtf8DecoderFast.Create(true); + result := ''; + for c := 1 to Length(s) do + begin + if ud.decode(s[c]) then result += wchar2win(WideChar(ud.codepoint)); + end; + exit; + end; + end; + result := s; +end; + + +function win2utf (const s: AnsiString): AnsiString; +var + f, c: Integer; + + function utf8Encode (code: Integer): AnsiString; + begin + if (code < 0) or (code > $10FFFF) then begin result := '?'; exit; end; + if (code <= $7f) then + begin + result := Char(code and $ff); + end + else if (code <= $7FF) then + begin + result := Char($C0 or (code shr 6)); + result += Char($80 or (code and $3F)); + end + else if (code <= $FFFF) then + begin + result := Char($E0 or (code shr 12)); + result += Char($80 or ((code shr 6) and $3F)); + result += Char($80 or (code and $3F)); + end + else if (code <= $10FFFF) then + begin + result := Char($F0 or (code shr 18)); + result += Char($80 or ((code shr 12) and $3F)); + result += Char($80 or ((code shr 6) and $3F)); + result += Char($80 or (code and $3F)); + end + else + begin + result := '?'; + end; + end; + +begin + for f := 1 to Length(s) do + begin + if (Byte(s[f]) > 127) then + begin + result := ''; + for c := 1 to Length(s) do + begin + if (Byte(s[c]) < 128) then + begin + result += s[c]; + end + else + begin + result += utf8Encode(cp1251[Byte(s[c])-128]) + end; + end; + exit; + end; + end; + result := s; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function digitInBase (ch: AnsiChar; base: Integer): Integer; +begin + result := -1; + if (base < 1) or (base > 36) then exit; + if (ch < '0') then exit; + if (base <= 10) then + begin + if (Integer(ch) >= 48+base) then exit; + result := Integer(ch)-48; + end + else + begin + if (ch >= '0') and (ch <= '9') then begin result := Integer(ch)-48; exit; end; + if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32); // poor man's tolower() + if (ch < 'A') or (Integer(ch) >= 65+(base-10)) then exit; + result := Integer(ch)-65+10; + end; +end; + +// ////////////////////////////////////////////////////////////////////////// // +function quoteStr (const s: AnsiString): AnsiString; + + function squote (const s: AnsiString): AnsiString; + var + f: Integer; + begin + result := ''''; + for f := 1 to Length(s) do + begin + if (s[f] = '''') then result += ''''; + result += s[f]; + end; + result += ''''; + end; + + function dquote (const s: AnsiString): AnsiString; + var + f: Integer; + ch: AnsiChar; + begin + result := '"'; + for f := 1 to Length(s) do + begin + ch := s[f]; + if (ch = #0) then result += '\z' + else if (ch = #9) then result += '\t' + else if (ch = #10) then result += '\n' + else if (ch = #13) then result += '\r' + else if (ch = #27) then result += '\e' + else if (ch < ' ') or (ch = #127) then + begin + result += '\x'; + result += LowerCase(IntToHex(Integer(ch), 2)); + end + else if (ch = '"') or (ch = '\') then + begin + result += '\'; + result += ch; + end + else + begin + result += ch; + end; + end; + result += '"'; + end; + +var + needSingle: Boolean = false; + f: Integer; +begin + for f := 1 to Length(s) do + begin + if (s[f] = '''') then begin needSingle := true; continue; end; + if (s[f] < ' ') or (s[f] = #127) then begin result := dquote(s); exit; end; + end; + if needSingle then result := squote(s) else result := ''''+s+''''; +end; + + +// ////////////////////////////////////////////////////////////////////////// // function hasWadExtension (fn: AnsiString): Boolean; begin fn := ExtractFileExt(fn); @@ -357,7 +659,7 @@ begin // remove trailing slashes again while (length(npt) > 0) and ((npt[1] = '/') or (npt[1] = '\')) do Delete(npt, 1, 1); wantdir := lastIsDir or (length(npt) > 0); // do we want directory here? - writeln(Format('0: npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)])); + //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)])); // try the easiest case first attr := FileGetAttr(newname+curname); if attr <> -1 then @@ -365,13 +667,12 @@ begin if wantdir = ((attr and faDirectory) <> 0) then begin // i found her! - writeln(Format('3: npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d; found=tan', [npt, newname, curname, Integer(wantdir)])); newname := newname+curname; if wantdir then newname := newname+'/'; continue; end; end; - writeln(Format('1: npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)])); + //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)])); // alas, either not found, or invalid attributes foundher := false; try @@ -389,28 +690,15 @@ begin finally FindClose(sr); end; - if (foundher) then - begin - writeln(Format('2: npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d; found=tan', [npt, newname, curname, Integer(wantdir)])); - end - else - begin - writeln(Format('2: npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d; found=ona', [npt, newname, curname, Integer(wantdir)])); - end; if not foundher then begin newname := ''; result := false; break; end; end; - writeln(Format('4: npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d; found=ona', [npt, newname, curname, Integer(wantdir)])); if result then pathname := newname; end; -function findFileCIStr (pathname: AnsiString; lastIsDir: Boolean=false): AnsiString; -var - s: AnsiString; +function findFileCIStr (pathname: AnsiString): AnsiString; begin - s := pathname; - if not findFileCI(s, lastIsDir) then s := pathname; - writeln(Format('***: pathname=[%s]; s=[%s]', [pathname, s])); - result := s; + result := pathname; + findFileCI(result); end; function openDiskFileRO (pathname: AnsiString): TStream; @@ -545,5 +833,5 @@ function readLongIntBE (st: TStream): LongInt; begin readIntegerBE(st, @result, function readInt64BE (st: TStream): Int64; begin readIntegerBE(st, @result, 8); end; function readUInt64BE (st: TStream): UInt64; begin readIntegerBE(st, @result, 8); end; - end. +