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