src/game/g_main.pas

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