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