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