DEADSOFTWARE

default to using FBO; can be disabled via command line
[d2df-sdl.git] / src / game / sdl / g_system.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_system;
18 interface
20 uses Utils;
22 (* --- Utils --- *)
23 function sys_GetTicks (): Int64;
24 procedure sys_Delay (ms: Integer);
26 (* --- Graphics --- *)
27 function sys_GetDisplayModes (bpp: Integer): SSArray;
28 function sys_SetDisplayMode (w, h, bpp: Integer; fullscreen, maximized: Boolean): Boolean;
29 procedure sys_EnableVSync (yes: Boolean);
30 procedure sys_Repaint;
32 (* --- Input --- *)
33 function sys_HandleInput (): Boolean;
34 procedure sys_RequestQuit;
36 (* --- Init --- *)
37 procedure sys_Init;
38 procedure sys_Final;
40 implementation
42 uses
43 SysUtils, SDL, Math,
44 {$INCLUDE ../nogl/noGLuses.inc}
45 e_log, e_graphics, e_input, e_sound,
46 g_options, g_window, g_console, g_game, g_menu, g_gui, g_main, g_basic;
48 const
49 GameTitle = 'Doom 2D: Forever (SDL 1.2, %s)';
51 var
52 userResize: Boolean;
53 modeResize: Integer;
54 screen: PSDL_Surface;
55 JoystickHandle: array [0..e_MaxJoys - 1] of PSDL_Joystick;
56 JoystickHatState: array [0..e_MaxJoys - 1, 0..e_MaxJoyHats - 1, HAT_LEFT..HAT_DOWN] of Boolean;
57 JoystickZeroAxes: array [0..e_MaxJoys - 1, 0..e_MaxJoyAxes - 1] of Integer;
59 (* --------- Utils --------- *)
61 function sys_GetTicks (): Int64;
62 begin
63 result := SDL_GetTicks()
64 end;
66 procedure sys_Delay (ms: Integer);
67 begin
68 SDL_Delay(ms)
69 end;
71 (* --------- Graphics --------- *)
73 procedure UpdateSize (w, h: Integer);
74 begin
75 gWinSizeX := w;
76 gWinSizeY := h;
77 gRC_Width := w;
78 gRC_Height := h;
79 if glRenderToFBO then
80 begin
81 // store real window size in gWinSize, downscale resolution now
82 w := round(w / r_pixel_scale);
83 h := round(h / r_pixel_scale);
84 e_ResizeFramebuffer(w, h);
85 end;
86 gScreenWidth := w;
87 gScreenHeight := h;
88 {$IFDEF ENABLE_HOLMES}
89 fuiScrWdt := w;
90 fuiScrHgt := h;
91 {$ENDIF}
92 e_ResizeWindow(w, h);
93 e_InitGL;
94 g_Game_SetupScreenSize;
95 g_Menu_Reset;
96 g_Game_ClearLoading;
97 end;
99 function GetTitle (): PChar;
100 var info: AnsiString;
101 begin
102 info := g_GetBuildHash(false);
103 if info = 'custom build' then
104 info := info + ' by ' + g_GetBuilderName() + ' ' + GAME_BUILDDATE + ' ' + GAME_BUILDTIME;
105 result := PChar(Format(GameTitle, [info]))
106 end;
108 function InitWindow (w, h, bpp: Integer; fullScreen: Boolean): Boolean;
109 var flags: Uint32;
110 begin
111 e_LogWritefln('InitWindow %s %s %s %s', [w, h, bpp, fullScreen]);
112 result := false;
113 SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
114 SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
115 SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
116 SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
117 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
118 SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 8); // lights; it is enough to have 1-bit stencil buffer for lighting, but...
119 flags := SDL_OPENGL;
120 if fullScreen then flags := flags or SDL_FULLSCREEN;
121 if userResize then flags := flags or SDL_VIDEORESIZE;
122 if (screen = nil) or (SDL_VideoModeOk(w, h, bpp, flags) <> 0) then
123 begin
124 SDL_FreeSurface(screen);
125 screen := SDL_SetVideoMode(w, h, bpp, flags);
126 if screen <> nil then
127 begin
128 {$IFDEF NOGL_INIT}
129 nogl_Init;
130 if glRenderToFBO and (not nogl_ExtensionSupported('GL_OES_framebuffer_object')) then
131 {$ELSE}
132 if glRenderToFBO and (not Load_GL_ARB_framebuffer_object()) then
133 {$ENDIF}
134 begin
135 e_LogWriteln('SDL: no framebuffer object support detected');
136 glRenderToFBO := False
137 end;
138 SDL_WM_SetCaption(GetTitle(), nil);
139 gFullScreen := fullscreen;
140 gRC_FullScreen := fullscreen;
141 UpdateSize(w, h);
142 result := True
143 end
144 end
145 else
146 begin
147 e_LogWritefln('SDL: video mode not supported', [])
148 end
149 end;
151 procedure sys_Repaint;
152 begin
153 if glRenderToFBO then
154 e_BlitFramebuffer(gWinSizeX, gWinSizeY);
155 SDL_GL_SwapBuffers
156 end;
158 procedure sys_EnableVSync (yes: Boolean);
159 begin
160 (* ??? *)
161 end;
163 function sys_GetDisplayModes (bpp: Integer): SSArray;
164 var m: PPSDL_Rect; f: TSDL_PixelFormat; i, count: Integer;
165 begin
166 SetLength(result, 0);
167 FillChar(f, sizeof(f), 0);
168 f.palette := nil;
169 f.BitsPerPixel := bpp;
170 f.BytesPerPixel := (bpp + 7) div 8;
171 m := SDL_ListModes(@f, SDL_OPENGL or SDL_FULLSCREEN);
172 if (m <> NIL) and (UIntPtr(m) <> UIntPtr(-1)) then
173 begin
174 count := 0;
175 while m[count] <> nil do inc(count);
176 SetLength(result, count);
177 for i := 0 to count - 1 do
178 result[i] := IntToStr(m[i].w) + 'x' + IntToStr(m[i].h);
179 end
180 end;
182 function sys_SetDisplayMode (w, h, bpp: Integer; fullscreen, maximized: Boolean): Boolean;
183 begin
184 result := InitWindow(w, h, bpp, fullscreen)
185 end;
187 (* --------- Joystick --------- *)
189 procedure HandleJoyButton (var ev: TSDL_JoyButtonEvent);
190 var down: Boolean; key: Integer;
191 begin
192 if (ev.which < e_MaxJoys) and (ev.button < e_MaxJoyBtns) then
193 begin
194 key := e_JoyButtonToKey(ev.which, ev.button);
195 down := ev.type_ = SDL_JOYBUTTONDOWN;
196 if g_dbg_input then
197 e_LogWritefln('Input Debug: jbutton, joy=%s, button=%s, keycode=%s, press=%s', [ev.which, ev.button, key, down]);
198 e_KeyUpDown(key, down);
199 g_Console_ProcessBind(key, down)
200 end
201 else
202 begin
203 if g_dbg_input then
204 begin
205 down := ev.type_ = SDL_JOYBUTTONDOWN;
206 e_LogWritefln('Input Debug: NOT IN RANGE! jbutton, joy=%s, button=%s, press=%s', [ev.which, ev.button, down])
207 end
208 end
209 end;
211 procedure HandleJoyAxis (var ev: TSDL_JoyAxisEvent);
212 var key, minuskey: Integer;
213 begin
214 if (ev.which < e_MaxJoys) and (ev.axis < e_MaxJoyAxes) then
215 begin
216 key := e_JoyAxisToKey(ev.which, ev.axis, AX_PLUS);
217 minuskey := e_JoyAxisToKey(ev.which, ev.axis, AX_MINUS);
219 if g_dbg_input then
220 e_LogWritefln('Input Debug: jaxis, joy=%s, axis=%s, value=%s, zeroaxes=%s, deadzone=%s', [ev.which, ev.axis, ev.value, JoystickZeroAxes[ev.which, ev.axis], e_JoystickDeadzones[ev.which]]);
222 if ev.value < JoystickZeroAxes[ev.which, ev.axis] - e_JoystickDeadzones[ev.which] then
223 begin
224 if (e_KeyPressed(key)) then
225 begin
226 e_KeyUpDown(key, False);
227 g_Console_ProcessBind(key, False)
228 end;
229 e_KeyUpDown(minuskey, True);
230 g_Console_ProcessBind(minuskey, True)
231 end
232 else if ev.value > JoystickZeroAxes[ev.which, ev.axis] + e_JoystickDeadzones[ev.which] then
233 begin
234 if (e_KeyPressed(minuskey)) then
235 begin
236 e_KeyUpDown(minuskey, False);
237 g_Console_ProcessBind(minuskey, False)
238 end;
239 e_KeyUpDown(key, True);
240 g_Console_ProcessBind(key, True)
241 end
242 else
243 begin
244 if (e_KeyPressed(minuskey)) then
245 begin
246 e_KeyUpDown(minuskey, False);
247 g_Console_ProcessBind(minuskey, False)
248 end;
249 if (e_KeyPressed(key)) then
250 begin
251 e_KeyUpDown(key, False);
252 g_Console_ProcessBind(key, False)
253 end
254 end
255 end
256 else
257 begin
258 if g_dbg_input then
259 e_LogWritefln('Input Debug: NOT IN RANGE! jaxis, joy=%s, axis=%s, value=%s, zeroaxes=%s, deadzone=%s', [ev.which, ev.axis, ev.value, JoystickZeroAxes[ev.which, ev.axis], e_JoystickDeadzones[ev.which]])
260 end
261 end;
263 procedure HandleJoyHat (var ev: TSDL_JoyHatEvent);
264 var
265 down: Boolean;
266 i, key: Integer;
267 hat: array [HAT_LEFT..HAT_DOWN] of Boolean;
268 begin
269 if (ev.which < e_MaxJoys) and (ev.hat < e_MaxJoyHats) then
270 begin
271 if g_dbg_input then
272 e_LogWritefln('Input Debug: jhat, joy=%s, hat=%s, value=%s', [ev.which, ev.hat, ev.value]);
273 hat[HAT_UP] := LongBool(ev.value and SDL_HAT_UP);
274 hat[HAT_DOWN] := LongBool(ev.value and SDL_HAT_DOWN);
275 hat[HAT_LEFT] := LongBool(ev.value and SDL_HAT_LEFT);
276 hat[HAT_RIGHT] := LongBool(ev.value and SDL_HAT_RIGHT);
277 for i := HAT_LEFT to HAT_DOWN do
278 begin
279 if JoystickHatState[ev.which, ev.hat, i] <> hat[i] then
280 begin
281 down := hat[i];
282 key := e_JoyHatToKey(ev.which, ev.hat, i);
283 e_KeyUpDown(key, down);
284 g_Console_ProcessBind(key, down)
285 end
286 end;
287 JoystickHatState[ev.which, ev.hat] := hat
288 end
289 else
290 begin
291 if g_dbg_input then
292 e_LogWritefln('Input Debug: NOT IN RANGE! jhat, joy=%s, hat=%s, value=%s', [ev.which, ev.hat, ev.value])
293 end
294 end;
296 procedure AddJoystick (which: Integer);
297 var i: Integer;
298 begin
299 assert(which < e_MaxJoys);
300 JoystickHandle[which] := SDL_JoystickOpen(which);
301 if JoystickHandle[which] <> nil then
302 begin
303 e_LogWritefln('Added Joystick %s', [which]);
304 e_JoystickAvailable[which] := True;
305 for i := 0 to Min(SDL_JoystickNumAxes(JoystickHandle[which]), e_MaxJoyAxes) - 1 do
306 JoystickZeroAxes[which, i] := SDL_JoystickGetAxis(JoystickHandle[which], i)
307 end
308 else
309 begin
310 e_LogWritefln('Failed to open Joystick %s', [which])
311 end
312 end;
314 procedure RemoveJoystick (which: Integer);
315 begin
316 assert(which < e_MaxJoys);
317 e_LogWritefln('Remove Joystick %s', [which]);
318 e_JoystickAvailable[which] := False;
319 if JoystickHandle[which] <> nil then
320 SDL_JoystickClose(JoystickHandle[which]);
321 JoystickHandle[which] := nil
322 end;
324 (* --------- Input --------- *)
326 function Key2Stub (key: Integer): Integer;
327 var x: Integer;
328 begin
329 case key of
330 SDLK_ESCAPE: x := IK_ESCAPE;
331 SDLK_RETURN: x := IK_RETURN;
332 SDLK_KP_ENTER: x := IK_KPRETURN;
333 SDLK_KP0: x := IK_KPINSERT;
334 SDLK_UP: x := IK_UP;
335 SDLK_KP8: x := IK_KPUP;
336 SDLK_DOWN: x := IK_DOWN;
337 SDLK_KP2: x := IK_KPDOWN;
338 SDLK_LEFT: x := IK_LEFT;
339 SDLK_KP4: x := IK_KPLEFT;
340 SDLK_RIGHT: x := IK_RIGHT;
341 SDLK_KP6: x := IK_KPRIGHT;
342 SDLK_DELETE: x := IK_DELETE;
343 SDLK_HOME: x := IK_HOME;
344 SDLK_KP7: x := IK_KPHOME;
345 SDLK_INSERT: x := IK_INSERT;
346 SDLK_SPACE: x := IK_SPACE;
347 SDLK_LSHIFT: x := IK_SHIFT;
348 SDLK_LALT: x := IK_ALT;
349 SDLK_TAB: x := IK_TAB;
350 SDLK_PAGEUP: x := IK_PAGEUP;
351 SDLK_KP9: x := IK_KPPAGEUP;
352 SDLK_PAGEDOWN: x := IK_PAGEDN;
353 SDLK_KP3: x := IK_KPPAGEDN;
354 SDLK_KP5: x := IK_KP5;
355 SDLK_NUMLOCK: x := IK_NUMLOCK;
356 SDLK_KP_DIVIDE: x := IK_KPDIVIDE;
357 SDLK_KP_MULTIPLY: x := IK_KPMULTIPLE;
358 SDLK_KP_MINUS: x := IK_KPMINUS;
359 SDLK_KP_PLUS: x := IK_KPPLUS;
360 SDLK_KP_PERIOD: x := IK_KPDOT;
361 SDLK_CAPSLOCK: x := IK_CAPSLOCK;
362 SDLK_RSHIFT: x := IK_RSHIFT;
363 SDLK_LCTRL: x := IK_CTRL;
364 SDLK_RCTRL: x := IK_RCTRL;
365 SDLK_RALT: x := IK_RALT;
366 SDLK_LSUPER: x := IK_WIN;
367 SDLK_RSUPER: x := IK_RWIN;
368 SDLK_MENU: x := IK_MENU;
369 SDLK_PRINT: x := IK_PRINTSCR;
370 SDLK_SCROLLOCK: x := IK_SCROLLLOCK;
371 SDLK_LEFTBRACKET: x := IK_LBRACKET;
372 SDLK_RIGHTBRACKET: x := IK_RBRACKET;
373 SDLK_SEMICOLON: x := IK_SEMICOLON;
374 SDLK_QUOTE: x := IK_QUOTE;
375 SDLK_BACKSLASH: x := IK_BACKSLASH;
376 SDLK_SLASH: x := IK_SLASH;
377 SDLK_COMMA: x := IK_COMMA;
378 SDLK_PERIOD: x := IK_DOT;
379 SDLK_EQUALS: x := IK_EQUALS;
380 SDLK_0: x := IK_0;
381 SDLK_1: x := IK_1;
382 SDLK_2: x := IK_2;
383 SDLK_3: x := IK_3;
384 SDLK_4: x := IK_4;
385 SDLK_5: x := IK_5;
386 SDLK_6: x := IK_6;
387 SDLK_7: x := IK_7;
388 SDLK_8: x := IK_8;
389 SDLK_9: x := IK_9;
390 SDLK_F1: x := IK_F1;
391 SDLK_F2: x := IK_F2;
392 SDLK_F3: x := IK_F3;
393 SDLK_F4: x := IK_F4;
394 SDLK_F5: x := IK_F5;
395 SDLK_F6: x := IK_F6;
396 SDLK_F7: x := IK_F7;
397 SDLK_F8: x := IK_F8;
398 SDLK_F9: x := IK_F9;
399 SDLK_F10: x := IK_F10;
400 SDLK_F11: x := IK_F11;
401 SDLK_F12: x := IK_F12;
402 SDLK_END: x := IK_END;
403 SDLK_KP1: x := IK_KPEND;
404 SDLK_BACKSPACE: x := IK_BACKSPACE;
405 SDLK_BACKQUOTE: x := IK_BACKQUOTE;
406 SDLK_PAUSE: x := IK_PAUSE;
407 SDLK_A..SDLK_Z: x := IK_A + (key - SDLK_A);
408 SDLK_MINUS: x := IK_MINUS;
409 SDLK_RMETA: x := IK_RMETA;
410 SDLK_LMETA: x := IK_LMETA;
411 else
412 x := IK_INVALID
413 end;
414 result := x
415 end;
417 procedure HandleKeyboard (var ev: TSDL_KeyboardEvent);
418 var down, repeated: Boolean; key: Integer; ch: Char;
419 begin
420 key := Key2Stub(ev.keysym.sym);
421 down := (ev.type_ = SDL_KEYDOWN);
422 repeated := down and e_KeyPressed(key);
423 ch := wchar2win(WideChar(ev.keysym.unicode));
424 if g_dbg_input then
425 e_LogWritefln('Input Debug: keysym, down=%s, sym=%s, state=%s, unicode=%s, stubsym=%s, cp1251=%s', [down, ev.keysym.sym, ev.state, ev.keysym.unicode, key, Ord(ch)]);
426 if not repeated then
427 begin
428 e_KeyUpDown(key, down);
429 g_Console_ProcessBind(key, down);
430 end
431 else if gConsoleShow or gChatShow or (g_ActiveWindow <> nil) then
432 begin
433 KeyPress(key) // key repeat in menus and shit
434 end;
435 if down and IsValid1251(ev.keysym.unicode) and IsPrintable1251(ch) then
436 CharPress(ch)
437 end;
439 procedure HandleResize (var ev: TSDL_ResizeEvent);
440 begin
441 if g_dbg_input then
442 e_LogWritefln('Input Debug: SDL_VIDEORESIZE %s %s', [ev.w, ev.h]);
443 if modeResize = 1 then
444 UpdateSize(ev.w, ev.h)
445 else if modeResize > 1 then
446 InitWindow(ev.w, ev.h, gBPP, gFullscreen)
447 end;
449 function sys_HandleInput (): Boolean;
450 var ev: TSDL_Event;
451 begin
452 result := false;
453 while SDL_PollEvent(@ev) <> 0 do
454 begin
455 case ev.type_ of
456 SDL_QUITEV: result := true;
457 SDL_VIDEORESIZE: HandleResize(ev.resize);
458 SDL_KEYUP, SDL_KEYDOWN: HandleKeyboard(ev.key);
459 SDL_JOYBUTTONDOWN, SDL_JOYBUTTONUP: HandleJoyButton(ev.jbutton);
460 SDL_JOYAXISMOTION: HandleJoyAxis(ev.jaxis);
461 SDL_JOYHATMOTION: HandleJoyHat(ev.jhat);
462 SDL_VIDEOEXPOSE: sys_Repaint;
463 SDL_ACTIVEEVENT: e_MuteChannels((ev.active.gain = 0) and gMuteWhenInactive);
464 end
465 end
466 end;
468 procedure sys_RequestQuit;
469 var ev: TSDL_Event;
470 begin
471 ev.quit.type_ := SDL_QUITEV;
472 SDL_PushEvent(@ev)
473 end;
475 (* --------- Init --------- *)
477 procedure sys_Init;
478 var flags: Uint32; i: Integer;
479 begin
480 e_WriteLog('Init SDL', TMsgType.Notify);
481 flags := SDL_INIT_VIDEO or SDL_INIT_AUDIO or
482 SDL_INIT_TIMER or SDL_INIT_JOYSTICK
483 (*or SDL_INIT_NOPARACHUTE*);
484 if SDL_Init(flags) <> 0 then
485 raise Exception.Create('SDL: Init failed: ' + SDL_GetError);
486 SDL_EnableUNICODE(1);
487 SDL_EnableKeyRepeat(SDL_DEFAULT_REPEAT_DELAY, SDL_DEFAULT_REPEAT_INTERVAL);
488 for i := 0 to e_MaxJoys - 1 do
489 AddJoystick(i)
490 end;
492 procedure sys_Final;
493 var i: Integer;
494 begin
495 e_WriteLog('Releasing SDL', TMsgType.Notify);
496 for i := 0 to e_MaxJoys - 1 do
497 RemoveJoystick(i);
498 if screen <> nil then
499 begin
500 {$IFDEF NOGL_INIT}
501 nogl_Quit;
502 {$ENDIF}
503 SDL_FreeSurface(screen)
504 end;
505 SDL_Quit
506 end;
508 initialization
509 (* window resize are broken both on linux and osx, so disabled by default *)
510 conRegVar('sdl_allow_resize', @userResize, 'allow to resize window by user', 'allow to resize window by user');
511 conRegVar('sdl_resize_action', @modeResize, 'set window resize mode (0: ignore, 1: change, 2: reset)', '');
512 userResize := false;
513 modeResize := 0;
514 end.