DEADSOFTWARE

fix stub system driver and some warnings
[d2df-sdl.git] / src / game / g_window.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 g_window;
18 interface
20 uses
21 utils;
23 function SDLMain (): Integer;
24 procedure ResetTimer ();
25 procedure ProcessLoading (forceUpdate: Boolean=false);
27 var
28 gwin_dump_extensions: Boolean = false;
29 gwin_has_stencil: Boolean = false;
30 gwin_k8_enable_light_experiments: Boolean = false;
31 g_dbg_aimline_on: Boolean = false;
32 g_dbg_input: Boolean = False;
34 implementation
36 uses
37 {$IFDEF WINDOWS}Windows,{$ENDIF}
38 {$IFDEF ENABLE_HOLMES}
39 g_holmes, sdlcarcass, fui_ctls,
40 {$ENDIF}
41 {$INCLUDE ../nogl/noGLuses.inc}
42 SysUtils, Classes, MAPDEF, Math,
43 e_graphics, e_log, e_texture, g_main,
44 g_console, e_input, g_options, g_game,
45 g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net,
46 g_map, g_gfx, g_monsters, xprofiler,
47 g_touch, g_gui, g_system;
50 const
51 ProgressUpdateMSecs = 35; //1;//100;
53 var
54 Time, Time_Delta, Time_Old: Int64;
55 flag: Boolean;
56 wNeedTimeReset: Boolean = false;
57 wMinimized: Boolean = false;
58 wLoadingQuit: Boolean = false;
60 procedure ResetTimer ();
61 begin
62 wNeedTimeReset := true;
63 end;
65 {$IFNDEF HEADLESS}
66 var
67 prevLoadingUpdateTime: UInt64 = 0;
68 {$ENDIF}
70 procedure ProcessLoading (forceUpdate: Boolean=false);
71 {$IFNDEF HEADLESS}
72 var
73 stt: UInt64;
74 {$ENDIF}
75 begin
76 if sys_HandleInput() = True then
77 Exit;
79 {$IFNDEF HEADLESS}
80 if not wMinimized then
81 begin
82 if not forceUpdate then
83 begin
84 stt := getTimeMilli();
85 forceUpdate := (stt < prevLoadingUpdateTime) or (stt-prevLoadingUpdateTime >= ProgressUpdateMSecs);
86 end;
88 if forceUpdate then
89 begin
90 DrawMenuBackground('INTER');
91 e_DarkenQuadWH(0, 0, gScreenWidth, gScreenHeight, 150);
93 DrawLoadingStat();
94 g_Console_Draw(True);
95 sys_Repaint;
96 prevLoadingUpdateTime := getTimeMilli();
97 end;
98 end;
99 {$ENDIF}
101 e_SoundUpdate();
103 if NetMode = NET_SERVER then
104 begin
105 g_Net_Host_Update();
106 end
107 else
108 begin
109 if (NetMode = NET_CLIENT) and (NetState <> NET_STATE_AUTH) then g_Net_Client_UpdateWhileLoading();
110 end;
111 end;
114 function ProcessMessage (): Boolean;
115 var
116 i, t: Integer;
117 begin
118 result := sys_HandleInput();
120 Time := sys_GetTicks();
121 Time_Delta := Time-Time_Old;
123 flag := false;
125 if wNeedTimeReset then
126 begin
127 Time_Delta := 28;
128 wNeedTimeReset := false;
129 end;
131 g_Map_ProfilersBegin();
132 g_Mons_ProfilersBegin();
134 t := Time_Delta div 28;
135 if (t > 0) then
136 begin
137 flag := true;
138 for i := 1 to t do
139 begin
140 if (NetMode = NET_SERVER) then g_Net_Host_Update()
141 else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
142 Update();
143 end;
144 end
145 else
146 begin
147 if (NetMode = NET_SERVER) then g_Net_Host_Update()
148 else if (NetMode = NET_CLIENT) then g_Net_Client_Update();
149 end;
151 if NetMode = NET_SERVER then g_Net_Flush();
153 g_Map_ProfilersEnd();
154 g_Mons_ProfilersEnd();
156 if wLoadingQuit then
157 begin
158 g_Game_Free();
159 g_Game_Quit();
160 end;
162 if (gExit = EXIT_QUIT) then
163 begin
164 result := true;
165 exit;
166 end;
168 // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
169 if flag then
170 begin
171 Time_Old := Time - (Time_Delta mod 28);
172 if (not wMinimized) then
173 begin
174 Draw;
175 sys_Repaint
176 end
177 end
178 else
179 begin
180 sys_Delay(1) // release time slice, so we won't eat 100% CPU
181 end;
183 e_SoundUpdate();
184 end;
186 function GLExtensionList (): SSArray;
187 var s: PChar; i, j, num: GLint;
188 begin
189 result := nil;
190 s := glGetString(GL_EXTENSIONS);
191 if s <> nil then
192 begin
193 num := 0; i := 0; j := 0;
194 while s[i] <> #0 do
195 begin
196 while (s[i] <> #0) and (s[i] <> ' ') do Inc(i);
197 SetLength(result, num + 1);
198 result[num] := Copy(s, j, i - j);
199 while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
200 j := i;
201 Inc(num)
202 end
203 end
204 end;
206 function GLExtensionSupported (ext: AnsiString): Boolean;
207 var i, len: GLint; exts: SSArray;
208 begin
209 result := false;
210 exts := GLExtensionList();
211 if exts <> nil then
212 begin
213 i := 0; len := Length(exts);
214 while (i < len) and (exts[i] <> ext) do Inc(i);
215 result := i < len
216 end
217 end;
219 procedure PrintGLSupportedExtensions;
220 begin
221 e_LogWritefln('GL Vendor: %s', [glGetString(GL_VENDOR)]);
222 e_LogWritefln('GL Renderer: %s', [glGetString(GL_RENDERER)]);
223 e_LogWritefln('GL Version: %s', [glGetString(GL_VERSION)]);
224 e_LogWritefln('GL Shaders: %s', [glGetString(GL_SHADING_LANGUAGE_VERSION)]);
225 e_LogWritefln('GL Extensions: %s', [glGetString(GL_EXTENSIONS)]);
226 end;
228 function SDLMain (): Integer;
229 var
230 idx: Integer;
231 arg: AnsiString;
232 mdfo: TStream;
233 {$IFDEF ENABLE_HOLMES}
234 itmp: Integer;
235 valres: Word;
236 {$ENDIF}
237 begin
238 {$IFDEF HEADLESS}
239 e_NoGraphics := true;
240 {$ENDIF}
242 idx := 1;
243 while (idx <= ParamCount) do
244 begin
245 arg := ParamStr(idx);
246 Inc(idx);
247 if arg = '--opengl-dump-exts' then gwin_dump_extensions := true;
248 //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
249 if arg = '--jah' then g_profile_history_size := 100;
250 if arg = '--no-particles' then gpart_dbg_enabled := false;
251 if arg = '--no-los' then gmon_dbg_los_enabled := false;
253 if arg = '--profile-render' then g_profile_frame_draw := true;
254 if arg = '--profile-coldet' then g_profile_collision := true;
255 if arg = '--profile-los' then g_profile_los := true;
257 if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
258 if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
259 if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
260 if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
261 if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
262 if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
264 if arg = '--debug-input' then g_dbg_input := True;
266 {.$IF DEFINED(D2F_DEBUG)}
267 if arg = '--aimline' then g_dbg_aimline_on := true;
268 {.$ENDIF}
270 {$IFDEF ENABLE_HOLMES}
271 if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
273 if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
274 begin
275 if (idx <= ParamCount) then
276 begin
277 if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
278 Inc(idx);
279 end;
280 end;
282 if (arg = '--holmes-font') or (arg = '-holmes-font') then
283 begin
284 if (idx <= ParamCount) then
285 begin
286 itmp := 0;
287 val(ParamStr(idx), itmp, valres);
288 {$IFNDEF HEADLESS}
289 if (valres = 0) and (not g_holmes_imfunctional) then
290 begin
291 case itmp of
292 8: uiContext.font := 'win8';
293 14: uiContext.font := 'win14';
294 16: uiContext.font := 'win16';
295 end;
296 end;
297 {$ELSE}
298 // fuck off, fpc!
299 itmp := itmp;
300 valres := valres;
301 {$ENDIF}
302 Inc(idx);
303 end;
304 end;
305 {$ENDIF}
307 if (arg = '--game-scale') or (arg = '-game-scale') then
308 begin
309 if (idx <= ParamCount) then
310 begin
311 if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
312 Inc(idx);
313 end;
314 end;
316 if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
317 begin
318 mdfo := createDiskFile('mapdef.txt');
319 mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
320 mdfo.Free();
321 Halt(0);
322 end;
323 end;
325 {$IFDEF USE_SYSSTUB}
326 PrintGLSupportedExtensions;
327 glLegacyNPOT := GLExtensionSupported('GL_ARB_texture_non_power_of_two') or GLExtensionSupported('GL_OES_texture_npot');
328 {$ELSE}
329 glLegacyNPOT := False;
330 {$ENDIF}
331 e_logWritefln('NPOT textures: %s', [glLegacyNPOT]);
332 gwin_dump_extensions := false;
334 Init;
335 Time_Old := sys_GetTicks();
337 // Êîìàíäíàÿ ñòðîêà
338 if (ParamCount > 0) then g_Game_Process_Params();
340 {$IFNDEF HEADLESS}
341 // Çàïðîñ ÿçûêà
342 if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
343 {$ENDIF}
345 e_WriteLog('Entering the main loop', TMsgType.Notify);
347 // main loop
348 while not ProcessMessage() do begin end;
350 Release();
351 result := 0;
352 end;
355 initialization
356 conRegVar('d_input', @g_dbg_input, '', '')
357 end.