DEADSOFTWARE

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