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