unit TextureCombiners;

interface

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

type
  TCombinerParami = array[0..31] of GLuint;
  TCombinerParamf = array[0..31] of GLfloat;
  TCombinerParamfv = array[0..31] of TVector4;
  TCombinerParamb = array[0..31] of boolean;

  TTextureCombiner = class(TShader) // <- UNIVERSAL SHADER COMPATIBLE
  protected
    FDisplayList        : GLuint;
    FCompiled           : boolean;

    FLog                : string;

    procedure SetParam(i: cardinal; value: TVector4); override;
    function GetParam(i: cardinal): TVector4; override;
  public
    CombineModeRGB      : TCombinerParami;
    CombineModeAlpha    : TCombinerParami;
    Source0RGB          : TCombinerParami;
    Operand0RGB         : TCombinerParami;
    Source0Alpha        : TCombinerParami;
    Operand0Alpha       : TCombinerParami;
    Source1RGB          : TCombinerParami;
    Operand1RGB         : TCombinerParami;
    Source1Alpha        : TCombinerParami;
    Operand1Alpha       : TCombinerParami;
    Source2RGB          : TCombinerParami;
    Operand2RGB         : TCombinerParami;
    Source2Alpha        : TCombinerParami;
    Operand2Alpha       : TCombinerParami;
    RGBScale            : TCombinerParamf;
    AlphaScale          : TCombinerParamf;
    TexEnvColor         : TCombinerParamfv;
    UseTexEnvColor      : TCombinerParamb;
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Bind; override;
    procedure Enable; override;
    procedure Disable; override;
    procedure Load(filename: string); override;
    procedure Compile; virtual;
    property Compiled: boolean read FCompiled;
    property Log: string read FLog;
  end;

implementation

constructor TTextureCombiner.Create;
var
  i: integer;
begin
  if not glext_ExtensionSupported('GL_ARB_texture_env_combine') then
    raise Exception.Create('GL_ARB_texture_env_combine required!');

  inherited Create;

  for i := 0 to 31 do
  begin
    CombineModeRGB[i]      := 0;
    CombineModeAlpha[i]    := 0;
    Source0RGB[i]          := 0;
    Operand0RGB[i]         := 0;
    Source0Alpha[i]        := 0;
    Operand0Alpha[i]       := 0;
    Source1RGB[i]          := 0;
    Operand1RGB[i]         := 0;
    Source1Alpha[i]        := 0;
    Operand1Alpha[i]       := 0;
    Source2RGB[i]          := 0;
    Operand2RGB[i]         := 0;
    Source2Alpha[i]        := 0;
    Operand2Alpha[i]       := 0;
    RGBScale[i]            := 1;
    AlphaScale[i]          := 1;
    TexEnvColor[i]         := Vector4(0,0,0,0);
    UseTexEnvColor[i]      := false;
  end;

  FDisplayList := glGenLists(1);
  FCompiled := false;
end;

destructor TTextureCombiner.Destroy;
begin
  glDeleteLists(FDisplayList, 1);

  inherited Destroy;
end;

procedure TTextureCombiner.SetParam;
begin
  TexEnvColor[i] := value;
  UseTexEnvColor[i] := true;

  Compile;
end;

function TTextureCombiner.GetParam;
begin
  result := TexEnvColor[i];
end;

procedure TTextureCombiner.Bind;
begin
end;

procedure TTextureCombiner.Enable;
begin
  if not FCompiled then Compile;
  glCallList(FDisplayList);
end;

procedure TTextureCombiner.Disable;
begin
end;

procedure TTextureCombiner.Compile;
var
  i: integer;
