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