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