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; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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.