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