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