unit ATIfragmentShader;

interface

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

type
  TATIfragmentShader = class(TShader) // <- UNIVERSAL SHADER COMPATIBLE
  protected
    FShader             : GLuint;
    FLog                : string;
    procedure SetParam(i: cardinal; p: TVector4); override;
    function GetParam(i: cardinal): TVector4; override;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Bind; override;
    procedure Enable; override;
    procedure Disable; override;
    procedure Load(filename: string); override;
    property ShaderObject: GLuint read FShader;
    property Log: string read FLog;
  end;

implementation

constructor TATIfragmentShader.Create;
begin
  if not Load_GL_ATI_fragment_shader then
    raise Exception.Create('GL_ATI_fragment_shader required!');

  inherited Create;

  FShader := glGenFragmentShadersATI(1);
end;

destructor TATIfragmentShader.Destroy;
begin
  glDeleteFragmentShaderATI(FShader);

  inherited Destroy;
end;

procedure TATIfragmentShader.Bind;
begin
  glBindFragmentShaderATI(FShader);
end;

procedure TATIfragmentShader.Enable;
begin
  glBindFragmentShaderATI(FShader);
  glEnable(GL_FRAGMENT_SHADER_ATI);
end;

procedure TATIfragmentShader.Disable;
begin
  glDisable(GL_FRAGMENT_SHADER_ATI);
end;

procedure TATIfragmentShader.Load;

  function GetEnumEx(s: string): cardinal;
  begin
    if Copy(s, 1, 3) = 'TEX' then
    begin
      Delete(s, 1, 3);
      result := GL_TEXTURE0 + Vali(s);
    end else
    if s[1] = 'R' then
    begin
      Delete(s, 1, 1);
      result := GL_REG_0_ATI + Vali(s);
    end else
    if s[1] = 'C' then
    begin
      Delete(s, 1, 1);
      result := GL_CON_0_ATI + Vali(s);
    end else
    if s = 'OUT' then
    begin
      result := GL_REG_0_ATI;
    end else
    if s = '0' then result := GL_ZERO else
    if s = '1' then result := GL_ONE else
    if s = 'COL0' then result := GL_PRIMARY_COLOR_ARB else
    if s = 'COL1' then result := GL_SECONDARY_INTERPOLATOR_ATI else
      FLog := FLog + 'Invalid token "' + s + '"'#13#10;
  end;

  function GetEnum(s: string): cardinal;
  begin
    if Pos('.', s) = 0 then result := GetEnumEx(s)
                       else result := GetEnumEx(Copy(s, 1, Pos('.', s)-1));
  end;

  function GetSwizzleEx(s: string): cardinal;
  begin
    if s = 'STR' then result := GL_SWIZZLE_STR_ATI else
    if s = 'STQ' then result := GL_SWIZZLE_STQ_ATI else
    if s = 'RGB' then result := GL_SWIZZLE_STR_ATI else
    if s = 'RGA' then result := GL_SWIZZLE_STQ_ATI else
      FLog := FLog + 'Invalid swizzle mode'#13#10;
  end;

  function GetSwizzle(s: string): cardinal;
  begin
    if Pos('.', s) = 0 then result := GL_SWIZZLE_STR_ATI
                       else result := GetSwizzleEx(Copy(s, Pos('.', s)+1, 255));
  end;

  function GetDstMod(s: string; var dstMask: cardinal): cardinal;
  var
    t: string;
  begin
    if Pos('.', s) = 0 then result := 0 else
    begin
      s := s + '.';
      Delete(s, 1, Pos('.', s));
      result := 0;
      while s <> '' do
      begin
        t := Copy(s, 1, Pos('.', s)-1);
        if t = 'X2' then result := result or GL_2X_BIT_ATI else
        if t = 'X4' then result := result or GL_4X_BIT_ATI else
        if t = 'X8' then result := result or GL_8X_BIT_ATI else
        if t = 'DIV2' then result := result or GL_HALF_BIT_ATI else
        if t = 'DIV4' then result := result or GL_QUARTER_BIT_ATI else
        if t = 'DIV8' then result := result or GL_EIGHTH_BIT_ATI else
        if t = 'R' then dstMask := GL_RED_BIT_ATI else
        if t = 'G' then dstMask := GL_GREEN_BIT_ATI else
        if t = 'B' then dstMask := GL_BLUE_BIT_ATI else
        if t = 'A' then dstMask := 8 else
        if t = 'RG' then dstMask := GL_RED_BIT_ATI or GL_GREEN_BIT_ATI else
        if t = 'RB' then dstMask := GL_RED_BIT_ATI or GL_BLUE_BIT_ATI else
        if t = 'GB' then dstMask := GL_GREEN_BIT_ATI or GL_BLUE_BIT_ATI else
        if t = 'RA' then dstMask := GL_RED_BIT_ATI or 8 else
        if t = 'GA' then dstMask := GL_GREEN_BIT_ATI or 8 else
        if t = 'BA' then dstMask := GL_BLUE_BIT_ATI or 8 else
        if t = 'RGB' then dstMask := GL_RED_BIT_ATI or GL_GREEN_BIT_ATI or GL_BLUE_BIT_ATI else
        if t = 'RGA' then dstMask := GL_RED_BIT_ATI or GL_GREEN_BIT_ATI or 8 else
        if t = 'RBA' then dstMask := GL_RED_BIT_ATI or GL_BLUE_BIT_ATI or 8 else
        if t = 'GBA' then dstMask := GL_GREEN_BIT_ATI or GL_BLUE_BIT_ATI or 8 else
        if t = 'RGBA' then dstMask := GL_RED_BIT_ATI or GL_GREEN_BIT_ATI or GL_BLUE_BIT_ATI or 8 else
          FLog := FLog + 'Invalid destination modifier "' + t + '"'#13#10;
        Delete(s, 1, Pos('.', s));
      end;
    end;
  end;

  function GetArgMod(s: string; var argRep: cardinal): cardinal;
  var
    t: string;
  begin
    if Pos('.', s) = 0 then result := 0 else
    begin
      s := s + '.';
      Delete(s, 1, Pos('.', s));
      result := 0;
      while s <> '' do
      begin
        t := Copy(s, 1, Pos('.', s)-1);
        if t = 'X2' then result := result or GL_2X_BIT_ATI else
        if t = 'COMP' then result := result or GL_COMP_BIT_ATI else
        if t = 'BIAS' then result := result or GL_BIAS_BIT_ATI else
        if t = 'R' then argRep := GL_RED else
        if t = 'G' then argRep := GL_GREEN else
        if t = 'B' then argRep := GL_BLUE else
        if t = 'A' then argRep := GL_ALPHA else
          FLog := FLog + 'Invalid argument modifier "' + t + '"'#13#10;
        Delete(s, 1, Pos('.', s));
      end;
    end;
  end;

