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>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
- <Version Value="9"/>
+ <Version Value="10"/>
<General>
<Flags>
<General>
<Flags>
- <MainUnitHasUsesSectionForAllUnits Value="False"/>
- <MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
+ <SharedMatrixOptions Count="1">
+ <Item1 ID="104550030988" Targets="" Modes="Default"/>
+ </SharedMatrixOptions>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</SyntaxOptions>
</Parsing>
<Linking>
</SyntaxOptions>
</Parsing>
<Linking>
- <Debugging>
- <GenerateDebugInfo Value="False"/>
- </Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
- <Other>
- <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
- </Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
</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;
program Editor;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
uses
Forms, Interfaces,
uses
Forms, Interfaces,
f_packmap in 'f_packmap.pas' {PackMapForm},
f_maptest in 'f_maptest.pas' {MapTestForm},
f_choosetype in 'f_choosetype.pas' {ChooseTypeForm},
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,
fmod,
fmoderrors,
fmodpresets,
fmodtypes,
+{$ENDIF}
ImagingTypes,
Imaging,
ImagingUtility,
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;
unit f_about;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index 8d9a873a5e8ee5d3acb662e97b2799e80f2431ca..aee0c30fb1d8580b3fc708373154293c52f7c252 100644 (file)
unit f_activationtype;
unit f_activationtype;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index 60fd18f3e452366f8c8fed8d66a2a4835eba845f..514cf5cdfa6e42c8f6ed9f3d535425d79801da33 100644 (file)
unit f_addresource;
unit f_addresource;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
implementation
uses
implementation
uses
- f_main, WADSTRUCT, g_language;
+ f_main, WADSTRUCT, g_language, utils;
{$R *.lfm}
{$R *.lfm}
// Внешний WAD:
if cbWADList.Text <> _lc[I_WAD_SPECIAL_MAP] then
// Внешний 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);
else // WAD карты:
begin
g_ProcessResourceStr(OpenedMap, fn, sn, rn);
if SectionList <> nil then
for i := 0 to High(SectionList) do
if SectionList[i] <> '' then
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;
else
cbSectionsList.Items.Add('..');
end;
// Внешний WAD:
if cbWADList.Text <> _lc[I_WAD_SPECIAL_MAP] then
// Внешний 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);
else // WAD карты:
begin
g_ProcessResourceStr(OpenedMap, fn, sn, rn);
WAD.ReadFile(FileName);
if cbSectionsList.Text <> '..' then
WAD.ReadFile(FileName);
if cbSectionsList.Text <> '..' then
- SectionName := cbSectionsList.Text
+ SectionName := utf2win(cbSectionsList.Text)
else
SectionName := '';
else
SectionName := '';
if ResourceList <> nil then
for i := 0 to High(ResourceList) do
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);
end;
procedure TAddResourceForm.lbResourcesListClick(Sender: TObject);
if cbSectionsList.Text = '..' then
SectionName := ''
else
if cbSectionsList.Text = '..' then
SectionName := ''
else
- SectionName := cbSectionsList.Text;
+ SectionName := utf2win(cbSectionsList.Text);
if cbWADList.Text[1] <> '<' then
if cbWADList.Text[1] <> '<' then
- FileName := cbWADList.Text
+ FileName := utf2win(cbWADList.Text)
else
FileName := '';
else
FileName := '';
- FResourceName := FileName+':'+SectionName+'\'+lbResourcesList.Items[lbResourcesList.ItemIndex];
+ FResourceName := FileName+':'+SectionName+'\'+utf2win(lbResourcesList.Items[lbResourcesList.ItemIndex]);
if FileName <> '' then
FFullResourceName := EditorDir+'wads/'+FResourceName
if FileName <> '' then
FFullResourceName := EditorDir+'wads/'+FResourceName
index fb5bd5f1946d4528c06b58a64ddf7296069a4377..2f2c25f84aa6743ef5a916a9f440cc26a7e8dcb5 100644 (file)
unit f_addresource_sky;
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,
interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, f_addresource,
- ExtCtrls, StdCtrls;
+ ExtCtrls, StdCtrls, utils;
type
TAddSkyForm = class (TAddResourceForm)
type
TAddSkyForm = class (TAddResourceForm)
{$R *.lfm}
{$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
function ShowTGATexture(ResourceStr: String): TBitMap;
var
TGAHeader: packed record // Header type for TGA images
SectionName := '..';
// WAD файл:
SectionName := '..';
// WAD файл:
- a := cbWADList.Items.IndexOf(FileName);
+ a := cbWADList.Items.IndexOf(win2utf(FileName));
if a <> -1 then
begin
cbWADList.ItemIndex := a;
if a <> -1 then
begin
cbWADList.ItemIndex := a;
end;
// Секция:
end;
// Секция:
- a := cbSectionsList.Items.IndexOf(SectionName);
+ a := cbSectionsList.Items.IndexOf(win2utf(SectionName));
if a <> -1 then
begin
cbSectionsList.ItemIndex := a;
if a <> -1 then
begin
cbSectionsList.ItemIndex := a;
end;
// Ресурс:
end;
// Ресурс:
- a := lbResourcesList.Items.IndexOf(ResourceName);
+ a := lbResourcesList.Items.IndexOf(win2utf(ResourceName));
if a <> -1 then
begin
lbResourcesList.ItemIndex := a;
if a <> -1 then
begin
lbResourcesList.ItemIndex := a;
index 2dfc49d720e0e7c8505a828866e0fc40f83c9c66..55508f0b724985ba0f52b0527e7fe51a81685d1d 100644 (file)
unit f_addresource_sound;
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,
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)
type
TAddSoundForm = class (TAddResourceForm)
implementation
uses
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}
{$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;
var
F_System: FMOD_SYSTEM;
SoundData: Pointer = nil;
res := FMOD_OK;
res := FMOD_OK;
+{$IFNDEF NOSOUND}
try
res := FMOD_System_Create(F_System);
if res <> FMOD_OK then
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;
Application.MessageBox(FMOD_ErrorString(res), 'Initialization', MB_OK or MB_ICONHAND);
raise;
end;
+{$ENDIF}
FSpectrum := TMiniSpectrum.Create(pSpectrum);
FSpectrum.Align := alClient;
FSpectrum := TMiniSpectrum.Create(pSpectrum);
FSpectrum.Align := alClient;
begin
Result := False;
begin
Result := False;
-
SoundData := nil;
Sound := nil;
Channel := nil;
SoundData := nil;
Sound := nil;
Channel := nil;
-
+{$IFNDEF NOSOUND}
g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
WAD := TWADEditor_1.Create;
g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
WAD := TWADEditor_1.Create;
WAD.Free();
Result := True;
WAD.Free();
Result := True;
+{$ENDIF}
end;
procedure TAddSoundForm.bbPlayClick(Sender: TObject);
end;
procedure TAddSoundForm.bbPlayClick(Sender: TObject);
if not CreateSoundWAD(FFullResourceName) then
Exit;
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
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);
FMOD_Channel_SetVolume(Channel, 1.0);
FSpectrum.SetChannel(Channel);
+{$ENDIF}
end;
end;
end;
end;
begin
Inherited;
begin
Inherited;
-
+{$IFNDEF NOSOUND}
FMOD_System_Update(F_System);
ShowSpectrum();
FMOD_System_Update(F_System);
ShowSpectrum();
res := FMOD_Channel_IsPlaying(Channel, b);
if (res <> FMOD_OK) or (not b) then
bbStop.Click();
res := FMOD_Channel_IsPlaying(Channel, b);
if (res <> FMOD_OK) or (not b) then
bbStop.Click();
+{$ENDIF}
end;
procedure TAddSoundForm.FormDestroy(Sender: TObject);
end;
procedure TAddSoundForm.FormDestroy(Sender: TObject);
Inherited;
FSpectrum.Free;
Inherited;
FSpectrum.Free;
-
+{$IFNDEF NOSOUND}
res := FMOD_System_Close(F_System);
if res <> FMOD_OK then
begin
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;
e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR);
e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR);
end;
+{$ENDIF}
end;
procedure Sound_StopRelease();
begin
Playing := False;
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);
if Channel <> nil then
FMOD_Channel_Stop(Channel);
if Sound <> nil then
FMOD_Sound_Release(Sound);
-
+{$ENDIF}
if SoundData <> nil then
FreeMem(SoundData);
if SoundData <> nil then
FreeMem(SoundData);
SectionName := '..';
// WAD файл:
SectionName := '..';
// WAD файл:
- a := cbWADList.Items.IndexOf(FileName);
+ a := cbWADList.Items.IndexOf(win2utf(FileName));
if a <> -1 then
begin
cbWADList.ItemIndex := a;
if a <> -1 then
begin
cbWADList.ItemIndex := a;
end;
// Секция:
end;
// Секция:
- a := cbSectionsList.Items.IndexOf(SectionName);
+ a := cbSectionsList.Items.IndexOf(win2utf(SectionName));
if a <> -1 then
begin
cbSectionsList.ItemIndex := a;
if a <> -1 then
begin
cbSectionsList.ItemIndex := a;
end;
// Ресурс:
end;
// Ресурс:
- a := lbResourcesList.Items.IndexOf(ResourceName);
+ a := lbResourcesList.Items.IndexOf(win2utf(ResourceName));
if a <> -1 then
begin
lbResourcesList.ItemIndex := a;
if a <> -1 then
begin
lbResourcesList.ItemIndex := a;
index ce9a073d40b5e6fafddff15b492908cfb9b0f213..195b22d52ead5396cb72fba75ef7e3dc2b56ebc4 100644 (file)
unit f_addresource_texture;
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,
interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, f_addresource,
- StdCtrls, ExtCtrls;
+ StdCtrls, ExtCtrls, utils;
type
TAddTextureForm = class (TAddResourceForm)
type
TAddTextureForm = class (TAddResourceForm)
for i := 0 to lbResourcesList.Count-1 do
if lbResourcesList.Selected[i] then
begin
for i := 0 to lbResourcesList.Count-1 do
if lbResourcesList.Selected[i] then
begin
- AddTexture(cbWADlist.Text, cbSectionsList.Text,
- lbResourcesList.Items[i], False);
+ AddTexture(utf2win(cbWADlist.Text), utf2win(cbSectionsList.Text),
+ utf2win(lbResourcesList.Items[i]), False);
lbResourcesList.Selected[i] := False;
end;
end;
lbResourcesList.Selected[i] := False;
end;
end;
index 98e8cc7c8b0e04d4eeaf6731702a801ea931abed..291819bf8637afafd7922f1ed3c6768b6ee4ad7a 100644 (file)
unit f_choosetype;
unit f_choosetype;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
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;
unit f_keys;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
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;
unit f_main;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ImgList, StdCtrls, Buttons,
ComCtrls, ValEdit, Types, ToolWin, Menus, ExtCtrls,
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
type
ok: Boolean;
FileName: String;
ResourceName: String;
ok: Boolean;
FileName: String;
ResourceName: String;
+ UResourceName: String;
FullResourceName: String;
SectionName: String;
Data: Pointer;
FullResourceName: String;
SectionName: String;
Data: Pointer;
end;
ok := True;
end;
ok := True;
+ UResourceName := win2utf(ResourceName);
// Есть ли уже такая текстура:
for a := 0 to MainForm.lbTextureList.Items.Count-1 do
// Есть ли уже такая текстура:
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],
begin
if not silent then
ErrorMessageBox(Format(_lc[I_MSG_TEXTURE_ALREADY],
- [ResourceName]));
+ [UResourceName]));
ok := False;
end;
ok := False;
end;
begin
if not silent then
ErrorMessageBox(Format(_lc[I_MSG_RES_NAME_64],
begin
if not silent then
ErrorMessageBox(Format(_lc[I_MSG_RES_NAME_64],
- [ResourceName]));
+ [UResourceName]));
ok := False;
end;
ok := False;
end;
a := -1;
if aWAD = _lc[I_WAD_SPECIAL_TEXS] then
begin
a := -1;
if aWAD = _lc[I_WAD_SPECIAL_TEXS] then
begin
- a := MainForm.lbTextureList.Items.Add(ResourceName);
+ a := MainForm.lbTextureList.Items.Add(UResourceName);
if not silent then
SelectTexture(a);
Result := True;
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
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
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);
end;
if (a > -1) and (not silent) then
SelectTexture(a);
function SelectedTexture(): String;
begin
if MainForm.lbTextureList.ItemIndex <> -1 then
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;
else
Result := '';
end;
function IsSpecialTextureSel(): Boolean;
begin
Result := (MainForm.lbTextureList.ItemIndex <> -1) and
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;
end;
function CopyBufferToString(var CopyBuf: TCopyRecArray): String;
OpenedMap := '';
OpenedWAD := '';
OpenedMap := '';
OpenedWAD := '';
- config := TConfig.CreateFile(EditorDir+'/Editor.cfg');
+ config := TConfig.CreateFile(EditorDir+'Editor.cfg');
if config.ReadBool('Editor', 'Maximize', False) then
WindowState := wsMaximized;
if config.ReadBool('Editor', 'Maximize', False) then
WindowState := wsMaximized;
config: TConfig;
i: Integer;
begin
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.WriteBool('Editor', 'Maximize', WindowState = wsMaximized);
config.WriteBool('Editor', 'Minimap', ShowMap);
config.WriteStr('RecentFiles', IntToStr(i+1), '');
RecentFiles.Free();
config.WriteStr('RecentFiles', IntToStr(i+1), '');
RecentFiles.Free();
- config.SaveFile(EditorDir+'/Editor.cfg');
+ config.SaveFile(EditorDir+'Editor.cfg');
config.Free();
slInvalidTextures.Free;
config.Free();
slInvalidTextures.Free;
begin
AddSoundForm.OKFunction := nil;
AddSoundForm.lbResourcesList.MultiSelect := False;
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
if (AddSoundForm.ShowModal() = mrOk) then
begin
- vleObjectProperty.Cells[1, i] := AddSoundForm.ResourceName;
+ vleObjectProperty.Cells[1, i] := win2utf(AddSoundForm.ResourceName);
bApplyProperty.Click();
end;
Exit;
bApplyProperty.Click();
end;
Exit;
begin
Panel^.TextureID := SpecialTextureID(Panel^.TextureName);
with MainForm.lbTextureList.Items do
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;
end;
end;
begin // Выбор файла звука/музыки:
AddSoundForm.OKFunction := nil;
AddSoundForm.lbResourcesList.MultiSelect := False;
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
if (AddSoundForm.ShowModal() = mrOk) then
begin
- vleObjectProperty.Values[Key] := AddSoundForm.ResourceName;
+ vleObjectProperty.Values[Key] := utf2win(AddSoundForm.ResourceName);
bApplyProperty.Click();
end;
end
bApplyProperty.Click();
end;
end
else gLanguage := LANGUAGE_RUSSIAN;
end;
else gLanguage := LANGUAGE_RUSSIAN;
end;
- config := TConfig.CreateFile(EditorDir+'/Editor.cfg');
+ config := TConfig.CreateFile(EditorDir+'Editor.cfg');
config.WriteStr('Editor', 'Language', gLanguage);
config.WriteStr('Editor', 'Language', gLanguage);
- config.SaveFile(EditorDir+'/Editor.cfg');
+ config.SaveFile(EditorDir+'Editor.cfg');
config.Free();
end;
config.Free();
end;
e_InitGL();
e_WriteLog('Loading data', MSG_NOTIFY);
LoadStdFont('STDTXT', 'STDFONT', gEditorFont);
e_InitGL();
e_WriteLog('Loading data', MSG_NOTIFY);
LoadStdFont('STDTXT', 'STDFONT', gEditorFont);
+ e_WriteLog('Loading more data', MSG_NOTIFY);
LoadData();
LoadData();
+ e_WriteLog('Loading even more data', MSG_NOTIFY);
gDataLoaded := True;
MainForm.FormResize(nil);
end;
gDataLoaded := True;
MainForm.FormResize(nil);
end;
index 0bd323dca8f60b03dbd1c85ece56262e85a1be13..bcb8ecf9cdfba7c230262dcdcbf7de771e6c30bc 100644 (file)
unit f_mapcheck;
unit f_mapcheck;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index 56eb889402ed087291951f9f6398828488d02dd4..e7aad24b53f9c31dd9a4d1f5b54eeea616eae1ee 100644 (file)
unit f_mapoptimization;
unit f_mapoptimization;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls,
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls,
- ComCtrls, ExtCtrls;
+ ComCtrls, ExtCtrls, utils;
type
TMapOptimizationForm = class (TForm)
type
TMapOptimizationForm = class (TForm)
for i := 0 to High(gPanels) do
if (gPanels[i].PanelType <> 0) and
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;
begin
ok := False;
Break;
// Нашли неиспользуемую текстуру:
if ok then
begin
// Нашли неиспользуемую текстуру:
if ok then
begin
- g_DeleteTexture(MainForm.lbTextureList.Items[a]);
+ g_DeleteTexture(utf2win(MainForm.lbTextureList.Items[a]));
if not b then
begin
mOptimizationResult.Lines.Add(_lc[I_OPT_DELETED_TEXTURES]);
b := True;
end;
mOptimizationResult.Lines.Add(' '+MainForm.lbTextureList.Items[a]);
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
MainForm.lbTextureList.Items.Delete(a);
end
else
index a194fa929071a597c29b9eaafa08e8baba658f6c..9d3a20ce1e6b619ffa359802745d2d5068a584bd 100644 (file)
unit f_mapoptions;
unit f_mapoptions;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
uses
SysUtils, Classes, Forms, Dialogs,
Controls, StdCtrls, ComCtrls, Buttons,
interface
uses
SysUtils, Classes, Forms, Dialogs,
Controls, StdCtrls, ComCtrls, Buttons,
- f_main;
+ f_main, utils;
type
TMapOptionsForm = class (TForm)
type
TMapOptionsForm = class (TForm)
// Callbacks to receive results from resource choosing dialogs
function SetSky: Boolean;
begin
// 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
Result := True;
end;
function SetMusic: Boolean;
begin
- MapOptionsForm.eMusic.Text := AddSoundForm.ResourceName;
+ MapOptionsForm.eMusic.Text := win2utf(AddSoundForm.ResourceName);
Result := True;
end;
Result := True;
end;
a, b: Integer;
begin
// General map options
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);
eMapWidth.Text := IntToStr(gMapInfo.Width);
eMapHeight.Text := IntToStr(gMapInfo.Height);
with gMapInfo do
begin
with gMapInfo do
begin
- Name := eMapName.Text;
- Description := eMapDescription.Text;
- Author := eAuthor.Text;
- SkyName := eBack.Text;
- MusicName := eMusic.Text;
+ Name := utf2win(eMapName.Text);
+ Description := utf2win(eMapDescription.Text);
+ Author := utf2win(eAuthor.Text);
+ SkyName := utf2win(eBack.Text);
+ MusicName := utf2win(eMusic.Text);
if Width > newWidth then
MapOffset.X := 0;
if Width > newWidth then
MapOffset.X := 0;
begin
AddSkyForm.OKFunction := SetSky;
AddSkyForm.lbResourcesList.MultiSelect := False;
begin
AddSkyForm.OKFunction := SetSky;
AddSkyForm.lbResourcesList.MultiSelect := False;
- AddSkyForm.SetResource := eBack.Text;
+ AddSkyForm.SetResource := utf2win(eBack.Text);
AddSkyForm.ShowModal();
end;
AddSkyForm.ShowModal();
end;
begin
AddSoundForm.OKFunction := SetMusic;
AddSoundForm.lbResourcesList.MultiSelect := False;
begin
AddSoundForm.OKFunction := SetMusic;
AddSoundForm.lbResourcesList.MultiSelect := False;
- AddSoundForm.SetResource := eMusic.Text;
+ AddSoundForm.SetResource := utf2win(eMusic.Text);
AddSoundForm.ShowModal();
end;
AddSoundForm.ShowModal();
end;
index 470da17acbf478c2ca206869204cc607b0b3a779..69f7f40f0568c338ddfee771a442719314fac0e8 100644 (file)
--- a/src/editor/f_maptest.pas
+++ b/src/editor/f_maptest.pas
unit f_maptest;
unit f_maptest;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
n: Integer;
begin
n: Integer;
begin
- config := TConfig.CreateFile(EditorDir+'/Editor.cfg');
+ config := TConfig.CreateFile(EditorDir+'Editor.cfg');
if rbTDM.Checked then
s := 'TDM'
if rbTDM.Checked then
s := 'TDM'
config.WriteStr('TestRun', 'Exe', edD2dExe.Text);
TestD2dExe := edD2dExe.Text;
config.WriteStr('TestRun', 'Exe', edD2dExe.Text);
TestD2dExe := edD2dExe.Text;
- config.SaveFile(EditorDir+'/Editor.cfg');
+ config.SaveFile(EditorDir+'Editor.cfg');
config.Free();
Close();
end;
config.Free();
Close();
end;
config: TConfig;
begin
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');
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;
unit f_options;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
else
DotSize := 1;
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);
config.WriteInt('Editor', 'DotColor', DotColor);
config.WriteBool('Editor', 'DotEnable', DotEnable);
MainForm.RefreshRecentMenu();
end;
MainForm.RefreshRecentMenu();
end;
- config.SaveFile(EditorDir+'/Editor.cfg');
+ config.SaveFile(EditorDir+'Editor.cfg');
config.Free();
Close();
end;
config.Free();
Close();
end;
index c9e093e88197ff6c0929feb88dba9c996199d9dc..0999e54c3758e074d1d3901ad5d0ea6153b205b7 100644 (file)
--- a/src/editor/f_packmap.pas
+++ b/src/editor/f_packmap.pas
unit f_packmap;
unit f_packmap;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index fde781fdd7c483fa68bc99e1ca71fd9c259f52fb..f89ee7366f2a7105e6502bc93f37ecb91463a608 100644 (file)
--- a/src/editor/f_savemap.pas
+++ b/src/editor/f_savemap.pas
unit f_savemap;
unit f_savemap;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index a314ac78be440da17f7bf6273b279de2636b3604..07b6850f4a28622a3b9c544dbdafef77b85fe192 100644 (file)
unit f_saveminimap;
unit f_saveminimap;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index eac54dac33798428a86fd23d0690596fb0d57170..bfb9998be520a25d1cafb099856f20171368114e 100644 (file)
unit f_selectlang;
unit f_selectlang;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index afa6a3eba7058b36db59176811c9283e1b747020..a83e3e03b140d0c76fcdbc0dcb8d9a628fa9d03b 100644 (file)
unit f_selectmap;
unit f_selectmap;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
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;
unit g_basic;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index 405798e96f12086e981d26355fa78f9ad2a4fcde..456ab9b63d3aa1d73c1d4e03af0e33c8908b4d20 100644 (file)
Unit g_language;
Unit g_language;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
Interface
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;
Unit g_map;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
Interface
Uses
LCLIntf, LCLType, LMessages, g_basic, e_graphics, MAPREADER, MAPSTRUCT,
Interface
Uses
LCLIntf, LCLType, LMessages, g_basic, e_graphics, MAPREADER, MAPSTRUCT,
- MAPWRITER, e_log, MAPDEF;
+ MAPWRITER, e_log, MAPDEF, utils;
Type
TMapObject = record
Type
TMapObject = record
for a := 0 to MainForm.lbTextureList.Items.Count-1 do
begin
SetLength(textures, Length(textures)+1);
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
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
// Записываем в WAD, если надо:
if Res <> '' then
begin
+ e_WriteLog('Fuck me (A) ' + ResName, MSG_NOTIFY);
WAD.RemoveResource('', ResName);
WAD.AddResource(Data, Len, ResName, '');
WAD.SaveTo(FileName);
WAD.RemoveResource('', ResName);
WAD.AddResource(Data, Len, ResName, '');
WAD.SaveTo(FileName);
procedure AddTexture(res: String; Error: Boolean);
var
a: Integer;
procedure AddTexture(res: String; Error: Boolean);
var
a: Integer;
+ ures: String;
begin
begin
+ ures := win2utf(res);
with MainForm.lbTextureList do
begin
for a := 0 to Count-1 do
with MainForm.lbTextureList do
begin
for a := 0 to Count-1 do
- if Items[a] = res then
+ if Items[a] = ures then
Exit;
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;
end;
end;
var
map: TConfig;
i, a: Integer;
var
map: TConfig;
i, a: Integer;
- s, section: String;
+ s, us, section: String;
panel: TPanel;
item: TItem;
area: TArea;
panel: TPanel;
item: TItem;
area: TArea;
Continue;
// Нет такой текстуры - ищем в WAD карты:
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), ''));
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;
Continue;
end;
- MainForm.lbTextureList.Items.Add(s);
+ MainForm.lbTextureList.Items.Add(win2utf(s));
end;
// Чтение панелей:
end;
// Чтение панелей:
end;
end;
end;
end;
+ us := win2utf(s);
with MainForm.lbTextureList.Items do
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;
panel.TextureName := s;
panel.TextureWidth := 1;
panel.TextureHeight := 1;
begin
if Items.Count > 0 then
for a := Items.Count-1 downto 0 do
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;
Clear();
end;
procedure LoadData();
begin
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();
end;
procedure FreeData();
index 7c130136b8a53f6a035b92cfac6dcdba877465d8..0ef0a81e0dae27a743e1469443b63cad4d351650 100644 (file)
unit g_textures;
unit g_textures;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
interface
index d0ef0988249af1f5bdef822e3b2fdba8adb1c557..fcedd73783a9c850afc8794bd5d1a351ed40ae94 100644 (file)
--- a/src/editor/spectrum.pas
+++ b/src/editor/spectrum.pas
unit spectrum;
unit spectrum;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
uses
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;
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);
type
TSpectrumStyle = (ssSmooth, ssBlock);
{$R-}
FBuffer.Canvas.Brush.Color := Color;
FBuffer.Canvas.FillRect(BoundsRect);
{$R-}
FBuffer.Canvas.Brush.Color := Color;
FBuffer.Canvas.FillRect(BoundsRect);
-
+{$IFNDEF NOSOUND}
if Enabled then
begin
if FChannel <> nil then
if Enabled then
begin
if FChannel <> nil then
end;
end
else // if Enabled ...
end;
end
else // if Enabled ...
+{$ENDIF}
begin
FBuffer.Canvas.Font.Color := clWhite;
ARect := BoundsRect;
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/>.
*)
* 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
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;
unit e_log;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
interface
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/>.
*)
* 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
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);
if (FPosition + varSize) > FSize then
ExtendMemory(varSize);
- CopyMemory(Pointer(Cardinal(FData) + FPosition),
+ CopyMemory(Pointer(PtrUInt(FData) + FPosition),
@x, varSize);
FPosition := FPosition + varSize;
end;
@x, varSize);
FPosition := FPosition + varSize;
end;
ExtendMemory(SizeOf(Byte) + len);
// Äëèíà ñòðîêè:
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
@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;
@x[1], len);
FPosition := FPosition + len;
end;
ExtendMemory(SizeOf(Cardinal) + memSize);
// Äëèíà áëîêà ïàìÿòè:
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
@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;
x, memSize);
FPosition := FPosition + memSize;
end;
if aLen > 0 then
begin
if aLen > 0 then
begin
- FillMemory(Pointer(Cardinal(FData) + FPosition),
+ FillMemory(Pointer(PtrUInt(FData) + FPosition),
aLen, aFillSym);
FPosition := FPosition + aLen;
end;
aLen, aFillSym);
FPosition := FPosition + aLen;
end;
if (FPosition + varSize) <= FSize then
begin
CopyMemory(@x,
if (FPosition + varSize) <= FSize then
begin
CopyMemory(@x,
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
varSize);
FPosition := FPosition + varSize;
end
varSize);
FPosition := FPosition + varSize;
end
begin
// Äëèíà ñòðîêè:
CopyMemory(@len,
begin
// Äëèíà ñòðîêè:
CopyMemory(@len,
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
SizeOf(Byte));
if (FPosition + SizeOf(Byte) + len) <= FSize then
SizeOf(Byte));
if (FPosition + SizeOf(Byte) + len) <= FSize then
if len > 0 then
begin
CopyMemory(@x[1],
if len > 0 then
begin
CopyMemory(@x[1],
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
len);
FPosition := FPosition + len;
end
len);
FPosition := FPosition + len;
end
begin
// Äëèíà áëîêà ïàìÿòè:
CopyMemory(@memSize,
begin
// Äëèíà áëîêà ïàìÿòè:
CopyMemory(@memSize,
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
SizeOf(Cardinal));
if (FPosition + SizeOf(Cardinal) + memSize) <= FSize then
SizeOf(Cardinal));
if (FPosition + SizeOf(Cardinal) + memSize) <= FSize then
begin
GetMem(x, memSize);
CopyMemory(x,
begin
GetMem(x, memSize);
CopyMemory(x,
- Pointer(Cardinal(FData) + FPosition),
+ Pointer(PtrUInt(FData) + FPosition),
memSize);
FPosition := FPosition + memSize;
end
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;
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;
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;
unit MAPREADER;
-{$MODE Delphi}
+{$INCLUDE ../shared/a_modes.inc}
{
-----------------------------------
{
-----------------------------------
-MAPREADER.PAS ВЕРСИЯ ОТ 13.11.07
+MAPREADER.PAS ÂÅÐÑÈß ÎÒ 13.11.07
-Поддержка карт версии 1
+Ïîääåðæêà êàðò âåðñèè 1
-----------------------------------
}
-----------------------------------
}
SysUtils, BinEditor;
var
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
function g_Texture_NumNameFindStart(name: String): Boolean;
var
NNF_CurrentNum := -1;
for i := Length(name) downto 1 do
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
if i = Length(name) then
- begin // Нет цифр в конце строки
+ begin // Íåò öèôð â êîíöå ñòðîêè
Exit;
end
else
Exit;
end
else
end;
end;
end;
end;
-// Не перевести в число:
+// Íå ïåðåâåñòè â ÷èñëî:
if not TryStrToInt(name, NNF_FirstNum) then
Exit;
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);
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;
TempDataBlocks := nil;
for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
begin
SetLength(Result, Length(Result)+1);
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;
TempDataBlocks := nil;
for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
begin
SetLength(Result, Length(Result)+1);
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;
TempDataBlocks := nil;
for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
begin
SetLength(Result, Length(Result)+1);
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;
TempDataBlocks := nil;
for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
begin
SetLength(Result, Length(Result)+1);
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;
TempDataBlocks := nil;
for b := 0 to (TempDataBlocks[a].Block.BlockSize div size)-1 do
begin
SetLength(Result, Length(Result)+1);
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;
TempDataBlocks := nil;
end;
adr := 3;
end;
adr := 3;
- CopyMemory(@Ver, Pointer(LongWord(Data)+adr), 1);
+ CopyMemory(@Ver, Pointer(PtrUInt(Data)+adr), 1);
FVersion := Ver;
if Ver > HandledVersion() then
begin
FVersion := Ver;
if Ver > HandledVersion() then
begin
SetLength(FDataBlocks, Length(FDataBlocks)+1);
_id := High(FDataBlocks);
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);
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;
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;
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;
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();
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
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);
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;
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;
end;
function TMapWriter.HandledVersion(): Byte;
Data := GetMemory(Block.BlockSize);
for a := 0 to High(Areas) do
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;
end;
Result := True;
Data := GetMemory(Block.BlockSize);
for a := 0 to High(Items) do
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;
end;
Result := True;
Data := GetMemory(Block.BlockSize);
for a := 0 to High(Monsters) do
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;
end;
Result := True;
Data := GetMemory(Block.BlockSize);
for a := 0 to High(Panels) do
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;
end;
Result := True;
Data := GetMemory(Block.BlockSize);
for a := 0 to High(Textures) do
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;
end;
Result := True;
Data := GetMemory(Block.BlockSize);
for a := 0 to High(Triggers) do
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;
end;
Result := True;
Data := GetMemory(Block.BlockSize);
Data := GetMemory(Block.BlockSize);
- CopyMemory(Pointer(LongWord(Data)), @MapHeader, size);
+ CopyMemory(Pointer(PtrUInt(Data)), @MapHeader, size);
end;
Result := True;
end;
Result := True;
index 26110093c33f149d023741811db89865be5183c5..e68fd21bcdee1c7d63ced3b086fb58abf80cd09d 100644 (file)
--- a/src/shared/WADEDITOR.pas
+++ b/src/shared/WADEDITOR.pas
implementation
uses
implementation
uses
- SysUtils, BinEditor, ZLib, utils;
+ SysUtils, BinEditor, ZLib, utils, e_log;
const
DFWAD_OPENED_NONE = 0;
const
DFWAD_OPENED_NONE = 0;
end;
end;
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
procedure g_ProcessResourceStr(ResourceStr: String; var FileName,
SectionName, ResourceName: String);
var
ResCompressed := nil;
ResCompressedSize := 0;
ResCompressed := nil;
ResCompressedSize := 0;
- Compress(Data, @Len, ResCompressed, ResCompressedSize);
+ CompressBuf(Data, Len, ResCompressed, ResCompressedSize);
if ResCompressed = nil then Exit;
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));
if FResData = nil then FResData := AllocMem(ResCompressedSize)
else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize));
ResCompressed := nil;
ResCompressedSize := 0;
ResCompressed := nil;
ResCompressedSize := 0;
- Compress(TempResource, @OriginalSize, ResCompressed, ResCompressedSize);
+ CompressBuf(TempResource, OriginalSize, ResCompressed, ResCompressedSize);
FreeMemory(TempResource);
if ResCompressed = nil then Exit;
FreeMemory(TempResource);
if ResCompressed = nil then Exit;
else
begin
TempData := GetMemory(FResTable[i].Length);
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);
FResTable[i].Length);
DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes);
FreeMem(TempData);
Exit;
end;
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;
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
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
SizeOf(TResourceTableRec_1)*FHeader.RecordsCount);
for a := 0 to High(FResTable) do
begin
if FResTable = nil then Exit;
begin
if FResTable = nil then Exit;
+ e_WriteLog('Fuck me (B) ' + Section + ' ' + Resource, MSG_NOTIFY);
+
i := -1;
b := 0;
c := 0;
i := -1;
b := 0;
c := 0;
if i = -1 then Exit;
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];
for a := i to High(FResTable)-1 do
FResTable[a] := FResTable[a+1];
d := d+FResTable[a].Length;
end;
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;
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/>.
*)
* 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
unit utils;
interface
SysUtils, Classes;
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;
// 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;
// `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;
// they throws
function openDiskFileRO (pathname: AnsiString): TStream;
function readUInt64BE (st: TStream): UInt64;
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
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);
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?
// 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
// try the easiest case first
attr := FileGetAttr(newname+curname);
if attr <> -1 then
if wantdir = ((attr and faDirectory) <> 0) then
begin
// i found her!
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;
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
// alas, either not found, or invalid attributes
foundher := false;
try
finally
FindClose(sr);
end;
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;
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;
if result then pathname := newname;
end;
-function findFileCIStr (pathname: AnsiString; lastIsDir: Boolean=false): AnsiString;
-var
- s: AnsiString;
+function findFileCIStr (pathname: AnsiString): AnsiString;
begin
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;
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;
function readInt64BE (st: TStream): Int64; begin readIntegerBE(st, @result, 8); end;
function readUInt64BE (st: TStream): UInt64; begin readIntegerBE(st, @result, 8); end;
-
end.
end.
+