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