DEADSOFTWARE

FreeBSD build fixes
[d2df-sdl.git] / 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;
19 interface
21 uses
22 wadreader;
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;
39 implementation
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;
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}
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 );
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;
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}
100 Result := False;
102 e_WriteLog('Setting display mode...', MSG_NOTIFY);
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;
108 if h_Wnd <> nil then
109 begin
110 SDL_DestroyWindow(h_Wnd);
111 h_Wnd := nil;
112 end;
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;
133 h_Wnd := SDL_CreateWindow(PChar(wTitle), gWinRealPosX, gWinRealPosY, gScreenWidth, gScreenHeight, wFlags);
134 if h_Wnd = nil then Exit;
136 SDL_GL_MakeCurrent(h_Wnd, h_GL);
137 SDL_ShowCursor(SDL_DISABLE);
139 Result := True;
140 end;
142 procedure ReShowCursor();
143 begin
144 // TODO: what was this for?
145 end;
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;
171 e_WriteLog('SDL: Got ' + IntToStr(k) + ' resolutions.', MSG_NOTIFY);
172 end;
174 procedure Sleep(ms: LongWord);
175 begin
176 SDL_Delay(ms);
177 end;
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;
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;
198 if (gScreenWidth <> W) or (gScreenHeight <> H) then
199 begin
200 Result := True;
201 gScreenWidth := W;
202 gScreenHeight := H;
203 end;
205 if gFullscreen <> FScreen then
206 begin
207 Result := True;
208 gFullscreen := FScreen;
209 Preserve := True;
210 end;
212 if Result then
213 begin
214 g_Window_SetDisplay(Preserve);
215 ChangeWindowSize();
216 end;
217 end;
219 function WindowEventHandler(ev: TSDL_WindowEvent): Boolean;
220 var
221 wActivate, wDeactivate: Boolean;
222 begin
223 Result := False;
224 wActivate := False;
225 wDeactivate := False;
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;
237 SDL_WINDOWEVENT_MINIMIZED:
238 begin
239 if not wMinimized then
240 begin
241 e_ResizeWindow(0, 0);
242 wMinimized := True;
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;
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;
266 SDL_WINDOWEVENT_EXPOSED:
267 SwapBuffers();
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;
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;
305 SDL_WINDOWEVENT_FOCUS_GAINED:
306 begin
307 wActivate := True;
308 //e_WriteLog('window gained focus!', MSG_NOTIFY);
309 end;
311 SDL_WINDOWEVENT_FOCUS_LOST:
312 begin
313 wDeactivate := True;
314 //e_WriteLog('window lost focus!', MSG_NOTIFY);
315 end;
316 end;
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();
326 if gMuteWhenInactive then
327 begin
328 //e_WriteLog('deactivating sounds', MSG_NOTIFY);
329 e_MuteChannels(True);
330 end;
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;
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;
348 if gMuteWhenInactive then
349 begin
350 //e_WriteLog('activating sounds', MSG_NOTIFY);
351 e_MuteChannels(False);
352 end;
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;
360 gWinActive := True;
361 end;
362 end;
363 end;
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);
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;
391 SDL_KEYDOWN:
392 begin
393 key := ev.key.keysym.scancode;
394 KeyPress(key);
395 end;
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;
406 // other key presses and joysticks are handled in e_input
407 end;
408 end;
410 procedure SwapBuffers();
411 begin
412 {$IFDEF HEADLESS}Exit;{$ENDIF}
413 SDL_GL_SwapWindow(h_Wnd);
414 end;
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;
425 function CreateGLWindow(Title: PChar): Boolean;
426 //var
427 // flags: LongWord;
428 begin
429 Result := False;
431 gWinSizeX := gScreenWidth;
432 gWinSizeY := gScreenHeight;
434 wTitle := Title;
435 e_WriteLog('Creating window', MSG_NOTIFY);
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;
444 {$IFNDEF HEADLESS}
445 h_Gl := SDL_GL_CreateContext(h_Wnd);
446 if h_Gl = nil then Exit;
447 {$ENDIF}
448 //wWindowCreated := True;
450 e_ResizeWindow(gScreenWidth, gScreenHeight);
451 e_InitGL();
453 Result := True;
454 end;
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}
493 procedure ResetTimer();
494 begin
495 wNeedTimeReset := True;
496 end;
498 procedure PushExitEvent();
499 var
500 ev: TSDL_Event;
501 begin
502 ev.type_ := SDL_QUITEV;
503 SDL_PushEvent(@ev);
504 end;
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;
521 if (ev.type_ = SDL_QUITEV) or (gExit = EXIT_QUIT) then
522 begin
523 wLoadingProgress := False;
524 exit;
525 end;
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);
534 DrawLoadingStat();
535 SwapBuffers();
537 ReShowCursor();
538 end;
540 e_SoundUpdate();
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;
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);
558 while SDL_PollEvent(@ev) > 0 do
559 begin
560 Result := EventHandler(ev);
561 if ev.type_ = SDL_QUITEV then exit;
562 end;
564 Time := GetTimer();
565 Time_Delta := Time - Time_Old;
567 flag := False;
569 if wNeedTimeReset then
570 begin
571 Time_Delta := 28{(27777 div 1000)};
572 wNeedTimeReset := False;
573 end;
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;
592 if wLoadingQuit then
593 begin
594 g_Game_Free();
595 g_Game_Quit();
596 end;
598 if gExit = EXIT_QUIT then
599 begin
600 Result := True;
601 Exit;
602 end;
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);
618 e_SoundUpdate();
619 end;
621 procedure ReDrawWindow;
622 begin
623 SwapBuffers();
624 ReShowCursor();
625 end;
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;
643 function SDLMain(): Integer;
644 begin
645 {$IFDEF HEADLESS}
646 e_NoGraphics := True;
647 {$ENDIF}
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;
656 e_WriteLog('Initializing OpenGL', MSG_NOTIFY);
657 InitOpenGL(gVSync);
659 {EnumDisplayModes();}
661 Init();
662 Time_Old := GetTimer();
664 // Êîìàíäíàÿ ñòðîêà:
665 if ParamCount > 0 then
666 g_Game_Process_Params();
668 // Çàïðîñ ÿçûêà:
669 if (not gGameOn) and gAskLanguage then
670 g_Menu_AskLanguage();
672 e_WriteLog('Entering the main loop', MSG_NOTIFY);
674 while not ProcessMessage() do
675 { Main Loop } ;
677 Release();
678 KillGLWindow();
680 Result := 0;
681 end;
683 end.