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