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