begin
  glNewList(FDisplayList, GL_COMPILE);
  for i := 0 to 31 do
  begin
    glActiveTexture(GL_TEXTURE0 + i);
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB);
    if CombineModeRGB[i] <> 0 then
    begin
      glTexEnvi(GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, CombineModeRGB[i]);
      if Source0RGB[i] <> 0 then
      begin
        glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, Source0RGB[i]);
        glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND0_RGB_ARB, Operand0RGB[i]);
      end;
      if Source1RGB[i] <> 0 then
      begin
        glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE1_RGB_ARB, Source1RGB[i]);
        glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND1_RGB_ARB, Operand1RGB[i]);
      end;
      if Source2RGB[i] <> 0 then
      begin
        glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE2_RGB_ARB, Source2RGB[i]);
        glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND2_RGB_ARB, Operand2RGB[i]);
      end;
      glTexEnvf(GL_TEXTURE_ENV, GL_RGB_SCALE_ARB, RGBScale[i]);
    end;
    if CombineModeAlpha[i] <> 0 then
    begin
      glTexEnvi(GL_TEXTURE_ENV, GL_COMBINE_ALPHA_ARB, CombineModeAlpha[i]);
      if Source0Alpha[i] <> 0 then
      begin
        glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE0_ALPHA_ARB, Source0Alpha[i]);
        glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND0_ALPHA_ARB, Operand0Alpha[i]);
      end;
      if Source1Alpha[i] <> 0 then
      begin
        glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE1_ALPHA_ARB, Source1Alpha[i]);
        glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND1_ALPHA_ARB, Operand1Alpha[i]);
      end;
      if Source2Alpha[i] <> 0 then
      begin
        glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE2_ALPHA_ARB, Source2Alpha[i]);
        glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND2_ALPHA_ARB, Operand2Alpha[i]);
      end;
      glTexEnvf(GL_TEXTURE_ENV, GL_ALPHA_SCALE, AlphaScale[i]);
    end;
    if UseTexEnvColor[i] then glTexEnvfv(GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, @TexEnvColor[i]);
  end;
  glActiveTexture(GL_TEXTURE0);
  glEndList;
  FCompiled := true;
end;

procedure TTextureCombiner.Load;
var
  f: text;
  s: string;
  i: integer;
  l: TParamList;

  procedure SetSource(s: string; var Src, Op, DefOp: GLuint);
  begin
    if Copy(s, length(s)-3, 4) = '.RGB' then
    begin
      Delete(s, length(s)-3, 4);
      Op := GL_SRC_COLOR;
    end else
    if Copy(s, length(s)-5, 6) = '.ALPHA' then
    begin
      Delete(s, length(s)-5, 6);
      Op := GL_SRC_ALPHA;
    end else Op := DefOp;
    if s = 'STAGE' + Stri(i-1) then Src := GL_PREVIOUS_ARB else
    if Copy(s, 1, 5) = 'CONST' then Src := GL_CONSTANT_ARB else
    if s = 'COLOR0' then Src := GL_PRIMARY_COLOR_ARB else
    if s = 'TEX' then Src := GL_TEXTURE else
    if Copy(s, 1, 3) = 'TEX' then
    begin
      if not glext_ExtensionSupported('GL_ARB_texture_env_crossbar') then
        raise Exception.Create('GL_ARB_texture_env_crossbar required!');
      Src := GL_TEXTURE0 + Vali(Copy(s, 4, 255));
    end else
      raise Exception.Create('TTextureCombiner.Load: Unknown identifier');
  end;

  procedure Process(var Mode, S0, O0, S1, O1, S2, O2: TCombinerParami;
                    var Scale: TCombinerParamf; Operand: GLuint);
  begin
    l := GetNextCommand(f);
    if l[0] <> '{' then
      raise Exception.Create('TTextureCombiner.Load: "{" expected');
    repeat
      l := GetNextCommand(f);
      if l[0] = 'CONST' + Stri(i) then
      begin
        if (l[1] <> '=') or (l[2] <> '(') or (l[7] <> ');') then
          raise Exception.Create('TTextureCombiner.Load: Invalid value');
        Delete(l[3], length(l[3]), 1);
        Delete(l[4], length(l[4]), 1);
        Delete(l[5], length(l[5]), 1);
        TexEnvColor[i] := Vector4(Valf(l[3]), Valf(l[4]), Valf(l[5]), Valf(l[6]));
        UseTexEnvColor[i] := true;
      end else
      if l[0] = 'SCALE_BY_TWO();' then
      begin
        Scale[i] := 2.0;
      end else
      if l[0] = 'SCALE_BY_FOUR();' then
      begin
        Scale[i] := 4.0;
      end else
      if l[0] = 'STAGE' + Stri(i) then
      begin
        if l[1] <> '=' then
          raise Exception.Create('TTextureCombiner.Load: "=" expected');
        if High(l) = 3 then // REPLACE
        begin
          if l[2][length(l[2])] <> ';' then
            raise Exception.Create('TTextureCombiner.Load: ";" expected');
          Delete(l[2], length(l[2]), 1);
          Mode[i] := GL_REPLACE;
          SetSource(l[2], S0[i], O0[i], Operand);
        end else
        begin
          if length(l[3]) <> 1 then
            raise Exception.Create('TTextureCombiner.Load: Invalid operator');
          case l[3][1] of
            '*': // MODULATE
              begin
                if l[4][length(l[4])] <> ';' then
                  raise Exception.Create('TTextureCombiner.Load: ";" expected');
                Delete(l[4], length(l[4]), 1);
                Mode[i] := GL_MODULATE;
                SetSource(l[2], S0[i], O0[i], Operand);
                SetSource(l[4], S1[i], O1[i], Operand);
              end;
            '+': // ADD or ADD_SIGNED
              begin
                if High(l) = 5 then
                begin
                  if l[4][length(l[4])] <> ';' then
                    raise Exception.Create('TTextureCombiner.Load: ";" expected');
                  Delete(l[4], length(l[4]), 1);
                  Mode[i] := GL_ADD;
                  SetSource(l[2], S0[i], O0[i], Operand);
                  SetSource(l[4], S1[i], O1[i], Operand);
                end else
                begin
                  if (l[5] <> '-') or (l[6] <> '0.5;') then
                    raise Exception.Create('TTextureCombiner.Load: Invalid operation');
                  Mode[i] := GL_ADD_SIGNED_ARB;
                  SetSource(l[2], S0[i], O0[i], Operand);
                  SetSource(l[4], S1[i], O1[i], Operand);
                end;
              end;
            '-': // SUBTRACT
              begin
                if l[4][length(l[4])] <> ';' then
                  raise Exception.Create('TTextureCombiner.Load: ";" expected');
                Delete(l[4], length(l[4]), 1);
                Mode[i] := GL_SUBTRACT_ARB;
                SetSource(l[2], S0[i], O0[i], Operand);
                SetSource(l[4], S1[i], O1[i], Operand);
              end;
            ':': // INTERPOLATE
              begin
                if (l[5] <> '|') or (l[6][length(l[6])] <> ';') then
                  raise Exception.Create('TTextureCombiner.Load: Invalid operation');
                Delete(l[6], length(l[6]), 1);
                Mode[i] := GL_INTERPOLATE_ARB;
                SetSource(l[2], S0[i], O0[i], Operand);
                SetSource(l[4], S1[i], O1[i], Operand);
                SetSource(l[6], S2[i], O2[i], Operand);
              end;
            '.': // DOT3
              begin
                if l[4][length(l[4])] <> ';' then
                  raise Exception.Create('TTextureCombiner.Load: ";" expected');
                Delete(l[4], length(l[4]), 1);
                if not glext_ExtensionSupported('GL_ARB_texture_env_dot3') then
                  raise Exception.Create('GL_ARB_texture_env_dot3 required!');
                Mode[i] := GL_DOT3_RGB_ARB;
                SetSource(l[2], S0[i], O0[i], Operand);
                SetSource(l[4], S1[i], O1[i], Operand);
              end;
          end;
        end;
      end else
      if l[0] = '}' then break else
        raise Exception.Create('TTextureCombiner.Load: Invalid instruction');
    until false;
  end;

