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, ConcatPaths([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, ConcatPaths([home, '.doom2df']));
 265       {$ENDIF}
 266       {$IFDEF DARWIN}
 267         bundle := GetBundlePath();
 268         if bundle <> '' then
 269           AddDir(result, ConcatPaths([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, ConcatPaths([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, ConcatPaths([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, ConcatPaths([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, ConcatPaths([rwdir, 'logs']));
 349         AddDir(SaveDirs, ConcatPaths([rwdir, 'data/saves']));
 350         AddDir(CacheDirs, ConcatPaths([rwdir, 'data/cache']));
 351         AddDir(ConfigDirs, ConcatPaths([rwdir, '']));
 352         AddDir(MapDownloadDirs, ConcatPaths([rwdir, 'maps/downloads']));
 353         AddDir(WadDownloadDirs, ConcatPaths([rwdir, 'wads/downloads']));
 354         AddDir(ScreenshotDirs, ConcatPaths([rwdir, 'screenshots']));
 355         AddDir(StatsDirs, ConcatPaths([rwdir, 'stats']));
 356         (* RO *)
 357         AddDir(DataDirs, ConcatPaths([rwdir, 'data']));
 358         AddDir(ModelDirs, ConcatPaths([rwdir, 'data/models']));
 359         AddDir(MegawadDirs, ConcatPaths([rwdir, 'maps/megawads']));
 360         AddDir(MapDirs, ConcatPaths([rwdir, 'maps']));
 361         AddDir(WadDirs, ConcatPaths([rwdir, 'wads']));
 362       end;
 363     '--ro-dir':
 364       begin
 365         Inc(i);
 366         rodir := ParamStr(i);
 367         (* RO *)
 368         AddDir(DataDirs, ConcatPaths([rodir, 'data']));
 369         AddDir(ModelDirs, ConcatPaths([rodir, 'data/models']));
 370         AddDir(MegawadDirs, ConcatPaths([rodir, 'maps/megawads']));
 371         AddDir(MapDirs, ConcatPaths([rodir, 'maps']));
 372         AddDir(WadDirs, ConcatPaths([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       LogFileName := ConcatPaths([rwdir, {$IFNDEF HEADLESS}'dfclient-'{$ELSE}'DFSERVER-'{$ENDIF}
 428         + date + '.log']);
 429     end
 430   end;
 431
 432   // HACK: ensure the screenshots folder also has a stats subfolder in it
 433   rwdir := e_GetWriteableDir(ScreenshotDirs, false);
 434   if rwdir <> '' then CreateDir(rwdir + '/stats');
 435 end;
 436
 437 function InitPrep: Boolean;
 438   var i: Integer;
 439 begin
 440   Result := False;
 441 {$IFDEF HEADLESS}
 442   conbufDumpToStdOut := True;
 443 {$ENDIF}
 444   for i := 1 to ParamCount do
 445   begin
 446     case ParamStr(i) of
 447       '--con-stdout': conbufDumpToStdOut := True;
 448       '--no-fbo': glRenderToFBO := False;
 449     end
 450   end;
 451
 452   if LogFileName <> '' then
 453     e_InitLog(LogFileName, TWriteMode.WM_NEWFILE);
 454   e_InitWritelnDriver();
 455   e_WriteLog('Doom 2D: Forever version ' + GAME_VERSION + ' proto ' + IntToStr(NET_PROTOCOL_VER), TMsgType.Notify);
 456   e_WriteLog('Build arch: ' + g_GetBuildArch(), TMsgType.Notify);
 457   e_WriteLog('Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME, TMsgType.Notify);
 458   e_WriteLog('Build hash: ' + g_GetBuildHash(), TMsgType.Notify);
 459   e_WriteLog('Build by: ' + g_GetBuilderName(), TMsgType.Notify);
 460
 461   e_LogWritefln('Force bin dir: %s', [forceBinDir], TMsgType.Notify);
 462   e_LogWritefln('BINARY PATH: [%s]', [binPath], TMsgType.Notify);
 463
 464   PrintDirs('DataDirs', DataDirs);
 465   PrintDirs('ModelDirs', ModelDirs);
 466   PrintDirs('MegawadDirs', MegawadDirs);
 467   PrintDirs('MapDirs', MapDirs);
 468   PrintDirs('WadDirs', WadDirs);
 469
 470   PrintDirs('LogDirs', LogDirs);
 471   PrintDirs('SaveDirs', SaveDirs);
 472   PrintDirs('CacheDirs', CacheDirs);
 473   PrintDirs('ConfigDirs', ConfigDirs);
 474   PrintDirs('ScreenshotDirs', ScreenshotDirs);
 475   PrintDirs('StatsDirs', StatsDirs);
 476   PrintDirs('MapDownloadDirs', MapDownloadDirs);
 477   PrintDirs('WadDownloadDirs', WadDownloadDirs);
 478
 479   GameWAD := e_FindWad(DataDirs, GameWADName);
 480   if GameWad = '' then
 481   begin
 482     e_WriteLog('WAD ' + GameWADName + ' not found in data directories.', TMsgType.Fatal);
 483     {$IF DEFINED(USE_SDL2) AND NOT DEFINED(HEADLESS)}
 484       if not forceBinDir then
 485         SDL_ShowSimpleMessageBox(
 486           SDL_MESSAGEBOX_ERROR,
 487           'Doom2D Forever',
 488           PChar('WAD ' + GameWADName + ' not found in data directories.'),
 489           nil
 490         );
 491     {$ENDIF}
 492     e_DeinitLog;
 493     exit;  // Halt(1) here will cause a memleak of strings GameWAD and "WAD <...> not found <...>"
 494   end;
 495
 496   Result := True;
 497 end;
 498
 499 procedure Main();
 500 {$IFDEF ENABLE_HOLMES}
 501 var
 502   flexloaded: Boolean;
 503 {$ENDIF}
 504 begin
 505   InitPath;
 506   if not InitPrep then Halt(1);
 507   e_InitInput;
 508   sys_Init;
 509
 510   g_Options_SetDefault;
 511   g_Options_SetDefaultVideo;
 512   g_Console_SysInit;
 513   if sys_SetDisplayMode(gRC_Width, gRC_Height, gBPP, gRC_FullScreen, gRC_Maximized) = False then
 514     raise Exception.Create('Failed to set videomode on startup.');
 515
 516   e_WriteLog(gLanguage, TMsgType.Notify);
 517   g_Language_Set(gLanguage);
 518
 519 {$IFDEF ENABLE_HOLMES}
 520   flexloaded := True;
 521   if not fuiAddWad('flexui.wad') then
 522     if not fuiAddWad('./data/flexui.wad') then
 523       fuiAddWad('./flexui.wad');
 524
 525   try
 526     fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
 527     fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
 528     fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
 529     fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
 530     fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
 531   except on e: Exception do
 532     begin
 533       writeln('ERROR loading FlexUI fonts');
 534       flexloaded := False;
 535       //raise;
 536     end;
 537   else
 538     begin
 539       flexloaded := False;
 540       //raise;
 541     end;
 542   end;
 543
 544   if flexloaded then
 545   begin
 546     try
 547       e_LogWriteln('FlexUI: loading stylesheet...');
 548       uiLoadStyles('flexui/widgets.wgs');
 549     except on e: TParserException do
 550       begin
 551         writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
 552         //raise;
 553         flexloaded := false;
 554       end;
 555     else
 556       begin
 557         //raise;
 558         flexloaded := false;
 559       end;
 560     end;
 561   end;
 562
 563   g_holmes_nonfunctional := not flexloaded;
 564   if not g_holmes_nonfunctional then
 565   begin
 566     if @oglInitCB <> nil then oglInitCB();
 567     uiInitialize();
 568     uiContext.font := 'win14';
 569   end;
 570 {$ENDIF}
 571
 572   //g_Res_CreateDatabases(true); // it will be done before connecting to the server for the first time
 573
 574   e_WriteLog('Entering PerformExecution', TMsgType.Notify);
 575 {$WARNINGS OFF}
 576   PerformExecution();
 577 {$WARNINGS ON}
 578
 579 {$IFDEF ENABLE_HOLMES}
 580   if not g_holmes_nonfunctional then
 581   begin
 582     uiDeinitialize();
 583     if @oglDeinitCB <> nil then oglDeinitCB();
 584   end;
 585 {$ENDIF}
 586
 587   g_Console_WriteGameConfig();
 588   sys_Final();
 589 end;
 590
 591 procedure Init();
 592 var
 593 {$IFDEF USE_SDLMIXER}
 594   timiditycfg: AnsiString;
 595   oldcwd, newcwd: RawByteString;
 596 {$ENDIF}
 597   NoSound: Boolean;
 598 begin
 599   Randomize;
 600
 601 {$IFDEF HEADLESS}
 602   {$IFDEF USE_SDLMIXER}
 603   NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
 604   {$ELSE}
 605   NoSound := True; // FMOD backend will sort it out
 606   {$ENDIF}
 607 {$ELSE}
 608   NoSound := False;
 609 {$ENDIF}
 610
 611   g_Touch_Init;
 612
 613 (*
 614   if (e_JoysticksAvailable > 0) then
 615     e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
 616   else
 617     e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
 618 *)
 619
 620   if gNoSound = false then
 621   begin
 622     e_WriteLog('Initializing sound system', TMsgType.Notify);
 623     {$IFDEF USE_SDLMIXER}
 624       newcwd := '';
 625       if UseNativeMusic then
 626         SetEnvVar('SDL_NATIVE_MUSIC', '1');
 627       timiditycfg := GetEnvironmentVariable('TIMIDITY_CFG');
 628       if timiditycfg = '' then
 629       begin
 630         timiditycfg := 'timidity.cfg';
 631         if e_FindResource(ConfigDirs, timiditycfg) OR e_FindResource(DataDirs, timiditycfg) then
 632         begin
 633           timiditycfg := ExpandFileName(timiditycfg);
 634           newcwd := ExtractFileDir(timiditycfg);
 635           SetEnvVar('TIMIDITY_CFG', timiditycfg);
 636         end
 637         else
 638           timiditycfg := '';
 639       end;
 640       e_LogWritefln('TIMIDITY_CFG = "%s"', [timiditycfg]);
 641       e_LogWritefln('SDL_NATIVE_MUSIC = "%s"', [GetEnvironmentVariable('SDL_NATIVE_MUSIC')]);
 642     {$ENDIF}
 643     e_InitSoundSystem(NoSound);
 644     {$IFDEF USE_SDLMIXER}
 645       if e_TimidityDecoder and (newcwd <> '') then
 646       begin
 647         (* HACK: Set CWD to load GUS patches relatively to cfg file. *)
 648         (*       CWD not restored after sound init because timidity  *)
 649         (*       store relative pathes internally and load patches   *)
 650         (*       later. I hope game never relies on CWD.             *)
 651         oldcwd := '';
 652         GetDir(0, oldcwd);
 653         ChDir(newcwd);
 654         e_logwritefln('WARNING: USED TIMIDITY CONFIG HACK, CWD SWITCHED "%s" -> "%s"', [oldcwd, newcwd]);
 655       end;
 656     {$ENDIF}
 657   end;
 658
 659   e_WriteLog('Init game', TMsgType.Notify);
 660   g_Game_Init();
 661
 662   FillChar(charbuff, sizeof(charbuff), ' ');
 663 end;
 664
 665
 666 procedure Release();
 667 begin
 668   e_WriteLog('Releasing engine', TMsgType.Notify);
 669   e_ReleaseEngine();
 670
 671   e_WriteLog('Releasing input', TMsgType.Notify);
 672   e_ReleaseInput();
 673
 674   if not gNoSound then
 675   begin
 676     e_WriteLog('Releasing sound', TMsgType.Notify);
 677     e_ReleaseSoundSystem();
 678   end;
 679 end;
 680
 681
 682 procedure Update ();
 683 begin
 684   // remember old mobj positions, prepare for update
 685   g_Game_PreUpdate();
 686   // server: receive client commands for new frame
 687   // client: receive game state changes from server
 688        if (NetMode = NET_SERVER) then g_Net_Host_Update()
 689   else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
 690   // think
 691   g_Game_Update();
 692   // server: send any accumulated outgoing data to clients
 693   if NetMode = NET_SERVER then g_Net_Flush();
 694 end;
 695
 696
 697 procedure Draw ();
 698 begin
 699   g_Game_Draw();
 700 end;
 701
 702
 703 function Translit (const S: AnsiString): AnsiString;
 704 var
 705   i: Integer;
 706 begin
 707   Result := S;
 708   for i := 1 to Length(Result) do
 709   begin
 710     case Result[i] of
 711       'É': Result[i] := 'Q';
 712       'Ö': Result[i] := 'W';
 713       'Ó': Result[i] := 'E';
 714       'Ê': Result[i] := 'R';
 715       'Å': Result[i] := 'T';
 716       'Í': Result[i] := 'Y';
 717       'Ã': Result[i] := 'U';
 718       'Ø': Result[i] := 'I';
 719       'Ù': Result[i] := 'O';
 720       'Ç': Result[i] := 'P';
 721       'Õ': Result[i] := '['; //Chr(219);
 722       'Ú': Result[i] := ']'; //Chr(221);
 723       'Ô': Result[i] := 'A';
 724       'Û': Result[i] := 'S';
 725       'Â': Result[i] := 'D';
 726       'À': Result[i] := 'F';
 727       'Ï': Result[i] := 'G';
 728       'Ð': Result[i] := 'H';
 729       'Î': Result[i] := 'J';
 730       'Ë': Result[i] := 'K';
 731       'Ä': Result[i] := 'L';
 732       'Æ': Result[i] := ';'; //Chr(186);
 733       'Ý': Result[i] := #39; //Chr(222);
 734       'ß': Result[i] := 'Z';
 735       '×': Result[i] := 'X';
 736       'Ñ': Result[i] := 'C';
 737       'Ì': Result[i] := 'V';
 738       'È': Result[i] := 'B';
 739       'Ò': Result[i] := 'N';
 740       'Ü': Result[i] := 'M';
 741       'Á': Result[i] := ','; //Chr(188);
 742       'Þ': Result[i] := '.'; //Chr(190);
 743     end;
 744   end;
 745 end;
 746
 747
 748 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
 749 var
 750   ls1, ls2: string;
 751 begin
 752   ls1 :=          CheatEng[ct];
 753   ls2 := Translit(CheatRus[ct]);
 754   if length(ls1) = 0 then ls1 := '~';
 755   if length(ls2) = 0 then ls2 := '~';
 756   result :=
 757     (Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)) = ls1) or
 758     (Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))) = ls1) or
 759     (Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)) = ls2) or
 760     (Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))) = ls2);
 761   {
 762   if ct = I_GAME_CHEAT_JETPACK then
 763   begin
 764     e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
 765     e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
 766     e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
 767     e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
 768     e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
 769     e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
 770   end;
 771   }
 772 end;
 773
 774
 775 procedure Cheat ();
 776 const
 777   CHEAT_DAMAGE = 500;
 778 label
 779   Cheated;
 780 var
 781   s, s2: string;
 782   c: ShortString;
 783   a: Integer;
 784 begin
 785   {
 786   if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
 787     (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
 788     or g_Game_IsNet then Exit;
 789   }
 790   if not gGameOn then exit;
 791   if not conIsCheatsEnabled then exit;
 792
 793   s := 'SOUND_GAME_RADIO';
 794
 795   //
 796   if CheckCheat(I_GAME_CHEAT_GODMODE) then
 797   begin
 798     if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
 799     if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
 800     goto Cheated;
 801   end;
 802   // RAMBO
 803   if CheckCheat(I_GAME_CHEAT_WEAPONS) then
 804   begin
 805     if gPlayer1 <> nil then gPlayer1.TankRamboCheats(False);
 806     if gPlayer2 <> nil then gPlayer2.TankRamboCheats(False);
 807     goto Cheated;
 808   end;
 809   // TANK
 810   if CheckCheat(I_GAME_CHEAT_HEALTH) then
 811   begin
 812     if gPlayer1 <> nil then gPlayer1.TankRamboCheats(True);
 813     if gPlayer2 <> nil then gPlayer2.TankRamboCheats(True);
 814     goto Cheated;
 815   end;
 816   // IDDQD
 817   if CheckCheat(I_GAME_CHEAT_DEATH) then
 818   begin
 819     if gPlayer1 <> nil then gPlayer1.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 820     if gPlayer2 <> nil then gPlayer2.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 821     s := 'SOUND_MONSTER_HAHA';
 822     goto Cheated;
 823   end;
 824   //
 825   if CheckCheat(I_GAME_CHEAT_DOORS) then
 826   begin
 827     g_Triggers_OpenAll();
 828     goto Cheated;
 829   end;
 830   // GOODBYE
 831   if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
 832   begin
 833     if gTriggers <> nil then
 834       for a := 0 to High(gTriggers) do
 835         if gTriggers[a].TriggerType = TRIGGER_EXIT then
 836         begin
 837           gExitByTrigger := True;
 838           //g_Game_ExitLevel(gTriggers[a].Data.MapName);
 839           g_Game_ExitLevel(gTriggers[a].tgcMap);
 840           Break;
 841         end;
 842     goto Cheated;
 843   end;
 844   //
 845   s2 := Copy(charbuff, 15, 2);
 846   if CheckCheat(I_GAME_CHEAT_CHANGEMAP, 2) and (s2[1] >= '0') and (s2[1] <= '9') and (s2[2] >= '0') and (s2[2] <= '9') then
 847   begin
 848     if g_Map_Exist(gGameSettings.WAD + ':\MAP' + s2) then
 849     begin
 850       c := 'MAP' + s2;
 851       g_Game_ExitLevel(c);
 852     end;
 853     goto Cheated;
 854   end;
 855   //
 856   if CheckCheat(I_GAME_CHEAT_FLY) then
 857   begin
 858     gFly := not gFly;
 859     goto Cheated;
 860   end;
 861   // BULLFROG
 862   if CheckCheat(I_GAME_CHEAT_JUMPS) then
 863   begin
 864     VEL_JUMP := 30-VEL_JUMP;
 865     goto Cheated;
 866   end;
 867   // FORMULA1
 868   if CheckCheat(I_GAME_CHEAT_SPEED) then
 869   begin
 870     MAX_RUNVEL := 32-MAX_RUNVEL;
 871     goto Cheated;
 872   end;
 873   // CONDOM
 874   if CheckCheat(I_GAME_CHEAT_SUIT) then
 875   begin
 876     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
 877     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
 878     goto Cheated;
 879   end;
 880   //
 881   if CheckCheat(I_GAME_CHEAT_AIR) then
 882   begin
 883     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
 884     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
 885     goto Cheated;
 886   end;
 887   // PURELOVE
 888   if CheckCheat(I_GAME_CHEAT_BERSERK) then
 889   begin
 890     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
 891     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
 892     goto Cheated;
 893   end;
 894   //
 895   if CheckCheat(I_GAME_CHEAT_JETPACK) then
 896   begin
 897     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
 898     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
 899     goto Cheated;
 900   end;
 901   // CASPER
 902   if CheckCheat(I_GAME_CHEAT_NOCLIP) then
 903   begin
 904     if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
 905     if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
 906     goto Cheated;
 907   end;
 908   //
 909   if CheckCheat(I_GAME_CHEAT_NOTARGET) then
 910   begin
 911     if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
 912     if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
 913     goto Cheated;
 914   end;
 915   // INFERNO
 916   if CheckCheat(I_GAME_CHEAT_NORELOAD) then
 917   begin
 918     if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
 919     if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
 920     goto Cheated;
 921   end;
 922   if CheckCheat(I_GAME_CHEAT_AIMLINE) then
 923   begin
 924     gAimLine := not gAimLine;
 925     goto Cheated;
 926   end;
 927   if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
 928   begin
 929     gShowMap := not gShowMap;
 930     goto Cheated;
 931   end;
 932   Exit;
 933
 934 Cheated:
 935   g_Sound_PlayEx(s);
 936 end;
 937
 938
 939 procedure KeyPress (K: Word);
 940 {$IFNDEF HEADLESS}
 941 var
 942   Msg: g_gui.TMessage;
 943 {$ENDIF}
 944 begin
 945 {$IFNDEF HEADLESS}
 946   case K of
 947     VK_ESCAPE: // <Esc>:
 948       begin
 949         if (g_ActiveWindow <> nil) then
 950         begin
 951           Msg.Msg := WM_KEYDOWN;
 952           Msg.WParam := VK_ESCAPE;
 953           g_ActiveWindow.OnMessage(Msg);
 954           if (not g_Game_IsNet) and (g_ActiveWindow = nil) then g_Game_Pause(false); //Fn loves to do this
 955         end
 956         else if (gState <> STATE_FOLD) then
 957         begin
 958           if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
 959           begin
 960             g_Game_InGameMenu(True);
 961           end
 962           else if (gExit = 0) and (gState <> STATE_SLIST) then
 963           begin
 964             if (gState <> STATE_MENU) then
 965             begin
 966               if (NetMode <> NET_NONE) then
 967               begin
 968                 g_Game_StopAllSounds(True);
 969                 g_Game_Free;
 970                 gState := STATE_MENU;
 971                 Exit;
 972               end;
 973             end;
 974             g_GUI_ShowWindow('MainMenu');
 975             g_Sound_PlayEx('MENU_OPEN');
 976           end;
 977         end;
 978       end;
 979
 980     IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
 981       begin // <F2> .. <F6> � <F12>
 982         if gGameOn and (not gConsoleShow) and (not gChatShow) then
 983         begin
 984           while (g_ActiveWindow <> nil) do g_GUI_HideWindow(False);
 985           if (not g_Game_IsNet) then g_Game_Pause(True);
 986           case K of
 987             IK_F2: g_Menu_Show_SaveMenu();
 988             IK_F3: g_Menu_Show_LoadMenu();
 989             IK_F4: g_Menu_Show_GameSetGame();
 990             IK_F5: g_Menu_Show_OptionsVideo();
 991             IK_F6: g_Menu_Show_OptionsSound();
 992             IK_F7: g_Menu_Show_EndGameMenu();
 993             IK_F10: g_Menu_Show_QuitGameMenu();
 994           end;
 995         end;
 996       end;
 997
 998     else
 999       begin
1000         gJustChatted := False;
1001         if gConsoleShow or gChatShow then
1002         begin
1003           g_Console_Control(K);
1004         end
1005         else if (g_ActiveWindow <> nil) then
1006         begin
1007           Msg.Msg := WM_KEYDOWN;
1008           Msg.WParam := K;
1009           g_ActiveWindow.OnMessage(Msg);
1010         end
1011         else if (gState = STATE_MENU) then
1012         begin
1013           g_GUI_ShowWindow('MainMenu');
1014           g_Sound_PlayEx('MENU_OPEN');
1015         end;
1016       end;
1017   end;
1018 {$ENDIF}
1019 end;
1020
1021
1022 procedure CharPress (C: AnsiChar);
1023 var
1024   Msg: g_gui.TMessage;
1025   a: Integer;
1026 begin
1027   if gConsoleShow or gChatShow then
1028   begin
1029     g_Console_Char(C)
1030   end
1031   else if (g_ActiveWindow <> nil) then
1032   begin
1033     Msg.Msg := WM_CHAR;
1034     Msg.WParam := Ord(C);
1035     g_ActiveWindow.OnMessage(Msg);
1036   end
1037   else
1038   begin
1039     for a := 0 to 14 do charbuff[a] := charbuff[a+1];
1040     charbuff[15] := upcase1251(C);
1041     Cheat();
1042   end;
1043 end;
1044
1045 initialization
1046 {$IFDEF USE_SDLMIXER}
1047   conRegVar('sdl_native_music', @UseNativeMusic, 'use native midi music output when possible', 'use native midi');
1048   {$IFDEF DARWIN}
1049     UseNativeMusic := true; (* OSX have a good midi support, so why not? *)
1050   {$ELSE}
1051     UseNativeMusic := false;
1052   {$ENDIF}
1053 {$ENDIF}
1054 end.