DEADSOFTWARE

cosmetic: yet another fix, but for rus language
[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_has_stencil: Boolean = false;
29 gwin_k8_enable_light_experiments: Boolean = false;
30 g_dbg_aimline_on: Boolean = false;
31 g_dbg_input: Boolean = False;
33 implementation
35 uses
36 {$IFDEF WINDOWS}Windows,{$ENDIF}
37 {$IFDEF ENABLE_HOLMES}
38 g_holmes, sdlcarcass, fui_ctls,
39 {$ENDIF}
40 {$INCLUDE ../nogl/noGLuses.inc}
41 SysUtils, Classes, MAPDEF, Math,
42 e_graphics, e_log, e_texture, g_main,
43 g_console, e_input, g_options, g_game,
44 g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net,
45 g_map, g_gfx, g_monsters, xprofiler,
46 g_touch, g_gui, g_system, g_netmaster;
49 const
50 ProgressUpdateMSecs = 35; //1;//100;
52 var
53 Time, Time_Delta, Time_Old: Int64;
54 Frame: 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);
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 e_SetRendertarget(True);
91 e_SetViewPort(0, 0, gScreenWidth, gScreenHeight);
93 DrawMenuBackground('INTER');
94 e_DarkenQuadWH(0, 0, gScreenWidth, gScreenHeight, 150);
95 DrawLoadingStat();
96 g_Console_Draw(True);
98 e_SetRendertarget(False);
99 e_SetViewPort(0, 0, gWinSizeX, gWinSizeY);
100 e_BlitFramebuffer(gWinSizeX, gWinSizeY);
102 sys_Repaint;
103 prevLoadingUpdateTime := getTimeMilli();
104 end;
105 end;
106 {$ENDIF}
108 e_SoundUpdate();
110 // TODO: At the moment, I left here only host network processing, because the client code must
111 // handle network events on its own. Otherwise separate network cases that use different calls to
112 // enet_host_service() WILL lose their packets (for example, resource downloading). So they have
113 // to handle everything by themselves. But in general, this MUST be removed completely, since
114 // updating the window should never affect the network. Use single enet_host_service(), period.
115 if NetMode = NET_SERVER
116 then g_Net_Host_Update();
117 end;
120 function ProcessMessage (): Boolean;
121 var
122 i, t: Integer;
123 begin
124 result := sys_HandleInput();
126 Time := sys_GetTicks();
127 Time_Delta := Time-Time_Old;
129 flag := false;
131 if wNeedTimeReset then
132 begin
133 Frame := 0;
134 Time_Delta := 28;
135 wNeedTimeReset := false;
136 end;
138 g_Map_ProfilersBegin();
139 g_Mons_ProfilersBegin();
141 t := Time_Delta div 28;
142 if (t > 0) then
143 begin
144 flag := true;
145 for i := 1 to t do
146 Update();
147 end;
149 g_Map_ProfilersEnd();
150 g_Mons_ProfilersEnd();
152 if wLoadingQuit then
153 begin
154 g_Game_Free();
155 g_Game_Quit();
156 end;
158 if (gExit = EXIT_QUIT) then
159 begin
160 result := true;
161 exit;
162 end;
164 // Âðåìÿ ïðåäûäóùåãî îáíîâëåíèÿ
165 if flag then
166 Time_Old := Time - (Time_Delta mod 28);
168 // don't wait if VSync is on, GL already probably waits enough
169 if gLerpActors then
170 flag := (Time - Frame >= gFrameTime) or gVSync;
172 if flag then
173 begin
174 if (not wMinimized) then
175 begin
176 if gPause or (not gLerpActors) or (gState = STATE_FOLD) then
177 gLerpFactor := 1.0
178 else
179 gLerpFactor := nmin(1.0, (Time - Time_Old) / 28.0);
180 Draw;
181 sys_Repaint
182 end;
183 Frame := Time
184 end
185 else
186 sys_Delay(1);
188 e_SoundUpdate();
189 end;
191 function GLExtensionList (): SSArray;
192 var
193 s: PChar;
194 i, j, num: GLint;
195 begin
196 result := nil;
197 s := glGetString(GL_EXTENSIONS);
198 if s <> nil then
199 begin
200 num := 0;
201 i := 0;
202 j := 0;
203 while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
204 while (s[i] <> #0) do
205 begin
206 while (s[i] <> #0) and (s[i] <> ' ') do Inc(i);
207 SetLength(result, num+1);
208 result[num] := Copy(s, j+1, i-j);
209 while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
210 j := i;
211 Inc(num);
212 end;
213 end;
214 end;
216 function GLExtensionSupported (ext: AnsiString): Boolean;
217 var
218 exts: SSArray;
219 e: AnsiString;
220 begin
221 result := false;
222 exts := GLExtensionList();
223 for e in exts do
224 begin
225 //writeln('<', e, '> : [', ext, '] = ', strEquCI1251(e, ext));
226 if (strEquCI1251(e, ext)) then begin result := true; exit; end;
227 end;
228 end;
230 procedure PrintGLSupportedExtensions;
231 begin
232 e_LogWritefln('GL Vendor: %s', [glGetString(GL_VENDOR)]);
233 e_LogWritefln('GL Renderer: %s', [glGetString(GL_RENDERER)]);
234 e_LogWritefln('GL Version: %s', [glGetString(GL_VERSION)]);
235 e_LogWritefln('GL Shaders: %s', [glGetString(GL_SHADING_LANGUAGE_VERSION)]);
236 e_LogWritefln('GL Extensions: %s', [glGetString(GL_EXTENSIONS)]);
237 end;
239 function SDLMain (): Integer;
240 var
241 idx: Integer;
242 arg: AnsiString;
243 mdfo: TStream;
244 {$IFDEF ENABLE_HOLMES}
245 itmp: Integer;
246 valres: Word;
247 {$ENDIF}
248 begin
249 {$IFDEF HEADLESS}
250 e_NoGraphics := true;
251 {$ENDIF}
253 idx := 1;
254 while (idx <= ParamCount) do
255 begin
256 arg := ParamStr(idx);
257 Inc(idx);
258 if arg = '--jah' then g_profile_history_size := 100;
259 if arg = '--no-particles' then gpart_dbg_enabled := false;
260 if arg = '--no-los' then gmon_dbg_los_enabled := false;
262 if arg = '--profile-render' then g_profile_frame_draw := true;
263 if arg = '--profile-coldet' then g_profile_collision := true;
264 if arg = '--profile-los' then g_profile_los := true;
266 if arg = '--no-part-phys' then gpart_dbg_phys_enabled := false;
267 if arg = '--no-part-physics' then gpart_dbg_phys_enabled := false;
268 if arg = '--no-particles-phys' then gpart_dbg_phys_enabled := false;
269 if arg = '--no-particles-physics' then gpart_dbg_phys_enabled := false;
270 if arg = '--no-particle-phys' then gpart_dbg_phys_enabled := false;
271 if arg = '--no-particle-physics' then gpart_dbg_phys_enabled := false;
273 if arg = '--debug-input' then g_dbg_input := True;
275 {.$IF DEFINED(D2F_DEBUG)}
276 if arg = '--aimline' then g_dbg_aimline_on := true;
277 {.$ENDIF}
279 {$IFDEF ENABLE_HOLMES}
280 if arg = '--holmes' then begin g_holmes_enabled := true; g_Game_SetDebugMode(); end;
282 if (arg = '--holmes-ui-scale') or (arg = '-holmes-ui-scale') then
283 begin
284 if (idx <= ParamCount) then
285 begin
286 if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0;
287 Inc(idx);
288 end;
289 end;
291 if (arg = '--holmes-font') or (arg = '-holmes-font') then
292 begin
293 if (idx <= ParamCount) then
294 begin
295 itmp := 0;
296 val(ParamStr(idx), itmp, valres);
297 {$IFNDEF HEADLESS}
298 if (valres = 0) and (not g_holmes_imfunctional) then
299 begin
300 case itmp of
301 8: uiContext.font := 'win8';
302 14: uiContext.font := 'win14';
303 16: uiContext.font := 'win16';
304 end;
305 end;
306 {$ELSE}
307 // fuck off, fpc!
308 itmp := itmp;
309 valres := valres;
310 {$ENDIF}
311 Inc(idx);
312 end;
313 end;
314 {$ENDIF}
316 if (arg = '--game-scale') or (arg = '-game-scale') then
317 begin
318 if (idx <= ParamCount) then
319 begin
320 if not conParseFloat(g_dbg_scale, ParamStr(idx)) then g_dbg_scale := 1.0;
321 Inc(idx);
322 end;
323 end;
325 if (arg = '--write-mapdef') or (arg = '-write-mapdef') then
326 begin
327 mdfo := createDiskFile('mapdef.txt');
328 mdfo.WriteBuffer(defaultMapDef[1], Length(defaultMapDef));
329 mdfo.Free();
330 Halt(0);
331 end;
333 if (arg = '--pixel-scale') or (arg = '-pixel-scale') then
334 begin
335 if (idx <= ParamCount) then
336 begin
337 if not conParseFloat(r_pixel_scale, ParamStr(idx)) then r_pixel_scale := 1.0;
338 Inc(idx);
339 end;
340 end;
341 end;
343 {$IFNDEF USE_SYSSTUB}
344 PrintGLSupportedExtensions;
345 glLegacyNPOT := not (GLExtensionSupported('GL_ARB_texture_non_power_of_two') or GLExtensionSupported('GL_OES_texture_npot'));
346 {$ELSE}
347 glLegacyNPOT := False;
348 glRenderToFBO := False;
349 {$ENDIF}
350 if glNPOTOverride and glLegacyNPOT then
351 begin
352 glLegacyNPOT := true;
353 e_logWriteln('NPOT texture emulation: FORCED');
354 end
355 else
356 begin
357 if (glLegacyNPOT) then e_logWriteln('NPOT texture emulation: enabled')
358 else e_logWriteln('NPOT texture emulation: disabled');
359 end;
361 Init;
362 Time_Old := sys_GetTicks();
364 g_Net_InitLowLevel();
366 // Êîìàíäíàÿ ñòðîêà
367 if (ParamCount > 0) then g_Game_Process_Params();
369 {$IFNDEF HEADLESS}
370 // Çàïðîñ ÿçûêà
371 if (not gGameOn) and gAskLanguage then g_Menu_AskLanguage();
372 {$ENDIF}
374 e_WriteLog('Entering the main loop', TMsgType.Notify);
376 // main loop
377 while not ProcessMessage() do begin end;
379 g_Net_Slist_ShutdownAll();
381 Release();
383 g_Net_DeinitLowLevel();
384 result := 0;
385 end;
388 initialization
389 conRegVar('d_input', @g_dbg_input, '', '')
390 end.