unit TGA;

interface

uses Images, Windows, SysUtils, GL;

type
  TTGAHeader = packed record
    IDLength: byte;
    CMapType: byte;
    ImageType: byte;
    CMapSpec: packed record
        FirstEntryIndex: word;
        Length: word;
        EntrySize: byte;
      end;
    ImgSpec: packed record
        Xorg: word;
        Yorg: word;
        Width: word;
        Height: word;
        Depth: byte;
        Desc: byte;
      end;
  end;

function LoadTGA(filename: string): TImage;
procedure SaveTGA(filename: string; img: TImage);
procedure TGAScreenShot;

implementation

function LoadTGA(filename: string): TImage;
var
  f: File;
  hdr: TTGAHeader;
  size: cardinal;
begin
  Assign(f, filename);
  Reset(f, 1);

  BlockRead(f, hdr, SizeOf(TTGAHeader));

  if hdr.ImageType <> 2 then
  begin
    MessageBox(0, 'Invalid file format', 'LoadTGA', MB_ICONERROR or MB_OK);
    halt;
  end;

  size := (hdr.ImgSpec.Width * hdr.ImgSpec.Height * hdr.ImgSpec.Depth) div 8;

  if (hdr.ImgSpec.Depth <> 32) and (hdr.ImgSpec.Depth <> 24) then
  begin
    MessageBox(0, 'Unsupported color depth', 'LoadTGA', MB_ICONERROR or MB_OK);
    halt;
  end;

  Seek(f, FilePos(f) + hdr.IDLength);
  Seek(f, FilePos(f) + hdr.CMapSpec.Length * hdr.CMapSpec.EntrySize div 8);

  result := TImage.Create(hdr.ImgSpec.Width, hdr.ImgSpec.Height,
                          hdr.ImgSpec.Depth);

  BlockRead(f, result.Data^, size);

  Close(f);
end;

procedure SaveTGA;
var
  f: File;
  hdr: TTGAHeader;
  size: cardinal;
begin
  Assign(f, filename);
  ReWrite(f, 1);

  hdr.IDLength := 0;
  hdr.CMapType := 0;
  hdr.ImageType := 2;
  hdr.CMapSpec.FirstEntryIndex := 0;
  hdr.CMapSpec.Length := 0;
  hdr.CMapSpec.EntrySize := img.BytesPerPel * 8;
  hdr.ImgSpec.Xorg := 0;
  hdr.ImgSpec.Yorg := 0;
  hdr.ImgSpec.Width := img.Width;
  hdr.ImgSpec.Height := img.Height;
  hdr.ImgSpec.Depth := img.BytesPerPel * 8;
  hdr.ImgSpec.Desc := 0;

  BlockWrite(f, hdr, SizeOf(TTGAHeader));

  size := (hdr.ImgSpec.Width * hdr.ImgSpec.Height * hdr.ImgSpec.Depth) div 8;

  BlockWrite(f, img.Data^, size);

  Close(f);
end;

procedure TGAScreenShot;
var
  buf: array of Byte;
  tga: TTGAHeader;
  f: File;
  fname: String;
  i: Integer;
  vp: array[0..3] of GLint;
begin

  // Take a screenshot and dump it to a TGA in the 'screenshots' subdirectory.

  glGetIntegerv(GL_VIEWPORT, @vp);

  SetLength(buf, vp[2]*vp[3]*3);
  glReadPixels(0, 0, vp[2], vp[3], GL_BGR_EXT, GL_UNSIGNED_BYTE, @buf[0]);

  // Find a filename that isn't taken yet:
  i := 0;
  fname := Format('screenshot/shot%.4d.tga', [i]);
  while FileExists(fname) do
  begin
    INC(i);
    fname := Format('screenshot/shot%.4d.tga', [i]);
  end;

  // Fill out the TGA header:
  FillChar(tga, SizeOf(TTGAHeader), 0);
  with tga do
  begin
    ImageType := 2;
    ImgSpec.Width := vp[2];
    ImgSpec.Height := vp[3];
    ImgSpec.Depth := 24;
  end;

  // Dump.
  AssignFile(f, fname);
  Rewrite(f, 1);
  BlockWrite(f, tga, SizeOf(TTGAHeader));
  BlockWrite(f, buf[0], Length(buf));
  CloseFile(f);

end;

end.