var
  f: text;
  s: string;
  DEFdstMask: cardinal;
  dst, dstMask, dstMod: cardinal;
  arg, argRep, argMod: array[1..3] of cardinal;
  i: integer;
  Op: cardinal;
  l: TParamList;
  final: boolean;
  c: TVector4;
begin
  FLog := '';
  glBindFragmentShaderATI(FShader);
  glBeginFragmentShaderATI;
  assign(f, filename);
  reset(f);
  readln(f, s);
  if s <> '!!ATIfs1.1' then
    FLog := FLog + 'Invalid file format'#13#10;
  DEFdstMask := GL_RED_BIT_ATI or GL_GREEN_BIT_ATI or GL_BLUE_BIT_ATI or 8;
  repeat
    l := GetNextCommandASM(f);
    s := Copy(l[0], 1, 3);
    dstMod          := GL_NONE;
    dstMask         := DEFdstMask;
    if Copy(l[0], length(l[0])-3, 4) = '_SAT' then
      dstMod := dstMod or GL_SATURATE_BIT_ATI;
    if l[0] = 'OPTION' then
    begin
      if l[1] = 'ATI_DEFAULT_MASK_COLOR_ONLY;' then
        DEFdstMask := GL_RED_BIT_ATI or GL_GREEN_BIT_ATI or GL_BLUE_BIT_ATI else
        FLog := FLog + 'Invalid program option'#13#10;
    end else
    if l[0] = 'PARAM' then
    begin
      if (l[2] <> '=') or (l[3] <> '{') or (l[8] <> '};') then
        FLog := FLog + 'Invalid value'#13#10;
      Delete(l[4], length(l[4]), 1);
      Delete(l[5], length(l[5]), 1);
      Delete(l[6], length(l[6]), 1);
      Delete(l[7], length(l[7]), 1);
      c := Vector4(Valf(l[4]), Valf(l[5]), Valf(l[6]), Valf(l[7]));
      glSetFragmentShaderConstantATI(GetEnum(l[1]), @c);
    end else
    if s = 'PTC' then
    begin
      if l[1][length(l[1])] <> ',' then
        FLog := FLog + '"," expected'#13#10;
      if l[2][length(l[2])] <> ';' then
        FLog := FLog + '";" expected'#13#10;
      Delete(l[1], length(l[1]), 1);
      Delete(l[2], length(l[2]), 1);
      glPassTexCoordATI(GetEnum(l[1]), GetEnum(l[2]), GetSwizzle(l[2]));
    end else
    if s = 'TEX' then
    begin
      if l[1][length(l[1])] <> ',' then
        FLog := FLog + '"," expected'#13#10;
      if l[2][length(l[2])] <> ';' then
        FLog := FLog + '";" expected'#13#10;
      Delete(l[1], length(l[1]), 1);
      Delete(l[2], length(l[2]), 1);
      glSampleMapATI(GetEnum(l[1]), GetEnum(l[2]), GetSwizzle(l[2]));
    end else
    if s = 'TXP' then
    begin
      if l[1][length(l[1])] <> ',' then
        FLog := FLog + '"," expected'#13#10;
      if l[2][length(l[2])] <> ';' then
        FLog := FLog + '";" expected'#13#10;
      Delete(l[1], length(l[1]), 1);
      Delete(l[2], length(l[2]), 1);
      glSampleMapATI(GetEnum(l[1]), GetEnum(l[2]), GetSwizzle(l[2]) + 2);
    end else
    begin
      if s = 'ADD' then Op := GL_ADD_ATI else
      if s = 'SUB' then Op := GL_SUB_ATI else
      if s = 'MUL' then Op := GL_MUL_ATI else
      if s = 'MAD' then Op := GL_MAD_ATI else
      if s = 'LRP' then Op := GL_LERP_ATI else
      if s = 'MOV' then Op := GL_MOV_ATI else
      if s = 'SGH' then Op := GL_CND_ATI else
      if s = 'SGZ' then Op := GL_CND0_ATI else
      if Copy(l[0], 1, 4) = 'DP2A' then Op := GL_DOT2_ADD_ATI else
      if s = 'DP3' then Op := GL_DOT3_ATI else
      if s = 'DP4' then Op := GL_DOT4_ATI else
      if s = 'END' then break else
        FLog := FLog + 'Invalid instruction "' + s + '"'#13#10;
      if l[1][length(l[1])] <> ',' then
        FLog := FLog + '"," expected'#13#10;
      Delete(l[1], length(l[1]), 1);
      dst := GetEnum(l[1]);
      dstMod := dstMod or GetDstMod(l[1], dstMask);
      i := 1; final := false;
      repeat
        if l[i+1][length(l[i+1])] = ';' then final := true;
        Delete(l[i+1], length(l[i+1]), 1);
        argMod[i] := 0; argRep[i] := 0;
        if l[i+1][1] = '-' then
        begin
          argMod[i] := GL_NEGATE_BIT_ATI;
          Delete(l[i+1], 1, 1);
        end;
        arg[i] := GetEnum(l[i+1]);
        argMod[i] := argMod[i] or GetArgMod(l[i+1], argRep[i]);
        inc(i);
      until final;
      if dstMask and 7 <> 0 then
      case Op of
        GL_MOV_ATI:
          glColorFragmentOp1ATI(Op, dst, dstMask and 7, dstMod,
                                arg[1], argRep[1], argMod[1]);
        GL_ADD_ATI, GL_SUB_ATI, GL_MUL_ATI, GL_DOT3_ATI, GL_DOT4_ATI:
          glColorFragmentOp2ATI(Op, dst, dstMask and 7, dstMod,
                                arg[1], argRep[1], argMod[1],
                                arg[2], argRep[2], argMod[2]);
        GL_MAD_ATI, GL_LERP_ATI, GL_CND_ATI, GL_CND0_ATI, GL_DOT2_ADD_ATI:
          glColorFragmentOp3ATI(Op, dst, dstMask and 7, dstMod,
                                arg[1], argRep[1], argMod[1],
                                arg[2], argRep[2], argMod[2],
                                arg[3], argRep[3], argMod[3]);
      end;
      if dstMask and 8 <> 0 then
      case Op of
        GL_MOV_ATI:
          glAlphaFragmentOp1ATI(Op, dst, dstMod,
                                arg[1], argRep[1], argMod[1]);
        GL_ADD_ATI, GL_SUB_ATI, GL_MUL_ATI, GL_DOT3_ATI, GL_DOT4_ATI:
          glAlphaFragmentOp2ATI(Op, dst, dstMod,
                                arg[1], argRep[1], argMod[1],
                                arg[2], argRep[2], argMod[2]);
        GL_MAD_ATI, GL_LERP_ATI, GL_CND_ATI, GL_CND0_ATI, GL_DOT2_ADD_ATI:
          glAlphaFragmentOp3ATI(Op, dst, dstMod,
                                arg[1], argRep[1], argMod[1],
                                arg[2], argRep[2], argMod[2],
                                arg[3], argRep[3], argMod[3]);
      end;
    end;
  until false;
  close(f);
  glEndFragmentShaderATI;
end;

procedure TATIfragmentShader.SetParam;
begin
  Bind;
  glSetFragmentShaderConstantATI(GL_CON_0_ATI + i, @p);
end;

function TATIfragmentShader.GetParam;
begin
end;

end.
