src/game/g_main.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit g_main;
  17
  18 interface
  19
  20   uses Utils;
  21
  22 procedure Main ();
  23 procedure Init ();
  24 procedure Release ();
  25 procedure Update ();
  26 procedure Draw ();
  27 procedure KeyPress (K: Word);
  28 procedure CharPress (C: AnsiChar);
  29
  30 var
  31   {--- Read-only dirs ---}
  32   GameWAD: string;
  33   DataDirs: SSArray;
  34   ModelDirs: SSArray;
  35   MegawadDirs: SSArray;
  36   MapDirs: SSArray;
  37   WadDirs: SSArray;
  38   AllMapDirs: SSArray; // Maps + Megawads
  39
  40   {--- Read-Write dirs ---}
  41   LogFileName: string;
  42   LogDirs: SSArray;
  43   SaveDirs: SSArray;
  44   CacheDirs: SSArray;
  45   ConfigDirs: SSArray;
  46   ScreenshotDirs: SSArray;
  47   StatsDirs: SSArray;
  48   MapDownloadDirs: SSArray;
  49   WadDownloadDirs: SSArray;
  50
  51 implementation
  52
  53 uses
  54 {$INCLUDE ../nogl/noGLuses.inc}
  55 {$IFDEF ENABLE_HOLMES}
  56   g_holmes, sdlcarcass, fui_ctls, fui_wadread, fui_style, fui_gfx_gl,
  57 {$ENDIF}
  58 {$IFDEF LINUX}
  59   BaseUnix,
  60 {$ENDIF}
  61 {$IFDEF DARWIN}
  62   MacOSAll, CocoaAll,
  63 {$ENDIF}
  64 {$IFDEF USE_SDL2}
  65   SDL2,
  66 {$ENDIF}
  67   wadreader, e_log, g_window,
  68   e_graphics, e_input, g_game, g_console, g_gui,
  69   e_sound, g_options, g_sound, g_player, g_basic,
  70   g_weapons, SysUtils, g_triggers, MAPDEF, g_map, e_res,
  71   g_menu, g_language, g_net, g_touch, g_system, g_res_downloader,
  72   conbuf, envvars,
  73   xparser;
  74
  75
  76 var
  77   charbuff: packed array [0..15] of AnsiChar;
  78   binPath: AnsiString = '';
  79   forceBinDir: Boolean;
  80
  81 function GetBinaryPath (): AnsiString;
  82 {$IFDEF LINUX}
  83 var
  84   //cd: AnsiString;
  85   sl: AnsiString;
  86 {$ENDIF}
  87 begin
  88   result := ExtractFilePath(ParamStr(0));
  89   {$IFDEF LINUX}
  90   // it may be a symlink; do some guesswork here
  91   sl := fpReadLink(ExtractFileName(ParamStr(0)));
  92   if (sl = ParamStr(0)) then
  93   begin
  94     // use current directory, as we don't have anything better
  95     //result := '.';
  96     GetDir(0, result);
  97   end;
  98   {$ENDIF}
  99   result := fixSlashes(result);
 100   if (length(result) > 0) and (result[length(result)] <> '/') then result := result+'/';
 101 end;
 102
 103 procedure PrintDirs (msg: AnsiString; dirs: SSArray);
 104   var dir: AnsiString;
 105 begin
 106   e_LogWriteln(msg + ':');
 107   for dir in dirs do
 108     e_LogWriteln('  ' + dir);
 109 end;
 110
 111 {$IFDEF DARWIN}
 112   function NSStringToAnsiString (s: NSString): AnsiString;
 113     var i: Integer;
 114   begin
 115     result := '';
 116     for i := 0 to s.length - 1 do
 117       result := result + AnsiChar(s.characterAtIndex(i));
 118   end;
 119
 120   function GetBundlePath (): AnsiString;
 121     var pathRef: CFURLRef; pathCFStr: CFStringRef; pathStr: ShortString;
 122   begin
 123     pathRef := CFBundleCopyBundleURL(CFBundleGetMainBundle());
 124     pathCFStr := CFURLCopyFileSystemPath(pathRef, kCFURLPOSIXPathStyle);
 125     CFStringGetPascalString(pathCFStr, @pathStr, 255, CFStringGetSystemEncoding());
 126     CFRelease(pathRef);
 127     CFRelease(pathCFStr);
 128     Result := pathStr;
 129   end;
 130 {$ENDIF}
 131
 132 procedure InitPath;
 133   var i: Integer; rwdir, rodir: AnsiString; rwdirs, rodirs: SSArray;
 134
 135   procedure AddDir (var dirs: SSArray; append: AnsiString);
 136   begin
 137     SetLength(dirs, Length(dirs) + 1);
 138     dirs[High(dirs)] := ExpandFileName(append)
 139   end;
 140
 141   function IsSep (ch: Char): Boolean;
 142   begin
 143     {$IFDEF WINDOWS}
 144     result := (ch = '/') or (ch = '\');
 145     {$ELSE}
 146     result := (ch = '/');
 147     {$ENDIF}
 148   end;
 149
 150   function OptimizePath (dir: AnsiString): AnsiString;
 151     var i, len: Integer; s: AnsiString;
 152   begin
 153     i := 1; len := Length(dir); s := '';
 154     while i <= len do
 155     begin
 156       if IsSep(dir[i]) then
 157       begin
 158         s := s + DirectorySeparator;
 159         Inc(i);
 160         while (i <= len) and IsSep(dir[i]) do Inc(i);
 161         if (i <= len) and (dir[i] = '.') then
 162         begin
 163           if (i = len) or IsSep(dir[i + 1]) then
 164           begin
 165             Inc(i)
 166           end
 167           else if (i + 1 <= len) and (dir[i + 1] = '.') then
 168           begin
 169             if (i + 1 = len) or IsSep(dir[i + 2]) then
 170             begin
 171               s := e_UpperDir(s);
 172               Inc(i, 2)
 173             end
 174           end
 175         end
 176       end
 177       else
 178       begin
 179         s := s + dir[i];
 180         Inc(i)
 181       end
 182     end;
 183     result := s
 184   end;
 185
 186   procedure OptimizeDirs (var dirs: SSArray);
 187     var i, j, k: Integer;
 188   begin
 189     for i := 0 to High(dirs) do
 190       dirs[i] := OptimizePath(dirs[i]);
 191     // deduplicate
 192     i := High(dirs);
 193     while i >= 0 do
 194     begin
 195       j := 0;
 196       while j < i do
 197       begin
 198         if dirs[j] = dirs[i] then
 199         begin
 200           for k := j + 1 to High(dirs) do
 201             dirs[k - 1] := dirs[k];
 202           Dec(i);
 203           SetLength(dirs, High(dirs))
 204         end
 205         else
 206         begin
 207           Inc(j)
 208         end
 209       end;
 210       Dec(i)
 211     end
 212   end;
 213
 214   procedure AddDef (var dirs: SSArray; base: SSArray; append: AnsiString);
 215     var s: AnsiString;
 216   begin
 217     if Length(dirs) = 0 then
 218       for s in base do
 219         AddDir(dirs, e_CatPath(s, append));
 220     OptimizeDirs(dirs)
 221   end;
 222
 223   function GetDefaultRODirs (): SSArray;
 224     {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
 225       var home: AnsiString;
 226     {$ENDIF}
 227     {$IFDEF WINDOWS}
 228       var appdata: AnsiString;
 229     {$ENDIF}
 230     {$IFDEF DARWIN}
 231       var bundle, s: AnsiString; dirArr: NSArray; i: Integer;
 232     {$ENDIF}
 233   begin
 234     result := nil;
 235     {$IFDEF DARWIN}
 236       bundle := GetBundlePath();
 237       if ExtractFileExt(bundle) <> '.app' then
 238         AddDir(result, binpath);
 239     {$ELSE}
 240       AddDir(result, binPath);
 241     {$ENDIF}
 242     if forceBinDir = false then
 243     begin
 244       {$IFDEF USE_SDL2}
 245         AddDir(result, SDL_GetBasePath());
 246         AddDir(result, SDL_GetPrefPath('', 'doom2df'));
 247       {$ENDIF}
 248       {$IFDEF WINDOWS}
 249         appdata := GetEnvironmentVariable('APPDATA') + '\doom2df';
 250         if appdata <> '' then
 251           AddDir(result, appdata);
 252       {$ENDIF}
 253       {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
 254         AddDir(result, '/usr/share/doom2df');
 255         AddDir(result, '/usr/local/share/doom2df');
 256         home := GetEnvironmentVariable('HOME');
 257         if home <> '' then
 258           AddDir(result, e_CatPath(home, '.doom2df'));
 259       {$ENDIF}
 260       {$IFDEF DARWIN}
 261         bundle := GetBundlePath();
 262         if bundle <> '' then
 263           AddDir(result, e_CatPath(bundle, 'Contents/Resources'));
 264         dirArr := NSSearchPathForDirectoriesInDomains(NSApplicationSupportDirectory, NSUserDomainMask, true);
 265         for i := 0 to dirArr.count - 1 do
 266         begin
 267           s := NSStringToAnsiString(dirArr.objectAtIndex(i));
 268           AddDir(result, e_CatPath(s, 'Doom 2D Forever'))
 269         end;
 270       {$ENDIF}
 271       {$IF DEFINED(ANDROID) AND DEFINED(USE_SDL2)}
 272         AddDir(result, SDL_AndroidGetInternalStoragePath());
 273         if SDL_AndroidGetExternalStorageState() <> 0 then
 274           AddDir(result, SDL_AndroidGetExternalStoragePath());
 275       {$ENDIF}
 276     end
 277   end;
 278
 279   function GetDefaultRWDirs (): SSArray;
 280     {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
 281       var home: AnsiString;
 282     {$ENDIF}
 283     {$IFDEF WINDOWS}
 284       var appdata: AnsiString;
 285     {$ENDIF}
 286     {$IFDEF DARWIN}
 287       var bundle, s: AnsiString; dirArr: NSArray; i: Integer;
 288     {$ENDIF}
 289   begin
 290     result := nil;
 291     {$IFDEF DARWIN}
 292       bundle := GetBundlePath();
 293       if ExtractFileExt(bundle) <> '.app' then
 294         AddDir(result, binPath);
 295     {$ELSE}
 296       AddDir(result, binPath);
 297     {$ENDIF}
 298     if forceBinDir = false then
 299     begin
 300       {$IFDEF USE_SDL2}
 301         AddDir(result, SDL_GetPrefPath('', 'doom2df'));
 302       {$ENDIF}
 303       {$IFDEF WINDOWS}
 304         appdata := GetEnvironmentVariable('APPDATA') + '\doom2df';
 305         if appdata <> '' then
 306           AddDir(result, appdata);
 307       {$ENDIF}
 308       {$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN) AND NOT DEFINED(ANDROID)}
 309         home := GetEnvironmentVariable('HOME');
 310         if home <> '' then
 311           AddDir(result, e_CatPath(home, '.doom2df'));
 312       {$ENDIF}
 313       {$IFDEF DARWIN}
 314         dirArr := NSSearchPathForDirectoriesInDomains(NSApplicationSupportDirectory, NSUserDomainMask, true);
 315         for i := 0 to dirArr.count - 1 do
 316         begin
 317           s := NSStringToAnsiString(dirArr.objectAtIndex(i));
 318           AddDir(result, e_CatPath(s, 'Doom 2D Forever'))
 319         end;
 320       {$ENDIF}
 321       {$IF DEFINED(ANDROID) AND DEFINED(USE_SDL2)}
 322         if SDL_AndroidGetExternalStorageState() <> 0 then
 323           AddDir(result, SDL_AndroidGetExternalStoragePath());
 324       {$ENDIF}
 325     end
 326   end;
 327
 328 begin
 329   forceBinDir := false;
 330   binPath := GetBinaryPath();
 331
 332   i := 1;
 333   while i < ParamCount do
 334   begin
 335     case ParamStr(i) of
 336     '--like-windoze': forceBinDir := true;
 337     '--rw-dir':
 338       begin
 339         Inc(i);
 340         rwdir := ParamStr(i);
 341         (* RW *)
 342         AddDir(LogDirs, e_CatPath(rwdir, ''));
 343         AddDir(SaveDirs, e_CatPath(rwdir, 'data'));
 344         AddDir(CacheDirs, e_CatPath(rwdir, 'data/cache'));
 345         AddDir(ConfigDirs, e_CatPath(rwdir, ''));
 346         AddDir(MapDownloadDirs, e_CatPath(rwdir, 'maps/downloads'));
 347         AddDir(WadDownloadDirs, e_CatPath(rwdir, 'wads/downloads'));
 348         AddDir(ScreenshotDirs, e_CatPath(rwdir, 'screenshots'));
 349         AddDir(StatsDirs, e_CatPath(rwdir, 'stats'));
 350         (* RO *)
 351         AddDir(DataDirs, e_CatPath(rwdir, 'data'));
 352         AddDir(ModelDirs, e_CatPath(rwdir, 'data/models'));
 353         AddDir(MegawadDirs, e_CatPath(rwdir, 'maps/megawads'));
 354         AddDir(MapDirs, e_CatPath(rwdir, 'maps'));
 355         AddDir(WadDirs, e_CatPath(rwdir, 'wads'));
 356       end;
 357     '--ro-dir':
 358       begin
 359         Inc(i);
 360         rodir := ParamStr(i);
 361         (* RO *)
 362         AddDir(DataDirs, e_CatPath(rodir, 'data'));
 363         AddDir(ModelDirs, e_CatPath(rodir, 'data/models'));
 364         AddDir(MegawadDirs, e_CatPath(rodir, 'maps/megawads'));
 365         AddDir(MapDirs, e_CatPath(rodir, 'maps'));
 366         AddDir(WadDirs, e_CatPath(rodir, 'wads'));
 367       end;
 368     end;
 369     Inc(i)
 370   end;
 371
 372   // prefer bin dir if it writable and contains game.wad
 373   if forceBinDir = false then
 374   begin
 375     if findDiskWad(binPath + 'data' + '/' + 'GAME') <> '' then
 376       if e_CanCreateFilesAt(binPath) then
 377         forceBinDir := true
 378   end;
 379
 380   (* RO *)
 381   rodirs := GetDefaultRODirs();
 382   AddDef(DataDirs, rodirs, 'data');
 383   AddDef(ModelDirs, rodirs, 'data/models');
 384   AddDef(MegawadDirs, rodirs, 'maps/megawads');
 385   AddDef(MapDirs, rodirs, 'maps');
 386   AddDef(WadDirs, rodirs, 'wads');
 387
 388   (* RW *)
 389   rwdirs := GetDefaultRWDirs();
 390   AddDef(LogDirs, rwdirs, '');
 391   AddDef(SaveDirs, rwdirs, 'data');
 392   AddDef(CacheDirs, rwdirs, 'data/cache');
 393   AddDef(ConfigDirs, rwdirs, '');
 394   AddDef(MapDownloadDirs, rwdirs, 'maps/downloads');
 395   AddDef(WadDownloadDirs, rwdirs, 'wads/downloads');
 396   AddDef(ScreenshotDirs, rwdirs, 'screenshots');
 397   AddDef(StatsDirs, rwdirs, 'stats');
 398
 399   for i := 0 to High(MapDirs) do
 400     AddDir(AllMapDirs, MapDirs[i]);
 401   for i := 0 to High(MegawadDirs) do
 402     AddDir(AllMapDirs, MegawadDirs[i]);
 403   OptimizeDirs(AllMapDirs);
 404
 405   if LogFileName = '' then
 406   begin
 407     rwdir := e_GetWriteableDir(LogDirs, false);
 408     if rwdir <> '' then
 409     begin
 410       {$IFDEF HEADLESS}
 411         LogFileName := e_CatPath(rwdir, 'Doom2DF_H.log');
 412       {$ELSE}
 413         LogFileName := e_CatPath(rwdir, 'Doom2DF.log');
 414       {$ENDIF}
 415     end
 416   end;
 417
 418   // HACK: ensure the screenshots folder also has a stats subfolder in it
 419   rwdir := e_GetWriteableDir(ScreenshotDirs, false);
 420   if rwdir <> '' then CreateDir(rwdir + '/stats');
 421 end;
 422
 423 procedure InitPrep;
 424   {$IF DEFINED(ANDROID) AND DEFINED(USE_SDLMIXER)}
 425     var timiditycfg: AnsiString;
 426   {$ENDIF}
 427   var i: Integer;
 428 begin
 429   {$IFDEF HEADLESS}
 430     conbufDumpToStdOut := true;
 431   {$ENDIF}
 432   for i := 1 to ParamCount do
 433   begin
 434     if (ParamStr(i) = '--con-stdout') then
 435     begin
 436       conbufDumpToStdOut := true;
 437       break
 438     end
 439   end;
 440
 441   if LogFileName <> '' then
 442     e_InitLog(LogFileName, TWriteMode.WM_NEWFILE);
 443   e_InitWritelnDriver();
 444   e_WriteLog('Doom 2D: Forever version ' + GAME_VERSION + ' proto ' + IntToStr(NET_PROTOCOL_VER), TMsgType.Notify);
 445   e_WriteLog('Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME, TMsgType.Notify);
 446   e_WriteLog('Build hash: ' + g_GetBuildHash(), TMsgType.Notify);
 447   e_WriteLog('Build by: ' + g_GetBuilderName(), TMsgType.Notify);
 448
 449   e_LogWritefln('Force bin dir: %s', [forceBinDir], TMsgType.Notify);
 450   e_LogWritefln('BINARY PATH: [%s]', [binPath], TMsgType.Notify);
 451
 452   PrintDirs('DataDirs', DataDirs);
 453   PrintDirs('ModelDirs', ModelDirs);
 454   PrintDirs('MegawadDirs', MegawadDirs);
 455   PrintDirs('MapDirs', MapDirs);
 456   PrintDirs('WadDirs', WadDirs);
 457
 458   PrintDirs('LogDirs', LogDirs);
 459   PrintDirs('SaveDirs', SaveDirs);
 460   PrintDirs('CacheDirs', CacheDirs);
 461   PrintDirs('ConfigDirs', ConfigDirs);
 462   PrintDirs('ScreenshotDirs', ScreenshotDirs);
 463   PrintDirs('StatsDirs', StatsDirs);
 464   PrintDirs('MapDownloadDirs', MapDownloadDirs);
 465   PrintDirs('WadDownloadDirs', WadDownloadDirs);
 466
 467   GameWAD := e_FindWad(DataDirs, 'GAME');
 468   if GameWad = '' then
 469   begin
 470     e_WriteLog('GAME.WAD not installed?', TMsgType.Fatal);
 471     {$IF DEFINED(USE_SDL2) AND NOT DEFINED(HEADLESS)}
 472       if forceBinDir = false then
 473         SDL_ShowSimpleMessageBox(SDL_MESSAGEBOX_ERROR, 'Doom 2D Forever', 'GAME.WAD not installed?', nil);
 474     {$ENDIF}
 475     e_DeinitLog;
 476     Halt(1);
 477   end;
 478
 479   {$IF DEFINED(ANDROID) AND DEFINED(USE_SDLMIXER)}
 480     timiditycfg := 'timidity.cfg';
 481     if e_FindResource(ConfigDirs, timiditycfg) = true then
 482     begin
 483       timiditycfg := ExpandFileName(timiditycfg);
 484       SetEnvVar('TIMIDITY_CFG', timiditycfg);
 485       e_LogWritefln('Set TIMIDITY_CFG = "%s"', [timiditycfg]);
 486     end;
 487   {$ENDIF}
 488 end;
 489
 490 procedure Main();
 491 {$IFDEF ENABLE_HOLMES}
 492   var flexloaded: Boolean;
 493 {$ENDIF}
 494   var s: AnsiString;
 495 begin
 496   InitPath;
 497   InitPrep;
 498   e_InitInput;
 499   sys_Init;
 500
 501   g_Options_SetDefault;
 502   g_Options_SetDefaultVideo;
 503   s := CONFIG_FILENAME;
 504   if e_FindResource(ConfigDirs, s) = true then
 505     g_Options_Read(s);
 506   g_Console_SysInit;
 507   if sys_SetDisplayMode(gRC_Width, gRC_Height, gBPP, gRC_FullScreen, gRC_Maximized) = False then
 508     raise Exception.Create('Failed to set videomode on startup.');
 509
 510   e_WriteLog(gLanguage, TMsgType.Notify);
 511   g_Language_Set(gLanguage);
 512
 513 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
 514   flexloaded := true;
 515   if not fuiAddWad('flexui.wad') then
 516   begin
 517     if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
 518   end;
 519   try
 520     fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
 521     fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
 522     fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
 523     fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
 524     fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
 525   except on e: Exception do
 526     begin
 527       writeln('ERROR loading FlexUI fonts');
 528       flexloaded := false;
 529       //raise;
 530     end;
 531   else
 532     begin
 533       flexloaded := false;
 534       //raise;
 535     end;
 536   end;
 537   if (flexloaded) then
 538   begin
 539     try
 540       e_LogWriteln('FlexUI: loading stylesheet...');
 541       uiLoadStyles('flexui/widgets.wgs');
 542     except on e: TParserException do
 543       begin
 544         writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
 545         //raise;
 546         flexloaded := false;
 547       end;
 548     else
 549       begin
 550         //raise;
 551         flexloaded := false;
 552       end;
 553     end;
 554   end;
 555   g_holmes_imfunctional := not flexloaded;
 556
 557   if (not g_holmes_imfunctional) then
 558   begin
 559     uiInitialize();
 560     uiContext.font := 'win14';
 561   end;
 562
 563   if assigned(oglInitCB) then oglInitCB;
 564 {$ENDIF}
 565
 566   //g_Res_CreateDatabases(true); // it will be done before connecting to the server for the first time
 567
 568   e_WriteLog('Entering SDLMain', TMsgType.Notify);
 569
 570   {$WARNINGS OFF}
 571     SDLMain();
 572   {$WARNINGS ON}
 573
 574   {$IFDEF ENABLE_HOLMES}
 575     if assigned(oglDeinitCB) then oglDeinitCB;
 576   {$ENDIF}
 577
 578   g_Console_WriteGameConfig;
 579   sys_Final;
 580 end;
 581
 582 procedure Init();
 583 var
 584   NoSound: Boolean;
 585 begin
 586   Randomize;
 587
 588 {$IFDEF HEADLESS}
 589  {$IFDEF USE_SDLMIXER}
 590   NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
 591  {$ELSE}
 592   NoSound := True; // FMOD backend will sort it out
 593  {$ENDIF}
 594 {$ELSE}
 595   NoSound := False;
 596 {$ENDIF}
 597
 598   g_Touch_Init;
 599
 600 (*
 601   if (e_JoysticksAvailable > 0) then
 602     e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
 603   else
 604     e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
 605 *)
 606
 607   if (not gNoSound) then
 608   begin
 609     e_WriteLog('Initializing sound system', TMsgType.Notify);
 610     e_InitSoundSystem(NoSound);
 611   end;
 612
 613   e_WriteLog('Init game', TMsgType.Notify);
 614   g_Game_Init();
 615
 616   FillChar(charbuff, sizeof(charbuff), ' ');
 617 end;
 618
 619
 620 procedure Release();
 621 begin
 622   e_WriteLog('Releasing engine', TMsgType.Notify);
 623   e_ReleaseEngine();
 624
 625   e_WriteLog('Releasing input', TMsgType.Notify);
 626   e_ReleaseInput();
 627
 628   if not gNoSound then
 629   begin
 630     e_WriteLog('Releasing sound', TMsgType.Notify);
 631     e_ReleaseSoundSystem();
 632   end;
 633 end;
 634
 635
 636 procedure Update ();
 637 begin
 638   g_Game_Update();
 639 end;
 640
 641
 642 procedure Draw ();
 643 begin
 644   g_Game_Draw();
 645 end;
 646
 647
 648 function Translit (const S: AnsiString): AnsiString;
 649 var
 650   i: Integer;
 651 begin
 652   Result := S;
 653   for i := 1 to Length(Result) do
 654   begin
 655     case Result[i] of
 656       'É': Result[i] := 'Q';
 657       'Ö': Result[i] := 'W';
 658       'Ó': Result[i] := 'E';
 659       'Ê': Result[i] := 'R';
 660       'Å': Result[i] := 'T';
 661       'Í': Result[i] := 'Y';
 662       'Ã': Result[i] := 'U';
 663       'Ø': Result[i] := 'I';
 664       'Ù': Result[i] := 'O';
 665       'Ç': Result[i] := 'P';
 666       'Õ': Result[i] := '['; //Chr(219);
 667       'Ú': Result[i] := ']'; //Chr(221);
 668       'Ô': Result[i] := 'A';
 669       'Û': Result[i] := 'S';
 670       'Â': Result[i] := 'D';
 671       'À': Result[i] := 'F';
 672       'Ï': Result[i] := 'G';
 673       'Ð': Result[i] := 'H';
 674       'Î': Result[i] := 'J';
 675       'Ë': Result[i] := 'K';
 676       'Ä': Result[i] := 'L';
 677       'Æ': Result[i] := ';'; //Chr(186);
 678       'Ý': Result[i] := #39; //Chr(222);
 679       'ß': Result[i] := 'Z';
 680       '×': Result[i] := 'X';
 681       'Ñ': Result[i] := 'C';
 682       'Ì': Result[i] := 'V';
 683       'È': Result[i] := 'B';
 684       'Ò': Result[i] := 'N';
 685       'Ü': Result[i] := 'M';
 686       'Á': Result[i] := ','; //Chr(188);
 687       'Þ': Result[i] := '.'; //Chr(190);
 688     end;
 689   end;
 690 end;
 691
 692
 693 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
 694 var
 695   ls1, ls2: string;
 696 begin
 697   ls1 :=          CheatEng[ct];
 698   ls2 := Translit(CheatRus[ct]);
 699   if length(ls1) = 0 then ls1 := '~';
 700   if length(ls2) = 0 then ls2 := '~';
 701   result :=
 702     (Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)) = ls1) or
 703     (Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))) = ls1) or
 704     (Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)) = ls2) or
 705     (Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))) = ls2);
 706   {
 707   if ct = I_GAME_CHEAT_JETPACK then
 708   begin
 709     e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
 710     e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
 711     e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
 712     e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
 713     e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
 714     e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
 715   end;
 716   }
 717 end;
 718
 719
 720 procedure Cheat ();
 721 const
 722   CHEAT_DAMAGE = 500;
 723 label
 724   Cheated;
 725 var
 726   s, s2: string;
 727   c: ShortString;
 728   a: Integer;
 729 begin
 730   {
 731   if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
 732     (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
 733     or g_Game_IsNet then Exit;
 734   }
 735   if not gGameOn then exit;
 736   if not conIsCheatsEnabled then exit;
 737
 738   s := 'SOUND_GAME_RADIO';
 739
 740   //
 741   if CheckCheat(I_GAME_CHEAT_GODMODE) then
 742   begin
 743     if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
 744     if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
 745     goto Cheated;
 746   end;
 747   // RAMBO
 748   if CheckCheat(I_GAME_CHEAT_WEAPONS) then
 749   begin
 750     if gPlayer1 <> nil then gPlayer1.AllRulez(False);
 751     if gPlayer2 <> nil then gPlayer2.AllRulez(False);
 752     goto Cheated;
 753   end;
 754   // TANK
 755   if CheckCheat(I_GAME_CHEAT_HEALTH) then
 756   begin
 757     if gPlayer1 <> nil then gPlayer1.AllRulez(True);
 758     if gPlayer2 <> nil then gPlayer2.AllRulez(True);
 759     goto Cheated;
 760   end;
 761   // IDDQD
 762   if CheckCheat(I_GAME_CHEAT_DEATH) then
 763   begin
 764     if gPlayer1 <> nil then gPlayer1.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 765     if gPlayer2 <> nil then gPlayer2.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 766     s := 'SOUND_MONSTER_HAHA';
 767     goto Cheated;
 768   end;
 769   //
 770   if CheckCheat(I_GAME_CHEAT_DOORS) then
 771   begin
 772     g_Triggers_OpenAll();
 773     goto Cheated;
 774   end;
 775   // GOODBYE
 776   if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
 777   begin
 778     if gTriggers <> nil then
 779       for a := 0 to High(gTriggers) do
 780         if gTriggers[a].TriggerType = TRIGGER_EXIT then
 781         begin
 782           gExitByTrigger := True;
 783           //g_Game_ExitLevel(gTriggers[a].Data.MapName);
 784           g_Game_ExitLevel(gTriggers[a].tgcMap);
 785           Break;
 786         end;
 787     goto Cheated;
 788   end;
 789   //
 790   s2 := Copy(charbuff, 15, 2);
 791   if CheckCheat(I_GAME_CHEAT_CHANGEMAP, 2) and (s2[1] >= '0') and (s2[1] <= '9') and (s2[2] >= '0') and (s2[2] <= '9') then
 792   begin
 793     if g_Map_Exist(gGameSettings.WAD + ':\MAP' + s2) then
 794     begin
 795       c := 'MAP' + s2;
 796       g_Game_ExitLevel(c);
 797     end;
 798     goto Cheated;
 799   end;
 800   //
 801   if CheckCheat(I_GAME_CHEAT_FLY) then
 802   begin
 803     gFly := not gFly;
 804     goto Cheated;
 805   end;
 806   // BULLFROG
 807   if CheckCheat(I_GAME_CHEAT_JUMPS) then
 808   begin
 809     VEL_JUMP := 30-VEL_JUMP;
 810     goto Cheated;
 811   end;
 812   // FORMULA1
 813   if CheckCheat(I_GAME_CHEAT_SPEED) then
 814   begin
 815     MAX_RUNVEL := 32-MAX_RUNVEL;
 816     goto Cheated;
 817   end;
 818   // CONDOM
 819   if CheckCheat(I_GAME_CHEAT_SUIT) then
 820   begin
 821     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
 822     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
 823     goto Cheated;
 824   end;
 825   //
 826   if CheckCheat(I_GAME_CHEAT_AIR) then
 827   begin
 828     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
 829     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
 830     goto Cheated;
 831   end;
 832   // PURELOVE
 833   if CheckCheat(I_GAME_CHEAT_BERSERK) then
 834   begin
 835     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
 836     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
 837     goto Cheated;
 838   end;
 839   //
 840   if CheckCheat(I_GAME_CHEAT_JETPACK) then
 841   begin
 842     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
 843     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
 844     goto Cheated;
 845   end;
 846   // CASPER
 847   if CheckCheat(I_GAME_CHEAT_NOCLIP) then
 848   begin
 849     if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
 850     if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
 851     goto Cheated;
 852   end;
 853   //
 854   if CheckCheat(I_GAME_CHEAT_NOTARGET) then
 855   begin
 856     if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
 857     if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
 858     goto Cheated;
 859   end;
 860   // INFERNO
 861   if CheckCheat(I_GAME_CHEAT_NORELOAD) then
 862   begin
 863     if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
 864     if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
 865     goto Cheated;
 866   end;
 867   if CheckCheat(I_GAME_CHEAT_AIMLINE) then
 868   begin
 869     gAimLine := not gAimLine;
 870     goto Cheated;
 871   end;
 872   if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
 873   begin
 874     gShowMap := not gShowMap;
 875     goto Cheated;
 876   end;
 877   Exit;
 878
 879 Cheated:
 880   g_Sound_PlayEx(s);
 881 end;
 882
 883
 884 procedure KeyPress (K: Word);
 885 {$IFNDEF HEADLESS}
 886 var
 887   Msg: g_gui.TMessage;
 888 {$ENDIF}
 889 begin
 890 {$IFNDEF HEADLESS}
 891   case K of
 892     VK_ESCAPE: // <Esc>:
 893       begin
 894         if (g_ActiveWindow <> nil) then
 895         begin
 896           Msg.Msg := WM_KEYDOWN;
 897           Msg.WParam := VK_ESCAPE;
 898           g_ActiveWindow.OnMessage(Msg);
 899           if (not g_Game_IsNet) and (g_ActiveWindow = nil) then g_Game_Pause(false); //Fn loves to do this
 900         end
 901         else if (gState <> STATE_FOLD) then
 902         begin
 903           if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
 904           begin
 905             g_Game_InGameMenu(True);
 906           end
 907           else if (gExit = 0) and (gState <> STATE_SLIST) then
 908           begin
 909             if (gState <> STATE_MENU) then
 910             begin
 911               if (NetMode <> NET_NONE) then
 912               begin
 913                 g_Game_StopAllSounds(True);
 914                 g_Game_Free;
 915                 gState := STATE_MENU;
 916                 Exit;
 917               end;
 918             end;
 919             g_GUI_ShowWindow('MainMenu');
 920             g_Sound_PlayEx('MENU_OPEN');
 921           end;
 922         end;
 923       end;
 924
 925     IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
 926       begin // <F2> .. <F6> � <F12>
 927         if gGameOn and (not gConsoleShow) and (not gChatShow) then
 928         begin
 929           while (g_ActiveWindow <> nil) do g_GUI_HideWindow(False);
 930           if (not g_Game_IsNet) then g_Game_Pause(True);
 931           case K of
 932             IK_F2: g_Menu_Show_SaveMenu();
 933             IK_F3: g_Menu_Show_LoadMenu();
 934             IK_F4: g_Menu_Show_GameSetGame();
 935             IK_F5: g_Menu_Show_OptionsVideo();
 936             IK_F6: g_Menu_Show_OptionsSound();
 937             IK_F7: g_Menu_Show_EndGameMenu();
 938             IK_F10: g_Menu_Show_QuitGameMenu();
 939           end;
 940         end;
 941       end;
 942
 943     else
 944       begin
 945         gJustChatted := False;
 946         if gConsoleShow or gChatShow then
 947         begin
 948           g_Console_Control(K);
 949         end
 950         else if (g_ActiveWindow <> nil) then
 951         begin
 952           Msg.Msg := WM_KEYDOWN;
 953           Msg.WParam := K;
 954           g_ActiveWindow.OnMessage(Msg);
 955         end
 956         else if (gState = STATE_MENU) then
 957         begin
 958           g_GUI_ShowWindow('MainMenu');
 959           g_Sound_PlayEx('MENU_OPEN');
 960         end;
 961       end;
 962   end;
 963 {$ENDIF}
 964 end;
 965
 966
 967 procedure CharPress (C: AnsiChar);
 968 var
 969   Msg: g_gui.TMessage;
 970   a: Integer;
 971 begin
 972   if gConsoleShow or gChatShow then
 973   begin
 974     g_Console_Char(C)
 975   end
 976   else if (g_ActiveWindow <> nil) then
 977   begin
 978     Msg.Msg := WM_CHAR;
 979     Msg.WParam := Ord(C);
 980     g_ActiveWindow.OnMessage(Msg);
 981   end
 982   else
 983   begin
 984     for a := 0 to 14 do charbuff[a] := charbuff[a+1];
 985     charbuff[15] := upcase1251(C);
 986     Cheat();
 987   end;
 988 end;
 989
 990 end.