// Wir beginnen mit Schritt 1, der Erstellung der Container für die Shader.
  VertexShaderHandle := glCreateShader (GL_VERTEX_SHADER);
  if ErrorHandler then begin
    if GetShaderInfoLog (VertexShaderHandle, pLog) then begin
      ShaderError('Fehler bei "glCreateShader (VertexShaderHandle)"'+#13+#10+
                  string (pLog));
      exit;
    end;
  end;

unit Shaders;

interface

uses
  glBmp,
  dGLOpenGL;

type
  TglShader = class
    // Handler-Variablen vom Typ „GLhandle“ deklarieren
    VertexShaderHandle, FragmentShaderHandle: GLhandle;
    // Programmhandle, mit dem nachher die shader aktiviert/deaktiviert werden
    ShaderProgramHandle: GLhandle;
    // jetzt die klassenmethoden
    constructor Create;
    destructor Destroy;
    procedure DeInstallShader;
    function DisableShaderProgram: boolean;
    function EnableShaderProgram: boolean;
    function FreeShaderBmpFile (nPic: integer): boolean;
    function GetProgramInfoLog (pObject : GlHandle; var pLog: string) : boolean;
    function GetShaderInfoLog (pObject : GlHandle; var pLog: string) : boolean;
    function GetUniLoc (pObject: glHandle; sUniform: pChar): glInt;
    function GetTexUnits: glInt;
    function InstallShaderBmpFile (cFile, cUniform: string; nUniform: integer): boolean;
    function InstallShader (VertexShaderFile, FragmentShaderFile: string): boolean;
  private
    // Zeiger auf den Quellcodespeicher der Shader deklarieren.
    VertexShaderSource, FragmentShaderSource: string;
    // hat alles geklappt?
    FShaderAvailable: boolean;
    // name der dateien für aktionen. werden in festgelegte textureinheiten
    // geladen. durch setzen von uniformvariablen kann dann im shader auf
    // diese dateien zugegriffen werden.
    ShaderBmpFile: array [1..7] of string;
    // die zu den jeweiligen dateinamen gehörenden internen bilder
    ShaderBmpPic: array [1..7] of tglbmp;
    function ErrorHandler: boolean;
  public
  published
    property ShaderAvailable: boolean read FShaderAvailable;
end;


implementation

uses
  forms,
  classes,
  OpenGLUtil,
  StdUtil,
  SysUtils,
  Functions;

function ReadTextFile (TextFile: string): string;
var
  sl: TStringlist;
begin
  sl:= TStringList.Create;
  sl.LoadFromFile(TextFile);

  result := sl.Text;

  sl.Free;
end;

function ShaderError (cError: string): boolean;
begin
  if not FuncIsComServer then begin
    StdFehler (cError);
  end;
  result := true;
end;

constructor TglShader.Create;
begin
  inherited create;
  FShaderAvailable := false;
end;

destructor TglShader.Destroy;
var
  i: integer;
begin
  for i := 1 to 7 do begin
    FreeShaderBmpFile (i);
  end;
  inherited destroy;
end;

function TglShader.InstallShader (VertexShaderFile, FragmentShaderFile: string): boolean;
var
  pVertexShaderSource, pFragmentShaderSource: PChar;
  pLog: string;
  TUs, arbTUs, nvTUs, atiTUs: GLint;
  pTUs, parbTUs, pnvTUs, patiTUs: pGLint;
  VertexShaderLen, FragmentShaderLen: GLint;
  pVertexShaderLen, pFragmentShaderLen: PGLint;
