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 {$MODE DELPHI}
  17 unit g_window;
  18
  19 interface
  20
  21 uses
  22   wadreader;
  23
  24 function  SDLMain(): Integer;
  25 function  GetTimer(): Int64;
  26 procedure ResetTimer();
  27 function  CreateGLWindow(Title: PChar): Boolean;
  28 procedure KillGLWindow();
  29 procedure PushExitEvent();
  30 function  ProcessMessage(): Boolean;
  31 procedure ProcessLoading();
  32 procedure ReDrawWindow();
  33 procedure SwapBuffers();
  34 procedure Sleep(ms: LongWord);
  35 function  GetDisplayModes(dBPP: DWORD; var SelRes: DWORD): SArray;
  36 function  g_Window_SetDisplay(PreserveGL: Boolean = False): Boolean;
  37 function  g_Window_SetSize(W, H: Word; FScreen: Boolean): Boolean;
  38
  39 implementation
  40
  41 uses
  42 {$IFDEF WINDOWS}Windows,{$ENDIF}
  43   SDL2, GL, GLExt, e_graphics, e_log, g_main,
  44   g_console, SysUtils, e_input, g_options, g_game,
  45   g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net;
  46
  47 var
  48   h_Wnd: PSDL_Window;
  49   h_GL: TSDL_GLContext;
  50   wFlags: LongWord = 0;
  51   Time, Time_Delta, Time_Old: Int64;
  52   flag: Boolean;
  53   wTitle: PChar = nil;
  54   wNeedTimeReset: Boolean = False;
  55   //wWindowCreated: Boolean = False;
  56   //wCursorShown: Boolean = False;
  57   wMinimized: Boolean = False;
  58   //wNeedFree: Boolean = True;
  59   wLoadingProgress: Boolean = False;
  60   wLoadingQuit: Boolean = False;
  61   {wWinPause: Byte = 0;}
  62 {$IFNDEF WINDOWS}
  63   ticksOverflow: Int64 = -1;
  64   lastTicks: Uint32 = 0; // to detect overflow
  65 {$ENDIF}
  66
  67 const
  68   // TODO: move this to a separate file
  69   CP1251: array [0..127] of Word = (
  70     $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
  71     $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
  72     $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
  73     $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
  74     $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
  75     $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
  76     $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
  77     $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
  78   );
  79
  80 // TODO: make a transition table or something
  81 function WCharToCP1251(wc: Word): Word;
  82 var
  83   n: Word;
  84 begin
  85   Result := 0;
  86   for n := 0 to 127 do
  87     if CP1251[n] = wc then begin Result := n; break end;
  88   Result := Result + 128;
  89 end;
  90
  91 function g_Window_SetDisplay(PreserveGL: Boolean = False): Boolean;
  92 var
  93   mode, cmode: TSDL_DisplayMode;
  94 begin
  95 {$IFDEF HEADLESS}
  96   Result := True;
  97   Exit;
  98 {$ENDIF}
  99
 100   Result := False;
 101
 102   e_WriteLog('Setting display mode...', MSG_NOTIFY);
 103
 104   wFlags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE;
 105   if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN;
 106   if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED;
 107
 108   if h_Wnd <> nil then
 109   begin
 110     SDL_DestroyWindow(h_Wnd);
 111     h_Wnd := nil;
 112   end;
 113
 114   if gFullscreen then
 115   begin
 116     mode.w := gScreenWidth;
 117     mode.h := gScreenHeight;
 118     mode.format := 0;
 119     mode.refresh_rate := 0;
 120     mode.driverdata := nil;
 121     if SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil then
 122     begin
 123       gScreenWidth := 800;
 124       gScreenHeight := 600;
 125     end
 126     else
 127     begin
 128       gScreenWidth := cmode.w;
 129       gScreenHeight := cmode.h;
 130     end;
 131   end;
 132
 133   h_Wnd := SDL_CreateWindow(PChar(wTitle), gWinRealPosX, gWinRealPosY, gScreenWidth, gScreenHeight, wFlags);
 134   if h_Wnd = nil then Exit;
 135
 136   SDL_GL_MakeCurrent(h_Wnd, h_GL);
 137   SDL_ShowCursor(SDL_DISABLE);
 138
 139   Result := True;
 140 end;
 141
 142 procedure ReShowCursor();
 143 begin
 144   // TODO: what was this for?
 145 end;
 146
 147 function GetDisplayModes(dBPP: DWORD; var SelRes: DWORD): SArray;
 148 var
 149   mode: TSDL_DisplayMode;
 150   res, i, k, n, pw, ph: Integer;
 151 begin
 152   SetLength(Result, 0);
 153   {$IFDEF HEADLESS}Exit;{$ENDIF}
 154   k := 0; SelRes := 0;
 155   n := SDL_GetNumDisplayModes(0);
 156   pw := 0; ph := 0;
 157   for i := 0 to n do
 158   begin
 159     res := SDL_GetDisplayMode(0, i, @mode);
 160     if res < 0 then continue;
 161     if SDL_BITSPERPIXEL(mode.format) = gBPP then continue;
 162     if (mode.w = pw) and (mode.h = ph) then continue;
 163     if (mode.w = gScreenWidth) and (mode.h = gScreenHeight) then
 164       SelRes := k;
 165     Inc(k);
 166     SetLength(Result, k);
 167     Result[k-1] := IntToStr(mode.w) + 'x' + IntToStr(mode.h);
 168     pw := mode.w; ph := mode.h
 169   end;
 170
 171   e_WriteLog('SDL: Got ' + IntToStr(k) + ' resolutions.', MSG_NOTIFY);
 172 end;
 173
 174 procedure Sleep(ms: LongWord);
 175 begin
 176   SDL_Delay(ms);
 177 end;
 178
 179 procedure ChangeWindowSize();
 180 begin
 181   gWinSizeX := gScreenWidth;
 182   gWinSizeY := gScreenHeight;
 183   {$IFDEF HEADLESS}Exit;{$ENDIF}
 184   e_ResizeWindow(gScreenWidth, gScreenHeight);
 185   g_Game_SetupScreenSize();
 186   g_Menu_Reset();
 187   g_Game_ClearLoading();
 188 end;
 189
 190 function g_Window_SetSize(W, H: Word; FScreen: Boolean): Boolean;
 191 var
 192   Preserve: Boolean;
 193 begin
 194   Result := False;
 195   {$IFDEF HEADLESS}Exit;{$ENDIF}
 196   Preserve := False;
 197
 198   if (gScreenWidth <> W) or (gScreenHeight <> H) then
 199   begin
 200     Result := True;
 201     gScreenWidth := W;
 202     gScreenHeight := H;
 203   end;
 204
 205   if gFullscreen <> FScreen then
 206   begin
 207     Result := True;
 208     gFullscreen := FScreen;
 209     Preserve := True;
 210   end;
 211
 212   if Result then
 213   begin
 214     g_Window_SetDisplay(Preserve);
 215     ChangeWindowSize();
 216   end;
 217 end;
 218
 219 function WindowEventHandler(ev: TSDL_WindowEvent): Boolean;
 220 var
 221   wActivate, wDeactivate: Boolean;
 222 begin
 223   Result := False;
 224   wActivate := False;
 225   wDeactivate := False;
 226
 227   case ev.event of
 228     SDL_WINDOWEVENT_MOVED:
 229     begin
 230       if not (gFullscreen or gWinMaximized) then
 231       begin
 232         gWinRealPosX := ev.data1;
 233         gWinRealPosY := ev.data2;
 234       end;
 235     end;
 236
 237     SDL_WINDOWEVENT_MINIMIZED:
 238     begin
 239       if not wMinimized then
 240       begin
 241         e_ResizeWindow(0, 0);
 242         wMinimized := True;
 243
 244         if g_debug_WinMsgs then
 245         begin
 246           g_Console_Add('Now minimized');
 247           e_WriteLog('[DEBUG] WinMsgs: Now minimized', MSG_NOTIFY);
 248         end;
 249         wDeactivate := True;
 250       end;
 251     end;
 252
 253     SDL_WINDOWEVENT_RESIZED:
 254     begin
 255       gScreenWidth := ev.data1;
 256       gScreenHeight := ev.data2;
 257       ChangeWindowSize();
 258       SwapBuffers();
 259       if g_debug_WinMsgs then
 260       begin
 261         g_Console_Add('Resized to ' + IntToStr(ev.data1) + 'x' + IntToStr(ev.data2));
 262         e_WriteLog('[DEBUG] WinMsgs: Resized to ' + IntToStr(ev.data1) + 'x' + IntToStr(ev.data2), MSG_NOTIFY);
 263       end;
 264     end;
 265
 266     SDL_WINDOWEVENT_EXPOSED:
 267       SwapBuffers();
 268
 269     SDL_WINDOWEVENT_MAXIMIZED:
 270     begin
 271       if wMinimized then
 272       begin
 273         e_ResizeWindow(gScreenWidth, gScreenHeight);
 274         wMinimized := False;
 275         wActivate := True;
 276       end;
 277       if not gWinMaximized then
 278       begin
 279         gWinMaximized := True;
 280         if g_debug_WinMsgs then
 281         begin
 282           g_Console_Add('Now maximized');
 283           e_WriteLog('[DEBUG] WinMsgs: Now maximized', MSG_NOTIFY);
 284         end;
 285       end;
 286     end;
 287
 288     SDL_WINDOWEVENT_RESTORED:
 289     begin
 290       if wMinimized then
 291       begin
 292         e_ResizeWindow(gScreenWidth, gScreenHeight);
 293         wMinimized := False;
 294         wActivate := True;
 295       end;
 296       if gWinMaximized then
 297         gWinMaximized := False;
 298       if g_debug_WinMsgs then
 299       begin
 300         g_Console_Add('Now restored');
 301         e_WriteLog('[DEBUG] WinMsgs: Now restored', MSG_NOTIFY);
 302       end;
 303     end;
 304
 305     SDL_WINDOWEVENT_FOCUS_GAINED:
 306     begin
 307       wActivate := True;
 308       //e_WriteLog('window gained focus!', MSG_NOTIFY);
 309     end;
 310
 311     SDL_WINDOWEVENT_FOCUS_LOST:
 312     begin
 313       wDeactivate := True;
 314       //e_WriteLog('window lost focus!', MSG_NOTIFY);
 315     end;
 316   end;
 317
 318   if wDeactivate then
 319   begin
 320     if gWinActive then
 321     begin
 322       e_WriteLog('deactivating window', MSG_NOTIFY);
 323       e_EnableInput := False;
 324       e_ClearInputBuffer();
 325
 326       if gMuteWhenInactive then
 327       begin
 328         //e_WriteLog('deactivating sounds', MSG_NOTIFY);
 329         e_MuteChannels(True);
 330       end;
 331
 332       if g_debug_WinMsgs then
 333       begin
 334         g_Console_Add('Now inactive');
 335         e_WriteLog('[DEBUG] WinMsgs: Now inactive', MSG_NOTIFY);
 336       end;
 337
 338       gWinActive := False;
 339     end;
 340   end
 341   else if wActivate then
 342   begin
 343     if not gWinActive then
 344     begin
 345       //e_WriteLog('activating window', MSG_NOTIFY);
 346       e_EnableInput := True;
 347
 348       if gMuteWhenInactive then
 349       begin
 350         //e_WriteLog('activating sounds', MSG_NOTIFY);
 351         e_MuteChannels(False);
 352       end;
 353
 354       if g_debug_WinMsgs then
 355       begin
 356         g_Console_Add('Now active');
 357         e_WriteLog('[DEBUG] WinMsgs: Now active', MSG_NOTIFY);
 358       end;
 359
 360       gWinActive := True;
 361     end;
 362   end;
 363 end;
 364
 365 function EventHandler(ev: TSDL_Event): Boolean;
 366 var
 367   key, keychr: Word;
 368   uc: UnicodeChar;
 369   //joy: Integer;
 370 begin
 371   Result := False;
 372   case ev.type_ of
 373     SDL_WINDOWEVENT:
 374       Result := WindowEventHandler(ev.window);
 375
 376     SDL_QUITEV:
 377     begin
 378       if gExit <> EXIT_QUIT then
 379       begin
 380         if not wLoadingProgress then
 381         begin
 382           g_Game_Free();
 383           g_Game_Quit();
 384         end
 385         else
 386           wLoadingQuit := True;
 387       end;
 388       Result := True;
 389     end;
 390
 391     SDL_KEYDOWN:
 392     begin
 393       key := ev.key.keysym.scancode;
 394       KeyPress(key);
 395     end;
 396
 397     SDL_TEXTINPUT:
 398     begin
 399       Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
 400       keychr := Word(uc);
 401       if (keychr > 127) then
 402         keychr := WCharToCP1251(keychr);
 403       CharPress(Chr(keychr));
 404     end;
 405
 406     // other key presses and joysticks are handled in e_input
 407   end;
 408 end;
 409
 410 procedure SwapBuffers();
 411 begin
 412   {$IFDEF HEADLESS}Exit;{$ENDIF}
 413   SDL_GL_SwapWindow(h_Wnd);
 414 end;
 415
 416 procedure KillGLWindow();
 417 begin
 418   if h_Wnd <> nil then SDL_DestroyWindow(h_Wnd);
 419   if h_GL <> nil then SDL_GL_DeleteContext(h_GL);
 420   h_Wnd := nil;
 421   h_GL := nil;
 422   //wWindowCreated := False;
 423 end;
 424
 425 function CreateGLWindow(Title: PChar): Boolean;
 426 //var
 427 //  flags: LongWord;
 428 begin
 429   Result := False;
 430
 431   gWinSizeX := gScreenWidth;
 432   gWinSizeY := gScreenHeight;
 433
 434   wTitle := Title;
 435   e_WriteLog('Creating window', MSG_NOTIFY);
 436
 437   if not g_Window_SetDisplay() then
 438   begin
 439     KillGLWindow();
 440     e_WriteLog('Window creation error (resolution not supported?)', MSG_FATALERROR);
 441     exit;
 442   end;
 443
 444 {$IFNDEF HEADLESS}
 445   h_Gl := SDL_GL_CreateContext(h_Wnd);
 446   if h_Gl = nil then Exit;
 447 {$ENDIF}
 448   //wWindowCreated := True;
 449
 450   e_ResizeWindow(gScreenWidth, gScreenHeight);
 451   e_InitGL();
 452
 453   Result := True;
 454 end;
 455
 456 {$IFDEF WINDOWS}
 457 // windoze sux; in headless mode `GetTickCount()` (and SDL) returns shit
 458 function GetTimer(): Int64;
 459 var
 460   F, C: Int64;
 461 begin
 462   QueryPerformanceFrequency(F);
 463   QueryPerformanceCounter(C);
 464   Result := Round(C/F*1000{000});
 465 end;
 466 {$ELSE}
 467 function GetTimer(): Int64;
 468 var
 469   t: Uint32;
 470   tt: Int64;
 471 begin
 472   t := SDL_GetTicks() {* 1000}; // TODO: do we really need microseconds here? k8: NOPE!
 473   if ticksOverflow = -1 then
 474   begin
 475     ticksOverflow := 0;
 476     lastTicks := t;
 477   end
 478   else
 479   begin
 480     if lastTicks > t then
 481     begin
 482       // overflow, increment overflow ;-)
 483       ticksOverflow := ticksOverflow+(Int64($ffffffff)+Int64(1));
 484       tt := (Int64($ffffffff)+Int64(1))+Int64(t);
 485       t := Uint32(tt-lastTicks);
 486     end;
 487   end;
 488   lastTicks := t;
 489   result := ticksOverflow+Int64(t);
 490 end;
 491 {$ENDIF}
 492
 493 procedure ResetTimer();
 494 begin
 495   wNeedTimeReset := True;
 496 end;
 497
 498 procedure PushExitEvent();
 499 var
 500   ev: TSDL_Event;
 501 begin
 502   ev.type_ := SDL_QUITEV;
 503   SDL_PushEvent(@ev);
 504 end;
 505
 506 procedure ProcessLoading();
 507 var
 508   ev: TSDL_Event;
 509   ID: DWORD;
 510 begin
 511   FillChar(ev, SizeOf(ev), 0);
 512   //wNeedFree := False;
 513   wLoadingProgress := True;
 514   while SDL_PollEvent(@ev) > 0 do
 515   begin
 516     if (ev.type_ = SDL_QUITEV) then
 517       break;
 518   end;
 519   //wNeedFree := True;
 520
 521   if (ev.type_ = SDL_QUITEV) or (gExit = EXIT_QUIT) then
 522   begin
 523     wLoadingProgress := False;
 524     exit;
 525   end;
 526
 527   if not wMinimized then
 528   begin
 529     if g_Texture_Get('INTER', ID) then
 530       e_DrawSize(ID, 0, 0, 0, False, False, gScreenWidth, gScreenHeight)
 531     else
 532       e_Clear(GL_COLOR_BUFFER_BIT, 0, 0, 0);
 533
 534     DrawLoadingStat();
 535     SwapBuffers();
 536
 537     ReShowCursor();
 538   end;
 539
 540   e_SoundUpdate();
 541
 542   if NetMode = NET_SERVER then
 543     g_Net_Host_Update
 544   else
 545     if (NetMode = NET_CLIENT) and (NetState <> NET_STATE_AUTH) then
 546       g_Net_Client_UpdateWhileLoading;
 547   wLoadingProgress := False;
 548 end;
 549
 550 function ProcessMessage(): Boolean;
 551 var
 552   i, t: Integer;
 553   ev: TSDL_Event;
 554 begin
 555   Result := False;
 556   FillChar(ev, SizeOf(ev), 0);
 557
 558   while SDL_PollEvent(@ev) > 0 do
 559   begin
 560     Result := EventHandler(ev);
 561     if ev.type_ = SDL_QUITEV then exit;
 562   end;
 563
 564   Time := GetTimer();
 565   Time_Delta := Time - Time_Old;
 566
 567   flag := False;
 568
 569   if wNeedTimeReset then
 570   begin
 571     Time_Delta := 28{(27777 div 1000)};
 572     wNeedTimeReset := False;
 573   end;
 574
 575   t := Time_Delta div 28{(27777 div 1000)};
 576   if t > 0 then
 577   begin
 578     flag := True;
 579     for i := 1 to t do
 580     begin
 581       if NetMode = NET_SERVER then g_Net_Host_Update()
 582       else if NetMode = NET_CLIENT then g_Net_Client_Update();
 583       Update();
 584     end;
 585   end
 586   else
 587   begin
 588     if NetMode = NET_SERVER then g_Net_Host_Update()
 589     else if NetMode = NET_CLIENT then g_Net_Client_Update();
 590   end;
 591
 592   if wLoadingQuit then
 593   begin
 594     g_Game_Free();
 595     g_Game_Quit();
 596   end;
 597
 598   if gExit = EXIT_QUIT then
 599   begin
 600     Result := True;
 601     Exit;
 602   end;
 603
 604 // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ:
 605   if flag then
 606   begin
 607     Time_Old := Time - (Time_Delta mod 28{(27777 div 1000)});
 608     if (not wMinimized) then
 609     begin
 610       Draw();
 611       SwapBuffers();
 612       ReShowCursor();
 613     end;
 614   end
 615   else
 616     Sleep(1);
 617
 618   e_SoundUpdate();
 619 end;
 620
 621 procedure ReDrawWindow;
 622 begin
 623   SwapBuffers();
 624   ReShowCursor();
 625 end;
 626
 627 procedure InitOpenGL(VSync: Boolean);
 628 var
 629   v: Byte;
 630 begin
 631   {$IFDEF HEADLESS}Exit;{$ENDIF}
 632   if VSync then v := 1 else v := 0;
 633   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
 634   SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
 635   SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
 636   SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
 637   SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
 638   SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
 639   SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
 640   SDL_GL_SetSwapInterval(v);
 641 end;
 642
 643 function SDLMain(): Integer;
 644 begin
 645 {$IFDEF HEADLESS}
 646   e_NoGraphics := True;
 647 {$ENDIF}
 648
 649   e_WriteLog('Creating GL window', MSG_NOTIFY);
 650   if not CreateGLWindow(PChar(Format('Doom 2D: Forever %s', [GAME_VERSION]))) then
 651   begin
 652     Result := 0;
 653     exit;
 654   end;
 655
 656   e_WriteLog('Initializing OpenGL', MSG_NOTIFY);
 657   InitOpenGL(gVSync);
 658
 659   {EnumDisplayModes();}
 660
 661   Init();
 662   Time_Old := GetTimer();
 663
 664 // Êîìàíäíàÿ ñòðîêà:
 665   if ParamCount > 0 then
 666     g_Game_Process_Params();
 667
 668 // Çàïðîñ ÿçûêà:
 669   if (not gGameOn) and gAskLanguage then
 670     g_Menu_AskLanguage();
 671
 672   e_WriteLog('Entering the main loop', MSG_NOTIFY);
 673
 674   while not ProcessMessage() do
 675     { Main Loop } ;
 676
 677   Release();
 678   KillGLWindow();
 679
 680   Result := 0;
 681 end;
 682
 683 end.