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);
42 gwin_dump_extensions
: Boolean = false;
43 gwin_has_stencil
: Boolean = false;
44 gwin_k8_enable_light_experiments
: Boolean = false;
45 g_dbg_aimline_on
: Boolean = false;
51 {$IFDEF WINDOWS}Windows
,{$ENDIF}
52 SysUtils
, Classes
, MAPDEF
,
53 SDL2
, GL
, GLExt
, e_graphics
, e_log
, e_texture
, g_main
,
54 g_console
, e_input
, g_options
, g_game
,
55 g_basic
, g_textures
, e_sound
, g_sound
, g_menu
, ENet
, g_net
,
56 g_map
, g_gfx
, g_monsters
, g_holmes
, xprofiler
,
61 ProgressUpdateMSecs
= 100;
64 h_Wnd
: PSDL_Window
= nil;
65 h_GL
: TSDL_GLContext
= nil;
66 Time
, Time_Delta
, Time_Old
: Int64;
68 {$IF not DEFINED(HEADLESS)}
71 wNeedTimeReset
: Boolean = false;
72 wMinimized
: Boolean = false;
73 wLoadingProgress
: Boolean = false;
74 wLoadingQuit
: Boolean = false;
76 ticksOverflow
: Int64 = -1;
77 lastTicks
: Uint32
= 0; // to detect overflow
81 procedure KillGLWindow ();
83 if (h_Wnd
<> nil) then
85 if assigned(oglDeinitCB
) then oglDeinitCB();
87 if (h_Wnd
<> nil) then SDL_DestroyWindow(h_Wnd
);
88 if (h_GL
<> nil) then SDL_GL_DeleteContext(h_GL
);
94 function g_Window_SetDisplay (preserveGL
: Boolean = false): Boolean;
95 {$IF not DEFINED(HEADLESS)}
97 mode
, cmode
: TSDL_DisplayMode
;
101 {$IF not DEFINED(HEADLESS)}
104 e_WriteLog('Setting display mode...', TMsgType
.Notify
);
106 wFlags
:= SDL_WINDOW_OPENGL
or SDL_WINDOW_RESIZABLE
;
107 if gFullscreen
then wFlags
:= wFlags
or SDL_WINDOW_FULLSCREEN
;
108 if gWinMaximized
then wFlags
:= wFlags
or SDL_WINDOW_MAXIMIZED
;
114 mode
.w
:= gScreenWidth
;
115 mode
.h
:= gScreenHeight
;
117 mode
.refresh_rate
:= 0;
118 mode
.driverdata
:= nil;
119 if (SDL_GetClosestDisplayMode(0, @mode
, @cmode
) = nil) then
122 gScreenHeight
:= 600;
126 gScreenWidth
:= cmode
.w
;
127 gScreenHeight
:= cmode
.h
;
131 h_Wnd
:= SDL_CreateWindow(PChar(wTitle
), gWinRealPosX
, gWinRealPosY
, gScreenWidth
, gScreenHeight
, wFlags
);
132 if (h_Wnd
= nil) then exit
;
134 SDL_GL_MakeCurrent(h_Wnd
, h_GL
);
135 SDL_ShowCursor(SDL_DISABLE
);
136 if (h_GL
<> nil) then
138 if assigned(oglInitCB
) then oglInitCB();
146 function GetDisplayModes (dbpp
: LongWord; var selres
: LongWord): SSArray
;
148 mode
: TSDL_DisplayMode
;
149 res
, i
, k
, n
, pw
, ph
: Integer;
151 SetLength(result
, 0);
152 {$IFDEF HEADLESS}exit
;{$ENDIF}
154 n
:= SDL_GetNumDisplayModes(0);
158 res
:= SDL_GetDisplayMode(0, i
, @mode
);
159 if res
< 0 then continue
;
160 if SDL_BITSPERPIXEL(mode
.format
) = gBPP
then continue
;
161 if (mode
.w
= pw
) and (mode
.h
= ph
) then continue
;
162 if (mode
.w
= gScreenWidth
) and (mode
.h
= gScreenHeight
) then
165 SetLength(result
, k
);
166 result
[k
-1] := IntToStr(mode
.w
) + 'x' + IntToStr(mode
.h
);
167 pw
:= mode
.w
; ph
:= mode
.h
170 e_WriteLog('SDL: Got ' + IntToStr(k
) + ' resolutions.', TMsgType
.Notify
);
174 procedure Sleep (ms
: LongWord);
180 procedure ChangeWindowSize ();
182 gWinSizeX
:= gScreenWidth
;
183 gWinSizeY
:= gScreenHeight
;
184 {$IF not DEFINED(HEADLESS)}
185 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
186 g_Game_SetupScreenSize();
188 g_Game_ClearLoading();
193 function g_Window_SetSize (w
, h
: Word; fullscreen
: Boolean): Boolean;
194 {$IF not DEFINED(HEADLESS)}
200 {$IF not DEFINED(HEADLESS)}
203 if (gScreenWidth
<> w
) or (gScreenHeight
<> h
) then
210 if (gFullscreen
<> fullscreen
) then
213 gFullscreen
:= fullscreen
;
219 g_Window_SetDisplay(preserve
);
226 function WindowEventHandler (constref ev
: TSDL_WindowEvent
): Boolean;
228 wActivate
, wDeactivate
: Boolean;
232 wDeactivate
:= false;
235 SDL_WINDOWEVENT_MOVED
:
237 if not (gFullscreen
or gWinMaximized
) then
239 gWinRealPosX
:= ev
.data1
;
240 gWinRealPosY
:= ev
.data2
;
244 SDL_WINDOWEVENT_MINIMIZED
:
247 if not wMinimized
then
249 e_ResizeWindow(0, 0);
251 if g_debug_WinMsgs
then
253 g_Console_Add('Now minimized');
254 e_WriteLog('[DEBUG] WinMsgs: Now minimized', TMsgType
.Notify
);
260 SDL_WINDOWEVENT_RESIZED
:
262 gScreenWidth
:= ev
.data1
;
263 gScreenHeight
:= ev
.data2
;
266 if g_debug_WinMsgs
then
268 g_Console_Add('Resized to ' + IntToStr(ev
.data1
) + 'x' + IntToStr(ev
.data2
));
269 e_WriteLog('[DEBUG] WinMsgs: Resized to ' + IntToStr(ev
.data1
) + 'x' + IntToStr(ev
.data2
), TMsgType
.Notify
);
273 SDL_WINDOWEVENT_EXPOSED
:
276 SDL_WINDOWEVENT_MAXIMIZED
:
280 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
284 if not gWinMaximized
then
286 gWinMaximized
:= true;
287 if g_debug_WinMsgs
then
289 g_Console_Add('Now maximized');
290 e_WriteLog('[DEBUG] WinMsgs: Now maximized', TMsgType
.Notify
);
295 SDL_WINDOWEVENT_RESTORED
:
299 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
303 if gWinMaximized
then gWinMaximized
:= false;
304 if g_debug_WinMsgs
then
306 g_Console_Add('Now restored');
307 e_WriteLog('[DEBUG] WinMsgs: Now restored', TMsgType
.Notify
);
311 SDL_WINDOWEVENT_FOCUS_GAINED
:
314 //e_WriteLog('window gained focus!', MSG_NOTIFY);
317 SDL_WINDOWEVENT_FOCUS_LOST
:
321 //e_WriteLog('window lost focus!', MSG_NOTIFY);
329 e_WriteLog('deactivating window', TMsgType
.Notify
);
330 e_EnableInput
:= false;
331 e_ClearInputBuffer();
333 if gMuteWhenInactive
then
335 //e_WriteLog('deactivating sounds', MSG_NOTIFY);
336 e_MuteChannels(true);
339 if g_debug_WinMsgs
then
341 g_Console_Add('Now inactive');
342 e_WriteLog('[DEBUG] WinMsgs: Now inactive', TMsgType
.Notify
);
347 if assigned(winBlurCB
) then winBlurCB();
350 else if wActivate
then
352 if not gWinActive
then
354 //e_WriteLog('activating window', MSG_NOTIFY);
355 e_EnableInput
:= true;
357 if gMuteWhenInactive
then
359 //e_WriteLog('activating sounds', MSG_NOTIFY);
360 e_MuteChannels(false);
363 if g_debug_WinMsgs
then
365 g_Console_Add('Now active');
366 e_WriteLog('[DEBUG] WinMsgs: Now active', TMsgType
.Notify
);
370 if assigned(winFocusCB
) then winFocusCB();
376 function EventHandler (var ev
: TSDL_Event
): Boolean;
386 result
:= WindowEventHandler(ev
.window
);
390 if (gExit
<> EXIT_QUIT
) then
392 if not wLoadingProgress
then
399 wLoadingQuit
:= true;
405 SDL_KEYDOWN
, SDL_KEYUP
:
407 key
:= ev
.key
.keysym
.scancode
;
408 down
:= (ev
.type_
= SDL_KEYDOWN
);
409 {$IF not DEFINED(HEADLESS)}
412 // event eaten, but...
413 if not down
then e_KeyUpDown(key
, false);
417 if down
then KeyPress(key
);
418 e_KeyUpDown(key
, down
);
421 {$IF not DEFINED(HEADLESS)}
422 SDL_MOUSEBUTTONDOWN
, SDL_MOUSEBUTTONUP
, SDL_MOUSEWHEEL
, SDL_MOUSEMOTION
:
428 Utf8ToUnicode(@uc
, PChar(ev
.text.text), 1);
430 if (keychr
> 127) then keychr
:= Word(wchar2win(WideChar(keychr
)));
431 CharPress(AnsiChar(keychr
));
434 // other key presses and joysticks are handled in e_input
439 procedure SwapBuffers ();
441 {$IF not DEFINED(HEADLESS)}
442 SDL_GL_SwapWindow(h_Wnd
);
447 function CreateGLWindow (Title
: PChar): Boolean;
451 gWinSizeX
:= gScreenWidth
;
452 gWinSizeY
:= gScreenHeight
;
454 {$IF not DEFINED(HEADLESS)}
457 e_WriteLog('Creating window', TMsgType
.Notify
);
459 if not g_Window_SetDisplay() then
462 e_WriteLog('Window creation error (resolution not supported?)', TMsgType
.Fatal
);
466 {$IF not DEFINED(HEADLESS)}
467 h_Gl
:= SDL_GL_CreateContext(h_Wnd
);
468 if (h_Gl
= nil) then exit
;
469 if assigned(oglInitCB
) then oglInitCB();
472 e_ResizeWindow(gScreenWidth
, gScreenHeight
);
480 // windoze sux; in headless mode `GetTickCount()` (and SDL) returns shit
481 function GetTimer (): Int64;
485 QueryPerformanceFrequency(F
);
486 QueryPerformanceCounter(C
);
487 result
:= Round(C
/F
*1000{000});
490 function GetTimer (): Int64;
496 if (ticksOverflow
= -1) then
503 if (lastTicks
> t
) then
505 // overflow, increment overflow ;-)
506 ticksOverflow
:= ticksOverflow
+(Int64($ffffffff)+Int64(1));
507 tt
:= (Int64($ffffffff)+Int64(1))+Int64(t
);
508 t
:= Uint32(tt
-lastTicks
);
512 result
:= ticksOverflow
+Int64(t
);
517 procedure ResetTimer ();
519 wNeedTimeReset
:= true;
523 procedure PushExitEvent ();
527 ev
.type_
:= SDL_QUITEV
;
533 prevLoadingUpdateTime
: UInt64 = 0;
535 procedure ProcessLoading (forceUpdate
: Boolean=false);
541 FillChar(ev
, sizeof(ev
), 0);
542 wLoadingProgress
:= true;
544 while (SDL_PollEvent(@ev
) > 0) do
546 if (ev
.type_
= SDL_QUITEV
) then break
;
549 if (ev
.type_
= SDL_QUITEV
) or (gExit
= EXIT_QUIT
) then
551 wLoadingProgress
:= false;
555 if not wMinimized
then
559 prevLoadingUpdateTime
:= getTimeMilli();
563 stt
:= getTimeMilli();
564 if (stt
< prevLoadingUpdateTime
) or (stt
-prevLoadingUpdateTime
>= ProgressUpdateMSecs
) then
566 prevLoadingUpdateTime
:= stt
;
573 if g_Texture_Get('INTER', ID
) then
575 e_DrawSize(ID
, 0, 0, 0, false, false, gScreenWidth
, gScreenHeight
)
579 e_Clear(GL_COLOR_BUFFER_BIT
, 0, 0, 0);
589 if NetMode
= NET_SERVER
then
595 if (NetMode
= NET_CLIENT
) and (NetState
<> NET_STATE_AUTH
) then g_Net_Client_UpdateWhileLoading();
598 wLoadingProgress
:= false;
602 function ProcessMessage (): Boolean;
608 FillChar(ev
, SizeOf(ev
), 0);
610 while (SDL_PollEvent(@ev
) > 0) do
612 result
:= EventHandler(ev
);
613 if (ev
.type_
= SDL_QUITEV
) then exit
;
617 Time_Delta
:= Time
-Time_Old
;
621 if wNeedTimeReset
then
624 wNeedTimeReset
:= false;
627 g_Map_ProfilersBegin();
628 g_Mons_ProfilersBegin();
630 t
:= Time_Delta
div 28;
636 if (NetMode
= NET_SERVER
) then g_Net_Host_Update()
637 else if (NetMode
= NET_CLIENT
) then g_Net_Client_Update();
643 if (NetMode
= NET_SERVER
) then g_Net_Host_Update()
644 else if (NetMode
= NET_CLIENT
) then g_Net_Client_Update();
647 g_Map_ProfilersEnd();
648 g_Mons_ProfilersEnd();
656 if (gExit
= EXIT_QUIT
) then
662 // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
665 Time_Old
:= Time
-(Time_Delta
mod 28);
666 if (not wMinimized
) then
674 Sleep(1); // release time slice, so we won't eat 100% CPU
681 procedure ReDrawWindow ();
687 procedure InitOpenGL (vsync
: Boolean);
688 {$IF not DEFINED(HEADLESS)}
693 {$IF not DEFINED(HEADLESS)}
694 if vsync
then v
:= 1 else v
:= 0;
695 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION
, 2);
696 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION
, 1);
697 SDL_GL_SetAttribute(SDL_GL_RED_SIZE
, 8);
698 SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE
, 8);
699 SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE
, 8);
700 SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE
, 16);
701 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER
, 1);
702 SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE
, 8); // lights; it is enough to have 1-bit stencil buffer for lighting, but...
703 SDL_GL_SetSwapInterval(v
);
708 function glHasExtension (const name
: AnsiString): Boolean;
713 extName
: ShortString;
716 if (Length(name
) = 0) then exit
;
717 exts
:= glGetString(GL_EXTENSIONS
);
718 if (exts
= nil) then exit
;
719 while (exts
[0] <> #0) and (exts
[0] = ' ') do Inc(exts
);
720 while (exts
[0] <> #0) do
722 if gwin_dump_extensions
then
725 while (exts
[i
] <> #0) and (exts
[i
] <> ' ') do Inc(i
);
728 e_WriteLog('FUUUUUUUUUUUUU', TMsgType
.Warning
);
732 Move(exts
^, extName
[1], i
);
733 extName
[0] := Char(i
);
734 e_WriteLog(Format('EXT: %s', [extName
]), TMsgType
.Notify
);
738 for i
:= 0 to length(name
)-1 do
740 if (exts
[i
] = #0) then begin found
:= false; break
; end;
741 if (exts
[i
] <> name
[i
+1]) then begin found
:= false; break
; end;
743 if found
and ((exts
[Length(name
)] = #0) or (exts
[Length(name
)] = ' ')) then begin result
:= true; exit
; end;
744 while (exts
[0] <> #0) and (exts
[0] <> ' ') do Inc(exts
);
745 while (exts
[0] <> #0) and (exts
[0] = ' ') do Inc(exts
);
750 function SDLMain (): Integer;
753 {$IF not DEFINED(HEADLESS)}
760 e_NoGraphics
:= true;
764 while (idx
<= ParamCount
) do
766 arg
:= ParamStr(idx
);
768 if arg
= '--opengl-dump-exts' then gwin_dump_extensions
:= true;
769 //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
770 if arg
= '--jah' then g_profile_history_size
:= 100;
771 if arg
= '--no-particles' then gpart_dbg_enabled
:= false;
772 if arg
= '--no-los' then gmon_dbg_los_enabled
:= false;
774 if arg
= '--profile-render' then g_profile_frame_draw
:= true;
775 if arg
= '--profile-coldet' then g_profile_collision
:= true;
776 if arg
= '--profile-los' then g_profile_los
:= true;
778 if arg
= '--no-part-phys' then gpart_dbg_phys_enabled
:= false;
779 if arg
= '--no-part-physics' then gpart_dbg_phys_enabled
:= false;
780 if arg
= '--no-particles-phys' then gpart_dbg_phys_enabled
:= false;
781 if arg
= '--no-particles-physics' then gpart_dbg_phys_enabled
:= false;
782 if arg
= '--no-particle-phys' then gpart_dbg_phys_enabled
:= false;
783 if arg
= '--no-particle-physics' then gpart_dbg_phys_enabled
:= false;
785 {.$IF DEFINED(D2F_DEBUG)}
786 if arg
= '--aimline' then g_dbg_aimline_on
:= true;
789 if arg
= '--holmes' then begin g_holmes_enabled
:= true; g_Game_SetDebugMode(); end;
790 if (arg
= '--holmes-ui-scale') or (arg
= '-holmes-ui-scale') then
792 if (idx
<= ParamCount
) then
794 if not conParseFloat(gh_ui_scale
, ParamStr(idx
)) then gh_ui_scale
:= 1.0;
799 if (arg
= '--game-scale') or (arg
= '-game-scale') then
801 if (idx
<= ParamCount
) then
803 if not conParseFloat(g_dbg_scale
, ParamStr(idx
)) then g_dbg_scale
:= 1.0;
808 if (arg
= '--write-mapdef') or (arg
= '-write-mapdef') then
810 mdfo
:= createDiskFile('mapdef.txt');
811 mdfo
.WriteBuffer(defaultMapDef
[1], Length(defaultMapDef
));
817 e_WriteLog('Initializing OpenGL', TMsgType
.Notify
);
820 e_WriteLog('Creating GL window', TMsgType
.Notify
);
821 if not CreateGLWindow(PChar(Format('Doom 2D: Forever %s', [GAME_VERSION
]))) then
827 {EnumDisplayModes();}
830 //gwin_k8_enable_light_experiments := false;
831 gwin_has_stencil
:= false;
832 glLegacyNPOT
:= false;
833 gwin_dump_extensions
:= false;
835 SDL_GL_GetAttribute(SDL_GL_STENCIL_SIZE
, @ltmp
);
836 e_LogWritefln('stencil buffer size: %s', [ltmp
]);
837 gwin_has_stencil
:= (ltmp
> 0);
839 if not glHasExtension('GL_ARB_texture_non_power_of_two') then
841 e_WriteLog('NPOT textures: NO', TMsgType
.Warning
);
842 glLegacyNPOT
:= true;
846 e_WriteLog('NPOT textures: YES', TMsgType
.Notify
);
847 glLegacyNPOT
:= false;
849 gwin_dump_extensions
:= false;
853 Time_Old
:= GetTimer();
856 if (ParamCount
> 0) then g_Game_Process_Params();
859 if (not gGameOn
) and gAskLanguage
then g_Menu_AskLanguage();
861 e_WriteLog('Entering the main loop', TMsgType
.Notify
);
864 while not ProcessMessage() do begin end;