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