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   (* To fix:
  21    *   - Joystick support
  22    *)
  23
  24   uses Utils;
  25
  26   (* --- Utils --- *)
  27   function sys_GetTicks (): Int64;
  28   procedure sys_Delay (ms: Integer);
  29
  30   (* --- Graphics --- *)
  31   function sys_GetDispalyModes (bpp: Integer): SSArray;
  32   function sys_SetDisplayMode (w, h, bpp: Integer; fullscreen: Boolean): Boolean;
  33   procedure sys_EnableVSync (yes: Boolean);
  34   procedure sys_Repaint;
  35
  36   (* --- Input --- *)
  37   function sys_HandleInput (): Boolean;
  38   procedure sys_RequestQuit;
  39
  40   (* --- Init --- *)
  41   procedure sys_Init;
  42   procedure sys_Final;
  43
  44 implementation
  45
  46   uses
  47     SysUtils, SDL, GL,
  48     e_log, e_graphics, e_input,
  49     g_options, g_window, g_console, g_game, g_menu, g_gui, g_main;
  50
  51   const
  52     GameTitle = 'Doom 2D: Forever (SDL 1.2)';
  53
  54   var
  55     userResize: Boolean;
  56     modeResize: Integer;
  57     screen: PSDL_Surface;
  58
  59   (* --------- Utils --------- *)
  60
  61   function sys_GetTicks (): Int64;
  62   begin
  63     result := SDL_GetTicks()
  64   end;
  65
  66   procedure sys_Delay (ms: Integer);
  67   begin
  68     SDL_Delay(ms)
  69   end;
  70
  71   (* --------- Graphics --------- *)
  72
  73   procedure UpdateSize (w, h: Integer);
  74   begin
  75     gWinSizeX := w;
  76     gWinSizeY := h;
  77     gWinRealPosX := 0;
  78     gWinRealPosY := 0;
  79     gScreenWidth := w;
  80     gScreenHeight := h;
  81     {$IFDEF ENABLE_HOLMES}
  82       fuiScrWdt := w;
  83       fuiScrHgt := h;
  84     {$ENDIF}
  85     e_ResizeWindow(w, h);
  86     e_InitGL;
  87     g_Game_SetupScreenSize;
  88     g_Menu_Reset;
  89     g_Game_ClearLoading;
  90   end;
  91
  92   function InitWindow (w, h, bpp: Integer; fullScreen: Boolean): Boolean;
  93     var flags: Uint32;
  94   begin
  95     e_LogWritefln('InitWindow %s %s %s %s', [w, h, bpp, fullScreen]);
  96     result := False;
  97     SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
  98     SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
  99     SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
 100     SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
 101     SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
 102     SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 8); // lights; it is enough to have 1-bit stencil buffer for lighting, but...
 103     flags := SDL_OPENGL;
 104     if fullScreen then flags := flags or SDL_FULLSCREEN;
 105     if userResize then flags := flags or SDL_VIDEORESIZE;
 106     if (screen = nil) or (SDL_VideoModeOk(w, h, bpp, flags) <> 0) then
 107     begin
 108       SDL_FreeSurface(screen);
 109       screen := SDL_SetVideoMode(w, h, bpp, flags);
 110       if screen <> nil then
 111       begin
 112         SDL_WM_SetCaption(GameTitle, nil);
 113         UpdateSize(w, h);
 114         result := True
 115       end
 116     end
 117     else
 118     begin
 119       e_LogWritefln('SDL: video mode not supported', [])
 120     end
 121   end;
 122
 123   procedure sys_Repaint;
 124   begin
 125     SDL_GL_SwapBuffers
 126   end;
 127
 128   procedure sys_EnableVSync (yes: Boolean);
 129   begin
 130     (* ??? *)
 131   end;
 132
 133   function sys_GetDispalyModes (bpp: Integer): SSArray;
 134     var m: PPSDL_Rect; f: TSDL_PixelFormat; i, count: Integer;
 135   begin
 136     SetLength(result, 0);
 137     FillChar(f, sizeof(f), 0);
 138     f.palette := nil;
 139     f.BitsPerPixel := bpp;
 140     f.BytesPerPixel := (bpp + 7) div 8;
 141     m := SDL_ListModes(@f, SDL_OPENGL or SDL_FULLSCREEN);
 142     if (m <> NIL) and (IntPtr(m) <> -1) then
 143     begin
 144       count := 0;
 145       while m[count] <> nil do inc(count);
 146       SetLength(result, count);
 147       for i := 0 to count - 1 do
 148         result[i] := IntToStr(m[i].w) + 'x' + IntToStr(m[i].h);
 149     end
 150   end;
 151
 152   function sys_SetDisplayMode (w, h, bpp: Integer; fullscreen: Boolean): Boolean;
 153   begin
 154     result := InitWindow(w, h, bpp, fullscreen)
 155   end;
 156
 157   (* --------- Input --------- *)
 158
 159   function Key2Stub (key: Integer): Integer;
 160     var x: Integer;
 161   begin
 162     case key of
 163       SDLK_ESCAPE: x := IK_ESCAPE;
 164       SDLK_RETURN: x := IK_RETURN;
 165       SDLK_KP_ENTER: x := IK_KPRETURN;
 166       SDLK_KP0: x := IK_KPINSERT;
 167       SDLK_UP: x := IK_UP;
 168       SDLK_KP8: x := IK_KPUP;
 169       SDLK_DOWN: x := IK_DOWN;
 170       SDLK_KP2: x := IK_KPDOWN;
 171       SDLK_LEFT: x := IK_LEFT;
 172       SDLK_KP4: x := IK_KPLEFT;
 173       SDLK_RIGHT: x := IK_RIGHT;
 174       SDLK_KP6: x := IK_KPRIGHT;
 175       SDLK_DELETE: x := IK_DELETE;
 176       SDLK_HOME: x := IK_HOME;
 177       SDLK_KP7: x := IK_KPHOME;
 178       SDLK_INSERT: x := IK_INSERT;
 179       SDLK_SPACE: x := IK_SPACE;
 180       SDLK_LSHIFT: x := IK_SHIFT;
 181       SDLK_LALT: x := IK_ALT;
 182       SDLK_TAB: x := IK_TAB;
 183       SDLK_PAGEUP: x := IK_PAGEUP;
 184       SDLK_KP9: x := IK_KPPAGEUP;
 185       SDLK_PAGEDOWN: x := IK_PAGEDN;
 186       SDLK_KP3: x := IK_KPPAGEDN;
 187       SDLK_KP5: x := IK_KP5;
 188       SDLK_NUMLOCK: x := IK_NUMLOCK;
 189       SDLK_KP_DIVIDE: x := IK_KPDIVIDE;
 190       SDLK_KP_MULTIPLY: x := IK_KPMULTIPLE;
 191       SDLK_KP_MINUS: x := IK_KPMINUS;
 192       SDLK_KP_PLUS: x := IK_KPPLUS;
 193       SDLK_KP_PERIOD: x := IK_KPDOT;
 194       SDLK_CAPSLOCK: x := IK_CAPSLOCK;
 195       SDLK_RSHIFT: x := IK_RSHIFT;
 196       SDLK_LCTRL: x := IK_CTRL;
 197       SDLK_RCTRL: x := IK_RCTRL;
 198       SDLK_RALT: x := IK_RALT;
 199       SDLK_LSUPER: x := IK_WIN;
 200       SDLK_RSUPER: x := IK_RWIN;
 201       SDLK_MENU: x := IK_MENU;
 202       SDLK_PRINT: x := IK_PRINTSCR;
 203       SDLK_SCROLLOCK: x := IK_SCROLLLOCK;
 204       SDLK_LEFTBRACKET: x := IK_LBRACKET;
 205       SDLK_RIGHTBRACKET: x := IK_RBRACKET;
 206       SDLK_SEMICOLON: x := IK_SEMICOLON;
 207       SDLK_QUOTE: x := IK_QUOTE;
 208       SDLK_BACKSLASH: x := IK_BACKSLASH;
 209       SDLK_SLASH: x := IK_SLASH;
 210       SDLK_COMMA: x := IK_COMMA;
 211       SDLK_PERIOD: x := IK_DOT;
 212       SDLK_EQUALS: x := IK_EQUALS;
 213       SDLK_0: x := IK_0;
 214       SDLK_1: x := IK_1;
 215       SDLK_2: x := IK_2;
 216       SDLK_3: x := IK_3;
 217       SDLK_4: x := IK_4;
 218       SDLK_5: x := IK_5;
 219       SDLK_6: x := IK_6;
 220       SDLK_7: x := IK_7;
 221       SDLK_8: x := IK_8;
 222       SDLK_9: x := IK_9;
 223       SDLK_F1: x := IK_F1;
 224       SDLK_F2: x := IK_F2;
 225       SDLK_F3: x := IK_F3;
 226       SDLK_F4: x := IK_F4;
 227       SDLK_F5: x := IK_F5;
 228       SDLK_F6: x := IK_F6;
 229       SDLK_F7: x := IK_F7;
 230       SDLK_F8: x := IK_F8;
 231       SDLK_F9: x := IK_F9;
 232       SDLK_F10: x := IK_F10;
 233       SDLK_F11: x := IK_F11;
 234       SDLK_F12: x := IK_F12;
 235       SDLK_END: x := IK_END;
 236       SDLK_KP1: x := IK_KPEND;
 237       SDLK_BACKSPACE: x := IK_BACKSPACE;
 238       SDLK_BACKQUOTE: x := IK_BACKQUOTE;
 239       SDLK_PAUSE: x := IK_PAUSE;
 240       SDLK_A..SDLK_Z: x := IK_A + (key - SDLK_A);
 241       SDLK_MINUS: x := IK_MINUS;
 242       SDLK_RMETA: x := IK_RMETA;
 243       SDLK_LMETA: x := IK_LMETA;
 244     else
 245       x := IK_INVALID
 246     end;
 247     result := x
 248   end;
 249
 250   procedure HandleKeyboard (var ev: TSDL_KeyboardEvent);
 251     var down, repeated: Boolean; key: Integer; ch: Char;
 252   begin
 253     key := Key2Stub(ev.keysym.sym);
 254     down := (ev.type_ = SDL_KEYDOWN);
 255     repeated := down and e_KeyPressed(key);
 256     ch := wchar2win(WideChar(ev.keysym.unicode));
 257     if g_dbg_input then
 258       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)]);
 259     if not repeated then
 260     begin
 261       e_KeyUpDown(key, down);
 262       g_Console_ProcessBind(key, down);
 263     end
 264     else if gConsoleShow or gChatShow or (g_ActiveWindow <> nil) then
 265     begin
 266       KeyPress(key) // key repeat in menus and shit
 267     end;
 268     if down and IsValid1251(ev.keysym.unicode) and IsPrintable1251(ch) then
 269       CharPress(ch)
 270   end;
 271
 272   function sys_HandleInput (): Boolean;
 273     var ev: TSDL_Event;
 274   begin
 275     result := false;
 276     while SDL_PollEvent(@ev) <> 0 do
 277     begin
 278       case ev.type_ of
 279         SDL_QUITEV: result := true;
 280         SDL_VIDEORESIZE:
 281           begin
 282             if g_dbg_input then
 283               e_LogWritefln('Input Debug: SDL_VIDEORESIZE %s %s', [ev.resize.w, ev.resize.h]);
 284             if modeResize = 1 then
 285               UpdateSize(ev.resize.w, ev.resize.h)
 286             else if modeResize > 1 then
 287               InitWindow(ev.resize.w, ev.resize.h, gBPP, gFullscreen)
 288           end;
 289         SDL_KEYUP, SDL_KEYDOWN: HandleKeyboard(ev.key);
 290         SDL_VIDEOEXPOSE: sys_Repaint;
 291       end
 292     end
 293   end;
 294
 295   procedure sys_RequestQuit;
 296     var ev: TSDL_Event;
 297   begin
 298     ev.quit.type_ := SDL_QUITEV;
 299     SDL_PushEvent(@ev)
 300   end;
 301
 302   (* --------- Init --------- *)
 303
 304   procedure sys_Init;
 305     var flags: Uint32; ok: Boolean;
 306   begin
 307     e_WriteLog('Init SDL', TMsgType.Notify);
 308     flags := SDL_INIT_VIDEO or SDL_INIT_AUDIO or
 309              SDL_INIT_TIMER or SDL_INIT_JOYSTICK
 310              (*or SDL_INIT_NOPARACHUTE*);
 311     if SDL_Init(flags) <> 0 then
 312       raise Exception.Create('SDL: Init failed: ' + SDL_GetError);
 313     ok := InitWindow(gScreenWidth, gScreenHeight, gBPP, gFullScreen);
 314     if not ok then
 315       raise Exception.Create('SDL: Failed to set videomode: ' + SDL_GetError);
 316     SDL_EnableUNICODE(1);
 317     SDL_EnableKeyRepeat(SDL_DEFAULT_REPEAT_DELAY, SDL_DEFAULT_REPEAT_INTERVAL);
 318   end;
 319
 320   procedure sys_Final;
 321   begin
 322     e_WriteLog('Releasing SDL', TMsgType.Notify);
 323     SDL_FreeSurface(screen);
 324     SDL_Quit
 325   end;
 326
 327 initialization
 328   (* window resize are broken both on linux and osx, so disabled by default *)
 329   conRegVar('sdl_allow_resize', @userResize, 'allow to resize window by user', 'allow to resize window by user');
 330   conRegVar('sdl_resize_action', @modeResize, 'set window resize mode (0: ignore, 1: change, 2: reset)', '');
 331   userResize := false;
 332   modeResize := 0;
 333 end.