src/game/sdl2/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: 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, SDL2, Math,
  44     e_log, e_graphics, e_input, e_sound,
  45     {$INCLUDE ../nogl/noGLuses.inc}
  46     {$IFDEF ENABLE_HOLMES}
  47       g_holmes, sdlcarcass, fui_ctls,
  48     {$ENDIF}
  49     g_touch, g_options, g_window, g_console, g_game, g_menu, g_gui, g_main;
  50
  51   const
  52     GameTitle = 'Doom 2D: Forever (SDL 2)';
  53
  54   var
  55     window: PSDL_Window;
  56     context: TSDL_GLContext;
  57     display: Integer;
  58     JoystickHandle: array [0..e_MaxJoys - 1] of PSDL_Joystick;
  59     JoystickHatState: array [0..e_MaxJoys - 1, 0..e_MaxJoyHats - 1, HAT_LEFT..HAT_DOWN] of Boolean;
  60     JoystickZeroAxes: array [0..e_MaxJoys - 1, 0..e_MaxJoyAxes - 1] of Integer;
  61
  62   (* --------- Utils --------- *)
  63
  64   function sys_GetTicks (): Int64;
  65   begin
  66     result := SDL_GetTicks()
  67   end;
  68
  69   procedure sys_Delay (ms: Integer);
  70   begin
  71     SDL_Delay(ms)
  72   end;
  73
  74   (* --------- Graphics --------- *)
  75
  76   procedure UpdateSize (w, h: Integer);
  77   begin
  78     gWinSizeX := w;
  79     gWinSizeY := h;
  80     gWinRealPosX := 0;
  81     gWinRealPosY := 0;
  82     gScreenWidth := w;
  83     gScreenHeight := h;
  84     {$IFDEF ENABLE_HOLMES}
  85       fuiScrWdt := w;
  86       fuiScrHgt := h;
  87     {$ENDIF}
  88     e_ResizeWindow(w, h);
  89     e_InitGL;
  90     g_Game_SetupScreenSize;
  91     {$IFNDEF ANDOIRD}
  92       (* This will fix menu reset on keyboard showing *)
  93       g_Menu_Reset;
  94     {$ENDIF}
  95     g_Game_ClearLoading;
  96     {$IFDEF ENABLE_HOLMES}
  97       if assigned(oglInitCB) then oglInitCB;
  98     {$ENDIF}
  99   end;
 100
 101   function InitWindow (w, h, bpp: Integer; fullScreen: Boolean): Boolean;
 102     var flags: UInt32;
 103   begin
 104     // note: on window close make: if assigned(oglDeinitCB) then oglDeinitCB;
 105     e_LogWritefln('InitWindow %s %s %s %s', [w, h, bpp, fullScreen]);
 106     result := false;
 107     if window = nil then
 108     begin
 109       {$IFDEF USE_GLES1}
 110         SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 1);
 111         SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
 112         SDL_GL_SetAttribute(SDL_GL_CONTEXT_PROFILE_MASK, SDL_GL_CONTEXT_PROFILE_ES);
 113       {$ELSE}
 114         SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
 115         SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
 116         SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
 117         SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
 118         SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
 119         SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
 120         SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
 121         SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 8); // lights; it is enough to have 1-bit stencil buffer for lighting, but...
 122       {$ENDIF}
 123       flags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE;
 124       if fullScreen then flags := flags or SDL_WINDOW_FULLSCREEN;
 125       window := SDL_CreateWindow(GameTitle, SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED, w, h, flags);
 126       if window <> nil then
 127       begin
 128         context := SDL_GL_CreateContext(window);
 129         if context <> nil then
 130         begin
 131           {$IFDEF NOGL_INIT}
 132             nogl_Init;
 133           {$ENDIF}
 134           UpdateSize(w, h);
 135           result := true
 136         end
 137         else
 138         begin
 139           e_LogWritefln('SDL: unable to create OpenGL context: %s', [SDL_GetError])
 140         end
 141       end
 142       else
 143       begin
 144         e_LogWritefln('SDL: unable to create window: %s', [SDL_GetError])
 145       end
 146     end
 147     else
 148     begin
 149       if fullScreen then flags := SDL_WINDOW_FULLSCREEN else flags := 0;
 150       SDL_SetWindowSize(window, w, h);
 151       SDL_SetWindowFullscreen(window, flags);
 152       UpdateSize(w, h);
 153       result := true
 154     end
 155   end;
 156
 157   procedure sys_Repaint;
 158   begin
 159     SDL_GL_SwapWindow(window)
 160   end;
 161
 162   procedure sys_EnableVSync (yes: Boolean);
 163   begin
 164     if yes then
 165       SDL_GL_SetSwapInterval(1)
 166     else
 167       SDL_GL_SetSwapInterval(0)
 168   end;
 169
 170   function sys_GetDisplayModes (bpp: Integer): SSArray;
 171     var i, count, num, pw, ph: Integer; m: TSDL_DisplayMode;
 172   begin
 173     result := nil;
 174     num := SDL_GetNumDisplayModes(display);
 175     if num < 0 then
 176       e_LogWritefln('SDL: unable to get numer of available display modes: %s', [SDL_GetError]);
 177     if num > 0 then
 178     begin
 179       e_LogWritefln('Video modes for display %s:', [display]);
 180       SetLength(result, num);
 181       i := 0; count := 0; pw := 0; ph := 0;
 182       while i < num do
 183       begin
 184         SDL_GetDisplayMode(display, i, @m);
 185         if ((pw <> m.w) or (ph <> m.h)) then
 186         begin
 187           e_LogWritefln('* %sx%sx%s@%s', [m.w, m.h, SDL_BITSPERPIXEL(m.format), m.refresh_rate]);
 188           pw := m.w; ph := m.h;
 189           result[count] := IntToStr(m.w) + 'x' + IntToStr(m.h);
 190           Inc(count);
 191         end
 192         else
 193         begin
 194           e_LogWritefln('- %sx%sx%s@%s', [m.w, m.h, SDL_BITSPERPIXEL(m.format), m.refresh_rate]);
 195         end;
 196         Inc(i)
 197       end;
 198       SetLength(result, count)
 199     end
 200   end;
 201
 202   function sys_SetDisplayMode (w, h, bpp: Integer; fullScreen: Boolean): Boolean;
 203   begin
 204     result := InitWindow(w, h, bpp, fullScreen)
 205   end;
 206
 207   (* --------- Joystick --------- *)
 208
 209   procedure HandleJoyButton (var ev: TSDL_JoyButtonEvent);
 210     var down: Boolean; key: Integer;
 211   begin
 212     if (ev.which < e_MaxJoys) and (ev.button < e_MaxJoyBtns) then
 213     begin
 214       key := e_JoyButtonToKey(ev.which, ev.button);
 215       down := ev.type_ = SDL_JOYBUTTONDOWN;
 216       if g_dbg_input then
 217         e_LogWritefln('Input Debug: jbutton, joy=%s, button=%s, keycode=%s, press=%s', [ev.which, ev.button, key, down]);
 218       e_KeyUpDown(key, down);
 219       g_Console_ProcessBind(key, down)
 220     end
 221     else
 222     begin
 223       if g_dbg_input then
 224       begin
 225         down := ev.type_ = SDL_JOYBUTTONDOWN;
 226         e_LogWritefln('Input Debug: NOT IN RANGE! jbutton, joy=%s, button=%s, press=%s', [ev.which, ev.button, down])
 227       end
 228     end
 229   end;
 230
 231   procedure HandleJoyAxis (var ev: TSDL_JoyAxisEvent);
 232     var key, minuskey: Integer;
 233   begin
 234     if (ev.which < e_MaxJoys) and (ev.axis < e_MaxJoyAxes) then
 235     begin
 236       key := e_JoyAxisToKey(ev.which, ev.axis, AX_PLUS);
 237       minuskey := e_JoyAxisToKey(ev.which, ev.axis, AX_MINUS);
 238
 239       if g_dbg_input then
 240           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]]);
 241
 242       if ev.value < JoystickZeroAxes[ev.which, ev.axis] - e_JoystickDeadzones[ev.which] then
 243       begin
 244         if (e_KeyPressed(key)) then
 245         begin
 246           e_KeyUpDown(key, False);
 247           g_Console_ProcessBind(key, False)
 248         end;
 249         e_KeyUpDown(minuskey, True);
 250         g_Console_ProcessBind(minuskey, True)
 251       end
 252       else if ev.value > JoystickZeroAxes[ev.which, ev.axis] + e_JoystickDeadzones[ev.which] then
 253       begin
 254         if (e_KeyPressed(minuskey)) then
 255         begin
 256           e_KeyUpDown(minuskey, False);
 257           g_Console_ProcessBind(minuskey, False)
 258         end;
 259         e_KeyUpDown(key, True);
 260         g_Console_ProcessBind(key, True)
 261       end
 262       else
 263       begin
 264         if (e_KeyPressed(minuskey)) then
 265         begin
 266           e_KeyUpDown(minuskey, False);
 267           g_Console_ProcessBind(minuskey, False)
 268         end;
 269         if (e_KeyPressed(key)) then
 270         begin
 271           e_KeyUpDown(key, False);
 272           g_Console_ProcessBind(key, False)
 273         end
 274       end
 275     end
 276     else
 277     begin
 278       if g_dbg_input then
 279         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]])
 280     end
 281   end;
 282
 283   procedure HandleJoyHat (var ev: TSDL_JoyHatEvent);
 284     var
 285       down: Boolean;
 286       i, key: Integer;
 287       hat: array [HAT_LEFT..HAT_DOWN] of Boolean;
 288   begin
 289     if (ev.which < e_MaxJoys) and (ev.hat < e_MaxJoyHats) then
 290     begin
 291       if g_dbg_input then
 292         e_LogWritefln('Input Debug: jhat, joy=%s, hat=%s, value=%s', [ev.which, ev.hat, ev.value]);
 293       hat[HAT_UP] := LongBool(ev.value and SDL_HAT_UP);
 294       hat[HAT_DOWN] := LongBool(ev.value and SDL_HAT_DOWN);
 295       hat[HAT_LEFT] := LongBool(ev.value and SDL_HAT_LEFT);
 296       hat[HAT_RIGHT] := LongBool(ev.value and SDL_HAT_RIGHT);
 297       for i := HAT_LEFT to HAT_DOWN do
 298       begin
 299         if JoystickHatState[ev.which, ev.hat, i] <> hat[i] then
 300         begin
 301           down := hat[i];
 302           key := e_JoyHatToKey(ev.which, ev.hat, i);
 303           e_KeyUpDown(key, down);
 304           g_Console_ProcessBind(key, down)
 305         end
 306       end;
 307       JoystickHatState[ev.which, ev.hat] := hat
 308     end
 309     else
 310     begin
 311       if g_dbg_input then
 312         e_LogWritefln('Input Debug: NOT IN RANGE! jhat, joy=%s, hat=%s, value=%s', [ev.which, ev.hat, ev.value])
 313     end
 314   end;
 315
 316   procedure HandleJoyAdd (var ev: TSDL_JoyDeviceEvent);
 317     var i: Integer;
 318   begin
 319     if (ev.which < e_MaxJoys) then
 320     begin
 321       JoystickHandle[ev.which] := SDL_JoystickOpen(ev.which);
 322       if JoystickHandle[ev.which] <> nil then
 323       begin
 324         e_LogWritefln('Added Joystick %s', [ev.which]);
 325         e_JoystickAvailable[ev.which] := True;
 326         for i := 0 to Min(SDL_JoystickNumAxes(JoystickHandle[ev.which]), e_MaxJoyAxes) - 1 do
 327           JoystickZeroAxes[ev.which, i] := SDL_JoystickGetAxis(JoystickHandle[ev.which], i)
 328       end
 329       else
 330       begin
 331         e_LogWritefln('Warning! Failed to open Joystick %s', [ev.which])
 332       end
 333     end
 334     else
 335     begin
 336       e_LogWritefln('Warning! Added Joystick %s, but we support only <= %s', [ev.which, e_MaxJoys])
 337     end
 338   end;
 339
 340   procedure HandleJoyRemove (var ev: TSDL_JoyDeviceEvent);
 341   begin
 342     e_LogWritefln('Removed Joystick %s', [ev.which]);
 343     if (ev.which < e_MaxJoys) then
 344     begin
 345       e_JoystickAvailable[ev.which] := False;
 346       if JoystickHandle[ev.which] <> nil then
 347         SDL_JoystickClose(JoystickHandle[ev.which]);
 348       JoystickHandle[ev.which] := nil
 349     end
 350   end;
 351
 352   (* --------- Input --------- *)
 353
 354   function HandleWindow (var ev: TSDL_WindowEvent): Boolean;
 355   begin
 356     result := false;
 357     case ev.event of
 358       SDL_WINDOWEVENT_RESIZED: UpdateSize(ev.data1, ev.data2);
 359       SDL_WINDOWEVENT_EXPOSED: sys_Repaint;
 360       SDL_WINDOWEVENT_CLOSE: result := true;
 361       SDL_WINDOWEVENT_FOCUS_LOST, SDL_WINDOWEVENT_MINIMIZED:
 362         begin
 363           e_UnpressAllKeys;
 364           if gMuteWhenInactive then
 365             e_MuteChannels(true);
 366           {$IFDEF ENABLE_HOLMES}
 367             if assigned(winBlurCB) then winBlurCB;
 368           {$ENDIF}
 369         end;
 370       SDL_WINDOWEVENT_FOCUS_GAINED, SDL_WINDOWEVENT_MAXIMIZED, SDL_WINDOWEVENT_RESTORED:
 371         begin
 372           e_MuteChannels(false);
 373           {$IFDEF ENABLE_HOLMES}
 374             if assigned(winFocusCB) then winFocusCB;
 375           {$ENDIF}
 376         end;
 377     end
 378   end;
 379
 380   procedure HandleKeyboard (var ev: TSDL_KeyboardEvent);
 381     var down: Boolean; key: Integer;
 382   begin
 383     key := ev.keysym.scancode;
 384     down := (ev.type_ = SDL_KEYDOWN);
 385     if key = SDL_SCANCODE_AC_BACK then
 386       key := SDL_SCANCODE_ESCAPE;
 387     {$IFDEF ENABLE_HOLMES}
 388       if fuiOnSDLEvent(PSDL_Event(@ev)^) then
 389       begin
 390         // event eaten, but...
 391         if not down then e_KeyUpDown(key, false);
 392         exit;
 393       end;
 394     {$ENDIF}
 395     if ev._repeat = 0 then
 396     begin
 397       if g_dbg_input then
 398         e_LogWritefln('Input Debug: keysym, press=%s, scancode=%s', [down, key]);
 399       e_KeyUpDown(key, down);
 400       g_Console_ProcessBind(key, down);
 401     end
 402     else if gConsoleShow or gChatShow or (g_ActiveWindow <> nil) then
 403     begin
 404       KeyPress(key) // key repeat in menus and shit
 405     end
 406   end;
 407
 408   procedure HandleTextInput (var ev: TSDL_TextInputEvent);
 409     var ch: UnicodeChar; sch: AnsiChar;
 410   begin
 411     if g_dbg_input then
 412       e_LogWritefln('Input Debug: text, text=%s', [ev.text]);
 413     Utf8ToUnicode(@ch, PChar(ev.text), 1);
 414     if IsValid1251(Word(ch)) then
 415     begin
 416       sch := AnsiChar(wchar2win(ch));
 417       CharPress(sch);
 418     end;
 419   end;
 420
 421   function sys_HandleInput (): Boolean;
 422     var ev: TSDL_Event;
 423   begin
 424     result := false;
 425     ZeroMemory(@ev, sizeof(ev));
 426     while SDL_PollEvent(@ev) <> 0 do
 427     begin
 428       case ev.type_ of
 429         SDL_QUITEV: result := true;
 430         SDL_WINDOWEVENT: result := HandleWindow(ev.window);
 431         SDL_KEYUP, SDL_KEYDOWN: HandleKeyboard(ev.key);
 432         SDL_JOYBUTTONDOWN, SDL_JOYBUTTONUP: HandleJoyButton(ev.jbutton);
 433         SDL_JOYAXISMOTION: HandleJoyAxis(ev.jaxis);
 434         SDL_JOYHATMOTION: HandleJoyHat(ev.jhat);
 435         SDL_JOYDEVICEADDED: HandleJoyAdd(ev.jdevice);
 436         SDL_JOYDEVICEREMOVED: HandleJoyRemove(ev.jdevice);
 437         SDL_TEXTINPUT: HandleTextInput(ev.text);
 438         SDL_FINGERMOTION, SDL_FINGERDOWN, SDL_FINGERUP: g_Touch_HandleEvent(ev.tfinger);
 439         {$IFDEF ENABLE_HOLMES}
 440           SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP, SDL_MOUSEWHEEL, SDL_MOUSEMOTION: fuiOnSDLEvent(ev);
 441         {$ENDIF}
 442       end
 443     end
 444   end;
 445
 446   procedure sys_RequestQuit;
 447     var ev: TSDL_Event;
 448   begin
 449     ev.type_ := SDL_QUITEV;
 450     SDL_PushEvent(@ev)
 451   end;
 452
 453   (* --------- Init --------- *)
 454
 455   procedure sys_Init;
 456     var flags: UInt32;
 457   begin
 458     e_WriteLog('Init SDL2', TMsgType.Notify);
 459     {$IFDEF HEADLESS}
 460       {$IFDEF USE_SDLMIXER}
 461         flags := SDL_INIT_TIMER or SDL_INIT_AUDIO or $00004000;
 462       {$ELSE}
 463         flags := SDL_INIT_TIMER or $00004000;
 464       {$ENDIF}
 465     {$ELSE}
 466       flags := SDL_INIT_JOYSTICK or SDL_INIT_TIMER or SDL_INIT_VIDEO;
 467     {$ENDIF}
 468     SDL_SetHint(SDL_HINT_ACCELEROMETER_AS_JOYSTICK, '0');
 469     if SDL_Init(flags) <> 0 then
 470       raise Exception.Create('SDL: Init failed: ' + SDL_GetError);
 471     SDL_ShowCursor(SDL_DISABLE);
 472   end;
 473
 474   procedure sys_Final;
 475   begin
 476     e_WriteLog('Releasing SDL2', TMsgType.Notify);
 477     if context <> nil then
 478     begin
 479       {$IFDEF NOGL_INIT}
 480         nogl_Quit;
 481       {$ENDIF}
 482       SDL_GL_DeleteContext(context);
 483       context := nil;
 484     end;
 485     if window <> nil then
 486     begin
 487       SDL_DestroyWindow(window);
 488       window := nil;
 489     end;
 490     SDL_Quit
 491   end;
 492
 493 initialization
 494   conRegVar('sdl2_display_index', @display, 'use display index as base', '');
 495 end.