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   SysUtils, Classes, MAPDEF, Math, r_graphics,
  41   r_window, e_log, r_game,
  42   g_console, r_console, e_input, g_options, g_game,
  43   g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net,
  44   g_map, g_gfx, g_monsters, xprofiler,
  45   g_touch, g_gui, g_system, g_netmaster;
  46
  47 var
  48   Time, Time_Delta, Time_Old: Int64;
  49   Frame: Int64;
  50   flag: Boolean;
  51   wNeedTimeReset: Boolean = false;
  52   wLoadingQuit: Boolean = false;
  53
  54 procedure Update ();
  55 begin
  56   // remember old mobj positions, prepare for update
  57   g_Game_PreUpdate();
  58   // server: receive client commands for new frame
  59   // client: receive game state changes from server
  60        if (NetMode = NET_SERVER) then g_Net_Host_Update()
  61   else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
  62   // think
  63   g_Game_Update();
  64   // server: send any accumulated outgoing data to clients
  65   if NetMode = NET_SERVER then g_Net_Flush();
  66 end;
  67
  68
  69 procedure Draw ();
  70 begin
  71   r_Game_Draw();
  72 end;
  73
  74
  75 procedure Init();
  76 var
  77   NoSound: Boolean;
  78 begin
  79   Randomize;
  80
  81 {$IFDEF HEADLESS}
  82  {$IFDEF USE_SDLMIXER}
  83   NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
  84  {$ELSE}
  85   NoSound := True; // FMOD backend will sort it out
  86  {$ENDIF}
  87 {$ELSE}
  88   NoSound := False;
  89 {$ENDIF}
  90
  91   g_Touch_Init;
  92
  93 (*
  94   if (e_JoysticksAvailable > 0) then
  95     e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
  96   else
  97     e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
  98 *)
  99
 100   if (not gNoSound) then
 101   begin
 102     e_WriteLog('Initializing sound system', TMsgType.Notify);
 103     e_InitSoundSystem(NoSound);
 104   end;
 105
 106   e_WriteLog('Init game', TMsgType.Notify);
 107   g_Game_Init();
 108
 109 //  FillChar(charbuff, sizeof(charbuff), ' ');
 110 end;
 111
 112 procedure Release();
 113 begin
 114   e_WriteLog('Releasing engine', TMsgType.Notify);
 115   e_ReleaseEngine();
 116
 117   e_WriteLog('Releasing input', TMsgType.Notify);
 118   e_ReleaseInput();
 119
 120   if not gNoSound then
 121   begin
 122     e_WriteLog('Releasing sound', TMsgType.Notify);
 123     e_ReleaseSoundSystem();
 124   end;
 125 end;
 126
 127 procedure ResetTimer ();
 128 begin
 129   wNeedTimeReset := true;
 130 end;
 131
 132 procedure ProcessLoading (forceUpdate: Boolean=false);
 133 begin
 134   if sys_HandleInput() = True then
 135     Exit;
 136
 137 {$IFNDEF HEADLESS}
 138   r_Window_DrawLoading(forceUpdate);
 139 {$ENDIF}
 140
 141   e_SoundUpdate();
 142
 143   if NetMode = NET_SERVER then
 144     g_Net_Host_Update()
 145   else if (NetMode = NET_CLIENT) and (NetState <> NET_STATE_AUTH) then
 146     g_Net_Client_UpdateWhileLoading();
 147 end;
 148
 149
 150 function ProcessMessage (): Boolean;
 151 var
 152   i, t: Integer;
 153 begin
 154   result := sys_HandleInput();
 155
 156   Time := sys_GetTicks();
 157   Time_Delta := Time-Time_Old;
 158
 159   flag := false;
 160
 161   if wNeedTimeReset then
 162   begin
 163     Frame := 0;
 164     Time_Delta := 28;
 165     wNeedTimeReset := false;
 166   end;
 167
 168   g_Map_ProfilersBegin();
 169   g_Mons_ProfilersBegin();
 170
 171   t := Time_Delta div 28;
 172   if (t > 0) then
 173   begin
 174     flag := true;
 175     for i := 1 to t do
 176       Update();
 177   end;
 178
 179   g_Map_ProfilersEnd();
 180   g_Mons_ProfilersEnd();
 181
 182   if wLoadingQuit then
 183   begin
 184     g_Game_Free();
 185     g_Game_Quit();
 186   end;
 187
 188   if (gExit = EXIT_QUIT) then
 189   begin
 190     result := true;
 191     exit;
 192   end;
 193
 194   // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
 195   if flag then
 196     Time_Old := Time - (Time_Delta mod 28);
 197
 198   // don't wait if VSync is on, GL already probably waits enough
 199   if gLerpActors then
 200     flag := (Time - Frame >= gFrameTime) or gVSync;
 201
 202   if flag then
 203   begin
 204     if gPause or (not gLerpActors) or (gState = STATE_FOLD) then
 205       gLerpFactor := 1.0
 206     else
 207       gLerpFactor := nmin(1.0, (Time - Time_Old) / 28.0);
 208     Draw;
 209     sys_Repaint;
 210     Frame := Time
 211   end
 212   else
 213     sys_Delay(1);
 214
 215   e_SoundUpdate();
 216 end;
 217
 218 function SDLMain (): Integer;
 219 var
 220   idx: Integer;
 221   arg: AnsiString;
 222   mdfo: TStream;
 223   {$IFDEF ENABLE_HOLMES}
 224   itmp: Integer;
 225   valres: Word;
 226   {$ENDIF}
 227 begin
 228
 229   idx := 1;
 230   while (idx <= ParamCount) do
 231   begin
 232     arg := ParamStr(idx);
 233     Inc(idx);
 234     //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
 235     if arg = '--jah' then g_profile_history_size := 100;
 236     if arg = '--no-particles' then gpart_dbg_enabled := false;
 237     if arg = '--no-los' then gmon_dbg_los_enabled := false;
 238
 239     if arg = '--profile-render' then g_profile_frame_draw := true;
 240     if arg = '--profile-coldet' then g_profile_collision := true;
 241     if arg = '--profile-los' then g_profile_los := true;
 242
 243     if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
 244     if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
 245     if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
 246     if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
 247     if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
 248     if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
 249
 250     if arg = '--debug-input' then g_dbg_input := True;
 251
 252     {.$IF DEFINED(D2F_DEBUG)}
 253     if arg = '--aimline' then g_dbg_aimline_on := true;
 254     {.$ENDIF}
 255
 256 {$IFDEF ENABLE_HOLMES}
 257     if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
 258
 259     if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
 260     begin
 261       if (idx <= ParamCount) then
 262       begin
 263         if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
 264         Inc(idx);
 265       end;
 266     end;
 267
 268     if (arg = '--holmes-font') or (arg = '-holmes-font') then
 269     begin
 270       if (idx <= ParamCount) then
 271       begin
 272         itmp := 0;
 273         val(ParamStr(idx), itmp, valres);
 274         {$IFNDEF HEADLESS}
 275         if (valres = 0) and (not g_holmes_imfunctional) then
 276         begin
 277           case itmp of
 278             8: uiContext.font := 'win8';
 279             14: uiContext.font := 'win14';
 280             16: uiContext.font := 'win16';
 281           end;
 282         end;
 283         {$ELSE}
 284         // fuck off, fpc!
 285         itmp := itmp;
 286         valres := valres;
 287         {$ENDIF}
 288         Inc(idx);
 289       end;
 290     end;
 291 {$ENDIF}
 292
 293     if (arg = '--game-scale') or (arg = '-game-scale') then
 294     begin
 295       if (idx <= ParamCount) then
 296       begin
 297         if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
 298         Inc(idx);
 299       end;
 300     end;
 301
 302     if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
 303     begin
 304       mdfo := createDiskFile('mapdef.txt');
 305       mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
 306       mdfo.Free();
 307       Halt(0);
 308     end;
 309
 310     if (arg = '--pixel-scale') or (arg = '-pixel-scale') then
 311     begin
 312       if (idx <= ParamCount) then
 313       begin
 314         if not conParseFloat(r_pixel_scale, ParamStr(idx)) then r_pixel_scale := 1.0;
 315         Inc(idx);
 316       end;
 317     end;
 318   end;
 319
 320   r_Window_Initialize;
 321
 322   Init;
 323   Time_Old := sys_GetTicks();
 324
 325   g_Net_InitLowLevel();
 326
 327   // Êîìàíäíàÿ ñòðîêà
 328   if (ParamCount > 0) then g_Game_Process_Params();
 329
 330 {$IFNDEF HEADLESS}
 331   // Çàïðîñ ÿçûêà
 332   if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
 333 {$ENDIF}
 334
 335   e_WriteLog('Entering the main loop', TMsgType.Notify);
 336
 337   // main loop
 338   while not ProcessMessage() do begin end;
 339
 340   g_Net_Slist_ShutdownAll();
 341
 342   Release();
 343
 344   g_Net_DeinitLowLevel();
 345   result := 0;
 346 end;
 347
 348
 349 initialization
 350   conRegVar('d_input', @g_dbg_input, '', '')
 351 end.