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, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit g_window;
  18
  19 interface
  20
  21 uses
  22   utils;
  23
  24 function SDLMain (): Integer;
  25 function GetTimer (): Int64;
  26 procedure ResetTimer ();
  27 function CreateGLWindow (Title: PChar): Boolean;
  28 procedure KillGLWindow ();
  29 procedure PushExitEvent ();
  30 function ProcessMessage (): Boolean;
  31 procedure ReDrawWindow ();
  32 procedure SwapBuffers ();
  33 procedure Sleep (ms: LongWord);
  34 function GetDisplayModes (dbpp: LongWord; var selres: LongWord): SSArray;
  35 function g_Window_SetDisplay (preserveGL: Boolean=false): Boolean;
  36 function g_Window_SetSize (w, h: Word; fullscreen: Boolean): Boolean;
  37
  38 procedure ProcessLoading (forceUpdate: Boolean=false);
  39
  40
  41 var
  42   gwin_dump_extensions: Boolean = false;
  43   gwin_has_stencil: Boolean = false;
  44   gwin_k8_enable_light_experiments: Boolean = false;
  45   g_dbg_aimline_on: Boolean = false;
  46
  47
  48 implementation
  49
  50 uses
  51 {$IFDEF WINDOWS}Windows,{$ENDIF}
  52   SysUtils, Classes, MAPDEF,
  53   SDL2, GL, GLExt, e_graphics, e_log, e_texture, g_main,
  54   g_console, e_input, g_options, g_game,
  55   g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net,
  56   g_map, g_gfx, g_monsters, g_holmes, xprofiler;
  57
  58
  59 const
  60   ProgressUpdateMSecs = 100;
  61
  62 var
  63   h_Wnd: PSDL_Window = nil;
  64   h_GL: TSDL_GLContext = nil;
  65   wFlags: LongWord = 0;
  66   Time, Time_Delta, Time_Old: Int64;
  67   flag: Boolean;
  68   wTitle: PChar = nil;
  69   wNeedTimeReset: Boolean = false;
  70   wMinimized: Boolean = false;
  71   wLoadingProgress: Boolean = false;
  72   wLoadingQuit: Boolean = false;
  73 {$IFNDEF WINDOWS}
  74   ticksOverflow: Int64 = -1;
  75   lastTicks: Uint32 = 0; // to detect overflow
  76 {$ENDIF}
  77 {$IF not DEFINED(HEADLESS)}
  78   curMsButState: Word = 0;
  79   curKbState: Word = 0;
  80   curMsX: Integer = 0;
  81   curMsY: Integer = 0;
  82 {$ENDIF}
  83
  84
  85 function g_Window_SetDisplay (preserveGL: Boolean = false): Boolean;
  86 {$IF not DEFINED(HEADLESS)}
  87 var
  88   mode, cmode: TSDL_DisplayMode;
  89 {$ENDIF}
  90 begin
  91 {$IF not DEFINED(HEADLESS)}
  92   result := false;
  93
  94   e_WriteLog('Setting display mode...', TMsgType.Notify);
  95
  96   wFlags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE;
  97   if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN;
  98   if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED;
  99
 100   if (h_Wnd <> nil) then
 101   begin
 102     SDL_DestroyWindow(h_Wnd);
 103     h_Wnd := nil;
 104   end;
 105
 106   if gFullscreen then
 107   begin
 108     mode.w := gScreenWidth;
 109     mode.h := gScreenHeight;
 110     mode.format := 0;
 111     mode.refresh_rate := 0;
 112     mode.driverdata := nil;
 113     if (SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil) then
 114     begin
 115       gScreenWidth := 800;
 116       gScreenHeight := 600;
 117     end
 118     else
 119     begin
 120       gScreenWidth := cmode.w;
 121       gScreenHeight := cmode.h;
 122     end;
 123   end;
 124
 125   h_Wnd := SDL_CreateWindow(PChar(wTitle), gWinRealPosX, gWinRealPosY, gScreenWidth, gScreenHeight, wFlags);
 126   if (h_Wnd = nil) then exit;
 127
 128   SDL_GL_MakeCurrent(h_Wnd, h_GL);
 129   SDL_ShowCursor(SDL_DISABLE);
 130 {$ENDIF}
 131
 132   result := true;
 133 end;
 134
 135
 136 function GetDisplayModes(dbpp: LongWord; var selres: LongWord): SSArray;
 137 var
 138   mode: TSDL_DisplayMode;
 139   res, i, k, n, pw, ph: Integer;
 140 begin
 141   SetLength(result, 0);
 142   {$IFDEF HEADLESS}exit;{$ENDIF}
 143   k := 0; selres := 0;
 144   n := SDL_GetNumDisplayModes(0);
 145   pw := 0; ph := 0;
 146   for i := 0 to n do
 147   begin
 148     res := SDL_GetDisplayMode(0, i, @mode);
 149     if res < 0 then continue;
 150     if SDL_BITSPERPIXEL(mode.format) = gBPP then continue;
 151     if (mode.w = pw) and (mode.h = ph) then continue;
 152     if (mode.w = gScreenWidth) and (mode.h = gScreenHeight) then
 153       selres := k;
 154     Inc(k);
 155     SetLength(result, k);
 156     result[k-1] := IntToStr(mode.w) + 'x' + IntToStr(mode.h);
 157     pw := mode.w; ph := mode.h
 158   end;
 159
 160   e_WriteLog('SDL: Got ' + IntToStr(k) + ' resolutions.', TMsgType.Notify);
 161 end;
 162
 163
 164 procedure Sleep (ms: LongWord);
 165 begin
 166   SDL_Delay(ms);
 167 end;
 168
 169
 170 procedure ChangeWindowSize ();
 171 begin
 172   gWinSizeX := gScreenWidth;
 173   gWinSizeY := gScreenHeight;
 174 {$IF not DEFINED(HEADLESS)}
 175   e_ResizeWindow(gScreenWidth, gScreenHeight);
 176   g_Game_SetupScreenSize();
 177   g_Menu_Reset();
 178   g_Game_ClearLoading();
 179   g_Holmes_VidModeChanged();
 180 {$ENDIF}
 181 end;
 182
 183
 184 function g_Window_SetSize (w, h: Word; fullscreen: Boolean): Boolean;
 185 var
 186   preserve: Boolean;
 187 begin
 188   result := false;
 189 {$IF not DEFINED(HEADLESS)}
 190   preserve := false;
 191
 192   if (gScreenWidth <> w) or (gScreenHeight <> h) then
 193   begin
 194     result := true;
 195     gScreenWidth := w;
 196     gScreenHeight := h;
 197   end;
 198
 199   if (gFullscreen <> fullscreen) then
 200   begin
 201     result := true;
 202     gFullscreen := fullscreen;
 203     preserve := true;
 204   end;
 205
 206   if result then
 207   begin
 208     g_Window_SetDisplay(preserve);
 209     ChangeWindowSize();
 210   end;
 211 {$ENDIF}
 212 end;
 213
 214
 215 procedure resetKMState ();
 216 begin
 217 {$IF not DEFINED(HEADLESS)}
 218   curMsButState := 0;
 219   curKbState := 0;
 220 {$ENDIF}
 221 end;
 222
 223
 224 function WindowEventHandler (constref ev: TSDL_WindowEvent): Boolean;
 225 var
 226   wActivate, wDeactivate: Boolean;
 227 begin
 228   result := false;
 229   wActivate := false;
 230   wDeactivate := false;
 231
 232   case ev.event of
 233     SDL_WINDOWEVENT_MOVED:
 234     begin
 235       if not (gFullscreen or gWinMaximized) then
 236       begin
 237         gWinRealPosX := ev.data1;
 238         gWinRealPosY := ev.data2;
 239       end;
 240     end;
 241
 242     SDL_WINDOWEVENT_MINIMIZED:
 243     begin
 244       resetKMState();
 245       e_UnpressAllKeys();
 246       if not wMinimized then
 247       begin
 248         e_ResizeWindow(0, 0);
 249         wMinimized := true;
 250         if g_debug_WinMsgs then
 251         begin
 252           g_Console_Add('Now minimized');
 253           e_WriteLog('[DEBUG] WinMsgs: Now minimized', TMsgType.Notify);
 254         end;
 255         wDeactivate := true;
 256       end;
 257     end;
 258
 259     SDL_WINDOWEVENT_RESIZED:
 260     begin
 261       resetKMState();
 262       gScreenWidth := ev.data1;
 263       gScreenHeight := ev.data2;
 264       ChangeWindowSize();
 265       SwapBuffers();
 266       if g_debug_WinMsgs then
 267       begin
 268         g_Console_Add('Resized to ' + IntToStr(ev.data1) + 'x' + IntToStr(ev.data2));
 269         e_WriteLog('[DEBUG] WinMsgs: Resized to ' + IntToStr(ev.data1) + 'x' + IntToStr(ev.data2), TMsgType.Notify);
 270       end;
 271     end;
 272
 273     SDL_WINDOWEVENT_EXPOSED:
 274       SwapBuffers();
 275
 276     SDL_WINDOWEVENT_MAXIMIZED:
 277     begin
 278       resetKMState();
 279       if wMinimized then
 280       begin
 281         e_ResizeWindow(gScreenWidth, gScreenHeight);
 282         wMinimized := false;
 283         wActivate := true;
 284       end;
 285       if not gWinMaximized then
 286       begin
 287         gWinMaximized := true;
 288         if g_debug_WinMsgs then
 289         begin
 290           g_Console_Add('Now maximized');
 291           e_WriteLog('[DEBUG] WinMsgs: Now maximized', TMsgType.Notify);
 292         end;
 293       end;
 294     end;
 295
 296     SDL_WINDOWEVENT_RESTORED:
 297     begin
 298       resetKMState();
 299       if wMinimized then
 300       begin
 301         e_ResizeWindow(gScreenWidth, gScreenHeight);
 302         wMinimized := false;
 303         wActivate := true;
 304       end;
 305       if gWinMaximized then
 306         gWinMaximized := false;
 307       if g_debug_WinMsgs then
 308       begin
 309         g_Console_Add('Now restored');
 310         e_WriteLog('[DEBUG] WinMsgs: Now restored', TMsgType.Notify);
 311       end;
 312     end;
 313
 314     SDL_WINDOWEVENT_FOCUS_GAINED:
 315     begin
 316       resetKMState();
 317       wActivate := true;
 318       //e_WriteLog('window gained focus!', MSG_NOTIFY);
 319       g_Holmes_WindowFocused();
 320     end;
 321
 322     SDL_WINDOWEVENT_FOCUS_LOST:
 323     begin
 324       resetKMState();
 325       wDeactivate := true;
 326       e_UnpressAllKeys();
 327       //e_WriteLog('window lost focus!', MSG_NOTIFY);
 328       g_Holmes_WindowBlured();
 329     end;
 330   end;
 331
 332   if wDeactivate then
 333   begin
 334     if gWinActive then
 335     begin
 336       e_WriteLog('deactivating window', TMsgType.Notify);
 337       e_EnableInput := false;
 338       e_ClearInputBuffer();
 339
 340       if gMuteWhenInactive then
 341       begin
 342         //e_WriteLog('deactivating sounds', MSG_NOTIFY);
 343         e_MuteChannels(true);
 344       end;
 345
 346       if g_debug_WinMsgs then
 347       begin
 348         g_Console_Add('Now inactive');
 349         e_WriteLog('[DEBUG] WinMsgs: Now inactive', TMsgType.Notify);
 350       end;
 351
 352       gWinActive := false;
 353     end;
 354   end
 355   else if wActivate then
 356   begin
 357     if not gWinActive then
 358     begin
 359       //e_WriteLog('activating window', MSG_NOTIFY);
 360       e_EnableInput := true;
 361
 362       if gMuteWhenInactive then
 363       begin
 364         //e_WriteLog('activating sounds', MSG_NOTIFY);
 365         e_MuteChannels(false);
 366       end;
 367
 368       if g_debug_WinMsgs then
 369       begin
 370         g_Console_Add('Now active');
 371         e_WriteLog('[DEBUG] WinMsgs: Now active', TMsgType.Notify);
 372       end;
 373
 374       gWinActive := true;
 375     end;
 376   end;
 377 end;
 378
 379
 380 function EventHandler (var ev: TSDL_Event): Boolean;
 381 var
 382   key, keychr: Word;
 383   uc: UnicodeChar;
 384   {$IF not DEFINED(HEADLESS)}
 385   msev: THMouseEvent;
 386   kbev: THKeyEvent;
 387   {$ENDIF}
 388
 389   function buildBut (b: Byte): Word;
 390   begin
 391     result := 0;
 392     case b of
 393       SDL_BUTTON_LEFT: result := result or THMouseEvent.Left;
 394       SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle;
 395       SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right;
 396     end;
 397   end;
 398
 399   {$IF not DEFINED(HEADLESS)}
 400   procedure updateKBState ();
 401   var
 402     kbstate: PUint8;
 403   begin
 404     curKbState := 0;
 405     kbstate := SDL_GetKeyboardState(nil);
 406     if (kbstate[SDL_SCANCODE_LCTRL] <> 0) or (kbstate[SDL_SCANCODE_RCTRL] <> 0) then curKbState := curKbState or THKeyEvent.ModCtrl;
 407     if (kbstate[SDL_SCANCODE_LALT] <> 0) or (kbstate[SDL_SCANCODE_RALT] <> 0) then curKbState := curKbState or THKeyEvent.ModAlt;
 408     if (kbstate[SDL_SCANCODE_LSHIFT] <> 0) or (kbstate[SDL_SCANCODE_RSHIFT] <> 0) then curKbState := curKbState or THKeyEvent.ModShift;
 409   end;
 410   {$ENDIF}
 411
 412 begin
 413   result := false;
 414   {$IF not DEFINED(HEADLESS)}
 415   updateKBState();
 416   {$ENDIF}
 417
 418   case ev.type_ of
 419     SDL_WINDOWEVENT:
 420       result := WindowEventHandler(ev.window);
 421
 422     SDL_QUITEV:
 423       begin
 424         if gExit <> EXIT_QUIT then
 425         begin
 426           if not wLoadingProgress then
 427           begin
 428             g_Game_Free();
 429             g_Game_Quit();
 430           end
 431           else
 432             wLoadingQuit := true;
 433         end;
 434         result := true;
 435       end;
 436
 437     SDL_KEYDOWN, SDL_KEYUP:
 438       begin
 439         key := ev.key.keysym.scancode;
 440         {$IF not DEFINED(HEADLESS)}
 441         if (g_holmes_enabled) then
 442         begin
 443           if (ev.type_ = SDL_KEYDOWN) then kbev.kind := THKeyEvent.Press else kbev.kind := THKeyEvent.Release;
 444           kbev.scan := ev.key.keysym.scancode;
 445           kbev.sym := ev.key.keysym.sym;
 446           kbev.bstate := curMsButState;
 447           kbev.kstate := curKbState;
 448           if g_Holmes_keyEvent(kbev) then
 449           begin
 450             if (ev.type_ <> SDL_KEYDOWN) then e_KeyUpDown(ev.key.keysym.scancode, false);
 451             exit;
 452           end;
 453         end;
 454         {$ENDIF}
 455         if (ev.type_ = SDL_KEYDOWN) then KeyPress(key);
 456         e_KeyUpDown(ev.key.keysym.scancode, (ev.type_ = SDL_KEYDOWN));
 457       end;
 458
 459     {$IF not DEFINED(HEADLESS)}
 460     SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
 461       begin
 462         msev.dx := ev.button.x-curMsX;
 463         msev.dy := ev.button.y-curMsY;
 464         curMsX := ev.button.x;
 465         curMsY := ev.button.y;
 466         if (ev.type_ = SDL_MOUSEBUTTONDOWN) then msev.kind := THMouseEvent.Press else msev.kind := THMouseEvent.Release;
 467         msev.but := buildBut(ev.button.button);
 468         msev.x := curMsX;
 469         msev.y := curMsY;
 470         if (msev.but <> 0) then
 471         begin
 472           // ev.button.clicks: Byte
 473           if (ev.type_ = SDL_MOUSEBUTTONDOWN) then curMsButState := curMsButState or msev.but else curMsButState := curMsButState and (not msev.but);
 474           msev.bstate := curMsButState;
 475           msev.kstate := curKbState;
 476           if (g_holmes_enabled) then g_Holmes_mouseEvent(msev);
 477         end;
 478       end;
 479     SDL_MOUSEWHEEL:
 480       begin
 481         if (ev.wheel.y <> 0) then
 482         begin
 483           msev.dx := 0;
 484           msev.dy := ev.wheel.y;
 485           msev.kind := THMouseEvent.Press;
 486           if (ev.wheel.y < 0) then msev.but := THMouseEvent.WheelUp else msev.but := THMouseEvent.WheelDown;
 487           msev.x := curMsX;
 488           msev.y := curMsY;
 489           msev.bstate := curMsButState;
 490           msev.kstate := curKbState;
 491           if (g_holmes_enabled) then g_Holmes_mouseEvent(msev);
 492         end;
 493       end;
 494     SDL_MOUSEMOTION:
 495       begin
 496         msev.dx := ev.button.x-curMsX;
 497         msev.dy := ev.button.y-curMsY;
 498         curMsX := ev.button.x;
 499         curMsY := ev.button.y;
 500         msev.kind := THMouseEvent.Motion;
 501         msev.but := 0;
 502         msev.x := curMsX;
 503         msev.y := curMsY;
 504         msev.bstate := curMsButState;
 505         msev.kstate := curKbState;
 506         if (g_holmes_enabled) then g_Holmes_mouseEvent(msev);
 507       end;
 508     {$ENDIF}
 509
 510     SDL_TEXTINPUT:
 511       begin
 512         Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
 513         keychr := Word(uc);
 514         if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
 515         CharPress(AnsiChar(keychr));
 516       end;
 517
 518     // other key presses and joysticks are handled in e_input
 519   end;
 520 end;
 521
 522
 523 procedure SwapBuffers ();
 524 begin
 525   {$IF not DEFINED(HEADLESS)}
 526   SDL_GL_SwapWindow(h_Wnd);
 527   {$ENDIF}
 528 end;
 529
 530
 531 procedure KillGLWindow();
 532 begin
 533   if (h_Wnd <> nil) then SDL_DestroyWindow(h_Wnd);
 534   if (h_GL <> nil) then SDL_GL_DeleteContext(h_GL);
 535   h_Wnd := nil;
 536   h_GL := nil;
 537 end;
 538
 539
 540 function CreateGLWindow (Title: PChar): Boolean;
 541 begin
 542   result := false;
 543
 544   gWinSizeX := gScreenWidth;
 545   gWinSizeY := gScreenHeight;
 546
 547   wTitle := Title;
 548   e_WriteLog('Creating window', TMsgType.Notify);
 549
 550   if not g_Window_SetDisplay() then
 551   begin
 552     KillGLWindow();
 553     e_WriteLog('Window creation error (resolution not supported?)', TMsgType.Fatal);
 554     exit;
 555   end;
 556
 557 {$IF not DEFINED(HEADLESS)}
 558   h_Gl := SDL_GL_CreateContext(h_Wnd);
 559   if (h_Gl = nil) then exit;
 560 {$ENDIF}
 561
 562   e_ResizeWindow(gScreenWidth, gScreenHeight);
 563   e_InitGL();
 564
 565   result := true;
 566 end;
 567
 568
 569 {$IFDEF WINDOWS}
 570 // windoze sux; in headless mode `GetTickCount()` (and SDL) returns shit
 571 function GetTimer (): Int64;
 572 var
 573   F, C: Int64;
 574 begin
 575   QueryPerformanceFrequency(F);
 576   QueryPerformanceCounter(C);
 577   result := Round(C/F*1000{000});
 578 end;
 579 {$ELSE}
 580 function GetTimer (): Int64;
 581 var
 582   t: Uint32;
 583   tt: Int64;
 584 begin
 585   t := SDL_GetTicks();
 586   if (ticksOverflow = -1) then
 587   begin
 588     ticksOverflow := 0;
 589     lastTicks := t;
 590   end
 591   else
 592   begin
 593     if (lastTicks > t) then
 594     begin
 595       // overflow, increment overflow ;-)
 596       ticksOverflow := ticksOverflow+(Int64($ffffffff)+Int64(1));
 597       tt := (Int64($ffffffff)+Int64(1))+Int64(t);
 598       t := Uint32(tt-lastTicks);
 599     end;
 600   end;
 601   lastTicks := t;
 602   result := ticksOverflow+Int64(t);
 603 end;
 604 {$ENDIF}
 605
 606
 607 procedure ResetTimer ();
 608 begin
 609   wNeedTimeReset := true;
 610 end;
 611
 612
 613 procedure PushExitEvent ();
 614 var
 615   ev: TSDL_Event;
 616 begin
 617   ev.type_ := SDL_QUITEV;
 618   SDL_PushEvent(@ev);
 619 end;
 620
 621
 622 var
 623   prevLoadingUpdateTime: UInt64 = 0;
 624
 625 procedure ProcessLoading (forceUpdate: Boolean=false);
 626 var
 627   ev: TSDL_Event;
 628   ID: LongWord;
 629   stt: UInt64;
 630 begin
 631   FillChar(ev, sizeof(ev), 0);
 632   wLoadingProgress := true;
 633
 634   while (SDL_PollEvent(@ev) > 0) do
 635   begin
 636     if (ev.type_ = SDL_QUITEV) then break;
 637   end;
 638
 639   if (ev.type_ = SDL_QUITEV) or (gExit = EXIT_QUIT) then
 640   begin
 641     wLoadingProgress := false;
 642     exit;
 643   end;
 644
 645   if not wMinimized then
 646   begin
 647     if forceUpdate then
 648     begin
 649       prevLoadingUpdateTime := getTimeMilli();
 650     end
 651     else
 652     begin
 653       stt := getTimeMilli();
 654       if (stt < prevLoadingUpdateTime) or (stt-prevLoadingUpdateTime >= ProgressUpdateMSecs) then
 655       begin
 656         prevLoadingUpdateTime := stt;
 657         forceUpdate := true;
 658       end;
 659     end;
 660
 661     if forceUpdate then
 662     begin
 663       if g_Texture_Get('INTER', ID) then
 664       begin
 665         e_DrawSize(ID, 0, 0, 0, false, false, gScreenWidth, gScreenHeight)
 666       end
 667       else
 668       begin
 669         e_Clear(GL_COLOR_BUFFER_BIT, 0, 0, 0);
 670       end;
 671
 672       DrawLoadingStat();
 673       SwapBuffers();
 674     end;
 675   end;
 676
 677   e_SoundUpdate();
 678
 679   if NetMode = NET_SERVER then
 680   begin
 681     g_Net_Host_Update();
 682   end
 683   else
 684   begin
 685     if (NetMode = NET_CLIENT) and (NetState <> NET_STATE_AUTH) then g_Net_Client_UpdateWhileLoading();
 686   end;
 687
 688   wLoadingProgress := false;
 689 end;
 690
 691
 692 function ProcessMessage (): Boolean;
 693 var
 694   i, t: Integer;
 695   ev: TSDL_Event;
 696 begin
 697   result := false;
 698   FillChar(ev, SizeOf(ev), 0);
 699
 700   while (SDL_PollEvent(@ev) > 0) do
 701   begin
 702     result := EventHandler(ev);
 703     if (ev.type_ = SDL_QUITEV) then exit;
 704   end;
 705
 706   Time := GetTimer();
 707   Time_Delta := Time-Time_Old;
 708
 709   flag := false;
 710
 711   if wNeedTimeReset then
 712   begin
 713     Time_Delta := 28;
 714     wNeedTimeReset := false;
 715   end;
 716
 717   g_Map_ProfilersBegin();
 718   g_Mons_ProfilersBegin();
 719
 720   t := Time_Delta div 28;
 721   if (t > 0) then
 722   begin
 723     flag := true;
 724     for i := 1 to t do
 725     begin
 726            if (NetMode = NET_SERVER) then g_Net_Host_Update()
 727       else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
 728       Update();
 729     end;
 730   end
 731   else
 732   begin
 733          if (NetMode = NET_SERVER) then g_Net_Host_Update()
 734     else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
 735   end;
 736
 737   g_Map_ProfilersEnd();
 738   g_Mons_ProfilersEnd();
 739
 740   if wLoadingQuit then
 741   begin
 742     g_Game_Free();
 743     g_Game_Quit();
 744   end;
 745
 746   if (gExit = EXIT_QUIT) then
 747   begin
 748     result := true;
 749     exit;
 750   end;
 751
 752   // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
 753   if flag then
 754   begin
 755     Time_Old := Time-(Time_Delta mod 28);
 756     if (not wMinimized) then
 757     begin
 758       Draw();
 759       SwapBuffers();
 760     end;
 761   end
 762   else
 763   begin
 764     Sleep(1); // release time slice, so we won't eat 100% CPU
 765   end;
 766
 767   e_SoundUpdate();
 768 end;
 769
 770
 771 procedure ReDrawWindow ();
 772 begin
 773   SwapBuffers();
 774 end;
 775
 776
 777 procedure InitOpenGL (vsync: Boolean);
 778 {$IF not DEFINED(HEADLESS)}
 779 var
 780   v: Byte;
 781 {$ENDIF}
 782 begin
 783 {$IF not DEFINED(HEADLESS)}
 784   if vsync then v := 1 else v := 0;
 785   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
 786   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
 787   SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
 788   SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
 789   SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
 790   SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
 791   SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
 792   SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 8); // lights; it is enough to have 1-bit stencil buffer for lighting, but...
 793   SDL_GL_SetSwapInterval(v);
 794 {$ENDIF}
 795 end;
 796
 797
 798 function glHasExtension (const name: AnsiString): Boolean;
 799 var
 800   exts: PChar;
 801   i: Integer;
 802   found: Boolean;
 803   extName: ShortString;
 804 begin
 805   result := false;
 806   if (Length(name) = 0) then exit;
 807   exts := glGetString(GL_EXTENSIONS);
 808   if (exts = nil) then exit;
 809   while (exts[0] <> #0) and (exts[0] = ' ') do Inc(exts);
 810   while (exts[0] <> #0) do
 811   begin
 812     if gwin_dump_extensions then
 813     begin
 814       i := 0;
 815       while (exts[i] <> #0) and (exts[i] <> ' ') do Inc(i);
 816       if i > 255 then
 817       begin
 818         e_WriteLog('FUUUUUUUUUUUUU', TMsgType.Warning);
 819       end
 820       else
 821       begin
 822         Move(exts^, extName[1], i);
 823         extName[0] := Char(i);
 824         e_WriteLog(Format('EXT: %s', [extName]), TMsgType.Notify);
 825       end;
 826     end;
 827     found := true;
 828     for i := 0 to length(name)-1 do
 829     begin
 830       if (exts[i] = #0) then begin found := false; break; end;
 831       if (exts[i] <> name[i+1]) then begin found := false; break; end;
 832     end;
 833     if found and ((exts[Length(name)] = #0) or (exts[Length(name)] = ' ')) then begin result := true; exit; end;
 834     while (exts[0] <> #0) and (exts[0] <> ' ') do Inc(exts);
 835     while (exts[0] <> #0) and (exts[0] = ' ') do Inc(exts);
 836   end;
 837 end;
 838
 839
 840 function SDLMain (): Integer;
 841 var
 842   idx: Integer;
 843   {$IF not DEFINED(HEADLESS)}
 844   ltmp: Integer;
 845   {$ENDIF}
 846   arg: AnsiString;
 847   mdfo: TStream;
 848 begin
 849 {$IFDEF HEADLESS}
 850   e_NoGraphics := true;
 851 {$ENDIF}
 852
 853   idx := 1;
 854   while (idx <= ParamCount) do
 855   begin
 856     arg := ParamStr(idx);
 857     Inc(idx);
 858     if arg = '--opengl-dump-exts' then gwin_dump_extensions := true;
 859     //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
 860     if arg = '--jah' then g_profile_history_size := 100;
 861     if arg = '--no-particles' then gpart_dbg_enabled := false;
 862     if arg = '--no-los' then gmon_dbg_los_enabled := false;
 863
 864     if arg = '--profile-render' then g_profile_frame_draw := true;
 865     if arg = '--profile-coldet' then g_profile_collision := true;
 866     if arg = '--profile-los' then g_profile_los := true;
 867
 868     if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
 869     if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
 870     if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
 871     if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
 872     if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
 873     if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
 874
 875     {.$IF DEFINED(D2F_DEBUG)}
 876     if arg = '--aimline' then g_dbg_aimline_on := true;
 877     {.$ENDIF}
 878
 879     if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
 880     if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
 881     begin
 882       if (idx <= ParamCount) then
 883       begin
 884         if not conParseFloat(g_holmes_ui_scale, ParamStr(idx)) then g_holmes_ui_scale := 1.0;
 885         Inc(idx);
 886       end;
 887     end;
 888
 889     if (arg = '--game-scale') or (arg = '-game-scale') then
 890     begin
 891       if (idx <= ParamCount) then
 892       begin
 893         if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
 894         Inc(idx);
 895       end;
 896     end;
 897
 898     if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
 899     begin
 900       mdfo := createDiskFile('mapdef.txt');
 901       mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
 902       mdfo.Free();
 903       Halt(0);
 904     end;
 905   end;
 906
 907   e_WriteLog('Initializing OpenGL', TMsgType.Notify);
 908   InitOpenGL(gVSync);
 909
 910   e_WriteLog('Creating GL window', TMsgType.Notify);
 911   if not CreateGLWindow(PChar(Format('Doom 2D: Forever %s', [GAME_VERSION]))) then
 912   begin
 913     result := 0;
 914     exit;
 915   end;
 916
 917   {EnumDisplayModes();}
 918
 919 {$IFDEF HEADLESS}
 920   //gwin_k8_enable_light_experiments := false;
 921   gwin_has_stencil := false;
 922   glLegacyNPOT := false;
 923   gwin_dump_extensions := false;
 924 {$ELSE}
 925   SDL_GL_GetAttribute(SDL_GL_STENCIL_SIZE, @ltmp);
 926   e_LogWritefln('stencil buffer size: %s', [ltmp]);
 927   gwin_has_stencil := (ltmp > 0);
 928
 929   if not glHasExtension('GL_ARB_texture_non_power_of_two') then
 930   begin
 931     e_WriteLog('Driver DID''T advertised NPOT textures support', TMsgType.Warning);
 932     glLegacyNPOT := true;
 933   end
 934   else
 935   begin
 936     e_WriteLog('Driver advertised NPOT textures support', TMsgType.Notify);
 937     glLegacyNPOT := false;
 938   end;
 939   gwin_dump_extensions := false;
 940 {$ENDIF}
 941
 942   Init();
 943   Time_Old := GetTimer();
 944
 945   // Êîìàíäíàÿ ñòðîêà
 946   if (ParamCount > 0) then g_Game_Process_Params();
 947
 948   // Çàïðîñ ÿçûêà
 949   if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
 950
 951   e_WriteLog('Entering the main loop', TMsgType.Notify);
 952
 953   // main loop
 954   while not ProcessMessage() do begin end;
 955
 956   Release();
 957   KillGLWindow();
 958
 959   result := 0;
 960 end;
 961
 962
 963 end.