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, e_res, envvars, 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   {$IFDEF USE_SDLMIXER}
  55     UseNativeMusic: Boolean;
  56   {$ENDIF}
  57
  58 procedure Update ();
  59 begin
  60   // remember old mobj positions, prepare for update
  61   g_Game_PreUpdate();
  62   // server: receive client commands for new frame
  63   // client: receive game state changes from server
  64        if (NetMode = NET_SERVER) then g_Net_Host_Update()
  65   else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
  66   // think
  67   g_Game_Update();
  68   // server: send any accumulated outgoing data to clients
  69   if NetMode = NET_SERVER then g_Net_Flush();
  70 end;
  71
  72
  73 procedure Draw ();
  74 begin
  75   r_Game_Draw();
  76 end;
  77
  78
  79 procedure Init();
  80   {$IFDEF USE_SDLMIXER}
  81     var timiditycfg: AnsiString;
  82     var oldcwd, newcwd: RawByteString;
  83   {$ENDIF}
  84   var NoSound: Boolean;
  85 begin
  86   Randomize;
  87
  88 {$IFDEF HEADLESS}
  89  {$IFDEF USE_SDLMIXER}
  90   NoSound := False; // hope env has set SDL_AUDIODRIVER to dummy
  91  {$ELSE}
  92   NoSound := True; // FMOD backend will sort it out
  93  {$ENDIF}
  94 {$ELSE}
  95   NoSound := False;
  96 {$ENDIF}
  97
  98   g_Touch_Init;
  99
 100 (*
 101   if (e_JoysticksAvailable > 0) then
 102     e_WriteLog('Input: Joysticks available.', TMsgType.Notify)
 103   else
 104     e_WriteLog('Input: No Joysticks.', TMsgType.Notify);
 105 *)
 106
 107   if gNoSound = false then
 108   begin
 109     e_WriteLog('Initializing sound system', TMsgType.Notify);
 110     {$IFDEF USE_SDLMIXER}
 111       newcwd := '';
 112       if UseNativeMusic then
 113         SetEnvVar('SDL_NATIVE_MUSIC', '1');
 114       timiditycfg := GetEnvironmentVariable('TIMIDITY_CFG');
 115       if timiditycfg = '' then
 116       begin
 117         timiditycfg := 'timidity.cfg';
 118         if e_FindResource(ConfigDirs, timiditycfg) OR e_FindResource(DataDirs, timiditycfg) then
 119         begin
 120           timiditycfg := ExpandFileName(timiditycfg);
 121           newcwd := ExtractFileDir(timiditycfg);
 122           SetEnvVar('TIMIDITY_CFG', timiditycfg);
 123         end
 124         else
 125           timiditycfg := '';
 126       end;
 127       e_LogWritefln('TIMIDITY_CFG = "%s"', [timiditycfg]);
 128       e_LogWritefln('SDL_NATIVE_MUSIC = "%s"', [GetEnvironmentVariable('SDL_NATIVE_MUSIC')]);
 129     {$ENDIF}
 130     e_InitSoundSystem(NoSound);
 131     {$IFDEF USE_SDLMIXER}
 132       if e_TimidityDecoder and (newcwd <> '') then
 133       begin
 134         (* HACK: Set CWD to load GUS patches relatively to cfg file. *)
 135         (*       CWD not restored after sound init because timidity  *)
 136         (*       store relative pathes internally and load patches   *)
 137         (*       later. I hope game never relies on CWD.             *)
 138         oldcwd := '';
 139         GetDir(0, oldcwd);
 140         ChDir(newcwd);
 141         e_logwritefln('WARNING: USED TIMIDITY CONFIG HACK, CWD SWITCHED "%s" -> "%s"', [oldcwd, newcwd]);
 142       end;
 143     {$ENDIF}
 144   end;
 145
 146   e_WriteLog('Init game', TMsgType.Notify);
 147   g_Game_Init();
 148
 149 //  FillChar(charbuff, sizeof(charbuff), ' ');
 150 end;
 151
 152 procedure Release();
 153 begin
 154   e_WriteLog('Releasing engine', TMsgType.Notify);
 155   e_ReleaseEngine();
 156
 157   e_WriteLog('Releasing input', TMsgType.Notify);
 158   e_ReleaseInput();
 159
 160   if not gNoSound then
 161   begin
 162     e_WriteLog('Releasing sound', TMsgType.Notify);
 163     e_ReleaseSoundSystem();
 164   end;
 165 end;
 166
 167 procedure ResetTimer ();
 168 begin
 169   wNeedTimeReset := true;
 170 end;
 171
 172 procedure ProcessLoading (forceUpdate: Boolean=false);
 173 begin
 174   if sys_HandleInput() = True then
 175     Exit;
 176
 177 {$IFNDEF HEADLESS}
 178   r_Window_DrawLoading(forceUpdate);
 179 {$ENDIF}
 180
 181   e_SoundUpdate();
 182
 183   // TODO: At the moment, I left here only host network processing, because the client code must
 184   // handle network events on its own. Otherwise separate network cases that use different calls to
 185   // enet_host_service() WILL lose their packets (for example, resource downloading). So they have
 186   // to handle everything by themselves. But in general, this MUST be removed completely, since
 187   // updating the window should never affect the network. Use single enet_host_service(), period.
 188   if NetMode = NET_SERVER
 189     then g_Net_Host_Update();
 190 end;
 191
 192
 193 function ProcessMessage (): Boolean;
 194 var
 195   i, t: Integer;
 196 begin
 197   result := sys_HandleInput();
 198
 199   Time := sys_GetTicks();
 200   Time_Delta := Time-Time_Old;
 201
 202   flag := false;
 203
 204   if wNeedTimeReset then
 205   begin
 206     Frame := 0;
 207     Time_Delta := 28;
 208     wNeedTimeReset := false;
 209   end;
 210
 211   g_Map_ProfilersBegin();
 212   g_Mons_ProfilersBegin();
 213
 214   t := Time_Delta div 28;
 215   if (t > 0) then
 216   begin
 217     flag := true;
 218     for i := 1 to t do
 219       Update();
 220   end;
 221
 222   g_Map_ProfilersEnd();
 223   g_Mons_ProfilersEnd();
 224
 225   if wLoadingQuit then
 226   begin
 227     g_Game_Free();
 228     g_Game_Quit();
 229   end;
 230
 231   if (gExit = EXIT_QUIT) then
 232   begin
 233     result := true;
 234     exit;
 235   end;
 236
 237   // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
 238   if flag then
 239     Time_Old := Time - (Time_Delta mod 28);
 240
 241   // don't wait if VSync is on, GL already probably waits enough
 242   if gLerpActors then
 243     flag := (Time - Frame >= gFrameTime) or gVSync;
 244
 245   if flag then
 246   begin
 247     if gPause or (not gLerpActors) or (gState = STATE_FOLD) then
 248       gLerpFactor := 1.0
 249     else
 250       gLerpFactor := nmin(1.0, (Time - Time_Old) / 28.0);
 251     Draw;
 252     sys_Repaint;
 253     Frame := Time
 254   end
 255   else
 256     sys_Delay(1);
 257
 258   e_SoundUpdate();
 259 end;
 260
 261 function SDLMain (): Integer;
 262 var
 263   idx: Integer;
 264   arg: AnsiString;
 265   mdfo: TStream;
 266   {$IFDEF ENABLE_HOLMES}
 267   itmp: Integer;
 268   valres: Word;
 269   {$ENDIF}
 270 begin
 271
 272   idx := 1;
 273   while (idx <= ParamCount) do
 274   begin
 275     arg := ParamStr(idx);
 276     Inc(idx);
 277     if arg = '--jah' then g_profile_history_size := 100;
 278     if arg = '--no-particles' then gpart_dbg_enabled := false;
 279     if arg = '--no-los' then gmon_dbg_los_enabled := false;
 280
 281     if arg = '--profile-render' then g_profile_frame_draw := true;
 282     if arg = '--profile-coldet' then g_profile_collision := true;
 283     if arg = '--profile-los' then g_profile_los := true;
 284
 285     if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
 286     if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
 287     if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
 288     if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
 289     if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
 290     if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
 291
 292     if arg = '--debug-input' then g_dbg_input := True;
 293
 294     {.$IF DEFINED(D2F_DEBUG)}
 295     if arg = '--aimline' then g_dbg_aimline_on := true;
 296     {.$ENDIF}
 297
 298 {$IFDEF ENABLE_HOLMES}
 299     if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
 300
 301     if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
 302     begin
 303       if (idx <= ParamCount) then
 304       begin
 305         if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
 306         Inc(idx);
 307       end;
 308     end;
 309
 310     if (arg = '--holmes-font') or (arg = '-holmes-font') then
 311     begin
 312       if (idx <= ParamCount) then
 313       begin
 314         itmp := 0;
 315         val(ParamStr(idx), itmp, valres);
 316         {$IFNDEF HEADLESS}
 317         if (valres = 0) and (not g_holmes_imfunctional) then
 318         begin
 319           case itmp of
 320             8: uiContext.font := 'win8';
 321             14: uiContext.font := 'win14';
 322             16: uiContext.font := 'win16';
 323           end;
 324         end;
 325         {$ELSE}
 326         // fuck off, fpc!
 327         itmp := itmp;
 328         valres := valres;
 329         {$ENDIF}
 330         Inc(idx);
 331       end;
 332     end;
 333 {$ENDIF}
 334
 335     if (arg = '--game-scale') or (arg = '-game-scale') then
 336     begin
 337       if (idx <= ParamCount) then
 338       begin
 339         if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
 340         Inc(idx);
 341       end;
 342     end;
 343
 344     if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
 345     begin
 346       mdfo := createDiskFile('mapdef.txt');
 347       mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
 348       mdfo.Free();
 349       Halt(0);
 350     end;
 351
 352     if (arg = '--pixel-scale') or (arg = '-pixel-scale') then
 353     begin
 354       if (idx <= ParamCount) then
 355       begin
 356         if not conParseFloat(r_pixel_scale, ParamStr(idx)) then r_pixel_scale := 1.0;
 357         Inc(idx);
 358       end;
 359     end;
 360   end;
 361
 362   r_Window_Initialize;
 363
 364   Init;
 365   Time_Old := sys_GetTicks();
 366
 367   g_Net_InitLowLevel();
 368
 369   // Êîìàíäíàÿ ñòðîêà
 370   if (ParamCount > 0) then g_Game_Process_Params();
 371
 372 {$IFNDEF HEADLESS}
 373   // Çàïðîñ ÿçûêà
 374   if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
 375 {$ENDIF}
 376
 377   e_WriteLog('Entering the main loop', TMsgType.Notify);
 378
 379   // main loop
 380   while not ProcessMessage() do begin end;
 381
 382   g_Net_Slist_ShutdownAll();
 383
 384   Release();
 385
 386   g_Net_DeinitLowLevel();
 387   result := 0;
 388 end;
 389
 390
 391 initialization
 392 {$IFDEF USE_SDLMIXER}
 393   conRegVar('sdl_native_music', @UseNativeMusic, 'use native midi music output when possible', 'use native midi');
 394   {$IFDEF DARWIN}
 395     UseNativeMusic := true; (* OSX have a good midi support, so why not? *)
 396   {$ELSE}
 397     UseNativeMusic := false;
 398   {$ENDIF}
 399 {$ENDIF}
 400   conRegVar('d_input', @g_dbg_input, '', '')
 401 end.