begin
  result := false;

  // Funktioniert sicher ab Version 2.0
  if not GL_VERSION_2_0 then begin
    ShaderError('Displacement Mapping wird nicht unterstützt!');
    exit;
  end;

  if (GetTexUnits < 2) then begin
    ShaderError('Displacement Mapping ist nicht möglich,'+#13+#10+
                'zu wenig Textureinheiten (1).');
    exit;
  end;

  TUs := 0; arbTUs := 0; nvTUs := 0; atiTUs := 0;

  pTUs := @TUs;
  glGetIntegerV (GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS, pTUs);
  parbTUs := @arbTUs;
  glGetIntegerV (GL_MAX_TEXTURE_IMAGE_UNITS_ARB, parbTUs);
  pnvTUs := @nvTUs;
  glGetIntegerV (GL_MAX_TEXTURE_IMAGE_UNITS_NV, pnvTUs);
  patiTUs := @atiTUs;
  glGetIntegerV (GL_BUMP_NUM_TEX_UNITS_ATI, patiTUs);
  if (TUs+arbTUs+nvTUs+atiTUs < 4) then begin
    ShaderError('Displacement Mapping ist nicht möglich,'+#13+#10+
                'zu wenig Textureinheiten (2).');
    exit;
  end;

  if not FileExists (VertexShaderFile) then begin
    ShaderError('Displacement Mapping ist nicht möglich,'+#13+#10+
                'Vertextdatei ist nicht vorhanden.'+#13+#10+
                '('+VertexShaderFile+')');
    exit;
  end;

  if not FileExists (FragmentShaderFile) then begin
    ShaderError('Displacement Mapping ist nicht möglich,'+#13+#10+
                'Fragmentdatei ist nicht vorhanden.'+#13+#10+
                '('+FragmentShaderFile+')');
    exit;
  end;

  // Wir beginnen mit Schritt 1, der Erstellung der Container für die Shader.
  VertexShaderHandle := glCreateShader (GL_VERTEX_SHADER);
  if ErrorHandler then begin
    if GetShaderInfoLog (VertexShaderHandle, pLog) then begin
      ShaderError('Fehler bei "glCreateShader (VertexShaderHandle)"'+#13+#10+
                  string (pLog));
      exit;
    end;
  end;
  FragmentShaderHandle := glCreateShader (GL_FRAGMENT_SHADER);
  if ErrorHandler then begin
    if GetShaderInfoLog (FragmentShaderHandle, pLog) then begin
      ShaderError('Fehler bei "glCompileShader (FragmentShaderHandle)"'+#13+#10+
                  string (pLog));
      exit;
    end;
  end;

  if (VertexShaderHandle = 0) or (FragmentShaderHandle = 0) then begin
    exit;
  end;

  // Im zweiten Schritt laden wir den Quellcode des Shaderpaares aus ihren
  // Dateien als Zeichenkettenfeld. Die Funktion „readTextFile“ bewerkstelligt
  // dies.
  VertexShaderSource   := ReadTextFile (VertexShaderFile);
  ErrorHandler;
  FragmentShaderSource := ReadTextFile (FragmentShaderFile);
  ErrorHandler;

  // Die geladen Quellcodes müssen jetzt in den betreffenden Container geladen
  // werden. Über die dafür deklarierten Konstanten „vv“ und „ff“ kann die
  // Operation durchgeführt werden. Dannach wird der Speicher für die
  // Zeichenkettenfelder wieder freigegeben.
  pVertexShaderSource   := PChar (VertexShaderSource);
  pFragmentShaderSource := PChar (FragmentShaderSource);

  VertexShaderLen   := length (VertexShaderSource);
  FragmentShaderLen := length (FragmentShaderSource);

  pVertexShaderlen   := @VertexShaderLen;
  pFragmentShaderlen := @FragmentShaderLen;

  glShaderSource (VertexShaderHandle, 1, @pVertexShaderSource, nil{pVertexShaderLen});
  ErrorHandler;
  glShaderSource (FragmentShaderHandle, 1, @pFragmentShaderSource, nil{pFragmentShaderLen});
  ErrorHandler;

  VertexShaderSource   := '';
  FragmentShaderSource := '';

  // In diesem Schritt wird der Quellcode für beide Shader übersetzt. Die
  // Fehlerabfrage zu dieser Operation ist hier nicht implementiert. Sie muss
  // an dieser Stelle noch eingebaut werden.
  glCompileShader (VertexShaderHandle);
  ErrorHandler;
  if GetShaderInfoLog (VertexShaderHandle, pLog) then begin
    ShaderError('Fehler bei "glCompileShader (VertexShaderHandle)"'+#13+#10+
                string (pLog));
    exit;
  end;
  glCompileShader (FragmentShaderHandle);
  ErrorHandler;
  if GetShaderInfoLog (FragmentShaderHandle, pLog) then begin
    ShaderError('Fehler bei "glCompileShader (FragmentShaderHandle)"'+#13+#10+
                string (pLog));
    exit;
  end;

  // Shader können nur als Paar aus Vertex- und Fragment-Shader geladen werden.
  // Deutlich wird dies durch die Erstellung des Shader-Programms in diesem
  // Vorgang.
  ShaderProgramHandle := glCreateProgram;
  ErrorHandler;

  // Die übersetzten Shader werden in diesem Schritt zum Shader-Programm
  // hinzugefügt.
  glAttachShader (ShaderProgramHandle, VertexShaderHandle);
  ErrorHandler;
  glAttachShader (ShaderProgramHandle, FragmentShaderHandle);
  ErrorHandler;

  // Die vorletzte Anweisung startet das Binden des Shader-Programms. An
  // dieser Stelle sei noch ein Mal daran erinnert, dass sowohl der Übersetzer
  // als auch Binder Bestandteile des OpenGL 2.0 Kernsystems sind und nicht
  // extern vorliegen.
  glLinkProgram (ShaderProgramHandle);
  ErrorHandler;
  if GetProgramInfoLog (ShaderProgramHandle, pLog) then begin
    ShaderError('Shaderprogramm kann nicht gelinkt werden'+#13+#10+
                string (pLog));
    exit;
  end;

  // Der letzte Schritt veranlasst das OpenGL-System das „fertige“
  // Shader-Programm auf der Grafikkarte zu installieren.
  // Um das Shader-Paar wieder zu entfernen, wird die Anweisung
  // „glUseProgram (0);“ benutzt. Dies ist wichtig, möchte man unterschiedliche
  // Shader für unterschiedliche Objekte in der Szene benutzen. Dann sollte
  // man die Aktivierung der Shader direkt in der „Display“-Funktion
  // durchführen. Andernfalls wird der Shader auf alle Objekte nach dem Aufruf
  // dieser Prozedur angewandt.
  EnableShaderProgram;

  result := true;
  FShaderAvailable := true;
