summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 2123863)
raw | patch | inline | side by side (parent: 2123863)
| author | fgsfds <pvt.fgsfds@gmail.com> | |
| Wed, 30 Aug 2017 02:52:09 +0000 (05:52 +0300) | ||
| committer | fgsfds <pvt.fgsfds@gmail.com> | |
| Wed, 30 Aug 2017 02:52:09 +0000 (05:52 +0300) |
41 files changed:
diff --git a/src/editor/Editor.lpi b/src/editor/Editor.lpi
index 6125b9787042dc1de1aed5da40e45011bca91477..db37c8d06e5115bd07790abff8a677f26fea8dbb 100644 (file)
--- a/src/editor/Editor.lpi
+++ b/src/editor/Editor.lpi
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
- <Version Value="9"/>
+ <Version Value="10"/>
<General>
<Flags>
- <MainUnitHasUsesSectionForAllUnits Value="False"/>
- <MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
+ <SharedMatrixOptions Count="1">
+ <Item1 ID="104550030988" Targets="" Modes="Default"/>
+ </SharedMatrixOptions>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</SyntaxOptions>
</Parsing>
<Linking>
- <Debugging>
- <GenerateDebugInfo Value="False"/>
- </Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
- <Other>
- <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
- </Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
diff --git a/src/editor/Editor.lpr b/src/editor/Editor.lpr
index 647bfae8129308cbab1781174315cc8acacfec16..71f5906bf6784736fa889e0cb245e44726b9d4a2 100644 (file)
--- a/src/editor/Editor.lpr
+++ b/src/editor/Editor.lpr
program Editor;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
uses
Forms, Interfaces,
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 3fdd29e693a8163c87fde0b8c3ecb0f6e1a00790..d073f586809aa77273df975b962e3d25746e6ced 100644 (file)
--- a/src/editor/f_about.pas
+++ b/src/editor/f_about.pas
unit f_about;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index 8d9a873a5e8ee5d3acb662e97b2799e80f2431ca..aee0c30fb1d8580b3fc708373154293c52f7c252 100644 (file)
unit f_activationtype;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index 60fd18f3e452366f8c8fed8d66a2a4835eba845f..514cf5cdfa6e42c8f6ed9f3d535425d79801da33 100644 (file)
unit f_addresource;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
implementation
uses
- f_main, WADSTRUCT, g_language;
+ f_main, WADSTRUCT, g_language, utils;
{$R *.lfm}
// Внешний 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);
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;
// Внешний 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);
WAD.ReadFile(FileName);
if cbSectionsList.Text <> '..' then
- SectionName := cbSectionsList.Text
+ SectionName := utf2win(cbSectionsList.Text)
else
SectionName := '';
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);
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
index fb5bd5f1946d4528c06b58a64ddf7296069a4377..2f2c25f84aa6743ef5a916a9f440cc26a7e8dcb5 100644 (file)
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)
{$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
SectionName := '..';
// WAD файл:
- a := cbWADList.Items.IndexOf(FileName);
+ a := cbWADList.Items.IndexOf(win2utf(FileName));
if a <> -1 then
begin
cbWADList.ItemIndex := a;
end;
// Секция:
- a := cbSectionsList.Items.IndexOf(SectionName);
+ a := cbSectionsList.Items.IndexOf(win2utf(SectionName));
if a <> -1 then
begin
cbSectionsList.ItemIndex := a;
end;
// Ресурс:
- a := lbResourcesList.Items.IndexOf(ResourceName);
+ a := lbResourcesList.Items.IndexOf(win2utf(ResourceName));
if a <> -1 then
begin
lbResourcesList.ItemIndex := a;
index 2dfc49d720e0e7c8505a828866e0fc40f83c9c66..55508f0b724985ba0f52b0527e7fe51a81685d1d 100644 (file)
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)
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;
res := FMOD_OK;
+{$IFNDEF NOSOUND}
try
res := FMOD_System_Create(F_System);
if res <> FMOD_OK then
Application.MessageBox(FMOD_ErrorString(res), 'Initialization', MB_OK or MB_ICONHAND);
raise;
end;
+{$ENDIF}
FSpectrum := TMiniSpectrum.Create(pSpectrum);
FSpectrum.Align := alClient;
begin
Result := False;
-
SoundData := nil;
Sound := nil;
Channel := nil;
-
+{$IFNDEF NOSOUND}
g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
WAD := TWADEditor_1.Create;
WAD.Free();
Result := True;
+{$ENDIF}
end;
procedure TAddSoundForm.bbPlayClick(Sender: TObject);
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
FMOD_Channel_SetVolume(Channel, 1.0);
FSpectrum.SetChannel(Channel);
+{$ENDIF}
end;
end;
begin
Inherited;
-
+{$IFNDEF NOSOUND}
FMOD_System_Update(F_System);
ShowSpectrum();
res := FMOD_Channel_IsPlaying(Channel, b);
if (res <> FMOD_OK) or (not b) then
bbStop.Click();
+{$ENDIF}
end;
procedure TAddSoundForm.FormDestroy(Sender: TObject);
Inherited;
FSpectrum.Free;
-
+{$IFNDEF NOSOUND}
res := FMOD_System_Close(F_System);
if res <> FMOD_OK then
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);
SectionName := '..';
// WAD файл:
- a := cbWADList.Items.IndexOf(FileName);
+ a := cbWADList.Items.IndexOf(win2utf(FileName));
if a <> -1 then
begin
cbWADList.ItemIndex := a;
end;
// Секция:
- a := cbSectionsList.Items.IndexOf(SectionName);
+ a := cbSectionsList.Items.IndexOf(win2utf(SectionName));
if a <> -1 then
begin
cbSectionsList.ItemIndex := a;
end;
// Ресурс:
- a := lbResourcesList.Items.IndexOf(ResourceName);
+ a := lbResourcesList.Items.IndexOf(win2utf(ResourceName));
if a <> -1 then
begin
lbResourcesList.ItemIndex := a;
index ce9a073d40b5e6fafddff15b492908cfb9b0f213..195b22d52ead5396cb72fba75ef7e3dc2b56ebc4 100644 (file)
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)
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;
index 98e8cc7c8b0e04d4eeaf6731702a801ea931abed..291819bf8637afafd7922f1ed3c6768b6ee4ad7a 100644 (file)
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 dd71caa2473f00a531f33ef44cf52a9d0869e414..576b573742aa5bc070efc73a5325aaeb09ec6c70 100644 (file)
--- a/src/editor/f_keys.pas
+++ b/src/editor/f_keys.pas
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 9a976f65c8ec3d453ad6af3a3b1258005105ddc2..d429811c6222c2066fb0ab2a8f4acde2e9aa11ce 100644 (file)
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
unit f_main;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
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
ok: Boolean;
FileName: String;
ResourceName: String;
+ UResourceName: String;
FullResourceName: String;
SectionName: String;
Data: Pointer;
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;
begin
if not silent then
ErrorMessageBox(Format(_lc[I_MSG_RES_NAME_64],
- [ResourceName]));
+ [UResourceName]));
ok := False;
end;
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;
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);
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;
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;
OpenedMap := '';
OpenedWAD := '';
- config := TConfig.CreateFile(EditorDir+'/Editor.cfg');
+ config := TConfig.CreateFile(EditorDir+'Editor.cfg');
if config.ReadBool('Editor', 'Maximize', False) then
WindowState := wsMaximized;
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);
config.WriteStr('RecentFiles', IntToStr(i+1), '');
RecentFiles.Free();
- config.SaveFile(EditorDir+'/Editor.cfg');
+ config.SaveFile(EditorDir+'Editor.cfg');
config.Free();
slInvalidTextures.Free;
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;
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;
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
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;
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;
index 0bd323dca8f60b03dbd1c85ece56262e85a1be13..bcb8ecf9cdfba7c230262dcdcbf7de771e6c30bc 100644 (file)
unit f_mapcheck;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index 56eb889402ed087291951f9f6398828488d02dd4..e7aad24b53f9c31dd9a4d1f5b54eeea616eae1ee 100644 (file)
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)
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;
// Нашли неиспользуемую текстуру:
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
index a194fa929071a597c29b9eaafa08e8baba658f6c..9d3a20ce1e6b619ffa359802745d2d5068a584bd 100644 (file)
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)
// 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;
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);
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;
begin
AddSkyForm.OKFunction := SetSky;
AddSkyForm.lbResourcesList.MultiSelect := False;
- AddSkyForm.SetResource := eBack.Text;
+ AddSkyForm.SetResource := utf2win(eBack.Text);
AddSkyForm.ShowModal();
end;
begin
AddSoundForm.OKFunction := SetMusic;
AddSoundForm.lbResourcesList.MultiSelect := False;
- AddSoundForm.SetResource := eMusic.Text;
+ AddSoundForm.SetResource := utf2win(eMusic.Text);
AddSoundForm.ShowModal();
end;
index 470da17acbf478c2ca206869204cc607b0b3a779..69f7f40f0568c338ddfee771a442719314fac0e8 100644 (file)
--- a/src/editor/f_maptest.pas
+++ b/src/editor/f_maptest.pas
unit f_maptest;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
n: Integer;
begin
- config := TConfig.CreateFile(EditorDir+'/Editor.cfg');
+ config := TConfig.CreateFile(EditorDir+'Editor.cfg');
if rbTDM.Checked then
s := 'TDM'
config.WriteStr('TestRun', 'Exe', edD2dExe.Text);
TestD2dExe := edD2dExe.Text;
- config.SaveFile(EditorDir+'/Editor.cfg');
+ config.SaveFile(EditorDir+'Editor.cfg');
config.Free();
Close();
end;
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');
index 99be37674802e7264d71763af56ebcaee5ec2093..28debba765666f781e334d94807db7cdd40e0cdd 100644 (file)
--- a/src/editor/f_options.pas
+++ b/src/editor/f_options.pas
unit f_options;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
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);
MainForm.RefreshRecentMenu();
end;
- config.SaveFile(EditorDir+'/Editor.cfg');
+ config.SaveFile(EditorDir+'Editor.cfg');
config.Free();
Close();
end;
index c9e093e88197ff6c0929feb88dba9c996199d9dc..0999e54c3758e074d1d3901ad5d0ea6153b205b7 100644 (file)
--- a/src/editor/f_packmap.pas
+++ b/src/editor/f_packmap.pas
unit f_packmap;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index fde781fdd7c483fa68bc99e1ca71fd9c259f52fb..f89ee7366f2a7105e6502bc93f37ecb91463a608 100644 (file)
--- a/src/editor/f_savemap.pas
+++ b/src/editor/f_savemap.pas
unit f_savemap;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index a314ac78be440da17f7bf6273b279de2636b3604..07b6850f4a28622a3b9c544dbdafef77b85fe192 100644 (file)
unit f_saveminimap;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index eac54dac33798428a86fd23d0690596fb0d57170..bfb9998be520a25d1cafb099856f20171368114e 100644 (file)
unit f_selectlang;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index afa6a3eba7058b36db59176811c9283e1b747020..a83e3e03b140d0c76fcdbc0dcb8d9a628fa9d03b 100644 (file)
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 1433fecfff51dcb23fe4f70c2006d61858600aa9..e7d3a71f0f099a35e7f1a89f20b55a0ef7f04a3b 100644 (file)
--- a/src/editor/g_basic.pas
+++ b/src/editor/g_basic.pas
unit g_basic;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index 405798e96f12086e981d26355fa78f9ad2a4fcde..456ab9b63d3aa1d73c1d4e03af0e33c8908b4d20 100644 (file)
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 b5bf888b52d165709e3444652fae2af64a21b345..237c247b58e1c6ca14acaf0307c28803eae5e736 100644 (file)
--- a/src/editor/g_map.pas
+++ b/src/editor/g_map.pas
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
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
// Записываем в WAD, если надо:
if Res <> '' then
begin
+ e_WriteLog('Fuck me (A) ' + ResName, MSG_NOTIFY);
WAD.RemoveResource('', ResName);
WAD.AddResource(Data, Len, ResName, '');
WAD.SaveTo(FileName);
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;
var
map: TConfig;
i, a: Integer;
- s, section: String;
+ s, us, section: String;
panel: TPanel;
item: TItem;
area: TArea;
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;
// Чтение панелей:
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;
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;
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();
index 7c130136b8a53f6a035b92cfac6dcdba877465d8..0ef0a81e0dae27a743e1469443b63cad4d351650 100644 (file)
unit g_textures;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
index d0ef0988249af1f5bdef822e3b2fdba8adb1c557..fcedd73783a9c850afc8794bd5d1a351ed40ae94 100644 (file)
--- a/src/editor/spectrum.pas
+++ b/src/editor/spectrum.pas
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);
{$R-}
FBuffer.Canvas.Brush.Color := Color;
FBuffer.Canvas.FillRect(BoundsRect);
-
+{$IFNDEF NOSOUND}
if Enabled then
begin
if FChannel <> nil then
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
+++ /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.
index 63a9e5bc113c6569f0cda0a65bcf5bc5d63c9bd6..47bf1107eff8781417c7e2f583f11e2201d525ce 100644 (file)
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
-{$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
--- 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 b2b9826f6669febb04b3f7e5dfc7b19bb5a24bad..2cabc36c176ec27ed5618a1d5d24fe0dab658273 100644 (file)
--- a/src/engine/e_log.pas
+++ b/src/engine/e_log.pas
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
--- 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.
index e6246bcc0f833de66dd39080ce5893b272d2f8ad..52a1e9213d77d85ee12d94f93410fd4f13fbe0af 100644 (file)
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
-{$MODE DELPHI}
+{$INCLUDE ../shared/a_modes.inc}
unit e_textures;
{ This unit provides interface to load 24-bit and 32-bit uncompressed images
index 43fa78fd1f548f0f664b517a84a14979ebea6494..9c5f21df650b2772b77eb7f4f557d3bec4c483c8 100644 (file)
--- a/src/shared/BinEditor.pas
+++ b/src/shared/BinEditor.pas
if (FPosition + varSize) > FSize then
ExtendMemory(varSize);
- CopyMemory(Pointer(Cardinal(FData) + FPosition),
+ CopyMemory(Pointer(PtrUInt(FData) + FPosition),
@x, varSize);
FPosition := FPosition + varSize;
end;
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;
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;
if aLen > 0 then
begin
- FillMemory(Pointer(Cardinal(FData) + FPosition),
+ FillMemory(Pointer(PtrUInt(FData) + FPosition),
aLen, aFillSym);
FPosition := FPosition + aLen;
end;
if (FPosition + varSize) <= FSize then
begin
CopyMemory(@x,
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
varSize);
FPosition := FPosition + varSize;
end
begin
// Äëèíà ñòðîêè:
CopyMemory(@len,
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
SizeOf(Byte));
if (FPosition + SizeOf(Byte) + len) <= FSize then
if len > 0 then
begin
CopyMemory(@x[1],
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
len);
FPosition := FPosition + len;
end
begin
// Äëèíà áëîêà ïàìÿòè:
CopyMemory(@memSize,
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
SizeOf(Cardinal));
if (FPosition + SizeOf(Cardinal) + memSize) <= FSize then
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 19c7d018291a921dd726c916e3fd9a3c65b5ca92..bcabf1745acc5760a0375285f42ebfcb70ec1ac2 100644 (file)
--- a/src/shared/CONFIG.pas
+++ b/src/shared/CONFIG.pas
unit CONFIG;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
{
-----------------------------------
diff --git a/src/shared/MAPDEF.pas b/src/shared/MAPDEF.pas
index fd0d58b9520601cfc62da436d36037f79d0efcd8..2cb45aa51f34629e50e69b5689e232069a9be8a4 100644 (file)
--- a/src/shared/MAPDEF.pas
+++ b/src/shared/MAPDEF.pas
unit MAPDEF;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
{
-----------------------------------
index 736123eb0a64fee25bf53ed07a04a2b7fff98f91..40a1fc0d42802275040c16b726ad481d853f3df1 100644 (file)
--- a/src/shared/MAPREADER.pas
+++ b/src/shared/MAPREADER.pas
unit MAPREADER;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
{
-----------------------------------
-MAPREADER.PAS ВЕРСИЯ ОТ 13.11.07
+MAPREADER.PAS ÂÅÐÑÈß ÎÒ 13.11.07
-Поддержка карт версии 1
+Ïîääåðæêà êàðò âåðñèè 1
-----------------------------------
}
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
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
end;
end;
-// Не перевести в число:
+// Íå ïåðåâåñòè â ÷èñëî:
if not TryStrToInt(name, NNF_FirstNum) then
Exit;
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;
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;
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;
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;
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;
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;
end;
adr := 3;
- CopyMemory(@Ver, Pointer(LongWord(Data)+adr), 1);
+ CopyMemory(@Ver, Pointer(PtrUInt(Data)+adr), 1);
FVersion := Ver;
if Ver > HandledVersion() then
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;
index 0456cf783f48b17d7d7d88ab63cf8d74cfa132e7..18cb8edc2536897d922ce4afdf96f075d68b4dd5 100644 (file)
--- a/src/shared/MAPSTRUCT.pas
+++ b/src/shared/MAPSTRUCT.pas
unit MAPSTRUCT;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
{
-----------------------------------
index 0759931c7ec65ec04fdbaa256884a805db269699..4c7a6379b179c4c1bbe008e28d45c10eaa45dad2 100644 (file)
--- a/src/shared/MAPWRITER.pas
+++ b/src/shared/MAPWRITER.pas
unit MAPWRITER;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
{
-----------------------------------
-MAPWRITER.PAS ВЕРСИЯ ОТ 24.09.06
+MAPWRITER.PAS ÂÅÐÑÈß ÎÒ 24.09.06
-Поддержка карт версии 1
+Ïîääåðæêà êàðò âåðñèè 1
-----------------------------------
}
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;
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;
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;
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;
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;
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;
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;
Data := GetMemory(Block.BlockSize);
- CopyMemory(Pointer(LongWord(Data)), @MapHeader, size);
+ CopyMemory(Pointer(PtrUInt(Data)), @MapHeader, size);
end;
Result := True;
index 26110093c33f149d023741811db89865be5183c5..e68fd21bcdee1c7d63ced3b086fb58abf80cd09d 100644 (file)
--- a/src/shared/WADEDITOR.pas
+++ b/src/shared/WADEDITOR.pas
implementation
uses
- SysUtils, BinEditor, ZLib, utils;
+ SysUtils, BinEditor, ZLib, utils, e_log;
const
DFWAD_OPENED_NONE = 0;
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
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));
ResCompressed := nil;
ResCompressedSize := 0;
- Compress(TempResource, @OriginalSize, ResCompressed, ResCompressedSize);
+ CompressBuf(TempResource, OriginalSize, ResCompressed, ResCompressedSize);
FreeMemory(TempResource);
if ResCompressed = nil then Exit;
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);
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
begin
if FResTable = nil then Exit;
+ e_WriteLog('Fuck me (B) ' + Section + ' ' + Resource, MSG_NOTIFY);
+
i := -1;
b := 0;
c := 0;
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];
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
--- /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 9bb12ec632dab6bb18c979f50d589c86de54558c..04780bb6eae7a0ee216ab2465c71ec19d6d8b234 100644 (file)
--- a/src/shared/utils.pas
+++ b/src/shared/utils.pas
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
-{$MODE DELPHI}
+{$INCLUDE a_modes.inc}
unit utils;
interface
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;
// `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;
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);
// 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
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
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;
function readInt64BE (st: TStream): Int64; begin readIntegerBE(st, @result, 8); end;
function readUInt64BE (st: TStream): UInt64; begin readIntegerBE(st, @result, 8); end;
-
end.
+