{
    This file is part of Chentrah,
    Copyright (C) 2004-2008 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************
 
    This unit is a placeholder for most of the mother module functions
      composed C-style from various include files

 **********************************************************************}

{$macro on}
{$longstrings on}
{$codepage utf-8}

unit cge;

{$define cge}
{$define cgekernel} // should be "mothermodule" now but I'm too lazy to change it.

{$ifdef darwin}
  {$linkframework AGL} //MacOS X specific mumbo-jumbo. I don't understand it myself.
  {$linkframework Carbon}
  {$define use_dynlibs}
{$endif}

{$ifdef windows}
  {$define use_dynlibs} {MacosX is unix, but I employ the unit "dynlibs" there,
    using the cross-platform LoadLibrary() from FPC RTL.
    But I still use native dl in Linux.}
{$endif}


interface
   uses
       {$ifdef unix}
         cthreads,
       {$endif}
         SysUtils
       , typinfo
       {$ifdef cpu32}
        , chelinfo
       {$else}
        {$ifndef buildmein}{$fatal Targets other than Win32 must only use builtin module}{$endif}
        , lineinfo
       {$endif}
       , ctypes
        {$ifdef unix}
          {$ifdef darwin}
            //Mind you, the Mac port was never finished. I moved onto a new job
            //  and lost my access to the Macs hosted at my old job --
            //  just as I began the porting.
            //I'd never buy one for myself as a Mac is a spectacular waste of money.
            //  So, the porting process has stopped with zilch chances to continue.
            {$if not defined(VER2_2_0) and not defined(VER2_0_4)}
             , MacOSAll
            {$else}
             , FPCMacOSAll
            {$endif}
           , dynlibs
	        {$else}
//           , libc //for only one function, to determine the phys. RAM size. What a shame
           , baseunix
           , unix
           , x
           , xlib
           , xutil
           , dl
           , keysym
           , cl_xinput_tablet
          {$endif}
        {$else}
         , windows
//         , registry
         , cl_winedetect
         , process
         , jedi_directsound8
         , cl_wintab //Oh crap, there's no easily implementable pen tablet
                     // support for Linux... :(  Micro$oft again saves the day
        {$endif}
      // , cl_clamscan
       , classes
       , syncobjs
       , IniFiles
       , math
       , md5
       , un_process
       , un_filelist
       , cl_strings
       , cl_builtinmodule
       {$ifdef windows}, cl_splashscreen{$endif}
       , cl_gamepad
       
       {$ifdef buildmein} //Jan 2010: Ain't need no this shit...?
        , cl_internalmodule //no any DLLs, only one module built into the executable (a.k.a. Release Mode)
       {$else}
        , cl_seh_hack  // structured exception handling hack mimicking the standard RTL mechanism to support the module DLL.
       {$endif}

   //    , OpenJpeg // my modification to Vampyre replaces one of its units
       , Imaging
       , ImagingTypes
       , ImagingFormats //Vampyre Imaging Library by Marek Mauder
       ;

{$ifdef CPUI386}
  {$define ASSEMBLER_ALLOWED}
{$endif}


procedure main();

procedure PerformCgeShutdown;

// ---------=========******* ГЛОБАЛЬНЫЕ ПЕРЕМЕННЫЕ *******========-------

CONST
//  UnixIcon = BaseImagesPath + 'icon.xbm';
  BuildNumber = {$include build.h};

  {$INCLUDE un_texsages.h} //enumerated type for the message container
    MI_CORE_MIDs_END );


var
  CGEString: widestring = 'Chentrah';

  {$include un_typedefs.h} // all important types and global variables here *****************

var
  MotherState: TMotherState;

  {$include un_unicode.h}

  {$INCLUDE cl_texsages.h} //message container class header + built-in message strings
  
  {$include cl_preinityells.inc} // pre-initialization error message strings
  
  {$include cl_dyna.h}
  
  {$include cl_default_conf.h} // a built-in config .ini file
  
  procedure ResetMotherErrorState();

type
  //float = single;
  EFake = class(Exception);
  EDying = class(Exception);

var
(*
  OpenJpegDll: string = //can be overridden in the main ini file
    {$ifdef unix}
      {$ifdef darwin}
        {$fatal No OpenJpeg support for you!}
      {$else}
        '*I/3rdparty/libopenjpeg.so'
      {$endif}
    {$else}
      '*I\3rdparty\OpenJPEG.dll'
    {$endif}
      ;
 *)
  CppSupportLibrary: string = 'libstdc++.so.5'; //must be dynamically loaded for openjpeg to work (Linux)
  LocalStoreStr: string = 'temporary-files';
  TranslationsDir: string = 'modules' + DS + 'chentrah' + DS + 'translations' + DS;
  SourcesDir: string = 'modules' + DS + 'chentrah' + DS + 'src' + DS;
  ConfigFilePath: string = 'conf' + DS + 'conf.ini';
  LogsDir: string = 'logs' + DS;
  ImagesDir: string = 'modules' + DS + 'chentrah' + DS + 'img' + DS;
  SoundsDir: string = 'modules' + DS + 'chentrah' + DS + 'snd' + DS;
  //RestartRequested: boolean = No; //restart from the scratch. dont rewrite the old log (moved to the MotherState interface record)
  NowRestarting: boolean = No;
