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