end;

procedure TglShader.DeInstallShader;
begin
  if glIsShader (VertexShaderHandle) then begin
    glDetachShader (ShaderProgramHandle, VertexShaderhandle);
    glDeleteShader (VertexShaderHandle);
  end;
  if glIsShader (FragmentShaderHandle) then begin
    glDetachShader (ShaderProgramHandle, FragmentShaderHandle);
    glDeleteShader (FragmentShaderHandle);
  end;
  if glIsProgram (ShaderProgramHandle) then begin
    glUseProgram (0);
  end;

  VertexShaderHandle   := 0;
  FragmentShaderHandle := 0;
  ShaderProgramHandle  := 0;

  FShaderAvailable := false;
end;

function TglShader.GetShaderInfoLog (pObject: GlHandle; var pLog: string) : boolean;
var
 blen,slen : GLInt;
 InfoLog   : PGLCharARB;
begin
  result := false;
  pLog := '';
  glGetShaderiv(pObject, GL_INFO_LOG_LENGTH , @blen);
  if blen > 1 then begin
    GetMem(InfoLog, blen*SizeOf(GLCharARB));
    glGetShaderInfoLog(pObject, blen, slen, InfoLog);
    pLog := PChar(InfoLog);
    Dispose(InfoLog);
    result := true;
  end;
end;

function TglShader.GetProgramInfoLog (pObject: GlHandle; var pLog: string) : boolean;
var
 blen,slen : GLInt;
 InfoLog   : PGLCharARB;
begin
  result := false;
  pLog := '';
  glGetProgramiv(pObject, GL_INFO_LOG_LENGTH , @blen);
  if blen > 1 then begin
    GetMem(InfoLog, blen*SizeOf(GLCharARB));
    glGetProgramInfoLog(pObject, blen, slen, InfoLog);
    pLog := PChar(InfoLog);
    Dispose(InfoLog);
    result := true;
  end;
end;

function TglShader.GetUniLoc (pObject: glHandle; sUniform: pChar): glInt;
begin
  result := glGetUniformLocation(pObject, sUniform);
end;

function TglShader.GetTexUnits: glInt;
begin
  glgetIntegerV (GL_MAX_TEXTURE_UNITS, @result);
end;

function TglShader.DisableShaderProgram: boolean;
{var
  nMaxCount, nCount: glInt;
  aShaders: array [0..1] of glHandle;
  pShaders: pgluInt;
  i: integer;}
begin
  result := true;
  {nMaxCount := 2;
  pShaders := @aShaders[0];
  glGetAttachedShaders (pObject, nMaxCount, nCount, pShaders);
  if nMaxCount = nCount then begin
    for i := 0 to nCount - 1 do begin
      glDetachShader (pObject, aShaders[i]);
    end;
  end;}

  glUseProgram (0);

  ErrorHandler;
