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