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