{*******************************************************}
{                                                       }
{       Small Game Engine (Textures.pas)                }
{                                                       }
{       Copyright (C) 2010 IdeyaX studio                }
{                                                       }
{*******************************************************}
{$WARNINGS OFF}
unit Textures;

interface

uses
  Windows, OpenGL, Graphics, Classes, JPEG, SysUtils, Log,pngimage;

const
 GL_CLAMP_TO_EDGE = $812F;
 GL_RGB8          = $8051;
 GL_RGBA8         = $8058;
 GL_BGRA          = $80E1;
 GL_BGR           = $80E0;
 GL_TEXTURE0      = $84C0;
 GL_TEXTURE1      = $84C1;

 GL_NORMAL_ARRAY        = $8075;
 GL_COLOR_ARRAY         = $8076;
 GL_VERTEX_ARRAY        = $8074;
 GL_TEXTURE_COORD_ARRAY = $8078;


var
 SYSTexureList:array of GLuint;

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

function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
procedure EnableTexture(var ID:GLuInt);

function CreateTexture(Width, Height, Format : Word; pData : Pointer) : Integer;

procedure FreeAllTextures();
implementation

procedure FreeAllTextures();
var
  i:Integer;
begin
   for i:=0 to High(SYSTexureList) do
   glDeleteTextures( 1, @SYSTexureList[i] );
   SetLength(SYSTexureList,0);
end;

procedure AddTolist(Texture: GLuint);
var
  i:Integer;
begin
  i:=High(SYSTexureList)+1;
  SetLength(SYSTexureList,i+1);
  SYSTexureList[i]:=Texture;
end;

function LoadPNGTexture(Filename: String;var Texture: GLuint) : Boolean ;
const
  LoadFromResource = false;
var
  Data : Array of DWORD;
  W, Width : Integer;
  H, Height : Integer;
  AlphaPtr: PByte;
  PNG : TPngObject;
  //Texture : gluint;
begin
  Result:=False;

  if not FileExists(filename) then
  begin
    exit;
  end;

  PNG := TPngObject.Create;
  PNG.LoadFromFile(Filename);

  if PNG.Header.ColorType = COLOR_PALETTE then
    begin
      PNG.free;
      exit;
    end;

  Width := PNG.Width;
  Height := PNG.Height;
  SetLength(Data, Width * Height);

  if (PNG.Header.ColorType = COLOR_RGB) or
     (PNG.Header.ColorType = COLOR_GRAYSCALE) then
  begin
    For H := 0 to Height - 1 do
      For W := 0 to Width - 1 do
        Data[W + (H * Width)] := $FF000000 or PNG.Pixels[W, (Height-1)-H];
  end
  else
  if (PNG.Header.ColorType = COLOR_RGBALPHA) or
     (PNG.Header.ColorType = COLOR_GRAYSCALEALPHA) then
  begin
    for H := 0 to Height - 1 do
    begin
      AlphaPtr := PByte(PNG.AlphaScanline[(Height-1)-H]);
      for W := 0 to Width - 1 do
      begin
        Data[W + (H * Width)] := (($FF000000 and (AlphaPtr^ shl 24)) or PNG.Pixels[W, (Height-1)-H]);
        Inc(AlphaPtr);
      end;
    end;
  end;

  PNG.free;

  Texture := CreateTexture(Width, Height,GL_RGBA, Data);
  AddTolist(Texture);
  Result := True;
end;





procedure EnableTexture(var ID:GLuInt);
begin
glBindTexture(Gl_TEXTURE_2D,ID);
end;
{------------------------------------------------------------------}
{  Create the Texture                                              }
{------------------------------------------------------------------}
function CreateTexture(Width, Height, Format : Word; pData : Pointer) : Integer;
var
  Texture : GLuint;
begin
  glGenTextures(1, Texture);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  {Texture blends with object background}
//  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);  {Texture does NOT blend with object background}

  { Select a filtering type. BiLinear filtering produces very good results with little performance impact
    GL_NEAREST               - Basic texture (grainy looking texture)
    GL_LINEAR                - BiLinear filtering
    GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
    GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
  }

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

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

  if Format = GL_RGBA then
    gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
  else
    gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
//  glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);  // Use when not wanting mipmaps to be built by openGL

  result :=Texture;
