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