This commit is contained in:
1 parent
d8360d49e5
commit
f71802c885
5 files changed
+1029
-95
No files matched your search
@@ -1,6 +1,7 @@
|
|||||||
{
|
{
|
||||||
"schema": "kam-source-resolution/1",
|
"schema": "kam-source-resolution/1",
|
||||||
"adaptations": [
|
"adaptations": [
|
||||||
|
"KaM_Remake.inc",
|
||||||
"src/utils/io/KM_FileIO.pas",
|
"src/utils/io/KM_FileIO.pas",
|
||||||
"src/common/KM_CommonClasses.pas",
|
"src/common/KM_CommonClasses.pas",
|
||||||
"src/settings/KM_GameSettings.pas",
|
"src/settings/KM_GameSettings.pas",
|
||||||
@@ -20,6 +21,7 @@
|
|||||||
"src/res/KM_ResLocales.pas",
|
"src/res/KM_ResLocales.pas",
|
||||||
"src/render/KM_Render.pas",
|
"src/render/KM_Render.pas",
|
||||||
"src/KM_GameApp.pas",
|
"src/KM_GameApp.pas",
|
||||||
|
"src/KM_Main.pas",
|
||||||
"src/res/KM_Resource.pas",
|
"src/res/KM_Resource.pas",
|
||||||
"src/common/KM_Defaults.pas",
|
"src/common/KM_Defaults.pas",
|
||||||
"src/res/KM_ResTypes.pas"
|
"src/res/KM_ResTypes.pas"
|
||||||
|
|||||||
@@ -0,0 +1,84 @@
|
|||||||
|
// WDC/FPC defines used for RTL-specific cases
|
||||||
|
// If you use any Delphi compiler that is not listed here - you need to add it
|
||||||
|
{$IFDEF VER140} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 6 compiler
|
||||||
|
{$IFDEF VER150} {.$DEFINE WDC} {$ENDIF} //Define Windows Delphi 7 compiler //FPC >= 3.2.0 has defined VER150, so just disable it here
|
||||||
|
{$IFDEF VER220} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE compiler
|
||||||
|
{$IFDEF VER230} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE2 compiler
|
||||||
|
{$IFDEF VER240} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE3 compiler
|
||||||
|
{$IFDEF VER250} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE4 compiler
|
||||||
|
{$IFDEF VER260} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE5 compiler
|
||||||
|
{$IFDEF VER270} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE6 compiler
|
||||||
|
{$IFDEF VER280} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE7 compiler
|
||||||
|
{$IFDEF VER290} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi XE8 compiler
|
||||||
|
{$IFDEF VER300} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10 Seattle compiler
|
||||||
|
{$IFDEF VER310} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.1 Berlin compiler
|
||||||
|
{$IFDEF VER320} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.2 Tokyo compiler
|
||||||
|
{$IFDEF VER330} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.3 Rio compiler
|
||||||
|
{$IFDEF VER340} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 10.4 Sydney compiler
|
||||||
|
{$IFDEF VER350} {$DEFINE WDC} {$ENDIF} //Define Windows Delphi 11 Alexandria
|
||||||
|
{$IFDEF VER360} {$DEFINE WDC} {$DEFINE WDC12PLUS} {$ENDIF} //Define Windows Delphi 12 Yukon
|
||||||
|
{.$DEFINE FPC} //Define Free Pascal compiler (defined automatically by Lazarus)
|
||||||
|
|
||||||
|
|
||||||
|
// Lazarus compiler specific settings
|
||||||
|
{$IFDEF FPC}
|
||||||
|
// Set FPC to work in Delphi mode
|
||||||
|
{$MODE Delphi}
|
||||||
|
// Allow advanced records in Lazarus
|
||||||
|
{$modeSwitch advancedRecords}
|
||||||
|
|
||||||
|
// Currently FPC does not define UNICODE define because in Delphi it means more than just a
|
||||||
|
// default string type but a full RTL implementation : using Windows 'W' functions instead of 'A',
|
||||||
|
// another class declarations(TStringStream for example).
|
||||||
|
{$IFDEF FPC_UNICODESTRINGS}
|
||||||
|
{$DEFINE UNICODE}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
// Delphi compiler specific settings
|
||||||
|
{$IFDEF WDC}
|
||||||
|
{$IFNDEF WDC64} // Not available on Win64
|
||||||
|
// Project can be compiled without madExcept features (if you dont have madExcept installed)
|
||||||
|
{$DEFINE USE_MAD_EXCEPT}
|
||||||
|
// Delphi compiler video play
|
||||||
|
{$DEFINE VIDEOS}
|
||||||
|
|
||||||
|
{.$DEFINE FASTMM}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$DEFINE USE_VIRTUAL_TREEVIEW}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
// Promote some warnings to errors for safety (for all our tools)
|
||||||
|
//----------------------------------------------------------------------------------------------------
|
||||||
|
{$IFDEF WDC}
|
||||||
|
{$WARN HIDING_MEMBER ERROR} // W1009 Redeclaration of '%s' hides a member in the base class
|
||||||
|
{$WARN HIDDEN_VIRTUAL ERROR} // W1010 Method '%s' hides virtual method of base type '%s'
|
||||||
|
{$WARN GARBAGE ERROR} // W1011 Text after final 'END.' - ignored by compiler
|
||||||
|
{$WARN BOUNDS_ERROR ERROR} // W1012 Constant expression violates subrange bounds (Delphi)
|
||||||
|
{$WARN FOR_VARIABLE ERROR} // W1019 For loop control variable must be simple local variable (Delphi)
|
||||||
|
{$WARN CONSTRUCTING_ABSTRACT ERROR} // W1020 Constructing instance of '%s' containing abstract method '%s.%s' (Delphi)
|
||||||
|
{$WARN COMPARISON_FALSE ERROR} // W1021 Comparison always evaluates to False
|
||||||
|
{$WARN COMPARISON_TRUE ERROR} // W1022 Comparison always evaluates to True
|
||||||
|
{$WARN DUPLICATE_CTOR_DTOR ERROR} // W1029 Duplicate %s '%s' with identical parameters will be inacessible from C++ (Delphi)
|
||||||
|
{$WARN NO_RETVAL ERROR} // W1035 Return value of function '%s' might be undefined
|
||||||
|
{$WARN USE_BEFORE_DEF ERROR} // W1036 Variable '%s' might not have been initialized
|
||||||
|
{$WARN FOR_LOOP_VAR_UNDEF ERROR} // W1037 FOR-Loop variable '%s' may be undefined after loop
|
||||||
|
{$WARN UNIT_NAME_MISMATCH ERROR} // W1038 Unit identifier '%s' does not match file name (Delphi)
|
||||||
|
{$WARN DUPLICATES_IGNORED ERROR} // W1051 Duplicate symbol names in namespace. Using '%s.%s' found in %s. Ignoring duplicate in %s
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
// Allows to skip secure authentication unit (KM_NetAuthSecure) if you dont have it
|
||||||
|
{.$DEFINE DBG_SKIP_SECURE_AUTH}
|
||||||
|
|
||||||
|
// Enable asynchronous game resource loading
|
||||||
|
{$IFNDEF NO_ASYNC_LOAD}
|
||||||
|
{$DEFINE LOAD_GAME_RES_ASYNC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$DEFINE DBG_RNG_SPY}
|
||||||
|
|
||||||
|
// Enable some debug features
|
||||||
|
{.$DEFINE DEBUG}
|
||||||
@@ -67,7 +67,6 @@ type
|
|||||||
procedure InitMainMenu(aScreenX, aScreenY: Word);
|
procedure InitMainMenu(aScreenX, aScreenY: Word);
|
||||||
function GetActiveInterface: TKMUserInterfaceCommon;
|
function GetActiveInterface: TKMUserInterfaceCommon;
|
||||||
|
|
||||||
procedure UpdatePerflog;
|
|
||||||
public
|
public
|
||||||
constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
|
constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
|
||||||
aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
|
aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
|
||||||
@@ -173,9 +172,8 @@ uses
|
|||||||
KM_GameSavePoints,
|
KM_GameSavePoints,
|
||||||
KM_Cursor, KM_ResTexts, KM_ResKeys, KM_ResTypes,
|
KM_Cursor, KM_ResTexts, KM_ResKeys, KM_ResTypes,
|
||||||
KM_IoGraphicUtils, KM_Settings,
|
KM_IoGraphicUtils, KM_Settings,
|
||||||
KM_Saves, KM_CommonUtils, KM_CommonShellUtils,
|
KM_Saves, KM_CommonUtils
|
||||||
{$IFDEF DBG_RNG_SPY}KM_RandomChecks,{$ENDIF}
|
{$IFDEF DBG_RNG_SPY}, KM_RandomChecks{$ENDIF};
|
||||||
KM_DevPerfLog, KM_DevPerfLogTypes;
|
|
||||||
|
|
||||||
|
|
||||||
{ TKMGameApp }
|
{ TKMGameApp }
|
||||||
@@ -1231,12 +1229,6 @@ begin
|
|||||||
|
|
||||||
gRender.BeginFrame;
|
gRender.BeginFrame;
|
||||||
|
|
||||||
{$IFDEF DBG_PERFLOG}
|
|
||||||
gPerfLogs.StackGFX.FrameBegin;
|
|
||||||
gPerfLogs.SectionEnter(psFrameFullG);
|
|
||||||
|
|
||||||
try
|
|
||||||
{$ENDIF}
|
|
||||||
if gVideoPlayer.IsActive then
|
if gVideoPlayer.IsActive then
|
||||||
gVideoPlayer.Paint
|
gVideoPlayer.Paint
|
||||||
else
|
else
|
||||||
@@ -1246,15 +1238,6 @@ begin
|
|||||||
fMainMenuInterface.Paint;
|
fMainMenuInterface.Paint;
|
||||||
|
|
||||||
gRender.RenderBrightness(gGameSettings.GFX.Brightness);
|
gRender.RenderBrightness(gGameSettings.GFX.Brightness);
|
||||||
{$IFDEF DBG_PERFLOG}
|
|
||||||
finally
|
|
||||||
gPerfLogs.SectionLeave(psFrameFullG);
|
|
||||||
gPerfLogs.StackGFX.FrameEnd;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if gMain <> nil then
|
|
||||||
gPerfLogs.Render(TOOLBAR_WIDTH + 10, gMain.FormMain.RenderArea.Width - 10, gMain.FormMain.RenderArea.Height - 10);
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
gRender.EndFrame;
|
gRender.EndFrame;
|
||||||
gRender.Query.QueriesSwapBuffers;
|
gRender.Query.QueriesSwapBuffers;
|
||||||
@@ -1369,26 +1352,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TKMGameApp.UpdatePerflog;
|
|
||||||
{$IFNDEF Unix}
|
|
||||||
{$IFDEF DBG_PERFLOG}
|
|
||||||
var
|
|
||||||
memUsed, stackUsed: NativeUInt;
|
|
||||||
{$ENDIF}
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
|
||||||
{$IFNDEF Unix}
|
|
||||||
{$IFDEF DBG_PERFLOG}
|
|
||||||
memUsed := GetMemUsed;
|
|
||||||
stackUsed := GetCommittedStackSize;
|
|
||||||
|
|
||||||
gPerfLogs.SectionAddValue(psMemUsed, memUsed div (10*1024), fGlobalTickCount, IntToStr(memUsed div (1024*1024)) + 'Mb');
|
|
||||||
gPerfLogs.SectionAddValue(psStackUsed, stackUsed div 128, fGlobalTickCount, IntToStr(stackUsed div 1024) + 'Kb');
|
|
||||||
{$ENDIF}
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure TKMGameApp.UpdateState;
|
procedure TKMGameApp.UpdateState;
|
||||||
begin
|
begin
|
||||||
if fIsLoading then Exit; //Don't update while toggling locale
|
if fIsLoading then Exit; //Don't update while toggling locale
|
||||||
@@ -1425,7 +1388,6 @@ begin
|
|||||||
fOnStatusBarUpdate(spTime, 'Time: ' + TimeToString(gGame.MissionTime));
|
fOnStatusBarUpdate(spTime, 'Time: ' + TimeToString(gGame.MissionTime));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
UpdatePerflog;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,941 @@
|
|||||||
|
unit KM_Main;
|
||||||
|
{$I KaM_Remake.inc}
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
{$IFDEF MSWindows} Windows, {$ENDIF}
|
||||||
|
KM_Defaults, KM_FormMain, KM_FormLoading, KM_Maps,
|
||||||
|
KM_MainSettings, KM_Resolutions, KM_Video,
|
||||||
|
KM_WindowParams,
|
||||||
|
KM_GameAppSettings
|
||||||
|
{$IFDEF FPC}
|
||||||
|
, Types
|
||||||
|
{$ENDIF}
|
||||||
|
;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
// Provides basement for the Game App
|
||||||
|
// Should be abstract enough, so that the Game could be a race-sim or a quest or any other
|
||||||
|
TKMMain = class
|
||||||
|
private
|
||||||
|
fFormMain: TFormMain;
|
||||||
|
fFormLoading: TFormLoading;
|
||||||
|
|
||||||
|
fGameTickInterval: Cardinal;
|
||||||
|
|
||||||
|
fRenderSchedule, fTickSchedule, fUpdateStateSchedule: Cardinal;
|
||||||
|
fLastRenderTime, fOldFrameTimes, fFrameCount: Cardinal;
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
fMutex: THandle;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
// fMainSettings: TKMainSettings;
|
||||||
|
fResolutions: TKMResolutions;
|
||||||
|
fMapCacheUpdater: TTMapsCacheUpdater;
|
||||||
|
|
||||||
|
fFPS: Single;
|
||||||
|
fFPSString: String;
|
||||||
|
|
||||||
|
procedure DoRestore(Sender: TObject);
|
||||||
|
procedure DoActivate(Sender: TObject);
|
||||||
|
procedure DoDeactivate(Sender: TObject);
|
||||||
|
procedure DoIdle(Sender: TObject; var Done: Boolean);
|
||||||
|
|
||||||
|
function GetRenderInterval: Cardinal;
|
||||||
|
function ForcedRenderRequired: Boolean;
|
||||||
|
|
||||||
|
procedure DoRender;
|
||||||
|
procedure SleepUntilNextSchedule;
|
||||||
|
|
||||||
|
procedure MapCacheUpdate;
|
||||||
|
procedure UpdateFPS(latestFrameTime: Cardinal);
|
||||||
|
|
||||||
|
procedure GameSpeedChange(aSpeed: Single);
|
||||||
|
function DoHaveGenericPermission: Boolean;
|
||||||
|
|
||||||
|
procedure TryWriteIntoGameFolder();
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function Start: Boolean;
|
||||||
|
procedure CloseQuery(var aCanClose: Boolean);
|
||||||
|
procedure Stop(Sender: TObject);
|
||||||
|
|
||||||
|
procedure UpdateWindowParams(const aWindowParams: TKMWindowParamsRecord);
|
||||||
|
procedure Move(const aWindowParams: TKMWindowParamsRecord);
|
||||||
|
procedure ForceResize;
|
||||||
|
procedure Resize(aWidth, aHeight: Integer); overload;
|
||||||
|
procedure Resize(aWidth, aHeight: Integer; const aWindowParams: TKMWindowParamsRecord); overload;
|
||||||
|
procedure Render;
|
||||||
|
procedure ShowAbout;
|
||||||
|
property FormMain: TFormMain read fFormMain;
|
||||||
|
|
||||||
|
procedure ApplyCursorRestriction;
|
||||||
|
function GetScreenBounds(out aBounds: TRect): Boolean;
|
||||||
|
function IsFormActive: Boolean;
|
||||||
|
function ClientRect(aPixelsCntToReduce: Integer = 0): TRect;
|
||||||
|
function ClientToScreen(aPoint: TPoint): TPoint;
|
||||||
|
function ReinitRender(aReturnToOptions: Boolean): Boolean;
|
||||||
|
|
||||||
|
property FPSString: String read fFPSString;
|
||||||
|
|
||||||
|
function IsDebugChangeAllowed: Boolean;
|
||||||
|
|
||||||
|
function LockMutex: Boolean;
|
||||||
|
procedure UnlockMutex;
|
||||||
|
|
||||||
|
procedure HandleStatusBarText(aPanelIndex: TKMStatusBarPanel; aText: string);
|
||||||
|
|
||||||
|
procedure SetGameTickInterval(aInterval: Cardinal);
|
||||||
|
property GameTickInterval: Cardinal read fGameTickInterval;
|
||||||
|
|
||||||
|
property Resolutions: TKMResolutions read fResolutions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
gMain: TKMMain;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, SysConst, StrUtils, Math,
|
||||||
|
Forms,
|
||||||
|
{$IF DEFINED(MSWindows)}
|
||||||
|
MMSystem,
|
||||||
|
{$ELSEIF DEFINED(Unix)}
|
||||||
|
Dialogs, LCLType, Controls,
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF USE_MAD_EXCEPT} KM_Exceptions, {$ENDIF}
|
||||||
|
KromUtils, KM_FileIO,
|
||||||
|
KM_GameApp, KM_VclHelpers,
|
||||||
|
KM_System,
|
||||||
|
KM_ResTexts,
|
||||||
|
KM_KeysSettings,
|
||||||
|
KM_Music,
|
||||||
|
KM_Log, KM_CommonUtils, KM_Points,
|
||||||
|
KM_CommonExceptions,
|
||||||
|
KromShellUtils, KM_MapTypes;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
// Mutex is used to block duplicate app launch on the same PC
|
||||||
|
// Random GUID generated in Delphi by Ctrl+Shift+G
|
||||||
|
// Generated for versions r13651+
|
||||||
|
// We can allow to have beta and r6720 versions to be opened at the same time
|
||||||
|
KAM_MUTEX = 'AAF80942-EC97-4D02-9339-07AB8FEFA187';
|
||||||
|
|
||||||
|
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
function AddWithOverflow(A, B: Cardinal): Cardinal; inline;
|
||||||
|
begin
|
||||||
|
Result := A + B;
|
||||||
|
end;
|
||||||
|
{$OVERFLOWCHECKS ON}
|
||||||
|
|
||||||
|
|
||||||
|
{ TKMMain }
|
||||||
|
constructor TKMMain.Create;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
|
||||||
|
// Try to write a file into the game folder and raise an error in case we can not
|
||||||
|
tryWriteIntoGameFolder();
|
||||||
|
|
||||||
|
fGameTickInterval := 100;
|
||||||
|
|
||||||
|
// Create exception handler as soon as possible in case it crashes early on
|
||||||
|
{$IFDEF USE_MAD_EXCEPT}gExceptions := TKMExceptions.Create;{$ENDIF}
|
||||||
|
|
||||||
|
//Form created first will be on taskbar
|
||||||
|
Application.CreateForm(TFormMain, fFormMain);
|
||||||
|
Application.CreateForm(TFormLoading, fFormLoading);
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TKMMain.Destroy;
|
||||||
|
begin
|
||||||
|
// FormLoading is owned by the Application
|
||||||
|
// If exception occurs and gMain is freed, make sure to remove fsStayOnTop from FormLoading,
|
||||||
|
// so that madExcept dialogs (main and its child SendBugReport) are not overlapped by it
|
||||||
|
fFormLoading.FormStyle := fsNormal;
|
||||||
|
|
||||||
|
{$IFDEF USE_MAD_EXCEPT}FreeAndNil(gExceptions);{$ENDIF}
|
||||||
|
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Try to write a file into the game folder and raise an error in case we can not
|
||||||
|
procedure TKMMain.TryWriteIntoGameFolder();
|
||||||
|
var
|
||||||
|
filename: String;
|
||||||
|
sList: TStringList;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
sList := TStringList.Create;
|
||||||
|
try
|
||||||
|
filename := ExtractFilePath(ParamStr(0)) + PathDelim + 'test.txt';
|
||||||
|
sList.SaveToFile(filename);
|
||||||
|
KMDeleteFile(filename);
|
||||||
|
finally
|
||||||
|
sList.Free;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
raise EGameInitError.Create('Can''t write into the game folder ''' + ExtractFilePath(ParamStr(0)) + '''' + sLineBreak + sLineBreak
|
||||||
|
+ 'Error:' + sLineBreak + E.Message + sLineBreak + sLineBreak
|
||||||
|
+ 'Please move the game folder to a writable location or change the game folder permissions');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Assertion error handler
|
||||||
|
procedure CustomAssertErrorHandler(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
|
||||||
|
var
|
||||||
|
fileNameOnly: string;
|
||||||
|
begin
|
||||||
|
// Show only filename in the error message
|
||||||
|
fileNameOnly := ExtractFileName(Filename);
|
||||||
|
|
||||||
|
if Message <> '' then
|
||||||
|
raise EAssertionFailed.CreateFmt(SAssertError,
|
||||||
|
[Message, fileNameOnly, LineNumber]) at ErrorAddr
|
||||||
|
else
|
||||||
|
raise EAssertionFailed.CreateFmt(SAssertError,
|
||||||
|
[SAssertionFailed, fileNameOnly, LineNumber]) at ErrorAddr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Return False in case we had difficulties on the start
|
||||||
|
function TKMMain.Start: Boolean;
|
||||||
|
|
||||||
|
function GetScreenMonitorsInfo: TKMPointArray;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
SetLength(Result, Screen.MonitorCount);
|
||||||
|
for I := 0 to Screen.MonitorCount-1 do
|
||||||
|
begin
|
||||||
|
Result[I].X := Screen.Monitors[I].Width;
|
||||||
|
Result[I].Y := Screen.Monitors[I].Height;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
LOG_CREATE_TRY_CNT = 3;
|
||||||
|
var
|
||||||
|
tryInd: Integer;
|
||||||
|
logsPath: UnicodeString;
|
||||||
|
time: Cardinal;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
|
||||||
|
time := TimeGet;
|
||||||
|
|
||||||
|
ExeDir := ExtractFilePath(ParamStr(0));
|
||||||
|
|
||||||
|
// Set custom AssertErrorhandler to avoid dev paths in the error messages, which could be seen by players
|
||||||
|
AssertErrorProc := @CustomAssertErrorHandler;
|
||||||
|
|
||||||
|
//Random is only used for cases where order does not matter, e.g. shuffle tracks
|
||||||
|
Randomize;
|
||||||
|
|
||||||
|
fFormLoading.Label5.Caption := UnicodeString(GAME_VERSION);
|
||||||
|
fFormLoading.Show; //This is our splash screen
|
||||||
|
fFormLoading.Refresh;
|
||||||
|
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
TimeBeginPeriod(1); //initialize timer precision
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
if not BLOCK_FILE_WRITE then
|
||||||
|
begin
|
||||||
|
tryInd := 0;
|
||||||
|
logsPath := ExeDir + 'Logs' + PathDelim + 'KaM_' + FormatDateTime('yyyy-mm-dd_hh-nn-ss-zzz', Now) + '.log';
|
||||||
|
// Try to create log several times
|
||||||
|
while (gLog = nil) and (tryInd < LOG_CREATE_TRY_CNT) do
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Inc(tryInd);
|
||||||
|
CreateDir(ExeDir + 'Logs' + PathDelim);
|
||||||
|
gLog := TKMLog.Create(logsPath); //First thing - create a log
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
if tryInd < LOG_CREATE_TRY_CNT then
|
||||||
|
Sleep(200) // Just wait a bit
|
||||||
|
else
|
||||||
|
raise EGameInitError.Create('Error initializing logging into file: ''' + logsPath + ''':' + sLineBreak + E.Message
|
||||||
|
{$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF});
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
gLog.DeleteOldLogs(LOGS_DELETE_WHEN_OLDER_THAN);
|
||||||
|
end;
|
||||||
|
|
||||||
|
gLog.AddTime('Game Load started');
|
||||||
|
|
||||||
|
//Resolutions are created first so that we could check Settings against them
|
||||||
|
fResolutions := TKMResolutions.Create;
|
||||||
|
|
||||||
|
//Only after we read settings (fullscreen property and resolutions)
|
||||||
|
//we can decide whenever we want to create Game fullscreen or not (OpenGL init depends on that)
|
||||||
|
gGameAppSettings := TKMGameAppSettings.Create(Screen.Width, Screen.Height);
|
||||||
|
|
||||||
|
//We need to verify INI values, as they can be from another display
|
||||||
|
if not fResolutions.IsValid(gMainSettings.Resolution) then
|
||||||
|
begin
|
||||||
|
gMainSettings.Resolution := fResolutions.FindCorrect(gMainSettings.Resolution);
|
||||||
|
if not fResolutions.IsValid(gMainSettings.Resolution) then
|
||||||
|
gMainSettings.FullScreen := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
gVideoPlayer := TKMVideoPlayer.Create(FEAT_VIDEOS_UNDER_WINE or not IsUnderWine);
|
||||||
|
|
||||||
|
fFormMain.Caption := 'KaM Remake - ' + UnicodeString(GAME_VERSION);
|
||||||
|
//Will make the form slightly higher, so do it before ReinitRender so it is reset
|
||||||
|
fFormMain.UpdateFormState;
|
||||||
|
|
||||||
|
// Check INI window params, if not valid - set NeedResetToDefaults flag for future update
|
||||||
|
if not gMainSettings.WindowParams.IsValid(GetScreenMonitorsInfo) then
|
||||||
|
gMainSettings.WindowParams.NeedResetToDefaults := True;
|
||||||
|
|
||||||
|
// Stop app if we did not ReinitRender properly (didn't pass game folder permissions test)
|
||||||
|
//todo -cComplicated: refactor. Separate folder permissions check and render initialization
|
||||||
|
// Locale and texts could be loaded separetely to show proper translated error message
|
||||||
|
if not ReinitRender(False) then
|
||||||
|
Exit(False);
|
||||||
|
|
||||||
|
fFormMain.ControlsReset; // Reset controls will update Defaults.pas settings after loaded DevSettings
|
||||||
|
fFormMain.ControlsRefill; // Refill some of the debug controls from game settings
|
||||||
|
|
||||||
|
// Create gSystem before Application.OnActivate (it uses FlashingStop)
|
||||||
|
gSystem := TKMSystem.Create(fFormMain.Handle);
|
||||||
|
|
||||||
|
Application.OnIdle := DoIdle;
|
||||||
|
Application.OnActivate := DoActivate;
|
||||||
|
Application.OnDeactivate := DoDeactivate;
|
||||||
|
Application.OnRestore := DoRestore; //OnActivate seems to happen at the wrong times, OnRestore happens when alt-tabbing back in full screen mode
|
||||||
|
|
||||||
|
//Update map cache files (*.mi) in the background so map lists load faster
|
||||||
|
MapCacheUpdate;
|
||||||
|
|
||||||
|
//Process messages in queue before hiding Loading, so that they all land on Loading form, not main one
|
||||||
|
Application.ProcessMessages;
|
||||||
|
fFormLoading.Hide;
|
||||||
|
|
||||||
|
fFormMain.AfterFormCreated;
|
||||||
|
|
||||||
|
gLog.AddTime('Game Load Done in ' + IntToStr(TimeSince(time)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.HandleStatusBarText(aPanelIndex: TKMStatusBarPanel; aText: string);
|
||||||
|
begin
|
||||||
|
fFormMain.StatusBar1.Panels[Ord(aPanelIndex)].Text := aText;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.GameSpeedChange(aSpeed: Single);
|
||||||
|
begin
|
||||||
|
// Set check state without trigger OnClick event handler for the CheckBox
|
||||||
|
fFormMain.chkSuperSpeed.SetCheckedWithoutClick(aSpeed = DEBUG_SPEEDUP_SPEED);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.CloseQuery(var aCanClose: Boolean);
|
||||||
|
var
|
||||||
|
wasRunning: Boolean;
|
||||||
|
begin
|
||||||
|
//MessageDlg works better than Application.MessageBox or others, it stays on top and
|
||||||
|
//pauses here until the user clicks ok. However for some reason we chose MessageBox
|
||||||
|
//thus we need to pause the game manually
|
||||||
|
|
||||||
|
aCanClose := (gGameApp = nil) or (gGameApp.Game = nil) or gGameApp.Game.Params.IsReplay;
|
||||||
|
|
||||||
|
if not aCanClose then
|
||||||
|
begin
|
||||||
|
//We want to pause the game for the time user verifies he really wants to close
|
||||||
|
wasRunning := not gGameApp.Game.Params.IsMultiPlayerOrSpec
|
||||||
|
and not gGameApp.Game.Params.IsMapEditor
|
||||||
|
and not gGameApp.Game.IsPaused;
|
||||||
|
|
||||||
|
//Pause the game
|
||||||
|
if wasRunning then
|
||||||
|
gGameApp.Game.IsPaused := True;
|
||||||
|
|
||||||
|
//Ask the Player
|
||||||
|
{$IF DEFINED(MSWindows)}
|
||||||
|
//MessageBox works best in Windows (gets stuck under main form less)
|
||||||
|
aCanClose := MessageBox( fFormMain.Handle,
|
||||||
|
PChar(gResTexts[TX_EXIT_WARN_MESSAGE]),
|
||||||
|
PChar(gResTexts[TX_EXIT_WARN_HEADER]),
|
||||||
|
MB_YESNO or MB_ICONWARNING or MB_SETFOREGROUND or MB_TASKMODAL
|
||||||
|
) = IDYES;
|
||||||
|
{$ELSEIF DEFINED(Unix)}
|
||||||
|
aCanClose := MessageDlg(gResTexts[TX_EXIT_WARN_MESSAGE], mtWarning, [mbYes, mbNo], 0) = mrYes;
|
||||||
|
{$ELSE}
|
||||||
|
{$ERROR Unsupported case. Please, implement the function}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
//Resume the game
|
||||||
|
if not aCanClose and wasRunning then
|
||||||
|
gGameApp.Game.IsPaused := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.Stop(Sender: TObject);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
gLog.AddTime('Stopping game application...');
|
||||||
|
FreeThenNil(gSystem);
|
||||||
|
//Reset the resolution
|
||||||
|
FreeThenNil(fResolutions);
|
||||||
|
|
||||||
|
if fMapCacheUpdater <> nil then
|
||||||
|
fMapCacheUpdater.Stop;
|
||||||
|
|
||||||
|
// Save Keys settings before destruction of gGameApp, since gResKeys, gResTexts, gResKeyFuncs are used when save to xml
|
||||||
|
gKeySettings.SaveToXML;
|
||||||
|
|
||||||
|
FreeThenNil(gGameApp);
|
||||||
|
// Destroy gGameAppSettings after GameApp is destroyed, since gGameSettings could be used during destruction
|
||||||
|
FreeThenNil(gGameAppSettings);
|
||||||
|
|
||||||
|
FreeThenNil(gLog);
|
||||||
|
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
TimeEndPeriod(1);
|
||||||
|
ClipCursor(nil); //Release the cursor restriction
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
// We could have been asked to close by MainForm or from other place (e.g. MainMenu Exit button)
|
||||||
|
// In first case Form will take care about closing itself
|
||||||
|
|
||||||
|
// Do not call gMain.Stop from FormClose handler again
|
||||||
|
fFormMain.OnClose := nil;
|
||||||
|
|
||||||
|
if Assigned(gVideoPlayer) then
|
||||||
|
gVideoPlayer.Free;
|
||||||
|
|
||||||
|
// fFormMain.DevSettingsSave; Moved into MainForm itself, since it's purely MainForms business. Rest of the app should know nothing about it
|
||||||
|
|
||||||
|
if Sender <> fFormMain then
|
||||||
|
fFormMain.Close;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
gLog.AddTime('Exception while closing game app: ' + E.Message
|
||||||
|
{$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF});
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
//Apply the cursor restriction when alt-tabbing back
|
||||||
|
procedure TKMMain.DoRestore(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if Application.Active and (gMainSettings <> nil) then
|
||||||
|
ApplyCursorRestriction; //Cursor restriction is lost when alt-tabbing out, so we need to apply it again
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.DoActivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if Application.Active then
|
||||||
|
gSystem.FlashingStop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.DoDeactivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
//Occurs during Toggle to fullscreen, should be ignored
|
||||||
|
if Application.Active then Exit;
|
||||||
|
|
||||||
|
//Prevent the game window from being in the way by minimizing when alt-tabbing
|
||||||
|
if (gMainSettings <> nil) and gMainSettings.FullScreen then
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
ClipCursor(nil); //Remove all cursor clipping just in case Windows doesn't automatically
|
||||||
|
{$ENDIF}
|
||||||
|
Application.Minimize;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.UpdateFPS(latestFrameTime: Cardinal);
|
||||||
|
var
|
||||||
|
fpsLag: Integer;
|
||||||
|
begin
|
||||||
|
if gMainSettings <> nil then //gMainSettings could be nil on Game Exit ?? Just check if its not nil
|
||||||
|
begin
|
||||||
|
Inc(fOldFrameTimes, latestFrameTime);
|
||||||
|
Inc(fFrameCount);
|
||||||
|
if fOldFrameTimes >= FPS_INTERVAL then
|
||||||
|
begin
|
||||||
|
fFPS := 1000 / (fOldFrameTimes / fFrameCount);
|
||||||
|
if gGameApp <> nil then
|
||||||
|
gGameApp.SendFPSMeasurement(Round(fFPS));
|
||||||
|
|
||||||
|
fpsLag := 1000 div gMainSettings.FPSCap;
|
||||||
|
fFPSString := Format('%.1f FPS', [fFPS]) + IfThen(CAP_MAX_FPS, ' (cap ' + IntToStr(fpsLag) + 'ms)');
|
||||||
|
HandleStatusBarText(spFPS, fFPSString);
|
||||||
|
fOldFrameTimes := 0;
|
||||||
|
fFrameCount := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.GetRenderInterval: Cardinal;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
if CAP_MAX_FPS and (gMainSettings <> nil) then
|
||||||
|
Result := 1000 div gMainSettings.FPSCap;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.DoRender;
|
||||||
|
var renderDelta: Cardinal;
|
||||||
|
begin
|
||||||
|
renderDelta := TimeSince(fLastRenderTime);
|
||||||
|
fLastRenderTime := TimeGet;
|
||||||
|
UpdateFPS(renderDelta);
|
||||||
|
|
||||||
|
gGameApp.UpdateStateIdle(renderDelta);
|
||||||
|
gGameApp.Render;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.SleepUntilNextSchedule;
|
||||||
|
var
|
||||||
|
nextTime, nextRender, nextTick, timeNow, sleepTime, renderInterval: Cardinal;
|
||||||
|
begin
|
||||||
|
renderInterval := GetRenderInterval;
|
||||||
|
|
||||||
|
nextRender := AddWithOverflow(fRenderSchedule, renderInterval);
|
||||||
|
nextTick := AddWithOverflow(fTickSchedule, fGameTickInterval);
|
||||||
|
|
||||||
|
if nextRender > nextTick then
|
||||||
|
nextTime := nextRender
|
||||||
|
else
|
||||||
|
nextTime := nextTick;
|
||||||
|
|
||||||
|
timeNow := TimeGet;
|
||||||
|
if nextTime > timeNow then
|
||||||
|
begin
|
||||||
|
sleepTime := nextTime - timeNow;
|
||||||
|
//Check for TimeGet overflow (never sleep longer than the render interval)
|
||||||
|
if sleepTime < renderInterval then
|
||||||
|
Sleep(sleepTime);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.ForcedRenderRequired: Boolean;
|
||||||
|
begin
|
||||||
|
Result := (gMainSettings <> nil)
|
||||||
|
and gMainSettings.IsNoRenderMaxTimeSet
|
||||||
|
and (TimeSince(fLastRenderTime) > gMainSettings.NoRenderMaxTime);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.DoIdle(Sender: TObject; var Done: Boolean);
|
||||||
|
|
||||||
|
function CalculateSchedule(aLastTime, aTimeSince, aInterval: Cardinal): Cardinal;
|
||||||
|
var
|
||||||
|
ticksBehind: Cardinal;
|
||||||
|
begin
|
||||||
|
ticksBehind := (aTimeSince div aInterval);
|
||||||
|
Result := AddWithOverflow(aLastTime, ticksBehind*aInterval);
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
MAX_TIME_BETWEEN_RENDERS = 1000; //Render at least 1 FPS
|
||||||
|
UI_UPDATE_INTERVAL = 100;
|
||||||
|
var
|
||||||
|
renderInterval, timeSinceRender, timeSinceTick, timeSinceUpdateUI: Cardinal;
|
||||||
|
begin
|
||||||
|
Done := False; //Repeats OnIdle asap without performing Form-specific idle code
|
||||||
|
|
||||||
|
if gGameApp = nil then
|
||||||
|
begin
|
||||||
|
Sleep(10);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if CHECK_8087CW then
|
||||||
|
//$1F3F is used to mask out reserved/undefined bits
|
||||||
|
Assert((Get8087CW and $1F3F = $133F), '8087CW is wrong');
|
||||||
|
|
||||||
|
//Some PCs seem to change 8087CW randomly between events like Timers and OnMouse*,
|
||||||
|
//so we need to set it right before we do game logic processing
|
||||||
|
Set8087CW($133F);
|
||||||
|
|
||||||
|
//Priority 1. Do we need to tick?
|
||||||
|
timeSinceTick := TimeSince(fTickSchedule);
|
||||||
|
if (timeSinceTick >= fGameTickInterval) and not ForcedRenderRequired then
|
||||||
|
begin
|
||||||
|
gGameApp.DoGameTick;
|
||||||
|
fTickSchedule := CalculateSchedule(fTickSchedule, timeSinceTick, fGameTickInterval);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
//Priority 2. UI update and render
|
||||||
|
timeSinceUpdateUI := TimeSince(fUpdateStateSchedule);
|
||||||
|
if timeSinceUpdateUI >= UI_UPDATE_INTERVAL then
|
||||||
|
begin
|
||||||
|
gGameApp.UpdateState;
|
||||||
|
fUpdateStateSchedule := CalculateSchedule(fUpdateStateSchedule, timeSinceUpdateUI, UI_UPDATE_INTERVAL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
renderInterval := GetRenderInterval;
|
||||||
|
if renderInterval > 0 then
|
||||||
|
begin
|
||||||
|
timeSinceRender := TimeSince(fRenderSchedule);
|
||||||
|
if timeSinceRender >= renderInterval then
|
||||||
|
begin
|
||||||
|
DoRender;
|
||||||
|
fRenderSchedule := CalculateSchedule(fRenderSchedule, timeSinceRender, renderInterval);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
SleepUntilNextSchedule;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
DoRender; //No FPS cap so always render
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
// Check game execution dir generic permissions
|
||||||
|
function TKMMain.DoHaveGenericPermission: Boolean;
|
||||||
|
const
|
||||||
|
GRANTED: array[Boolean] of string = ('blocked', 'granted');
|
||||||
|
var
|
||||||
|
readAcc, writeAcc, execAcc, dirWritable: Boolean;
|
||||||
|
begin
|
||||||
|
CheckFolderPermission(ExeDir, readAcc, writeAcc, execAcc);
|
||||||
|
|
||||||
|
dirWritable := IsDirectoryWriteable(ExeDir);
|
||||||
|
|
||||||
|
gLog.AddTime('Checking game folder "%s" generic permissions: READ: %s; WRITE: %s; EXECUTE: %s; folder is writable: %s',
|
||||||
|
[ExeDir, GRANTED[readAcc], GRANTED[writeAcc], GRANTED[execAcc], BoolToStr(dirWritable, True)]);
|
||||||
|
|
||||||
|
Result := dirWritable and readAcc and writeAcc and execAcc;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.ReinitRender(aReturnToOptions: Boolean): Boolean;
|
||||||
|
|
||||||
|
procedure ShowPermissionsError;
|
||||||
|
begin
|
||||||
|
SKIP_RENDER := True; // Skip render, since gGameApp will show panels on FullScreen mode
|
||||||
|
fFormLoading.Hide; //Will close the form on Full Screen mode
|
||||||
|
fFormMain.Hide;
|
||||||
|
gMusic.Stop;
|
||||||
|
fFormMain.ShowFolderPermissionError; // Show localized error message
|
||||||
|
Stop(nil); // Stop the app
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
if gMainSettings.FullScreen then
|
||||||
|
begin
|
||||||
|
// Lock window params while we are in FullScreen mode
|
||||||
|
gMainSettings.WindowParams.LockParams;
|
||||||
|
if fResolutions.IsValid(gMainSettings.Resolution) then
|
||||||
|
fResolutions.SetResolution(gMainSettings.Resolution)
|
||||||
|
else
|
||||||
|
gMainSettings.FullScreen := False;
|
||||||
|
end else
|
||||||
|
fResolutions.Restore;
|
||||||
|
|
||||||
|
fFormLoading.Position := poScreenCenter;
|
||||||
|
|
||||||
|
// Will show windowed form and play videos
|
||||||
|
// Should be made before GameApp creation, otherwise window position will not be set correctly
|
||||||
|
// (its prbably because it will be overwritten, on gGameApp creation)
|
||||||
|
if not gMainSettings.FullScreen then
|
||||||
|
fFormMain.ShowInWindow;
|
||||||
|
|
||||||
|
//It's required to re-init whole OpenGL related things when RC gets toggled fullscreen
|
||||||
|
FreeThenNil(gGameApp); //Saves all settings into ini file in midst
|
||||||
|
gGameApp := TKMGameApp.Create(fFormMain.RenderArea,
|
||||||
|
fFormMain.RenderArea.Width,
|
||||||
|
fFormMain.RenderArea.Height,
|
||||||
|
gMainSettings.VSync,
|
||||||
|
fFormLoading.LoadingStep,
|
||||||
|
fFormLoading.LoadingText,
|
||||||
|
HandleStatusBarText);
|
||||||
|
|
||||||
|
// Will show fullscreen form and play videos
|
||||||
|
// We need to start it after GameApp creation, since we need gResLocales to load proper video file by loaded locale
|
||||||
|
if gMainSettings.FullScreen then
|
||||||
|
fFormMain.ShowFullscreen;
|
||||||
|
|
||||||
|
// Check if player has all permissions on game folder. Close the app if not
|
||||||
|
// Check is done after gGameApp creating because we want to load texts first to show traslated error message
|
||||||
|
//todo -cComplicated: refactor. Separate folder permissions check and render initialization
|
||||||
|
// Locale and texts could be loaded separetely to show proper translated error message
|
||||||
|
try
|
||||||
|
if (gLog = nil)
|
||||||
|
or (not aReturnToOptions and not DoHaveGenericPermission) then
|
||||||
|
begin
|
||||||
|
ShowPermissionsError;
|
||||||
|
Exit(False); // Stop the app
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
// but it seems like Exit alone doesn't work - try-except block does
|
||||||
|
ShowPermissionsError;
|
||||||
|
Exit(False); // Stop the app
|
||||||
|
end;
|
||||||
|
|
||||||
|
gGameApp.OnGameSpeedActualChange := GameSpeedChange;
|
||||||
|
gGameApp.AfterConstruction(aReturnToOptions);
|
||||||
|
|
||||||
|
//Preload game resources while in menu to make 1st game start faster
|
||||||
|
gGameApp.PreloadGameResources;
|
||||||
|
|
||||||
|
gGameApp.OnOptionsChange := fFormMain.ControlsRefill;
|
||||||
|
fFormMain.OnControlsUpdated := gGameApp.DebugControlsUpdated;
|
||||||
|
|
||||||
|
gLog.AddTime('ToggleFullscreen');
|
||||||
|
gLog.AddTime('Form Width/Height: %dx%d', [fFormMain.Width, fFormMain.Height]);
|
||||||
|
gLog.AddTime('Panel Width/Height: %dx%d', [fFormMain.RenderArea.Width, fFormMain.RenderArea.Height]);
|
||||||
|
|
||||||
|
//Hide'n'show will make form go ontop of taskbar
|
||||||
|
fFormMain.Hide;
|
||||||
|
fFormMain.Show;
|
||||||
|
|
||||||
|
ForceResize; //Force everything to resize
|
||||||
|
|
||||||
|
// Unlock window params if are no longer in FullScreen mode
|
||||||
|
if not gMainSettings.FullScreen then
|
||||||
|
gMainSettings.WindowParams.UnlockParams;
|
||||||
|
|
||||||
|
ApplyCursorRestriction;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.LockMutex: Boolean;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
if not BLOCK_DUPLICATE_APP then Exit;
|
||||||
|
|
||||||
|
fMutex := CreateMutex(nil, True, PChar(KAM_MUTEX));
|
||||||
|
|
||||||
|
if fMutex = 0 then
|
||||||
|
RaiseLastOSError;
|
||||||
|
|
||||||
|
Result := (GetLastError <> ERROR_ALREADY_EXISTS);
|
||||||
|
|
||||||
|
if not Result then
|
||||||
|
// Close our own handle on the mutex because someone else already made the mutex
|
||||||
|
UnlockMutex;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.UnlockMutex;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
if not BLOCK_DUPLICATE_APP then Exit;
|
||||||
|
if fMutex = 0 then Exit; //Didn't have a mutex lock
|
||||||
|
CloseHandle(fMutex);
|
||||||
|
fMutex := 0;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.MapCacheUpdate;
|
||||||
|
begin
|
||||||
|
// Thread frees itself automatically
|
||||||
|
fMapCacheUpdater := TTMapsCacheUpdater.Create([mkSP, mkMP, mkDL]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.IsDebugChangeAllowed: Boolean;
|
||||||
|
begin
|
||||||
|
Result := (gGameApp.Game = nil)
|
||||||
|
or not gGameApp.Game.Params.IsMultiPlayerOrSpec
|
||||||
|
or MULTIPLAYER_CHEATS;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.ClientRect(aPixelsCntToReduce: Integer = 0): TRect;
|
||||||
|
begin
|
||||||
|
Result := fFormMain.RenderArea.ClientRect;
|
||||||
|
Result.TopLeft := ClientToScreen(Result.TopLeft);
|
||||||
|
Result.TopLeft.X := Result.TopLeft.X + aPixelsCntToReduce;
|
||||||
|
Result.TopLeft.Y := Result.TopLeft.Y + aPixelsCntToReduce;
|
||||||
|
Result.BottomRight := ClientToScreen(Result.BottomRight);
|
||||||
|
Result.BottomRight.X := Result.BottomRight.X - aPixelsCntToReduce;
|
||||||
|
Result.BottomRight.Y := Result.BottomRight.Y - aPixelsCntToReduce;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.ClientToScreen(aPoint: TPoint): TPoint;
|
||||||
|
begin
|
||||||
|
Result := fFormMain.RenderArea.ClientToScreen(aPoint);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
//Can be invalid very breifly if you change resolutions (this is possible in Windowed mode)
|
||||||
|
function TKMMain.GetScreenBounds(out aBounds: TRect): Boolean;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
try
|
||||||
|
aBounds := Classes.Rect(-1,-1,-1,-1);
|
||||||
|
fFormMain.Monitor; //This forces Delphi to reload Screen.Monitors (only if necessary) and so fixes crashes when using multiple monitors
|
||||||
|
//Maximized is a special case, it can only be on one monitor. This is required because when maximized form.left = -9 (on Windows 7 anyway)
|
||||||
|
if fFormMain.WindowState = wsMaximized then
|
||||||
|
begin
|
||||||
|
for I := 0 to Screen.MonitorCount-1 do
|
||||||
|
//Find the monitor with the left closest to the left of the form
|
||||||
|
if (I = 0)
|
||||||
|
or ((Abs(fFormMain.Left - Screen.Monitors[I].Left) <= Abs(fFormMain.Left - aBounds.Left)) and
|
||||||
|
(Abs(fFormMain.Top - Screen.Monitors[I].Top ) <= Abs(fFormMain.Top - aBounds.Top))) then
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
aBounds.Left := Screen.Monitors[I].Left;
|
||||||
|
aBounds.Right := Screen.Monitors[I].Width+Screen.Monitors[I].Left;
|
||||||
|
aBounds.Top := Screen.Monitors[I].Top;
|
||||||
|
aBounds.Bottom:= Screen.Monitors[I].Height+Screen.Monitors[I].Top;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
for I:=0 to Screen.MonitorCount-1 do
|
||||||
|
//See if our form is within the boundaries of this monitor (I.e. when it is not outside the boundaries)
|
||||||
|
if not ((fFormMain.Left >= Screen.Monitors[I].Width + Screen.Monitors[I].Left) or
|
||||||
|
(fFormMain.Width + fFormMain.Left <= Screen.Monitors[I].Left) or
|
||||||
|
(fFormMain.Top >= Screen.Monitors[I].Height + Screen.Monitors[I].Top) or
|
||||||
|
(fFormMain.Height + fFormMain.Top <= Screen.Monitors[I].Top)) then
|
||||||
|
begin
|
||||||
|
if not Result then
|
||||||
|
begin
|
||||||
|
//First time we have to initialise the result
|
||||||
|
Result := True;
|
||||||
|
aBounds.Left := Screen.Monitors[I].Left;
|
||||||
|
aBounds.Right := Screen.Monitors[I].Width+Screen.Monitors[I].Left;
|
||||||
|
aBounds.Top := Screen.Monitors[I].Top;
|
||||||
|
aBounds.Bottom:= Screen.Monitors[I].Height+Screen.Monitors[I].Top;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
//After the first time we compare it with the previous result and take the largest possible area
|
||||||
|
aBounds.Left := Math.Min(aBounds.Left, Screen.Monitors[I].Left);
|
||||||
|
aBounds.Right := Math.Max(aBounds.Right, Screen.Monitors[I].Width+Screen.Monitors[I].Left);
|
||||||
|
aBounds.Top := Math.Min(aBounds.Top, Screen.Monitors[I].Top);
|
||||||
|
aBounds.Bottom:= Math.Max(aBounds.Bottom,Screen.Monitors[I].Height+Screen.Monitors[I].Top);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
gLog.AddTime('Exception in TKMMain.GetScreenBounds: ' + E.Message
|
||||||
|
{$IFDEF WDC} + sLineBreak + E.StackTrace {$ENDIF});
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TKMMain.IsFormActive: Boolean;
|
||||||
|
begin
|
||||||
|
Result := fFormMain.Active;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.Render;
|
||||||
|
begin
|
||||||
|
if Self = nil then Exit;
|
||||||
|
|
||||||
|
gGameApp.Render;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
//Force everything to resize
|
||||||
|
procedure TKMMain.ForceResize;
|
||||||
|
begin
|
||||||
|
Resize(fFormMain.RenderArea.Width, fFormMain.RenderArea.Height);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.Resize(aWidth, aHeight: Integer);
|
||||||
|
begin
|
||||||
|
if Self = nil then Exit;
|
||||||
|
|
||||||
|
gGameApp.Resize(aWidth, aHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.Resize(aWidth, aHeight: Integer; const aWindowParams: TKMWindowParamsRecord);
|
||||||
|
begin
|
||||||
|
if gGameApp = nil then Exit;
|
||||||
|
|
||||||
|
gGameApp.Resize(aWidth, aHeight);
|
||||||
|
UpdateWindowParams(aWindowParams);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.Move(const aWindowParams: TKMWindowParamsRecord);
|
||||||
|
begin
|
||||||
|
if Self = nil then Exit;
|
||||||
|
|
||||||
|
UpdateWindowParams(aWindowParams);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.UpdateWindowParams(const aWindowParams: TKMWindowParamsRecord);
|
||||||
|
begin
|
||||||
|
if gGameApp = nil then Exit;
|
||||||
|
if gMainSettings.WindowParams = nil then Exit; //just in case...
|
||||||
|
|
||||||
|
gMainSettings.WindowParams.ApplyWindowParams(aWindowParams);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.SetGameTickInterval(aInterval: Cardinal);
|
||||||
|
begin
|
||||||
|
if Self = nil then Exit; // Could be nil in Runner
|
||||||
|
|
||||||
|
fGameTickInterval := aInterval;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TKMMain.ShowAbout;
|
||||||
|
begin
|
||||||
|
if Self = nil then Exit;
|
||||||
|
|
||||||
|
fFormLoading.Position := poScreenCenter;
|
||||||
|
fFormLoading.Bar1.Position := 0;
|
||||||
|
fFormLoading.Label1.Caption := '';
|
||||||
|
fFormLoading.FormStyle := fsStayOnTop;
|
||||||
|
fFormLoading.Show;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
//Restrict cursor movement in fullscreen mode
|
||||||
|
//For multiple monitors, it's very annoying if you play a fullscreen game and your cursor slides
|
||||||
|
//onto second monitor instead of stopping at the edge as expected.
|
||||||
|
procedure TKMMain.ApplyCursorRestriction;
|
||||||
|
var
|
||||||
|
rect: TRect;
|
||||||
|
begin
|
||||||
|
//This restriction is removed when alt-tabbing out, and added again when alt-tabbing back
|
||||||
|
{$IFDEF MSWindows}
|
||||||
|
if gMainSettings.FullScreen then
|
||||||
|
begin
|
||||||
|
rect := fFormMain.BoundsRect;
|
||||||
|
ClipCursor(@rect);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ClipCursor(nil); //Otherwise have no restriction
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -36,7 +36,6 @@ const
|
|||||||
{$IFDEF DEBUG} + ' [DEBUG]' {$ENDIF}
|
{$IFDEF DEBUG} + ' [DEBUG]' {$ENDIF}
|
||||||
{$IFDEF WDC64} + ' [x64]' {$ENDIF}
|
{$IFDEF WDC64} + ' [x64]' {$ENDIF}
|
||||||
{$IFDEF DBG_RNG_SPY} + ' [RNGSPY]' {$ENDIF}
|
{$IFDEF DBG_RNG_SPY} + ' [RNGSPY]' {$ENDIF}
|
||||||
{$IFDEF DBG_PERFLOG} + ' [PERFLOG]' {$ENDIF}
|
|
||||||
;
|
;
|
||||||
|
|
||||||
GAME_VERSION_PREFIX = ''; // Custom prefix for the test builds
|
GAME_VERSION_PREFIX = ''; // Custom prefix for the test builds
|
||||||
@@ -182,68 +181,14 @@ var
|
|||||||
AGGRESSIVE_REPLAYS :Boolean = True; //Write a command gicTempDoNothing every tick in order to find exactly when a replay mismatch occurs
|
AGGRESSIVE_REPLAYS :Boolean = True; //Write a command gicTempDoNothing every tick in order to find exactly when a replay mismatch occurs
|
||||||
SHOW_GAME_TICK :Boolean = DEBUG_CFG; //Show game tick next to game time
|
SHOW_GAME_TICK :Boolean = DEBUG_CFG; //Show game tick next to game time
|
||||||
SHOW_FPS :Boolean = False; //Show FPS
|
SHOW_FPS :Boolean = False; //Show FPS
|
||||||
SHOW_TERRAIN_IDS :Boolean = False; //Show number of every tile terrain on it (also show layers terrain ids)
|
|
||||||
SKIP_TER_RENDER_ANIMS :Boolean = False; //Skip render terrain animations
|
|
||||||
SKIP_TER_RENDER_LIGHT :Boolean = False; //Skip render terrain lighting
|
|
||||||
SKIP_TER_RENDER_SHADOW :Boolean = False; //Skip render terrain shadows
|
|
||||||
DO_DEBUG_TER_RENDER :Boolean = False; //Do we do debug terrain layers? If yes, then only chosen terrain layers will be rendered
|
|
||||||
DEBUG_TERRAIN_LAYERS :set of Byte = [0,1,2,3]; //Terrain layers to render while debugging with DO_DEBUG_LAYERS
|
|
||||||
SKIP_RENDER_TER_LAYERS :Boolean = False; //Do not render terrain layers
|
|
||||||
SHOW_TERRAIN_KINDS :Boolean = False; //Show terrain kind ids on every tile corner
|
|
||||||
SHOW_TERRAIN_OVERLAYS :Boolean = False; //Show terrain tile overlays
|
|
||||||
SHOW_TERRAIN_HEIGHT :Boolean = False; //Show terrain tile overlays
|
|
||||||
SHOW_TERRAIN_TILES_GRID :Boolean = False; //Show terrain tiles grid
|
SHOW_TERRAIN_TILES_GRID :Boolean = False; //Show terrain tiles grid
|
||||||
SHOW_BRUSH_APPLY_AREA :Boolean = False; //Show brushes apply area
|
|
||||||
SHOW_TERRAIN_WIRES :Boolean = False; //Makes terrain height visible
|
|
||||||
SHOW_TERRAIN_PASS :Byte = 0; //Byte(TKMTerrainPassability)
|
SHOW_TERRAIN_PASS :Byte = 0; //Byte(TKMTerrainPassability)
|
||||||
SHOW_UNIT_ROUTES :Boolean = False; //Draw unit routes
|
|
||||||
SHOW_UNIT_ROUTES_STEPS :Boolean = False; //Draw unit routes step numbers
|
|
||||||
SHOW_SEL_BUFFER :Boolean = False; //Display selection buffer
|
|
||||||
SHOW_PROJECTILES :Boolean = False; //Shows projectiles trajectory
|
|
||||||
SHOW_POINTER_DOTS :Boolean = False; //Show pointer count as small dots below unit/houses
|
|
||||||
SHOW_GROUND_LINES :Boolean = False; //Show a line below all sprites to mark the ground height used in Z-Order
|
|
||||||
SHOW_UNIT_MOVEMENT :Boolean = False; //Draw unit movement overlay (occupied tile), Only if unit interaction enabled
|
|
||||||
SHOW_VIEWPORT_POS :Boolean = False; //Draw viewport position
|
|
||||||
SHOW_JAM_METER :Boolean = False; //Show jam meter value on terrain
|
|
||||||
SHOW_TILE_OBJECT_ID :Boolean = False; //Show tiles object ID
|
|
||||||
SHOW_TILES_OWNER :Boolean = False; //Show tiles owner
|
SHOW_TILES_OWNER :Boolean = False; //Show tiles owner
|
||||||
SHOW_TREE_AGE :Boolean = False; //Show tiles tree age
|
|
||||||
SHOW_FIELD_AGE :Boolean = False; //Show tiles field age
|
|
||||||
SHOW_TILE_LOCK :Boolean = False; //Show tiles lock
|
|
||||||
SHOW_TILE_UNIT :Boolean = False; //Show tiles units
|
|
||||||
SHOW_VERTEX_UNIT :Boolean = False; //Show vertex unit (if vertex is occupied)
|
|
||||||
SHOW_UIDs :Boolean = False; //Show units/groups/houses UIDs
|
|
||||||
SHOW_WALK_CONNECT :Boolean = False; //Show floodfill areas of interconnected areas
|
|
||||||
SHOW_GROUP_MEMBERS_POS :Boolean = False; //Show group members position
|
|
||||||
TEST_VIEW_CLIP_INSET :Boolean = False; //Renders smaller area to see if everything gets clipped well
|
|
||||||
SHOW_ATTACK_RADIUS :Boolean = False; //Render towers/archers attack radius
|
SHOW_ATTACK_RADIUS :Boolean = False; //Render towers/archers attack radius
|
||||||
DISPLAY_SOUNDS :Boolean = False; //Display sounds on map
|
|
||||||
RENDER_3D :Boolean = False; //Experimental 3D render
|
RENDER_3D :Boolean = False; //Experimental 3D render
|
||||||
HOUSE_BUILDING_STEP :Single = 0;
|
|
||||||
WATER_LIGHT_MULTIPLIER :Single = DEFAULT_WATER_LIGHT_MULTIPLIER; //Terrain light multiplier
|
|
||||||
OVERLAY_NAVMESH :Boolean = False; //Show navmesh
|
|
||||||
OVERLAY_HIGHLIGHT_POLY :Integer = 0; //Highlight plygon in navmesh
|
|
||||||
OVERLAY_DEFENCES :Boolean = False; //Show AI defence perimeters
|
|
||||||
OVERLAY_DEFENCES_A :Boolean = False; //Show AI defence perimeters (Animation)
|
|
||||||
OVERLAY_INFLUENCE :Boolean = False; //Show influence map
|
|
||||||
OVERLAY_OWNERSHIP :Boolean = False; //Show ownership map
|
|
||||||
OVERLAY_AVOID :Boolean = False; //Show avoidance map
|
|
||||||
OVERLAY_AI_BUILD :Boolean = False; //Show build progress of new AI
|
|
||||||
OVERLAY_AI_COMBAT :Boolean = False; //Show combat marks of new AI
|
|
||||||
OVERLAY_AI_PATHFINDING :Boolean = False; //Show combat marks of new AI
|
|
||||||
OVERLAY_AI_EYE :Boolean = False; //Show Eye vision of new AI
|
|
||||||
OVERLAY_AI_SOIL :Boolean = False; //Show Soil vision of new AI
|
|
||||||
OVERLAY_AI_FLATAREA :Boolean = False; //Show FlatArea vision of new AI
|
|
||||||
OVERLAY_AI_ROUTES :Boolean = False; //Show Routes to resources vision of new AI
|
|
||||||
OVERLAY_AI_SUPERVISOR :Boolean = False; //Show Supervisor vision of new AI
|
|
||||||
OVERLAY_AI_VEC_FLD_ENEM :Boolean = False; //Show Vector field of enemy (combat AI)
|
|
||||||
OVERLAY_AI_VEC_FLD_ALLY :Boolean = False; //Show Vector field of ally (combat AI)
|
|
||||||
OVERLAY_AI_CLUSTERS :Boolean = False; //Show combat clusters (combat AI)
|
|
||||||
OVERLAY_AI_ALLIEDGROUPS :Boolean = False; //Show show allied groups (combat AI)
|
|
||||||
{Render}
|
{Render}
|
||||||
SAVE_MAP_TO_FBO_RENDER :Boolean = False; //Do Render is performed into FBO off-screen buffer?
|
SAVE_MAP_TO_FBO_RENDER :Boolean = False; //Do Render is performed into FBO off-screen buffer?
|
||||||
{Stats}
|
{Stats}
|
||||||
SHOW_SPRITE_COUNT :Boolean = False; //display rendered controls/sprites count
|
|
||||||
SHOW_POINTER_COUNT :Boolean = False; //Show debug total count of unit/house pointers being tracked
|
SHOW_POINTER_COUNT :Boolean = False; //Show debug total count of unit/house pointers being tracked
|
||||||
SHOW_CMDQUEUE_COUNT :Boolean = False; //Show how many commands were processed and stored by TGameInputProcess
|
SHOW_CMDQUEUE_COUNT :Boolean = False; //Show how many commands were processed and stored by TGameInputProcess
|
||||||
SHOW_NETWORK_DELAY :Boolean = False; //Show the current delay in multiplayer game
|
SHOW_NETWORK_DELAY :Boolean = False; //Show the current delay in multiplayer game
|
||||||
|
|||||||
Reference in new issue
Block a user