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