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;
  48
  49
  50 const
  51   ProgressUpdateMSecs = 35; //1;//100;
  52
  53 var
  54   Time, Time_Delta, Time_Old: 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=false);
  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       DrawMenuBackground('INTER');
  91       e_DarkenQuadWH(0, 0, gScreenWidth, gScreenHeight, 150);
  92
  93       DrawLoadingStat();
  94       g_Console_Draw(True);
  95       sys_Repaint;
  96       prevLoadingUpdateTime := getTimeMilli();
  97     end;
  98   end;
  99 {$ENDIF}
 100
 101   e_SoundUpdate();
 102
 103   if NetMode = NET_SERVER then
 104   begin
 105     g_Net_Host_Update();
 106   end
 107   else
 108   begin
 109     if (NetMode = NET_CLIENT) and (NetState <> NET_STATE_AUTH) then g_Net_Client_UpdateWhileLoading();
 110   end;
 111 end;
 112
 113
 114 function ProcessMessage (): Boolean;
 115 var
 116   i, t: Integer;
 117 begin
 118   result := sys_HandleInput();
 119
 120   Time := sys_GetTicks();
 121   Time_Delta := Time-Time_Old;
 122
 123   flag := false;
 124
 125   if wNeedTimeReset then
 126   begin
 127     Time_Delta := 28;
 128     wNeedTimeReset := false;
 129   end;
 130
 131   g_Map_ProfilersBegin();
 132   g_Mons_ProfilersBegin();
 133
 134   t := Time_Delta div 28;
 135   if (t > 0) then
 136   begin
 137     flag := true;
 138     for i := 1 to t do
 139     begin
 140            if (NetMode = NET_SERVER) then g_Net_Host_Update()
 141       else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
 142       Update();
 143     end;
 144   end
 145   else
 146   begin
 147          if (NetMode = NET_SERVER) then g_Net_Host_Update()
 148     else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
 149   end;
 150
 151   if NetMode = NET_SERVER then g_Net_Flush();
 152
 153   g_Map_ProfilersEnd();
 154   g_Mons_ProfilersEnd();
 155
 156   if wLoadingQuit then
 157   begin
 158     g_Game_Free();
 159     g_Game_Quit();
 160   end;
 161
 162   if (gExit = EXIT_QUIT) then
 163   begin
 164     result := true;
 165     exit;
 166   end;
 167
 168   // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
 169   if flag then
 170   begin
 171     Time_Old := Time - (Time_Delta mod 28);
 172     if (not wMinimized) then
 173     begin
 174       Draw;
 175       sys_Repaint
 176     end
 177   end
 178   else
 179   begin
 180     sys_Delay(1) // release time slice, so we won't eat 100% CPU
 181   end;
 182
 183   e_SoundUpdate();
 184 end;
 185
 186 function GLExtensionList (): SSArray;
 187   var s: PChar; i, j, num: GLint;
 188 begin
 189   result := nil;
 190   s := glGetString(GL_EXTENSIONS);
 191   if s <> nil then
 192   begin
 193     num := 0; i := 0; j := 0;
 194     while s[i] <> #0 do
 195     begin
 196       while (s[i] <> #0) and (s[i] <> ' ') do Inc(i);
 197       SetLength(result, num + 1);
 198       result[num] := Copy(s, j, i - j);
 199       while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
 200       j := i;
 201       Inc(num)
 202     end
 203   end
 204 end;
 205
 206 function GLExtensionSupported (ext: AnsiString): Boolean;
 207   var i, len: GLint; exts: SSArray;
 208 begin
 209   result := false;
 210   exts := GLExtensionList();
 211   if exts <> nil then
 212   begin
 213     i := 0; len := Length(exts);
 214     while (i < len) and (exts[i] <> ext) do Inc(i);
 215     result := i < len
 216   end
 217 end;
 218
 219 procedure PrintGLSupportedExtensions;
 220 begin
 221   e_LogWritefln('GL Vendor: %s', [glGetString(GL_VENDOR)]);
 222   e_LogWritefln('GL Renderer: %s', [glGetString(GL_RENDERER)]);
 223   e_LogWritefln('GL Version: %s', [glGetString(GL_VERSION)]);
 224   e_LogWritefln('GL Shaders: %s', [glGetString(GL_SHADING_LANGUAGE_VERSION)]);
 225   e_LogWritefln('GL Extensions: %s', [glGetString(GL_EXTENSIONS)]);
 226 end;
 227
 228 function SDLMain (): Integer;
 229 var
 230   idx: Integer;
 231   arg: AnsiString;
 232   mdfo: TStream;
 233   {$IFDEF ENABLE_HOLMES}
 234   itmp: Integer;
 235   valres: Word;
 236   {$ENDIF}
 237 begin
 238 {$IFDEF HEADLESS}
 239   e_NoGraphics := true;
 240 {$ENDIF}
 241
 242   idx := 1;
 243   while (idx <= ParamCount) do
 244   begin
 245     arg := ParamStr(idx);
 246     Inc(idx);
 247     if arg = '--opengl-dump-exts' then gwin_dump_extensions := true;
 248     //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
 249     if arg = '--jah' then g_profile_history_size := 100;
 250     if arg = '--no-particles' then gpart_dbg_enabled := false;
 251     if arg = '--no-los' then gmon_dbg_los_enabled := false;
 252
 253     if arg = '--profile-render' then g_profile_frame_draw := true;
 254     if arg = '--profile-coldet' then g_profile_collision := true;
 255     if arg = '--profile-los' then g_profile_los := true;
 256
 257     if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
 258     if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
 259     if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
 260     if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
 261     if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
 262     if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
 263
 264     if arg = '--debug-input' then g_dbg_input := True;
 265
 266     {.$IF DEFINED(D2F_DEBUG)}
 267     if arg = '--aimline' then g_dbg_aimline_on := true;
 268     {.$ENDIF}
 269
 270 {$IFDEF ENABLE_HOLMES}
 271     if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
 272
 273     if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
 274     begin
 275       if (idx <= ParamCount) then
 276       begin
 277         if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
 278         Inc(idx);
 279       end;
 280     end;
 281
 282     if (arg = '--holmes-font') or (arg = '-holmes-font') then
 283     begin
 284       if (idx <= ParamCount) then
 285       begin
 286         itmp := 0;
 287         val(ParamStr(idx), itmp, valres);
 288         {$IFNDEF HEADLESS}
 289         if (valres = 0) and (not g_holmes_imfunctional) then
 290         begin
 291           case itmp of
 292             8: uiContext.font := 'win8';
 293             14: uiContext.font := 'win14';
 294             16: uiContext.font := 'win16';
 295           end;
 296         end;
 297         {$ELSE}
 298         // fuck off, fpc!
 299         itmp := itmp;
 300         valres := valres;
 301         {$ENDIF}
 302         Inc(idx);
 303       end;
 304     end;
 305 {$ENDIF}
 306
 307     if (arg = '--game-scale') or (arg = '-game-scale') then
 308     begin
 309       if (idx <= ParamCount) then
 310       begin
 311         if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
 312         Inc(idx);
 313       end;
 314     end;
 315
 316     if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
 317     begin
 318       mdfo := createDiskFile('mapdef.txt');
 319       mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
 320       mdfo.Free();
 321       Halt(0);
 322     end;
 323   end;
 324
 325 {$IFDEF USE_SYSSTUB}
 326   PrintGLSupportedExtensions;
 327   glLegacyNPOT := GLExtensionSupported('GL_ARB_texture_non_power_of_two') or GLExtensionSupported('GL_OES_texture_npot');
 328 {$ELSE}
 329   glLegacyNPOT := False;
 330 {$ENDIF}
 331   e_logWritefln('NPOT textures: %s', [glLegacyNPOT]);
 332   gwin_dump_extensions := false;
 333
 334   Init;
 335   Time_Old := sys_GetTicks();
 336
 337   // Êîìàíäíàÿ ñòðîêà
 338   if (ParamCount > 0) then g_Game_Process_Params();
 339
 340 {$IFNDEF HEADLESS}
 341   // Çàïðîñ ÿçûêà
 342   if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
 343 {$ENDIF}
 344
 345   e_WriteLog('Entering the main loop', TMsgType.Notify);
 346
 347   // main loop
 348   while not ProcessMessage() do begin end;
 349
 350   Release();
 351   result := 0;
 352 end;
 353
 354
 355 initialization
 356   conRegVar('d_input', @g_dbg_input, '', '')
 357 end.