src/game/opengl/r_render.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 r_render;
  17
  18 interface
  19
  20   uses
  21     {$IFDEF ENABLE_MENU}
  22       g_gui,
  23     {$ENDIF}
  24     g_base // TRectWH
  25   ;
  26
  27   procedure r_Render_Initialize;
  28   procedure r_Render_Finalize;
  29
  30   procedure r_Render_Load;
  31   procedure r_Render_Free;
  32
  33   procedure r_Render_LoadTextures;
  34   procedure r_Render_FreeTextures;
  35
  36   procedure r_Render_Update;
  37   procedure r_Render_Draw;
  38
  39   procedure r_Render_Resize (w, h: Integer);
  40   procedure r_Render_Apply;
  41
  42   function r_Render_WriteScreenShot (filename: String): Boolean;
  43
  44   {$IFDEF ENABLE_GIBS}
  45     function r_Render_GetGibRect (m, id: Integer): TRectWH;
  46   {$ENDIF}
  47
  48   {$IFDEF ENABLE_GFX}
  49     procedure r_Render_QueueEffect (AnimType, X, Y: Integer);
  50   {$ENDIF}
  51
  52   {$IFDEF ENABLE_TOUCH}
  53     // touch screen button location and size
  54     procedure r_Render_GetKeyRect (key: Integer; out x, y, w, h: Integer; out founded: Boolean);
  55   {$ENDIF}
  56
  57   {$IFDEF ENABLE_MENU}
  58     procedure r_Render_GetControlSize (ctrl: TGUIControl; out w, h: Integer);
  59     procedure r_Render_GetLogoSize (out w, h: Integer);
  60     procedure r_Render_GetMaxFontSize (BigFont: Boolean; out w, h: Integer);
  61     procedure r_Render_GetStringSize (BigFont: Boolean; str: String; out w, h: Integer);
  62   {$ENDIF}
  63
  64   procedure r_Render_DrawLoading (force: Boolean); // !!! remove it
  65
  66 implementation
  67
  68   uses
  69     {$INCLUDE ../../nogl/noGLuses.inc}
  70     {$IFDEF ENABLE_TOUCH}
  71       r_touch,
  72     {$ENDIF}
  73     {$IFDEF ENABLE_GFX}
  74       r_gfx,
  75     {$ENDIF}
  76     {$IFDEF ENABLE_SYSTEM}
  77       g_system,
  78     {$ENDIF}
  79     {$IFDEF ENABLE_MENU}
  80       r_gui,
  81     {$ENDIF}
  82     SysUtils, Classes, Math,
  83     e_log, utils,
  84     g_game, g_options, g_console,
  85     r_window, r_graphics, r_console, r_playermodel, r_textures, r_animations,
  86     r_weapons, r_items, r_monsters, r_map, r_player, r_game
  87   ;
  88
  89   var
  90     LoadedGL: Boolean = false;
  91
  92   function GLExtensionList (): SSArray;
  93     var s: PChar; i, j, num: GLint;
  94   begin
  95     result := nil;
  96     s := glGetString(GL_EXTENSIONS);
  97     if s <> nil then
  98     begin
  99       num := 0;
 100       i := 0;
 101       j := 0;
 102       while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
 103       while (s[i] <> #0) do
 104       begin
 105         while (s[i] <> #0) and (s[i] <> ' ') do Inc(i);
 106         SetLength(result, num+1);
 107         result[num] := Copy(s, j+1, i-j);
 108         while (s[i] <> #0) and (s[i] = ' ') do Inc(i);
 109         j := i;
 110         Inc(num)
 111       end
 112     end
 113   end;
 114
 115   function GLExtensionSupported (ext: AnsiString): Boolean;
 116     var e: AnsiString;
 117   begin
 118     {$IFDEF NOGL_INIT}
 119       Result := nogl_ExtensionSupported(ext);
 120     {$ELSE}
 121       result := false;
 122       for e in GLExtensionList() do
 123       begin
 124         if strEquCI1251(e, ext) then
 125         begin
 126           result := true;
 127           exit
 128         end
 129       end
 130     {$ENDIF}
 131   end;
 132
 133   function HaveNPOTSupport (): Boolean;
 134   begin
 135     Result := GLExtensionSupported('GL_ARB_texture_non_power_of_two') or
 136               GLExtensionSupported('GL_OES_texture_npot')
 137   end;
 138
 139   function HaveFBOSupport (): Boolean;
 140   begin
 141     Result := GLExtensionSupported('GL_ARB_framebuffer_object') or
 142               GLExtensionSupported('GL_OES_framebuffer_object')
 143   end;
 144
 145   procedure PrintGLSupportedExtensions;
 146   begin
 147     e_LogWritefln('GL Vendor: %s', [glGetString(GL_VENDOR)]);
 148     e_LogWritefln('GL Renderer: %s', [glGetString(GL_RENDERER)]);
 149     e_LogWritefln('GL Version: %s', [glGetString(GL_VERSION)]);
 150     e_LogWritefln('GL Shaders: %s', [glGetString(GL_SHADING_LANGUAGE_VERSION)]);
 151     e_LogWritefln('GL Extensions: %s', [glGetString(GL_EXTENSIONS)]);
 152   end;
 153
 154   procedure r_Window_Initialize;
 155   begin
 156 {$IFNDEF USE_SYSSTUB}
 157     PrintGLSupportedExtensions;
 158     glLegacyNPOT := not HaveNPOTSupport();
 159 {$ELSE}
 160     glLegacyNPOT := False;
 161     glRenderToFBO := False;
 162 {$ENDIF}
 163     if glNPOTOverride and glLegacyNPOT then
 164     begin
 165       glLegacyNPOT := true;
 166       e_logWriteln('NPOT texture emulation: FORCED')
 167     end
 168     else
 169     begin
 170       if glLegacyNPOT then
 171         e_logWriteln('NPOT texture emulation: enabled')
 172       else
 173         e_logWriteln('NPOT texture emulation: disabled')
 174     end
 175   end;
 176
 177   procedure LoadGL;
 178     var fboload: Boolean;
 179   begin
 180     if LoadedGL = false then
 181     begin
 182       {$IFDEF NOGL_INIT}
 183         nogl_Init;
 184       {$ENDIF}
 185       if glRenderToFBO then
 186       begin
 187         fboload := True;
 188         {$IFDEF NOGL_INIT}
 189           fboload := True; // !!! but if not?
 190         {$ELSE}
 191           fboload := Load_GL_ARB_framebuffer_object();
 192         {$ENDIF}
 193         if (fboload = False) or (HaveFBOSupport() = False) or (HaveNPOTSupport() = False) then
 194         begin
 195           e_LogWriteln('GL: framebuffer objects not supported; disabling FBO rendering');
 196           glRenderToFBO := false
 197         end;
 198       end;
 199       LoadedGL := true
 200     end
 201   end;
 202
 203   procedure FreeGL;
 204   begin
 205     if LoadedGL = true then
 206     begin
 207       {$IFDEF NOGL_INIT}
 208         nogl_Quit;
 209       {$ENDIF}
 210       LoadedGL := false
 211     end
 212   end;
 213
 214   procedure r_Render_LoadTextures;
 215   begin
 216     r_Game_LoadTextures;
 217     r_Map_LoadTextures;
 218   end;
 219
 220   procedure r_Render_FreeTextures;
 221   begin
 222     r_Map_FreeTextures;
 223     r_Game_FreeTextures;
 224   end;
 225
 226   procedure r_Render_Load;
 227   begin
 228     r_Game_Load; // load first!
 229     r_Player_Load;
 230     r_Map_Load;
 231     r_PlayerModel_Load;
 232     r_Monsters_Load;
 233     r_Weapon_Load;
 234     r_Items_Load;
 235     {$IFDEF ENABLE_GFX}
 236       r_GFX_Load;
 237     {$ENDIF}
 238     {$IFDEF ENABLE_MENU}
 239       r_GUI_Load;
 240     {$ENDIF}
 241   end;
 242
 243   procedure r_Render_Free;
 244   begin
 245     {$IFDEF ENABLE_MENU}
 246       r_GUI_Free;
 247     {$ENDIF}
 248     {$IFDEF ENABLE_GFX}
 249       r_GFX_Free;
 250     {$ENDIF}
 251     r_Items_Free;
 252     r_Weapon_Free;
 253     r_Monsters_Free;
 254     r_PlayerModel_Free;
 255     r_Map_Free;
 256     r_Player_Free;
 257     r_Game_Free;
 258     g_Texture_DeleteAll;
 259     g_Frames_DeleteAll;
 260   end;
 261
 262   procedure r_Render_Initialize;
 263   begin
 264     {$IFDEF ENABLE_SYSTEM}
 265       if sys_SetDisplayMode(gRC_Width, gRC_Height, gBPP, gRC_FullScreen, gRC_Maximized) = False then
 266         raise Exception.Create('Failed to set videomode on startup.');
 267     {$ENDIF}
 268     LoadGL;
 269     r_Window_Initialize;
 270     r_Console_Init;
 271     r_PlayerModel_Initialize;
 272     r_Map_Initialize;
 273   end;
 274
 275   procedure r_Render_Finalize;
 276   begin
 277     r_Map_Finalize;
 278     r_PlayerModel_Finalize;
 279     FreeGL;
 280     e_ReleaseEngine
 281   end;
 282
 283   procedure r_Render_Update;
 284   begin
 285     {$IFDEF ENABLE_GFX}
 286       r_GFX_Update;
 287     {$ENDIF}
 288     r_Map_Update;
 289     r_PlayerModel_Update;
 290     r_Console_Update;
 291     r_Items_Update;
 292   end;
 293
 294   procedure r_Render_Draw;
 295   begin
 296     r_Game_Draw;
 297     {$IFDEF ENABLE_TOUCH}
 298       r_Touch_Draw;
 299     {$ENDIF}
 300   end;
 301
 302   procedure r_Render_Resize (w, h: Integer);
 303   begin
 304     LoadGL;
 305     gWinSizeX := w;
 306     gWinSizeY := h;
 307     gRC_Width := w;
 308     gRC_Height := h;
 309     if glRenderToFBO then
 310     begin
 311       // store real window size in gWinSize, downscale resolution now
 312       w := round(w / r_pixel_scale);
 313       h := round(h / r_pixel_scale);
 314       if not e_ResizeFramebuffer(w, h) then
 315       begin
 316         e_LogWriteln('GL: could not create framebuffer, falling back to --no-fbo');
 317         glRenderToFBO := False;
 318         w := gWinSizeX;
 319         h := gWinSizeY;
 320       end;
 321     end;
 322     gScreenWidth := w;
 323     gScreenHeight := h;
 324     e_ResizeWindow(w, h);
 325     e_InitGL;
 326     r_Game_SetupScreenSize;
 327   end;
 328
 329   procedure r_Render_Apply;
 330   begin
 331     {$IFDEF ENABLE_SYSTEM}
 332       if sys_SetDisplayMode(Max(1, gRC_Width), Max(1, gRC_Height), Max(1, gBPP), gRC_FullScreen, gRC_Maximized) then
 333         e_LogWriteln('resolution changed')
 334       else
 335         e_LogWriteln('resolution not changed');
 336       sys_EnableVSync(gVSync)
 337     {$ENDIF}
 338   end;
 339
 340   function r_Render_WriteScreenShot (filename: String): Boolean;
 341     var s: TStream;
 342   begin
 343     Result := False;
 344     try
 345       s := CreateDiskFile(filename);
 346       try
 347         e_MakeScreenshot(s, gWinSizeX, gWinSizeX);
 348         Result := True;
 349       except
 350         DeleteFile(filename)
 351       end;
 352       s.Free;
 353     finally
 354     end
 355   end;
 356
 357 {$IFDEF ENABLE_GIBS}
 358   function r_Render_GetGibRect (m, id: Integer): TRectWH;
 359   begin
 360     Result := r_PlayerModel_GetGibRect(m, id)
 361   end;
 362 {$ENDIF}
 363
 364 {$IFDEF ENABLE_GFX}
 365   procedure r_Render_QueueEffect (AnimType, X, Y: Integer);
 366   begin
 367     r_GFX_OnceAnim(AnimType, X, Y)
 368   end;
 369 {$ENDIF}
 370
 371 {$IFDEF ENABLE_TOUCH}
 372   procedure r_Render_GetKeyRect (key: Integer; out x, y, w, h: Integer; out founded: Boolean);
 373   begin
 374     r_Touch_GetKeyRect (key, x, y, w, h, founded)
 375   end;
 376 {$ENDIF}
 377
 378 {$IFDEF ENABLE_MENU}
 379   procedure r_Render_GetControlSize (ctrl: TGUIControl; out w, h: Integer);
 380   begin
 381     r_GUI_GetSize(ctrl, w, h)
 382   end;
 383
 384   procedure r_Render_GetLogoSize (out w, h: Integer);
 385   begin
 386     r_GUI_GetLogoSize(w, h)
 387   end;
 388
 389   procedure r_Render_GetMaxFontSize (BigFont: Boolean; out w, h: Integer);
 390   begin
 391     r_GUI_GetMaxFontSize(BigFont, w, h)
 392   end;
 393
 394   procedure r_Render_GetStringSize (BigFont: Boolean; str: String; out w, h: Integer);
 395   begin
 396     r_GUI_GetStringSize(BigFont, str, w, h)
 397   end;
 398 {$ENDIF}
 399
 400   procedure r_Render_DrawLoading (force: Boolean);
 401   begin
 402     r_Window_DrawLoading(force)
 403   end;
 404
 405 end.