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 procedure Main ();
  21 procedure Init ();
  22 procedure Release ();
  23 procedure Update ();
  24 procedure Draw ();
  25 procedure KeyPress (K: Word);
  26 procedure CharPress (C: AnsiChar);
  27
  28 var
  29   GameDir: string;
  30   DataDir: string;
  31   MapsDir: string;
  32   ModelsDir: string;
  33   GameWAD: string;
  34   LogFileName: string;
  35
  36 implementation
  37
  38 uses
  39 {$INCLUDE ../nogl/noGLuses.inc}
  40 {$IFDEF ENABLE_HOLMES}
  41   g_holmes, fui_wadread, fui_style, fui_gfx_gl,
  42 {$ENDIF}
  43 {$IFDEF USE_SDL2}
  44   SDL2,
  45 {$ENDIF}
  46   wadreader, e_log, g_window,
  47   e_graphics, e_input, g_game, g_console, g_gui,
  48   e_sound, g_options, g_sound, g_player, g_basic,
  49   g_weapons, SysUtils, g_triggers, MAPDEF, g_map,
  50   g_menu, g_language, g_net, g_touch, g_system, g_res_downloader,
  51   utils, conbuf, envvars,
  52   xparser;
  53
  54
  55 var
  56   charbuff: packed array [0..15] of AnsiChar;
  57
  58 procedure Main();
  59 var
  60   sdlflags: LongWord;
  61 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
  62   flexloaded: Boolean;
  63 {$ENDIF}
  64 begin
  65   e_InitWritelnDriver();
  66
  67   GetDir(0, GameDir);
  68   MapsDir := GameDir + '/maps/';
  69   DataDir := GameDir + '/data/';
  70   ModelsDir := DataDir + 'models/';
  71   GameWAD := DataDir + 'Game.wad';
  72
  73   e_InitLog(GameDir + '/' + LogFileName, TWriteMode.WM_NEWFILE);
  74
  75   e_WriteLog(
  76     'Doom 2D: Forever version ' + GAME_VERSION +
  77     ' proto ' + IntToStr(NET_PROTOCOL_VER),
  78     TMsgType.Notify
  79   );
  80   e_WriteLog(
  81     'Build date: ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME,
  82     TMsgType.Notify
  83   );
  84
  85 {$IFDEF HEADLESS}
  86   conbufDumpToStdOut := true;
  87 {$ENDIF}
  88   e_WriteToStdOut := False; //{$IFDEF HEADLESS}True;{$ELSE}False;{$ENDIF}
  89
  90 {$IFDEF USE_SDL2}
  91 {$IFDEF HEADLESS}
  92  {$IFDEF USE_SDLMIXER}
  93   sdlflags := SDL_INIT_TIMER or SDL_INIT_AUDIO or $00004000;
  94   // HACK: shit this into env and hope for the best
  95   SetEnvVar('SDL_AUDIODRIVER', 'dummy');
  96  {$ELSE}
  97   sdlflags := SDL_INIT_TIMER or $00004000;
  98  {$ENDIF}
  99 {$ELSE}
 100  {$IFDEF USE_SDLMIXER}
 101   {*sdlflags := SDL_INIT_EVERYTHING;*}
 102   sdlflags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
 103  {$ELSE}
 104   sdlflags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
 105  {$ENDIF}
 106 {$ENDIF}
 107
 108   SDL_SetHint(SDL_HINT_ACCELEROMETER_AS_JOYSTICK, '0');
 109
 110   if SDL_Init(sdlflags) < 0 then
 111     raise Exception.Create('SDL: Init failed: ' + SDL_GetError());
 112 {$ENDIF}
 113
 114   e_WriteLog('Read config file', TMsgType.Notify);
 115   g_Options_Read(GameDir + '/' + CONFIG_FILENAME);
 116
 117   //GetSystemDefaultLCID()
 118
 119   //e_WriteLog('Read language file', MSG_NOTIFY);
 120   //g_Language_Load(DataDir + gLanguage + '.txt');
 121   e_WriteLog(gLanguage, TMsgType.Notify);
 122   g_Language_Set(gLanguage);
 123
 124 {$IFNDEF USE_SDL2}
 125   sys_Init;
 126 {$ENDIF}
 127
 128 {$IF not DEFINED(HEADLESS) and DEFINED(ENABLE_HOLMES)}
 129   flexloaded := true;
 130   if not fuiAddWad('flexui.wad') then
 131   begin
 132     if not fuiAddWad('./data/flexui.wad') then fuiAddWad('./flexui.wad');
 133   end;
 134   try
 135     fuiGfxLoadFont('win8', 'flexui/fonts/win8.fuifont');
 136     fuiGfxLoadFont('win14', 'flexui/fonts/win14.fuifont');
 137     fuiGfxLoadFont('win16', 'flexui/fonts/win16.fuifont');
 138     fuiGfxLoadFont('dos8', 'flexui/fonts/dos8.fuifont');
 139     fuiGfxLoadFont('msx6', 'flexui/fonts/msx6.fuifont');
 140   except on e: Exception do
 141     begin
 142       writeln('ERROR loading FlexUI fonts');
 143       flexloaded := false;
 144       //raise;
 145     end;
 146   else
 147     begin
 148       flexloaded := false;
 149       //raise;
 150     end;
 151   end;
 152   if (flexloaded) then
 153   begin
 154     try
 155       e_LogWriteln('FlexUI: loading stylesheet...');
 156       uiLoadStyles('flexui/widgets.wgs');
 157     except on e: TParserException do
 158       begin
 159         writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
 160         //raise;
 161         flexloaded := false;
 162       end;
 163     else
 164       begin
 165         //raise;
 166         flexloaded := false;
 167       end;
 168     end;
 169   end;
 170   g_holmes_imfunctional := not flexloaded;
 171 {$ENDIF}
 172
 173   //g_Res_CreateDatabases(); // it will be done before connecting to the server for the first time
 174
 175   e_WriteLog('Entering SDLMain', TMsgType.Notify);
 176
 177 {$WARNINGS OFF}
 178   SDLMain();
 179 {$WARNINGS ON}
 180
 181 {$IFDEF USE_SDL2}
 182   e_WriteLog('Releasing SDL', TMsgType.Notify);
 183   SDL_Quit();
 184 {$ELSE}
 185   sys_Final;
 186 {$ENDIF}
 187 end;
 188
 189 procedure Init();
 190 var
 191   NoSound: Boolean;
 192 begin
 193   Randomize;
 194
 195 {$IFDEF HEADLESS}
 196  {$IFDEF USE_SDLMIXER}
 197   NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
 198  {$ELSE}
 199   NoSound := True; // FMOD backend will sort it out
 200  {$ENDIF}
 201 {$ELSE}
 202   NoSound := False;
 203 {$ENDIF}
 204
 205   e_WriteLog('Init Input', TMsgType.Notify);
 206   e_InitInput();
 207   g_Touch_Init;
 208
 209 (*
 210   if (e_JoysticksAvailable > 0) then
 211     e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
 212   else
 213     e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
 214 *)
 215
 216   if (not gNoSound) then
 217   begin
 218     e_WriteLog('Initializing sound system', TMsgType.Notify);
 219     e_InitSoundSystem(NoSound);
 220   end;
 221
 222   e_WriteLog('Init game', TMsgType.Notify);
 223   g_Game_Init();
 224
 225   FillChar(charbuff, sizeof(charbuff), ' ');
 226 end;
 227
 228
 229 procedure Release();
 230 begin
 231   e_WriteLog('Releasing engine', TMsgType.Notify);
 232   e_ReleaseEngine();
 233
 234   e_WriteLog('Releasing Input', TMsgType.Notify);
 235   e_ReleaseInput();
 236
 237   if not gNoSound then
 238   begin
 239     e_WriteLog('Releasing FMOD', TMsgType.Notify);
 240     e_ReleaseSoundSystem();
 241   end;
 242 end;
 243
 244
 245 procedure Update ();
 246 begin
 247   g_Game_Update();
 248 end;
 249
 250
 251 procedure Draw ();
 252 begin
 253   g_Game_Draw();
 254 end;
 255
 256
 257 function Translit (const S: AnsiString): AnsiString;
 258 var
 259   i: Integer;
 260 begin
 261   Result := S;
 262   for i := 1 to Length(Result) do
 263   begin
 264     case Result[i] of
 265       'É': Result[i] := 'Q';
 266       'Ö': Result[i] := 'W';
 267       'Ó': Result[i] := 'E';
 268       'Ê': Result[i] := 'R';
 269       'Å': Result[i] := 'T';
 270       'Í': Result[i] := 'Y';
 271       'Ã': Result[i] := 'U';
 272       'Ø': Result[i] := 'I';
 273       'Ù': Result[i] := 'O';
 274       'Ç': Result[i] := 'P';
 275       'Õ': Result[i] := '['; //Chr(219);
 276       'Ú': Result[i] := ']'; //Chr(221);
 277       'Ô': Result[i] := 'A';
 278       'Û': Result[i] := 'S';
 279       'Â': Result[i] := 'D';
 280       'À': Result[i] := 'F';
 281       'Ï': Result[i] := 'G';
 282       'Ð': Result[i] := 'H';
 283       'Î': Result[i] := 'J';
 284       'Ë': Result[i] := 'K';
 285       'Ä': Result[i] := 'L';
 286       'Æ': Result[i] := ';'; //Chr(186);
 287       'Ý': Result[i] := #39; //Chr(222);
 288       'ß': Result[i] := 'Z';
 289       '×': Result[i] := 'X';
 290       'Ñ': Result[i] := 'C';
 291       'Ì': Result[i] := 'V';
 292       'È': Result[i] := 'B';
 293       'Ò': Result[i] := 'N';
 294       'Ü': Result[i] := 'M';
 295       'Á': Result[i] := ','; //Chr(188);
 296       'Þ': Result[i] := '.'; //Chr(190);
 297     end;
 298   end;
 299 end;
 300
 301
 302 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
 303 var
 304   ls1, ls2: string;
 305 begin
 306   ls1 :=          CheatEng[ct];
 307   ls2 := Translit(CheatRus[ct]);
 308   if length(ls1) = 0 then ls1 := '~';
 309   if length(ls2) = 0 then ls2 := '~';
 310   result :=
 311     (Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)) = ls1) or
 312     (Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))) = ls1) or
 313     (Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)) = ls2) or
 314     (Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))) = ls2);
 315   {
 316   if ct = I_GAME_CHEAT_JETPACK then
 317   begin
 318     e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
 319     e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
 320     e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
 321     e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
 322     e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
 323     e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
 324   end;
 325   }
 326 end;
 327
 328
 329 procedure Cheat ();
 330 const
 331   CHEAT_DAMAGE = 500;
 332 label
 333   Cheated;
 334 var
 335   s, s2: string;
 336   c: ShortString;
 337   a: Integer;
 338 begin
 339   {
 340   if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
 341     (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
 342     or g_Game_IsNet then Exit;
 343   }
 344   if not gGameOn then exit;
 345   if not conIsCheatsEnabled then exit;
 346
 347   s := 'SOUND_GAME_RADIO';
 348
 349   //
 350   if CheckCheat(I_GAME_CHEAT_GODMODE) then
 351   begin
 352     if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
 353     if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
 354     goto Cheated;
 355   end;
 356   // RAMBO
 357   if CheckCheat(I_GAME_CHEAT_WEAPONS) then
 358   begin
 359     if gPlayer1 <> nil then gPlayer1.AllRulez(False);
 360     if gPlayer2 <> nil then gPlayer2.AllRulez(False);
 361     goto Cheated;
 362   end;
 363   // TANK
 364   if CheckCheat(I_GAME_CHEAT_HEALTH) then
 365   begin
 366     if gPlayer1 <> nil then gPlayer1.AllRulez(True);
 367     if gPlayer2 <> nil then gPlayer2.AllRulez(True);
 368     goto Cheated;
 369   end;
 370   // IDDQD
 371   if CheckCheat(I_GAME_CHEAT_DEATH) then
 372   begin
 373     if gPlayer1 <> nil then gPlayer1.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 374     if gPlayer2 <> nil then gPlayer2.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 375     s := 'SOUND_MONSTER_HAHA';
 376     goto Cheated;
 377   end;
 378   //
 379   if CheckCheat(I_GAME_CHEAT_DOORS) then
 380   begin
 381     g_Triggers_OpenAll();
 382     goto Cheated;
 383   end;
 384   // GOODBYE
 385   if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
 386   begin
 387     if gTriggers <> nil then
 388       for a := 0 to High(gTriggers) do
 389         if gTriggers[a].TriggerType = TRIGGER_EXIT then
 390         begin
 391           gExitByTrigger := True;
 392           //g_Game_ExitLevel(gTriggers[a].Data.MapName);
 393           g_Game_ExitLevel(gTriggers[a].tgcMap);
 394           Break;
 395         end;
 396     goto Cheated;
 397   end;
 398   //
 399   s2 := Copy(charbuff, 15, 2);
 400   if CheckCheat(I_GAME_CHEAT_CHANGEMAP, 2) and (s2[1] >= '0') and (s2[1] <= '9') and (s2[2] >= '0') and (s2[2] <= '9') then
 401   begin
 402     if g_Map_Exist(MapsDir+gGameSettings.WAD+':\MAP'+s2) then
 403     begin
 404       c := 'MAP'+s2;
 405       g_Game_ExitLevel(c);
 406     end;
 407     goto Cheated;
 408   end;
 409   //
 410   if CheckCheat(I_GAME_CHEAT_FLY) then
 411   begin
 412     gFly := not gFly;
 413     goto Cheated;
 414   end;
 415   // BULLFROG
 416   if CheckCheat(I_GAME_CHEAT_JUMPS) then
 417   begin
 418     VEL_JUMP := 30-VEL_JUMP;
 419     goto Cheated;
 420   end;
 421   // FORMULA1
 422   if CheckCheat(I_GAME_CHEAT_SPEED) then
 423   begin
 424     MAX_RUNVEL := 32-MAX_RUNVEL;
 425     goto Cheated;
 426   end;
 427   // CONDOM
 428   if CheckCheat(I_GAME_CHEAT_SUIT) then
 429   begin
 430     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
 431     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
 432     goto Cheated;
 433   end;
 434   //
 435   if CheckCheat(I_GAME_CHEAT_AIR) then
 436   begin
 437     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
 438     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
 439     goto Cheated;
 440   end;
 441   // PURELOVE
 442   if CheckCheat(I_GAME_CHEAT_BERSERK) then
 443   begin
 444     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
 445     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
 446     goto Cheated;
 447   end;
 448   //
 449   if CheckCheat(I_GAME_CHEAT_JETPACK) then
 450   begin
 451     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
 452     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
 453     goto Cheated;
 454   end;
 455   // CASPER
 456   if CheckCheat(I_GAME_CHEAT_NOCLIP) then
 457   begin
 458     if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
 459     if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
 460     goto Cheated;
 461   end;
 462   //
 463   if CheckCheat(I_GAME_CHEAT_NOTARGET) then
 464   begin
 465     if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
 466     if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
 467     goto Cheated;
 468   end;
 469   // INFERNO
 470   if CheckCheat(I_GAME_CHEAT_NORELOAD) then
 471   begin
 472     if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
 473     if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
 474     goto Cheated;
 475   end;
 476   if CheckCheat(I_GAME_CHEAT_AIMLINE) then
 477   begin
 478     gAimLine := not gAimLine;
 479     goto Cheated;
 480   end;
 481   if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
 482   begin
 483     gShowMap := not gShowMap;
 484     goto Cheated;
 485   end;
 486   Exit;
 487
 488 Cheated:
 489   g_Sound_PlayEx(s);
 490 end;
 491
 492
 493 procedure KeyPress (K: Word);
 494 {$IFNDEF HEADLESS}
 495 var
 496   Msg: g_gui.TMessage;
 497 {$ENDIF}
 498 begin
 499 {$IFNDEF HEADLESS}
 500   case K of
 501     VK_ESCAPE: // <Esc>:
 502       begin
 503         if (g_ActiveWindow <> nil) then
 504         begin
 505           Msg.Msg := WM_KEYDOWN;
 506           Msg.WParam := VK_ESCAPE;
 507           g_ActiveWindow.OnMessage(Msg);
 508           if (not g_Game_IsNet) and (g_ActiveWindow = nil) then g_Game_Pause(false); //Fn loves to do this
 509         end
 510         else if (gState <> STATE_FOLD) then
 511         begin
 512           if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
 513           begin
 514             g_Game_InGameMenu(True);
 515           end
 516           else if (gExit = 0) and (gState <> STATE_SLIST) then
 517           begin
 518             if (gState <> STATE_MENU) then
 519             begin
 520               if (NetMode <> NET_NONE) then
 521               begin
 522                 g_Game_StopAllSounds(True);
 523                 g_Game_Free;
 524                 gState := STATE_MENU;
 525                 Exit;
 526               end;
 527             end;
 528             g_GUI_ShowWindow('MainMenu');
 529             g_Sound_PlayEx('MENU_OPEN');
 530           end;
 531         end;
 532       end;
 533
 534     IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
 535       begin // <F2> .. <F6> � <F12>
 536         if gGameOn and (not gConsoleShow) and (not gChatShow) then
 537         begin
 538           while (g_ActiveWindow <> nil) do g_GUI_HideWindow(False);
 539           if (not g_Game_IsNet) then g_Game_Pause(True);
 540           case K of
 541             IK_F2: g_Menu_Show_SaveMenu();
 542             IK_F3: g_Menu_Show_LoadMenu();
 543             IK_F4: g_Menu_Show_GameSetGame();
 544             IK_F5: g_Menu_Show_OptionsVideo();
 545             IK_F6: g_Menu_Show_OptionsSound();
 546             IK_F7: g_Menu_Show_EndGameMenu();
 547             IK_F10: g_Menu_Show_QuitGameMenu();
 548           end;
 549         end;
 550       end;
 551
 552     else
 553       begin
 554         gJustChatted := False;
 555         if gConsoleShow or gChatShow then
 556         begin
 557           g_Console_Control(K);
 558         end
 559         else if (g_ActiveWindow <> nil) then
 560         begin
 561           Msg.Msg := WM_KEYDOWN;
 562           Msg.WParam := K;
 563           g_ActiveWindow.OnMessage(Msg);
 564         end
 565         else if (gState = STATE_MENU) then
 566         begin
 567           g_GUI_ShowWindow('MainMenu');
 568           g_Sound_PlayEx('MENU_OPEN');
 569         end;
 570       end;
 571   end;
 572 {$ENDIF}
 573 end;
 574
 575
 576 procedure CharPress (C: AnsiChar);
 577 var
 578   Msg: g_gui.TMessage;
 579   a: Integer;
 580 begin
 581   if gConsoleShow or gChatShow then
 582   begin
 583     g_Console_Char(C)
 584   end
 585   else if (g_ActiveWindow <> nil) then
 586   begin
 587     Msg.Msg := WM_CHAR;
 588     Msg.WParam := Ord(C);
 589     g_ActiveWindow.OnMessage(Msg);
 590   end
 591   else
 592   begin
 593     for a := 0 to 14 do charbuff[a] := charbuff[a+1];
 594     charbuff[15] := upcase1251(C);
 595     Cheat();
 596   end;
 597 end;
 598
 599
 600 end.