-unit uglcShader;
-
-{ Package: OpenGLCore
- Prefix: glc - OpenGL Core
- Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Shader Objekte
- Beispiel:
- var
- shader: TglcShaderProgram;
-
- //write log message to console
- // @param aSender: object that send the message
- // @param aMsg: message to write to console
- procedure LogMessage(aSender: TObject; const aMsg: String);
- begin
- writeln(Format('[%p]: %s', [aSender, aMsg]);
- end;
-
- //load shader object from file and add it to 'shader'
- // @param aFilename: name of file to load shader code from
- // @param aType: type of shader object to create
- procedure LoadShaderObject(const aFilename: String; const aType: TglcShaderType);
- var
- sl: TStringList;
- so: TglcShaderObject;
- begin
- sl := TStringList.Create;
- try
- sl.LoadFromFile(aFileName);
- so := TglcShaderObject.Create(aType);
- shader.add(so);
- finally
- FreeAndNil(sl, @LogMessage);
- end;
- end;
-
- shader := TglcShaderProgram.Create(@LogMessage);
- try
- // load shader objects
- LoadShaderObject('./test_shader.vert', TglcShaderType.stVertex);
- LoadShaderObject('./test_shader.frag', TglcShaderType.stFragment);
-
- // compile shader
- shader.Compile;
-
- // use shader
- shader.Enable;
- shader.Uniform1f('uTest', 0.1234);
- // do normal rendering
- shader.Disable;
-
- finally
- FreeAndNil(shader);
- end; }
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils, fgl, dglOpenGL, uglcTypes, ugluMatrix;
-
-type
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EglcShader = class(Exception);
- TglcShaderProgram = class;
- TglcShaderLogEvent = procedure(aSender: TObject; const aMsg: String) of Object;
- TglcShaderObject = class(TObject)
- private
- fAtachedTo: TglcShaderProgram;
- fShaderObj: GLHandle;
- fShaderType: TglcShaderType;
- fCode: String;
- fOnLog: TglcShaderLogEvent;
- fAttachedTo: TglcShaderProgram;
-
- function GetInfoLog(aObj: GLHandle): String;
- function GetCompiled: Boolean;
- procedure Log(const aMsg: String);
- procedure CreateShaderObj;
- procedure AttachTo(const aProgram: TglcShaderProgram);
- public
- property ShaderObj : GLHandle read fShaderObj;
- property ShaderType: TglcShaderType read fShaderType;
- property Compiled: Boolean read GetCompiled;
- property AtachedTo: TglcShaderProgram read fAtachedTo;
- property Code: String read fCode write fCode;
- property OnLog: TglcShaderLogEvent read fOnLog write fOnLog;
-
- procedure Compile;
-
- constructor Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent = nil);
- destructor Destroy; override;
- end;
- TglcShaderObjectList = specialize TFPGObjectList<TglcShaderObject>;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TglcShaderProgram = class(TglcShaderObjectList)
- private
- fProgramObj: GLHandle;
- fOnLog: TglcShaderLogEvent;
- fFilename: String;
-
- function GetUniformLocation(const aName: String; out aPos: glInt): Boolean;
- function GetInfoLog(Obj: GLHandle): String;
- function GetCompiled: Boolean;
- function GetLinked: Boolean;
-
- procedure CreateProgramObj;
- procedure Log(const msg: String);
- procedure AttachShaderObj(const aShaderObj: TglcShaderObject);
- public
- property ProgramObj: glHandle read fProgramObj;
- property Filename: String read fFilename;
- property Compiled: Boolean read GetCompiled;
- property Linked: Boolean read GetLinked;
- property OnLog: TglcShaderLogEvent read fOnLog write fOnLog;
-
- procedure Compile;
- procedure Enable;
- procedure Disable;
-
- procedure Add(aShaderObj: TglcShaderObject);
- procedure Delete(aID: Integer; aFreeOwnedObj: Boolean = True);
- procedure Clear;
-
- function Uniform1f(const aName: String; aP1: GLFloat): Boolean;
- function Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean;
- function Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean;
- function Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean;
- function Uniform1i(const aName: String; aP1: GLint): Boolean;
- function Uniform2i(const aName: String; aP1, aP2: GLint): Boolean;
- function Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean;
- function Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean;
- function Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
- function Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
- function Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
- function Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
- function Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
- function Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
- function Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
- function Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
- function UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean;
- function UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean;
- function UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean;
-
- function GetUniformfv(const aName: String; aP: PGLfloat): Boolean;
- function GetUniformfi(const aName: String; aP: PGLint): Boolean;
- function HasUniform(const aName: String): Boolean;
-
- procedure LoadFromFile(const aFilename: String);
- procedure LoadFromStream(const aStream: TStream);
- procedure SaveToFile(const aFilename: String);
- procedure SaveToStream(const aStream: TStream);
-
- constructor Create(const aLogEvent: TglcShaderLogEvent = nil);
- destructor Destroy; override;
- end;
-
-implementation
-
-uses
- RegExpr;
-
-const
- ERROR_STR_VAR_NAME: String = 'can''t find the variable ''%s'' in the program';
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//glShaderObject////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI//
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//ließt das Log eines OpenGL-Objekts aus
-//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll;
-//@result: Log des Objekts;
-function TglcShaderObject.GetInfoLog(aObj: GLHandle): String;
-var
- Msg: PChar;
- bLen: GLint;
- sLen: GLsizei;
-begin
- bLen := 0;
- glGetShaderiv(aObj, GL_INFO_LOG_LENGTH, @bLen);
- if bLen > 1 then begin
- GetMem(Msg, bLen * SizeOf(Char));
- glGetShaderInfoLog(aObj, bLen, @sLen, Msg);
- result := PChar(Msg);
- Dispose(Msg);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//ließt aus, ob der Shader ohne Fehler kompiliert wurde
-//@result: TRUE wenn ohne Fehler kompiliert, sonst FALSE;
-function TglcShaderObject.GetCompiled: Boolean;
-var
- value: glInt;
-begin
- glGetShaderiv(fShaderObj, GL_COMPILE_STATUS, @value);
- result := (value = GL_TRUE);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//ruft das Log-Event auf, wenn es gesetzt ist
-//@msg: Nachricht die geloggt werden soll;
-procedure TglcShaderObject.Log(const aMsg: String);
-begin
- if Assigned(fOnLog) then begin
- fOnLog(self, aMsg);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TglcShaderObject.CreateShaderObj;
-begin
- if (fShaderObj <> 0) then
- exit;
- fShaderObj := glCreateShader(GLenum(fShaderType));
- if fShaderObj = 0 then
- raise EglcShader.Create('can''t create ShaderObject');
- Log('shader object created: #'+IntToHex(fShaderObj, 4));
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TglcShaderObject.AttachTo(const aProgram: TglcShaderProgram);
-begin
- if (aProgram <> fAtachedTo) then begin
- CreateShaderObj;
- glAttachShader(aProgram.ProgramObj, fShaderObj);
- fAttachedTo := aProgram;
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL//
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//kompiliert das Shader-Objekt
-procedure TglcShaderObject.Compile;
-var
- len, i: GLint;
- List: TStringList;
- c: PAnsiChar;
-begin
- CreateShaderObj;
- len := Length(fCode);
- if len > 0 then begin
- c := PAnsiChar(fCode);
- glShaderSource(fShaderObj, 1, @c, @len);
- glCompileShader(fShaderObj);
- List := TStringList.Create;
- List.Text := GetInfoLog(fShaderObj);
- for i := 0 to List.Count-1 do
- Log(List[i]);
- List.Free;
- end else Log('error while compiling: no bound shader code');
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//erzeugt das Objekt
-//@ShaderType: Typ des Shader-Objekts;
-//@LogEvent: Event zum loggen von Fehlern und Ereignissen;
-//@raise: EglcShader wenn der Shadertyp unbekannt oder ungültig ist;
-constructor TglcShaderObject.Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent);
-begin
- inherited Create;
- fCode := '';
- fOnLog := aLogEvent;
- fShaderType := aShaderType;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//gibt das Objekt frei
-destructor TglcShaderObject.Destroy;
-begin
- if (fShaderObj <> 0) then
- glDeleteShader(fShaderObj);
- inherited Destroy;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//glShaderProgram///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI//
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TglcShaderProgram.GetUniformLocation(const aName: String; out aPos: glInt): Boolean;
-begin
- aPos := glGetUniformLocation(fProgramObj, PChar(aName));
- result := (aPos <> -1);
- if not result then
- Log(StringReplace(ERROR_STR_VAR_NAME, '%s', aName, [rfIgnoreCase, rfReplaceAll]));
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//ließt das Log eines OpenGL-Objekts aus
-//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll;
-//@result: Log des Objekts;
-function TglcShaderProgram.GetInfoLog(Obj: GLHandle): String;
-var
- Msg: PChar;
- bLen: GLint;
- sLen: GLsizei;
-begin
- bLen := 0;
- glGetProgramiv(Obj, GL_INFO_LOG_LENGTH, @bLen);
- if bLen > 1 then begin
- GetMem(Msg, bLen * SizeOf(Char));
- glGetProgramInfoLog(Obj, bLen, @sLen, Msg);
- result := PChar(Msg);
- Dispose(Msg);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//prüft ob alle Shader ohne Fehler compiliert wurden
-//@result: TRUE wenn alle erfolgreich compiliert, sonst FALSE;
-function TglcShaderProgram.GetCompiled: Boolean;
-var
- i: Integer;
-begin
- result := (Count > 0);
- for i := 0 to Count-1 do
- result := result and Items[i].Compiled;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//prüft ob das Programm ohne Fehler gelinkt wurde
-//@result: TRUE wenn linken erfolgreich, sonst FASLE;
-function TglcShaderProgram.GetLinked: Boolean;
-var
- value: glInt;
-begin
- glGetProgramiv(fProgramObj, GL_LINK_STATUS, @value);
- result := (value = GL_TRUE);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TglcShaderProgram.CreateProgramObj;
-begin
- if (fProgramObj = 0) then begin
- if GL_LibHandle = nil then
- raise EglcShader.Create('TglShaderProgram.Create - OpenGL not initialized');
-
- if (wglGetCurrentContext() = 0) or (wglGetCurrentDC() = 0) then
- raise EglcShader.Create('TglShaderProgram.Create - no valid render context');
-
- fProgramObj := glCreateProgram();
- Log('shader program created: #'+IntToHex(fProgramObj, 4));
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//ruft das Log-Event auf, wenn es gesetzt ist
-//@msg: Nachricht die geloggt werden soll;
-procedure TglcShaderProgram.Log(const msg: String);
-begin
- if Assigned(fOnLog) then begin
- fOnLog(self, msg);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TglcShaderProgram.AttachShaderObj(const aShaderObj: TglcShaderObject);
-begin
- CreateProgramObj;
- aShaderObj.AttachTo(self);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL//
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//Kompiliert den Shader-Code
-procedure TglcShaderProgram.Compile;
-var
- i: Integer;
- l: TStringList;
-begin
- CreateProgramObj;
- for i := 0 to Count-1 do begin
- AttachShaderObj(Items[i]);
- Items[i].Compile;
- end;
- glLinkProgram(fProgramObj);
- l := TStringList.Create;
- l.Text := GetInfoLog(fProgramObj);
- for i := 0 to l.Count-1 do
- Log(l[i]);
- l.Free;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//aktiviert den Shader
-procedure TglcShaderProgram.Enable;
-begin
- glUseProgram(fProgramObj);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//deaktiviert den Shader
-procedure TglcShaderProgram.Disable;
-begin
- glUseProgram(0);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//fügt der Liste einen Shader hinzu
-//@ShaderObj: Objekt, das hinzugefügt werden soll;
-procedure TglcShaderProgram.Add(aShaderObj: TglcShaderObject);
-begin
- inherited Add(aShaderObj);
- if (fProgramObj <> 0) then
- AttachShaderObj(aShaderObj);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//löscht ein ShaderObjekt aus der Liste
-//@ID: Index des Objekts, das gelöscht werden soll;
-//@FreeOwnedObj: wenn TRUE wird das gelöschte Objekt freigegeben;
-procedure TglcShaderProgram.Delete(aID: Integer; aFreeOwnedObj: Boolean);
-var
- b: Boolean;
-begin
- if (aID >= 0) and (aID < Count) and (fProgramObj <> 0) then begin
- glDetachShader(fProgramObj, Items[aID].fShaderObj);
- Items[aID].fAttachedTo := nil;
- end;
- b := FreeObjects;
- FreeObjects := aFreeOwnedObj;
- inherited Delete(aID);
- FreeObjects := b;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TglcShaderProgram.Clear;
-begin
- while (Count > 0) do
- Delete(0);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 1-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform1f(const aName: String; aP1: GLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform1f(pos, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 2-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@p2: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform2f(pos, aP1, aP2);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 3-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@p2: Wert der Variable, der gesetzt werden soll;
-//@p3: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform3f(pos, aP1, aP2, aP3);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 4-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@p2: Wert der Variable, der gesetzt werden soll;
-//@p3: Wert der Variable, der gesetzt werden soll;
-//@p4: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform4f(pos, aP1, aP2, aP3, aP4);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 1-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform1i(const aName: String; aP1: GLint): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform1i(pos, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 2-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform2i(const aName: String; aP1, aP2: GLint): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform2i(pos, aP1, aP2);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 3-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@p2: Wert der Variable, der gesetzt werden soll;
-//@p3: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform3i(pos, aP1, aP2, aP3);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen 4-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@p2: Wert der Variable, der gesetzt werden soll;
-//@p3: Wert der Variable, der gesetzt werden soll;
-//@p4: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform4i(pos, aP1, aP2, aP3, aP4);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 1-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform1fv(pos, aCount, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 2-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform2fv(pos, aCount, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 3-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform3fv(pos, aCount, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 4-Komponenten Float-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform4fv(pos, aCount, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 1-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform1iv(pos, aCount, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 2-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform2iv(pos, aCount, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 3-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform3iv(pos, aCount, aP1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt einen oder mehrere 4-Komponenten Integer-Vektoren an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@count: Anzahl an Parametern auf die p1 zeigt;
-//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniform4iv(pos, aCount, aP1) ;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt eine oder mehrere 2x2-Matrizen an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;
-//@Count: Anzahl der zu übergebenden Elemente;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniformMatrix2fv(pos, aCount, aTranspose, PGLfloat(aP1));
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt eine oder mehrere 3x3-Matrizen an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;
-//@Count: Anzahl der zu übergebenden Elemente;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniformMatrix3fv(pos, aCount, aTranspose, PGLfloat(aP1));
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//übergibt eine oder mehrere 4x4-Matrizen an den Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gesetzt werden soll;
-//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;
-//@Count: Anzahl der zu übergebenden Elemente;
-//@p1: Wert der Variable, der gesetzt werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glUniformMatrix4fv(pos, aCount, aTranspose, PGLfloat(aP1));
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//holt den Wert einer Float-Uniform-Variable aus dem Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gelesen werden soll;
-//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.GetUniformfv(const aName: String; aP: PGLfloat): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glGetUniformfv(fProgramObj, pos, aP);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//holt den Wert einer Integer-Uniform-Variable aus dem Shader
-//!!!Der Shader muss dazu aktiviert sein!!!
-//@Name: Name der Variablen die gelesen werden soll;
-//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;
-//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);
-function TglcShaderProgram.GetUniformfi(const aName: String; aP: PGLint): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
- if result then
- glGetUniformiv(fProgramObj, pos, aP);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TglcShaderProgram.HasUniform(const aName: String): Boolean;
-var
- pos: GLint;
-begin
- result := GetUniformLocation(aName, pos);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//läd den Shader aus einer Datei
-//@Filename: Datei aus der gelesen werden soll;
-//@raise: EglcShader, wenn Datei nicht vorhanden ist;
-procedure TglcShaderProgram.LoadFromFile(const aFilename: String);
-var
- Stream: TFileStream;
-begin
- if FileExists(aFilename) then begin
- Stream := TFileStream.Create(aFilename, fmOpenRead);
- try
- LoadFromStream(Stream);
- fFilename := aFilename;
- finally
- Stream.Free;
- end;
- end else raise EglcShader.Create('TglShaderProgram.LoadFromFile - file not found: '+Filename);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//läd den Shader aus einem Stream
-//@Stream: Stream aus dem gelesen werden soll;
-//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;
-procedure TglcShaderProgram.LoadFromStream(const aStream: TStream);
-
- function GetShaderType(const aStr: String): TglcShaderType;
- begin
- if (aStr = 'GL_VERTEX_SHADER') then
- result := TglcShaderType.stVertex
- else if (aStr = 'GL_FRAGMENT_SHADER') then
- result := TglcShaderType.stFragment
- else if (aStr = 'GL_GEOMETRY_SHADER') then
- result := TglcShaderType.stGeometry
- else if (aStr = 'GL_TESS_CONTROL_SHADER') then
- result := TglcShaderType.stTessControl
- else if (aStr = 'GL_TESS_EVALUATION_SHADER') then
- result := TglcShaderType.stTessEvaluation
- else
- raise Exception.Create('invalid shader type: ' + aStr);
- end;
-
-var
- sl: TStringList;
- s: String;
- rx: TRegExpr;
- LastMatchPos: PtrInt;
- st: TglcShaderType;
- o: TglcShaderObject;
-
- procedure AddObj(const aPos: Integer);
- begin
- if (LastMatchPos > 0) then begin
- o := TglcShaderObject.Create(st, fOnLog);
- o.Code := Trim(Copy(s, LastMatchPos, aPos - LastMatchPos));
- Add(o);
- end;
- end;
-
-begin
- if not Assigned(aStream) then
- raise EglcShader.Create('TglShaderProgram.SaveToStream - stream is nil');
-
- Clear;
- sl := TStringList.Create;
- rx := TRegExpr.Create;
- try
- sl.LoadFromStream(aStream);
- s := sl.Text;
- LastMatchPos := 0;
- rx.Expression := '/\*\s*ShaderObject\s*:\s*(GL_[A-Z_]+)\s*\*/\s*$?';
- rx.InputString := s;
-
- while rx.Exec(LastMatchPos+1) do begin
- AddObj(rx.MatchPos[0]);
- LastMatchPos := rx.MatchPos[0] + rx.MatchLen[0];
- st := GetShaderType(rx.Match[1]);
- end;
- AddObj(Length(s));
- finally
- rx.Free;
- sl.Free;
- end;
-
-
- {
- if Assigned(aStream) then begin
- Clear;
- fFilename := '';
- reader := TutlStreamReader.Create(aStream);
- try
- if reader.ReadAnsiString <> GLSL_FILE_HEADER then
- raise EglcShader.Create('TglShaderProgram.SaveToStream - incompatible file');
- v := reader.ReadInteger;
-
- if v >= 100 then begin //version 1.00
- c := reader.ReadInteger;
- for i := 0 to c-1 do begin
- Add(TglcShaderObject.Create(Cardinal(reader.ReadInteger), fOnLog));
- Last.fCode := reader.ReadAnsiString;
- end;
- end;
- finally
- reader.Free;
- end;
- end else
- }
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//speichert den Shader in einer Datei
-//@Filename: Datei in die geschrieben werden soll;
-procedure TglcShaderProgram.SaveToFile(const aFilename: String);
-var
- Stream: TFileStream;
-begin
- Stream := TFileStream.Create(aFilename, fmCreate);
- try
- SaveToStream(Stream);
- fFilename := aFilename;
- finally
- Stream.Free;
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//speichert den Shader in einen Stream
-//@Stream: Stream in den geschrieben werden soll;
-//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;
-//@raise: EglcShader wenn ungültige Datei;
-procedure TglcShaderProgram.SaveToStream(const aStream: TStream);
-var
- i: Integer;
- sl: TStringList;
- sObj: TglcShaderObject;
-
- function GetShaderTypeStr(const aShaderType: TglcShaderType): String;
- begin
- case aShaderType of
- TglcShaderType.stVertex: result := 'GL_VERTEX_SHADER';
- TglcShaderType.stFragment: result := 'GL_FRAGMENT_SHADER';
- TglcShaderType.stGeometry: result := 'GL_GEOMETRY_SHADER';
- TglcShaderType.stTessControl: result := 'GL_TESS_CONTROL_SHADER';
- TglcShaderType.stTessEvaluation: result := 'GL_TESS_EVALUATION_SHADER';
- else
- result := 'UNKNOWN';
- end;
- end;
-
-begin
- if not Assigned(aStream) then
- raise EglcShader.Create('TglShaderProgram.LoadFromStream - stream is nil');
- fFilename := '';
- sl := TStringList.Create;
- try
- for i := 0 to Count-1 do begin
- sObj := Items[i];
- sl.Add('/* ShaderObject: ' + GetShaderTypeStr(sObj.ShaderType) + ' */');
- sl.Add(sObj.Code);
- end;
- sl.SaveToStream(aStream);
- finally
- sl.Free;
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//erzeugt das Objekt
-//@LogEvent: Event zum loggen von Fehlern und Ereignissen;
-//@raise: EglcShader wenn OpenGL nicht initialisiert werden konnte;
-//@raise:
-constructor TglcShaderProgram.Create(const aLogEvent: TglcShaderLogEvent);
-begin
- inherited Create;
- fOnLog := aLogEvent;
- fFilename := '';
- fProgramObj := 0;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//gibt das Objekt frei
-destructor TglcShaderProgram.Destroy;
-begin
- if (fProgramObj <> 0) then
- glDeleteProgram(fProgramObj);
- inherited Destroy;
-end;
-
-end.
-
+unit uglcShader;\r
+\r
+{ Package: OpenGLCore\r
+ Prefix: glc - OpenGL Core\r
+ Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Shader Objekte\r
+ Beispiel:\r
+ var\r
+ shader: TglcShaderProgram;\r
+\r
+ //write log message to console\r
+ // @param aSender: object that send the message\r
+ // @param aMsg: message to write to console\r
+ procedure LogMessage(aSender: TObject; const aMsg: String);\r
+ begin\r
+ writeln(Format('[%p]: %s', [aSender, aMsg]);\r
+ end;\r
+\r
+ //load shader object from file and add it to 'shader'\r
+ // @param aFilename: name of file to load shader code from\r
+ // @param aType: type of shader object to create\r
+ procedure LoadShaderObject(const aFilename: String; const aType: TglcShaderType);\r
+ var\r
+ sl: TStringList;\r
+ so: TglcShaderObject;\r
+ begin\r
+ sl := TStringList.Create;\r
+ try\r
+ sl.LoadFromFile(aFileName);\r
+ so := TglcShaderObject.Create(aType);\r
+ shader.add(so);\r
+ finally\r
+ FreeAndNil(sl, @LogMessage);\r
+ end;\r
+ end;\r
+\r
+ shader := TglcShaderProgram.Create(@LogMessage);\r
+ try\r
+ // load shader objects\r
+ LoadShaderObject('./test_shader.vert', TglcShaderType.stVertex);\r
+ LoadShaderObject('./test_shader.frag', TglcShaderType.stFragment);\r
+\r
+ // compile shader\r
+ shader.Compile;\r
+\r
+ // use shader\r
+ shader.Enable;\r
+ shader.Uniform1f('uTest', 0.1234);\r
+ // do normal rendering\r
+ shader.Disable;\r
+\r
+ finally\r
+ FreeAndNil(shader);\r
+ end; }\r
+\r
+{$mode objfpc}{$H+}\r
+\r
+interface\r
+\r
+uses\r
+ Classes, SysUtils, fgl, dglOpenGL, uglcTypes, ugluMatrix, uglcContext;\r
+\r
+type\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+ EglcShader = class(Exception);\r
+ TglcShaderProgram = class;\r
+ TglcShaderLogEvent = procedure(aSender: TObject; const aMsg: String) of Object;\r
+ TglcShaderObject = class(TObject)\r
+ private\r
+ fAtachedTo: TglcShaderProgram;\r
+ fShaderObj: GLHandle;\r
+ fShaderType: TglcShaderType;\r
+ fCode: String;\r
+ fOnLog: TglcShaderLogEvent;\r
+ fAttachedTo: TglcShaderProgram;\r
+\r
+ function GetInfoLog(aObj: GLHandle): String;\r
+ function GetCompiled: Boolean;\r
+ procedure Log(const aMsg: String);\r
+ procedure CreateShaderObj;\r
+ procedure AttachTo(const aProgram: TglcShaderProgram);\r
+ public\r
+ property ShaderObj : GLHandle read fShaderObj;\r
+ property ShaderType: TglcShaderType read fShaderType;\r
+ property Compiled: Boolean read GetCompiled;\r
+ property AtachedTo: TglcShaderProgram read fAtachedTo;\r
+ property Code: String read fCode write fCode;\r
+ property OnLog: TglcShaderLogEvent read fOnLog write fOnLog;\r
+\r
+ procedure Compile;\r
+\r
+ constructor Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent = nil);\r
+ destructor Destroy; override;\r
+ end;\r
+ TglcShaderObjectList = specialize TFPGObjectList<TglcShaderObject>;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+ TglcShaderProgram = class(TglcShaderObjectList)\r
+ private\r
+ fProgramObj: GLHandle;\r
+ fOnLog: TglcShaderLogEvent;\r
+ fFilename: String;\r
+\r
+ function GetUniformLocation(const aName: String; out aPos: glInt): Boolean;\r
+ function GetInfoLog(Obj: GLHandle): String;\r
+ function GetCompiled: Boolean;\r
+ function GetLinked: Boolean;\r
+\r
+ procedure CreateProgramObj;\r
+ procedure Log(const msg: String);\r
+ procedure AttachShaderObj(const aShaderObj: TglcShaderObject);\r
+ public\r
+ property ProgramObj: glHandle read fProgramObj;\r
+ property Filename: String read fFilename;\r
+ property Compiled: Boolean read GetCompiled;\r
+ property Linked: Boolean read GetLinked;\r
+ property OnLog: TglcShaderLogEvent read fOnLog write fOnLog;\r
+\r
+ procedure Compile;\r
+ procedure Enable;\r
+ procedure Disable;\r
+\r
+ procedure Add(aShaderObj: TglcShaderObject);\r
+ procedure Delete(aID: Integer; aFreeOwnedObj: Boolean = True);\r
+ procedure Clear;\r
+\r
+ function Uniform1f(const aName: String; aP1: GLFloat): Boolean;\r
+ function Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean;\r
+ function Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean;\r
+ function Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean;\r
+ function Uniform1i(const aName: String; aP1: GLint): Boolean;\r
+ function Uniform2i(const aName: String; aP1, aP2: GLint): Boolean;\r
+ function Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean;\r
+ function Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean;\r
+ function Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+ function Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+ function Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+ function Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+ function Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+ function Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+ function Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+ function Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+ function UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean;\r
+ function UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean;\r
+ function UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean;\r
+\r
+ function GetUniformfv(const aName: String; aP: PGLfloat): Boolean;\r
+ function GetUniformfi(const aName: String; aP: PGLint): Boolean;\r
+ function HasUniform(const aName: String): Boolean;\r
+\r
+ procedure LoadFromFile(const aFilename: String);\r
+ procedure LoadFromStream(const aStream: TStream);\r
+ procedure SaveToFile(const aFilename: String);\r
+ procedure SaveToStream(const aStream: TStream);\r
+\r
+ constructor Create(const aLogEvent: TglcShaderLogEvent = nil);\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+implementation\r
+\r
+uses\r
+ RegExpr;\r
+\r
+const\r
+ ERROR_STR_VAR_NAME: String = 'can''t find the variable ''%s'' in the program';\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//glShaderObject////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI//\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//ließt das Log eines OpenGL-Objekts aus\r
+//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll;\r
+//@result: Log des Objekts;\r
+function TglcShaderObject.GetInfoLog(aObj: GLHandle): String;\r
+var\r
+ Msg: PChar;\r
+ bLen: GLint;\r
+ sLen: GLsizei;\r
+begin\r
+ bLen := 0;\r
+ glGetShaderiv(aObj, GL_INFO_LOG_LENGTH, @bLen);\r
+ if bLen > 1 then begin\r
+ GetMem(Msg, bLen * SizeOf(Char));\r
+ glGetShaderInfoLog(aObj, bLen, @sLen, Msg);\r
+ result := PChar(Msg);\r
+ Dispose(Msg);\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//ließt aus, ob der Shader ohne Fehler kompiliert wurde\r
+//@result: TRUE wenn ohne Fehler kompiliert, sonst FALSE;\r
+function TglcShaderObject.GetCompiled: Boolean;\r
+var\r
+ value: glInt;\r
+begin\r
+ glGetShaderiv(fShaderObj, GL_COMPILE_STATUS, @value);\r
+ result := (value = GL_TRUE);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//ruft das Log-Event auf, wenn es gesetzt ist\r
+//@msg: Nachricht die geloggt werden soll;\r
+procedure TglcShaderObject.Log(const aMsg: String);\r
+begin\r
+ if Assigned(fOnLog) then begin\r
+ fOnLog(self, aMsg);\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+procedure TglcShaderObject.CreateShaderObj;\r
+begin\r
+ if (fShaderObj <> 0) then\r
+ exit;\r
+ fShaderObj := glCreateShader(GLenum(fShaderType));\r
+ if fShaderObj = 0 then\r
+ raise EglcShader.Create('can''t create ShaderObject');\r
+ Log('shader object created: #'+IntToHex(fShaderObj, 4));\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+procedure TglcShaderObject.AttachTo(const aProgram: TglcShaderProgram);\r
+begin\r
+ if (aProgram <> fAtachedTo) then begin\r
+ CreateShaderObj;\r
+ glAttachShader(aProgram.ProgramObj, fShaderObj);\r
+ fAttachedTo := aProgram;\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL//\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//kompiliert das Shader-Objekt\r
+procedure TglcShaderObject.Compile;\r
+var\r
+ len, i: GLint;\r
+ List: TStringList;\r
+ c: PAnsiChar;\r
+begin\r
+ CreateShaderObj;\r
+ len := Length(fCode);\r
+ if len > 0 then begin\r
+ c := PAnsiChar(fCode);\r
+ glShaderSource(fShaderObj, 1, @c, @len);\r
+ glCompileShader(fShaderObj);\r
+ List := TStringList.Create;\r
+ List.Text := GetInfoLog(fShaderObj);\r
+ for i := 0 to List.Count-1 do\r
+ Log(List[i]);\r
+ List.Free;\r
+ end else Log('error while compiling: no bound shader code');\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//erzeugt das Objekt\r
+//@ShaderType: Typ des Shader-Objekts;\r
+//@LogEvent: Event zum loggen von Fehlern und Ereignissen;\r
+//@raise: EglcShader wenn der Shadertyp unbekannt oder ungültig ist;\r
+constructor TglcShaderObject.Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent);\r
+begin\r
+ inherited Create;\r
+ fCode := '';\r
+ fOnLog := aLogEvent;\r
+ fShaderType := aShaderType;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//gibt das Objekt frei\r
+destructor TglcShaderObject.Destroy;\r
+begin\r
+ if (fShaderObj <> 0) then\r
+ glDeleteShader(fShaderObj);\r
+ inherited Destroy;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//glShaderProgram///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI//\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+function TglcShaderProgram.GetUniformLocation(const aName: String; out aPos: glInt): Boolean;\r
+begin\r
+ aPos := glGetUniformLocation(fProgramObj, PChar(aName));\r
+ result := (aPos <> -1);\r
+ if not result then\r
+ Log(StringReplace(ERROR_STR_VAR_NAME, '%s', aName, [rfIgnoreCase, rfReplaceAll]));\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//ließt das Log eines OpenGL-Objekts aus\r
+//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll;\r
+//@result: Log des Objekts;\r
+function TglcShaderProgram.GetInfoLog(Obj: GLHandle): String;\r
+var\r
+ Msg: PChar;\r
+ bLen: GLint;\r
+ sLen: GLsizei;\r
+begin\r
+ bLen := 0;\r
+ glGetProgramiv(Obj, GL_INFO_LOG_LENGTH, @bLen);\r
+ if bLen > 1 then begin\r
+ GetMem(Msg, bLen * SizeOf(Char));\r
+ glGetProgramInfoLog(Obj, bLen, @sLen, Msg);\r
+ result := PChar(Msg);\r
+ Dispose(Msg);\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//prüft ob alle Shader ohne Fehler compiliert wurden\r
+//@result: TRUE wenn alle erfolgreich compiliert, sonst FALSE;\r
+function TglcShaderProgram.GetCompiled: Boolean;\r
+var\r
+ i: Integer;\r
+begin\r
+ result := (Count > 0);\r
+ for i := 0 to Count-1 do\r
+ result := result and Items[i].Compiled;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//prüft ob das Programm ohne Fehler gelinkt wurde\r
+//@result: TRUE wenn linken erfolgreich, sonst FASLE;\r
+function TglcShaderProgram.GetLinked: Boolean;\r
+var\r
+ value: glInt;\r
+begin\r
+ glGetProgramiv(fProgramObj, GL_LINK_STATUS, @value);\r
+ result := (value = GL_TRUE);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+procedure TglcShaderProgram.CreateProgramObj;\r
+begin\r
+ if (fProgramObj = 0) then begin\r
+ if GL_LibHandle = nil then\r
+ raise EglcShader.Create('TglShaderProgram.Create - OpenGL not initialized');\r
+\r
+ if not TglcContext.IsAnyContextActive then\r
+ raise EglcShader.Create('TglShaderProgram.Create - no valid render context');\r
+\r
+ fProgramObj := glCreateProgram();\r
+ Log('shader program created: #'+IntToHex(fProgramObj, 4));\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//ruft das Log-Event auf, wenn es gesetzt ist\r
+//@msg: Nachricht die geloggt werden soll;\r
+procedure TglcShaderProgram.Log(const msg: String);\r
+begin\r
+ if Assigned(fOnLog) then begin\r
+ fOnLog(self, msg);\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+procedure TglcShaderProgram.AttachShaderObj(const aShaderObj: TglcShaderObject);\r
+begin\r
+ CreateProgramObj;\r
+ aShaderObj.AttachTo(self);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL//\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//Kompiliert den Shader-Code\r
+procedure TglcShaderProgram.Compile;\r
+var\r
+ i: Integer;\r
+ l: TStringList;\r
+begin\r
+ CreateProgramObj;\r
+ for i := 0 to Count-1 do begin\r
+ AttachShaderObj(Items[i]);\r
+ Items[i].Compile;\r
+ end;\r
+ glLinkProgram(fProgramObj);\r
+ l := TStringList.Create;\r
+ l.Text := GetInfoLog(fProgramObj);\r
+ for i := 0 to l.Count-1 do\r
+ Log(l[i]);\r
+ l.Free;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//aktiviert den Shader\r
+procedure TglcShaderProgram.Enable;\r
+begin\r
+ glUseProgram(fProgramObj);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//deaktiviert den Shader\r
+procedure TglcShaderProgram.Disable;\r
+begin\r
+ glUseProgram(0);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//fügt der Liste einen Shader hinzu\r
+//@ShaderObj: Objekt, das hinzugefügt werden soll;\r
+procedure TglcShaderProgram.Add(aShaderObj: TglcShaderObject);\r
+begin\r
+ inherited Add(aShaderObj);\r
+ if (fProgramObj <> 0) then\r
+ AttachShaderObj(aShaderObj);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//löscht ein ShaderObjekt aus der Liste\r
+//@ID: Index des Objekts, das gelöscht werden soll;\r
+//@FreeOwnedObj: wenn TRUE wird das gelöschte Objekt freigegeben;\r
+procedure TglcShaderProgram.Delete(aID: Integer; aFreeOwnedObj: Boolean);\r
+var\r
+ b: Boolean;\r
+begin\r
+ if (aID >= 0) and (aID < Count) and (fProgramObj <> 0) then begin\r
+ glDetachShader(fProgramObj, Items[aID].fShaderObj);\r
+ Items[aID].fAttachedTo := nil;\r
+ end;\r
+ b := FreeObjects;\r
+ FreeObjects := aFreeOwnedObj;\r
+ inherited Delete(aID);\r
+ FreeObjects := b;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+procedure TglcShaderProgram.Clear;\r
+begin\r
+ while (Count > 0) do\r
+ Delete(0);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 1-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform1f(const aName: String; aP1: GLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform1f(pos, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 2-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@p2: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform2f(pos, aP1, aP2);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 3-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@p2: Wert der Variable, der gesetzt werden soll;\r
+//@p3: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform3f(pos, aP1, aP2, aP3);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 4-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@p2: Wert der Variable, der gesetzt werden soll;\r
+//@p3: Wert der Variable, der gesetzt werden soll;\r
+//@p4: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform4f(pos, aP1, aP2, aP3, aP4);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 1-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform1i(const aName: String; aP1: GLint): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform1i(pos, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 2-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform2i(const aName: String; aP1, aP2: GLint): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform2i(pos, aP1, aP2);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 3-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@p2: Wert der Variable, der gesetzt werden soll;\r
+//@p3: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform3i(pos, aP1, aP2, aP3);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen 4-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@p2: Wert der Variable, der gesetzt werden soll;\r
+//@p3: Wert der Variable, der gesetzt werden soll;\r
+//@p4: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform4i(pos, aP1, aP2, aP3, aP4);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 1-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform1fv(pos, aCount, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 2-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform2fv(pos, aCount, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 3-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform3fv(pos, aCount, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 4-Komponenten Float-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform4fv(pos, aCount, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 1-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform1iv(pos, aCount, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 2-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform2iv(pos, aCount, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 3-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform3iv(pos, aCount, aP1);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt einen oder mehrere 4-Komponenten Integer-Vektoren an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@count: Anzahl an Parametern auf die p1 zeigt;\r
+//@p1: Zeiger auf den ersten Wert der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniform4iv(pos, aCount, aP1) ;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt eine oder mehrere 2x2-Matrizen an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;\r
+//@Count: Anzahl der zu übergebenden Elemente;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniformMatrix2fv(pos, aCount, aTranspose, PGLfloat(aP1));\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt eine oder mehrere 3x3-Matrizen an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;\r
+//@Count: Anzahl der zu übergebenden Elemente;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniformMatrix3fv(pos, aCount, aTranspose, PGLfloat(aP1));\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//übergibt eine oder mehrere 4x4-Matrizen an den Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gesetzt werden soll;\r
+//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert;\r
+//@Count: Anzahl der zu übergebenden Elemente;\r
+//@p1: Wert der Variable, der gesetzt werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glUniformMatrix4fv(pos, aCount, aTranspose, PGLfloat(aP1));\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//holt den Wert einer Float-Uniform-Variable aus dem Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gelesen werden soll;\r
+//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.GetUniformfv(const aName: String; aP: PGLfloat): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glGetUniformfv(fProgramObj, pos, aP);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//holt den Wert einer Integer-Uniform-Variable aus dem Shader\r
+//!!!Der Shader muss dazu aktiviert sein!!!\r
+//@Name: Name der Variablen die gelesen werden soll;\r
+//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll;\r
+//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden);\r
+function TglcShaderProgram.GetUniformfi(const aName: String; aP: PGLint): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+ if result then\r
+ glGetUniformiv(fProgramObj, pos, aP);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+function TglcShaderProgram.HasUniform(const aName: String): Boolean;\r
+var\r
+ pos: GLint;\r
+begin\r
+ result := GetUniformLocation(aName, pos);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//läd den Shader aus einer Datei\r
+//@Filename: Datei aus der gelesen werden soll;\r
+//@raise: EglcShader, wenn Datei nicht vorhanden ist;\r
+procedure TglcShaderProgram.LoadFromFile(const aFilename: String);\r
+var\r
+ Stream: TFileStream;\r
+begin\r
+ if FileExists(aFilename) then begin\r
+ Stream := TFileStream.Create(aFilename, fmOpenRead);\r
+ try\r
+ LoadFromStream(Stream);\r
+ fFilename := aFilename;\r
+ finally\r
+ Stream.Free;\r
+ end;\r
+ end else raise EglcShader.Create('TglShaderProgram.LoadFromFile - file not found: '+Filename);\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//läd den Shader aus einem Stream\r
+//@Stream: Stream aus dem gelesen werden soll;\r
+//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;\r
+procedure TglcShaderProgram.LoadFromStream(const aStream: TStream);\r
+\r
+ function GetShaderType(const aStr: String): TglcShaderType;\r
+ begin\r
+ if (aStr = 'GL_VERTEX_SHADER') then\r
+ result := TglcShaderType.stVertex\r
+ else if (aStr = 'GL_FRAGMENT_SHADER') then\r
+ result := TglcShaderType.stFragment\r
+ else if (aStr = 'GL_GEOMETRY_SHADER') then\r
+ result := TglcShaderType.stGeometry\r
+ else if (aStr = 'GL_TESS_CONTROL_SHADER') then\r
+ result := TglcShaderType.stTessControl\r
+ else if (aStr = 'GL_TESS_EVALUATION_SHADER') then\r
+ result := TglcShaderType.stTessEvaluation\r
+ else\r
+ raise Exception.Create('invalid shader type: ' + aStr);\r
+ end;\r
+\r
+var\r
+ sl: TStringList;\r
+ s: String;\r
+ rx: TRegExpr;\r
+ LastMatchPos: PtrInt;\r
+ st: TglcShaderType;\r
+ o: TglcShaderObject;\r
+\r
+ procedure AddObj(const aPos: Integer);\r
+ begin\r
+ if (LastMatchPos > 0) then begin\r
+ o := TglcShaderObject.Create(st, fOnLog);\r
+ o.Code := Trim(Copy(s, LastMatchPos, aPos - LastMatchPos));\r
+ Add(o);\r
+ end;\r
+ end;\r
+\r
+begin\r
+ if not Assigned(aStream) then\r
+ raise EglcShader.Create('TglShaderProgram.SaveToStream - stream is nil');\r
+\r
+ Clear;\r
+ sl := TStringList.Create;\r
+ rx := TRegExpr.Create;\r
+ try\r
+ sl.LoadFromStream(aStream);\r
+ s := sl.Text;\r
+ LastMatchPos := 0;\r
+ rx.Expression := '/\*\s*ShaderObject\s*:\s*(GL_[A-Z_]+)\s*\*/\s*$?';\r
+ rx.InputString := s;\r
+\r
+ while rx.Exec(LastMatchPos+1) do begin\r
+ AddObj(rx.MatchPos[0]);\r
+ LastMatchPos := rx.MatchPos[0] + rx.MatchLen[0];\r
+ st := GetShaderType(rx.Match[1]);\r
+ end;\r
+ AddObj(Length(s));\r
+ finally\r
+ rx.Free;\r
+ sl.Free;\r
+ end;\r
+\r
+\r
+ {\r
+ if Assigned(aStream) then begin\r
+ Clear;\r
+ fFilename := '';\r
+ reader := TutlStreamReader.Create(aStream);\r
+ try\r
+ if reader.ReadAnsiString <> GLSL_FILE_HEADER then\r
+ raise EglcShader.Create('TglShaderProgram.SaveToStream - incompatible file');\r
+ v := reader.ReadInteger;\r
+\r
+ if v >= 100 then begin //version 1.00\r
+ c := reader.ReadInteger;\r
+ for i := 0 to c-1 do begin\r
+ Add(TglcShaderObject.Create(Cardinal(reader.ReadInteger), fOnLog));\r
+ Last.fCode := reader.ReadAnsiString;\r
+ end;\r
+ end;\r
+ finally\r
+ reader.Free;\r
+ end;\r
+ end else\r
+ }\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//speichert den Shader in einer Datei\r
+//@Filename: Datei in die geschrieben werden soll;\r
+procedure TglcShaderProgram.SaveToFile(const aFilename: String);\r
+var\r
+ Stream: TFileStream;\r
+begin\r
+ Stream := TFileStream.Create(aFilename, fmCreate);\r
+ try\r
+ SaveToStream(Stream);\r
+ fFilename := aFilename;\r
+ finally\r
+ Stream.Free;\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//speichert den Shader in einen Stream\r
+//@Stream: Stream in den geschrieben werden soll;\r
+//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde;\r
+//@raise: EglcShader wenn ungültige Datei;\r
+procedure TglcShaderProgram.SaveToStream(const aStream: TStream);\r
+var\r
+ i: Integer;\r
+ sl: TStringList;\r
+ sObj: TglcShaderObject;\r
+\r
+ function GetShaderTypeStr(const aShaderType: TglcShaderType): String;\r
+ begin\r
+ case aShaderType of\r
+ TglcShaderType.stVertex: result := 'GL_VERTEX_SHADER';\r
+ TglcShaderType.stFragment: result := 'GL_FRAGMENT_SHADER';\r
+ TglcShaderType.stGeometry: result := 'GL_GEOMETRY_SHADER';\r
+ TglcShaderType.stTessControl: result := 'GL_TESS_CONTROL_SHADER';\r
+ TglcShaderType.stTessEvaluation: result := 'GL_TESS_EVALUATION_SHADER';\r
+ else\r
+ result := 'UNKNOWN';\r
+ end;\r
+ end;\r
+\r
+begin\r
+ if not Assigned(aStream) then\r
+ raise EglcShader.Create('TglShaderProgram.LoadFromStream - stream is nil');\r
+ fFilename := '';\r
+ sl := TStringList.Create;\r
+ try\r
+ for i := 0 to Count-1 do begin\r
+ sObj := Items[i];\r
+ sl.Add('/* ShaderObject: ' + GetShaderTypeStr(sObj.ShaderType) + ' */');\r
+ sl.Add(sObj.Code);\r
+ end;\r
+ sl.SaveToStream(aStream);\r
+ finally\r
+ sl.Free;\r
+ end;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//erzeugt das Objekt\r
+//@LogEvent: Event zum loggen von Fehlern und Ereignissen;\r
+//@raise: EglcShader wenn OpenGL nicht initialisiert werden konnte;\r
+//@raise:\r
+constructor TglcShaderProgram.Create(const aLogEvent: TglcShaderLogEvent);\r
+begin\r
+ inherited Create;\r
+ fOnLog := aLogEvent;\r
+ fFilename := '';\r
+ fProgramObj := 0;\r
+end;\r
+\r
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////\r
+//gibt das Objekt frei\r
+destructor TglcShaderProgram.Destroy;\r
+begin\r
+ if (fProgramObj <> 0) then\r
+ glDeleteProgram(fProgramObj);\r
+ inherited Destroy;\r
+end;\r
+\r
+end.\r
+\r
\ No newline at end of file
projects / LazOpenGLCore.git / commitdiff