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