From f6e073e2225d2f86345512f67dedb4951abb6f21 Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Fri, 31 Oct 2014 16:20:27 +0100 Subject: [PATCH] * some linux fixes --- uglcContextGtk2GLX.pas | 37 +- uglcShader.pas | 1950 ++++++++++++++++++++++++------------------------ 2 files changed, 996 insertions(+), 991 deletions(-) diff --git a/uglcContextGtk2GLX.pas b/uglcContextGtk2GLX.pas index bbde99f..b3ddb20 100644 --- a/uglcContextGtk2GLX.pas +++ b/uglcContextGtk2GLX.pas @@ -60,10 +60,7 @@ type {$region messages -fold} procedure TRenderControl.WndProc(var Message: TLMessage); -var - handled: Boolean; begin - handled := false; case Message.msg of //LM_ACTIVATEITEM, //LM_CHANGED, @@ -269,10 +266,8 @@ begin CN_SYSCHAR, CN_NOTIFY: begin - if Assigned(fTarget) then begin + if Assigned(fTarget) then Message.Result := fTarget.Perform(Message.msg, Message.wParam, Message.lParam); - handled := true; - end; end; end; inherited WndProc(Message); @@ -422,6 +417,7 @@ procedure TglcContextGtk2GLX.OpenContext; var Attribs: array of GLint; tmpContext: GLXContext; + glxID: GLXDrawable; begin inherited OpenContext; @@ -453,7 +449,8 @@ begin SetLength(Attribs, 1); Attribs[High(Attribs)] := 0; - glXMakeCurrent(FDisplay, GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window), tmpContext); + glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window); + glXMakeCurrent(FDisplay, glxID, tmpContext); ReadImplementationProperties; if not Assigned(glXCreateContextAttribsARB) or not GLX_ARB_create_context then begin glXDestroyContext(FDisplay, tmpContext); @@ -500,6 +497,8 @@ begin end; procedure TglcContextGtk2GLX.Activate; +var + glxID: GLXDrawable; begin if not Assigned(FWidget) then exit; // make sure the widget is realized @@ -507,30 +506,36 @@ begin if not GTK_WIDGET_REALIZED(FWidget) then exit; // make current - - glXMakeCurrent(FDisplay, GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window), FContext); + glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window); + glXMakeCurrent(FDisplay, glxID, FContext); end; procedure TglcContextGtk2GLX.Deactivate; +var + glxID: GLXDrawable; begin if not Assigned(FWidget) then exit; - glXMakeCurrent(FDisplay, GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window), nil); + glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window); + glXMakeCurrent(FDisplay, glxID, nil); end; function TglcContextGtk2GLX.IsActive: boolean; +var + glxID: GLXDrawable; begin + glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window); Result:= (FContext = glXGetCurrentContext()) and Assigned(FWidget) and - (GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window) = glXGetCurrentDrawable()); + (glxID = glXGetCurrentDrawable()); end; procedure TglcContextGtk2GLX.SwapBuffers; var - drawable: PGdkDrawable; + glxID: GLXDrawable; begin if not Assigned(FWidget) then exit; - drawable:= GTK_WIDGET(FWidget)^.window; - glXSwapBuffers(FDisplay, GDK_DRAWABLE_XID(drawable)); + glxID := GDK_DRAWABLE_XID(GTK_WIDGET(FWidget)^.window); + glXSwapBuffers(FDisplay, glxID); end; procedure TglcContextGtk2GLX.SetSwapInterval(const aInterval: GLint); @@ -547,7 +552,7 @@ begin raise Exception.Create('not yet implemented'); end; -class function TglcContextGtk2GLX.ChangeDisplaySettings(const aWidth, aHeight, +class function TglcContextGtk2GLX.{%H-}ChangeDisplaySettings(const aWidth, aHeight, aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean; begin raise Exception.Create('not yet implemented'); @@ -559,4 +564,4 @@ begin end; end. - \ No newline at end of file + diff --git a/uglcShader.pas b/uglcShader.pas index 634d57f..750e8bc 100644 --- a/uglcShader.pas +++ b/uglcShader.pas @@ -1,975 +1,975 @@ -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; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - 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; + +{ 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, uglcContext; + +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; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + 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 not TglcContext.IsAnyContextActive 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. + \ No newline at end of file -- 2.1.4