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