end;


{------------------------------------------------------------------}
{  Load BMP textures                                               }
{------------------------------------------------------------------}
function LoadBMPTexture(Filename : String; var Texture : GLuInt) : Boolean;
type
TRGB = array [0..1] of record
Blue, Green, Red : Byte;
end;
var
    p : ^TRGB;
    idx : integer;
    B,B2 : TBitmap;
    i,j : Integer;
    Width,
    Height, ow,oh : Integer;
    pBits : pByteArray;
    Detail : real;
begin
result:=false;
Detail:=1.0;

  B := TBitmap.Create;

  try
  if fileexists(Filename) then
  B.LoadFromFile(Filename)
  else
  begin
   MessageBox(0, PChar('File not found "'+Filename+'"'), PChar('BMP Unit'), MB_OK or MB_ICONERROR);
   Exit;
  end;

  except
   MessageBox(0, PChar('Couldn''t load BMP from "'+Filename+'"'), PChar('BMP Unit'), MB_OK or MB_ICONERROR);
   Exit;
 end;

 B.PixelFormat := pf24bit;

  Detail:=1;

  oW := B.Width;
  oH := B.Height;

  B2:=TBitmap.Create;

  B2.Width:=round(B.Width*Detail);
  B2.Height:=round(B.Height*Detail);
  B2.PixelFormat:=pf24bit;

  SetStretchBltMode(B2.Canvas.Handle, COLORONCOLOR);
  StretchBlt(B2.Canvas.Handle, 0,0,B2.Width,B2.Height,B.Canvas.Handle, 0,0,B.Width,B.Height,SRCCOPY );

  B.Height:=B2.Height;
  B.Width:=B2.Width;

  BitBlt(B.Canvas.Handle,0,0,B.Width,B.Height,B2.Canvas.Handle,0,0,SRCCOPY);

  B2.Free;

  Width := B.Width;
  Height := B.Height;

  GetMem(pBits,Width*Height*4);

 idx := 0;
 for j := 0 to Height - 1 do
 begin
   p := B.ScanLine[j];
   for i := 0 to Width - 1 do
   with p[ i ] do
   begin
     pBits[idx] := Red;
     pBits[idx+1] := Green;
     pBits[idx+2] := Blue;
     if RGB(Red, Green, Blue) = $ff00ff then
       pBits[idx + 3] := 0
     else
       pBits[idx + 3] := 255;
       idx := idx + 4;
   end;
 end;

    Texture := CreateTexture(Width,Height,GL_RGBA,pbits);
    AddTolist(Texture);

  freemem(pbits);

  B.Free;
  result  := TRUE;
end;

{------------------------------------------------------------------}
{  Load JPEG textures                                              }
{------------------------------------------------------------------}
function LoadJPGTexture(Filename: String; var Texture: GLuint): Boolean;
var
  Data : Array of LongWord;
  W, Width : Integer;
  H, Height : Integer;
  BMP : TBitmap;
  JPG : TJPEGImage;
  C : LongWord;
  Line : ^LongWord;
  ResStream : TResourceStream;      // used for loading from resource
begin
  result :=FALSE;
  JPG:=TJPEGImage.Create;


    try
      JPG.LoadFromFile(Filename);
    except
      MessageBox(0, PChar('Couldn''t load JPG - "'+ Filename +'"'), PChar('BMP Unit'), MB_OK);
      Exit;
    end;

  // Create Bitmap
  BMP:=TBitmap.Create;
  BMP.pixelformat:=pf32bit;
  BMP.width:=JPG.width;
  BMP.height:=JPG.height;
  BMP.canvas.draw(0,0,JPG);        // Copy the JPEG onto the Bitmap

  //  BMP.SaveToFile('D:\test.bmp');
  Width :=BMP.Width;
  Height :=BMP.Height;
  SetLength(Data, Width*Height);

   For H:=0 to Height-1 do
  Begin
    Line :=BMP.scanline[h];   // flip JPEG
    For W:=0 to Width-1 do
    Begin
      c:=Line^ and $FFFFFF; // Need to do a color swap
      Data[W+(H*Width)] :=(((c and $FF) shl 16)+(c shr 16)+(c and $FF00)) or $FF000000;  // 4 channel.
      inc(Line);
    End;
  End;

  BMP.free;
  JPG.free;

  Texture :=CreateTexture(Width, Height, GL_RGBA, addr(Data[0]));
  AddTolist(Texture);
  result :=TRUE;