//moved to motherstate  ExitRequested: boolean = No; //is used to initiate program shutdown

  FirstRestart: boolean = Yes;
  XServerBully: boolean = No; //set when hacking around the force shutdown by X server
  ReceivedSigterm: boolean = No; //set when requested to terminate by the operating system
  EmergencyShutdown: boolean;// signals that application goes down due to some svere failure. (OpenGL may be unavailable)

  
  HeartbeatMinMiliseconds: integer = 35;

  MainIni: TMemIniFile;
  {StartDir, chInstallPath, LocalStorePath, FoLocalStoreDir,} ModulesBasePath {,SessionPath, SavePath, chHomePath}
  : ansistring; {all use the default system 8-bit locale!
                 (on modern OSes it's usually utf-8)}

  AppNick: ansistring;
  LastHeartbeatMoment: TDateTime;
  AbortHotKey, RestartHotKey, ConsoleToggleHotkey, ConsoleScrollUpHotkey,
    ConsoleScrollDownHotkey, LanguageHotKey, SessionRollbackHotkey,
    QualityFactorManualOverrideToggleHotkey
     : TIntegerArray;
  ModuleHotKey : array[0..0{MAX_MODULE}] of TIntegerArray;
  ModuleCiMs: array of pointer;
  CgeStartTime, SecondStageInitTime: TDateTime;
  CgeStartingTick: longint;
  DontWriteALog: boolean;
  AnotherInstanceIsRunning: boolean = No;
  NoHardwareAcceleration: boolean = No;
type
  THomePathWarning = (hfwNone, hfwTriedIUseH, hfwTriedHuseI, hfwUseI, hfwWin9x);
var
  HomePathWarning: THomePathWarning = hfwNone;
  
type
  TBimMessage = record
    inipar: string;
    capMID, msgMID: TMessageID;
    capStr, msgStr: WideString;
    params: array of WideString;
    writeval: integer;
    isyellow: boolean;
  end;
var
  StopMessage, WarningMessage: array of TBimMessage;
  ModuleStopMessage: TBimMessage;

  WarningQueue: TAOW;

type
  TEngineObjects = class(TAOO)
    Function AddObj(i: TObject): integer;
  end;
  
  TCgeProcess = class(TExProcess)
    procedure OnReadLn(ss: string); override;
  end;
  
  TProcedure = procedure; cdecl;
  TTryWrapperProcedure = procedure(p: pointer); cdecl;
  
const
  MAX_STACK_FRAMES_DUMP = 5;//in error messages, unless the debug mode is on

  OGL_REQ_HI = 1{2}; //Now each module decides if it needs 2.0 or 1.2
  OGL_REQ_MED = 2{0};

  OGL_REQ_HI2 = 2; //OpenGl 2.0 required
  OGL_REQ_MED2 = 0;


  OAL_BUFFERS = 2; //OpenAL sources and buffers (swap at receiving new data)
  OAL_DEVICE_OPEN_TIMEOUT = 10.0 / SecondsPerDay; //OAL sometimes locks up when opening a device

  MODULE_THREADS_STOP_TIMEOUT = 15.0 / SecondsPerDay; {If they dawdle longer
    than that when the module is unloaded, it causes application restart.}

// 2014: Moved this to un_typedefs.h as QualityFactor is now controlled by the module.
//  QF_MIN = 10;
//  QF_MAX = 999;
  FPS_COUNTER_SIZE = 0.10; //of the window size
  FPS_COUNTER_MAX_FONT_SIZE = 18;
  FPS_MEASURING_INTERVAL = 0.33; //seconds

  FADE_IN_TIME = 1.33; //seconds. Screen from black.

  //resources
  NOT_A_MODULE = -1;
  MAX_MODULE_LOAD_ATTEMPTS = 6; //since an attempt to load it while it's still being compiled
    // is destined to fail but the module manager does that as soon as the
    //file date changes, we have to try several times before giving up
  
    //deprecated! As of 2012, module always continues running on at least 30 fps.
    FRAMES_TO_CONTINUE_RENDER_AFTER_LOSING_FOCUS = 4; {While not having focus, the
    window updates only when it receives a message (e.g. you pass your mouse
    pointer above it). This doesn't just affect render, it stops calling the
    module's Pulse procedure when inactive.}
  //sleep this interval each frame if our window does not have the input focus
  NO_FOCUS_SLEEP_INTERVAL = 150;

//moved to un_typedefs.h
//  FPS_CULL_DEFAULT = 30; //also, values of MotherState.CullFrameRate below this are ignored
  FPS_CULL_DEFAULT_MOUSE_MOVED = 60; //raise if mouse moved. Without this, the OpenGL mouse pointer looks sluggish.
  FPS_CULL_DEFAULT_MOUSE_DELTA_THRESHOLD = 5; //pixels per frame (mouse movement speed)



  //image handling
  CGE_RESIZE_FILTER: TResizeFilter = rfBicubic;
  CGE_RESAMPLE_FILTER: TSamplingFilter = sfLanczos;
  
 //Two values control the mouse pointer mode: either the full-color one via OpenGL
 //  or the 2-bit black and white image set as the standard system cursor
 //  using the obsolete mechanisms of Win32 / X.
 //The upside of this primitivism is that it's compatible
 //  with both Windows 95 and any obscure X server with no randR extensions.
 //The mode is controlled from TCLWindow.SwapBuffers (cl_winman.inc),
 //  which also renders the OpenGL cursor.
  HW_POINTER_LOW_FPS_THRESHOLD = 20;
  HW_POINTER_HIGH_FPS_THRESHOLD = 25;
  HW_POINTER_ALPHA_THRESHOLD = 0.5; //where to cut off while creating the 2-bit version.
  HW_POINTER_DITHER_FACTOR = 0.6;

  
  //must match cl_cursor_normal.png
  CGE_STD_CURSOR_HOTSPOT_X = 3;
  CGE_STD_CURSOR_HOTSPOT_Y = 3;
  
  //must match cl_cursor_error.png
  CGE_ERR_CURSOR_HOTSPOT_X = 3;
  CGE_ERR_CURSOR_HOTSPOT_Y = 3;
  
  //must match cl_cursor_hourglass.png
  CGE_HRGLASS_CURSOR_HOTSPOT_X = 15;
  CGE_HRGLASS_CURSOR_HOTSPOT_Y = 15;

  fixedfont_min_qf_to_use_hq_texture = 15;
  fixedfont_max_qf_to_use_lq_texture = 20;

  // Timer
  TSCMeasuringInterval = 1.0;//seconds
  INITIAL_BLACKOUT = 0.3; //seconds before the fade in from black begins.
  LOGO_ANIMATION_LENGTH = 4.0; //seconds;

var
  Res: TAOP;

  ActiveOwner: integer = 0;
  CurrentOwner: integer = NOT_A_MODULE;
  InExportedProc: boolean = false;

  procedure InitMotherState;

  function Tick: longint; //miliseconds since CGE start;

  Procedure Die(YellID :TMessageID; Param: array of const); overload;
  Procedure Die(YellID :TMessageID); overload;
  Procedure Die(AnsiYell :AnsiString; Param: array of const); overload;
  Procedure Die(WideYell :WideString; Param: array of const); overload;
  Procedure Die(Ru, En :WideString; Param: array of const); overload;
  Procedure Die(AnsiYell: AnsiString); overload;
  Procedure Die(WideYell: WideString); overload;
  procedure AddYell(u: WideString);
  Procedure Warning(YellID :TMessageID; Param: array of const); overload;

  Procedure AddStopMessage(YellID :TMessageID; Param: array of const); overload;
  Procedure AddStopMessage(Yell: WideString; Param: array of const); overload;
  Procedure AddStopMessage(Yell: WideString); overload;
  
  procedure AddMStopMessage(itisfatal: boolean);
  
  procedure GiveWarning(_inipar: string; Cap, Yell :TMessageID; Param: array of const); overload;
  Procedure GiveWarningNotYellow(_inipar: string; Cap, Yell :TMessageID; Param: array of const);
  procedure GiveWarning(_inipar: string; Cap, Yell :WideString; Param: array of const); overload;
  procedure AddWarning(Cap: TMessageId; Yell :WideString; Param: array of const); overload;
  procedure AddWarning(Cap, Yell :WideString; Param: array of const); overload;
  procedure GiveWarnings();

  function StopDying(): WideString;
  function ExtractDyingYell(): WideString;
  
  procedure ProcessGuardedException; cdecl;
  procedure CheckForGuardedException;

  Procedure ClearWarningQueue;
  Function IsWarningQueueEmpty: boolean;
  Function PullWarningsFromQueue: WideString;


  Procedure PreInitDie(Yell: WideString; p: array of const);
  procedure DisplayDyingYells;
  function CallStack(IgnoreLastN: integer; Padding: WideString): WideString;

  function PervertedFormat(U: WideString; P: array of const): WideString;
  function PervertedFormatW(U: WideString; P: array of WideString): WideString;

  function StrOrUndefined(U: WideString): WideString;
  
  function LoadUnicodeText(FileName: string): TAOW;

  Procedure AddLog(S: AnsiString); OVERLOAD;
  Procedure VerboseLog(S: AnsiString); OVERLOAD;
  Procedure AddLog(U: WideString); OVERLOAD;
  Procedure AddLog(mID: TMessageID); OVERLOAD;
  Procedure AddLog(S: AnsiString; Param: array of const); OVERLOAD;
  Procedure VerboseLog(S: AnsiString; Param: array of const); OVERLOAD;
  Procedure VerboseLogOk;
  Procedure AddLog(U: WideString; Param: array of const); OVERLOAD;
  Procedure AddLog(mID: TMessageID; Param: array of const); OVERLOAD;
  procedure VerboseLog(mID: TMessageID; Param: array of const); OVERLOAD;
  procedure VerboseLog(mID: TMessageID); OVERLOAD;
  Procedure AddLogComment(S: AnsiString; Param: array of const); OVERLOAD;
  Procedure AddLogComment(U: WideString; Param: array of const); OVERLOAD;
  Procedure AddLogComment(mID: TMessageID; Param: array of const); OVERLOAD;
  Procedure AddLogComment(S: AnsiString); OVERLOAD;
  Procedure AddLogComment(U: WideString); OVERLOAD;
  Procedure AddLogComment(mID: TMessageID); OVERLOAD;
  
  Procedure DbgSayS(Yell: AnsiString);
  Procedure DbgSay(Yell: WideString);
  
  Procedure _ExportHostProc(i: integer; var p: pointer); cdecl;
  
  function _RunningInWindows9x: boolean;
  {$ifdef win32}
  function CheckIfWindows9xHasUnicodeSupportInstalled: boolean;
  {$endif}
  function _RunningInWindowsNT: boolean;
  procedure DetectOSType;
  procedure LogOSVersion;
  function ThisIsAnOnlyInstance: boolean;

  procedure RestartMyself(param: ansistring);
  procedure KillMyself(exitcode: integer = 0);
  
  procedure GetHotKeysFromConfig;
  function GetHotkeyName(var HK: TIntegerArray): string;
  procedure InitCTimer;
  procedure StartVampyre;
  procedure InitResourceManager;

  function RuEn(Ru, En: WideString): WideString;
  function VersionToStr(major, minor, build: integer): AnsiString;
  function CGEPath(s: string): string;
  procedure DetermineInstallPath;
  procedure DetermineHomePath;
  function ValidateWritePath (path: AnsiString): boolean;
  
  procedure chCopyFile(n1, n2: string);

{  Leaves from my working in Delphi 5 years ago. It was a nice stuff
     but the exception information in FPC/win32 doesn't support the
     exception address (not the code, but the exact address accessing which
     caused the AV). Still, it was nice to know  which of the multitude of DLLs
     allocated the memory block where it happened.
   Anyway, I doubt Linux has anything similar to WinAPI's VirtualQuery().}
{ function ToldMemRgn(ptr: pointer): WideString;
  function ExpCallerAddress(): WideString; cdecl; }

  function TellException(E: Exception): WideString;
  function ExpExpAddress(addr: pointer): WideString;
  function ShortExpAddr(addr: pointer): WideString;

  function GetDLLFileName(h: {$ifdef unix} pointer {$else} THandle {$endif}): ansistring;

  procedure CgeSleep(ms: longint);

 {$include cl_confman.h}

 {$include un_al.h}  {
     Alas, the OpenAL header should be custom-made too.
       blame the vastly imperfect initialisation/dynamic linking routines
       of the default FPC packages. I will NOT tolerate a unit
       that causes my program to crash silently or with an unitelligible
       error message if some desired library is missing on the user machine.

     My code of honor demands that my program must fail graciously,
       giving a detailed explanation of the problem and some suggestions
       as how to alleviate it (e.g. "Install fresh drivers, ya stupid noob!")
   }

 {$include un_gl.h}  {  OpenGL mini-header which the game module shares
                          with the mother module }

 {$ifdef unix}  { platform-dependent OpenGL stuff
                    which the game module doesn't need to know about }
   {$ifdef darwin}
     {$include cl_agl.h}
   {$else}
     {$include cl_glx.h}
   {$endif}
 {$else}
   {$include cl_wgl.h}
 {$endif}
 
 function GetGLProcAddress(ProcName, Suffix: ansistring): Pointer;
 function GetGLProcAddress2(ProcName, Suffix1, Suffix2: ansistring): Pointer;
 function _GetGLProcAddress(ProcName: ansistring): Pointer;
 procedure InitGlProcAddresses(Load2: boolean = false);
 procedure CheckGLVersion;

 function GetALProcAddress(ProcName: ansistring): pointer;
 
 {$include cl_winman.h}

 {$ifdef windows}
   {$include cl_directsound.h}
 {$endif}

type
  TSmallIntArray = array of smallint;
  function DecodeWav(inp: TStream): TSmallIntArray;

 {$include cl_soundman.h}

  procedure InitOpenGL;
  procedure CloseOpenGL;
  Procedure InitOpenAL;
  Procedure CloseOpenAL;


  procedure GetOpenGLVersion(var hi, med: integer);

var
  DoShowFps: boolean;
  prevfpssec: double = 0;

  procedure MeasureFps;
  procedure RenderFpsCounter;
  procedure InitFpsCounter;


  procedure InitFixedFont;

 {$ifdef unix}
  procedure SetSigtermHandler;
 {$endif}

 
 {$define header}
   {$define cgekernel}
   {$include cl_exported_func.h}
 {$undef header}
 
 {$include cl_module.h}
 
 {$include cl_console.h}
 
  procedure LoadFixedFontTexture;
  procedure _cgeffSizeToFace(size: integer; face: Pinteger; zoom: PGLfloat );
  function _cgeffGetStringWidth(Size, numChars: integer): GLfloat;
  function _cgeffGetStringHeight(Size, numLines: integer): GLfloat;
  procedure _cgeffSetRenderState (noshadow: boolean);
  procedure _cgeffFitStringIntoRectangle (
       Size, numChars, numLines, Width, Height: integer;  fit: PStringFitRec);
  procedure _cgeffRenderString (fit: PStringFitRec; Left, Top: glFloat; w: PWideChar);
  
  procedure ResampleImg (var i: TImageData; newwidth, newheight: integer);

  {$include cl_lockupguard.h}

//  procedure SafeInitSound; cdecl;
//  procedure SafeInitVideo; cdecl;

var
  BottleNeckCounter1, BottleNeckCounter2: int64;

  function BoolChars(b: boolean):string;
  function NumeralFormEn (n: integer; wSingular, wPlural: WideString): WideString;
  function NumeralFormRu (n: integer; wSingular, wPlural2_4, wPlural: WideString): WideString;

  function SanateStringForFileName(s: AnsiString): AnsiString;


// A non-linear function for screen fade in from black.
  function FancyFunc(f: double): glFloat;

  procedure ErrorMessageBox(Title, Body: WideString);

  {$ifdef unix}{$ifndef darwin}procedure DetectLinuxVersionString;{$endif}{$endif}

  function IniCompatibleStringForm(a: AnsiString): AnsiString;

  {$include cl_gamepad.h}

  function NewInputEvent: integer;

  procedure CheckbatteryStatus; //needed for limiting rendering settings when laptop runs on battery

implementation

    procedure CheckForGenericDyingYells(var U: WideString; omit_frames: integer = 0); forward;
  



  {$include cl_translit.inc} // converts russian text for output using latin alphabet
  
  {$ifdef unix}
    {$ifdef darwin}
      {$fatal Oopsie... Not ported yet.}
    {$else}
      {$include xunikey.inc} //ripped from the ptc/x11 package included with the FreePascal sources
    {$endif}
  {$else}
    {$include un_errmode.inc} //prevents XP from popping up its own error messages
  {$endif}

  function GoingDownHard: boolean; cdecl;
  begin
    Result:=EmergencyShutdown or XServerBully or ReceivedSigterm;
  end;

  function Tick: longint; //Время в милисекундах от запуска программы
  begin
    //{$ifdef windows}
    // Result:=GetTickCount() - CgeStartingTick;
    //{$endif}

    // Rough. Rounds to 15..16 ms.
    Result:=round((Now() - CgeStartTime) * 86400000.0);
  end;

  procedure CgeSleep(ms: longint);
  var q, q2: qword;
  begin
    {$ifdef unix}
      Sleep(ms);
    {$else}
      if
        //(MotherState.Os in WindowsEmulators) or
        (0 = MotherState.RdtscFrequency) then Sleep(ms)
      else begin
        UsecByTsc(@q);
        q2:= q;
        repeat
          Sleep(0);
          q:= q2;
        until UsecByTsc(@q) >= (ms * 1000.0);
      end;
    {$endif}
  end;
  
  procedure LoadQF;
  var
    i: integer;
    s: ansistring;
    w: dword;
  begin
    i:=Config.Int['videocard_' + MotherState.RendererAlias, 'quality_factor'];
    if i = 0 then exit;
    i:= max(QF_MIN, min(QF_MAX, i));
    MotherState.QF:= i;
    With MotherState do
      DoShowFps:= Config.Bool['video', 'show_fps'] or DebugMode or DeveloperMode;
    try
      s:= Config.Str['videocard_' + MotherState.RendererAlias, 'quirks'];
      w:= StrToInt(s);
      MotherState.OGLQuirks:= w;
    except
    end;
  end;
  
  procedure SaveQF;
  begin
    Config.Int['videocard_' + MotherState.RendererAlias, 'quality_factor'] := round(MotherState.QF);
    Config.Str['videocard_' + MotherState.RendererAlias, 'quirks'] := '$' + IntToHex(MotherState.OGLQuirks, 2);
  end;
  

  var
    _dsay: widestring;
  Procedure DbgSay(Yell: WideString);
  begin
    _dsay:= Yell;
  end;



var
  TimeStamp: Int64 = 0;

  function PCharToString(P: PAnsiChar): AnsiString;
  var
    i: integer;
    p2: PAnsiChar;
  begin
    if not Assigned(p) then Result:=''
    else try
      p2:=p;
      i:=0;
      While p2^ <> #0 do begin
        inc(p2);
        inc(i);
      end;
      SetLength(Result, i);
      Move(p^, Result[1], i);
    except raise Exception.Create('AV in PCharToString() : ' + inttohex(ptruint(p),8) + 'h, count = '+ IntToStr(i)) end;
  end;

  function PWideCharToWideString(P: PWideChar): WideString;
  var
    i: integer;
    p2: PWideChar;
  begin
    if not Assigned(p) then Result:=''
    else begin
      p2:=p;
      i:=0;
      While p2^ <> #0 do begin
        inc(p2);
        inc(i);
      end;
      SetLength(Result, i);
      Move(p^, Result[1], i*2);
    end;
  end;

 // The image files used by the mother module:
 {$include iim_00.inc}
// {$include cl_j2k_test.inc}
 {$include cl_bgimg_error.inc}
 {$include cl_console_font.inc}
 {$include cl_cursor_cyan.inc}
 {$include cl_cursor_yellow.inc}
 {$include cl_cursor_hourglass.inc}

 {$include cl_exports_implement.inc}  //the functions the mother exe exports into the game dll


  Procedure PreInitDie(Yell: WideString; p: array of const);
  //all error messages given before MessageContainer is initialized
  // are in English, so there's no need for unicode...
  begin
    Yell:=PervertedFormat(Yell, p);
   {$ifdef unix}
    WriteLn(#10#13#10#13#10#13 + ExtractFileName(CGEString + ' crashed at startup!'));
    Writeln(#10#13 + Yell + #10#13);
   {$endif}
    ErrorMessageBox(CGEString + ' crashed при запуске!', Yell);
    Halt(0);//1);
  end;

  function ExtractDyingYell(): WideString;
  var i: integer;
  begin
    Result:='';
    For i:=WarningQueue.High downto 0 do begin
      Result:=Result + WarningQueue[i];
      if i > 0 then Result:=Result + #10#13#10#13;
    end;
    ClearWarningQueue;
  end;

  procedure DisplayDyingYells;
  var
    tit, DyingYell: WideString;
    titA: AnsiString;
  begin
    DyingYell:=ExtractDyingYell();
    AddLog(MI_ERROR_MESSAGE_IS, [DyingYell]);
    {$ifdef unix}
     WriteLn(#10#13#10#13#10#13 + ExtractFileName(ParamStr(0) + ' crashed!'));
     Writeln(#10#13 + DyingYell + #10#13);
    {$endif}
     tit:=MessageContainer[MI_CGE_TITLE];
     ErrorMessageBox(MessageContainer[MI_CGE_TITLE], DyingYell);
  end;

(* DOESNT WORK, GIVES FALSE NEGATIVE
  {$ifdef windows}
  function TryWin98LacksUnicodeSupport(): boolean;
  var
    a: ansistring;
    w: widestring;
    i: integer;
  begin
    SetLength(a, 1);
    a[1]:='i';
    i:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @a[1], length(a), nil, 0);
    if i > 0 then begin
      SetLength(w, i);
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @a[1], length(a), @w[1], i);
      Result:= (w[1] <> 'i');
    end
    else Result:= Yes;
  end;
 {$endif} *)


  function _RunningInWindows9x: boolean;
  begin
   {$ifdef windows}
    Result := (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) {and
      (Win32MajorVersion < 5)} {and (WIN32MinorVersion <= 1)}
   {$else}
    Result:=No;
   {$endif}
  end;
  
  function _RunningInWindowsNT: boolean;
  begin
   {$ifdef windows}
    Result := (Win32Platform =  VER_PLATFORM_WIN32_NT)
   {$else}
    Result:=No;
   {$endif}
  end;


  function _RunningInMacOSX: boolean;
  begin
   {$ifdef unix}
    Result:= No; //********** IMPLEMENT ME *********************
   {$else}
    Result:=No;
   {$endif}
  end;

  {$ifdef windows}
  function GetLocalAppDataDir: AnsiString; forward;
  {$endif}

  procedure DetectOSType;
  begin
   {$ifdef unix}
     {$ifdef darwin}
      MotherState.OS:= ostMacOSX;
     {$else}
      MotherState.OS:= ostLinux;
     {$endif}
   {$else}
     if RunningInWine then begin
       MotherState.OS:= ostWine;
       MotherState.DriveZIsRoot:= GetZIsRoot();
       if MotherState.DriveZIsRoot then begin
         //otherwise we're unable to tell Linux from MacOS X
         if FileExists('z:\usr\lib\libc.dylib')
           then MotherState.OS:= ostDarwine;
       end;
     end
     else
       if _RunningInWindows9x then MotherState.OS:= ostWin9x //98 or Me
       else
         case Win32MajorVersion of
           3,4: MotherState.OS:= ostWin2k;  //Windows NT 3.x and 4.x are treated as Windows 2000. Chentrah probably won't event start there
           5: if WIN32MinorVersion = 0
                then MotherState.OS:= ostWin2k
                else MotherState.OS:= ostWinXP; //or server 2003, doesn't matter
           6: case WIN32MinorVersion of
                0: MotherState.OS:= ostVista;
                1: MotherState.OS:= ostWin7;
                2: MotherState.OS:= ostWin8;
              else
                MotherState.OS:= ostWin9;
              end;
         else
           MotherState.OS:= ostWin7
         end;
    MotherState.CSIDL_AppDataDir:= GetLocalAppDataDir;
    MotherState.Win98LacksUnicodeSupport:= {$ifdef cpu64} false {$else} not CheckIfWindows9xHasUnicodeSupportInstalled() {$endif} ;
   {$endif}
    MotherState.OstID:= GetEnumName(typeinfo(TOSType), ord(MotherState.OS));
    if MotherState.OS = ostWine
      then MotherState.OSName:= WineVersionString
      else begin
        if (Win32MajorVersion < 5) or (Win32MajorVersion > 6)
        or ((Win32MajorVersion = 6) and (WIN32MinorVersion > 1))
          then MotherState.OSName:= 'Windows NT ' + IntToStr(Win32MajorVersion) + '.' + IntToStr(WIN32MinorVersion)
          else MotherState.OSName:= OsName[MotherState.OS];
      end;
   {$ifdef unix}
    {$ifndef darwin}
     DetectLinuxVersionString;
    {$endif}
   {$endif}
  end;


  //key words to remove from the processor name:
  const ccpun_keywords: array [0..8] of ansistring = ('@', '(r)', 'amd', 'cpu', '(tm)', 'intel', 'dual core', 'dual-core', 'processor');

  function CleanCPUName (s: ansistring): ansistring;
  var
    i, n, k: integer;
    prevc: ansichar;
    b: boolean;
    o: ansistring;
  begin
    if s = '' then exit;
    o:= lowercase(s);
    //first, erase the keywords:
    for i:= 1 to length(s) do
      for k:= 0 to high(ccpun_keywords) do begin
        b:= true;
        for n:= 1 to length(ccpun_keywords[k]) do
          if ((i + n - 1) > length (s)) or (o[i + n - 1] <> ccpun_keywords[k][n]) then begin
            b:=false;
            break;
          end;
        if b then for n:= 1 to length(ccpun_keywords[k]) do
          s[i + n - 1]:= ' ';
      end;
    //then remove all the extra unnecessary spaces
    Result:= '';
    prevc:= ' ';
    for i:= 1 to length(s) do begin
      if (prevc > ' ') or (s[i] > ' ') then Result+= s[i];
      prevc:= s[i];
    end;
    Result:= Trim(Result);
  end;


  function GetProcessorInfo: string;
  var
    A, ffa, ffb, ffd, family, model, stepping, lvl, elvl: dword;
    vstr: string[12];
    dstr: string[48] = '';
   {$ifdef windows}
    si: SYSTEM_INFO;
   {$endif}
  begin
    setlength(vstr, 12);
    asm
      mov eax, 0
      cpuid
      mov [lvl], eax
      mov [vstr + 1], ebx
      mov [vstr + 5], edx
      mov [vstr + 9], ecx

      mov eax, 1
      cpuid
      mov [ffa], eax
      mov [ffb], ebx
      mov [ffd], edx

      mov eax, 80000000h
      cpuid
      mov [elvl], eax
    end;
    if elvl >= $80000004 then begin
      setLength(dstr, 48);
      asm
        mov eax, 80000002h
        cpuid
        mov [dstr + 1], eax
        mov [dstr + 5], ebx
        mov [dstr + 9], ecx
        mov [dstr + 13], edx

        mov eax, 80000003h
        cpuid
        mov [dstr + 17], eax
        mov [dstr + 21], ebx
        mov [dstr + 25], ecx
        mov [dstr + 29], edx

        mov eax, 80000004h
        cpuid
        mov [dstr + 33], eax
        mov [dstr + 37], ebx
        mov [dstr + 41], ecx
        mov [dstr + 45], edx
      end;
    end;
    if elvl >= $80000006 then begin
      asm
        mov eax, 80000006h
        cpuid
        mov [A], ecx
      end;
      MotherState.CPUL2CacheSize:= A shr 16;
      MotherState.CPUL2CacheLineSize:= A and $ff;
    end;
    if elvl >= $80000007 then begin
      asm
        mov eax, 80000007h
        cpuid
        mov [A], edx
      end;
      MotherState.CPUTSCInvariance:= ((A shr 8) and $00000001) > 0;
    end;
    if (ffd and (1 shl 28)) > 0  then begin
      MotherState.CpuCount:= (ffb shr 16) and $00ff;
      (*
      if (MotherState.CpuCount > 1)
        and (vstr = 'GenuineIntel')
        then MotherState.CpuCount:= MotherState.CpuCount div 2;
        {
          Fuck. There's no *sane* way to get the number of PHYSICAL processors on Intel CPUs.
          So I simply divide the number of logical cores by 2 if HT is supported.
          I'm not checking if it is really enabled (do I have to? does Windows ever disable it?)
        }
      *)
      if (MotherState.CPUL2CacheSize > 0) and (MotherState.CPUL2CacheSize < 512) and (MotherState.CpuCount > 2) then begin
        //in all CPUs since forever the cache size smaller than 512K means it is split between HT "cores"
        MotherState.CpuCount:= MotherState.CpuCount div 2;
        MotherState.CPUL2CacheSize*= 2;
      end;
    end
    else
      MotherState.CpuCount:= 1;
    family:= (ffa shr 8) and $0f;
    if family = $0f then family+= ((ffa shr 20) and $ff);
    model:= (ffa shr 4) and $0f;
    if model = $0f then model+= ((ffa shr 16) and $0f);
    stepping:= ffa and $0f;
    MotherState.SSE2Available:= ((ffd and (1 shl 26)) > 0);
    Result:= CleanCPUName(dstr);
    if Result = '' then begin
      if vstr = 'GenuineIntel'
        then Result:='Intel'
        else
          if vstr = 'AuthenticAMD'
            then result:='AMD'
            else result:= vstr;
      result+= ' ' + IntToStr(family)+'.'+IntToStr(model)+'.'+IntToStr(stepping);
    end;
    MotherState.CpuName:= Result;
    {$ifdef windows}
      windows.GetSystemInfo(@si);
      if (si.dwNumberOfProcessors > 0) and (si.dwNumberOfProcessors < MotherState.CpuCount) then begin
        MotherState.CPUL2CacheSize*= (MotherState.CpuCount div si.dwNumberOfProcessors);
        MotherState.CpuCount:= si.dwNumberOfProcessors;
      end;
    {$else}

    {$endif}

  end;

  function NumeralFormRu (n: integer; wSingular, wPlural2_4, wPlural: WideString): WideString;
  begin
    n:= n mod 100;
    if n > 19 then n:= n mod 10;
    case n of
      1: Result:= wSingular;
      2..4: Result:= wPlural2_4;
    else
      Result:= wPlural;


    end;
  end;

  function NumeralFormEn (n: integer; wSingular, wPlural: WideString): WideString;
  begin
    if n = 1
      then Result:= wSingular
      else Result:= wPlural;
  end;


  procedure LogOsVersion;
  var
    w, oops: WideString;
    nc, nl, ni: WideString;
  begin
    w:= PervertedFormat(MessageContainer[MI_OS_VERSION], [MotherState.OsName]);
  {$ifdef windows}
    if MotherState.Win98LacksUnicodeSupport
      then w+= RuEn(' (без поддержки Unicode)',' (with no Unicode support)');
  {$endif}
    AddLog(w);
    GetProcessorInfo();
    AddLog(RuEn('Пользователь: %0','User name: %0%'), [MotherState.UserNameUcs16]);
    if MotherState.CPUL2CacheSize > 0 then nc:= IntToStr(MotherState.CPUL2CacheSize) + RuEn(' Кб',' Kbytes') else nc:= RuEn(' размер неизвестен',' unknown size');
    if MotherState.CPUL2CacheLineSize > 0 then nl:= IntToStr(MotherState.CPUL2CacheLineSize) + RuEn(NumeralFormRu(MotherState.CPUL2CacheLineSize, ' байт',' байта',' байт'),' bytes') else nl:= RuEn(' неизвестно',' unknown');
    if MotherState.CPUTSCInvariance then ni:= RuEn('есть','yes') else ni:= RuEn('не поддерживается','not supported');
    AddLog(RuEn(
     'ЦП %0'#10#13'  x%1 '
         + NumeralFormRu(MotherState.CpuCount,'логическое ядро','логических ядра','логических ядер')
         + #10#13'  реальная частота:  %2 ГГц.'
         + #10#13'  кэш второго уровня: %3, линейка %4'
         + #10#13'  инвариантность TSC: %5',
     'CPU %0'#10#13'  x%1 '
         + NumeralFormEn(MotherState.CpuCount, 'logical core', 'logical cores')
         + #10#13'  actual frequency: %2 GHz)'
         + #10#13'  level 2 cache: %3, line size %4'
         + #10#13'  TSC invariancy: %5'),
      [ MotherState.CpuName,
        MotherState.CpuCount,
        format('%1.2f', [MotherState.RdtscFrequency / 1000000000.0]),
        nc,
        nl,
        ni]);
    AddLog(RuEn('ОЗУ: %0 Мб','RAM: %0 Mb'), [MotherState.PhysMemory]);
    oops:= '';

    if not MotherState.SSE2Available
      then oops+= RuEn(
       ' - не поддерживается набор команд SSE2'#10#13#10#13,
       ' -- no support for the SSE2 instruction set.'#10#13#10#13);

    if MotherState.CPUCount < 2
      then oops+= RuEn(
       ' - только одно ядро'#10#13#10#13,' -- has only one core'#10#13#10#13);
    if MotherState.CPUL2CacheSize < 512
      then oops+= RuEn(
      ' - размер кеша второго уровня меньше 512 килобайт (имеется '+ nc +')'#10#13#10#13,
      ' -- level 2 cache is smaller than 512 kilobytes (its size is '+nc+')'#10#13#10#13);

    if oops <> '' then
      GiveWarning('_cpu_is_feature_weak', RuEn('МОЖЕТ НЕ ПОТЯНУТЬ.','NOT GOOD.'),
         RuEn(
           'Процессор не поддерживает некоторые необязательные,'#10#13 +
           '  но влияющие на производительность технологии:',
           'Your CPU lacks some features'#10#13 +
           '  that are optional but still desired for better performance:')
         + #10#13#10#13 + oops, []);
  end;
  
{$ifdef unix}
  var
    Fn: string;
    Di: boolean = false;

  function ThisIsAnOnlyInstance: boolean;
  var
    i: integer;
    t: Text;
  begin
    Result:=True;
    Fn:= '/tmp/.' + ChangeFileExt(ExtractFileName(ParamStr(0)),'') + 'SingleInstanceMutex';
    Try
      if FileExists(Fn) then begin
        i:=0;
        AssignFile(t, Fn);
        Reset(t);
        Readln(t, i);
        CloseFile(t);
        if i = fpGetPid() then Exit
        else
          if DirectoryExists('/proc/' + IntToStr(i))
            and (
              (ExtractFileName(fpReadLink ('/proc/' + IntToStr(i) + '/exe')) = ExtractFileName(ParamStr(0)))
              //safety check:
              // if we can't determine if the PID belongs to the same app,
              // then we assume it does.
              or not FileExists('/proc/' + IntToStr(i) + '/exe') //different unix
              or ((Length(ParamStr(0)) >=8) and (copy(ParamStr(0),1, 8) = '/tmp/upx'))) //executable is upx'ed
            then
              Exit(False);
      end;
      AssignFile(t, Fn);
      Rewrite(t);
      Writeln(t, fpGetPid());
      CloseFile(t);
    Except
    End;
    Di:= Result;
  end;
{$else}
  var
    M: THandle;
    Di: boolean = false;

  function ThisIsAnOnlyInstance: boolean;
  var N: string;
  begin
    Result:=True;
    N:=ChangeFileExt(ExtractFileName(ParamStr(0)),'') + 'SingleInstanceMutex';
    M:=OpenMutex(MUTEX_MODIFY_STATE, False, PChar(N));
    if M = 0 then M:=CreateMutex(nil, True, PChar(N))
    else begin
      if WaitForSingleObject(M, 0) <> WAIT_ABANDONED then Result:=False;
    end;
    Di:=Result;
  end;
{$endif}

  Procedure DbgSayS(Yell: AnsiString);
  begin
   {$ifdef windows}
    MessageBox(0, PChar(Yell), PChar(string('Ы')), MB_ICONINFORMATION + MB_OK);
   {$else}
//    UnixPMMessageBox(AnsiToWide(Yell), '---Ok---');
   {$endif}
  end;

 {$include un_unicode.inc}

  function LoadUnicodeText(FileName: string): TAOW;
  var
    i: integer;
    s: TStringList;
  begin
    if not FileExists(FileName)
    then
      Die(MI_ERROR_FILE_NOT_FOUND, [FileName]);
    Try
      s:=TStringList.Create;
      s.LoadFromFile(FileName);
      Result:=TAOW.Create;
      For i:=0 to s.Count - 1 do begin
        //if (Result.high < 0) and (Trim(s[i]) = '') then continue;
        Result.Add({chTRimRightSpaces}(Utf8Decode(s[i])));
//        if (Result.high = 0) and (Result.last[1] = #$fffe)
//          then Result.last:=copy(Result.last, 2, length(Result.last) - 1);
        if (Result.last = '.') then Result.last:='';
      end;
      s.Free;
    Except
      Die(MI_ERROR_INVALID_UTF8_TEXT,[FileName])
    End;
  end;

  {$include cl_texsages.inc}

  function VarRecToWide(V: TVarRec): WideString;
  begin
    Case V.Vtype of
      vtInteger:    Result := IntToStr(V.VInteger);
      vtBoolean:    Result := AnsiToWide(BoolChars(V.VBoolean));
      vtChar:   Result := AnsiToWide(V.VChar);
      vtWideChar:   Result:=V.VWideChar;
      vtExtended:   Result := FloatToStr(V.VExtended^);
      vtAnsiString: Result := AnsiToWide(AnsiString(V.VAnsiString));
      vtWideString: Result := WideString(V.VWideString);
      vtPChar:  Result := AnsiToWide(PCharToString(V.VPChar));
      vtPWideChar:  Result := PWideCharToWideString(V.VPWideChar);
//      vtPChar:      Result := AnsiToWide(PCharToString(V.VPChar));
      vtObject:     Result := V.VObject.ClassName;
      vtClass:      Result := V.VClass.ClassName;
      vtPointer: begin
        if Assigned(V.VPointer) then Result:= Format('%Ph',[V.VPointer])
                                else Result:='NIL';
      end;
     {
      //not supported in the FreePascal 1.0.6
      vtCurrency:   Result := CurrToStr(V.VCurrency^);
      vtVariant:    Result := string(V.VVariant^);
      }
      vtInt64:      Result := IntToStr(V.VInt64^);
      vtQword:      Result:= IntToStr(V.VQword^);
    else
      Result:='?unknown VarRec type?';
    end;
  end;

{  procedure PervertedFormat(A: WideStringArray; P: array of const);
  var u: WideString;
  begin
    u:=ArrayToUni(A);
    a.Free;
    PervertedFormat(u, p);
    A:=UniToArray(u);
    u.Free;
  end;}

  function PervertedFormat(U: WideString; P: array of const): WideString; //OVERLOAD;
  var
    j: integer;
    b, e: WideString;
  begin
    e:='';
    For j:=0 to High(p) do begin
      b:=VarRecToWide(P[j]);
      if WidePos('%' + IntToStr(j), U) < 1
        then e:=e + '  [' + b + ']  '
        else u:=WideReplace(u, '%' + IntToStr(j), b);
    end;
    if e <> '' then begin
      e:=' +FORMAT ERROR!! ' + e;
    end;
    Result:=u + e;
  end;
  
  function PervertedFormatW(U: WideString; P: array of WideString): WideString;
  var
    j: integer;
    e: WideString;
  begin
    e:='';
    For j:=0 to High(p) do begin
      if WidePos('%' + IntToStr(j), U) < 1
        then e:=e + '  [' + p[j] + ']  '
        else u:=WideReplace(u, '%' + IntToStr(j), p[j]);
    end;
    if e <> '' then begin
      e:=' +FORMAT ERROR!! ' + e;
    end;
    Result:=u + e;
  end;
  
  function StrOrUndefined(U: WideString): WideString;
  begin
    if U='' then Result:=MessageContainer[MI_UNDEFINED]
            else Result:=U;
  end;

 {$ifdef win32}
  function Win32LastError: WideString;
  var
    M: Cardinal;
    u: WideString;
  begin
    M:=GetLastError;
    if M = ERROR_SUCCESS then Result:=''
    else begin
      if MotherState.OS = ostWin9x
        then u:=AnsiToWide(SysErrorMessage(M))
        else u:=SysErrorMessage(M);
      Result:=#10#13 + Result + #10#13 + PervertedFormat(
        MessageContainer[MI_WIN32_EXPLAINS],
        [IntToHex(M, 8), u]);
    end;
  end;
 {$endif}

    function ExceptObjectisException: boolean;
    begin
//      Try
        Result:=Assigned(ExceptObject) and (ExceptObject is Exception);
//      Except
//        Result:=No;
//      End;
    end;

(*  var
    EChar: string;
  procedure SetEChar;
  begin
    //1 - "естественное" исключение (не Die() )
    //2 - в модуле
    //3 - внутри экспортируемой процедуры
    //4 - модуль не загружен
    EChar:='----';
    if not MotherState.NowDying and ExceptObjectisException
       and not (ExceptObject is EFake) then EChar[1]:='*';
    if CurrentOwner <> NOT_A_MODULE then EChar[2]:='*';
    if ActiveOwner = NOT_A_MODULE then EChar[4]:='*';
    if InExportedProc then EChar[3]:='*';
        {$ifdef win32}
//    if GetLastError <> 0 then EChar[3]:='*';
        {$endif}
  end;
*)


var
  zz0p: pointer = nil;

  {$include cl_die.inc}

  procedure AddYell(u: WideString);
  begin
    if not MotherState.NowDying then begin
      AddLog(MI_SHIT_HAPPENS_SEE_BELOW, ['----']);
      MotherState.NowDying:=Yes;
    end;
    WarningQueue.Add(u);
  end;
  
  Procedure Warning(YellID :TMessageID; Param: array of const); OVERLOAD;
  var
    U: WideString;
  begin
    U:=PervertedFormat(MessageContainer[YellID], Param);
    WarningQueue.Add(U);
  end;
  

  type
    TWstrArray = array of WideString;

  function VarrecsToWstrs(param: array of const): TWstrArray;
  var
    i: integer;
  begin
    SetLength(Result,length(param));
    for i:=0 to high(param) do Result[i]:= VarRecToWide(param[i]);
  end;

  Procedure AddStopMessage(YellID :TMessageID; Param: array of const);
  begin
    SetLength(StopMessage, length(StopMessage) + 1);
    with StopMessage[high(StopMessage)] do begin
      capMID:= MI_STOP_MESSAGE_CAPTION;
      capStr:= '';
      msgMID:= YellID;
      msgStr:= '';
      params:= VarrecsToWstrs(Param);
    end;
  end;
  
  Procedure AddStopMessage(Yell: WideString; Param: array of const);
  begin
    SetLength(StopMessage, length(StopMessage) + 1);
    with StopMessage[high(StopMessage)] do begin
      capMID:= MI_STOP_MESSAGE_CAPTION;
      capStr:= '';
      msgStr:= Yell;
      params:= VarrecsToWstrs(Param);
    end;
  end;
  
  Procedure AddStopMessage(Yell: WideString);
  begin
    SetLength(StopMessage, length(StopMessage) + 1);
    with StopMessage[high(StopMessage)] do begin
      capMID:= MI_STOP_MESSAGE_CAPTION;
      capStr:= '';
      msgStr:= Yell;
      params:= nil;
    end;
  end;
  
  procedure AddMStopMessage(itisfatal: boolean);
  begin
    bimState:= bimsModuleError;
    with ModuleStopMessage do begin
      capStr:= PervertedFormat(MessageContainer[MI_MODULE_CRASHED_ONELINER], [MotherState.ModuleNameW]);
      msgStr:= StopDying();
      if not itisfatal
        then msgStr+= #10#13#10#13'······································'#10#13#10#13
        + MessageContainer[MI_MODULE_CRASHED_EXPLAIN];
//AddLog(capStr + #10#13 + MsgStr);
    end;
  end;
  
  
  Procedure AddWarning(Cap: TMessageId; Yell :WideString; Param: array of const);
  begin
    SetLength(WarningMessage, length(WarningMessage) + 1);
    with WarningMessage[high(WarningMessage)] do begin
      capMID:= Cap;
      capStr:= '';
      msgStr:= Yell;
      params:= VarrecsToWstrs(Param);
      inipar:= '';
    end;
  end;

  Procedure AddWarning(Cap, Yell :WideString; Param: array of const);
  begin
    SetLength(WarningMessage, length(WarningMessage) + 1);
    with WarningMessage[high(WarningMessage)] do begin
      capStr:= Cap;
      msgStr:= Yell;
      params:= VarrecsToWstrs(Param);
      inipar:= '';
    end;
  end;


  
  Procedure GiveWarning(_inipar: string; Cap, Yell :TMessageID; Param: array of const);
  begin
    if Config.Int['warnings', _inipar] = 1  then exit;
    SetLength(WarningMessage, length(WarningMessage) + 1);
    with WarningMessage[high(WarningMessage)] do begin
      capMID:= Cap;
      capStr:= '';
      msgMID:= Yell;
      msgStr:= '';
      params:= VarrecsToWstrs(Param);
      inipar:= _inipar;
      writeval:= 1;
      isyellow:= true;
    end;
  end;

  Procedure GiveWarningNotYellow(_inipar: string; Cap, Yell :TMessageID; Param: array of const);
  begin
    if Config.Int['warnings', _inipar] = 1  then exit;
    SetLength(WarningMessage, length(WarningMessage) + 1);
    with WarningMessage[high(WarningMessage)] do begin
      capMID:= Cap;
      capStr:= '';
      msgMID:= Yell;
      msgStr:= '';
      params:= VarrecsToWstrs(Param);
      inipar:= _inipar;
      writeval:= 1;
      isyellow:= false;
    end;
  end;



  procedure GiveWarning(_inipar: string; Cap, Yell :WideString; Param: array of const);
  begin
    if Config.Int['warnings', _inipar] = 1  then exit;
    SetLength(WarningMessage, length(WarningMessage) + 1);
    with WarningMessage[high(WarningMessage)] do begin
      capStr:= Cap;
      msgStr:= Yell;
      params:= VarrecsToWstrs(Param);
      inipar:= _inipar;
      writeval:= 1;
      isyellow:= true;
    end;
  end;


  
  Procedure GivePeriodicWarning(DaysToRepeat: float; _inipar: string; Cap, Yell :TMessageID; Param: array of const);
  var
    dd: integer;
  begin
    dd:= round(Now() / daysToRepeat);
    if Config.Int['warnings', _inipar] = dd  then exit;
    SetLength(WarningMessage, length(WarningMessage) + 1);
    with WarningMessage[high(WarningMessage)] do begin
      capMID:= Cap;
      capStr:= '';
      msgMID:= Yell;
      msgStr:= '';
      params:= VarrecsToWstrs(Param);
      inipar:= _inipar;
      writeval:= dd;
      isyellow:= true;
    end;
  end;
  

  function StopDying(): WideString;
  begin
{    if not Dying and (ExceptObject <> nil) and (ExceptObject is Exception)
      then Result:= ToldException(ExceptObject as Exception)
      else Result:=ExtractDyingYell(); }
      
    Result:=ExtractDyingYell();
    if not MotherState.NowDying or (Trim(Result) = ''){and (CurrentOwner = NOT_A_MODULE)} then CheckForGenericDyingYells(Result);

{    and (ExceptObject <> nil) and (ExceptObject is Exception)
      then Result:= Result + #10#13 + ToldException(ExceptObject as Exception);
}
    with MotherState do begin
      NowDying:=No;
      DyingAfterTrueException:=No;
      CallStackLogged:= No;
    end;
  end;

    var uckn: array [0..255] of string;

  function GetHotkeyName(var HK: TIntegerArray): string;
  var
    i: integer;
    kn: string;
  begin
    Result:='';
    For i:=0 to high(HK) do begin
      if i > 0 then Result += '+';
      kn:= GetEnumName(typeinfo(TKey), HK[i]);
      kn:= Copy(kn, 5, length(kn) - 4); //remove the 'KEY_' part
      Result += kn;
//addlog('---> %0  %1   %2  %3', [Result, kn, i, hk[i]]);
    end;
  end;

  procedure GetHotKeyFromConfig(par: string; var HK: TIntegerArray);
  var
    str, sp: string;
    i, j, n: integer;
  begin
    Try
      str:=Config.Str['main', par];
      i:=1;
      While StrParm(str, i, '+') <> '' do begin
        System.SetLength(HK, i);
        sp:=uppercase (Trim(StrParm(str, i, ['+'])));
        n:=0;
        For j:=1 to 255 do begin
          if uckn[j] = ''
            then uckn[j]:= uppercase(GetEnumName(typeinfo(TKey), j));
          if (sp = uckn[j] ) or ('KEY_' + sp = uckn[j] )
          then begin
            n:=j;
            break;
          end;
        end;
        if n = 0 then Die(MI_INVALID_HOST_HOTKEY_NAME, [uppercase(sp), MotherState.InstallPath]);
        HK[i - 1]:= n;
        inc(i);
      end;
    Except
      Die(MI_INVALID_HOST_HOTKEY_RECORD, [Config.Wherefoundname, 'main', par, str]);
    End;
  end;

  procedure GetHotKeysFromConfig;
  var
    i: integer;
  begin
    GetHotKeyFromConfig('Abort_Hotkey', AbortHotKey);
    GetHotKeyFromConfig('Restart_Hotkey', RestartHotKey);
    GetHotKeyFromConfig('Session_rollback_Hotkey', SessionRollbackHotKey);
    GetHotKeyFromConfig('Language_Hotkey', LanguageHotKey);
    GetHotKeyFromConfig('Console_Toggle_Hotkey', ConsoleToggleHotkey);
    GetHotKeyFromConfig('Console_Scroll_Up_Hotkey', ConsoleScrollUpHotkey);
    GetHotKeyFromConfig('Console_Scroll_Down_Hotkey', ConsoleScrollDownHotkey);
    GetHotKeyFromConfig('QualityFactorManualOverrideToggleHotkey', QualityFactorManualOverrideToggleHotkey);

    For i:=0 to 0 {MAX_MODULE} do GetHotKeyFromConfig('Module_'+IntToStr(i) + '_Hotkey', ModuleHotKey[i]);
  end;
  
  function TEngineObjects.AddObj(i: TObject): integer;
  begin
    Result:= Self.Add(i);
    if MotherState.DebugMode then AddLog('Added engine object #%0 (%1)', [Result + 1, AnsiString(i.ClassName)]);
  end;

  
  procedure VyRussifyResourceStrings;
  Var I,J : Longint;
      S, S1 : WideString;
  begin
// FPC 2.2.0: /home/cheb/chentrah/modules/chentrah/src/cge.pp(1162,41)
// Error: Identifier not found "ResourceStringTableCount"

(*    For I:=0 to ResourceStringTableCount-1 do
      For J:=0 to ResourceStringCount(i)-1 do
        begin
          S:=AnsiToWide(GetResourceStringDefaultValue(I,J));
          S1:=S;
          if S = 'Vampyre Imaging Library' then S:='Vampyre Imaging Library';
          if S = 'Exception Message' then S:='Сообщение';
          if S = 'All Images' then S:='Все изображения';
          if S = 'Unknown and unsupported format' then S:='Неизвестный и неподдерживаемый формат';
          if S = 'Error while freeing image. %s' then S:='Ошибка при освобождении изображения. %s';
          if S = 'Error while cloning image. %s' then S:='Ошибка при клонировании изображения. %s';
{
          if S = 'Error while flipping image. %s' then S:='';
          if S = 'Error while mirroring image. %s' then S:='';
          if S = 'Error while resizing image.  %s' then S:='';
          if S = 'Error while swapping channels of image. %s' then S:='';
          if S = 'Image Format "%s" does not support loading images.' then S:='';
}
          if S = 'Image Format "%s" does not support saving images.' then S:='Для формата "%s" не поддерживается запись.';
{
          if S = 'Error while creating image data with params: Width=%d ' +
            'Height=%d Format=%s.' then S:='';
}
          if S = 'Error while converting image to format "%s". %s' then S:='Ошибка при преобразовании изображения в формат "%s". %s';
{
          if S = 'Image @%p info: Width = %dpx, Height = %dpx, ' +
            'Format = %s, Size = %.0nKiB, Bits @%p, Palette @%p.' then S:='';
}
          if S = 'Access violation encountered when getting info on ' +
            'image at address %p.' then S:='Нарушение прав доступа к памяти (Access violation) при получении информации о изображении по адресу %p.';
          if S = 'File "%s" is not valid image in "%s" format.' then S:='Файл "%s" не является исправным изображением формата "%s".';
{
          if S = 'Stream %p does not contain valid image in "%s" format.' then S:='';
          if S = 'Memory %p (%d Bytes) does not contain valid image ' +
            'in "%s" format.' then S:='';
}
          if S = 'Error while loading images from file "%s" (file format: %s).' then S:='Ошибка при загрузке изображения из файла "%s" (формат файла: %s)';
          if S = 'Error while saving images to file "%s" (file format: %s).' then S:='Ошибка при сохранении изображения в файл "%s" (формат файла: %s)';
{
          if S = 'Error while loading images from stream %p (file format: %s).' then S:='';
          if S = 'Error while loading images from memory %p (%d Bytes) (file format: %s).' then S:='';
          if S = 'Error while saving images to stream %p (file format: %s).' then S:='';
          if S = 'Error while saving images to memory %p (%d Bytes) (file format: %s).' then S:='';
          if S = 'Error while finding color in palette @%p with %d entries.' then S:='';
          if S = 'Error while filling grayscale palette @%p with %d entries.' then S:='';
          if S = 'Error while filling custom palette @%p with %d entries.' then S:='';
          if S = 'Error while swapping channels of palette @%p with %d entries.' then S:='';
          if S = 'Error while reducing number of colors of image to %d. %s' then S:='';
          if S = 'Error while generating %d mipmap levels for image %s' then S:='';
          if S = 'One or more images are not valid.' then S:='';
          if S = 'Error while copying rect from image %s to image %s.' then S:='';
          if S = 'Error while mapping image %s to palette.' then S:='';
          if S = 'Error while filling rectangle X:%d Y:%d W:%d H:%d in image %s' then S:='';
          if S = 'Error while splitting image %s to %dx%d sized chunks.' then S:='';
          if S = 'Error while making %d color palette for %d images.' then S:='';
          if S = 'Error while creating new palette with %d entries' then S:='';
          if S = 'Error while freeing palette @%p' then S:='';
          if S = 'Error while copying %d entries from palette @%p to @%p' then S:='';
          if S = 'Error while replacing colors in rectangle X:%d Y:%d W:%d H:%d of image %s' then S:='';
          if S = 'Error while rotating image %s by %d degrees' then S:='';
          if S = 'Error while stretching rect from image %s to image %s.' then S:='';
}
          If S1 <> S then SetResourceStringValue(I,J,WideToAnsi(S));
        end;
*)
  end;

  procedure StartVampyre;
  var
    I: TImageData;
    dllname: string;
  begin
//addlog(' sizeof(opj_image_comp) = %0',[sizeof(opj_image_comp)]);
//addlog(' sizeof(OPJ_COMPONENT_TYPE) = %0',[sizeof(OPJ_COMPONENT_TYPE)]);
    if MessageContainer.CurrentLanguage = 0//'RUSSIAN'
      then VyRussifyResourceStrings;
//J2k support removed
(*
    if (MotherState.InstallPath <> '') and Config.Bool['main', 'use_OpenJpeg']
    then try
      dllname:= Config.Path['OpenJPEG', 'j2k' + SystemSuffix];
      if dllname = '' then dllname:= UnmangleFileName(PChar(OpenJpegDll));
      if (ExtractFilePath(dllname) <> '') and not FileExists(dllname)
        then Die(MI_ERROR_FILE_NOT_FOUND, [OpenJpegDll])
      else;// CpsInitOpenJpeg(dllname);
      try
        InitImage(I);
        LoadImageFromMemory(@j2k_test_image, sizeof(j2k_test_image), I);
        FreeImage(I);
      except
        Die('Сбой при чтении пробного изображения',
              'Failed to load the test image',[]);
      end;
    except
      try
        Die(
         'Не удалось запустить поддержку jpeg2000' ,
         'Unable to init the jpeg2000 support',[]);
      except end;
      AddStopMessage(StopDying());
    end;
 *)
  end;

  function CGEPath(s: string): string;
  begin
    Result:=StrReplace(StrReplace(s, '{$PLATFORM}', SystemSuffix), '{$HOME}', MotherState.HomePath);
    if  (Result = '')
      or ({$ifdef unix}Result[1] <> '/'{$else}ExtractFileDrive(Result) = '' {$endif})
      then Result:=MotherState.InstallPath + Result;
    Result:=OptiPath(Result) + ExtractFileName(Result);
  end;
  
  function RuEn(Ru, En: WideString): WideString;
  begin
    if MotherState.IsRussian
      then Result:=Ru
      else Result:=En;
  end;

  function VersionToStr(major, minor, build: integer): AnsiString;
  begin
    Result:=format('%d.%.2d.%.4d' ,[Major, minor, build]);
  end;
  

  {$ifdef windows}
    var SHGetFolderPathA: function (p1: pointer; p2: integer; p3: pointer; p4: dword; p5: pointer): HResult; stdcall;
    const
      SHGFP_TYPE_CURRENT = 0;
      CSIDL_PROGRAM_FILES = $26;
      CSIDL_LOCAL_APPDATA = $1c;
      CSIDL_APPDATA = $1a;
      CSIDL_FLAG_NO_ALIAS = $1000;
      CSIDL_FLAG_CREATE = $8000; { (force creation of requested folder if it doesn't exist yet)     }

    function GetSpecialFolder(f: integer): AnsiString;
    var
      i: integer;
    begin
      if MotherState.LegacyWindowslacksFunctions then Result:= '<Error>'
      else begin
        SetLength(Result, MAX_PATH);
        FillChar(Result[1], Length(Result), 0);
        SHGetFolderPathA(nil, f or CSIDL_FLAG_CREATE, nil, SHGFP_TYPE_CURRENT, pointer(Result));
        for i:=1 to Length(Result) do
          if Result[i] = #0 then begin
            SetLength(Result, i - 1);
            break;
          end;
        if Result > '' then begin
          Result[1]:= UpCase(Result[1]);
          Result:=IncludeTrailingPathDelimiter(Result);
        end;
      end;
    end;

    function GetProgramFilesDir: ansistring;
    begin
      Result:=GetSpecialFolder(CSIDL_PROGRAM_FILES);
    end;

    function GetLocalAppDataDir: ansistring;
    begin
      Result:=GetSpecialFolder(CSIDL_APPDATA);
    end;

    function GetUserName: widestring;
    var L: cardinal;
    begin
      if MotherState.LegacyWindowslacksFunctions then Result:='<Unknown>'
      else begin
        SetLength(Result, 1000);
        L:=Length(Result);
        if not windows.GetUserNameW(@Result[1], @L)
          then Exit('<ERROR>');
        SetLength(Result, max(0, L - 1)); //don't forget the trailing zero!
      end;
    end;


    const
      SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)) ;
      SECURITY_BUILTIN_DOMAIN_RID = $00000020;
      DOMAIN_ALIAS_RID_ADMINS = $00000220;

    function GetRunningAsAdmin: longbool;
    var
      hAccessToken: THandle;
      ptgGroups: PTokenGroups;
      dwInfoBufferSize: DWORD;
      psidAdministrators: PSID;
      g: Integer;
      bSuccess: BOOL;
    begin
      Result := False;
      if MotherState.LegacyWindowslacksFunctions then exit;
      if not OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken)
      then begin
        if (GetLastError <> ERROR_NO_TOKEN)
         or not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken)
           then Exit(false);
      end;
      GetMem(ptgGroups, 1024) ;
      if GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize)
      then begin
        CloseHandle(hAccessToken) ;
        AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators) ;
        for g := 0 to ptgGroups^.GroupCount - 1 do
          if EqualSid(psidAdministrators, ptgGroups^.Groups[g].Sid) then
          begin
            Result := True;
            Break;
          end;
        FreeSid(psidAdministrators) ;
      end;
      FreeMem(ptgGroups) ;
    end;

  {$endif}
  
  function BacktrackSymlink(a: ansistring): ansistring;
  var
    b: string;
  begin
    {$ifdef unix}
     while true do begin
       b:= fpReadLink(a);
       if b = '' then break;
       a:= b;
     end;
    {$endif}
     Result:=a;
  end;

//  var ExePath, StdLocation, AltLocation, StdHome: ansistring;

  procedure CheckIfUserNameValid(deadly: boolean);
  var
    i: integer;
    s: ansistring;
    oops: boolean = No;
  begin
   {$ifdef windows}
    if (MotherState.OS in WindowsEmulators)
      or (MotherState.LegacyWindowslacksFunctions) then Exit;
    if MotherState.UserNameUcs16 <> AnsiToWide(WideToAnsi(MotherState.UserNameUcs16))
       then oops:= Yes;
    s:= GetLocalAppDataDir();
    for i:=1 to length(s) do if s[i] = '?' then oops:= Yes;
    if oops then begin
      if deadly then AddStopMessage(MI_INVALID_USER_NAME,[MotherState.UserNameUcs16, s])
                else GiveWarning(
                       Utf8Encode(MotherState.UserNameUcs16) + '-invalid-name',
                            MI_WARN_WARNING,
                            MI_INVALID_USER_NAME, [MotherState.UserNameUcs16, s]);
    end;
   {$endif}
  end;
  
  {$ifdef unix}

  function GetPhysicalMemorySize: integer;
  //wtf? they seem to be defined in libc.pp!
  const
    _SC_UIO_MAXIOV = 60;
    _SC_PHYS_PAGES = (_SC_UIO_MAXIOV)+25;
  var
    p: TLoggedProcess;
    s2: string = '';
    i,j: integer;
    procedure SayOops;
    begin
      WriteLn('FAILED TO DETERMINE RAM SIZE, ASSUMING 1024 Mb');
    end;
  begin
    p:= TLoggedProcess.Create('head -n20 /proc/meminfo');
    p.Execute;
    for i:=0 to p.log.Count-1 do
      if (copy (p.log[i], 1, 9) = 'MemTotal:') then begin
        for j:=1 to length(p.log[i]) do
          if p.log[i][j] in ['0'..'9'] then s2+= p.log[i][j];
        break;
      end;
    if s2 = '' then begin
      SayOops;
      Result:= 1024;
    end
    else begin
      try
        Result:= StrToInt(s2) div 1024;
      except
        WriteLn((ExceptObject as Exception).ClassName, '  ', (ExceptObject as Exception).Message);
        SayOops;
        Result:= 1024;
      end;
      if Result < 90 then begin
        WriteLn('RAM SIZE SUSPICIOUSLY SMALL (', Result, ' Mb). ASSUMING 256 Mb');
        Result:= 256;
      end;
    end;
    p.Free;
    //old version, relied on the libc unit.
    //Result:= sysconf(_SC_PHYS_PAGES) * 4096//sysconf(_SC_PAGE_SIZE)//can't find numeric value for it
     //         div (1024*1024);
  end;

  {$ifndef darwin}
  procedure DetectLinuxVersionString;
  var
    p: TLoggedProcess;
    i: integer;
    w: WideString = '';
    a: Utf8String;
    S: TFileStream;
  begin
    p:= TLoggedProcess.Create('lsb_release -d');
    p.Execute;
    for i:=0 to p.log.Count-1 do
      if (copy (p.log[i], 1, 13) = 'Description:'#$09) then begin
        w:= Utf8Decode(trim(copy(p.log[i], 14, length(p.log[i]))));
        break;
      end;
    p.Free;
    if w <> '' then MotherState.OSName:= w
    else try
      S:=TFileStream.Create('z:\etc\issue', fmOpenRead);
      i:= min(S.Size, 300);
      SetLength(a, i);
      S.ReadBuffer(a[1], i);
      S.Free;
      a:= StringReplace(a, '\n', ' ', [rfReplaceAll, rfIgnoreCase]);
      a:= StringReplace(a, '\l', ' ', [rfReplaceAll, rfIgnoreCase]);
      a:= StringReplace(a, #10, ' ', [rfReplaceAll, rfIgnoreCase]);
      a:= StringReplace(a, #13, ' ', [rfReplaceAll, rfIgnoreCase]);
      a:= trim(a);
      if a <> '' then MotherState.OSName:= Utf8Decode(a);
    except
    end;
  end;
  {$endif}

  {$else}
  function GetPhysicalMemorySize: integer; // in Mbytes
  var
    Status : TMemoryStatus;
  begin
    Status.dwLength := sizeof( TMemoryStatus ) ;
    GlobalMemoryStatus( Status ) ;
    Result:=Status.dwTotalPhys div (1024*1024);
  end;
  {$endif}

  var
    HomepathThatBeenNonWriteable: ansistring = '';
    
  procedure DetermineInstallPath;
    function IsProgramDir(a: ansistring): boolean;
    begin
      Result:= FileExists(IncludeTrailingPathDelimiter(a) + MyAppName + '.ini');
      if Result then MotherState.InstallPath:=a;
    end;
  begin
    with MotherState do begin
      ProgramDirIsWriteable:= No;
      ExePath:=ExtractFilePath({BacktrackSymlink}(ParamStr(0)));
      InstallPath:='';
    {$ifdef unix}
      {$ifdef darwin}
        {$fatal Oopsie... Not ported yet.}
      {$else}
        Username:=Trim(GetEnvironmentVariable('USER'));
        UserNameUcs16:= Utf8Decode(Username);
        if not IsProgramDir(Exepath)
           and not IsProgramDir('/usr/share/' + MyAppName +'/')
           and not IsProgramDir('/usr/local/share/' + MyAppName +'/')
          then AddStopMessage(MI_INSTALL_DIR_NOT_FOUND, ['/usr/share/' + MyAppName +'/', ExePath]);
        if (UserName = 'root') or (Copy (MotherState.HomePath, 1, 6) = '/root/')
          then AddStopMessage(MI_BAD_USER_NO_ROOT, [CgeString]);
      {$endif}
    {$else}
      UsernameUcs16:= GetUserName;
      UserName:= WideToAnsi(UserNameUcs16);
      if not IsProgramDir(Exepath)
        and not IsProgramDir(GetProgramFilesDir + MyAppName + '\')
        then AddStopMessage(MI_INSTALL_DIR_NOT_FOUND, [GetProgramFilesDir + MyAppName + '\', ExePath]);
    {$endif}
      HomePath:= '';
    end;
  end;

  procedure DetermineHomePath;
    var
      H: boolean = true;
      I: boolean = true;
      mainreason: boolean;
    procedure TryHomePath;
    begin
      with MotherState do begin
        HomePath:= StdHomePath;
        if not ValidateWritePath(Homepath) then begin
          HomepathThatBeenNonWriteable:= HomePath;
          H:= false;
        end;
      end;
    end;
    procedure TryInstallPath;
    begin
      I:= ValidateWritePath(MotherState.InstallPath);
      MotherState.ProgramDirIsWriteable:= I;
      if I then MotherState.HomePath:= MotherState.InstallPath;
    end;
  begin
    with MotherState do begin
      if ExePath = '' then exit;
      StdHomePath:= Config.Path[OstId, 'save-path'];
      IsPortable:= Config.Bool['main','portable'];
      ProgramDirIsWriteable:= No;
      mainreason:= Config.Bool[OstId, 'try-program-dir-first'] or DeveloperMode or IsPortable;
      if mainreason {$ifdef windows} or MotherState.LegacyWindowslacksFunctions {$endif}
      then begin
        if LegacyWindowslacksFunctions and not mainreason
          then HomePathWarning:= hfwWin9x
          else
            if not IsPortable then HomePathWarning:= hfwUseI;
        TryInstallPath;
        if not I then begin
          if MotherState.LegacyWindowslacksFunctions then begin
            AddStopMessage(MI_LEGACY_WIN_USING_I,[AnsiToWide(InstallPath)]);
            AddStopMessage(MI_INSTALL_DIR_NOT_WRITEABLE,[AnsiToWide(InstallPath), UserNameUcs16]);
            HomePath:='';
            Exit;
          end
          else begin
            HomePathwarning:= hfwTriedIUseH;
            TryHomePath;
          end;
        end;
        if not H then begin
          AddStopMessage(MI_INSTALL_DIR_NOT_WRITEABLE,[AnsiToWide(InstallPath), UserNameUcs16]);
          AddStopMessage(MI_HOME_PATH_NOT_FOUND,[AnsiToWide(HomePath), UserNameUcs16]);
          HomePath:= '';
        end;
      end
      else begin
        TryHomePath;
        if not H then begin
          HomePath:='';
          HomePathwarning:= hfwTriedHuseI;
          if Config.Bool[OstId, 'try-program-dir-if-save-path-not-writeable']
            then begin
            TryInstallPath;
            if not I then begin
              AddStopMessage(MI_HOME_PATH_NOT_FOUND,[AnsiToWide(HomePath), UserNameUcs16]);
              AddStopMessage(MI_INSTALL_DIR_NOT_WRITEABLE,[AnsiToWide(InstallPath), UserNameUcs16]);
              HomePath:= '';
            end;
          end
          else
            AddStopMessage(MI_HOME_PATH_NOT_FOUND,[AnsiToWide(HomePath), UserNameUcs16]);
        end;
      end;
      if HomePath <> '' then HomePath:= IncludeTrailingpathDelimiter(HomePath);
    end;
  end;


   procedure chCopyFile(n1, n2: string);
   var
     s1, s2: TFileStream;
     f: file;
     sz: int64;
   begin
     try
       _MakeSurePathExists(PChar(ExtractFilePath(n2)));
       CheckForGuardedException;
       if FileExists(n2) then try
         AssignFile(f, n2);
         Erase(f);
       except
         Die(MI_ERROR_CANNOT_DESTROY_FILE,[n2]);
       end;
       s1:=TFileStream.Create(n1, fmOpenRead);
       s2:=TFileStream.Create(n2, fmCreate);
       sz:= s2.CopyFrom(s1, s1.Size);
       if sz <> s1.Size then Die(RuEn('Файл скопировался не полностью', 'File did not copy completely'));
     except
       s1.Free;
       s2.Free;
       Die(MI_CANNOT_COPY_FILE, [n1, n2]);
     end;
     s1.Free;
     s2.Free;
   end;
   

  var
    Wgiven: boolean = No;

  procedure GiveWarnings;
  begin
    if Wgiven then exit;
    GiveWarningNotYellow('gpl', MI_WARN_GNU_GPL_CAPTION, MI_WARN_GNU_GPL,
      [
       RuEn(CgeStringRu, CgeStringEn),
       AnsiToWide(MotherState.InstallPath) + 'license' + PathSlash +'gpl.txt',
       RuEn(CopyrightRu, CopyrightEn),
       RuEn(CopyrightLibsRu, CopyrightLibsEn)
      ]);

    if MotherState.DeveloperMode then GiveWarning('developer_mode', MI_WARN_WARNING, MI_WARN_DEVELOPER_MODE,
      [
        CgeString,
        AnsiToWide(MotherState.InstallPath) + MyAppName + '.ini'
      ]);
      
   {$ifdef windows}
    if MotherState.Win98LacksUnicodeSupport
      then GiveWarning('win98-no-unicode', MI_WARN_WARNING, MI_WINDOWS_98_NO_UNICODE_SUPPORT, []);
   {$endif}

    if not (MotherState.os in SupportedOSes)
      then GiveWarning(
         OsName[MotherState.OS] + '-unsupported', MI_WARN_WARNING,
          MI_UNSUPPORTED_OS, [CgeString, OsName[MotherState.OS]]);
          
    if not MotherState.IsPortable then
      case HomePathWarning of
        hfwNone:;
        hfwTriedIUseH: GiveWarning(
          Utf8Encode(MotherState.UserNameUcs16) + '-' + MotherState.OstID + '-install-path-not-writeable-use-home-path',
          MI_WARN_WARNING,
          MI_I_PATH_NON_WRITEABLE_USING_H,
          [AnsiToWide(MotherState.HomePath), AnsiToWide(MotherState.InstallPath),
           MotherState.UserNameUcs16, OsName[MotherState.OS]]);
        hfwTriedHuseI: GiveWarning(
          Utf8Encode(MotherState.UserNameUcs16) + '-' + MotherState.OstID + '-home-path-not-writeable-use-install-path',
          MI_WARN_WARNING,
          MI_H_PATH_NON_WRITEABLE_USING_I,
          [AnsiToWide(MotherState.StdHomePath), AnsiToWide(MotherState.InstallPath),
           MotherState.UserNameUcs16, OsName[MotherState.OS]]);
        hfwUseI: GiveWarning(
          Utf8Encode(MotherState.UserNameUcs16) + '-' + MotherState.OstID + '-using-install-path',
          MI_WARN_WARNING,
          MI_USING_I,
          [AnsiToWide(MotherState.StdHomePath), AnsiToWide(MotherState.InstallPath),
           OsName[MotherState.OS]]);
        hfwWin9x:  GiveWarning(
          MotherState.OstID + '-no-multiuser-support-using-install-path',
          MI_WARN_WARNING,
          MI_LEGACY_WIN_USING_I,
          [AnsiToWide(MotherState.InstallPath)]);
      else
        Die('missing case branch for HomePathWarning %0 in cl_main.inc', [GetEnumName(TypeInfo(THomePathWarning),ord(HomePathWarning))]);
      end;

    if MotherState.PhysMemory < OsReqMem[MotherState.OS]
      then GiveWarning(OsName[MotherState.OS] + '--phys-mem', MI_WARN_WARNING,
        MI_TOO_LITTLE_PHYSICAL_MEMORY, [OsName[MotherState.OS],
        OsReqMemRep[MotherState.OS], MotherState.PhysMemory]);


    if MotherState.DebugMode then GiveWarning('debug_mode', MI_WARN_WARNING, MI_WARN_DEBUG_MODE,
      [
        CgeString,
        AnsiToWide(MotherState.InstallPath) + MyAppName + '.ini'
      ]);

    Wgiven:= Yes;
  end;

  {$ifdef unix}
  function GetDLLFileName(h: pointer): ansistring;
  var
    dlinfo: dl_info;
  begin
    FillChar(dlinfo, sizeof(dlinfo), 0);
    dladdr(h, @dlinfo);
    Result:= String(dlinfo.dli_fname);
  end;
  {$else}
  function GetDLLFileName(h: THandle): ansistring;
  var
    TST: array[0..Max_Path] of Char;
  begin
    GetModuleFileName(h, TST, SizeOf(TST));
    Result:= String(PChar(@TST));
  end;
  {$endif}

  function FancyFunc(f: double): glFloat;
  {A non-linear function for screen fade in from black.
   The input is time scaled to 0.0..1.0 (but may go beyond 1.0)}
  begin
    if f < 0 then Result:=0
    else
      if f > 1 then Result:=1
      else
        if f < 0.5
          then Result:= 0.5 * sqr(f * 2)
          else Result:= 1 - 0.5 * sqr(( 1 - f)*2);
  end;

  function IniCompatibleStringForm(a: AnsiString): AnsiString;
  var i: integer;
  begin
    a:= LowerCase(a);
    Result:= '';
    for i:=1 to length(a) do
      if a[i] in ['a'..'z', '0'..'9', '-'] then Result+= a[i]
                                           else Result+= '_';
  end;

  function NewInputEvent: integer;
  begin
    Result:= length(MotherState.InputEvents) - 1;
    SetLength(MotherState.InputEvents, Result + 2);
    FillChar(MotherState.InputEvents[Result + 1], Sizeof(TInputEvent), 0);
    if Result < 0 then Result:= NewInputEvent(); //a perverted way to keep one ahead
  end;
  
  function GetAppNameEventOverride: string;
  begin
    Result:=MyAppName;
  end;

  procedure CheckForGuardedException;
  begin
    if MotherState.NowDying then raise Exception.Create('');
  end;
  
  procedure TCgeProcess.OnReadLn(ss: string);
  begin
    AddLogComment(#10#13'  ' + s);
    _cgeHeartBeat;
  end;

  procedure DisplayLastWill;
  var
    i: integer;
    F: File;
    u: AnsiString;
  begin
    For i:=1 to ParamCount do
      if copy(lowercase(ParamStr(i)), 1, 11) = '--last-will' then begin
        try
          AssignFile(F, _UnmangleFileName('*H/logs/last-last-will.txt'));
          Reset(F, 1);
          SetLength(u, FileSize(F));
          BlockRead(F, u[1], FileSize(F));
          CloseFile(F);
        except
          Halt(0);
          {Die(RuEn(
            'Не удалось прочитать файл с завещанием!',
            'Failed to read the last will file!'))}
        end;
{        AddLog(
          RuEn(
            'Получено завещание, вывожу диалоговое окно:#10#13#10#13%0',
            'Received a last will, displaying the dialog window:#10#13#10#13%0'),
          [utf8Decode(u)]
        );
}
        ErrorMessageBox(CGEString, utf8Decode(u));
        Halt(0);
      end;
  end;

  function BoolChars(b: boolean):string;
  begin
    if b then result:='true' else result:='false';
  end;

  const CharsTolerableInFileName: set of AnsiChar = ['_', '-', 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'];
  function SanateStringForFileName(s: AnsiString): AnsiString;
  var i: integer;
  begin
    SetLength(Result, Length(s));
    for i:=1 to length(s) do if s[i] in CharsTolerableInFileName then Result[i]:= s[i] else Result[i]:= '_';
  end;

  function CgeNeedToKeepModuleResources(): boolean; cdecl;
  begin
    Result:= Assigned(Module) and (MotherState.ModuleState  <> ms_Exiting); // (Module.IndexToLoad <> Module.Index);
  end;

  procedure InitMotherState;
  begin
    FillChar(MotherState, SizeOf(TMotherState), 0);
    MotherState.dwSize:= sizeof(TMotherState);
    MotherState.ExportHostProc:= @_ExportHostProc;
    MotherState.FPS:= 99.0;
    MotherState.QF:= 99.0;
    MotherState.PhysMemory:= GetPhysicalMemorySize();
    MotherState.FadeIn:= 0.0;
    MotherState.BlackoutStart:= Now() + INITIAL_BLACKOUT / SecondsPerDay;
    MotherState.LogoAnimationStart:= MotherState.BlackoutStart;
    MotherState.LogoAnimationPlaying:= No; //changed to Yes later
    MotherState.NeedToKeepModuleResources:= @CgeNeedToKeepModuleResources;
    MotherState.ProcessID:= GetProcessID();
    MotherState.MainThreadId:= GetCurrentThreadId();
    MotherState.RendererAlias:= '_unknown_';
    InitCriticalsection(MotherState.CriticalSection);
    _GenHash(PResourceHash(@MotherState.RunSessionHash));
  end;

procedure ReportFoundProc(procPtr: pointer; ProcName: ansistring);
var
  baseaddr: pointer;
  exename: string;
begin
  if not MotherState.DebugMode then exit;
  if Assigned(procPtr) then begin
    {$ifdef cpu64}
     AddLog('  %0() at %1', [ProcName, procPtr]);
    {$else}
     GetModuleByAddr(procPtr, baseaddr, exename);
     AddLog('  %0() at %1 in %2', [ProcName, procPtr, exename]);
    {$endif}
  end
  else
    AddLog('  %0() not found!', [ProcName]);
end;

{$ifdef windows}
type TTerminateProcess = function(hProcess:HANDLE; uExitCode:UINT):WINBOOL; stdcall;
var TerminateProcess: TTerminateProcess = nil;

  procedure LoadFunctionsUnsupportedInWindows98();
  var
    shell32, kernel32: THandle;
  begin
    if MotherState.DebugMode then AddLog('Dynamically loading Win32 API functions not supported by Windows 98...');
    shell32:= LoadLibrary('shell32.dll');
    pointer(SHGetFolderPathA):= GetProcAddress(shell32, 'SHGetFolderPathA');
    ReportFoundProc(@SHGetFolderPathA, 'SHGetFolderPathA');
    MotherState.LegacyWindowslacksFunctions:= not (
      Assigned(SHGetFolderPathA)
    );
    kernel32:= LoadLibrary('kernel32.dll');
    pointer(TerminateProcess):= GetProcAddress(kernel32, 'TerminateProcess');
    ReportFoundProc(@TerminateProcess, 'TerminateProcess');
  end;
  {$endif}


  {$ifdef windows}
  var
   rstp: TProcess;
  {$endif}

  procedure RestartMyself(param: ansistring);
  begin
    {$ifdef unix}
      fpExecL(ParamStr(0), [param]);
    {$else}
      rstp:=TProcess.Create(nil);
      rstp.CommandLine:= ParamStr(0) + ' ' + param;
      rstp.Options:=[poNoConsole];
      rstp.Execute;
//      ShellExecute(0, 'open', PChar(ParamStr(0)), '--restart', '', SW_SHOWNORMAL);
    {$endif}
  end;

  procedure KillMyself(exitcode: integer = 0);
  begin
    halt(exitcode);
    //seriously, there could be some threads locked up, so terminating self requires a decisive approach.
    {$ifdef unix}
      if MotherState.ProcessID > 0 then FpKill(MotherState.ProcessID, SIGKILL);
    {$else}
      if Assigned(TerminateProcess) and (MotherState.ExeHandle <> 0) then TerminateProcess(MotherState.ExeHandle, exitcode);//hara-kiri!
    {$endif}
    halt(exitcode);
  end;

  procedure ResetMotherErrorState();
  begin
    with MotherState do begin
      NowDying:= No;
      CallStackLogged:= No;
     {$ifdef windows}{$ifndef buildmein}
      sehh_ExceptionCode:= 0;
      sehh_ExceptionAddress:= 0;
     {$endif}{$endif}
   end;
  end;


  var
   BatteryStatusCheckMoment: TdateTime;
   PrevBatteryRemaining: integer = -1;

  procedure CheckBatteryStatus; //needed for limiting rendering settings when laptop runs on battery
 {$ifdef windows}
  var
    ps: SYSTEM_POWER_STATUS;
    F: TextFile;
  begin
    if Now() < BatteryStatusCheckMoment then Exit; //check every 10 seconds
    if not GetSystemPowerStatus(ps) then begin
      if MotherState.BatteryRemaining <> 255
        then AddLog(RuEn(
          'Не удалось получить от ОС состояние электропитания. Заряд батареи НЕ учитывается!',
          'Failed to get power status from the OS. The battery charge is NOT accounted for!'));
      MotherState.BatteryRemaining:= 255;
      BatteryStatusCheckMoment:= Now() + (5 * 60) / SecondsPerDay; //check again five minutes later
    end
    else if ps.ACLineStatus > 0 then begin
      BatteryStatusCheckMoment:= Now() + 10 / SecondsPerDay; //check often: what if it gets unplugged?
      MotherState.BatteryRemaining:= 255;
    end
    else begin
      MotherState.BatteryRemaining:= ps.BatteryLifePercent; //it's an unsigned byte, LOL.
      BatteryStatusCheckMoment:= Now() + 30 / SecondsPerDay;  //check two times a minute

      if MotherState.BatteryRemaining < 10 then begin
        _MakeSurePathExists(_UnmangleFileName('*H/logs'));
        AssignFile(F, _UnmangleFileName('*H/logs/last-last-will.txt'));
        Rewrite(F);
        WriteLn(F, Utf8Encode(RuEn(
          'Аварийный выход: батарея ноутбука щас сдохнет!',
          'Emergency shutdown: laptop battery is dying!')));
        CloseFile(F);
        RestartMyself('--last-will');
      end;
    end;
//if MotherState.VerboseLog and
    if (PrevBatteryRemaining <> MotherState.BatteryRemaining)
    then begin
      if MotherState.BatteryRemaining > 100
        then AddLog(RuEn('Питание от сети.', 'AC power.'))
        else AddLog(RuEn('Заряд батареи %0%.', 'Battery charge %0%.')
                    , [MotherState.BatteryRemaining]);
        PrevBatteryRemaining:= MotherState.BatteryRemaining;
    end;

  end;
 {$else}
  //not supported
  begin
    MotherState.BatteryRemaining:= 255;
  end;
 {$endif}

  {$ifdef unix}
    {$include cl_sigterm.inc} // intercepting sigterm to allow saving the session
  {$endif}

  {$ifdef win32}
    {$include cl_win98_u_test.inc} //test if windows 98 has unicode support installed
  {$endif}

  {$include cl_dyna.inc} //a bunch of legacy dynamic array classes
  
//  {$include cl_stream.inc}

  {$include cl_confman.inc} //configuration manager

  {$include cl_winman.inc} //the window manager basis, mostly platform-dependent
  
  {$include cl_window.inc} //the higher, platform-independent window manager logic

  {$include cl_soundman_oal.inc} //the sound manager, controls openal
  {$ifdef windows}
    {$include cl_soundman_dsound.inc}
  {$endif}
  {$include cl_soundman.inc}


  {$include un_talesteller.inc} //composes a detailed error message from the exception address
  
  {$include un_gl.inc} //dynamic loading opengl functions

  {$include cl_gl_init.inc} //loading opengl dll and getting functions from it

  {$include un_al.inc} //dynamic loading openal functions

  {$include cl_al_init.inc} //loading openal dll and getting functions from it

  {$ifdef windows}
    {$include cl_directsound_init.inc}
  {$endif}

  {$include cl_module.inc} //loading and interacting with the actual game module dll
  
//  {$include cl_container.inc}
  
  {$include cl_console.inc} //opengl log console, also renders background and logo
  
  {$include cl_main.inc} // procedure main()
  
  {$include cl_fixed_font.inc} //handling the bitmap font and rendering text using OpenGL FFP
  
  {$include cl_fps_counter.inc} //measure fps and render the counter

  {$include cl_msgbox.inc} //system error message boxes for different platforms

  {$include cl_lockupguard.inc} //a separate thread to commit harakiri if processing one frame takes more than 30 seconds

  {$include cl_log.inc}

  {$include un_wav_format.inc}

  {$include cl_gamepad.inc} // Xbox360 game controller support. Windows-only.
  
initialization
  pointer(OnGetApplicationName):= @GetAppNameEventOverride;
  
finalization
  Try
{$ifdef unix}
    if Di and FileExists(Fn) then DeleteFile(Fn);
{$else}
    if Di then ReleaseMutex(M);
{$endif}
  Except End;
end.


