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