end;



{------------------------------------------------------------------}
{  Loads 24 and 32bpp (alpha channel) TGA textures                 }
{------------------------------------------------------------------}
function LoadTGATexture(Filename: String; var Texture: GLuint): Boolean;
var
  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}
  Width, Height : Integer;
  ColorDepth    : Integer;
  ImageSize     : Integer;
  I : Integer;
  Front: ^Byte;
  Back: ^Byte;
  Temp: Byte;

  ResStream : TResourceStream;      // used for loading from resource
begin
  result :=FALSE;
  GetMem(Image, 0);


    if FileExists(Filename) then
    begin
      AssignFile(TGAFile, Filename);
      Reset(TGAFile, 1);

      // Read in the bitmap file header
      BlockRead(TGAFile, TGAHeader, SizeOf(TGAHeader));
      result :=TRUE;
    end
    else
    begin
      MessageBox(0, PChar('File not found  - ' + Filename), PChar('TGA Texture'), MB_OK);
      Exit;
    end;

  if Result = TRUE then
  begin
    Result :=FALSE;

    // Only support uncompressed images
    if (TGAHeader.ImageType <> 2) then  { TGA_RGB }
    begin
      Result := False;
      CloseFile(tgaFile);
      MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Compressed TGA files not supported.'), PChar('TGA File Error'), MB_OK);
     AddToLog('False',TRUE,FALSE);
      Exit;
    end;

    // Don't support colormapped files
    if TGAHeader.ColorMapType <> 0 then
    begin
      Result := False;
      CloseFile(TGAFile);
      MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Colormapped TGA files not supported.'), PChar('TGA File Error'), MB_OK);
         AddToLog('False',TRUE,FALSE);
      Exit;
    end;

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

    if ColorDepth < 24 then
    begin
      Result := False;
      CloseFile(TGAFile);
      MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Only 24 bit TGA files supported.'), PChar('TGA File Error'), MB_OK);
         AddToLog('False',TRUE,FALSE);
      Exit;
    end;

    GetMem(Image, ImageSize);

      BlockRead(TGAFile, image^, ImageSize, bytesRead);
      if bytesRead <> ImageSize then
      begin
        Result := False;
        CloseFile(TGAFile);
        MessageBox(0, PChar('Couldn''t read file "'+ Filename +'".'), PChar('TGA File Error'), MB_OK);
        Exit;
      end;

  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 Width * Height - 1 do
    begin
      Front := Pointer(Integer(Image) + I*3);
      Back := Pointer(Integer(Image) + I*3 + 2);
      Temp := Front^;
      Front^ := Back^;
      Back^ := Temp;
    end;
    Texture :=CreateTexture(Width, Height, GL_RGB, Image);
  end
  else
  begin
    for I :=0 to Width * Height - 1 do
    begin
      Front := Pointer(Integer(Image) + I*4);
      Back := Pointer(Integer(Image) + I*4 + 2);
      Temp := Front^;
      Front^ := Back^;
      Back^ := Temp;
    end;
    Texture :=CreateTexture(Width, Height, GL_RGBA, Image);
  end;

  AddTolist(Texture);

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

// Работа с текстурой

{------------------------------------------------------------------}
{  Determines file type and sends to correct function              }
{------------------------------------------------------------------}
function LoadTexture(Filename: String; var Texture : GLuint) : Boolean;
begin
  Result:=False;
AddToLog('Loading Texture '+Filename+': ',FALSE,TRUE);
  if copy(filename, length(filename)-3, 4) = '.bmp' then
    Result:=LoadBMPTexture(Filename, Texture);
  if copy(filename, length(filename)-3, 4) = '.jpg' then
    Result:=LoadJPGTexture(Filename, Texture);
  if copy(filename, length(filename)-3, 4) = '.png' then
    Result:=LoadPNGTexture(Filename,Texture);
  if copy(filename, length(filename)-3, 4) = '.tga' then
    Result:=LoadTGATexture(Filename,Texture);

 if (Result) then AddToLog('OK',TRUE,FALSE) else AddToLog('ERROR',TRUE,FALSE);
end;


end.