end;

function TglShader.EnableShaderProgram: boolean;
var
  pLog: string;
begin
  result := false;

  {glAttachShader (ShaderProgramHandle, VertexShaderHandle);
  glAttachShader (ShaderProgramHandle, FragmentShaderHandle);

  glLinkProgram (ShaderProgramHandle);
  if GetProgramInfoLog (ShaderProgramHandle, pLog) then begin
    if not FuncIsComServer then begin
      StdFehler ('Shaderprogramm kann nicht gelinkt werden');
    end;
    exit;
  end;}

  glUseProgram (ShaderProgramHandle);

  ErrorHandler;

  result := true;
end;

function TglShader.InstallShaderBmpFile (cFile, cUniform: string; nUniform: integer): boolean;
begin
  result := false;
  if (nUniform < 1) or (nUniform > 7) then begin
    exit;
  end;
  ShaderBmpFile [nUniform] := cFile;
  if (FileExists (ShaderBmpFile [nUniform])) then begin
    if assigned (ShaderBmpPic [nUniform]) then begin
      ShaderBmpPic [nUniform].Free;
    end;
    ShaderBmpPic [nUniform] := TGLbmp.Create(ShaderBmpFile [nUniform]);
    // variable texSampler im Fragmentshader mit Textureinheit aus
    // nUniform belegen
    glUniform1i (GetUniLoc(ShaderProgramHandle, PChar(cUniform)), nUniform);
    glActiveTexture (GL_TEXTURE0+nUniform);
    glEnable (GL_TEXTURE_2D);
    ShaderBmpPic [nUniform].Bind;
    glTexEnvf (GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_EXT);
    glTexEnvf (GL_TEXTURE_ENV, GL_COMBINE_RGB_EXT, GL_REPLACE);
    glActiveTexture (GL_TEXTURE0);
  end;
  result := true;
end;

function TglShader.FreeShaderBmpFile (nPic: integer): boolean;
begin
  if assigned (ShaderBmpPic [nPic]) then begin
    ShaderBmpPic [nPic].Free;
    ShaderBmpPic [nPic] := nil;
  end;
  result := true;
end;

function TglShader.ErrorHandler: boolean;
var
  cTmp: string;
begin
{
  GL_NO_ERROR
    No error has been recorded.
    The value of this symbolic constant is guaranteed to be 0.
  GL_INVALID_VALUE
    is generated if program is neither 0 nor a value generated by OpenGL.
  GL_INVALID_OPERATION
    is generated if program is not a program object.
  GL_INVALID_OPERATION
    is generated if program could not be made part of current state.
  GL_INVALID_OPERATION
    is generated if glUseProgram is executed between the execution of
    glBegin and the corresponding execution of glEnd.
}
  result := false;
  cTmp := gluErrorString(glGetError);
  if not stdutil.upperequal (cTmp, gluErrorString(GL_NO_ERROR)) then begin
    Application.MessageBox(PChar (cTmp), 'Error Handler', 0);
    result := true;
  end;
end;

end.

procedure TglShader.ResetGLErrorFlags;
var
  err: GLenum;
begin
  repeat
    err := glGetError;
  until err = GL_NO_ERROR;
end;

  pStatus := addr (Status);
  glCompileShader (VertexShaderHandle);
  glGetShaderiv(VertexShaderHandle, GL_COMPILE_STATUS, pStatus);
  if not Status=GL_TRUE then begin
    ShaderError('Fehler bei "glGetShaderiv(VertexShaderHandle, GL_COMPILE_STATUS, pStatus)"');
    exit;
  end;

.
.
.
  glCompileShader (FragmentShaderHandle);
  glGetShaderiv(FragmentShaderHandle, GL_COMPILE_STATUS, pStatus);
  if not Status=GL_TRUE then begin
    ShaderError('Fehler bei "glGetShaderiv(FragmentShaderHandle, GL_COMPILE_STATUS, pStatus)"');
    exit;
  end;
.
.
.
  glLinkProgram (ShaderProgramHandle);
  glGetShaderiv(ShaderProgramHandle, GL_LINK_STATUS, pStatus);
  if not Status=GL_TRUE then begin
    ShaderError('Fehler bei "glGetShaderiv(ShaderProgramHandle, GL_LINK_STATUS, pStatus)"');
    exit;
  end;