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_has_stencil: Boolean = false;
  29   gwin_k8_enable_light_experiments: Boolean = false;
  30   g_dbg_aimline_on: Boolean = false;
  31   g_dbg_input: Boolean = False;
  32
  33 implementation
  34
  35 uses
  36 {$IFDEF WINDOWS}Windows,{$ENDIF}
  37 {$IFDEF ENABLE_HOLMES}
  38   g_holmes, sdlcarcass, fui_ctls,
  39 {$ENDIF}
  40 {$INCLUDE ../nogl/noGLuses.inc}
  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, g_netmaster;
  47
  48
  49 const
  50   ProgressUpdateMSecs = 35; //1;//100;
  51
  52 var
  53   Time, Time_Delta, Time_Old: Int64;
  54   Frame: Int64;
  55   flag: Boolean;
  56   wNeedTimeReset: Boolean = false;
  57   wMinimized: Boolean = false;
  58   wLoadingQuit: Boolean = false;
  59
  60 procedure ResetTimer ();
  61 begin
  62   wNeedTimeReset := true;
  63 end;
  64
  65 {$IFNDEF HEADLESS}
  66 var
  67   prevLoadingUpdateTime: UInt64 = 0;
  68 {$ENDIF}
  69
  70 procedure ProcessLoading (forceUpdate: Boolean);
  71 {$IFNDEF HEADLESS}
  72 var
  73   stt: UInt64;
  74 {$ENDIF}
  75 begin
  76   if sys_HandleInput() = True then
  77     Exit;
  78
  79 {$IFNDEF HEADLESS}
  80   if not wMinimized then
  81   begin
  82     if not forceUpdate then
  83     begin
  84       stt := getTimeMilli();
  85       forceUpdate := (stt < prevLoadingUpdateTime) or (stt-prevLoadingUpdateTime >= ProgressUpdateMSecs);
  86     end;
  87
  88     if forceUpdate then
  89     begin
  90       e_SetRendertarget(True);
  91       e_SetViewPort(0, 0, gScreenWidth, gScreenHeight);
  92
  93       DrawMenuBackground('INTER');
  94       e_DarkenQuadWH(0, 0, gScreenWidth, gScreenHeight, 150);
  95       DrawLoadingStat();
  96       g_Console_Draw(True);
  97
  98       e_SetRendertarget(False);
  99       e_SetViewPort(0, 0, gWinSizeX, gWinSizeY);
 100       e_BlitFramebuffer(gWinSizeX, gWinSizeY);
 101
 102       sys_Repaint;
 103       prevLoadingUpdateTime := getTimeMilli();
 104     end;
 105   end;
 106 {$ENDIF}
 107
 108   e_SoundUpdate();
 109
 110   // TODO: At the moment, I left here only host network processing, because the client code must
 111   // handle network events on its own. Otherwise separate network cases that use different calls to
 112   // enet_host_service() WILL lose their packets (for example, resource downloading). So they have
 113   // to handle everything by themselves. But in general, this MUST be removed completely, since
 114   // updating the window should never affect the network. Use single enet_host_service(), period.
 115   if NetMode = NET_SERVER
 116     then g_Net_Host_Update();
 117 end;
 118
 119
 120 function ProcessMessage (): Boolean;
 121 var
 122   i, t: Integer;
 123 begin
 124   result := sys_HandleInput();
 125
 126   Time := sys_GetTicks();
 127   Time_Delta := Time-Time_Old;
 128
 129   flag := false;
 130
 131   if wNeedTimeReset then
 132   begin
 133     Frame := 0;
 134     Time_Delta := 28;
 135     wNeedTimeReset := false;
 136   end;
 137
 138   g_Map_ProfilersBegin();
 139   g_Mons_ProfilersBegin();
 140
 141   t := Time_Delta div 28;
 142   if (t > 0) then
 143   begin
 144     flag := true;
 145     for i := 1 to t do
 146       Update();
 147   end;
 148
 149   g_Map_ProfilersEnd();
 150   g_Mons_ProfilersEnd();
 151
 152   if wLoadingQuit then
 153   begin
 154     g_Game_Free();
 155     g_Game_Quit();
 156   end;
 157
 158   if (gExit = EXIT_QUIT) then
 159   begin
 160     result := true;
 161     exit;
 162   end;
 163
 164   // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
 165   if flag then
 166     Time_Old := Time - (Time_Delta mod 28);
 167
 168   // don't wait if VSync is on, GL already probably waits enough
 169   if gLerpActors then
 170     flag := (Time - Frame >= gFrameTime) or gVSync;
 171
 172   if flag then
 173   begin
 174     if (not wMinimized) then
 175     begin
 176       if gPause or (not gLerpActors) or (gState = STATE_FOLD) then
 177         gLerpFactor := 1.0
 178       else
 179         gLerpFactor := nmin(1.0, (Time - Time_Old) / 28.0);
 180       Draw;
 181       sys_Repaint
 182     end;
 183     Frame := Time
 184   end
 185   else
 186     sys_Delay(1);
 187
 188   e_SoundUpdate();
 189 end;
 190
 191 function GLExtensionList (): SSArray;
 192 var
 193   s: PChar;
 194   i, j, num: GLint;
 195 begin
 196   result := nil;
 197   s := glGetString(GL_EXTENSIONS);
 198   if s <> nil then
 199   begin
 200     num := 0;
 201     i := 0;
 202     j := 0;
 203     while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
 204     while (s[i] <> #0) do
 205     begin
 206       while (s[i] <> #0) and (s[i] <> ' ') do Inc(i);
 207       SetLength(result, num+1);
 208       result[num] := Copy(s, j+1, i-j);
 209       while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
 210       j := i;
 211       Inc(num);
 212     end;
 213   end;
 214 end;
 215
 216 function GLExtensionSupported (ext: AnsiString): Boolean;
 217 var
 218   exts: SSArray;
 219   e: AnsiString;
 220 begin
 221   result := false;
 222   exts := GLExtensionList();
 223   for e in exts do
 224   begin
 225     //writeln('<', e, '> : [', ext, '] = ', strEquCI1251(e, ext));
 226     if (strEquCI1251(e, ext)) then begin result := true; exit; end;
 227   end;
 228 end;
 229
 230 procedure PrintGLSupportedExtensions;
 231 begin
 232   e_LogWritefln('GL Vendor: %s', [glGetString(GL_VENDOR)]);
 233   e_LogWritefln('GL Renderer: %s', [glGetString(GL_RENDERER)]);
 234   e_LogWritefln('GL Version: %s', [glGetString(GL_VERSION)]);
 235   e_LogWritefln('GL Shaders: %s', [glGetString(GL_SHADING_LANGUAGE_VERSION)]);
 236   e_LogWritefln('GL Extensions: %s', [glGetString(GL_EXTENSIONS)]);
 237 end;
 238
 239 function SDLMain (): Integer;
 240 var
 241   idx: Integer;
 242   arg: AnsiString;
 243   mdfo: TStream;
 244   {$IFDEF ENABLE_HOLMES}
 245   itmp: Integer;
 246   valres: Word;
 247   {$ENDIF}
 248 begin
 249 {$IFDEF HEADLESS}
 250   e_NoGraphics := true;
 251 {$ENDIF}
 252
 253   idx := 1;
 254   while (idx <= ParamCount) do
 255   begin
 256     arg := ParamStr(idx);
 257     Inc(idx);
 258     if arg = '--jah' then g_profile_history_size := 100;
 259     if arg = '--no-particles' then gpart_dbg_enabled := false;
 260     if arg = '--no-los' then gmon_dbg_los_enabled := false;
 261
 262     if arg = '--profile-render' then g_profile_frame_draw := true;
 263     if arg = '--profile-coldet' then g_profile_collision := true;
 264     if arg = '--profile-los' then g_profile_los := true;
 265
 266     if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
 267     if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
 268     if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
 269     if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
 270     if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
 271     if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
 272
 273     if arg = '--debug-input' then g_dbg_input := True;
 274
 275     {.$IF DEFINED(D2F_DEBUG)}
 276     if arg = '--aimline' then g_dbg_aimline_on := true;
 277     {.$ENDIF}
 278
 279 {$IFDEF ENABLE_HOLMES}
 280     if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
 281
 282     if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
 283     begin
 284       if (idx <= ParamCount) then
 285       begin
 286         if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
 287         Inc(idx);
 288       end;
 289     end;
 290
 291     if (arg = '--holmes-font') or (arg = '-holmes-font') then
 292     begin
 293       if (idx <= ParamCount) then
 294       begin
 295         itmp := 0;
 296         val(ParamStr(idx), itmp, valres);
 297         {$IFNDEF HEADLESS}
 298         if (valres = 0) and (not g_holmes_imfunctional) then
 299         begin
 300           case itmp of
 301             8: uiContext.font := 'win8';
 302             14: uiContext.font := 'win14';
 303             16: uiContext.font := 'win16';
 304           end;
 305         end;
 306         {$ELSE}
 307         // fuck off, fpc!
 308         itmp := itmp;
 309         valres := valres;
 310         {$ENDIF}
 311         Inc(idx);
 312       end;
 313     end;
 314 {$ENDIF}
 315
 316     if (arg = '--game-scale') or (arg = '-game-scale') then
 317     begin
 318       if (idx <= ParamCount) then
 319       begin
 320         if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
 321         Inc(idx);
 322       end;
 323     end;
 324
 325     if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
 326     begin
 327       mdfo := createDiskFile('mapdef.txt');
 328       mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
 329       mdfo.Free();
 330       Halt(0);
 331     end;
 332
 333     if (arg = '--pixel-scale') or (arg = '-pixel-scale') then
 334     begin
 335       if (idx <= ParamCount) then
 336       begin
 337         if not conParseFloat(r_pixel_scale, ParamStr(idx)) then r_pixel_scale := 1.0;
 338         Inc(idx);
 339       end;
 340     end;
 341   end;
 342
 343 {$IFNDEF USE_SYSSTUB}
 344   PrintGLSupportedExtensions;
 345   glLegacyNPOT := not (GLExtensionSupported('GL_ARB_texture_non_power_of_two') or GLExtensionSupported('GL_OES_texture_npot'));
 346 {$ELSE}
 347   glLegacyNPOT := False;
 348   glRenderToFBO := False;
 349 {$ENDIF}
 350   if glNPOTOverride and glLegacyNPOT then
 351   begin
 352     glLegacyNPOT := true;
 353     e_logWriteln('NPOT texture emulation: FORCED');
 354   end
 355   else
 356   begin
 357     if (glLegacyNPOT) then e_logWriteln('NPOT texture emulation: enabled')
 358     else e_logWriteln('NPOT texture emulation: disabled');
 359   end;
 360
 361   Init;
 362   Time_Old := sys_GetTicks();
 363
 364   g_Net_InitLowLevel();
 365
 366   // Êîìàíäíàÿ ñòðîêà
 367   if (ParamCount > 0) then g_Game_Process_Params();
 368
 369 {$IFNDEF HEADLESS}
 370   // Çàïðîñ ÿçûêà
 371   if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
 372 {$ENDIF}
 373
 374   e_WriteLog('Entering the main loop', TMsgType.Notify);
 375
 376   // main loop
 377   while not ProcessMessage() do begin end;
 378
 379   g_Net_Slist_ShutdownAll();
 380
 381   Release();
 382
 383   g_Net_DeinitLowLevel();
 384   result := 0;
 385 end;
 386
 387
 388 initialization
 389   conRegVar('d_input', @g_dbg_input, '', '')
 390 end.