///////////////////////////////////////////////////////////////////////
// Copyright (C) Andru 2007                                          //
// mail: dr.andru@gmail.com                                          //
// site: http://andru.2x4.ru                                         //
//                                                                   //
// OMEGA Engine is free software.                                    //
//                                                                   //
// You may redistribute it and/or modify it under the terms of the   //
// GNU General Public License, as published by the Free Software     //
// Foundation; either version 2 of the License, or (at your option)  //
// any later version.                                                //
//                                                                   //
// this module is distributed in the hope that it will be useful,    //
// but WITHOUT ANY WARRANTY; without even the implied warranty of    //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.              //
// See the GNU General Public License for more details.              //
//                                                                   //
// You should have received a copy of the GNU General Public License //
// along with this module.  If not, write to:                        //
// 	The Free Software Foundation, Inc.,                              //
// 	51 Franklin Street, Fifth Floor                                  //
// 	Boston, MA  02110-1301, USA.                                     //
///////////////////////////////////////////////////////////////////////
unit TEXTURE_TGA;

interface

{$I DEFINES.pas}

uses
  minClasses,
  minFile,

  ENGINE_UTILS,

  TEXTURE_EFFECTS;

type
  TTGAHeader = packed record
    IDLength  : Byte;
    CPalType  : Byte;
    ImageType : Byte;
    CPalSpec  : packed record
      FirstEntry : Word;
      Length     : Word;
      EntrySize  : Byte;
    end;
    ImgSpec: packed record
      X      : Word;
      Y      : Word;
      Width  : Word;
      Height : Word;
      Depth  : Byte;
      Desc   : Byte;
    end;
end;

type
  TTGAImage = class
  protected
    procedure RLEDecode( S : TStream );
  public
    Header  : TTGAHeader;
    Data    : array of Byte;
    Palette : array of Byte;
    constructor Create;
    destructor  Destroy; override;

    procedure LoadFromStream( S : TStream );
    procedure LoadFromFile( FileName : PChar );

    procedure Normalize( var pData : Pointer );

    procedure ToTrueColor;

    procedure FlipVertically;
    procedure FlipHorizontally;
end;

implementation

procedure TTGAImage.RLEDecode;
  var
    pixelSize : Integer;
    i, j, n   : Integer;
    packetHdr : Byte;
    packet    : array of Byte;
    packetLen : Byte;
Begin
// Если RLE, то декодеруем
pixelSize := Header.ImgSpec.Depth div 8;
n         := Header.ImgSpec.Width * Header.ImgSpec.Height * pixelSize;
SetLength( Data, n );

SetLength( packet, pixelSize );

i := 0;
while i < n do
  begin
    // Читаем хедер
    S.Read( packetHdr, 1 );
    packetLen := ( packetHdr and $7F ) + 1;
    if ( packetHdr and $80 ) <> 0 Then
      begin
        S.Read( packet[ 0 ], pixelSize );
        for j := 0 to ( packetLen * pixelSize ) - 1 do
          begin
            Data[ i ] := packet[ j mod pixelSize ];
            INC( i );
          end;
      end else
        begin
          for j := 0 to (packetLen * pixelSize) - 1 do
            begin
              S.Read( packet[ j mod pixelSize ], 1 );
              Data[ i ] := packet[ j mod pixelSize ];
              INC( i );
           end;
        end;
  end;

// Изменяем формат в обычный после декомпрессии
Header.ImageType := Header.ImageType - 8;
End;

procedure TTGAImage.FlipVertically;
  var
    scanLine  : array of Byte;
    i, w, h,
    pixelSize : Integer;
Begin
w         := Header.ImgSpec.Width;
h         := Header.ImgSpec.Height;
pixelSize := Header.ImgSpec.Depth shr 3;

SetLength( scanLine, w * pixelSize );

for i := 0 to h shr 1 - 1 do
  begin
    Move(
          Data[ i * w * pixelSize ],
          scanLine[ 0 ],
          w * pixelSize
        );
    Move(
          Data[ ( h - i - 1 ) * w * pixelSize ],
          Data[ i * w * pixelSize ],
          w * pixelSize
        );
    Move(
          scanLine[ 0 ],
          Data[( h - i - 1 ) * w * pixelSize ],
          w * pixelSize
        );
  end;
End;

procedure TTGAImage.FlipHorizontally;
  var
    scanLine  : array of Byte;
    i, j,
    x, w, h,
    pixelSize : Integer;
Begin
w         := Header.ImgSpec.Width;
h         := Header.ImgSpec.Height;
pixelSize := Header.ImgSpec.Depth shr 3;

