//----------------------------------------------------------------------------
//
// Author      : Jan Horn
// Email       : jhorn@global.co.za
// Website     : http://home.global.co.za/~jhorn
// Date        : 8 April 2001
// Description : A unit that used with OpenGL projects to load BMP files
// Usage       : LoadTexture(BMPFilename, TextureName);
//               eg : LoadTexture('logo.bmp', LogoTex);
//
// Changes     : 28 July. Faster BGR to RGB routine
//----------------------------------------------------------------------------
unit iz_texture;

interface

uses
  Windows, OpenGL, iz_utils, iz_types;

type
  izTextureItem = record
    FileName : string;
    Size : izSize_w;
    ID : uint;
    Count : word;
  end;

  zTextureManager = ^izTextureManager;
  izTextureManager = class
    Items : array of izTextureItem;
    Count : word;
    Binded : int;
  public
    constructor Create();
    destructor Destroy();
    procedure Clear();
    function Load(Filename: String) : word;
    procedure Bind(id : word);
    procedure Delete(id : word);
    function Find(FileName : string) : int;
    function GetSize(id : word) : izSize_w;
  end;

  procedure LoadBMPTexture( FileName : string; var ID : uint; var size : izSize_w );
  procedure LoadTGATexture( FileName : string; var ID : uint; var size : izSize_w );
  function CreateTexture( size : izSize_w; Format : Word;  pData : Pointer ) : int;
implementation
uses
  iz_gfx;

procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32;
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;
procedure glDeleteTextures(N: GLsizei; Textures: PGLuint); stdcall; external opengl32;

constructor izTextureManager.Create();
begin
  Count := 0;
  SetLength(Items,Count);
  Binded := -1;
end;

procedure izTextureManager.Clear();
var
  i : int;
begin
  for i := 0 to Count-1 do
  begin
    Items[i].FileName := '';
    glDeleteTextures(1, @Items[i].ID);
  end;
  Count := 0;
  SetLength(Items, Count);
end;

function izTextureManager.Find(FileName : string) : int;
var
  i : int;
begin
  Result := -1;
  for i := 0 to Count-1 do
    if Items[i].FileName = FileName then
    begin
      Result := i;
      break;
    end;
end;

{------------------------------------------------------------------}
{  Determines file type and sends to correct function              }
{------------------------------------------------------------------}
function izTextureManager.Load(Filename: String) : word;
var
  id : int;
  ext : string;
begin
  if not FileExists(FileName) then
  begin
    gfx.MsgErr('File '+FileName+' no exist.');
    exit;
  end;

  id := Find(FileName);
  if id < 0 then
  begin
    id := Find( '' );
    if id < 0 then
    begin
      id := Count;
      inc( Count );
      SetLength( Items, Count );
      Items[id].FileName := FileName;
      Items[id].Count := 1;
    end;

    ext := copy(UpperCase(Items[id].FileName), Length(Items[id].FileName)-3, 4);
    if ext = '.TGA' then
      LoadTGATexture(Items[id].FileName, Items[id].ID, Items[id].Size)
    else if ext = '.BMP' then
      LoadBMPTexture(Items[id].FileName, Items[id].ID, Items[id].Size);
  end
  else
    inc(Items[id].Count);

  Result := id;
end;

procedure izTextureManager.Bind(id : word);
begin
  if Binded <> Items[id].ID then
  begin
    glBindTexture(GL_TEXTURE_2D, Items[id].ID);
    Binded := Items[id].ID;
  end;
end;

procedure izTextureManager.Delete(id : word);
begin
  if Count > id then
  begin
    dec(Items[id].Count);
    if Items[id].Count <= 0 then
    begin
      if Binded = Items[id].ID then
        Binded := -1;
      Items[id].FileName := '';
      glDeleteTextures(1, @Items[id].ID);
    end;
  end;
end;

function izTextureManager.GetSize(id : word) : izSize_w;
begin
  Result := Items[id].Size;
end;

destructor izTextureManager.Destroy();
begin
  Clear();
end;


{------------------------------------------------------------------}
{  Swap bitmap format from BGR to RGB                              }
{------------------------------------------------------------------}
procedure SwapRGB(data : Pointer; Size : Integer);
asm
  mov ebx, eax
  mov ecx, size

@@loop :
  mov al,[ebx+0]
  mov ah,[ebx+2]
  mov [ebx+2],al
  mov [ebx+0],ah
  add ebx,3
  dec ecx
  jnz @@loop
end;


