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