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