SetLength( scanLine, w * pixelSize );

for i := 0 to h - 1 do
  begin
    Move(
          Data[ i * w * pixelSize ],
          scanLine[ 0 ],
          w * pixelSize
        );
    for x := 0 to w shr 1 do
      for j := 0 to pixelSize - 1 do
        scanLine[ x * pixelSize + j ] := scanLine[ ( w - 1 - x ) * pixelSize + j ];
  end;
End;

procedure TTGAImage.ToTrueColor;
  var
    i, n, base : Integer;
    hasPalette : Boolean;
    entry      : Byte;
Begin

// Если не 8-битный TGA, то выходим
if Header.ImageType = 2 Then Exit;

hasPalette := Header.CPalType = 1;
if hasPalette and ( Header.CPalSpec.EntrySize <> 24 ) Then
  E_Error(
           {$IFDEF RUS} 'Неподдерживаемый формат цветовой палитры в TGA-файле!'
           {$ELSE}      'Unsupported color palette type in TGA-file!'
           {$ENDIF}
         );

base := Header.CPalSpec.FirstEntry;
n    := Length( Data );

Header.ImageType     := 2;
Header.ImgSpec.Depth := 24;
Header.CPalType      := 0;
FillChar ( Header.CPalSpec, SizeOf( Header.CPalSpec ), 0 );
SetLength( Data, Length( Data ) * 3 );

// Конвертация 8-битных пикселей в 24-битные
for i := n - 1 downto 0 do
  begin
    entry := Data[ i ];
    if hasPalette Then
      begin
        // Используем палитру
        Data[ i * 3 + 0 ] := Palette[ entry * 3 + 0 - base ];
        Data[ i * 3 + 1 ] := Palette[ entry * 3 + 1 - base ];
        Data[ i * 3 + 2 ] := Palette[ entry * 3 + 2 - base ];
      end else
        begin
          // Просто присваиваем значения
          Data[ i * 3 + 0 ] := entry;
          Data[ i * 3 + 1 ] := entry;
          Data[ i * 3 + 2 ] := entry;
        end;
  end;

End;

constructor TTGAImage.Create;
Begin

inherited Create;

FillChar( Header, SizeOf( TTGAHeader ), 0 );
SetLength( Data, 0 );

End;

procedure TTGAImage.LoadFromStream;
  var
    hasPalette, isRLE : Boolean;
    pixelSize         : Integer;
Begin

S.Read( Header, SizeOf( TTGAHeader ) );

hasPalette := Header.CPalType = 1;
isRLE      := Header.ImageType >= 9;
pixelSize  := Header.ImgSpec.Depth shr 3;

if hasPalette then
  begin
    with Header.CPalSpec do
      SetLength( Palette, Length * EntrySize shr 3 );
    S.Read( Palette[ 0 ], Length( Palette ) );
  end;

if isRLE Then
  RLEDecode( S )
else
  begin
    SetLength( Data, Header.ImgSpec.Width * Header.ImgSpec.Height * pixelSize );
    S.Read   ( Data[ 0 ], Length( Data ) );
  end;

// Если надо, то отражаем текстуру для стандарта OpenGL
if ( Header.ImgSpec.Desc and ( 1 shl 4 ) ) <> 0 Then FlipHorizontally;
if ( Header.ImgSpec.Desc and ( 1 shl 5 ) ) <> 0 Then FlipVertically;

End;

procedure TTGAImage.LoadFromFile;
  var
    S : TMemoryStream;
Begin

S := TMemoryStream.Create;
S.LoadFromFile( FileName );
LoadFromStream( S );
S.Free;

End;

procedure TTGAImage.Normalize;
  var
    i : Integer;
Begin
if Header.ImgSpec.Depth shr 3 = 3 Then
  begin
    Mem_Get( pData, Header.ImgSpec.Width * Header.ImgSpec.Height * 4 );
    for i := 0 to Header.ImgSpec.Width * Header.ImgSpec.Height - 1 do
      begin
        CopyRGB( Integer( pData ) + i * 4, Integer( Data ) + i * 3 );
        Byte( Pointer( Integer( pData ) + i * 4 + 3 )^ ) := 255;
      end;
  end else
    if Header.ImgSpec.Depth shr 3 = 4 Then
      begin
        Mem_Get( pData, Header.ImgSpec.Width * Header.ImgSpec.Height * 4 );
        Move( Pointer( Data )^, pData^, Header.ImgSpec.Width * Header.ImgSpec.Height * 4 );
      end else
        pData := nil;
End;

destructor TTGAImage.Destroy;
Begin

SetLength( Data, 0 );
inherited Destroy;

End;

end.
