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, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$MODE DELPHI}
  17 unit g_main;
  18
  19 interface
  20
  21 procedure Main();
  22 procedure Init();
  23 procedure Release();
  24 procedure Update();
  25 procedure Draw();
  26 procedure KeyPress(K: Word);
  27 procedure CharPress(C: Char);
  28
  29 var
  30   GameDir: string;
  31   DataDir: string;
  32   MapsDir: string;
  33   ModelsDir: string;
  34   GameWAD: string;
  35
  36 implementation
  37
  38 uses
  39   SDL2, GL, GLExt, wadreader, e_log, g_window,
  40   e_graphics, e_input, g_game, g_console, g_gui,
  41   e_sound, g_options, g_sound, g_player,
  42   g_weapons, SysUtils, g_triggers, MAPDEF, g_map,
  43   MAPSTRUCT, g_menu, g_language, g_net, utils;
  44
  45 var
  46   charbuff: Array [0..15] of Char;
  47
  48 procedure Main();
  49 var
  50   sdlflags: LongWord;
  51 begin
  52   e_InitWritelnDriver();
  53
  54   GetDir(0, GameDir);
  55   MapsDir := GameDir + '/maps/';
  56   DataDir := GameDir + '/data/';
  57   ModelsDir := DataDir + 'models/';
  58   GameWAD := DataDir + 'Game.wad';
  59
  60   e_InitLog(GameDir + '/' + LOG_FILENAME, WM_NEWFILE);
  61
  62   e_WriteLog('Read config file', MSG_NOTIFY);
  63   g_Options_Read(GameDir + '/' + CONFIG_FILENAME);
  64
  65   e_WriteToStdOut := {$IFDEF HEADLESS}True;{$ELSE}False;{$ENDIF}
  66
  67   //GetSystemDefaultLCID()
  68
  69   //e_WriteLog('Read language file', MSG_NOTIFY);
  70   //g_Language_Load(DataDir + gLanguage + '.txt');
  71   e_WriteLog(gLanguage, MSG_NOTIFY);
  72   g_Language_Set(gLanguage);
  73
  74 {$IFDEF HEADLESS}
  75   sdlflags := SDL_INIT_TIMER or $00004000;
  76 {$ELSE}
  77  {$IFDEF USE_SDLMIXER}
  78   sdlflags := SDL_INIT_EVERYTHING;
  79  {$ELSE}
  80   sdlflags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
  81  {$ENDIF}
  82 {$ENDIF}
  83   if SDL_Init(sdlflags) < 0 then
  84     raise Exception.Create('SDL: Init failed: ' + SDL_GetError());
  85
  86 {$IFDEF HEADLESS}
  87   SDL_StartTextInput();
  88 {$ENDIF}
  89
  90   e_WriteLog('Entering SDLMain', MSG_NOTIFY);
  91
  92 {$WARNINGS OFF}
  93   SDLMain();
  94 {$WARNINGS ON}
  95
  96 {$IFDEF HEADLESS}
  97   SDL_StopTextInput();
  98 {$ENDIF}
  99
 100   e_WriteLog('Releasing SDL', MSG_NOTIFY);
 101   SDL_Quit();
 102 end;
 103
 104 procedure Init();
 105 var
 106   a: Integer;
 107 begin
 108   Randomize;
 109
 110   e_WriteLog('Init Input', MSG_NOTIFY);
 111   e_InitInput();
 112
 113   if (e_JoysticksAvailable > 0) then
 114     e_WriteLog('Input: Joysticks available.', MSG_NOTIFY)
 115   else
 116     e_WriteLog('Input: No Joysticks.', MSG_NOTIFY);
 117
 118   if (not gNoSound) then
 119   begin
 120     e_WriteLog('Initializing sound system', MSG_NOTIFY);
 121     e_InitSoundSystem({$IFDEF HEADLESS}True{$ELSE}False{$ENDIF});
 122   end;
 123
 124   e_WriteLog('Init game', MSG_NOTIFY);
 125   g_Game_Init();
 126
 127   for a := 0 to 15 do charbuff[a] := ' ';
 128 end;
 129
 130 procedure Release();
 131 begin
 132   e_WriteLog('Releasing engine', MSG_NOTIFY);
 133   e_ReleaseEngine();
 134
 135   e_WriteLog('Releasing Input', MSG_NOTIFY);
 136   e_ReleaseInput();
 137
 138   if not gNoSound then
 139   begin
 140     e_WriteLog('Releasing FMOD', MSG_NOTIFY);
 141     e_ReleaseSoundSystem();
 142   end;
 143 end;
 144
 145 procedure Update();
 146 begin
 147   g_Game_Update();
 148 end;
 149
 150 procedure Draw();
 151 begin
 152   g_Game_Draw();
 153 end;
 154
 155 function Translit(S: String): String;
 156 var
 157   i: Integer;
 158 begin
 159   Result := S;
 160   for i := 1 to Length(Result) do
 161     case Result[i] of
 162       'É': Result[i] := 'Q';
 163       'Ö': Result[i] := 'W';
 164       'Ó': Result[i] := 'E';
 165       'Ê': Result[i] := 'R';
 166       'Å': Result[i] := 'T';
 167       'Í': Result[i] := 'Y';
 168       'Ã': Result[i] := 'U';
 169       'Ø': Result[i] := 'I';
 170       'Ù': Result[i] := 'O';
 171       'Ç': Result[i] := 'P';
 172       'Õ': Result[i] := '['; //Chr(219);
 173       'Ú': Result[i] := ']'; //Chr(221);
 174       'Ô': Result[i] := 'A';
 175       'Û': Result[i] := 'S';
 176       'Â': Result[i] := 'D';
 177       'À': Result[i] := 'F';
 178       'Ï': Result[i] := 'G';
 179       'Ð': Result[i] := 'H';
 180       'Î': Result[i] := 'J';
 181       'Ë': Result[i] := 'K';
 182       'Ä': Result[i] := 'L';
 183       'Æ': Result[i] := ';'; //Chr(186);
 184       'Ý': Result[i] := #39; //Chr(222);
 185       'ß': Result[i] := 'Z';
 186       '×': Result[i] := 'X';
 187       'Ñ': Result[i] := 'C';
 188       'Ì': Result[i] := 'V';
 189       'È': Result[i] := 'B';
 190       'Ò': Result[i] := 'N';
 191       'Ü': Result[i] := 'M';
 192       'Á': Result[i] := ','; //Chr(188);
 193       'Þ': Result[i] := '.'; //Chr(190);
 194     end;
 195 end;
 196
 197
 198 function CheckCheat (ct: TStrings_Locale; eofs: Integer=0): Boolean;
 199 var
 200   ls1, ls2: string;
 201 begin
 202   ls1 :=          CheatEng[ct];
 203   ls2 := Translit(CheatRus[ct]);
 204   if length(ls1) = 0 then ls1 := '~';
 205   if length(ls2) = 0 then ls2 := '~';
 206   result :=
 207     (Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)) = ls1) or
 208     (Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))) = ls1) or
 209     (Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)) = ls2) or
 210     (Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))) = ls2);
 211   {
 212   if ct = I_GAME_CHEAT_JETPACK then
 213   begin
 214     e_WriteLog('ls1: ['+ls1+']', MSG_NOTIFY);
 215     e_WriteLog('ls2: ['+ls2+']', MSG_NOTIFY);
 216     e_WriteLog('bf0: ['+Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1))+']', MSG_NOTIFY);
 217     e_WriteLog('bf1: ['+Translit(Copy(charbuff, 17-Length(ls1)-eofs, Length(ls1)))+']', MSG_NOTIFY);
 218     e_WriteLog('bf2: ['+Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2))+']', MSG_NOTIFY);
 219     e_WriteLog('bf3: ['+Translit(Copy(charbuff, 17-Length(ls2)-eofs, Length(ls2)))+']', MSG_NOTIFY);
 220   end;
 221   }
 222 end;
 223
 224
 225 procedure Cheat();
 226 const
 227   CHEAT_DAMAGE = 500;
 228 label
 229   Cheated;
 230 var
 231   s, s2: string;
 232   c: Char16;
 233   a: Integer;
 234 begin
 235   if (not gGameOn) or (not gCheats) or ((gGameSettings.GameType <> GT_SINGLE) and
 236     (gGameSettings.GameMode <> GM_COOP) and (not gDebugMode))
 237     or g_Game_IsNet then Exit;
 238
 239   s := 'SOUND_GAME_RADIO';
 240
 241   //
 242   if CheckCheat(I_GAME_CHEAT_GODMODE) then
 243   begin
 244     if gPlayer1 <> nil then gPlayer1.GodMode := not gPlayer1.GodMode;
 245     if gPlayer2 <> nil then gPlayer2.GodMode := not gPlayer2.GodMode;
 246     goto Cheated;
 247   end;
 248   // RAMBO
 249   if CheckCheat(I_GAME_CHEAT_WEAPONS) then
 250   begin
 251     if gPlayer1 <> nil then gPlayer1.AllRulez(False);
 252     if gPlayer2 <> nil then gPlayer2.AllRulez(False);
 253     goto Cheated;
 254   end;
 255   // TANK
 256   if CheckCheat(I_GAME_CHEAT_HEALTH) then
 257   begin
 258     if gPlayer1 <> nil then gPlayer1.AllRulez(True);
 259     if gPlayer2 <> nil then gPlayer2.AllRulez(True);
 260     goto Cheated;
 261   end;
 262   // IDDQD
 263   if CheckCheat(I_GAME_CHEAT_DEATH) then
 264   begin
 265     if gPlayer1 <> nil then gPlayer1.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 266     if gPlayer2 <> nil then gPlayer2.Damage(CHEAT_DAMAGE, 0, 0, 0, HIT_TRAP);
 267     s := 'SOUND_MONSTER_HAHA';
 268     goto Cheated;
 269   end;
 270   //
 271   if CheckCheat(I_GAME_CHEAT_DOORS) then
 272   begin
 273     g_Triggers_OpenAll();
 274     goto Cheated;
 275   end;
 276   // GOODBYE
 277   if CheckCheat(I_GAME_CHEAT_NEXTMAP) then
 278   begin
 279     if gTriggers <> nil then
 280       for a := 0 to High(gTriggers) do
 281         if gTriggers[a].TriggerType = TRIGGER_EXIT then
 282         begin
 283           gExitByTrigger := True;
 284           g_Game_ExitLevel(gTriggers[a].Data.MapName);
 285           Break;
 286         end;
 287     goto Cheated;
 288   end;
 289   //
 290   s2 := Copy(charbuff, 15, 2);
 291   if CheckCheat(I_GAME_CHEAT_CHANGEMAP, 2) and (s2[1] >= '0') and (s2[1] <= '9') and (s2[2] >= '0') and (s2[2] <= '9') then
 292   begin
 293     if g_Map_Exist(MapsDir+gGameSettings.WAD+':\MAP'+s2) then
 294     begin
 295       c := 'MAP00';
 296       c[3] := s2[1];
 297       c[4] := s2[2];
 298       g_Game_ExitLevel(c);
 299     end;
 300     goto Cheated;
 301   end;
 302   //
 303   if CheckCheat(I_GAME_CHEAT_FLY) then
 304   begin
 305     gFly := not gFly;
 306     goto Cheated;
 307   end;
 308   // BULLFROG
 309   if CheckCheat(I_GAME_CHEAT_JUMPS) then
 310   begin
 311     VEL_JUMP := 30-VEL_JUMP;
 312     goto Cheated;
 313   end;
 314   // FORMULA1
 315   if CheckCheat(I_GAME_CHEAT_SPEED) then
 316   begin
 317     MAX_RUNVEL := 32-MAX_RUNVEL;
 318     goto Cheated;
 319   end;
 320   // CONDOM
 321   if CheckCheat(I_GAME_CHEAT_SUIT) then
 322   begin
 323     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_SUIT);
 324     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_SUIT);
 325     goto Cheated;
 326   end;
 327   //
 328   if CheckCheat(I_GAME_CHEAT_AIR) then
 329   begin
 330     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_OXYGEN);
 331     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_OXYGEN);
 332     goto Cheated;
 333   end;
 334   // PURELOVE
 335   if CheckCheat(I_GAME_CHEAT_BERSERK) then
 336   begin
 337     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_MEDKIT_BLACK);
 338     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_MEDKIT_BLACK);
 339     goto Cheated;
 340   end;
 341   //
 342   if CheckCheat(I_GAME_CHEAT_JETPACK) then
 343   begin
 344     if gPlayer1 <> nil then gPlayer1.GiveItem(ITEM_JETPACK);
 345     if gPlayer2 <> nil then gPlayer2.GiveItem(ITEM_JETPACK);
 346     goto Cheated;
 347   end;
 348   // CASPER
 349   if CheckCheat(I_GAME_CHEAT_NOCLIP) then
 350   begin
 351     if gPlayer1 <> nil then gPlayer1.SwitchNoClip;
 352     if gPlayer2 <> nil then gPlayer2.SwitchNoClip;
 353     goto Cheated;
 354   end;
 355   //
 356   if CheckCheat(I_GAME_CHEAT_NOTARGET) then
 357   begin
 358     if gPlayer1 <> nil then gPlayer1.NoTarget := not gPlayer1.NoTarget;
 359     if gPlayer2 <> nil then gPlayer2.NoTarget := not gPlayer2.NoTarget;
 360     goto Cheated;
 361   end;
 362   // INFERNO
 363   if CheckCheat(I_GAME_CHEAT_NORELOAD) then
 364   begin
 365     if gPlayer1 <> nil then gPlayer1.NoReload := not gPlayer1.NoReload;
 366     if gPlayer2 <> nil then gPlayer2.NoReload := not gPlayer2.NoReload;
 367     goto Cheated;
 368   end;
 369   if CheckCheat(I_GAME_CHEAT_AIMLINE) then
 370   begin
 371     gAimLine := not gAimLine;
 372     goto Cheated;
 373   end;
 374   if CheckCheat(I_GAME_CHEAT_AUTOMAP) then
 375   begin
 376     gShowMap := not gShowMap;
 377     goto Cheated;
 378   end;
 379   Exit;
 380
 381 Cheated:
 382   g_Sound_PlayEx(s);
 383 end;
 384
 385 procedure KeyPress(K: Word);
 386 var
 387   Msg: g_gui.TMessage;
 388 begin
 389   case K of
 390     IK_PAUSE: // <Pause/Break>:
 391       begin
 392         if (g_ActiveWindow = nil) then
 393           g_Game_Pause(not gPause);
 394       end;
 395
 396     IK_BACKQUOTE: // <`/~/¨/¸>:
 397       begin
 398         g_Console_Switch();
 399       end;
 400
 401     IK_ESCAPE: // <Esc>:
 402       begin
 403         if gChatShow then
 404         begin
 405           g_Console_Chat_Switch();
 406           Exit;
 407         end;
 408
 409         if gConsoleShow then
 410           g_Console_Switch()
 411         else
 412           if g_ActiveWindow <> nil then
 413             begin
 414               Msg.Msg := WM_KEYDOWN;
 415               Msg.WParam := IK_ESCAPE;
 416               g_ActiveWindow.OnMessage(Msg);
 417             end
 418           else
 419             if gState <> STATE_FOLD then
 420               if gGameOn
 421               or (gState = STATE_INTERSINGLE)
 422               or (gState = STATE_INTERCUSTOM)
 423               then
 424                 g_Game_InGameMenu(True)
 425               else
 426                 if (gExit = 0) and (gState <> STATE_SLIST) then
 427                   begin
 428                     if gState <> STATE_MENU then
 429                       if NetMode <> NET_NONE then
 430                       begin
 431                         g_Game_StopAllSounds(True);
 432                         g_Game_Free;
 433                         gState := STATE_MENU;
 434                         Exit;
 435                       end;
 436
 437                     g_GUI_ShowWindow('MainMenu');
 438                     g_Sound_PlayEx('MENU_OPEN');
 439                   end;
 440       end;
 441
 442     IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
 443       begin // <F2> .. <F6> � <F12>
 444         if gGameOn and (not gConsoleShow) and (not gChatShow) then
 445         begin
 446           while g_ActiveWindow <> nil do
 447             g_GUI_HideWindow(False);
 448
 449           if (not g_Game_IsNet) then
 450             g_Game_Pause(True);
 451
 452           case K of
 453             IK_F2:
 454               g_Menu_Show_SaveMenu();
 455             IK_F3:
 456               g_Menu_Show_LoadMenu();
 457             IK_F4:
 458               g_Menu_Show_GameSetGame();
 459             IK_F5:
 460               g_Menu_Show_OptionsVideo();
 461             IK_F6:
 462               g_Menu_Show_OptionsSound();
 463             IK_F7:
 464               g_Menu_Show_EndGameMenu();
 465             IK_F10:
 466               g_Menu_Show_QuitGameMenu();
 467           end;
 468         end;
 469       end;
 470
 471     else
 472       begin
 473         gJustChatted := False;
 474         if gConsoleShow or gChatShow then
 475           g_Console_Control(K)
 476         else
 477           if g_ActiveWindow <> nil then
 478           begin
 479             Msg.Msg := WM_KEYDOWN;
 480             Msg.WParam := K;
 481             g_ActiveWindow.OnMessage(Msg);
 482           end
 483           else
 484           begin
 485             if (gState = STATE_MENU) then
 486             begin
 487               g_GUI_ShowWindow('MainMenu');
 488               g_Sound_PlayEx('MENU_OPEN');
 489             end;
 490           end;
 491       end;
 492   end;
 493 end;
 494
 495 procedure CharPress(C: Char);
 496 var
 497   Msg: g_gui.TMessage;
 498   a: Integer;
 499 begin
 500   if (not gChatShow) and ((C = '`') or (C = '~') or (C = '¸') or (C = '¨')) then
 501     Exit;
 502
 503   if gConsoleShow or gChatShow then
 504     g_Console_Char(C)
 505   else
 506     if g_ActiveWindow <> nil then
 507     begin
 508       Msg.Msg := WM_CHAR;
 509       Msg.WParam := Ord(C);
 510       g_ActiveWindow.OnMessage(Msg);
 511     end
 512     else
 513     begin
 514       for a := 0 to 14 do charbuff[a] := charbuff[a+1];
 515       charbuff[15] := UpCase1251(C);
 516       Cheat();
 517     end;
 518 end;
 519
 520 end.