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