DEADSOFTWARE

gl: implement screenshots
authorDeaDDooMER <deaddoomer@deadsoftware.ru>
Sat, 18 Feb 2023 14:43:58 +0000 (17:43 +0300)
committerDeaDDooMER <deaddoomer@deadsoftware.ru>
Fri, 9 Jun 2023 09:15:22 +0000 (12:15 +0300)
src/game/g_game.pas
src/game/g_options.pas
src/game/renders/opengl/r_render.pas

index d1bab9081efc7424221d32070ebd02bfbe8e3626..ff94b2860bfff29e190216ace14f71de42feffa8 100644 (file)
@@ -132,9 +132,6 @@ procedure g_Game_Announce_KillCombo(Param: Integer);
 procedure g_Game_Announce_BodyKill(SpawnerUID: Word);
 procedure g_Game_StartVote(Command, Initiator: string);
 procedure g_Game_CheckVote;
-{$IFDEF ENABLE_RENDER}
-  procedure g_TakeScreenShot(Filename: string = '');
-{$ENDIF}
 procedure g_FatalError(Text: String);
 procedure g_SimpleError(Text: String);
 function  g_Game_IsTestMap(): Boolean;
@@ -5981,7 +5978,7 @@ begin
   else if cmd = 'screenshot' then
   begin
     {$IFDEF ENABLE_RENDER}
-      g_TakeScreenShot;
+      r_Render_RequestScreenShot;
     {$ENDIF}
   end
   else if (cmd = 'weapnext') or (cmd = 'weapprev') then
@@ -6315,29 +6312,6 @@ begin
   end;
 end;
 
-{$IFDEF ENABLE_RENDER}
-procedure g_TakeScreenShot(Filename: string = '');
-  var t: TDateTime; dir, date, name: String;
-begin
-  if e_NoGraphics then
-    Exit;
-
-  dir := e_GetWriteableDir(ScreenshotDirs);
-  if Filename = '' then
-  begin
-    t := Now;
-    DateTimeToString(date, 'yyyy-mm-dd-hh-nn-ss', t);
-    Filename := 'screenshot-' + date;
-  end;
-
-  name := e_CatPath(dir, Filename + '.png');
-  if r_Render_WriteScreenShot(name) then
-    g_Console_Add(Format(_lc[I_CONSOLE_SCREENSHOT], [name]))
-  else
-    g_Console_Add(Format(_lc[I_CONSOLE_ERROR_WRITE], [name]));
-end;
-{$ENDIF}
-
 {$IFDEF ENABLE_MENU}
 procedure g_Game_InGameMenu(Show: Boolean);
 begin
index 1f49765dac0563b62bbd963964ecd77c05e6024e..2f05f7c7b22a51dd382c664384fcd4c4cab078d6 100644 (file)
@@ -80,7 +80,6 @@ var
 {$ELSE}
   e_NoGraphics: Boolean = False;
 {$ENDIF}
-  e_FastScreenshots: Boolean = true; // it's REALLY SLOW with `false`
   g_dbg_scale: Single = 1.0;
   r_pixel_scale: Single = 1.0;
 
@@ -312,7 +311,6 @@ begin
   gChatBubble := 4;
   wadoptDebug := False;
   wadoptFast := False;
-  e_FastScreenshots := True;
   gDefaultMegawadStart := DF_Default_Megawad_Start;
   g_dbg_scale := 1.0;
   gSaveStats := False;
@@ -427,7 +425,6 @@ initialization
   conRegVar('r_chat_bubble', @gChatBubble, '', '');
   conRegVar('sfs_debug', @wadoptDebug, '', '');
   conRegVar('sfs_fastmode', @wadoptFast, '', '');
-  conRegVar('g_fast_screenshots', @e_FastScreenshots, '', '');
   conRegVar('g_default_megawad', @gDefaultMegawadStart, '', '');
   conRegVar('g_save_stats', @gSaveStats, '', '');
   conRegVar('g_screenshot_stats', @gScreenshotStats, '', '');
index bfd0d826ec3a157f2b92d05a5aec88552e54b992..44ee5b61da1bdf57a5eb97d9c57113eb57f733f0 100644 (file)
@@ -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,7 @@ implementation
     {$ENDIF}
     SysUtils, Classes, Math,
     g_basic,
-    e_log, utils, wadreader, mapdef,
+    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 +117,7 @@ implementation
     hudbflag, hudbflags, hudbflagd: TGLTexture;
 
     FPS, FPSCounter, FPSTime: LongWord;
+    TakeScreenShot: Boolean;
 
   procedure r_Render_LoadTextures;
   begin
@@ -1072,6 +1074,63 @@ 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
+          {$IFDEF ENDIAN_LITTLE}
+            typ := GL_UNSIGNED_INT_8_8_8_8_REV;
+          {$ELSE}
+            typ := GL_UNSIGNED_INT_8_8_8_8;
+          {$ENDIF}
+          glReadPixels(0, 0, gWinSizeX, gWinSizeY, GL_BGRA, typ, img.bits);
+          if glGetError() = GL_NO_ERROR then
+          begin
+            if FlipImage(img) 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;
   begin
@@ -1289,6 +1348,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;
 
@@ -1316,10 +1388,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}