DEADSOFTWARE

update year in credits (extremely important)
[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, g_netmaster;
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
188 s: PChar;
189 i, j, num: GLint;
190 begin
191 result := nil;
192 s := glGetString(GL_EXTENSIONS);
193 if s <> nil then
194 begin
195 num := 0;
196 i := 0;
197 j := 0;
198 while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
199 while (s[i] <> #0) do
200 begin
201 while (s[i] <> #0) and (s[i] <> ' ') do Inc(i);
202 SetLength(result, num+1);
203 result[num] := Copy(s, j+1, i-j);
204 while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
205 j := i;
206 Inc(num);
207 end;
208 end;
209 end;
211 function GLExtensionSupported (ext: AnsiString): Boolean;
212 var
213 exts: SSArray;
214 e: AnsiString;
215 begin
216 result := false;
217 exts := GLExtensionList();
218 for e in exts do
219 begin
220 //writeln('<', e, '> : [', ext, '] = ', strEquCI1251(e, ext));
221 if (strEquCI1251(e, ext)) then begin result := true; exit; end;
222 end;
223 end;
225 procedure PrintGLSupportedExtensions;
226 begin
227 e_LogWritefln('GL Vendor: %s', [glGetString(GL_VENDOR)]);
228 e_LogWritefln('GL Renderer: %s', [glGetString(GL_RENDERER)]);
229 e_LogWritefln('GL Version: %s', [glGetString(GL_VERSION)]);
230 e_LogWritefln('GL Shaders: %s', [glGetString(GL_SHADING_LANGUAGE_VERSION)]);
231 e_LogWritefln('GL Extensions: %s', [glGetString(GL_EXTENSIONS)]);
232 end;
234 function SDLMain (): Integer;
235 var
236 idx: Integer;
237 arg: AnsiString;
238 mdfo: TStream;
239 {$IFDEF ENABLE_HOLMES}
240 itmp: Integer;
241 valres: Word;
242 {$ENDIF}
243 begin
244 {$IFDEF HEADLESS}
245 e_NoGraphics := true;
246 {$ENDIF}
248 idx := 1;
249 while (idx <= ParamCount) do
250 begin
251 arg := ParamStr(idx);
252 Inc(idx);
253 if arg = '--opengl-dump-exts' then gwin_dump_extensions := true;
254 //if arg = '--twinkletwinkle' then gwin_k8_enable_light_experiments := true;
255 if arg = '--jah' then g_profile_history_size := 100;
256 if arg = '--no-particles' then gpart_dbg_enabled := false;
257 if arg = '--no-los' then gmon_dbg_los_enabled := false;
259 if arg = '--profile-render' then g_profile_frame_draw := true;
260 if arg = '--profile-coldet' then g_profile_collision := true;
261 if arg = '--profile-los' then g_profile_los := true;
263 if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
264 if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
265 if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
266 if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
267 if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
268 if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
270 if arg = '--debug-input' then g_dbg_input := True;
272 {.$IF DEFINED(D2F_DEBUG)}
273 if arg = '--aimline' then g_dbg_aimline_on := true;
274 {.$ENDIF}
276 {$IFDEF ENABLE_HOLMES}
277 if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
279 if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
280 begin
281 if (idx <= ParamCount) then
282 begin
283 if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
284 Inc(idx);
285 end;
286 end;
288 if (arg = '--holmes-font') or (arg = '-holmes-font') then
289 begin
290 if (idx <= ParamCount) then
291 begin
292 itmp := 0;
293 val(ParamStr(idx), itmp, valres);
294 {$IFNDEF HEADLESS}
295 if (valres = 0) and (not g_holmes_imfunctional) then
296 begin
297 case itmp of
298 8: uiContext.font := 'win8';
299 14: uiContext.font := 'win14';
300 16: uiContext.font := 'win16';
301 end;
302 end;
303 {$ELSE}
304 // fuck off, fpc!
305 itmp := itmp;
306 valres := valres;
307 {$ENDIF}
308 Inc(idx);
309 end;
310 end;
311 {$ENDIF}
313 if (arg = '--game-scale') or (arg = '-game-scale') then
314 begin
315 if (idx <= ParamCount) then
316 begin
317 if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
318 Inc(idx);
319 end;
320 end;
322 if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
323 begin
324 mdfo := createDiskFile('mapdef.txt');
325 mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
326 mdfo.Free();
327 Halt(0);
328 end;
329 end;
331 {$IFNDEF USE_SYSSTUB}
332 PrintGLSupportedExtensions;
333 glLegacyNPOT := not (GLExtensionSupported('GL_ARB_texture_non_power_of_two') or GLExtensionSupported('GL_OES_texture_npot'));
334 {$ELSE}
335 glLegacyNPOT := False;
336 {$ENDIF}
337 if glNPOTOverride and glLegacyNPOT then
338 begin
339 glLegacyNPOT := true;
340 e_logWriteln('NPOT texture emulation: FORCED');
341 end
342 else
343 begin
344 if (glLegacyNPOT) then e_logWriteln('NPOT texture emulation: enabled')
345 else e_logWriteln('NPOT texture emulation: disabled');
346 end;
347 gwin_dump_extensions := false;
349 Init;
350 Time_Old := sys_GetTicks();
352 g_Net_InitLowLevel();
354 // Êîìàíäíàÿ ñòðîêà
355 if (ParamCount > 0) then g_Game_Process_Params();
357 {$IFNDEF HEADLESS}
358 // Çàïðîñ ÿçûêà
359 if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
360 {$ENDIF}
362 e_WriteLog('Entering the main loop', TMsgType.Notify);
364 // main loop
365 while not ProcessMessage() do begin end;
367 g_Net_Slist_ShutdownAll();
369 Release();
371 g_Net_DeinitLowLevel();
372 result := 0;
373 end;
376 initialization
377 conRegVar('d_input', @g_dbg_input, '', '')
378 end.