This commit is contained in:
1 parent
d8360d49e5
commit
f71802c885
5 files changed
+1037
-103
No files matched your search
@@ -1,6 +1,7 @@
|
||||
{
|
||||
"schema": "kam-source-resolution/1",
|
||||
"adaptations": [
|
||||
"KaM_Remake.inc",
|
||||
"src/utils/io/KM_FileIO.pas",
|
||||
"src/common/KM_CommonClasses.pas",
|
||||
"src/settings/KM_GameSettings.pas",
|
||||
@@ -20,6 +21,7 @@
|
||||
"src/res/KM_ResLocales.pas",
|
||||
"src/render/KM_Render.pas",
|
||||
"src/KM_GameApp.pas",
|
||||
"src/KM_Main.pas",
|
||||
"src/res/KM_Resource.pas",
|
||||
"src/common/KM_Defaults.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);
|
||||
function GetActiveInterface: TKMUserInterfaceCommon;
|
||||
|
||||
procedure UpdatePerflog;
|
||||
public
|
||||
constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
|
||||
aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
|
||||
@@ -173,9 +172,8 @@ uses
|
||||
KM_GameSavePoints,
|
||||
KM_Cursor, KM_ResTexts, KM_ResKeys, KM_ResTypes,
|
||||
KM_IoGraphicUtils, KM_Settings,
|
||||
KM_Saves, KM_CommonUtils, KM_CommonShellUtils,
|
||||
{$IFDEF DBG_RNG_SPY}KM_RandomChecks,{$ENDIF}
|
||||
KM_DevPerfLog, KM_DevPerfLogTypes;
|
||||
KM_Saves, KM_CommonUtils
|
||||
{$IFDEF DBG_RNG_SPY}, KM_RandomChecks{$ENDIF};
|
||||
|
||||
|
||||
{ TKMGameApp }
|
||||
@@ -1231,30 +1229,15 @@ begin
|
||||
|
||||
gRender.BeginFrame;
|
||||
|
||||
{$IFDEF DBG_PERFLOG}
|
||||
gPerfLogs.StackGFX.FrameBegin;
|
||||
gPerfLogs.SectionEnter(psFrameFullG);
|
||||
if gVideoPlayer.IsActive then
|
||||
gVideoPlayer.Paint
|
||||
else
|
||||
if gGame <> nil then
|
||||
gGame.Render(gRender)
|
||||
else
|
||||
fMainMenuInterface.Paint;
|
||||
|
||||
try
|
||||
{$ENDIF}
|
||||
if gVideoPlayer.IsActive then
|
||||
gVideoPlayer.Paint
|
||||
else
|
||||
if gGame <> nil then
|
||||
gGame.Render(gRender)
|
||||
else
|
||||
fMainMenuInterface.Paint;
|
||||
|
||||
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.RenderBrightness(gGameSettings.GFX.Brightness);
|
||||
|
||||
gRender.EndFrame;
|
||||
gRender.Query.QueriesSwapBuffers;
|
||||
@@ -1369,26 +1352,6 @@ begin
|
||||
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;
|
||||
begin
|
||||
if fIsLoading then Exit; //Don't update while toggling locale
|
||||
@@ -1425,7 +1388,6 @@ begin
|
||||
fOnStatusBarUpdate(spTime, 'Time: ' + TimeToString(gGame.MissionTime));
|
||||
end;
|
||||
|
||||
UpdatePerflog;
|
||||
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 WDC64} + ' [x64]' {$ENDIF}
|
||||
{$IFDEF DBG_RNG_SPY} + ' [RNGSPY]' {$ENDIF}
|
||||
{$IFDEF DBG_PERFLOG} + ' [PERFLOG]' {$ENDIF}
|
||||
;
|
||||
|
||||
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
|
||||
SHOW_GAME_TICK :Boolean = DEBUG_CFG; //Show game tick next to game time
|
||||
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_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_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_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
|
||||
DISPLAY_SOUNDS :Boolean = False; //Display sounds on map
|
||||
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}
|
||||
SAVE_MAP_TO_FBO_RENDER :Boolean = False; //Do Render is performed into FBO off-screen buffer?
|
||||
{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_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
|
||||
|
||||
Reference in new issue
Block a user