src/game/g_window.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_window;
  17
  18 interface
  19
  20 uses
  21   utils;
  22
  23 function SDLMain (): Integer;
  24 procedure ResetTimer ();
  25 procedure ProcessLoading (forceUpdate: Boolean=false);
  26
  27 var
  28   gwin_dump_extensions: Boolean = false;
  29   gwin_has_stencil: Boolean = false;
  30   gwin_k8_enable_light_experiments: Boolean = false;
  31   g_dbg_aimline_on: Boolean = false;
  32   g_dbg_input: Boolean = False;
  33
  34 implementation
  35
  36 uses
  37 {$IFDEF WINDOWS}Windows,{$ENDIF}
  38 {$IFDEF ENABLE_HOLMES}
  39   g_holmes, sdlcarcass, fui_ctls,
  40 {$ENDIF}
  41   SysUtils, Classes, MAPDEF, Math,
  42   e_graphics, e_log, e_texture, g_main,
  43   g_console, e_input, g_options, g_game,
  44   g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net,
  45   g_map, g_gfx, g_monsters, xprofiler,
  46   g_touch, g_gui, g_system;
  47
  48
  49 const
  50   ProgressUpdateMSecs = 35; //1;//100;
  51
  52 var
  53   Time, Time_Delta, Time_Old: Int64;
  54   flag: Boolean;
  55   wNeedTimeReset: Boolean = false;
  56   wMinimized: Boolean = false;
  57   wMaximized: Boolean = false;
  58   wLoadingProgress: Boolean = false;
  59   wLoadingQuit: Boolean = false;
  60
  61 procedure ResetTimer ();
  62 begin
  63   wNeedTimeReset := true;
  64 end;
  65
  66 {$IFNDEF HEADLESS}
  67 var
  68   prevLoadingUpdateTime: UInt64 = 0;
  69 {$ENDIF}
  70
  71 procedure ProcessLoading (forceUpdate: Boolean=false);
  72 var
  73 {$IFNDEF HEADLESS}
  74 //  ev: TSDL_Event;
  75   stt: UInt64;
  76 {$ENDIF}
  77 begin
  78 //  FillChar(ev, sizeof(ev), 0);
  79   wLoadingProgress := true;
  80
  81 //  while (SDL_PollEvent(@ev) > 0) do
  82 //  begin
  83 //    EventHandler(ev);
  84 //    if (ev.type_ = SDL_QUITEV) then break;
  85 //  end;
  86   //e_PollJoysticks();
  87
  88 //  if (ev.type_ = SDL_QUITEV) or (gExit = EXIT_QUIT) then
  89 //  begin
  90 //    wLoadingProgress := false;
  91 //    exit;
  92 //  end;
  93
  94 {$IFNDEF HEADLESS}
  95   if not wMinimized then
  96   begin
  97     if not forceUpdate then
  98     begin
  99       stt := getTimeMilli();
 100       forceUpdate := (stt < prevLoadingUpdateTime) or (stt-prevLoadingUpdateTime >= ProgressUpdateMSecs);
 101     end;
 102
 103     if forceUpdate then
 104     begin
 105       DrawMenuBackground('INTER');
 106       e_DarkenQuadWH(0, 0, gScreenWidth, gScreenHeight, 150);
 107
 108       DrawLoadingStat();
 109       g_Console_Draw(True);
 110       sys_Repaint;
 111       prevLoadingUpdateTime := getTimeMilli();
 112     end;
 113   end;
 114 {$ENDIF}
 115
 116   e_SoundUpdate();
 117
 118   if NetMode = NET_SERVER then
 119   begin
 120     g_Net_Host_Update();
 121   end
 122   else
 123   begin
 124     if (NetMode = NET_CLIENT) and (NetState <> NET_STATE_AUTH) then g_Net_Client_UpdateWhileLoading();
 125   end;
 126
 127   wLoadingProgress := false;
 128 end;
 129
 130
 131 function ProcessMessage (): Boolean;
 132 var
 133   i, t: Integer;
 134 begin
 135   result := sys_HandleInput();
 136
 137   Time := sys_GetTicks();
 138   Time_Delta := Time-Time_Old;
 139
 140   flag := false;
 141
 142   if wNeedTimeReset then
 143   begin
 144     Time_Delta := 28;
 145     wNeedTimeReset := false;
 146   end;
 147
 148   g_Map_ProfilersBegin();
 149   g_Mons_ProfilersBegin();
 150
 151   t := Time_Delta div 28;
 152   if (t > 0) then
 153   begin
 154     flag := true;
 155     for i := 1 to t do
 156     begin
 157            if (NetMode = NET_SERVER) then g_Net_Host_Update()
 158       else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
 159       Update();
 160     end;
 161   end
 162   else
 163   begin
 164          if (NetMode = NET_SERVER) then g_Net_Host_Update()
 165     else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
 166   end;
 167
 168   if NetMode = NET_SERVER then g_Net_Flush();
 169
 170   g_Map_ProfilersEnd();
 171   g_Mons_ProfilersEnd();
 172
 173   if wLoadingQuit then
 174   begin
 175     g_Game_Free();
 176     g_Game_Quit();
 177   end;
 178
 179   if (gExit = EXIT_QUIT) then
 180   begin
 181     result := true;
 182     exit;
 183   end;
 184
 185   // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
 186   if flag then
 187   begin
 188     Time_Old := Time - (Time_Delta mod 28);
 189     if (not wMinimized) then
 190     begin
 191       Draw;
 192       sys_Repaint
 193     end
 194   end
 195   else
 196   begin
 197     sys_Delay(1) // release time slice, so we won't eat 100% CPU
 198   end;
 199
 200   e_SoundUpdate();
 201 end;
 202
 203 function SDLMain (): Integer;
 204 var
 205   idx: Integer;
 206   {$IF not DEFINED(HEADLESS)}
 207   ltmp: Integer;
 208   {$ENDIF}
 209   arg: AnsiString;
 210   mdfo: TStream;
 211   {$IFDEF ENABLE_HOLMES}
 212   itmp: Integer;
 213   valres: Word;
 214   {$ENDIF}
 215 begin
 216 {$IFDEF HEADLESS}
 217   e_NoGraphics := true;
 218 {$ELSE}
 219   {$IFDEF ENABLE_HOLMES}
 220     if (not g_holmes_imfunctional) then
 221     begin
 222       uiInitialize();
 223       uiContext.font := 'win14';
 224     end;
 225   {$ENDIF}
 226 {$ENDIF}
 227
 228   idx := 1;
 229   while (idx <= ParamCount) do
 230   begin
 231     arg := ParamStr(idx);
 232     Inc(idx);
 233     if arg = '--opengl-dump-exts' then gwin_dump_extensions := true;
 234     //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
 235     if arg = '--jah' then g_profile_history_size := 100;
 236     if arg = '--no-particles' then gpart_dbg_enabled := false;
 237     if arg = '--no-los' then gmon_dbg_los_enabled := false;
 238
 239     if arg = '--profile-render' then g_profile_frame_draw := true;
 240     if arg = '--profile-coldet' then g_profile_collision := true;
 241     if arg = '--profile-los' then g_profile_los := true;
 242
 243     if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
 244     if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
 245     if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
 246     if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
 247     if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
 248     if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
 249
 250     if arg = '--debug-input' then g_dbg_input := True;
 251
 252     {.$IF DEFINED(D2F_DEBUG)}
 253     if arg = '--aimline' then g_dbg_aimline_on := true;
 254     {.$ENDIF}
 255
 256 {$IFDEF ENABLE_HOLMES}
 257     if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
 258
 259     if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
 260     begin
 261       if (idx <= ParamCount) then
 262       begin
 263         if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
 264         Inc(idx);
 265       end;
 266     end;
 267
 268     if (arg = '--holmes-font') or (arg = '-holmes-font') then
 269     begin
 270       if (idx <= ParamCount) then
 271       begin
 272         itmp := 0;
 273         val(ParamStr(idx), itmp, valres);
 274         {$IFNDEF HEADLESS}
 275         if (valres = 0) and (not g_holmes_imfunctional) then
 276         begin
 277           case itmp of
 278             8: uiContext.font := 'win8';
 279             14: uiContext.font := 'win14';
 280             16: uiContext.font := 'win16';
 281           end;
 282         end;
 283         {$ELSE}
 284         // fuck off, fpc!
 285         itmp := itmp;
 286         valres := valres;
 287         {$ENDIF}
 288         Inc(idx);
 289       end;
 290     end;
 291 {$ENDIF}
 292
 293     if (arg = '--game-scale') or (arg = '-game-scale') then
 294     begin
 295       if (idx <= ParamCount) then
 296       begin
 297         if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
 298         Inc(idx);
 299       end;
 300     end;
 301
 302     if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
 303     begin
 304       mdfo := createDiskFile('mapdef.txt');
 305       mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
 306       mdfo.Free();
 307       Halt(0);
 308     end;
 309   end;
 310
 311   Init;
 312   Time_Old := sys_GetTicks();
 313
 314   // Êîìàíäíàÿ ñòðîêà
 315   if (ParamCount > 0) then g_Game_Process_Params();
 316
 317 {$IFNDEF HEADLESS}
 318   // Çàïðîñ ÿçûêà
 319   if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
 320 {$ENDIF}
 321
 322   e_WriteLog('Entering the main loop', TMsgType.Notify);
 323
 324   // main loop
 325   while not ProcessMessage() do begin end;
 326
 327   Release();
 328   result := 0;
 329 end;
 330
 331
 332 initialization
 333   conRegVar('d_input', @g_dbg_input, '', '')
 334 end.