DEADSOFTWARE

fixed small fonts, translation and change point size
[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, 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 sdlstandalone;
19 interface
21 uses
22 SDL2,
23 sdlcarcass;
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
31 procedure glSwap ();
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 ();
41 implementation
43 uses
44 SysUtils;
47 var
48 gWinH: PSDL_Window = nil;
49 gGLContext: TSDL_GLContext = nil;
50 lastFrameTime: UInt64 = 0;
53 // ////////////////////////////////////////////////////////////////////////// //
54 procedure onExposeFrame ();
55 begin
56 glSwap();
57 end;
60 // ////////////////////////////////////////////////////////////////////////// //
61 function sdlInit (): Boolean;
62 var
63 sdlflags: LongWord;
64 begin
65 result := false;
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());
70 //SDL_Quit();
71 result := true;
72 fuiWinActive := fuiWinActive;
73 SDL_StartTextInput();
74 end;
77 procedure glSwap ();
78 begin
79 if (gWinH = nil) then exit;
80 SDL_GL_SwapWindow(gWinH);
81 end;
84 procedure killGLWindow ();
85 begin
86 if (gWinH <> nil) then SDL_DestroyWindow(gWinH);
87 if (gGLContext <> nil) then SDL_GL_DeleteContext(gGLContext);
88 gWinH := nil;
89 gGLContext := nil;
90 end;
93 procedure pushQuitEvent ();
94 var
95 ev: TSDL_Event;
96 begin
97 ev.type_ := SDL_QUITEV;
98 SDL_PushEvent(@ev);
99 end;
102 // ////////////////////////////////////////////////////////////////////////// //
103 // true: quit
104 function processMessages (): Boolean;
105 var
106 ev: TSDL_Event;
107 begin
108 result := false;
109 FillChar(ev, sizeof(ev), 0);
110 while (SDL_PollEvent(@ev) > 0) do
111 begin
112 fuiOnSDLEvent(ev);
113 //if (ev.type_ = SDL_QUITEV) then exit;
114 end;
115 if fuiQuitReceived then result := true;
116 end;
119 // ////////////////////////////////////////////////////////////////////////// //
120 procedure glDeinit ();
121 begin
122 if (gWinH <> nil) and assigned(oglDeinitCB) then oglDeinitCB();
123 killGLWindow();
124 end;
127 function glInit (const winTitle: AnsiString='SDL TEST'): Boolean;
128 var
129 wFlags: LongWord = 0;
130 v: Byte = 0;
131 begin
132 result := false;
134 wFlags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE;
135 //if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN;
136 //if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED;
138 glDeinit();
140 //if VSync then v := 1 else v := 0;
141 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
142 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
143 SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
144 SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
145 SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
146 SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
147 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
148 SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 1); // lights; it is enough to have 1-bit stencil buffer for lighting
149 SDL_GL_SetSwapInterval(v);
152 if gFullscreen then
153 begin
154 mode.w := gScreenWidth;
155 mode.h := gScreenHeight;
156 mode.format := 0;
157 mode.refresh_rate := 0;
158 mode.driverdata := nil;
159 if SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil then
160 begin
161 gScreenWidth := 800;
162 gScreenHeight := 600;
163 end
164 else
165 begin
166 gScreenWidth := cmode.w;
167 gScreenHeight := cmode.h;
168 end;
169 end;
172 gWinH := SDL_CreateWindow(PAnsiChar(winTitle), -1, -1, fuiScrWdt, fuiScrHgt, wFlags);
173 if (gWinH = nil) then exit;
175 gGLContext := SDL_GL_CreateContext(gWinH);
176 if (gGLContext = nil) then begin SDL_DestroyWindow(gWinH); gWinH := nil; exit; end;
178 SDL_GL_MakeCurrent(gWinH, gGLContext);
179 SDL_ShowCursor(SDL_DISABLE);
181 if assigned(oglInitCB) then oglInitCB();
183 result := true;
184 end;
187 // run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS
188 procedure mainLoop ();
189 var
190 nft, ctt: UInt64;
191 wt: Integer;
192 begin
193 if assigned(buildFrameCB) then buildFrameCB();
194 if assigned(prerenderFrameCB) then prerenderFrameCB();
195 if assigned(renderFrameCB) then renderFrameCB();
196 if assigned(postrenderFrameCB) then postrenderFrameCB();
197 glSwap();
198 lastFrameTime := fuiTimeMilli();
199 while true do
200 begin
201 // calculate time to build and render next frame
202 nft := lastFrameTime+(1000 div fuiFPS);
203 ctt := fuiTimeMilli();
204 if (ctt >= nft) then
205 begin
206 // time to build next frame
207 if assigned(buildFrameCB) then buildFrameCB();
208 if assigned(prerenderFrameCB) then prerenderFrameCB();
209 if assigned(renderFrameCB) then renderFrameCB();
210 if assigned(postrenderFrameCB) then postrenderFrameCB();
211 glSwap();
212 lastFrameTime := ctt; // ignore frame processing time
213 end
214 else
215 begin
216 // has to wait for some time
217 if (nft-ctt > 1000) then wt := 1000 else wt := Integer(nft-ctt);
218 SDL_WaitEventTimeout(nil, wt);
219 end;
220 if processMessages() then break; // just in case
221 end;
222 end;
225 initialization
226 exposeFrameCB := onExposeFrame();
228 if not sdlInit() then raise Exception.Create('cannot initialize SDL');
229 finalization
230 glDeinit();
231 SDL_Quit();
232 end.