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