DEADSOFTWARE

changed license to GPLv3 only; sorry, no trust to FSF anymore
[d2df-sdl.git] / src / flexui / sdlstandalone.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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit sdlstandalone;
18 interface
20 uses
21 SDL2,
22 sdlcarcass;
25 // ////////////////////////////////////////////////////////////////////////// //
26 // initialize OpenGL; set `gScreenWidth` and `gScreenHeight` before calling this
27 function glInit (const winTitle: AnsiString='SDL TEST'): Boolean;
28 procedure glDeinit ();
29 // call this to show built frame
30 procedure glSwap ();
31 // call this to push "quit" event into queue
32 procedure pushQuitEvent ();
33 // call this to process queued messages; result is `true` if quit event was received
34 function processMessages (): Boolean;
36 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
37 procedure mainLoop ();
40 implementation
42 uses
43 SysUtils;
46 var
47 gWinH: PSDL_Window = nil;
48 gGLContext: TSDL_GLContext = nil;
49 lastFrameTime: UInt64 = 0;
52 // ////////////////////////////////////////////////////////////////////////// //
53 procedure onExposeFrame ();
54 begin
55 glSwap();
56 end;
59 // ////////////////////////////////////////////////////////////////////////// //
60 function sdlInit (): Boolean;
61 var
62 sdlflags: LongWord;
63 begin
64 result := false;
66 sdlflags := SDL_INIT_TIMER or SDL_INIT_VIDEO;
67 if SDL_Init(sdlflags) < 0 then exit; //raise Exception.Create('SDL: Init failed: ' + SDL_GetError());
69 //SDL_Quit();
70 result := true;
71 fuiWinActive := fuiWinActive;
72 SDL_StartTextInput();
73 end;
76 procedure glSwap ();
77 begin
78 if (gWinH = nil) then exit;
79 SDL_GL_SwapWindow(gWinH);
80 end;
83 procedure killGLWindow ();
84 begin
85 if (gWinH <> nil) then SDL_DestroyWindow(gWinH);
86 if (gGLContext <> nil) then SDL_GL_DeleteContext(gGLContext);
87 gWinH := nil;
88 gGLContext := nil;
89 end;
92 procedure pushQuitEvent ();
93 var
94 ev: TSDL_Event;
95 begin
96 ev.type_ := SDL_QUITEV;
97 SDL_PushEvent(@ev);
98 end;
101 // ////////////////////////////////////////////////////////////////////////// //
102 // true: quit
103 function processMessages (): Boolean;
104 var
105 ev: TSDL_Event;
106 begin
107 result := false;
108 FillChar(ev, sizeof(ev), 0);
109 while (SDL_PollEvent(@ev) > 0) do
110 begin
111 fuiOnSDLEvent(ev);
112 //if (ev.type_ = SDL_QUITEV) then exit;
113 end;
114 if fuiQuitReceived then result := true;
115 end;
118 // ////////////////////////////////////////////////////////////////////////// //
119 procedure glDeinit ();
120 begin
121 if (gWinH <> nil) and assigned(oglDeinitCB) then oglDeinitCB();
122 killGLWindow();
123 end;
126 function glInit (const winTitle: AnsiString='SDL TEST'): Boolean;
127 var
128 wFlags: LongWord = 0;
129 v: Byte = 0;
130 begin
131 result := false;
133 wFlags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE;
134 //if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN;
135 //if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED;
137 glDeinit();
139 //if VSync then v := 1 else v := 0;
140 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
141 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
142 SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
143 SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
144 SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
145 SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
146 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
147 SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 1); // lights; it is enough to have 1-bit stencil buffer for lighting
148 SDL_GL_SetSwapInterval(v);
151 if gFullscreen then
152 begin
153 mode.w := gScreenWidth;
154 mode.h := gScreenHeight;
155 mode.format := 0;
156 mode.refresh_rate := 0;
157 mode.driverdata := nil;
158 if SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil then
159 begin
160 gScreenWidth := 800;
161 gScreenHeight := 600;
162 end
163 else
164 begin
165 gScreenWidth := cmode.w;
166 gScreenHeight := cmode.h;
167 end;
168 end;
171 gWinH := SDL_CreateWindow(PAnsiChar(winTitle), -1, -1, fuiScrWdt, fuiScrHgt, wFlags);
172 if (gWinH = nil) then exit;
174 gGLContext := SDL_GL_CreateContext(gWinH);
175 if (gGLContext = nil) then begin SDL_DestroyWindow(gWinH); gWinH := nil; exit; end;
177 SDL_GL_MakeCurrent(gWinH, gGLContext);
178 SDL_ShowCursor(SDL_DISABLE);
180 if assigned(oglInitCB) then oglInitCB();
182 result := true;
183 end;
186 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
187 procedure mainLoop ();
188 var
189 nft, ctt: UInt64;
190 wt: Integer;
191 begin
192 if assigned(buildFrameCB) then buildFrameCB();
193 if assigned(prerenderFrameCB) then prerenderFrameCB();
194 if assigned(renderFrameCB) then renderFrameCB();
195 if assigned(postrenderFrameCB) then postrenderFrameCB();
196 glSwap();
197 lastFrameTime := fuiTimeMilli();
198 while true do
199 begin
200 // calculate time to build and render next frame
201 nft := lastFrameTime+(1000 div fuiFPS);
202 ctt := fuiTimeMilli();
203 if (ctt >= nft) then
204 begin
205 // time to build next frame
206 if assigned(buildFrameCB) then buildFrameCB();
207 if assigned(prerenderFrameCB) then prerenderFrameCB();
208 if assigned(renderFrameCB) then renderFrameCB();
209 if assigned(postrenderFrameCB) then postrenderFrameCB();
210 glSwap();
211 lastFrameTime := ctt; // ignore frame processing time
212 end
213 else
214 begin
215 // has to wait for some time
216 if (nft-ctt > 1000) then wt := 1000 else wt := Integer(nft-ctt);
217 SDL_WaitEventTimeout(nil, wt);
218 end;
219 if processMessages() then break; // just in case
220 end;
221 end;
224 initialization
225 exposeFrameCB := onExposeFrame();
227 if not sdlInit() then raise Exception.Create('cannot initialize SDL');
228 finalization
229 glDeinit();
230 SDL_Quit();
231 end.