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