unit Textures;

interface

uses Windows, SysUtils, GL, GLu, GLext, WGLext, GLtools, Images;

type
  TTexture = class
  protected
    FTexture            : cardinal;
    FTarget             : cardinal;
    FInternalFormat     : cardinal;
    procedure SetMagFilter(filter: cardinal); virtual;
    function GetMagFilter: cardinal; virtual;
    procedure SetMinFilter(filter: cardinal); virtual;
    function GetMinFilter: cardinal; virtual;
    procedure SetWrapModeS(mode: cardinal); virtual;
    function GetWrapModeS: cardinal; virtual;
    procedure SetWrapModeT(mode: cardinal); virtual;
    function GetWrapModeT: cardinal; virtual;
    procedure SetWrapModeR(mode: cardinal); virtual;
    function GetWrapModeR: cardinal; virtual;
    function GetWidth: cardinal; virtual;
    function GetHeight: cardinal; virtual;
    function GetDepth: cardinal; virtual;
    function GetBytesPerPel: cardinal; virtual;
    procedure SetImage(img: TImage); virtual; abstract;
    function GetImage: TImage; virtual; abstract;
  public
    constructor Create(eTarget: cardinal); virtual;
    destructor Destroy; override;
    procedure Enable; virtual;
    procedure Disable; virtual;
    procedure Bind; virtual;
    procedure Parameteri(param, value: GLint); overload; virtual;
    procedure Parameterf(param: GLint; value: GLfloat); overload; virtual;
    function Parameteri(param: GLint): GLint; overload; virtual;
    function Parameterf(param: GLint): GLfloat; overload; virtual;
    property Texture: cardinal read FTexture;
    property Target: cardinal read FTarget;
    property InternalFormat: cardinal read FInternalFormat write FInternalFormat;
    property MagFilter: cardinal read GetMagFilter write SetMagFilter;
    property MinFilter: cardinal read GetMinFilter write SetMinFilter;
    property WrapModeS: cardinal read GetWrapModeS write SetWrapModeS;
    property WrapModeT: cardinal read GetWrapModeT write SetWrapModeT;
    property WrapModeR: cardinal read GetWrapModeR write SetWrapModeR;
    property Width: cardinal read GetWidth;
    property Height: cardinal read GetHeight;
    property Depth: cardinal read GetDepth;
    property BytesPerPel: cardinal read GetBytesPerPel;
    property Image: TImage read GetImage write SetImage;
  end;

  TTexture1D = class(TTexture)
  protected
    procedure SetImage(img: TImage); override;
    function GetImage: TImage; override;
  public
    constructor Create; reintroduce; virtual;
  end;

  TTexture2D = class(TTexture)
  protected
    procedure SetImage(img: TImage); override;
    function GetImage: TImage; override;
  public
    constructor Create; reintroduce; virtual;
  end;

implementation

constructor TTexture.Create;
begin
  if not glext_ExtensionSupported('GL_EXT_texture_object') then
    raise Exception.Create('GL_EXT_texture_object required!');

  inherited Create;

  glGenTextures(1, @FTexture);
  FTarget               := eTarget;
  FInternalFormat       := 4;
  MagFilter             := GL_NEAREST;
  MinFilter             := GL_NEAREST;
  WrapModeS             := GL_REPEAT;
  WrapModeT             := GL_REPEAT;
  WrapModeR             := GL_REPEAT;
end;

destructor TTexture.Destroy;
begin
  glDeleteTextures(1, @FTexture);

  inherited Destroy;
end;

procedure TTexture.Enable;
begin
  glEnable(FTarget);
  glBindTexture(FTarget, FTexture);
end;

procedure TTexture.Disable;
begin
  glDisable(FTarget);
end;

procedure TTexture.Bind;
begin
  glBindTexture(FTarget, FTexture);
end;

procedure TTexture.Parameteri(param, value: GLint);
begin
  Bind;
  glTexParameteri(FTarget, param, value);
end;

procedure TTexture.Parameterf(param: GLint; value: GLfloat);
begin
  Bind;
  glTexParameterf(FTarget, param, value);
end;

function TTexture.Parameteri(param: GLint): GLint;
begin
  Bind;
  case param of
    GL_TEXTURE_MAG_FILTER, GL_TEXTURE_MIN_FILTER,
    GL_TEXTURE_WRAP_S, GL_TEXTURE_WRAP_T, GL_TEXTURE_WRAP_R:
         glGetTexParameteriv(FTarget, param, @result);
    else glGetTexLevelParameteriv(FTarget, 0, param, @result);
  end;
end;

