1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
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 ReDrawWindow ();
32 procedure SwapBuffers ();
33 procedure Sleep (ms
: LongWord);
34 function GetDisplayModes (dbpp
: LongWord; var selres
: LongWord): SSArray
;
35 function g_Window_SetDisplay (preserveGL
: Boolean=false): Boolean;
36 function g_Window_SetSize (w
, h
: Word; fullscreen
: Boolean): Boolean;
38 procedure ProcessLoading (forceUpdate
: Boolean=false);
40 // returns `true` if quit event was received
41 function g_ProcessMessages (): Boolean;
45 gwin_dump_extensions
: Boolean = false;
46 gwin_has_stencil
: Boolean = false;
47 gwin_k8_enable_light_experiments
: Boolean = false;
48 g_dbg_aimline_on
: Boolean = false;
54 {$IFDEF WINDOWS}Windows
,{$ENDIF}
55 SysUtils
, Classes
, MAPDEF
,
56 SDL2
, GL
, GLExt
, e_graphics
, e_log
, e_texture
, g_main
,
57 g_console
, e_input
, g_options
, g_game
,
58 g_basic
, g_textures
, e_sound
, g_sound
, g_menu
, ENet
, g_net
,
59 g_map
, g_gfx
, g_monsters
, g_holmes
, xprofiler
,
64 ProgressUpdateMSecs
= 100;
67 h_Wnd
: PSDL_Window
= nil;
68 h_GL
: TSDL_GLContext
= nil;
69 Time
, Time_Delta
, Time_Old
: Int64;
71 {$IF not DEFINED(HEADLESS)}
74 wNeedTimeReset
: Boolean = false;
75 wMinimized
: Boolean = false;
76 wLoadingProgress
: Boolean = false;
77 wLoadingQuit
: Boolean = false;
79 ticksOverflow
: Int64 = -1;
80 lastTicks
: Uint32
= 0; // to detect overflow
84 procedure KillGLWindow ();
86 if (h_Wnd
<> nil) then
88 if assigned(oglDeinitCB
) then oglDeinitCB();
90 if (h_Wnd
<> nil) then SDL_DestroyWindow(h_Wnd
);
91 if (h_GL
<> nil) then SDL_GL_DeleteContext(h_GL
);
97 function g_Window_SetDisplay (preserveGL
: Boolean = false): Boolean;
98 {$IF not DEFINED(HEADLESS)}
100 mode
, cmode
: TSDL_DisplayMode
;
101 wFlags
: LongWord = 0;
104 {$IF not DEFINED(HEADLESS)}
107 e_WriteLog('Setting display mode...', TMsgType
.Notify
);
109 wFlags
:= SDL_WINDOW_OPENGL
or SDL_WINDOW_RESIZABLE
;
110 if gFullscreen
then wFlags
:= wFlags
or SDL_WINDOW_FULLSCREEN
;
111 if gWinMaximized
then wFlags
:= wFlags
or SDL_WINDOW_MAXIMIZED
;
117 mode
.w
:= gScreenWidth
;
118 mode
.h
:= gScreenHeight
;
120 mode
.refresh_rate
:= 0;
121 mode
.driverdata
:= nil;
122 if (SDL_GetClosestDisplayMode(0, @mode
, @cmode
) = nil) then
125 gScreenHeight
:= 600;
129 gScreenWidth
:= cmode
.w
;
130 gScreenHeight
:= cmode
.h
;
134 h_Wnd
:= SDL_CreateWindow(PChar(wTitle
), gWinRealPosX
, gWinRealPosY
, gScreenWidth
, gScreenHeight
, wFlags
);
135 if (h_Wnd
= nil) then exit
;
137 SDL_GL_MakeCurrent(h_Wnd
, h_GL
);
138 SDL_ShowCursor(SDL_DISABLE
);
139 if (h_GL
<> nil) then
141 if assigned(oglInitCB
) then oglInitCB();
149 function GetDisplayModes (dbpp
: LongWord; var selres
: LongWord): SSArray
;
151 mode
: TSDL_DisplayMode
;
152 res
, i
, k
, n
, pw
, ph
: Integer;
154 SetLength(result
, 0);
155 {$IFDEF HEADLESS}exit
;{$ENDIF}
157 n
:= SDL_GetNumDisplayModes(0);
161 res
:= SDL_GetDisplayMode(0, i
, @mode
);
162 if res
< 0 then continue
;
163 if SDL_BITSPERPIXEL(mode
.format
) = gBPP
then continue
;
164 if (mode
.w
= pw
) and (mode
.h
= ph
) then continue
;
165 if (mode
.w
= gScreenWidth
) and (mode
.h
= gScreenHeight
) then
168 SetLength(result
, k
);
169 result
[k
-1] := IntToStr(mode
.w
) + 'x' + IntToStr(mode
.h
);
170 pw
:= mode
.w
; ph
:= mode
.h
173 e_WriteLog('SDL: Got ' + IntToStr(k
) + ' resolutions.', TMsgType
.Notify
);
177 procedure Sleep (ms
: LongWord);
183 procedure ChangeWindowSize ();
185 gWinSizeX
:= gScreenWidth
;
186 gWinSizeY
:= gScreenHeight
;
187 {$IF not DEFINED(HEADLESS)}
188 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
189 g_Game_SetupScreenSize();
191 g_Game_ClearLoading();
196 function g_Window_SetSize (w
, h
: Word; fullscreen
: Boolean): Boolean;
197 {$IF not DEFINED(HEADLESS)}
203 {$IF not DEFINED(HEADLESS)}
206 if (gScreenWidth
<> w
) or (gScreenHeight
<> h
) then
213 if (gFullscreen
<> fullscreen
) then
216 gFullscreen
:= fullscreen
;
222 g_Window_SetDisplay(preserve
);
229 function WindowEventHandler (constref ev
: TSDL_WindowEvent
): Boolean;
231 wActivate
, wDeactivate
: Boolean;
235 wDeactivate
:= false;
238 SDL_WINDOWEVENT_MOVED
:
240 if not (gFullscreen
or gWinMaximized
) then
242 gWinRealPosX
:= ev
.data1
;
243 gWinRealPosY
:= ev
.data2
;
247 SDL_WINDOWEVENT_MINIMIZED
:
250 if not wMinimized
then
252 e_ResizeWindow(0, 0);
254 if g_debug_WinMsgs
then
256 g_Console_Add('Now minimized');
257 e_WriteLog('[DEBUG] WinMsgs: Now minimized', TMsgType
.Notify
);
263 SDL_WINDOWEVENT_RESIZED
:
265 gScreenWidth
:= ev
.data1
;
266 gScreenHeight
:= ev
.data2
;
269 if g_debug_WinMsgs
then
271 g_Console_Add('Resized to ' + IntToStr(ev
.data1
) + 'x' + IntToStr(ev
.data2
));
272 e_WriteLog('[DEBUG] WinMsgs: Resized to ' + IntToStr(ev
.data1
) + 'x' + IntToStr(ev
.data2
), TMsgType
.Notify
);
276 SDL_WINDOWEVENT_EXPOSED
:
279 SDL_WINDOWEVENT_MAXIMIZED
:
283 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
287 if not gWinMaximized
then
289 gWinMaximized
:= true;
290 if g_debug_WinMsgs
then
292 g_Console_Add('Now maximized');
293 e_WriteLog('[DEBUG] WinMsgs: Now maximized', TMsgType
.Notify
);
298 SDL_WINDOWEVENT_RESTORED
:
302 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
306 if gWinMaximized
then gWinMaximized
:= false;
307 if g_debug_WinMsgs
then
309 g_Console_Add('Now restored');
310 e_WriteLog('[DEBUG] WinMsgs: Now restored', TMsgType
.Notify
);
314 SDL_WINDOWEVENT_FOCUS_GAINED
:
317 //e_WriteLog('window gained focus!', MSG_NOTIFY);
320 SDL_WINDOWEVENT_FOCUS_LOST
:
324 //e_WriteLog('window lost focus!', MSG_NOTIFY);
332 e_WriteLog('deactivating window', TMsgType
.Notify
);
333 e_EnableInput
:= false;
334 e_ClearInputBuffer();
336 if gMuteWhenInactive
then
338 //e_WriteLog('deactivating sounds', MSG_NOTIFY);
339 e_MuteChannels(true);
342 if g_debug_WinMsgs
then
344 g_Console_Add('Now inactive');
345 e_WriteLog('[DEBUG] WinMsgs: Now inactive', TMsgType
.Notify
);
350 if assigned(winBlurCB
) then winBlurCB();
353 else if wActivate
then
355 if not gWinActive
then
357 //e_WriteLog('activating window', MSG_NOTIFY);
358 e_EnableInput
:= true;
360 if gMuteWhenInactive
then
362 //e_WriteLog('activating sounds', MSG_NOTIFY);
363 e_MuteChannels(false);
366 if g_debug_WinMsgs
then
368 g_Console_Add('Now active');
369 e_WriteLog('[DEBUG] WinMsgs: Now active', TMsgType
.Notify
);
373 if assigned(winFocusCB
) then winFocusCB();
379 function EventHandler (var ev
: TSDL_Event
): Boolean;
389 result
:= WindowEventHandler(ev
.window
);
393 if (gExit
<> EXIT_QUIT
) then
395 if not wLoadingProgress
then
402 wLoadingQuit
:= true;
408 SDL_KEYDOWN
, SDL_KEYUP
:
410 key
:= ev
.key
.keysym
.scancode
;
411 down
:= (ev
.type_
= SDL_KEYDOWN
);
412 {$IF not DEFINED(HEADLESS)}
413 if fuiOnSDLEvent(ev
) then
415 // event eaten, but...
416 if not down
then e_KeyUpDown(key
, false);
420 if down
then KeyPress(key
);
421 e_KeyUpDown(key
, down
);
424 {$IF not DEFINED(HEADLESS)}
425 SDL_MOUSEBUTTONDOWN
, SDL_MOUSEBUTTONUP
, SDL_MOUSEWHEEL
, SDL_MOUSEMOTION
:
431 Utf8ToUnicode(@uc
, PChar(ev
.text.text), 1);
433 if (keychr
> 127) then keychr
:= Word(wchar2win(WideChar(keychr
)));
434 if (keychr
> 0) and (keychr
<= 255) then CharPress(AnsiChar(keychr
));
437 // other key presses and joysticks are handled in e_input
442 procedure SwapBuffers ();
444 {$IF not DEFINED(HEADLESS)}
445 SDL_GL_SwapWindow(h_Wnd
);
450 function CreateGLWindow (Title
: PChar): Boolean;
454 gWinSizeX
:= gScreenWidth
;
455 gWinSizeY
:= gScreenHeight
;
457 {$IF not DEFINED(HEADLESS)}
460 e_WriteLog('Creating window', TMsgType
.Notify
);
462 if not g_Window_SetDisplay() then
465 e_WriteLog('Window creation error (resolution not supported?)', TMsgType
.Fatal
);
469 {$IF not DEFINED(HEADLESS)}
470 h_Gl
:= SDL_GL_CreateContext(h_Wnd
);
471 if (h_Gl
= nil) then exit
;
472 if assigned(oglInitCB
) then oglInitCB();
475 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
483 // windoze sux; in headless mode `GetTickCount()` (and SDL) returns shit
484 function GetTimer (): Int64;
488 QueryPerformanceFrequency(F
);
489 QueryPerformanceCounter(C
);
490 result
:= Round(C
/F
*1000{000});
493 function GetTimer (): Int64;
499 if (ticksOverflow
= -1) then
506 if (lastTicks
> t
) then
508 // overflow, increment overflow ;-)
509 ticksOverflow
:= ticksOverflow
+(Int64($ffffffff)+Int64(1));
510 tt
:= (Int64($ffffffff)+Int64(1))+Int64(t
);
511 t
:= Uint32(tt
-lastTicks
);
515 result
:= ticksOverflow
+Int64(t
);
520 procedure ResetTimer ();
522 wNeedTimeReset
:= true;
526 procedure PushExitEvent ();
530 ev
.type_
:= SDL_QUITEV
;
536 prevLoadingUpdateTime
: UInt64 = 0;
538 procedure ProcessLoading (forceUpdate
: Boolean=false);
544 FillChar(ev
, sizeof(ev
), 0);
545 wLoadingProgress
:= true;
547 while (SDL_PollEvent(@ev
) > 0) do
550 if (ev
.type_
= SDL_QUITEV
) then break
;
554 if (ev
.type_
= SDL_QUITEV
) or (gExit
= EXIT_QUIT
) then
556 wLoadingProgress
:= false;
560 if not wMinimized
then
564 prevLoadingUpdateTime
:= getTimeMilli();
568 stt
:= getTimeMilli();
569 if (stt
< prevLoadingUpdateTime
) or (stt
-prevLoadingUpdateTime
>= ProgressUpdateMSecs
) then
571 prevLoadingUpdateTime
:= stt
;
578 if g_Texture_Get('INTER', ID
) then
580 e_DrawSize(ID
, 0, 0, 0, false, false, gScreenWidth
, gScreenHeight
)
584 e_Clear(GL_COLOR_BUFFER_BIT
, 0, 0, 0);
594 if NetMode
= NET_SERVER
then
600 if (NetMode
= NET_CLIENT
) and (NetState
<> NET_STATE_AUTH
) then g_Net_Client_UpdateWhileLoading();
603 wLoadingProgress
:= false;
607 function g_ProcessMessages (): Boolean;
612 FillChar(ev
, SizeOf(ev
), 0);
613 while (SDL_PollEvent(@ev
) > 0) do
615 result
:= EventHandler(ev
);
616 if (ev
.type_
= SDL_QUITEV
) then exit
;
622 function ProcessMessage (): Boolean;
626 result
:= g_ProcessMessages();
629 Time_Delta
:= Time
-Time_Old
;
633 if wNeedTimeReset
then
636 wNeedTimeReset
:= false;
639 g_Map_ProfilersBegin();
640 g_Mons_ProfilersBegin();
642 t
:= Time_Delta
div 28;
648 if (NetMode
= NET_SERVER
) then g_Net_Host_Update()
649 else if (NetMode
= NET_CLIENT
) then g_Net_Client_Update();
655 if (NetMode
= NET_SERVER
) then g_Net_Host_Update()
656 else if (NetMode
= NET_CLIENT
) then g_Net_Client_Update();
659 g_Map_ProfilersEnd();
660 g_Mons_ProfilersEnd();
668 if (gExit
= EXIT_QUIT
) then
674 // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
677 Time_Old
:= Time
-(Time_Delta
mod 28);
678 if (not wMinimized
) then
686 Sleep(1); // release time slice, so we won't eat 100% CPU
693 procedure ReDrawWindow ();
699 procedure InitOpenGL (vsync
: Boolean);
700 {$IF not DEFINED(HEADLESS)}
705 {$IF not DEFINED(HEADLESS)}
706 if vsync
then v
:= 1 else v
:= 0;
707 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION
, 2);
708 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION
, 1);
709 SDL_GL_SetAttribute(SDL_GL_RED_SIZE
, 8);
710 SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE
, 8);
711 SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE
, 8);
712 SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE
, 16);
713 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER
, 1);
714 SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE
, 8); // lights; it is enough to have 1-bit stencil buffer for lighting, but...
715 SDL_GL_SetSwapInterval(v
);
720 function glHasExtension (const name
: AnsiString): Boolean;
725 extName
: ShortString;
728 if (Length(name
) = 0) then exit
;
729 exts
:= glGetString(GL_EXTENSIONS
);
730 if (exts
= nil) then exit
;
731 while (exts
[0] <> #0) and (exts
[0] = ' ') do Inc(exts
);
732 while (exts
[0] <> #0) do
734 if gwin_dump_extensions
then
737 while (exts
[i
] <> #0) and (exts
[i
] <> ' ') do Inc(i
);
740 e_WriteLog('FUUUUUUUUUUUUU', TMsgType
.Warning
);
744 Move(exts
^, extName
[1], i
);
745 extName
[0] := Char(i
);
746 e_WriteLog(Format('EXT: %s', [extName
]), TMsgType
.Notify
);
750 for i
:= 0 to length(name
)-1 do
752 if (exts
[i
] = #0) then begin found
:= false; break
; end;
753 if (exts
[i
] <> name
[i
+1]) then begin found
:= false; break
; end;
755 if found
and ((exts
[Length(name
)] = #0) or (exts
[Length(name
)] = ' ')) then begin result
:= true; exit
; end;
756 while (exts
[0] <> #0) and (exts
[0] <> ' ') do Inc(exts
);
757 while (exts
[0] <> #0) and (exts
[0] = ' ') do Inc(exts
);
762 function SDLMain (): Integer;
765 {$IF not DEFINED(HEADLESS)}
774 e_NoGraphics
:= true;
777 uiContext
.font
:= 'win14';
781 while (idx
<= ParamCount
) do
783 arg
:= ParamStr(idx
);
785 if arg
= '--opengl-dump-exts' then gwin_dump_extensions
:= true;
786 //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
787 if arg
= '--jah' then g_profile_history_size
:= 100;
788 if arg
= '--no-particles' then gpart_dbg_enabled
:= false;
789 if arg
= '--no-los' then gmon_dbg_los_enabled
:= false;
791 if arg
= '--profile-render' then g_profile_frame_draw
:= true;
792 if arg
= '--profile-coldet' then g_profile_collision
:= true;
793 if arg
= '--profile-los' then g_profile_los
:= true;
795 if arg
= '--no-part-phys' then gpart_dbg_phys_enabled
:= false;
796 if arg
= '--no-part-physics' then gpart_dbg_phys_enabled
:= false;
797 if arg
= '--no-particles-phys' then gpart_dbg_phys_enabled
:= false;
798 if arg
= '--no-particles-physics' then gpart_dbg_phys_enabled
:= false;
799 if arg
= '--no-particle-phys' then gpart_dbg_phys_enabled
:= false;
800 if arg
= '--no-particle-physics' then gpart_dbg_phys_enabled
:= false;
802 {.$IF DEFINED(D2F_DEBUG)}
803 if arg
= '--aimline' then g_dbg_aimline_on
:= true;
806 if arg
= '--holmes' then begin g_holmes_enabled
:= true; g_Game_SetDebugMode(); end;
808 if (arg
= '--holmes-ui-scale') or (arg
= '-holmes-ui-scale') then
810 if (idx
<= ParamCount
) then
812 if not conParseFloat(fuiRenderScale
, ParamStr(idx
)) then fuiRenderScale
:= 1.0;
817 if (arg
= '--holmes-font') or (arg
= '-holmes-font') then
819 if (idx
<= ParamCount
) then
822 val(ParamStr(idx
), itmp
, valres
);
824 if (valres
= 0) and (not g_holmes_imfunctional
) then
827 8: uiContext
.font
:= 'win8';
828 14: uiContext
.font
:= 'win14';
829 16: uiContext
.font
:= 'win16';
841 if (arg
= '--game-scale') or (arg
= '-game-scale') then
843 if (idx
<= ParamCount
) then
845 if not conParseFloat(g_dbg_scale
, ParamStr(idx
)) then g_dbg_scale
:= 1.0;
850 if (arg
= '--write-mapdef') or (arg
= '-write-mapdef') then
852 mdfo
:= createDiskFile('mapdef.txt');
853 mdfo
.WriteBuffer(defaultMapDef
[1], Length(defaultMapDef
));
859 e_WriteLog('Initializing OpenGL', TMsgType
.Notify
);
862 e_WriteLog('Creating GL window', TMsgType
.Notify
);
863 if not CreateGLWindow(PChar(Format('Doom 2D: Forever %s', [GAME_VERSION
]))) then
869 {EnumDisplayModes();}
872 //gwin_k8_enable_light_experiments := false;
873 gwin_has_stencil
:= false;
874 glLegacyNPOT
:= false;
875 gwin_dump_extensions
:= false;
877 SDL_GL_GetAttribute(SDL_GL_STENCIL_SIZE
, @ltmp
);
878 e_LogWritefln('stencil buffer size: %s', [ltmp
]);
879 gwin_has_stencil
:= (ltmp
> 0);
881 if not glHasExtension('GL_ARB_texture_non_power_of_two') then
883 e_WriteLog('NPOT textures: NO', TMsgType
.Warning
);
884 glLegacyNPOT
:= true;
888 e_WriteLog('NPOT textures: YES', TMsgType
.Notify
);
889 glLegacyNPOT
:= false;
891 gwin_dump_extensions
:= false;
895 Time_Old
:= GetTimer();
898 if (ParamCount
> 0) then g_Game_Process_Params();
901 if (not gGameOn
) and gAskLanguage
then g_Menu_AskLanguage();
903 e_WriteLog('Entering the main loop', TMsgType
.Notify
);
906 while not ProcessMessage() do begin end;