unit ARBprograms;

interface

uses Windows, SysUtils, Classes, Math3D, GL, GLu, GLext, WGLext, GLtools, Shaders;

type
  TARBprogram = class(TShader) // <- UNIVERSAL SHADER COMPATIBLE
  protected
    FTarget             : GLenum;
    FProgram            : GLuint;
    FSource             : TStringList;
    FLog                : string;
    procedure SetEnvParam(i: cardinal; value: TVector4); virtual;
    function GetEnvParam(i: cardinal): TVector4; virtual;
    procedure SetParam(i: cardinal; value: TVector4); override;
    function GetParam(i: cardinal): TVector4; override;
  public
    constructor Create(shaderType: GLenum); virtual;
    destructor Destroy; override;
    procedure Bind; override;
    procedure Enable; override;
    procedure Disable; override;
    procedure Load(filename: string); override;
    procedure Save(filename: string); virtual;
    property EnvParam[i: cardinal]: TVector4 read GetEnvParam write SetEnvParam;
    property LocalParam[i: cardinal]: TVector4 read GetParam write SetParam;
    property ProgramObject: GLuint read FProgram;
    property Log: string read FLog;
  end;

implementation

constructor TARBprogram.Create;
begin
  if not Load_GL_ARB_vertex_program then
    raise Exception.Create('GL_ARB_vertex_program required!');

  inherited Create;

  glGenProgramsARB(1, @FProgram);
  FTarget               := shaderType;
  FSource               := TStringList.Create;
end;

destructor TARBprogram.Destroy;
begin
  glDeleteProgramsARB(1, @FProgram);
  FSource.Free;

  inherited Destroy;
end;

procedure TARBprogram.Bind;
begin
  glBindProgramARB(FTarget, FProgram);
end;

procedure TARBprogram.Enable;
begin
  glEnable(FTarget);
  glBindProgramARB(FTarget, FProgram);
end;

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

procedure TARBprogram.Load;
begin
  FSource.LoadFromFile(filename);
  glBindProgramARB(FTarget, FProgram);
  glProgramStringARB(FTarget, GL_PROGRAM_FORMAT_ASCII_ARB,
                     length(FSource.Text), PChar(FSource.Text));
  FLog := PChar(glGetString(GL_PROGRAM_ERROR_STRING_ARB));
end;

procedure TARBprogram.Save;
begin
  FSource.SaveToFile(filename);
end;

procedure TARBprogram.SetEnvParam;
begin
  Bind;
  glProgramEnvParameter4fvARB(FTarget, i, @value);
end;

function TARBprogram.GetEnvParam;
begin
  Bind;
  glGetProgramEnvParameterfvARB(FTarget, i, @result);
end;

procedure TARBprogram.SetParam;
begin
  Bind;
  glProgramLocalParameter4fvARB(FTarget, i, @value);
end;

function TARBprogram.GetParam;
begin
  Bind;
  glGetProgramLocalParameterfvARB(FTarget, i, @result);
end;

end.
