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