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