{------------------------------------------------------------------}
{  Load BMP textures                                               }
{------------------------------------------------------------------}
procedure LoadBMPTexture( FileName : string; var ID : uint; var size : izSize_w );
var
  FileHeader: BITMAPFILEHEADER;
  InfoHeader: BITMAPINFOHEADER;
  Palette: array of RGBQUAD;
  BitmapFile: THandle;
  BitmapLength: LongWord;
  PaletteLength: LongWord;
  ReadBytes: LongWord;
  pData : Pointer;
begin

  // Load image from file
  BitmapFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if (BitmapFile = INVALID_HANDLE_VALUE) then begin
    gfx.MsgErr('opening ' + Filename);
    Exit;
  end;

  // Get header information
  ReadFile(BitmapFile, FileHeader, SizeOf(FileHeader), ReadBytes, nil);
  ReadFile(BitmapFile, InfoHeader, SizeOf(InfoHeader), ReadBytes, nil);

  // Get palette
  PaletteLength := InfoHeader.biClrUsed;
  SetLength(Palette, PaletteLength);
  ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
  if (ReadBytes <> PaletteLength) then begin
    gfx.MsgErr('Error reading palette');
    Exit;
  end;

  Size[0]  := InfoHeader.biWidth;
  Size[1] := InfoHeader.biHeight;
  BitmapLength := InfoHeader.biSizeImage;
  if BitmapLength = 0 then
    BitmapLength := Size[0] * Size[1] * InfoHeader.biBitCount Div 8;

  // Get the actual pixel data
  GetMem(pData, BitmapLength);
  ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
  if (ReadBytes <> BitmapLength) then begin
    gfx.MsgErr('Error reading bitmap data');
    Exit;
  end;
  CloseHandle(BitmapFile);

  // Bitmaps are stored BGR and not RGB, so swap the R and B bytes.
  SwapRGB(pData, Size[0]*Size[1]);

  ID := CreateTexture(Size, GL_RGB, pData );
  FreeMem(pData);
end;

{------------------------------------------------------------------}
{  Loads 24 and 32bpp (alpha channel) TGA textures                 }
{------------------------------------------------------------------}
procedure LoadTGATexture( FileName : string; var ID : uint; var size : izSize_w );
var
  Result : bool;
  TGAHeader : packed record   // Header type for TGA images
    FileType     : Byte;
    ColorMapType : Byte;
    ImageType    : Byte;
    ColorMapSpec : Array[0..4] of Byte;
    OrigX  : Array [0..1] of Byte;
    OrigY  : Array [0..1] of Byte;
    Width  : Array [0..1] of Byte;
    Height : Array [0..1] of Byte;
    BPP    : Byte;
    ImageInfo : Byte;
  end;
  TGAFile   : File;
  bytesRead : Integer;
  image     : Pointer;    {or PRGBTRIPLE}
  CompImage : Pointer;
  ColorDepth    : Integer;
  ImageSize     : Integer;
  BufferIndex : Integer;
  currentByte : Integer;
  CurrentPixel : Integer;
  I : Integer;
  Front: ^Byte;
  Back: ^Byte;
  Temp: Byte;

  // Copy a pixel from source to dest and Swap the RGB color values
  procedure CopySwapPixel(const Source, Destination : Pointer);
  asm
    push ebx
    mov bl,[eax+0]
    mov bh,[eax+1]
    mov [edx+2],bl
    mov [edx+1],bh
    mov bl,[eax+2]
    mov bh,[eax+3]
    mov [edx+0],bl
    mov [edx+3],bh
    pop ebx
  end;

