|
- 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, {$IFNDEF OPENGL_ES}dglOpenGl{$ELSE}dglOpenGLES{$ENDIF}, uglcTypes, ugluMatrix;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EglcShader = class(Exception);
- TglcShaderProgram = class;
- TglcShaderLogEvent = procedure(aSender: TObject; const aMsg: String) of Object;
- TglcShaderObject = class(TObject)
- private
- fAtachedTo: TglcShaderProgram;
- fShaderObj: GLuint;
- fShaderType: TglcShaderType;
- fCode: String;
- fOnLog: TglcShaderLogEvent;
- fAttachedTo: TglcShaderProgram;
-
- function GetInfoLog(aObj: GLuint): String;
- function GetCompiled: Boolean;
- procedure Log(const aMsg: String);
- procedure CreateShaderObj;
- procedure AttachTo(const aProgram: TglcShaderProgram);
- public
- property ShaderObj: GLuint 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: GLuint;
- fOnLog: TglcShaderLogEvent;
- fFilename: String;
-
- function GetUniformLocation(const aName: String; out aPos: glInt): Boolean;
- function GetInfoLog(Obj: GLuint): String;
- function GetCompiled: Boolean;
- function GetLinked: Boolean;
-
- procedure CreateProgramObj;
- procedure Log(const msg: String);
- procedure AttachShaderObj(const aShaderObj: TglcShaderObject);
- public
- property ProgramObj: GLuint 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;
- procedure BindAttribLocation(const aName: String; const aAttribIndex: GLint);
- function GetAttribLocation(const aName: String): Integer;
- 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: GLuint): 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 = GLint(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: GLuint): 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 = GLint(GL_TRUE));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TglcShaderProgram.CreateProgramObj;
- begin
- if (fProgramObj = 0) then begin
- 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;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TglcShaderProgram.BindAttribLocation(const aName: String; const aAttribIndex: GLint);
- begin
- CreateProgramObj;
- glBindAttribLocation(fProgramObj, aAttribIndex, PGLchar(aName));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TglcShaderProgram.GetAttribLocation(const aName: String): Integer;
- begin
- result := glGetAttribLocation(fProgramObj, PGLchar(aName));
- 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
- {$IFNDEF OPENGL_ES}
- 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
- {$ENDIF}
- 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;
- 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';
- {$IFNDEF OPENGL_ES}
- TglcShaderType.stGeometry: result := 'GL_GEOMETRY_SHADER';
- TglcShaderType.stTessControl: result := 'GL_TESS_CONTROL_SHADER';
- TglcShaderType.stTessEvaluation: result := 'GL_TESS_EVALUATION_SHADER';
- {$ENDIF}
- 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.
-
|