unit FragmentCombiners;

interface

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

type
  TFragmentCombiner = class(TShader) // <- UNIVERSAL SHADER COMPATIBLE
  protected
    Multiplier0RGB    : cardinal;
    Multiplier0Alpha  : cardinal;
    Multiplier1RGB    : cardinal;
    Multiplier1Alpha  : cardinal;
    CombineModeRGB    : cardinal;
    CombineModeAlpha  : cardinal;
    ConstantColor     : TVector4;
    UseConstantColor  : boolean;

    FCombiner         : cardinal;

    FLog              : string;

    procedure SetParam(i: cardinal; value: TVector4); override;
    function GetParam(i: cardinal): TVector4; override;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Load(filename: string); override;
    procedure Compile; virtual;
    procedure Bind; override;
    procedure Enable; override;
    procedure Disable; override;
    property Log: string read FLog;
  end;

implementation

constructor TFragmentCombiner.Create;
begin
  if not Load_GL_EXT_blend_color then
    raise Exception.Create('GL_EXT_blend_color required!');
  if not Load_GL_EXT_blend_func_separate then
    raise Exception.Create('GL_EXT_blend_func_separate required!');
  if not Load_GL_EXT_blend_minmax then
    raise Exception.Create('GL_EXT_blend_minmax required!');
  if not glext_ExtensionSupported('GL_EXT_blend_subtract') then
    raise Exception.Create('GL_EXT_blend_subtract required!');

  inherited Create;

  Multiplier0RGB             := GL_ONE;
  Multiplier0Alpha           := GL_ONE;
  Multiplier1RGB             := GL_ZERO;
  Multiplier1Alpha           := GL_ZERO;
  CombineModeRGB             := GL_FUNC_ADD_EXT;
  CombineModeAlpha           := GL_FUNC_ADD_EXT;
  ConstantColor              := Vector4(0, 0, 0, 0);
  UseConstantColor           := false;
end;

destructor TFragmentCombiner.Destroy;
begin
  glDeleteLists(FCombiner, 1);

  inherited Destroy;
end;

procedure TFragmentCombiner.Load;
var
  f: text;
  s: string;
  l: TParamList;

  function GetEnum(s: string): cardinal;
  begin
    if s = 'SOURCE' then result := GL_SRC_COLOR else
    if s = 'DESTIN' then result := GL_DST_COLOR else
    if s = '1' then result := GL_ONE else
    if s = '0' then result := GL_ZERO else
    if s = '(1-SOURCE)' then result := GL_ONE_MINUS_SRC_COLOR else
    if s = '(1-DESTIN)' then result := GL_ONE_MINUS_DST_COLOR else
    if s = 'CONST' then result := GL_CONSTANT_COLOR_EXT else
    if s = '(1-CONST)' then result := GL_ONE_MINUS_CONSTANT_COLOR_EXT else
      FLog := FLog + 'Unknown identifier'#13#10;
  end;

  procedure Process(var Mode, M0, M1: cardinal);
  begin
    l := GetNextCommand(f);
    if l[0] <> '{' then
      FLog := FLog + '"{" expected'#13#10;
    repeat
      l := GetNextCommand(f);
      if l[0] = 'OPERAND0' then
      begin
        if (l[1] = '=') and (l[2][length(l[2])] = ';') then
        begin
          if l[2] = 'SOURCE;' then M0 := GL_ONE else
          if l[2] = '0;' then M0 := GL_ZERO else
            FLog := FLog + 'Unknown identifier'#13#10;
        end else
        if (l[1] = '=') and (l[2] = 'SOURCE') and (l[3] = '*') and (l[4][length(l[4])] = ';') then
        begin
          Delete(l[4], length(l[4]), 1);
          M0 := GetEnum(l[4]);
        end else
          FLog := FLog + 'Invalid operation'#13#10;
      end else
      if l[0] = 'OPERAND1' then
      begin
        if (l[1] = '=') and (l[2][length(l[2])] = ';') then
        begin
          if l[2] = 'DESTIN;' then M1 := GL_ONE else
          if l[2] = '0;' then M1 := GL_ZERO else
            FLog := FLog + 'Unknown identifier'#13#10;
        end else
        if (l[1] = '=') and (l[2] = 'DESTIN') and (l[3] = '*') and (l[4][length(l[4])] = ';') then
        begin
          Delete(l[4], length(l[4]), 1);
          M1 := GetEnum(l[4]);
        end else
          FLog := FLog + 'Invalid operation'#13#10;
      end else
      if l[0] = 'RESULT' then
      begin
        if l[1] <> '=' then
          FLog := FLog + '"=" expected'#13#10;
        if (l[2][length(l[2])] = ';') then
        begin
          if l[2] = 'SOURCE;' then
          begin
            M0 := GL_ONE;
            M1 := GL_ZERO;
            Mode := GL_FUNC_ADD_EXT;
          end else
          if l[2] = 'DESTIN;' then
          begin
            M0 := GL_ZERO;
            M1 := GL_ONE;
            Mode := GL_FUNC_ADD_EXT;
          end else
          if l[2] = '0;' then
          begin
            M0 := GL_ZERO;
            M1 := GL_ZERO;
            Mode := GL_FUNC_ADD_EXT;
          end else
          if l[2] = 'OPERAND0;' then
          begin
            M1 := GL_ZERO;
            Mode := GL_FUNC_ADD_EXT;
          end else
          if l[2] = 'OPERAND1;' then
          begin
            M0 := GL_ZERO;
            Mode := GL_FUNC_ADD_EXT;
          end else
            FLog := FLog + 'Invalid operation'#13#10;
        end else
        if (l[2] = 'OPERAND0') and (l[4] = 'OPERAND1;') then
        begin
          if l[3] = '+' then Mode := GL_FUNC_ADD_EXT else
          if l[3] = '-' then Mode := GL_FUNC_SUBTRACT_EXT else
            FLog := FLog + 'Invalid operator'#13#10;
        end else
        if (l[2] = 'OPERAND1') and (l[4] = 'OPERAND0;') then
        begin
          if l[3] = '-' then Mode := GL_FUNC_REVERSE_SUBTRACT_EXT else
            FLog := FLog + 'Invalid operator'#13#10;
        end else
        if (l[3] = '(OPERAND0,') and (l[4] = 'OPERAND1);') then
        begin
          if l[2] = 'MIN' then Mode := GL_MIN_EXT else
          if l[2] = 'MAX' then Mode := GL_MAX_EXT else
            FLog := FLog + 'Invalid function'#13#10;
        end else
          FLog := FLog + 'Invalid operation'#13#10;
      end else
      if l[0] = '}' then break else
        FLog := FLog + 'Invalid instruction'#13#10;
    until false;
  end;