begin
  result :=FALSE;
  GetMem(Image, 0);

  AssignFile(TGAFile, Filename);
  Reset(TGAFile, 1);

  // Read in the bitmap file header
  BlockRead(TGAFile, TGAHeader, SizeOf(TGAHeader));
  result :=TRUE;

  if Result = TRUE then
  begin
    Result :=FALSE;

    // Only support 24, 32 bit images
    if (TGAHeader.ImageType <> 2) AND    { TGA_RGB }
       (TGAHeader.ImageType <> 10) then  { Compressed RGB }
    begin
      Result := False;
      CloseFile(tgaFile);
      gfx.MsgErr('Couldn''t load "'+ Filename +'". Only 24 and 32bit TGA supported.');
      Exit;
    end;

    // Don't support colormapped files
    if TGAHeader.ColorMapType <> 0 then
    begin
      Result := False;
      CloseFile(TGAFile);
      gfx.MsgErr('Couldn''t load "'+ Filename +'". Colormapped TGA files not supported.');
      Exit;
    end;

    // Get the width, height, and color depth
    Size[0]  := TGAHeader.Width[0]  + TGAHeader.Width[1]  * 256;
    Size[1] := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
    ColorDepth := TGAHeader.BPP;
    ImageSize  := Size[0]*Size[1]*(ColorDepth div 8);

    if ColorDepth < 24 then
    begin
      Result := False;
      CloseFile(TGAFile);
      gfx.MsgErr('Couldn''t load "'+ Filename +'". Only 24 and 32 bit TGA files supported.');
      Exit;
    end;

    GetMem(Image, ImageSize);

    if TGAHeader.ImageType = 2 then   // Standard 24, 32 bit TGA file
    begin
      BlockRead(TGAFile, image^, ImageSize, bytesRead);
      if bytesRead <> ImageSize then
      begin
        Result := False;
        CloseFile(TGAFile);
        gfx.MsgErr('Couldn''t read file "'+ Filename +'".');
        Exit;
      end;

      // TGAs are stored BGR and not RGB, so swap the R and B bytes.
      // 32 bit TGA files have alpha channel and gets loaded differently
      if TGAHeader.BPP = 24 then
      begin
        for I :=0 to Size[0] * Size[1] - 1 do
        begin
          Front := Pointer(Integer(Image) + I*3);
          Back := Pointer(Integer(Image) + I*3 + 2);
          Temp := Front^;
          Front^ := Back^;
          Back^ := Temp;
        end;
        ID :=CreateTexture(Size, GL_RGB, Image );
      end
      else
      begin
        for I :=0 to Size[0] * Size[1] - 1 do
        begin
          Front := Pointer(Integer(Image) + I*4);
          Back := Pointer(Integer(Image) + I*4 + 2);
          Temp := Front^;
          Front^ := Back^;
          Back^ := Temp;
        end;
        ID :=CreateTexture(Size, GL_RGBA, Image );
      end;
    end;

    // Compressed 24, 32 bit TGA files
    if TGAHeader.ImageType = 10 then
    begin
      ColorDepth :=ColorDepth DIV 8;
      CurrentByte :=0;
      CurrentPixel :=0;
      BufferIndex :=0;

      GetMem(CompImage, FileSize(TGAFile)-sizeOf(TGAHeader));
      BlockRead(TGAFile, CompImage^, FileSize(TGAFile)-sizeOf(TGAHeader), BytesRead);   // load compressed data into memory
      if bytesRead <> FileSize(TGAFile)-sizeOf(TGAHeader) then
      begin
        Result := False;
        CloseFile(TGAFile);
        gfx.MsgErr('Couldn''t read file "'+ Filename +'".');
        Exit;
      end;

      // Extract pixel information from compressed data
      repeat
        Front := Pointer(Integer(CompImage) + BufferIndex);
        Inc(BufferIndex);
        if Front^ < 128 then
        begin
          For I := 0 to Front^ do
          begin
            CopySwapPixel(Pointer(Integer(CompImage)+BufferIndex+I*ColorDepth), Pointer(Integer(image)+CurrentByte));
            CurrentByte := CurrentByte + ColorDepth;
            inc(CurrentPixel);
          end;
          BufferIndex :=BufferIndex + (Front^+1)*ColorDepth
        end
        else
        begin
          For I := 0 to Front^ -128 do
          begin
            CopySwapPixel(Pointer(Integer(CompImage)+BufferIndex), Pointer(Integer(image)+CurrentByte));
            CurrentByte := CurrentByte + ColorDepth;
            inc(CurrentPixel);
          end;
          BufferIndex :=BufferIndex + ColorDepth
        end;
      until CurrentPixel >= Size[0]*Size[1];

      if ColorDepth = 3 then
        ID :=CreateTexture(Size, GL_RGB, Image )
      else
        ID :=CreateTexture(Size, GL_RGBA, Image );
    end;
    CloseFile(TGAFile);

    Result :=TRUE;
    FreeMem(Image);
  end;
end;

function CreateTexture( size : izSize_w; Format : Word;  pData : Pointer ) : int;
var
  Texture : uint;
begin
  glGenTextures(1, Texture);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  {Texture blends with object background}

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); { only first two can be used }
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); { all of the above can be used }

  if Format = GL_RGBA then
    gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Size[0], Size[1], GL_RGBA, GL_UNSIGNED_BYTE, pData)
  else
    gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Size[0], Size[1], GL_RGB, GL_UNSIGNED_BYTE, pData);

  Result := Texture;
end;

end.
