src/game/g_window.pas

   1 unit g_window;
   2
   3 interface
   4
   5 uses
   6   WADEDITOR;
   7
   8 function  SDLMain(): Integer;
   9 function  GetTimer(): Int64;
  10 procedure ResetTimer();
  11 function  CreateGLWindow(Title: PChar): Boolean;
  12 procedure KillGLWindow();
  13 procedure PushExitEvent();
  14 function  ProcessMessage(): Boolean;
  15 procedure ProcessLoading();
  16 procedure ReDrawWindow();
  17 procedure SwapBuffers();
  18 procedure Sleep(ms: LongWord);
  19 function  GetDisplayModes(dBPP: DWORD; var SelRes: DWORD): SArray;
  20 function  g_Window_SetDisplay(PreserveGL: Boolean = False): Boolean;
  21 function  g_Window_SetSize(W, H: Word; FScreen: Boolean): Boolean;
  22
  23 implementation
  24
  25 uses
  26   SDL, GL, GLExt, e_graphics, e_log, g_main,
  27   g_console, SysUtils, e_input, g_options, g_game,
  28   g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net;
  29
  30 var
  31   h_Wnd: PSDL_Surface;
  32   wFlags: LongWord = 0;
  33   Time, Time_Delta, Time_Old: Int64;
  34   flag: Boolean;
  35   wNeedTimeReset: Boolean = False;
  36   wWindowCreated: Boolean = False;
  37   //wCursorShown: Boolean = False;
  38   wMinimized: Boolean = False;
  39   //wNeedFree: Boolean = True;
  40   wLoadingProgress: Boolean = False;
  41   wLoadingQuit: Boolean = False;
  42   {wWinPause: Byte = 0;}
  43
  44 const
  45   // TODO: move this to a separate file
  46   CP1251: array [0..127] of Word = (
  47     $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
  48     $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
  49     $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
  50     $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
  51     $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
  52     $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
  53     $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
  54     $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
  55   );
  56
  57 // TODO: make a transition table or something
  58 function WCharToCP1251(wc: Word): Word;
  59 var
  60   n: Word;
  61 begin
  62   Result := 0;
  63   for n := 0 to 127 do
  64     if CP1251[n] = wc then begin Result := n; break end;
  65   Result := Result + 128;
  66 end;
  67
  68 function g_Window_SetDisplay(PreserveGL: Boolean = False): Boolean;
  69 begin
  70   Result := False;
  71
  72   e_WriteLog('Setting display mode...', MSG_NOTIFY);
  73
  74   if wWindowCreated and PreserveGL then
  75     e_SaveGLContext(); // we need this and restore because of a bug in SDL1.2, apparently
  76
  77   wFlags := SDL_RESIZABLE or SDL_OPENGL;
  78   if gFullscreen then wFlags := wFlags or SDL_FULLSCREEN;
  79
  80   h_Wnd := SDL_SetVideoMode(gScreenWidth, gScreenHeight, gBPP, wFlags);
  81   SDL_EnableUNICODE(SDL_ENABLE);
  82   SDL_EnableKeyRepeat(SDL_DEFAULT_REPEAT_DELAY, SDL_DEFAULT_REPEAT_INTERVAL);
  83   SDL_ShowCursor(SDL_DISABLE);
  84
  85   if wWindowCreated and PreserveGL then
  86     e_RestoreGLContext();
  87
  88   Result := h_Wnd <> nil;
  89 end;
  90
  91 procedure ReShowCursor();
  92 begin
  93   // TODO: what was this for?
  94 end;
  95
  96 function GetDisplayModes(dBPP: DWORD; var SelRes: DWORD): SArray;
  97 var
  98   modesp: PPSDL_Rect;
  99   tmpp: PSDL_Rect;
 100   tmpr: SDL_Rect;
 101   i: Integer;
 102 begin
 103   SetLength(Result, 0);
 104   modesp := SDL_ListModes(nil, SDL_FULLSCREEN or SDL_HWSURFACE);
 105   if modesp = nil then exit;
 106   if Pointer(-1) = modesp then exit;
 107
 108   tmpp := modesp^;
 109   i := 0;
 110   while tmpp <> nil do
 111   begin
 112     tmpr := tmpp^;
 113     if (tmpr.w = gScreenWidth) and (tmpr.h = gScreenHeight) then
 114       SelRes := i;
 115     SetLength(Result, Length(Result) + 1);
 116     Result[i] := IntToStr(tmpr.w) + 'x' + IntToStr(tmpr.h);
 117
 118     modesp := Pointer(Cardinal(modesp) + SizeOf(PSDL_Rect));
 119     tmpp := modesp^;
 120     Inc(i);
 121   end;
 122
 123   e_WriteLog('SDL: Got ' + IntToStr(Length(Result)) + ' resolutions.', MSG_NOTIFY);
 124 end;
 125
 126 procedure Sleep(ms: LongWord);
 127 begin
 128   SDL_Delay(ms);
 129 end;
 130
 131 procedure ChangeWindowSize();
 132 begin
 133   gWinSizeX := gScreenWidth;
 134   gWinSizeY := gScreenHeight;
 135   e_ResizeWindow(gScreenWidth, gScreenHeight);
 136   g_Game_SetupScreenSize();
 137   g_Menu_Reset();
 138   g_Game_ClearLoading();
 139 end;
 140
 141 function g_Window_SetSize(W, H: Word; FScreen: Boolean): Boolean;
 142 var
 143   Preserve: Boolean;
 144 begin
 145   Result := False;
 146   Preserve := False;
 147
 148   if (gScreenWidth <> W) or (gScreenHeight <> H) then
 149   begin
 150     Result := True;
 151     gScreenWidth := W;
 152     gScreenHeight := H;
 153   end;
 154
 155   if gFullscreen <> FScreen then
 156   begin
 157     Result := True;
 158     gFullscreen := FScreen;
 159     Preserve := True;
 160   end;
 161
 162   if Result then
 163   begin
 164     g_Window_SetDisplay(Preserve);
 165     ChangeWindowSize();
 166   end;
 167 end;
 168
 169 function EventHandler(ev: TSDL_Event): Boolean;
 170 var
 171   key, keychr: Word;
 172   //joy: Integer;
 173 begin
 174   Result := False;
 175   case ev.type_ of
 176     SDL_VIDEORESIZE:
 177     begin
 178       g_Window_SetSize(ev.resize.w, ev.resize.h, gFullscreen);
 179       e_Clear();
 180     end;
 181
 182     SDL_ACTIVEEVENT:
 183     begin
 184       if (ev.active.gain = 0) then
 185       begin
 186         if g_debug_WinMsgs then
 187         begin
 188           g_Console_Add('Inactive');
 189           e_WriteLog('[DEBUG] WinMsgs: Inactive', MSG_NOTIFY);
 190         end;
 191
 192         if LongBool(ev.active.state and SDL_APPINPUTFOCUS) and gWinActive then
 193         begin
 194           e_EnableInput := False;
 195           e_ClearInputBuffer();
 196
 197           if gMuteWhenInactive then
 198             e_MuteChannels(True);
 199
 200           if g_debug_WinMsgs then
 201           begin
 202             g_Console_Add('Inactive indeed');
 203             e_WriteLog('[DEBUG] WinMsgs: Inactive indeed', MSG_NOTIFY);
 204           end;
 205
 206           gWinActive := False;
 207         end;
 208
 209         if LongBool(ev.active.state and SDL_APPACTIVE) and (not wMinimized) then
 210         begin
 211           e_ResizeWindow(0, 0);
 212           wMinimized := True;
 213
 214           if g_debug_WinMsgs then
 215           begin
 216             g_Console_Add('Minimized indeed');
 217             e_WriteLog('[DEBUG] WinMsgs: Minimized indeed', MSG_NOTIFY);
 218           end;
 219         end;
 220       end
 221       else
 222       begin
 223         if g_debug_WinMsgs then
 224         begin
 225           g_Console_Add('Active');
 226           e_WriteLog('[DEBUG] WinMsgs: Active', MSG_NOTIFY);
 227         end;
 228
 229         // Åñëè îêíî áûëî íåàêòèâíûì:
 230         if LongBool(ev.active.state and SDL_APPINPUTFOCUS) and (not gWinActive) then
 231         begin
 232           e_EnableInput := True;
 233
 234           if gMuteWhenInactive then
 235             e_MuteChannels(False);
 236
 237           if g_debug_WinMsgs then
 238           begin
 239             g_Console_Add('Active indeed');
 240             e_WriteLog('[DEBUG] WinMsgs: Active indeed', MSG_NOTIFY);
 241           end;
 242
 243           gWinActive := True;
 244         end;
 245
 246         if LongBool(ev.active.state and SDL_APPACTIVE) and wMinimized then
 247         begin
 248           e_ResizeWindow(gScreenWidth, gScreenHeight);
 249
 250           wMinimized := False;
 251
 252           if g_debug_WinMsgs then
 253           begin
 254             g_Console_Add('Restored indeed');
 255             e_WriteLog('[DEBUG] WinMsgs: Restored indeed', MSG_NOTIFY);
 256           end;
 257         end;
 258       end;
 259     end;
 260
 261     SDL_VIDEOEXPOSE:
 262     begin
 263       // TODO: the fuck is this event?
 264       // Draw();
 265     end;
 266
 267     SDL_QUITEV:
 268     begin
 269       if gExit <> EXIT_QUIT then
 270       begin
 271         if not wLoadingProgress then
 272         begin
 273           g_Game_Free();
 274           g_Game_Quit();
 275         end
 276         else
 277           wLoadingQuit := True;
 278       end;
 279       Result := True;
 280     end;
 281
 282     SDL_KEYDOWN:
 283     begin
 284       key := ev.key.keysym.sym;
 285       keychr := ev.key.keysym.unicode;
 286       KeyPress(key);
 287       if (keychr > 7) and (key <> IK_BACKSPACE) then
 288       begin
 289         if (keychr >= 128) then
 290           keychr := WCharToCP1251(keychr);
 291         CharPress(Chr(keychr));
 292       end;
 293     end;
 294
 295     // key presses and joysticks are handled in e_input
 296   end;
 297 end;
 298
 299 procedure SwapBuffers();
 300 begin
 301   SDL_GL_SwapBuffers();
 302 end;
 303
 304 procedure KillGLWindow();
 305 begin
 306   wWindowCreated := False;
 307 end;
 308
 309 function CreateGLWindow(Title: PChar): Boolean;
 310 //var
 311 //  flags: LongWord;
 312 begin
 313   Result := False;
 314
 315   gWinSizeX := gScreenWidth;
 316   gWinSizeY := gScreenHeight;
 317
 318   e_WriteLog('Creating window', MSG_NOTIFY);
 319
 320   if not g_Window_SetDisplay() then
 321   begin
 322     KillGLWindow();
 323     e_WriteLog('Window creation error (resolution not supported?)', MSG_FATALERROR);
 324     exit;
 325   end;
 326
 327   SDL_WM_SetCaption(Title, Title);
 328   wWindowCreated := True;
 329
 330   e_ResizeWindow(gScreenWidth, gScreenHeight);
 331   e_InitGL();
 332
 333   Result := True;
 334 end;
 335
 336 function GetTimer(): Int64;
 337 begin
 338   Result := SDL_GetTicks() * 1000; // TODO: do we really need microseconds here?
 339 end;
 340
 341 procedure ResetTimer();
 342 begin
 343   wNeedTimeReset := True;
 344 end;
 345
 346 procedure PushExitEvent();
 347 var
 348   ev: TSDL_Event;
 349 begin
 350   ev.type_ := SDL_QUITEV;
 351   SDL_PushEvent(@ev);
 352 end;
 353
 354 procedure ProcessLoading();
 355 var
 356   ev: TSDL_Event;
 357   ID: DWORD;
 358 begin
 359   FillChar(ev, SizeOf(ev), 0);
 360   //wNeedFree := False;
 361   wLoadingProgress := True;
 362   while SDL_PollEvent(@ev) > 0 do
 363   begin
 364     if (ev.type_ = SDL_QUITEV) then
 365       break;
 366   end;
 367   //wNeedFree := True;
 368
 369   if (ev.type_ = SDL_QUITEV) or (gExit = EXIT_QUIT) then
 370   begin
 371     wLoadingProgress := False;
 372     exit;
 373   end;
 374
 375   if not wMinimized then
 376   begin
 377     if g_Texture_Get('INTER', ID) then
 378       e_DrawSize(ID, 0, 0, 0, False, False, gScreenWidth, gScreenHeight)
 379     else
 380       e_Clear(GL_COLOR_BUFFER_BIT, 0, 0, 0);
 381
 382     DrawLoadingStat();
 383     SwapBuffers();
 384
 385     ReShowCursor();
 386   end;
 387
 388   e_SoundUpdate();
 389
 390   if NetMode = NET_SERVER then
 391     g_Net_Host_Update
 392   else
 393     if (NetMode = NET_CLIENT) and (NetState <> NET_STATE_AUTH) then
 394       g_Net_Client_UpdateWhileLoading;
 395   wLoadingProgress := False;
 396 end;
 397
 398 function ProcessMessage(): Boolean;
 399 var
 400   i, t: Integer;
 401   ev: TSDL_Event;
 402 begin
 403   Result := False;
 404   FillChar(ev, SizeOf(ev), 0);
 405
 406   while SDL_PollEvent(@ev) > 0 do
 407   begin
 408     Result := EventHandler(ev);
 409     if ev.type_ = SDL_QUITEV then exit;
 410   end;
 411
 412   Time := GetTimer();
 413   Time_Delta := Time - Time_Old;
 414
 415   flag := False;
 416
 417   if wNeedTimeReset then
 418   begin
 419     Time_Delta := 27777;
 420     wNeedTimeReset := False;
 421   end;
 422
 423   t := Time_Delta div 27777;
 424   if t > 0 then
 425   begin
 426     flag := True;
 427     for i := 1 to t do
 428     begin
 429       if NetMode = NET_SERVER then g_Net_Host_Update()
 430       else if NetMode = NET_CLIENT then g_Net_Client_Update();
 431       Update();
 432     end;
 433   end
 434   else
 435   begin
 436     if NetMode = NET_SERVER then g_Net_Host_Update()
 437     else if NetMode = NET_CLIENT then g_Net_Client_Update();
 438   end;
 439
 440   if wLoadingQuit then
 441   begin
 442     g_Game_Free();
 443     g_Game_Quit();
 444   end;
 445
 446   if gExit = EXIT_QUIT then
 447   begin
 448     Result := True;
 449     Exit;
 450   end;
 451
 452 // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ:
 453   if flag then
 454   begin
 455     Time_Old := Time - (Time_Delta mod 27777);
 456     if (not wMinimized) then
 457     begin
 458       Draw();
 459       SwapBuffers();
 460       ReShowCursor();
 461     end;
 462   end
 463   else
 464     Sleep(1);
 465
 466   e_SoundUpdate();
 467 end;
 468
 469 procedure ReDrawWindow;
 470 begin
 471   SwapBuffers();
 472   ReShowCursor();
 473 end;
 474
 475 procedure InitOpenGL(VSync: Boolean);
 476 var
 477   v: Byte;
 478 begin
 479   if VSync then v := 1 else v := 0;
 480   SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
 481   SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
 482   SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
 483   SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
 484   SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
 485   SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, v);
 486 end;
 487
 488 function SDLMain(): Integer;
 489 begin
 490   e_WriteLog('Creating GL window', MSG_NOTIFY);
 491   if not CreateGLWindow(PChar(Format('Doom 2D: Forever %s', [GAME_VERSION]))) then
 492   begin
 493     Result := 0;
 494     exit;
 495   end;
 496
 497   e_WriteLog('Initializing OpenGL', MSG_NOTIFY);
 498   InitOpenGL(gVSync);
 499
 500   {EnumDisplayModes();}
 501
 502   Init();
 503   Time_Old := GetTimer();
 504
 505 // Êîìàíäíàÿ ñòðîêà:
 506   if ParamCount > 0 then
 507     g_Game_Process_Params();
 508
 509 // Çàïðîñ ÿçûêà:
 510   if (not gGameOn) and gAskLanguage then
 511     g_Menu_AskLanguage();
 512
 513   e_WriteLog('Entering the main loop', MSG_NOTIFY);
 514
 515   while not ProcessMessage() do
 516     { Main Loop } ;
 517
 518   Release();
 519   KillGLWindow();
 520
 521   Result := 0;
 522 end;
 523
 524 end.