src/game/g_main.pas

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