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