function TTexture.Parameterf(param: GLint): GLfloat;
begin
  Bind;
  case param of
    GL_TEXTURE_MAG_FILTER, GL_TEXTURE_MIN_FILTER,
    GL_TEXTURE_WRAP_S, GL_TEXTURE_WRAP_T, GL_TEXTURE_WRAP_R:
         glGetTexParameterfv(FTarget, param, @result);
    else glGetTexLevelParameterfv(FTarget, 0, param, @result);
  end;
end;

procedure TTexture.SetMagFilter(filter: cardinal);
begin
  Parameteri(GL_TEXTURE_MAG_FILTER, filter);
end;

function TTexture.GetMagFilter: cardinal;
begin
  result := Parameteri(GL_TEXTURE_MAG_FILTER);
end;

procedure TTexture.SetMinFilter(filter: cardinal);
begin
  Parameteri(GL_TEXTURE_MIN_FILTER, filter);
end;

function TTexture.GetMinFilter: cardinal;
begin
  result := Parameteri(GL_TEXTURE_MIN_FILTER);
end;

procedure TTexture.SetWrapModeS(mode: cardinal);
begin
  Parameteri(GL_TEXTURE_WRAP_S, mode);
end;

function TTexture.GetWrapModeS: cardinal;
begin
  result := Parameteri(GL_TEXTURE_WRAP_S);
end;

procedure TTexture.SetWrapModeT(mode: cardinal);
begin
  Parameteri(GL_TEXTURE_WRAP_T, mode);
end;

function TTexture.GetWrapModeT: cardinal;
begin
  result := Parameteri(GL_TEXTURE_WRAP_T);
end;

procedure TTexture.SetWrapModeR(mode: cardinal);
begin
  Parameteri(GL_TEXTURE_WRAP_R, mode);
end;

function TTexture.GetWrapModeR: cardinal;
begin
  result := Parameteri(GL_TEXTURE_WRAP_R);
end;

function TTexture.GetWidth;
begin
  result := Parameteri(GL_TEXTURE_WIDTH);
end;

function TTexture.GetHeight;
begin
  result := Parameteri(GL_TEXTURE_HEIGHT);
end;

function TTexture.GetDepth;
begin
  result := Parameteri(GL_TEXTURE_DEPTH);
end;

function TTexture.GetBytesPerPel;
begin
  result := Parameteri(GL_TEXTURE_COMPONENTS);
end;

constructor TTexture1D.Create;
begin
  inherited Create(GL_TEXTURE_1D);
end;

procedure TTexture1D.SetImage;
var
  fmt: cardinal;
begin
  Bind;
  case img.BytesPerPel of
    1: fmt := GL_RED;
    2: fmt := GL_LUMINANCE_ALPHA;
    3: fmt := GL_BGR;
    4: fmt := GL_BGRA;
    else raise Exception.Create('TTexture1D.SetImage: Invalid bytes per pel');
  end;
  glTexImage1D(FTarget, 0, FInternalFormat,
               img.Width, 0, fmt, GL_UNSIGNED_BYTE, img.Data);
end;

function TTexture1D.GetImage;
var
  fmt: cardinal;
begin
  Bind;
  result := TImage.Create(Width, 1, BytesPerPel * 8);
  case BytesPerPel of
    1: fmt := GL_RED;
    2: fmt := GL_LUMINANCE_ALPHA;
    3: fmt := GL_RGB;
    4: fmt := GL_RGBA;
    else raise Exception.Create('TTexture1D.GetImage: Invalid bytes per pel');
  end;
  glGetTexImage(FTarget, 0, fmt, GL_UNSIGNED_BYTE, result.Data);
end;

constructor TTexture2D.Create;
begin
  inherited Create(GL_TEXTURE_2D);
end;

procedure TTexture2D.SetImage;
var
  fmt: cardinal;
begin
  Bind;
  case img.BytesPerPel of
    1: fmt := GL_RED;
    2: fmt := GL_LUMINANCE_ALPHA;
    3: fmt := GL_BGR;
    4: fmt := GL_BGRA;
    else raise Exception.Create('TTexture2D.SetImage: Invalid bytes per pel');
  end;
  glTexImage2D(FTarget, 0, FInternalFormat,
               img.Width, img.Height, 0, fmt, GL_UNSIGNED_BYTE, img.Data);
end;

function TTexture2D.GetImage;
var
  fmt: cardinal;
begin
  Bind;
  result := TImage.Create(Width, Height, BytesPerPel * 8);
  case BytesPerPel of
    1: fmt := GL_RED;
    2: fmt := GL_LUMINANCE_ALPHA;
    3: fmt := GL_BGR;
    4: fmt := GL_BGRA;
    else raise Exception.Create('TTexture2D.GetImage: Invalid bytes per pel');
  end;
  glGetTexImage(FTarget, 0, fmt, GL_UNSIGNED_BYTE, result.Data);
end;

end.
