gl: fix screenshoting on gles

[d2df-sdl.git] / src / game / renders / opengl / r_render.pas

diff --git a/src/game/renders/opengl/r_render.pas b/src/game/renders/opengl/r_render.pas
index 3c2cd6fefbc27760a0871ea29e28a5e707400d8b..88c507977fe20c58463e93d20fa9c0e37fd1803f 100644 (file)
--- a/src/game/renders/opengl/r_render.pas
+++ b/src/game/renders/opengl/r_render.pas
@@ -46,7 +46,7 @@ interface
   procedure r_Render_Resize (w, h: Integer);
   procedure r_Render_Apply;
 
-  function r_Render_WriteScreenShot (filename: String): Boolean;
+  procedure r_Render_RequestScreenShot;
 
   {$IFDEF ENABLE_GIBS}
     function r_Render_GetGibRect (m, id: Integer): TRectWH;
@@ -84,6 +84,7 @@ implementation
 
   uses
     {$I ../../../nogl/noGLuses.inc}
+    Imaging, ImagingTypes, ImagingUtility, (* for screenshots *)
     {$IFDEF ENABLE_MENU}
       r_gui,
     {$ENDIF}
@@ -98,7 +99,8 @@ implementation
     {$ENDIF}
     SysUtils, Classes, Math,
     g_basic,
-    e_log, utils, wadreader, mapdef,
+    e_sound, // DebugSound
+    e_log, e_res, utils, wadreader, mapdef,
     g_game, g_map, g_panel, g_options, g_console, g_player, g_weapons, g_language, g_triggers, g_monsters,
     g_net, g_netmaster,
     r_draw, r_textures, r_fonts, r_common, r_console, r_map, r_loadscreen
@@ -116,6 +118,8 @@ implementation
     hudbflag, hudbflags, hudbflagd: TGLTexture;
 
     FPS, FPSCounter, FPSTime: LongWord;
+    TakeScreenShot: Boolean;
+    DebugSound: Boolean;
 
   procedure r_Render_LoadTextures;
   begin
@@ -1072,8 +1076,60 @@ implementation
     DrawPlayers;
   end;
 
+  function GetScreenShotName (AsStats: Boolean): AnsiString;
+    var dir, date: AnsiString;
+  begin
+    result := '';
+    dir := e_GetWriteableDir(ScreenshotDirs);
+    if dir <> '' then
+    begin
+      if AsStats then
+      begin
+        dir := e_CatPath(dir, 'stats'); (* TODO: use e_GetWriteableDir *)
+        result := e_CatPath(dir, StatFilename + '.png');
+      end
+      else
+      begin
+        DateTimeToString(date, 'yyyy-mm-dd-hh-nn-ss', Now());
+        result := e_CatPath(dir, 'screenshot-' + date + '.png');
+      end;
+    end;
+  end;
+
+  procedure SaveScreenShot (AsStats: Boolean);
+    var img: TImageData; typ: GLenum; ok: Boolean; fname: AnsiString;
+  begin
+    ok := false;
+    fname := GetScreenShotName(AsStats);
+    if fname <> '' then
+    begin
+      if (gWinSizeX > 0) and (gWinSizeY > 0) then
+      begin
+        Imaging.SetOption(ImagingPNGPreFilter, 5);
+        Imaging.SetOption(ImagingPNGCompressLevel, 5);
+        InitImage(img);
+        if NewImage(gWinSizeX, gWinSizeY, TImageFormat.ifA8R8G8B8, img) then
+        begin
+          glReadPixels(0, 0, gWinSizeX, gWinSizeY, GL_RGBA, GL_UNSIGNED_BYTE, img.bits);
+          if glGetError() = GL_NO_ERROR then
+          begin
+            if FlipImage(img) and SwapChannels(img, ChannelRed, ChannelBlue) then
+            begin
+              ok := SaveImageToFile(fname, img);
+            end;
+          end;
+        end;
+        FreeImage(img);
+      end;
+    end;
+    if ok then
+      g_Console_Add(Format(_lc[I_CONSOLE_SCREENSHOT], [fname]))
+    else
+      g_Console_Add(Format(_lc[I_CONSOLE_ERROR_WRITE], [fname]));
+  end;
+
   procedure r_Render_Draw;
-    var p1, p2: TPlayer; time: LongWord; pw, ph: Integer;
+    var p1, p2: TPlayer; time: LongWord; pw, ph, i, j: Integer;
   begin
     if gExit = EXIT_QUIT then
       exit;
@@ -1188,7 +1244,14 @@ implementation
       // TODO F key handle
       case gState of
         STATE_NONE: (* do nothing *) ;
-        STATE_MENU: r_Common_DrawBackground(GameWad + ':TEXTURES/TITLE');
+        STATE_MENU:
+        begin
+          r_Common_DrawBackground(GameWad + ':TEXTURES/TITLE');
+          {$IFDEF ENABLE_MENU}
+            if g_ActiveWindow <> nil then
+              r_Draw_FillRect(0, 0, gScreenWidth, gScreenHeight, 0, 0, 0, 105);
+          {$ENDIF}
+        end;
         STATE_FOLD:
         begin
           if EndingGameCounter > 0 then
@@ -1258,7 +1321,12 @@ implementation
 
     r_Console_Draw(false);
 
-    // TODO g_debug_Sounds
+    if DebugSound and gGameOn then
+    begin
+      for i := 0 to High(e_SoundsArray) do
+        for j := 0 to e_SoundsArray[i].nRefs do
+          r_Draw_FillRect(i + 100, j + 100, i + 100 + 1, j + 100 + 1, 255, 0, 0, 255);
+    end;
 
     if gShowFPS then
     begin
@@ -1282,6 +1350,19 @@ implementation
       r_Touch_Draw;
     {$ENDIF}
 
+    if TakeScreenShot then
+    begin
+      SaveScreenShot(false);
+      TakeScreenShot := false;
+    end;
+
+    (* take stats screenshot immediately after the first frame of the stats showing *)
+    if gScreenshotStats and (StatShotDone = false) and (Length(CustomStat.PlayerStat) > 1) then
+    begin
+      SaveScreenShot(true);
+      StatShotDone := true;
+    end;
+
     sys_Repaint;
   end;
 
@@ -1309,10 +1390,9 @@ implementation
     {$ENDIF}
   end;
 
-  function r_Render_WriteScreenShot (filename: String): Boolean;
+  procedure r_Render_RequestScreenShot;
   begin
-    // TODO write screenshot file
-    Result := False;
+    TakeScreenShot := true;
   end;
 
 {$IFDEF ENABLE_GIBS}
@@ -1400,4 +1480,7 @@ implementation
   end;
 {$ENDIF}
 
+begin
+  conRegVar('d_sounds', @DebugSound, '', '');
+  DebugSound := false;
 end.