begin
  assign(f, filename);
  reset(f);
  readln(f, s);
  if s <> '!!TC1.0' then
    raise Exception.Create('TTextureCombiner.Load: Invalid file format');
  i := 0;
  while not eof(f) do
  begin
    if i > 31 then
      raise Exception.Create('TTextureCombiner.Load: Too many stages');
    l := GetNextCommand(f);
    if l[0] <> '{' then
      raise Exception.Create('TTextureCombiner.Load: "{" expected');
    repeat
      l := GetNextCommand(f);
      if l[0] = 'RGB' then
      // RGB PROCESSING
      begin
        Process(CombineModeRGB,
                Source0RGB, Operand0RGB,
                Source1RGB, Operand1RGB,
                Source2RGB, Operand2RGB,
                RGBScale, GL_SRC_COLOR);
      end else
      if l[0] = 'ALPHA' then
      // ALPHA PROCESSING
      begin
        Process(CombineModeAlpha,
                Source0Alpha, Operand0Alpha,
                Source1Alpha, Operand1Alpha,
                Source2Alpha, Operand2Alpha,
                AlphaScale, GL_SRC_ALPHA);
      end else
      if l[0] = '}' then break else
        raise Exception.Create('TTextureCombiner.Load: Invalid fragment format: ' + l[0]);
    until false;
    inc(i);
  end;
  close(f);
  Compile;
end;

end.
