{$MODE FPC}
{$MODESWITCH result}
{$MODESWITCH autoderef}
{$MODESWITCH duplicatelocals}
unit DEngScreenshot;

interface

uses
  dfiles,
  DEng,
  DDraw;

type
TScreenshotSaver = object
private
  FEng: TEngine;
  FBuf: PByte;
  FWidth, FHeight: LongInt;
  procedure CheckBuffer;
public
  procedure Init(Eng: TEngine);
  procedure Done; inline;
  function SaveScreenshotTga(const FileName: AnsiString): Boolean;
  function SaveScreenshotTgaToDir(const Dir: AnsiString): Boolean;
  property Eng: TEngine read FEng;
end;

implementation

uses
  dstreamfile;

procedure TScreenshotSaver.CheckBuffer;
begin
  if FBuf <> nil then begin
    if (FWidth = Eng.Width) and (FHeight = Eng.Height) then
      Exit;
    FreeMem(FBuf);
  end;
  FWidth := Eng.Width;
  FHeight := Eng.Height;
  GetMem(FBuf, FWidth * FHeight * 4);
end;

procedure TScreenshotSaver.Init(Eng: TEngine);
begin
  FEng := Eng;
  FBuf := nil;
  FWidth := 0;
  FHeight := 0;
end;

procedure TScreenshotSaver.Done;
begin
  if FBuf <> nil then begin
    FreeMem(FBuf);
  end;
end;

type
PTgaHeader = ^TTgaHeader;
TTgaHeader = packed record
  IdLength:             Uint8;
  ColormapType:         Uint8;
  ImageType:            Uint8;  // aka DataTypeCode
  ColormapIndex:        Uint16; // aka ColourMapOrigin
  ColormapLength:       Uint16;
  ColormapEntrySize:    Uint8;  // aka ColourMapDepth
  Xorigin:              Uint16;
  Yorigin:              Uint16;
  Width:                Uint16;
  Height:               Uint16;
  PixelDepth:           Uint8;  // BitsPerPixel, 16, 24 or 32
  ImageDesc:            Uint8;
end;

function TScreenshotSaver.SaveScreenshotTga(const FileName: AnsiString): Boolean;
var
  Header: TTgaHeader;
  Stream: TStreamFile;
  It, ItEnd: PByte;
  B: Byte;
begin
  CheckBuffer;
  if FBuf = nil then
    Exit(False);
  Eng.Draw.ReadScreen(FBuf, FWidth, FHeight);

  // Swap RGBA to BGRA
  It := FBuf;
  ItEnd := FBuf + FWidth * FHeight * 4;
  while It < ItEnd do begin
    B := It^;
    It^ := (It + 2)^;
    (It + 2)^ := B;
    Inc(It, 4);
  end;

  FillChar(Header, SizeOf(Header), 0);
  // Header.IdLength := 0;
  // Header.ColormapType := 0; // TGA_COLOR_MAP_NO
  Header.ImageType := 2; // TGA_IMAGE_TYPE_RGB
  // Header.ColormapIndex := 0;
  // Header.ColormapLength := 0;
  // Header.ColormapEntrySize := 0;
  // Header.Xorigin := 0;
  // Header.Yorigin := 0;
  Header.Width := FWidth;
  Header.Height := FHeight;
  Header.PixelDepth := 32; // for RGBA
  Header.ImageDesc := %00100100;

  Stream.Init(FileName, FM_WRITE);
  Result := Stream.Ready;
  if Result then begin
    Stream.Write(@Header, SizeOf(Header));
    Stream.Write(FBuf, FWidth * FHeight * 4);
  end else begin
    Log('Cannot save screenshot to ' + FileName + ': ' + Stream.Error.Msg);
  end;
  Stream.Done;
end;

function TScreenshotSaver.SaveScreenshotTgaToDir(const Dir: AnsiString): Boolean;
var
  Path: AnsiString;
  Index: PtrUInt;
begin
  Log('Saving Screenshot');
  if (not DirExists(Dir)) and (not MakeDirectory(Dir)) then
    Exit(False);
  Log('Dir exists');
  Index := 0;
  repeat
    Path := Dir + '/screenshot-' + HexStr(Index, 4) + '.tga';
    Log('Trying path ' + Path);
    Inc(Index);
    if Index > $ffff then
      Exit(False);
  until not FileExists(Path);
  Log('Finally got path ' + Path);
  Exit(SaveScreenshotTga(Path));
end;

end.
