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