begin
  FLog := '';
  assign(f, filename);
  reset(f);
  readln(f, s);
  if s <> '!!FC1.0' then
    FLog := FLog + 'Invalid file format'#13#10;
    l := GetNextCommand(f);
    if l[0] = 'CONST' then
    begin
      if (l[1] <> '=') or (l[2] <> '(') or (l[7] <> ');') then
        FLog := FLog + 'Invalid value'#13#10;
      Delete(l[3], length(l[3]), 1);
      Delete(l[4], length(l[4]), 1);
      Delete(l[5], length(l[5]), 1);
      ConstantColor := Vector4(Valf(l[3]), Valf(l[4]), Valf(l[5]), Valf(l[6]));
      UseConstantColor := true;
      l := GetNextCommand(f);
    end;
    if l[0] <> '{' then
      FLog := FLog + '"{" expected'#13#10;
    repeat
      l := GetNextCommand(f);
      if l[0] = 'RGB' then
      // RGB PROCESSING
      begin
        Process(CombineModeRGB, Multiplier0RGB, Multiplier1RGB);
      end else
      if l[0] = 'ALPHA' then
      // ALPHA PROCESSING
      begin
        Process(CombineModeAlpha, Multiplier0Alpha, Multiplier1Alpha);
      end else
      if l[0] = '}' then break else
        FLog := FLog + 'Invalid fragment format "' + l[0] + '"'#13#10;
    until false;
  close(f);

  Compile;
end;

procedure TFragmentCombiner.Compile;
begin
  FCombiner := glGenLists(1);
  glNewList(FCombiner, GL_COMPILE);
    CombineModeAlpha := CombineModeRGB;
    glBlendEquationEXT(CombineModeRGB);
    if (Multiplier0RGB = Multiplier0Alpha) and
       (Multiplier1RGB = Multiplier1Alpha) then
      glBlendFunc(Multiplier0RGB, Multiplier1RGB) else
    begin
      case Multiplier0Alpha of
        GL_SRC_COLOR: Multiplier0Alpha := GL_SRC_ALPHA;
        GL_DST_COLOR: Multiplier0Alpha := GL_DST_ALPHA;
        GL_ONE_MINUS_SRC_COLOR: Multiplier0Alpha := GL_ONE_MINUS_SRC_ALPHA;
        GL_ONE_MINUS_DST_COLOR: Multiplier0Alpha := GL_ONE_MINUS_DST_ALPHA;
        GL_CONSTANT_COLOR_EXT: Multiplier0Alpha := GL_CONSTANT_ALPHA_EXT;
        GL_ONE_MINUS_CONSTANT_COLOR_EXT: Multiplier0Alpha := GL_ONE_MINUS_CONSTANT_ALPHA_EXT;
      end;
      case Multiplier1Alpha of
        GL_SRC_COLOR: Multiplier1Alpha := GL_SRC_ALPHA;
        GL_DST_COLOR: Multiplier1Alpha := GL_DST_ALPHA;
        GL_ONE_MINUS_SRC_COLOR: Multiplier1Alpha := GL_ONE_MINUS_SRC_ALPHA;
        GL_ONE_MINUS_DST_COLOR: Multiplier1Alpha := GL_ONE_MINUS_DST_ALPHA;
        GL_CONSTANT_COLOR_EXT: Multiplier1Alpha := GL_CONSTANT_ALPHA_EXT;
        GL_ONE_MINUS_CONSTANT_COLOR_EXT: Multiplier1Alpha := GL_ONE_MINUS_CONSTANT_ALPHA_EXT;
      end;
      glBlendFuncSeparateEXT(Multiplier0RGB, Multiplier1RGB,
        Multiplier0Alpha, Multiplier1Alpha);
    end;
    if UseConstantColor then glBlendColorEXT(ConstantColor.x, ConstantColor.y,
                                             ConstantColor.z, ConstantColor.w);
  glEndList;
end;

procedure TFragmentCombiner.SetParam;
begin
  if i = 0 then
  begin
    ConstantColor := value;
    UseConstantColor := true;
    Compile;
  end;
end;

function TFragmentCombiner.GetParam;
begin
  if i = 0 then
    result := ConstantColor;
end;

procedure TFragmentCombiner.Bind;
begin
  glCallList(FCombiner);
end;

procedure TFragmentCombiner.Enable;
begin
  glEnable(GL_BLEND);
  glCallList(FCombiner);
end;

procedure TFragmentCombiner.Disable;
begin
  glDisable(GL_BLEND);
end;

end.
