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