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}
26 // ////////////////////////////////////////////////////////////////////////// //
27 // initialize OpenGL; set `gScreenWidth` and `gScreenHeight` before calling this
28 function glInit (const winTitle
: AnsiString
='SDL TEST'): Boolean;
29 procedure glDeinit ();
30 // call this to show built frame
32 // call this to push "quit" event into queue
33 procedure pushQuitEvent ();
34 // call this to process queued messages; result is `true` if quit event was received
35 function processMessages (): Boolean;
37 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
38 procedure mainLoop ();
48 gWinH
: PSDL_Window
= nil;
49 gGLContext
: TSDL_GLContext
= nil;
50 lastFrameTime
: UInt64
= 0;
53 // ////////////////////////////////////////////////////////////////////////// //
54 procedure onExposeFrame ();
60 // ////////////////////////////////////////////////////////////////////////// //
61 function sdlInit (): Boolean;
67 sdlflags
:= SDL_INIT_TIMER
or SDL_INIT_VIDEO
;
68 if SDL_Init(sdlflags
) < 0 then exit
; //raise Exception.Create('SDL: Init failed: ' + SDL_GetError());
72 fuiWinActive
:= fuiWinActive
;
78 if (gWinH
= nil) then exit
;
79 SDL_GL_SwapWindow(gWinH
);
83 procedure killGLWindow ();
85 if (gWinH
<> nil) then SDL_DestroyWindow(gWinH
);
86 if (gGLContext
<> nil) then SDL_GL_DeleteContext(gGLContext
);
92 procedure pushQuitEvent ();
96 ev
.type_
:= SDL_QUITEV
;
101 // ////////////////////////////////////////////////////////////////////////// //
103 function processMessages (): Boolean;
108 FillChar(ev
, sizeof(ev
), 0);
109 while (SDL_PollEvent(@ev
) > 0) do
111 if fuiOnSDLEvent(ev
) then result
:= true;
112 //if (ev.type_ = SDL_QUITEV) then exit;
117 // ////////////////////////////////////////////////////////////////////////// //
118 procedure glDeinit ();
120 if (gWinH
<> nil) and assigned(oglDeinitCB
) then oglDeinitCB();
125 function glInit (const winTitle
: AnsiString
='SDL TEST'): Boolean;
127 wFlags
: LongWord
= 0;
132 wFlags
:= SDL_WINDOW_OPENGL
or SDL_WINDOW_RESIZABLE
;
133 //if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN;
134 //if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED;
138 //if VSync then v := 1 else v := 0;
139 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION
, 2);
140 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION
, 1);
141 SDL_GL_SetAttribute(SDL_GL_RED_SIZE
, 8);
142 SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE
, 8);
143 SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE
, 8);
144 SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE
, 16);
145 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER
, 1);
146 SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE
, 1); // lights; it is enough to have 1-bit stencil buffer for lighting
147 SDL_GL_SetSwapInterval(v
);
152 mode.w := gScreenWidth;
153 mode.h := gScreenHeight;
155 mode.refresh_rate := 0;
156 mode.driverdata := nil;
157 if SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil then
160 gScreenHeight := 600;
164 gScreenWidth := cmode.w;
165 gScreenHeight := cmode.h;
170 gWinH
:= SDL_CreateWindow(PAnsiChar(winTitle
), -1, -1, fuiScrWdt
, fuiScrHgt
, wFlags
);
171 if (gWinH
= nil) then exit
;
173 gGLContext
:= SDL_GL_CreateContext(gWinH
);
174 if (gGLContext
= nil) then begin SDL_DestroyWindow(gWinH
); gWinH
:= nil; exit
; end;
176 SDL_GL_MakeCurrent(gWinH
, gGLContext
);
177 SDL_ShowCursor(SDL_DISABLE
);
179 if assigned(oglInitCB
) then oglInitCB();
185 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
186 procedure mainLoop ();
191 if assigned(buildFrameCB
) then buildFrameCB();
192 if assigned(prerenderFrameCB
) then prerenderFrameCB();
193 if assigned(renderFrameCB
) then renderFrameCB();
194 if assigned(postrenderFrameCB
) then postrenderFrameCB();
196 lastFrameTime
:= fuiTimeMilli();
199 // calculate time to build and render next frame
200 nft
:= lastFrameTime
+(1000 div fuiFPS
);
201 ctt
:= fuiTimeMilli();
204 // time to build next frame
205 if assigned(buildFrameCB
) then buildFrameCB();
206 if assigned(prerenderFrameCB
) then prerenderFrameCB();
207 if assigned(renderFrameCB
) then renderFrameCB();
208 if assigned(postrenderFrameCB
) then postrenderFrameCB();
210 lastFrameTime
:= ctt
; // ignore frame processing time
214 // has to wait for some time
215 if (nft
-ctt
> 1000) then wt
:= 1000 else wt
:= Integer(nft
-ctt
);
216 SDL_WaitEventTimeout(nil, wt
);
218 if processMessages() then break
; // just in case
224 exposeFrameCB
:= onExposeFrame();
226 if not sdlInit() then raise Exception
.Create('cannot initialize SDL');