--- /dev/null
+unit uglcArrayBuffer;
+
+{ Package: OpenGLCore
+ Prefix: glc - OpenGL Core
+ Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Array Buffer }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ dglOpenGL, sysutils, uglcTypes;
+
+type
+ EglcArrayBuffer = class(Exception);
+ TglcArrayBuffer = class(TObject)
+ private
+ fID: GLuint;
+ fTarget: TglcBufferTarget;
+ fUsage: TglcBufferUsage;
+ protected
+ fDataCount: Integer;
+ fDataSize: Integer;
+ public
+ property ID: gluInt read fID;
+ property Target: TglcBufferTarget read fTarget;
+ property Usage: TglcBufferUsage read fUsage;
+ property DataCount: Integer read fDataCount;
+ property DataSize: Integer read fDataSize;
+
+ procedure BufferData(const aDataCount, aDataSize: Cardinal; const aUsage: TglcBufferUsage; const aData: Pointer);
+ function MapBuffer(const aAccess: TglcBufferAccess): Pointer;
+ procedure UnmapBuffer;
+ procedure Bind;
+ procedure Unbind;
+ constructor Create(const aTarget: TglcBufferTarget);
+ destructor Destroy; override;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcArrayBuffer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.BufferData(const aDataCount, aDataSize: Cardinal; const aUsage: TglcBufferUsage; const aData: Pointer);
+begin
+ glGetError(); //clear Errors
+ Bind;
+ fDataCount := aDataCount;
+ fDataSize := aDataSize;
+ fUsage := aUsage;
+ glBufferData(GLenum(fTarget), fDataCount * fDataSize, aData, GLenum(fUsage));
+ glcCheckAndRaiseError;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+function TglcArrayBuffer.MapBuffer(const aAccess: TglcBufferAccess): Pointer;
+begin
+ glGetError();
+ result := nil;
+ if (fDataCount * fDataSize) <= 0 then
+ exit;
+ result := glMapBuffer(GLenum(fTarget), GLenum(aAccess));
+ glcCheckAndRaiseError;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.UnmapBuffer;
+begin
+ glUnmapBuffer(GLenum(fTarget));
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.Bind;
+begin
+ glBindBuffer(GLenum(fTarget), fID);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.Unbind;
+begin
+ glBindBuffer(GLenum(fTarget), 0);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+constructor TglcArrayBuffer.Create(const aTarget: TglcBufferTarget);
+begin
+ if not GL_ARB_Vertex_Buffer_Object then
+ raise EglcArrayBuffer.Create('Create - VertexBuffer: not supported');
+ inherited Create;
+ glGenBuffers(1, @fID);
+ fDataCount := 0;
+ fDataSize := 0;
+ fTarget := aTarget;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+destructor TglcArrayBuffer.Destroy;
+begin
+ glDeleteBuffers(1, @fID);
+ inherited Destroy;
+end;
+
+end.
+
--- /dev/null
+unit uglcCamera;
+
+{ Package: OpenGLCore
+ Prefix: glc - OpenGL Core
+ Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Frustum und Kamera }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils,
+ ugluVector, ugluMatrix;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcFrustum = class(TObject)
+ private
+ function GetWidth: Single;
+ function GetHeight: Single;
+ function GetFOVAngle: Single;
+ function GetAspectRatio: Single;
+ protected
+ fIsOrthogonal: Boolean;
+ fTop, fBottom, fLeft, fRight, fNear, fFar: Single;
+ public
+ property Top : Single read fTop;
+ property Bottom : Single read fBottom;
+ property Left : Single read fLeft;
+ property Right : Single read fRight;
+ property Near : Single read fNear;
+ property Far : Single read fFar;
+ property Width : Single read GetWidth;
+ property Height : Single read GetHeight;
+ property FOVAngle : Single read GetFOVAngle;
+ property AspectRatio : Single read GetAspectRatio;
+ property IsOrthogonal: Boolean read fIsOrthogonal;
+
+ procedure Frustum(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+ procedure Perspective(const aFOVAngle, aAspectRatio, aNear, aFar: Single);
+ procedure Ortho(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+ procedure Activate;
+ procedure Render;
+
+ constructor Create;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcCamera = class(TglcFrustum)
+ private
+ fPosition: TgluMatrix4f;
+ public
+ property Position: TgluMatrix4f read fPosition write fPosition;
+
+ procedure Move(const aVec: TgluVector3f);
+ procedure Tilt(const aAngle: Single);
+ procedure Turn(const aAngle: Single);
+ procedure Roll(const aAngle: Single);
+ procedure Activate;
+ function GetRay(const aPos: TgluVector2f): TgluRayf;
+
+ constructor Create;
+ end;
+
+implementation
+
+uses
+ Math, dglOpenGL;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcFrustum///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetWidth: Single;
+begin
+ result := (fRight - fLeft);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetHeight: Single;
+begin
+ result := (fTop - fBottom);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetFOVAngle: Single;
+begin
+ result := arctan2(Height/2, fNear)/Pi*360;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetAspectRatio: Single;
+begin
+ result := Height / Width;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Frustum(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+begin
+ fIsOrthogonal := false;
+ fTop := aRight;
+ fBottom := aLeft;
+ fLeft := aBottom;
+ fRight := aTop;
+ fNear := aNear;
+ fFar := aFar;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Perspective(const aFOVAngle, aAspectRatio, aNear, aFar: Single);
+begin
+ fIsOrthogonal := false;
+ fNear := aNear;
+ fFar := aFar;
+ fTop := fNear * tan(aFOVAngle / 360 * Pi);
+ fBottom := -fTop;
+ fRight := aAspectRatio * fTop;
+ fLeft := -fRight;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Ortho(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+begin
+ fIsOrthogonal := true;
+ fLeft := aLeft;
+ fRight := aRight;
+ fTop := aTop;
+ fBottom := aBottom;
+ fNear := aNear;
+ fFar := aFar;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Activate;
+begin
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ if fIsOrthogonal then
+ glOrtho(fLeft, fRight, fBottom, fTop, fNear, fFar)
+ else
+ glFrustum(fLeft, fRight, fBottom, fTop, fNear, fFar);
+ glMatrixMode(GL_MODELVIEW);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Render;
+var
+ min, max: TgluVector2f;
+begin
+ min[0] := fLeft / fNear * fFar;
+ min[1] := fBottom / fNear * fFar;
+ max[0] := fRight / fNear * fFar;
+ max[1] := fTop / fNear * fFar;
+
+ glBegin(GL_LINE_LOOP);
+ glVertex3f(fLeft, fTop, -fNear);
+ glVertex3f(fLeft, fBottom, -fNear);
+ glVertex3f(fRight, fBottom, -fNear);
+ glVertex3f(fRight, fTop, -fNear);
+ glEnd;
+
+ glBegin(GL_LINE_LOOP);
+ glVertex3f(min[0], min[0], -fFar);
+ glVertex3f(min[0], max[0], -fFar);
+ glVertex3f(max[0], max[0], -fFar);
+ glVertex3f(max[0], min[0], -fFar);
+ glEnd;
+
+ glBegin(GL_LINES);
+ glVertex3f(0, 0, 0); glVertex3f(min[0], min[0], -fFar);
+ glVertex3f(0, 0, 0); glVertex3f(min[0], max[0], -fFar);
+ glVertex3f(0, 0, 0); glVertex3f(max[0], max[0], -fFar);
+ glVertex3f(0, 0, 0); glVertex3f(max[0], min[0], -fFar);
+ glEnd;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcFrustum.Create;
+begin
+ inherited Create;
+ fTop := 0;
+ fBottom := 0;
+ fLeft := 0;
+ fRight := 0;
+ fNear := 0;
+ fFar := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcCamera////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Move(const aVec: TgluVector3f);
+begin
+ fPosition := gluMatrixMult(gluMatrixTranslate(aVec), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Tilt(const aAngle: Single);
+begin
+ fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(1,0,0), aAngle), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Turn(const aAngle: Single);
+begin
+ fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(0,1,0), aAngle), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Roll(const aAngle: Single);
+begin
+ fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(0,0,1), aAngle), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Activate;
+begin
+ inherited Activate;
+ glLoadMatrixf(@fPosition[0, 0]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcCamera.GetRay(const aPos: TgluVector2f): TgluRayf;
+var
+ p: TgluVector3f;
+begin
+ if (aPos[0] < 0) then
+ p[0] := -aPos[0] * fLeft
+ else
+ p[0] := aPos[0] * fRight;
+ if (aPos[1] < 0) then
+ p[1] := -aPos[1] * fBottom
+ else
+ p[1] := aPos[1] * fTop;
+ if (fIsOrthogonal) then begin
+ p[2] := 0;
+ result.p := fPosition * p;
+ result.v := fPosition * gluVector3f(0, 0, -1);
+ end else begin
+ p[2] := -fNear;
+ result.p := gluVector3f(0, 0, 0);
+ result.v := fPosition * p;
+ end;
+ result := gluRayNormalize(result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcCamera.Create;
+begin
+ inherited Create;
+ fPosition := gluMatrixIdentity;
+end;
+
+end.
+
--- /dev/null
+unit uglcFrameBufferObject;
+
+{ Package: OpenGLCore
+ Prefix: glc - OpenGL Core
+ Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL FrameBufferObjekte }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fgl, dglOpenGl, uglcTypes;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcBufferType = (btRenderBuffer, btTextureBuffer);
+ TglcBuffer = class(TObject)
+ private
+ fBufferType: TglcBufferType;
+ fWidth: Integer;
+ fHeight: Integer;
+
+ procedure SetWidth(const aValue: Integer);
+ procedure SetHeight(const aValue: Integer);
+ public
+ property Width : Integer read fWidth write SetWidth;
+ property Height: Integer read fHeight write SetHeight;
+ property BufferType: TglcBufferType read fBufferType;
+
+ procedure SetSize(const aWidth, aHeight: Integer); virtual;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EglcRenderBuffer = class(Exception);
+ TglcRenderBuffer = class(TglcBuffer)
+ private
+ fID: gluInt;
+ fFormat: TglcInternalFormat;
+
+ procedure UpdateRenderBufferStorage;
+ procedure SetFormat(const aValue: TglcInternalFormat);
+ public
+ property ID: gluInt read fID;
+ property Format: TglcInternalFormat read fFormat write SetFormat;
+
+ procedure SetSize(const aWidth, aHeight: Integer); override;
+ procedure Bind;
+ procedure Unbind;
+
+ constructor Create(const aFormat: TglcInternalFormat);
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EglcTextureBuffer = class(exception);
+ TglcTextureBuffer = class(TglcBuffer)
+ private
+ fID: GLuint;
+ fFormat: TglcFormat;
+ fInternalFormat: TglcInternalFormat;
+ fBorder: Boolean;
+
+ procedure UpdateTexImage;
+ procedure SetFormat(const aValue: TglcFormat);
+ procedure SetInternalFormat(const aValue: TglcInternalFormat);
+ procedure SetBorder(const aValue: Boolean);
+ public
+ property ID : GLuint read fID;
+ property Border : Boolean read fBorder write SetBorder;
+ property Format : TglcFormat read fFormat write SetFormat;
+ property InternalFormat: TglcInternalFormat read fInternalFormat write SetInternalFormat;
+
+ procedure SetSize(const aWidth, aHeight: Integer); override;
+ procedure Bind(const aEnableTextureUnit: Boolean = true);
+ procedure Unbind(const aDisableTextureUnit: Boolean = true);
+
+ constructor Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat);
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EglcFrameBufferObject = class(Exception);
+ TglcFrameBufferObject = class(TObject)
+ private type
+ TglcAttachmentContainer = class(TObject)
+ Buffer: TglcBuffer;
+ Attachment: TglcAttachment;
+ OwnsObject: Boolean;
+ constructor Create(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsObject: Boolean = true);
+ destructor Destroy; override;
+ end;
+ TglcAttachmentContainerList = specialize TFPGObjectList<TglcAttachmentContainer>;
+ private
+ fID: GLuint;
+ fOwnsObjects: Boolean;
+ fWidth: Integer;
+ fHeight: Integer;
+ fBuffers: TglcAttachmentContainerList;
+
+ function GetBuffer(const aIndex: Integer): TglcBuffer;
+ procedure SetBuffer(const aIndex: Integer; const aValue: TglcBuffer);
+
+ function GetAttachment(const aIndex: Integer): TglcAttachment;
+ procedure SetAttachment(const aIndex: Integer; const aValue: TglcAttachment);
+
+ function GetBufferCount: Integer;
+
+ procedure Attach(const aIndex: Integer);
+ procedure Detach(const aIndex: Integer);
+
+ procedure SetWidth(const aValue: Integer);
+ procedure SetHeight(const aValue: Integer);
+ procedure CheckFrameBufferStatus;
+ procedure UpdateAndCheckFBO;
+ public
+ property ID : GLuint read fID;
+ property Count : Integer read GetBufferCount;
+ property OwnsObjects: Boolean read fOwnsObjects;
+ property Width : Integer read fWidth write SetWidth;
+ property Height : Integer read fHeight write SetHeight;
+ property Attachments[const aIndex: Integer]: TglcAttachment read GetAttachment write SetAttachment;
+ property Buffers [const aIndex: Integer]: TglcBuffer read GetBuffer write SetBuffer;
+
+ procedure AddBuffer(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean = true);
+ procedure DelBuffer(const aIndex: Integer);
+ function RemBuffer(const aBuffer: TglcBuffer): Integer;
+ function IndexOfBuffer(const aBuffer: TglcBuffer): Integer;
+
+ procedure SetSize(const aWidth, aHeight: Integer);
+ function CheckAttachment(const aAttachment: TglcAttachment): Boolean;
+
+ procedure Bind(const aSetViewport: Boolean = true);
+ procedure Unbind(const aResetViewport: Boolean = true);
+
+ constructor Create(const aOwnBuffers: Boolean = true);
+ destructor Destroy; override;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcBuffer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcBuffer.SetWidth(const aValue: Integer);
+begin
+ SetSize(aValue, fHeight);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcBuffer.SetHeight(const aValue: Integer);
+begin
+ SetSize(fWidth, aValue);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcBuffer.SetSize(const aWidth, aHeight: Integer);
+begin
+ fWidth := aWidth;
+ fHeight := aHeight;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcRenderBuffer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcRenderBuffer.UpdateRenderBufferStorage;
+begin
+ glGetError; //clear Erroros
+ Bind;
+ glRenderbufferStorage(GL_RENDERBUFFER, GLenum(fFormat), fWidth, fHeight);
+ Unbind;
+ glcCheckAndRaiseError;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcRenderBuffer.SetFormat(const aValue: TglcInternalFormat);
+begin
+ fFormat := aValue;
+ UpdateRenderBufferStorage;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcRenderBuffer.SetSize(const aWidth, aHeight: Integer);
+begin
+ if (aWidth <= 0) or (aHeight <= 0) then
+ raise EglcRenderBuffer.Create('invalid width or height');
+ if (aWidth <> fWidth) or (aHeight <> fHeight) then begin
+ inherited SetSize(aWidth, aHeight);
+ UpdateRenderBufferStorage;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcRenderBuffer.Bind;
+begin
+ glBindRenderbuffer(GL_RENDERBUFFER, fID);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcRenderBuffer.Unbind;
+begin
+ glBindRenderbuffer(GL_RENDERBUFFER, 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcRenderBuffer.Create(const aFormat: TglcInternalFormat);
+begin
+ inherited Create;
+ fBufferType := btRenderBuffer;
+ glGenRenderbuffers(1, @fID);
+ fFormat := aFormat;
+ SetSize(64, 64);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TglcRenderBuffer.Destroy;
+begin
+ glDeleteRenderbuffers(1, @fID);
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcTextureBuffer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcTextureBuffer.UpdateTexImage;
+begin
+ glGetError; //clear errors
+ Bind(false);
+ glTexImage2D(GL_TEXTURE_2D, 0, GLenum(fInternalFormat), fWidth, fHeight, GLint(Byte(fBorder) and Byte(1)), GLenum(fFormat), GL_UNSIGNED_BYTE, nil);
+ Unbind(false);
+ glcCheckAndRaiseError;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcTextureBuffer.SetFormat(const aValue: TglcFormat);
+begin
+ if (fFormat <> aValue) then begin
+ fFormat := aValue;
+ UpdateTexImage;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcTextureBuffer.SetInternalFormat(const aValue: TglcInternalFormat);
+begin
+ if (fInternalFormat <> aValue) then begin
+ fInternalFormat := aValue;
+ UpdateTexImage;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcTextureBuffer.SetBorder(const aValue: Boolean);
+begin
+ if (fBorder <> aValue) then begin
+ fBorder := aValue;
+ UpdateTexImage;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcTextureBuffer.SetSize(const aWidth, aHeight: Integer);
+begin
+ if (aWidth <= 0) or (aHeight <= 0) then
+ raise EglcTextureBuffer.Create('invalid width or height');
+ if (aWidth <> fWidth) or (aHeight <> fHeight) then begin
+ inherited SetSize(aWidth, aHeight);
+ UpdateTexImage;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcTextureBuffer.Bind(const aEnableTextureUnit: Boolean = true);
+begin
+ if aEnableTextureUnit then
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, fID);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcTextureBuffer.Unbind(const aDisableTextureUnit: Boolean = true);
+begin
+ if aDisableTextureUnit then
+ glDisable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcTextureBuffer.Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat);
+begin
+ inherited Create;
+ fBufferType := btTextureBuffer;
+
+ glGenTextures(1, @fID);
+ Bind(false);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ Unbind(false);
+
+ fFormat := aFormat;
+ fInternalFormat := aInternalFormat;
+ SetSize(64, 64);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TglcTextureBuffer.Destroy;
+begin
+ glDeleteTextures(1, @fID);
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcAttachment////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcFrameBufferObject.TglcAttachmentContainer.Create(const aBuffer: TglcBuffer;
+ const aAttachment: TglcAttachment; const aOwnsObject: Boolean);
+begin
+ inherited Create;
+ Buffer := aBuffer;
+ Attachment := aAttachment;
+ OwnsObject := aOwnsObject;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TglcFrameBufferObject.TglcAttachmentContainer.Destroy;
+begin
+ if OwnsObject then
+ Buffer.Free;
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcFrameBufferObject/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrameBufferObject.GetBuffer(const aIndex: Integer): TglcBuffer;
+begin
+ if (aIndex >= 0) and (aIndex < fBuffers.Count) then
+ result := fBuffers[aIndex].Buffer
+ else
+ raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrameBufferObject.SetBuffer(const aIndex: Integer; const aValue: TglcBuffer);
+begin
+ if (aIndex < 0) or (aIndex >= fBuffers.Count) then
+ raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
+
+ if not Assigned(aValue) then
+ raise EglcFrameBufferObject.Create('invalid buffer');
+
+ Detach(aIndex);
+ fBuffers[aIndex].Buffer := aValue;
+ Attach(aIndex);
+ UpdateAndCheckFBO;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrameBufferObject.GetAttachment(const aIndex: Integer): TglcAttachment;
+begin
+ if (aIndex >= 0) and (aIndex < fBuffers.Count) then
+ result := fBuffers[aIndex].Attachment
+ else
+ raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrameBufferObject.SetAttachment(const aIndex: Integer; const aValue: TglcAttachment);
+begin
+ if (aIndex < 0) or (aIndex >= fBuffers.Count) then
+ raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
+
+ if not CheckAttachment(aValue) then
+ raise EglcFrameBufferObject.Create('Attachment already assigned');
+
+ Detach(aIndex);
+ fBuffers[aIndex].Attachment := aValue;
+ Attach(aIndex);
+ UpdateAndCheckFBO;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrameBufferObject.Attach(const aIndex: Integer);
+var
+ a: TglcAttachment;
+ b: TglcBuffer;
+begin
+ a := Attachments[aIndex];
+ b := Buffers[aIndex];
+ Bind(false);
+ if (b.BufferType = btRenderBuffer) then
+ glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, (b as TglcRenderBuffer).ID)
+ else
+ glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, (b as TglcTextureBuffer).ID, 0);
+ Unbind(false);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrameBufferObject.Detach(const aIndex: Integer);
+var
+ a: TglcAttachment;
+ b: TglcBuffer;
+begin
+ a := Attachments[aIndex];
+ b := Buffers[aIndex];
+ Bind(false);
+ if (b.BufferType = btRenderBuffer) then
+ glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, 0)
+ else
+ glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, 0, 0);
+ Unbind(false);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//legt die neue Breite fest
+//@Value: Breite;
+procedure TglcFrameBufferObject.SetWidth(const aValue: Integer);
+begin
+ SetSize(aValue, fHeight);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//legt die neue Höhe fest
+//@Value: neue Höhe;
+procedure TglcFrameBufferObject.SetHeight(const aValue: Integer);
+begin
+ SetSize(fWidth, aValue);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrameBufferObject.CheckFrameBufferStatus;
+begin
+ case glCheckFramebufferStatus(GL_FRAMEBUFFER) of
+ GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT:
+ raise EglcFrameBufferObject.Create('Incomplete attachment');
+ GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT:
+ raise EglcFrameBufferObject.Create('Missing attachment');
+ GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT:
+ raise EglcFrameBufferObject.Create('Incomplete dimensions');
+ GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT:
+ raise EglcFrameBufferObject.Create('Incomplete formats');
+ GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER:
+ raise EglcFrameBufferObject.Create('Incomplete draw buffer');
+ GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER:
+ raise EglcFrameBufferObject.Create('Incomplete read buffer');
+ GL_FRAMEBUFFER_UNSUPPORTED:
+ raise EglcFrameBufferObject.Create('Framebufferobjects unsupported');
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//prüft das FrameBufferObjekt auf Fehler
+procedure TglcFrameBufferObject.UpdateAndCheckFBO;
+
+ function IsColorAttachment(const a: TglcAttachment): Boolean;
+ begin
+ result := (GLenum(a) >= GL_COLOR_ATTACHMENT0) and (GLenum(a) <= GL_COLOR_ATTACHMENT15);
+ end;
+
+var
+ buff: array of GLenum;
+ b: GLboolean;
+ i: Integer;
+begin
+ if (fBuffers.Count = 0) then
+ exit;
+ Bind(false);
+
+ //find ColorBuffers
+ SetLength(buff, 0);
+ for i := 0 to fBuffers.Count-1 do
+ if IsColorAttachment(fBuffers[i].Attachment) then begin
+ SetLength(buff, Length(buff) + 1);
+ buff[High(buff)] := GLenum(fBuffers[i].Attachment);
+ end;
+
+ //set Read and Draw Buffer
+ if (Length(buff) = 0) then begin
+ glReadBuffer(GL_NONE);
+ glDrawBuffer(GL_NONE);
+ end else begin
+ glDrawBuffers(Length(buff), @buff[0]);
+ glGetBooleanv(GL_DOUBLEBUFFER, @b);
+ if b then
+ glReadBuffer(GL_BACK)
+ else
+ glReadBuffer(GL_FRONT);
+ end;
+ Unbind(false);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrameBufferObject.GetBufferCount: Integer;
+begin
+ result := fBuffers.Count;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrameBufferObject.AddBuffer(const aBuffer: TglcBuffer;
+ const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean);
+begin
+ if not Assigned(aBuffer) then
+ raise EglcFrameBufferObject.Create('invalid buffer');
+ if not CheckAttachment(aAttachment) then
+ raise EglcFrameBufferObject.Create('attachment already assigned');
+
+ fBuffers.Add(TglcAttachmentContainer.Create(aBuffer, aAttachment, fOwnsObjects and aOwnsBuffer));
+ if OwnsObjects then
+ aBuffer.SetSize(fWidth, fHeight);
+ Attach(fBuffers.Count-1);
+
+ UpdateAndCheckFBO;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrameBufferObject.DelBuffer(const aIndex: Integer);
+begin
+ if (aIndex >= 0) and (aIndex < fBuffers.Count) then begin
+ Detach(aIndex);
+ fBuffers.Delete(aIndex);
+ UpdateAndCheckFBO;
+ end else
+ raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrameBufferObject.RemBuffer(const aBuffer: TglcBuffer): Integer;
+begin
+ result := IndexOfBuffer(aBuffer);
+ if (result >= 0) then
+ DelBuffer(result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrameBufferObject.IndexOfBuffer(const aBuffer: TglcBuffer): Integer;
+var
+ i: Integer;
+begin
+ for i := 0 to fBuffers.Count-1 do
+ if (fBuffers[i].Buffer = aBuffer) then begin
+ result := i;
+ exit;
+ end;
+ result := -1;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//legt die Größe neu fest
+//@Width: neue Breite;
+//@Height: neue Höhe;
+procedure TglcFrameBufferObject.SetSize(const aWidth, aHeight: Integer);
+var
+ c: TglcAttachmentContainer;
+begin
+ if (aWidth <= 0) or (aHeight <= 0) then
+ raise EglcFrameBufferObject.Create('invalid width or height');
+
+ fWidth := aWidth;
+ fHeight := aHeight;
+ if OwnsObjects then
+ for c in fBuffers do
+ if c.OwnsObject then
+ c.Buffer.SetSize(fWidth, fHeight);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrameBufferObject.CheckAttachment(const aAttachment: TglcAttachment): Boolean;
+var
+ i: Integer;
+begin
+ result := false;
+ for i := 0 to fBuffers.Count-1 do
+ if (fBuffers[i].Attachment = aAttachment) then
+ exit;
+ result := true;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Bindet das FrameBufferObjekt
+procedure TglcFrameBufferObject.Bind(const aSetViewport: Boolean = true);
+begin
+ glBindFramebuffer(GL_FRAMEBUFFER, fID);
+ if aSetViewport then begin
+ glPushAttrib(GL_VIEWPORT_BIT);
+ glViewPort(0, 0, fWidth, fHeight);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Entbindet das FrameBufferObjekt
+procedure TglcFrameBufferObject.Unbind(const aResetViewport: Boolean = true);
+begin
+ if aResetViewport then
+ glPopAttrib;
+ glBindFramebuffer(GL_FRAMEBUFFER, 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erzeugt das Objekt
+constructor TglcFrameBufferObject.Create(const aOwnBuffers: Boolean = true);
+begin
+ inherited Create;
+
+ glGenFramebuffers(1, @fID);
+ fWidth := 64;
+ fHeight := 64;
+ fOwnsObjects := aOwnBuffers;
+ fBuffers := TglcAttachmentContainerList.Create(true); //containers are always owned by this object!
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//gibt das Objekt frei
+destructor TglcFrameBufferObject.Destroy;
+begin
+ fBuffers.Free;
+ glDeleteFramebuffers(1, @fID);
+ inherited Destroy;
+end;
+
+end.
+
--- /dev/null
+unit uglcLight;
+
+{ Package: OpenGLCore
+ Prefix: glc - OpenGL Core
+ Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Licht- und Material-Objekte }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, dglOpenGL, ugluVector, uglcTypes;
+
+type
+ TglcMaterialRec = packed record
+ Ambient: TgluVector4f;
+ Diffuse: TgluVector4f;
+ Specular: TgluVector4f;
+ Emission: TgluVector4f;
+ Shininess: GLfloat;
+ end;
+ PglcMaterialRec = ^TglcMaterialRec;
+
+ TglcLightType = (ltGlobal, ltPoint, ltSpot);
+ TglcLightRec = packed record
+ Ambient: TgluVector4f;
+ Diffuse: TgluVector4f;
+ Specular: TgluVector4f;
+ Position: TgluVector4f;
+ SpotDirection: TgluVector3f;
+ SpotExponent: GLfloat;
+ SpotCutoff: GLfloat;
+ ConstantAtt: GLfloat;
+ LinearAtt: GLfloat;
+ QuadraticAtt: GLfloat;
+ end;
+ PglcLightRec = ^TglcLightRec;
+
+const
+ MAT_DEFAULT_AMBIENT: TgluVector4f = (0.2, 0.2, 0.2, 1.0);
+ MAT_DEFAULT_DIFFUSE: TgluVector4f = (0.8, 0.8, 0.8, 1.0);
+ MAT_DEFAULT_SPECULAR: TgluVector4f = (0.5, 0.5, 0.5, 1.0);
+ MAT_DEFAULT_EMISSION: TgluVector4f = (0.0, 0.0, 0.0, 1.0);
+ MAT_DEFAULT_SHININESS: GLfloat = 50.0;
+
+ LIGHT_DEFAULT_AMBIENT: TgluVector4f = (0.4, 0.4, 0.4, 1.0);
+ LIGHT_DEFAULT_DIFFUSE: TgluVector4f = (0.7, 0.7, 0.7, 1.0);
+ LIGHT_DEFAULT_SPECULAR: TgluVector4f = (0.9, 0.9, 0.9, 1.0);
+ LIGHT_DEFAULT_POSITION: TgluVector4f = (0.0, 0.0, 1.0, 0.0);
+ LIGHT_DEFAULT_SPOT_DIRECTION: TgluVector3f = (0.0, 0.0, -1.0);
+ LIGHT_DEFAULT_SPOT_EXPONENT: GLfloat = 0.0;
+ LIGHT_DEFAULT_SPOT_CUTOFF: GLfloat = 180.0;
+ LIGHT_DEFAULT_CONSTANT_ATT: GLfloat = 1.0;
+ LIGHT_DEFAULT_LINEAR_ATT: GLfloat = 0.0;
+ LIGHT_DEFAULT_QUADRATIC_ATT: GLfloat = 0.0;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcMaterial = class(TObject)
+ private
+ fData: TglcMaterialRec;
+ public
+ property Diffuse: TgluVector4f read fData.Diffuse write fData.Diffuse;
+ property Ambient: TgluVector4f read fData.Ambient write fData.Ambient;
+ property Specular: TgluVector4f read fData.Specular write fData.Specular;
+ property Emission: TgluVector4f read fData.Emission write fData.Emission;
+ property Shininess: GLfloat read fData.Shininess write fData.Shininess;
+ property Data: TglcMaterialRec read fData write fData;
+
+ procedure Bind(const aFace: TglcFace);
+
+ class procedure Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
+ class function DefaultValues: TglcMaterialRec;
+
+ constructor Create;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EglcLight = class(Exception);
+ TglcLight = class(TObject)
+ private
+ function GetDataPtr: PglcLightRec;
+ protected
+ fData: TglcLightRec;
+
+ procedure SetAmbient (const aValue: TgluVector4f); virtual;
+ procedure SetDiffuse (const aValue: TgluVector4f); virtual;
+ procedure SetSpecular (const aValue: TgluVector4f); virtual;
+ procedure SetPosition4f (const aValue: TgluVector4f); virtual;
+ procedure SetSpotDirection(const aValue: TgluVector3f); virtual;
+ procedure SetSpotExponent (const aValue: GLfloat); virtual;
+ procedure SetSpotCutoff (const aValue: GLfloat); virtual;
+ procedure SetConstantAtt (const aValue: GLfloat); virtual;
+ procedure SetLinearAtt (const aValue: GLfloat); virtual;
+ procedure SetQuadraticAtt (const aValue: GLfloat); virtual;
+ procedure SetData (const aValue: TglcLightRec); virtual;
+
+ property Ambient: TgluVector4f read fData.Ambient write SetAmbient;
+ property Diffuse: TgluVector4f read fData.Diffuse write SetDiffuse;
+ property Specular: TgluVector4f read fData.Specular write SetSpecular;
+ property Position4f: TgluVector4f read fData.Position write SetPosition4f;
+ property SpotDirection: TgluVector3f read fData.SpotDirection write SetSpotDirection;
+ property SpotExponent: GLfloat read fData.SpotExponent write SetSpotExponent;
+ property SpotCutoff: GLfloat read fData.SpotCutoff write SetSpotCutoff;
+ property ConstantAtt: GLfloat read fData.ConstantAtt write SetConstantAtt;
+ property LinearAtt: GLfloat read fData.LinearAtt write SetLinearAtt;
+ property QuadraticAtt: GLfloat read fData.QuadraticAtt write SetQuadraticAtt;
+ public
+ property Data: TglcLightRec read fData write SetData;
+ property DataPtr: PglcLightRec read GetDataPtr;
+
+ procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); virtual; abstract;
+
+ class procedure Bind(const aLightID: GLenum; const aLight: TglcLightRec;
+ const aEnableLighting: Boolean; const aLightType: TglcLightType);
+ class procedure Unbind(const aLightID: GLenum; const aDisableLighting: Boolean = true);
+ class function DefaultValues: TglcLightRec; virtual;
+
+ constructor Create;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcLightGlobal = class(TglcLight)
+ private
+ function GetDirection: TgluVector3f;
+ procedure SetDirection(aValue: TgluVector3f);
+ public
+ property Ambient;
+ property Diffuse;
+ property Specular;
+ property Direction: TgluVector3f read GetDirection write SetDirection;
+
+ procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcLightPoint = class(TglcLight)
+ private
+ fMaxSize: Single;
+ fSizeFactor: Single;
+ function GetPosition: TgluVector3f;
+ procedure SetPosition(const aValue: TgluVector3f);
+ protected
+ procedure SetMaxSize (const aValue: Single); virtual;
+ procedure SetSizeFactor(const aValue: Single); virtual;
+ public
+ property Ambient;
+ property Diffuse;
+ property Specular;
+ property ConstantAtt;
+ property LinearAtt;
+ property QuadraticAtt;
+ property MaxSize: Single read fMaxSize write SetMaxSize;
+ property SizeFactor: Single read fSizeFactor write SetSizeFactor;
+ property Position: TgluVector3f read GetPosition write SetPosition;
+
+ procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
+
+ constructor Create;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcLightSpot = class(TglcLightPoint)
+ public
+ property SpotCutoff;
+ property SpotDirection;
+ property SpotExponent;
+
+ procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcMaterial//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcMaterial.Bind(const aFace: TglcFace);
+begin
+ Bind(aFace, fData);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TglcMaterial.Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
+begin
+ glMaterialfv(GLenum(aFace), GL_AMBIENT, @aMaterial.Ambient[0]);
+ glMaterialfv(GLenum(aFace), GL_DIFFUSE, @aMaterial.Diffuse[0]);
+ glMaterialfv(GLenum(aFace), GL_EMISSION, @aMaterial.Emission[0]);
+ glMaterialfv(GLenum(aFace), GL_SPECULAR, @aMaterial.Specular[0]);
+ glMaterialfv(GLenum(aFace), GL_SHININESS, @aMaterial.Shininess);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TglcMaterial.DefaultValues: TglcMaterialRec;
+begin
+ result.Ambient := MAT_DEFAULT_AMBIENT;
+ result.Diffuse := MAT_DEFAULT_DIFFUSE;
+ result.Specular := MAT_DEFAULT_SPECULAR;
+ result.Emission := MAT_DEFAULT_EMISSION;
+ result.Shininess := MAT_DEFAULT_SHININESS;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcMaterial.Create;
+begin
+ inherited Create;
+ fData := DefaultValues;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLight/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcLight.GetDataPtr: PglcLightRec;
+begin
+ result := @fData;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetAmbient(const aValue: TgluVector4f);
+begin
+ fData.Ambient := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetDiffuse(const aValue: TgluVector4f);
+begin
+ fData.Diffuse := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpecular(const aValue: TgluVector4f);
+begin
+ fData.Specular := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetPosition4f(const aValue: TgluVector4f);
+begin
+ fData.Position := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetConstantAtt(const aValue: GLfloat);
+begin
+ fData.ConstantAtt := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetLinearAtt(const aValue: GLfloat);
+begin
+ fData.LinearAtt := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetQuadraticAtt(const aValue: GLfloat);
+begin
+ fData.QuadraticAtt := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpotDirection(const aValue: TgluVector3f);
+begin
+ fData.SpotDirection := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpotExponent(const aValue: GLfloat);
+begin
+ fData.SpotExponent := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpotCutoff(const aValue: GLfloat);
+begin
+ fData.SpotCutoff := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetData(const aValue: TglcLightRec);
+begin
+ fData := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TglcLight.Bind(const aLightID: GLenum; const aLight: TglcLightRec;
+ const aEnableLighting: Boolean; const aLightType: TglcLightType);
+begin
+ glEnable(aLightID);
+ if (aEnableLighting) then
+ glEnable(GL_LIGHTING);
+
+ if (aLightType in [ltGlobal, ltPoint, ltSpot]) then begin
+ glLightfv(aLightID, GL_AMBIENT, @aLight.Ambient[0]);
+ glLightfv(aLightID, GL_DIFFUSE, @aLight.Diffuse[0]);
+ glLightfv(aLightID, GL_SPECULAR, @aLight.Specular[0]);
+ glLightfv(aLightID, GL_POSITION, @aLight.Position[0]);
+ end else begin
+ glLightfv(aLightID, GL_AMBIENT, @LIGHT_DEFAULT_AMBIENT[0]);
+ glLightfv(aLightID, GL_DIFFUSE, @LIGHT_DEFAULT_DIFFUSE[0]);
+ glLightfv(aLightID, GL_SPECULAR, @LIGHT_DEFAULT_SPECULAR[0]);
+ glLightfv(aLightID, GL_POSITION, @LIGHT_DEFAULT_POSITION[0]);
+ end;
+
+ if (aLightType in [ltPoint, ltSpot]) then begin
+ glLightfv(aLightID, GL_CONSTANT_ATTENUATION, @aLight.ConstantAtt);
+ glLightfv(aLightID, GL_LINEAR_ATTENUATION, @aLight.LinearAtt);
+ glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @aLight.QuadraticAtt);
+ end else begin
+ glLightfv(aLightID, GL_CONSTANT_ATTENUATION, @LIGHT_DEFAULT_CONSTANT_ATT);
+ glLightfv(aLightID, GL_LINEAR_ATTENUATION, @LIGHT_DEFAULT_LINEAR_ATT);
+ glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @LIGHT_DEFAULT_QUADRATIC_ATT);
+ end;
+
+ if (aLightType in [ltSpot]) then begin
+ glLightfv(aLightID, GL_SPOT_DIRECTION, @aLight.SpotDirection[0]);
+ glLightfv(aLightID, GL_SPOT_EXPONENT, @aLight.SpotExponent);
+ glLightfv(aLightID, GL_SPOT_CUTOFF, @aLight.SpotCutoff);
+ end else begin
+ glLightfv(aLightID, GL_SPOT_DIRECTION, @LIGHT_DEFAULT_SPOT_DIRECTION[0]);
+ glLightfv(aLightID, GL_SPOT_EXPONENT, @LIGHT_DEFAULT_SPOT_EXPONENT);
+ glLightfv(aLightID, GL_SPOT_CUTOFF, @LIGHT_DEFAULT_SPOT_CUTOFF);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TglcLight.Unbind(const aLightID: GLenum; const aDisableLighting: Boolean);
+begin
+ glDisable(aLightID);
+ if aDisableLighting then
+ glDisable(GL_LIGHTING);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TglcLight.DefaultValues: TglcLightRec;
+begin
+ result.Ambient := LIGHT_DEFAULT_AMBIENT;
+ result.Diffuse := LIGHT_DEFAULT_DIFFUSE;
+ result.Specular := LIGHT_DEFAULT_SPECULAR;
+ result.Position := LIGHT_DEFAULT_POSITION;
+ result.SpotDirection := LIGHT_DEFAULT_SPOT_DIRECTION;
+ result.SpotExponent := LIGHT_DEFAULT_SPOT_EXPONENT;
+ result.SpotCutoff := LIGHT_DEFAULT_SPOT_CUTOFF;
+ result.ConstantAtt := LIGHT_DEFAULT_CONSTANT_ATT;
+ result.LinearAtt := LIGHT_DEFAULT_LINEAR_ATT;
+ result.QuadraticAtt := LIGHT_DEFAULT_QUADRATIC_ATT;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcLight.Create;
+begin
+ inherited Create;
+ fData := DefaultValues;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLightGlobal///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcLightGlobal.GetDirection: TgluVector3f;
+begin
+ result := gluVector3f(Position4f);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightGlobal.SetDirection(aValue: TgluVector3f);
+begin
+ Position4f := gluVector4f(aValue, 0.0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightGlobal.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
+begin
+ TglcLight.Bind(aLightID, fData, aEnableLighting, ltGlobal);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLightPoint////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcLightPoint.GetPosition: TgluVector3f;
+begin
+ result := gluVector3f(fData.Position);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.SetPosition(const aValue: TgluVector3f);
+begin
+ SetPosition4f(gluVector4f(aValue, 1.0));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.SetMaxSize(const aValue: Single);
+begin
+ fMaxSize := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.SetSizeFactor(const aValue: Single);
+begin
+ fSizeFactor := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
+begin
+ TglcLight.Bind(aLightID, fData, aEnableLighting, ltPoint);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcLightPoint.Create;
+begin
+ inherited Create;
+ Position := gluVector3f(0.0, 0.0, 0.0);
+ fMaxSize := 0;
+ fSizeFactor := 1.0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLightSpot/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightSpot.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
+begin
+ TglcLight.Bind(aLightID, fData, aEnableLighting, ltSpot);
+end;
+
+end.
+
--- /dev/null
+unit uglcShader;
+
+{ Package: OpenGLCore
+ Prefix: glc - OpenGL Core
+ Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Shader Objekte }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fgl, dglOpenGL, uglcTypes, ugluMatrix;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EglcShader = class(Exception);
+ TglcShaderProgram = class;
+ TglcShaderLogEvent = procedure(aSender: TObject; const aMsg: String) of Object;
+ TglcShaderObject = class(TObject)
+ private
+ fAtachedTo: TglcShaderProgram;
+ fShaderObj: GLHandle;
+ fShaderType: TglcShaderType;
+ fCode: String;
+ fOnLog: TglcShaderLogEvent;
+ fAttachedTo: TglcShaderProgram;
+
+ function GetInfoLog(aObj: GLHandle): String;
+ function GetCompiled: Boolean;
+ procedure Log(const aMsg: String);
+ procedure CreateShaderObj;
+ procedure AttachTo(const aProgram: TglcShaderProgram);
+ public
+ property ShaderObj : GLHandle read fShaderObj;
+ property ShaderType: TglcShaderType read fShaderType;
+ property Compiled: Boolean read GetCompiled;
+ property AtachedTo: TglcShaderProgram read fAtachedTo;
+ property Code: String read fCode write fCode;
+ property OnLog: TglcShaderLogEvent read fOnLog write fOnLog;
+
+ procedure Compile;
+
+ constructor Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent = nil);
+ destructor Destroy; override;
+ end;
+ TglcShaderObjectList = specialize TFPGObjectList<TglcShaderObject>;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TglcShaderProgram = class(TglcShaderObjectList)
+ private
+ fProgramObj: GLHandle;
+ fOnLog: TglcShaderLogEvent;
+ fFilename: String;
+ fGeometryInputType: GLint;
+ fGeometryOutputType: GLint;
+ fGeometryVerticesOut: GLint;
+
+ 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;
+ property GeometryInputType: GLint read fGeometryInputType write fGeometryInputType;
+ property GeometryOutputType: GLint read fGeometryOutputType write fGeometryOutputType;
+ property GeometryVerticesOut: GLint read fGeometryVerticesOut write fGeometryVerticesOut;
+
+ 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(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, sLen: GLint;
+begin
+ bLen := 0;
+ glGetShaderiv(aObj, GL_INFO_LOG_LENGTH, @bLen);
+ if bLen > 1 then begin
+ GetMem(Msg, bLen * SizeOf(Char));
+ glGetShaderInfoLog(aObj, bLen, sLen{%H-}, 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, sLen: GLint;
+begin
+ bLen := 0;
+ glGetProgramiv(Obj, GL_INFO_LOG_LENGTH, @bLen);
+ if bLen > 1 then begin
+ GetMem(Msg, bLen * SizeOf(Char));
+ glGetProgramInfoLog(Obj, bLen, sLen{%H-}, 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(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.
+
--- /dev/null
+unit uglcTypes;
+
+{ Package: OpenGLCore
+ Prefix: glc - OpenGL Core
+ Beschreibung: diese Unit definiert Enum-Typen die OpenGL Konstanten wrappen und stellt zusätzlich
+ Funktions-Wrapper zur verfügung die diese Enum-Typen als Parameter entgegen nehmen }
+
+{$mode objfpc}{$H+}
+{$MACRO ON}
+{$SCOPEDENUMS ON}
+
+interface
+
+uses
+ dglOpenGL, sysutils;
+
+type
+ TglcFace = (
+ faFront = GL_FRONT,
+ faBack = GL_BACK,
+ faBoth = GL_FRONT_AND_BACK);
+
+ TglcPolygonMode = (
+ pmPoint = GL_POINT,
+ pmLine = GL_LINE,
+ pmFill = GL_FILL);
+
+ TglcDepthFunc = (
+ dfNever = GL_NEVER,
+ dfLess = GL_LESS,
+ dfEqual = GL_EQUAL,
+ dfLessEqual = GL_LEQUAL,
+ dfGreater = GL_GREATER,
+ dfNotEqual = GL_NOTEQUAL,
+ dfGreaterEqual = GL_GEQUAL,
+ dfAlways = GL_ALWAYS);
+
+ TglcClearBuffer = (
+ cbDepthBuffer = GL_DEPTH_BUFFER_BIT,
+ cbAccumBuffer = GL_ACCUM_BUFFER_BIT,
+ cbStencilBuffer = GL_STENCIL_BUFFER_BIT,
+ cbColorBuffer = GL_COLOR_BUFFER_BIT);
+
+ TglcTextureMinFilter = (
+ mfNearest = GL_NEAREST,
+ mfLinear = GL_LINEAR,
+ mfNearestMipmapNearest = GL_NEAREST_MIPMAP_NEAREST,
+ mfLinearMipmapNearest = GL_LINEAR_MIPMAP_NEAREST,
+ mfNearestMipmapLinear = GL_NEAREST_MIPMAP_LINEAR,
+ mfLinearMipmapLinear = GL_LINEAR_MIPMAP_LINEAR);
+
+ TglcTextureMagFilter = (
+ mfNearest = GL_NEAREST,
+ mfLinear = GL_LINEAR);
+
+ TglcTextureWrap = (
+ twClamp = GL_CLAMP,
+ twRepeat = GL_REPEAT,
+ twClampToBorder = GL_CLAMP_TO_BORDER,
+ twClampToEdge = GL_CLAMP_TO_EDGE,
+ twMirroredRepeat = GL_MIRRORED_REPEAT);
+
+ TglcBlendFactor = (
+ bfZero = GL_ZERO,
+ bfOne = GL_ONE,
+ bfSrcColor = GL_SRC_COLOR,
+ bfOneMinusSrcColor = GL_ONE_MINUS_SRC_COLOR,
+ bfSrcAlpha = GL_SRC_ALPHA,
+ bfOneMinusSrcAlpha = GL_ONE_MINUS_SRC_ALPHA,
+ bfDstAlpha = GL_DST_ALPHA,
+ bfOneMinusDstAlpha = GL_ONE_MINUS_DST_ALPHA,
+ bfDstColor = GL_DST_COLOR,
+ bfOneMinusDstColor = GL_ONE_MINUS_DST_COLOR,
+ bfSrcAlphaSaturate = GL_SRC_ALPHA_SATURATE,
+ bgConstColor = GL_CONSTANT_COLOR,
+ bfOneMinusConstColor = GL_ONE_MINUS_CONSTANT_COLOR,
+ bfConstAlpha = GL_CONSTANT_ALPHA,
+ bfOneMinusConstAlpha = GL_ONE_MINUS_CONSTANT_ALPHA);
+
+ TglcBlendMode = (
+ bmNone,
+ bmAlphaBlend,
+ bmAdditiveAlphaBlend,
+ bmAdditiveBlend);
+
+ TglcFormat = (
+ fmUnknown = 0,
+ fmColorIndex = GL_COLOR_INDEX,
+ fmDepthComponent = GL_DEPTH_COMPONENT,
+ fmRed = GL_RED,
+ fmGreen = GL_GREEN,
+ fmBlue = GL_BLUE,
+ fmAlpha = GL_ALPHA,
+ fmRGB = GL_RGB,
+ fmRGBA = GL_RGBA,
+ fmLuminance = GL_LUMINANCE,
+ fmLuminanceAlpha = GL_LUMINANCE_ALPHA,
+ fmBGR = GL_BGR,
+ fmBGRA = GL_BGRA,
+ fmDepthStencil = GL_DEPTH_STENCIL);
+
+ TglcInternalFormat = (
+ ifUnknown = 0,
+ ifDepthComponent = GL_DEPTH_COMPONENT,
+ ifAlpha = GL_ALPHA,
+ ifRGB = GL_RGB,
+ ifRGBA = GL_RGBA,
+ ifLuminance = GL_LUMINANCE,
+ ifLuminanceAlpha = GL_LUMINANCE_ALPHA,
+ ifR3G3B2 = GL_R3_G3_B2,
+ ifAlpha4 = GL_ALPHA4,
+ ifAlpha8 = GL_ALPHA8,
+ ifAlpha12 = GL_ALPHA12,
+ ifAlpha16 = GL_ALPHA16,
+ ifLuminance4 = GL_LUMINANCE4,
+ ifLuminance8 = GL_LUMINANCE8,
+ ifLuminance12 = GL_LUMINANCE12,
+ ifLuminance16 = GL_LUMINANCE16,
+ ifLuminance4Alpha4 = GL_LUMINANCE4_ALPHA4,
+ ifLuminance6Alpha2 = GL_LUMINANCE6_ALPHA2,
+ ifLuminance8Alpha8 = GL_LUMINANCE8_ALPHA8,
+ ifLuminance12Alpha4 = GL_LUMINANCE12_ALPHA4,
+ ifLuminance12Alpha12 = GL_LUMINANCE12_ALPHA12,
+ ifLuminance16Alpha16 = GL_LUMINANCE16_ALPHA16,
+ ifIntensity = GL_INTENSITY,
+ ifIntensity4 = GL_INTENSITY4,
+ ifIntensity8 = GL_INTENSITY8,
+ ifIntensity12 = GL_INTENSITY12,
+ ifIntensity16 = GL_INTENSITY16,
+ ifRGB4 = GL_RGB4,
+ ifRGB5 = GL_RGB5,
+ ifRGB8 = GL_RGB8,
+ ifRGB10 = GL_RGB10,
+ ifRGB12 = GL_RGB12,
+ ifRGB16 = GL_RGB16,
+ ifRGBA2 = GL_RGBA2,
+ ifRGBA4 = GL_RGBA4,
+ ifRGB5A1 = GL_RGB5_A1,
+ ifRGBA8 = GL_RGBA8,
+ ifRGB10A2 = GL_RGB10_A2,
+ ifRGBA12 = GL_RGBA12,
+ ifRGBA16 = GL_RGBA16,
+ ifDepthComponent16 = GL_DEPTH_COMPONENT16,
+ ifDepthComponent24 = GL_DEPTH_COMPONENT24,
+ ifDepthComponent32 = GL_DEPTH_COMPONENT32,
+ ifCompressedAlpha = GL_COMPRESSED_ALPHA,
+ ifCompressedLuminance = GL_COMPRESSED_LUMINANCE,
+ ifCompressedLuminanceAlpha = GL_COMPRESSED_LUMINANCE_ALPHA,
+ ifCompressedIntensity = GL_COMPRESSED_INTENSITY,
+ ifCompressedRGB = GL_COMPRESSED_RGB,
+ ifCompressedRGBA = GL_COMPRESSED_RGBA,
+ ifRGBA32f = GL_RGBA32F,
+ ifRGB32f = GL_RGB32F,
+ ifRGBA16F = GL_RGBA16F,
+ ifRGB16F = GL_RGB16F,
+ ifDepth24Stencil8 = GL_DEPTH24_STENCIL8,
+ ifSRGB = GL_SRGB,
+ ifSRGB8 = GL_SRGB8,
+ ifSRGBA = GL_SRGB_ALPHA,
+ ifSRGBA8 = GL_SRGB8_ALPHA8,
+ ifSLuminanceAlpha = GL_SLUMINANCE_ALPHA,
+ ifSLuminance8Alpha8 = GL_SLUMINANCE8_ALPHA8,
+ ifSLuminance = GL_SLUMINANCE,
+ ifSLuminance8 = GL_SLUMINANCE8,
+ ifDepth32fStencil8 = GL_DEPTH32F_STENCIL8,
+ ifStencil1 = GL_STENCIL_INDEX1,
+ ifStencil4 = GL_STENCIL_INDEX4,
+ ifStencil8 = GL_STENCIL_INDEX8,
+ ifStencil16 = GL_STENCIL_INDEX16);
+
+ TglcAttachment = (
+ atDepthStencil = GL_DEPTH_STENCIL_ATTACHMENT,
+ atColor0 = GL_COLOR_ATTACHMENT0,
+ atColor1 = GL_COLOR_ATTACHMENT1,
+ atColor2 = GL_COLOR_ATTACHMENT2,
+ atColor3 = GL_COLOR_ATTACHMENT3,
+ atColor4 = GL_COLOR_ATTACHMENT4,
+ atColor5 = GL_COLOR_ATTACHMENT5,
+ atColor6 = GL_COLOR_ATTACHMENT6,
+ atColor7 = GL_COLOR_ATTACHMENT7,
+ atColor8 = GL_COLOR_ATTACHMENT8,
+ atColor9 = GL_COLOR_ATTACHMENT9,
+ atColor10 = GL_COLOR_ATTACHMENT10,
+ atColor11 = GL_COLOR_ATTACHMENT11,
+ atColor12 = GL_COLOR_ATTACHMENT12,
+ atColor13 = GL_COLOR_ATTACHMENT13,
+ atColor14 = GL_COLOR_ATTACHMENT14,
+ atColor15 = GL_COLOR_ATTACHMENT15,
+ atDepth = GL_DEPTH_ATTACHMENT,
+ atStencil = GL_STENCIL_ATTACHMENT);
+
+ TglcShaderType = (
+ stFragment = GL_FRAGMENT_SHADER,
+ stVertex = GL_VERTEX_SHADER,
+ stGeometry = GL_GEOMETRY_SHADER,
+ stTessEvaluation = GL_TESS_EVALUATION_SHADER,
+ stTessControl = GL_TESS_CONTROL_SHADER);
+
+ TglcBufferTarget = (
+ btArrayBuffer = GL_ARRAY_BUFFER,
+ btElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER);
+
+ TglcBufferUsage = (
+ buStreamDraw = GL_STREAM_DRAW,
+ buStreamRead = GL_STREAM_READ,
+ buStreamCopy = GL_STREAM_COPY,
+ buStaticDraw = GL_STATIC_DRAW,
+ buStaticRead = GL_STATIC_READ,
+ buStaticCopy = GL_STATIC_COPY,
+ buDynamicDraw = GL_DYNAMIC_DRAW,
+ buDynamicRead = GL_DYNAMIC_READ,
+ buDynamicCopy = GL_DYNAMIC_COPY);
+
+ TglcBufferAccess = (
+ baReadOnly = GL_READ_ONLY,
+ baWriteOnly = GL_WRITE_ONLY,
+ baReadWrite = GL_READ_WRITE);
+
+ EOpenGL = class(Exception)
+ private
+ fErrorCode: GLenum;
+ public
+ property ErrorCode: GLenum read fErrorCode;
+ constructor Create(const aErrorCode: GLenum);
+ constructor Create(const aMsg: String; const aErrorCode: GLenum);
+ end;
+
+procedure glcRenderFace(const aValue: TglcFace); inline;
+procedure glcPolygonMode(const aFace: TglcFace; const aValue: TglcPolygonMode); inline;
+procedure glcDepthFunc(const aValue: TglcDepthFunc); inline;
+procedure glcBlendFunc(const aSource, aDest: TglcBlendFactor); inline; overload;
+procedure glcBlendFunc(const aMode: TglcBlendMode); inline; overload;
+procedure glcCheckAndRaiseError;
+
+implementation
+
+type
+ TglcBlendModeValue = packed record
+ src, dst: TglcBlendFactor;
+ end;
+
+const
+ BLEND_MODE_VALUES: array[TglcBlendMode] of TglcBlendModeValue = (
+ (src: TglcBlendFactor.bfOne; dst: TglcBlendFactor.bfZero), //bmNone
+ (src: TglcBlendFactor.bfSrcAlpha; dst: TglcBlendFactor.bfOneMinusSrcAlpha), //bmAlphaBlend
+ (src: TglcBlendFactor.bfSrcAlpha; dst: TglcBlendFactor.bfOne), //bmAdditiveAlphaBlend
+ (src: TglcBlendFactor.bfOne; dst: TglcBlendFactor.bfOne)); //bmAdditiveBlend
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcRenderFace(const aValue: TglcFace);
+begin
+ case aValue of
+ TglcFace.faBoth: begin
+ glDisable(GL_CULL_FACE);
+ end;
+ TglcFace.faFront: begin
+ glEnable(GL_CULL_FACE);
+ glCullFace(GL_BACK);
+ end;
+ TglcFace.faBack: begin
+ glEnable(GL_CULL_FACE);
+ glCullFace(GL_FRONT);
+ end;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcPolygonMode(const aFace: TglcFace; const aValue: TglcPolygonMode);
+begin
+ glPolygonMode(GLenum(aFace), GLenum(aValue));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcDepthFunc(const aValue: TglcDepthFunc);
+begin
+ glDepthFunc(GLenum(aValue));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcBlendFunc(const aSource, aDest: TglcBlendFactor);
+begin
+ glBlendFunc(GLenum(aSource), GLenum(aDest));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcBlendFunc(const aMode: TglcBlendMode); overload;
+begin
+ glBlendFunc(GLenum(BLEND_MODE_VALUES[aMode].src), GLenum(BLEND_MODE_VALUES[aMode].dst));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcCheckAndRaiseError;
+var
+ e: GLenum;
+begin
+ e := glGetError();
+ if (e <> GL_NO_ERROR) then
+ raise EOpenGL.Create(e);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//EOpenGL///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EOpenGL.Create(const aErrorCode: GLenum);
+begin
+ fErrorCode := aErrorCode;
+ inherited Create(gluErrorString(fErrorCode));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EOpenGL.Create(const aMsg: String; const aErrorCode: GLenum);
+begin
+ fErrorCode := aErrorCode;
+ inherited Create(aMsg + ': ' + gluErrorString(fErrorCode))
+end;
+
+end.
+
--- /dev/null
+unit ugluMatrix;
+
+{ Package: OpenGLCore
+ Prefix: glu - OpenGL Utils
+ Beschreibung: diese Unit enthält Matrix-Typen und Methoden um diese zu erstellen und zu manipulieren }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, ugluVector;
+
+type
+ //Matrixtypen
+ TgluMatrix2ub = array[0..1] of TgluVector2ub;
+ TgluMatrix2i = array[0..1] of TgluVector2i;
+ TgluMatrix2f = array[0..1] of TgluVector2f;
+ TgluMatrix2d = array[0..1] of TgluVector2d;
+
+ TgluMatrix3ub = array[0..2] of TgluVector3ub;
+ TgluMatrix3i = array[0..2] of TgluVector3i;
+ TgluMatrix3f = array[0..2] of TgluVector3f;
+ TgluMatrix3d = array[0..2] of TgluVector3d;
+
+ TgluMatrix4ub = array[0..3] of TgluVector4ub;
+ TgluMatrix4i = array[0..3] of TgluVector4i;
+ TgluMatrix4f = array[0..3] of TgluVector4f;
+ TgluMatrix4d = array[0..3] of TgluVector4d;
+
+ //MatrixPointer
+ PgluMatrix2ub = ^TgluMatrix2ub;
+ PgluMatrix2i = ^TgluMatrix2i;
+ PgluMatrix2f = ^TgluMatrix2f;
+ PgluMatrix2d = ^TgluMatrix2d;
+
+ PgluMatrix3ub = ^TgluMatrix3ub;
+ PgluMatrix3i = ^TgluMatrix3i;
+ PgluMatrix3f = ^TgluMatrix3f;
+ PgluMatrix3d = ^TgluMatrix3d;
+
+ PgluMatrix4ub = ^TgluMatrix4ub;
+ PgluMatrix4i = ^TgluMatrix4i;
+ PgluMatrix4f = ^TgluMatrix4f;
+ PgluMatrix4d = ^TgluMatrix4d;
+
+ //Konstructoren
+ function gluMatrix4d(const m: TgluMatrix4f): TgluMatrix4d;
+
+ //Matrixfunktionen
+ function gluMatrixTranslate(const v: TgluVector3f): TgluMatrix4f;
+ function gluMatrixScale(const v: TgluVector3f): TgluMatrix4f; overload;
+ function gluMatrixScale(const s: Single): TgluMatrix4f; overload;
+ function gluMatrixRotate(axis: TgluVector3f; const angle: Single): TgluMatrix4f;
+ function gluMatrixMult(const m1, m2: TgluMatrix4f): TgluMatrix4f;
+ function gluMatrixMultVec(const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+ function gluMatrixTranspose(const m: TgluMatrix3f): TgluMatrix3f; overload;
+ function gluMatrixTranspose(const m: TgluMatrix4f): TgluMatrix4f; overload;
+ function gluMatrixSubMatrix(const m:TgluMatrix4f; const s, z: Integer): TgluMatrix3f;
+ function gluMatrixDeterminant(const m: TgluMatrix3f): Single; overload;
+ function gluMatrixDeterminant(const m: TgluMatrix4f): Single; overload;
+ function gluMatrixAdjoint(const m: TgluMatrix4f): TgluMatrix4f;
+ function gluMatrixInvert(const m: TgluMatrix4f): TgluMatrix4f;
+
+ operator * (const m1, m2: TgluMatrix4f): TgluMatrix4f;
+ operator * (const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+ operator * (const m: TgluMatrix4f; const v: TgluVector3f): TgluVector3f;
+
+const
+ maAxisX = 0;
+ maAxisY = 1;
+ maAxisZ = 2;
+ maPos = 3;
+ gluMatrixIdentity: TgluMatrix4f = ((1,0,0,0),(0,1,0,0),(0,0,1,0),(0,0,0,1));
+
+implementation
+
+uses
+ Math;
+
+operator * (const m1, m2: TgluMatrix4f): TgluMatrix4f;
+begin
+ result := gluMatrixMult(m1, m2);
+end;
+
+operator * (const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+begin
+ result := gluMatrixMultVec(m, v);
+end;
+
+operator * (const m: TgluMatrix4f; const v: TgluVector3f): TgluVector3f;
+begin
+ result := gluVector3f(gluMatrixMultVec(m, gluVEctor4f(v, 1.0)));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluMatrix4d(const m: TgluMatrix4f): TgluMatrix4d;
+var
+ i, j: Integer;
+begin
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ result[i, j] := m[i, j];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt eine Translationsmatrix
+//@v: Vektor der Translationsmatrix;
+function gluMatrixTranslate(const v: TgluVector3f): TgluMatrix4f;
+var
+ i: Integer;
+begin
+ result := gluMatrixIdentity;
+ for i := 0 to 2 do
+ result[3, i] := v[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt eine Skalierungsmatrix
+//@v: Vektor der Skalierungsmatrix;
+function gluMatrixScale(const v: TgluVector3f): TgluMatrix4f;
+var
+ i: Integer;
+begin
+ result := gluMatrixIdentity;
+ for i := 0 to 2 do
+ result[i, i] := v[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluMatrixScale(const s: Single): TgluMatrix4f;
+var
+ i: Integer;
+begin
+ result := gluMatrixIdentity;
+ for i := 0 to 2 do
+ result[i, i] := s;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt eine Rotationsmatrix;
+//@axis: Achse um die gedreht werden soll;
+//@angle: Winkel mit dem gedreht werden soll;
+function gluMatrixRotate(axis: TgluVector3f; const angle: Single): TgluMatrix4f;
+var
+ X, Y, Z, a, s, c: Single;
+begin
+ axis := gluVectorNormalize(axis);
+ X := axis[0];
+ Y := axis[1];
+ Z := axis[2];
+ a := angle/180*Pi;
+ s := sin(a);
+ c := cos(a);
+ result := gluMatrixIdentity;
+ result[maAxisX] := gluVector4f(
+ SQR(X) + (1-SQR(X))*c,
+ X*Y*(1-c) + Z*s,
+ X*Z*(1-c) - Y*s,
+ 0);
+ result[maAxisY] := gluVector4f(
+ X*Y*(1-c) - Z*s,
+ SQR(Y) + (1-SQR(Y))*c,
+ Y*Z*(1-c) + X*s,
+ 0);
+ result[maAxisZ] := gluVector4f(
+ X*Z*(1-c) + Y*s,
+ Y*Z*(1-c) - X*s,
+ SQR(Z) + (1-SQR(Z))*c,
+ 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Mutlipliziert Matrix1 mit Matrix2
+//@Matrix1: 1. Multiplikator;
+//@Matrix2: 2. Multiplikator;
+//@result: Matrix1 * Matrix2
+function gluMatrixMult(const m1, m2: TgluMatrix4f): TgluMatrix4f;
+var
+ x, y, i: Integer;
+ sum: Single;
+begin
+ for x := 0 to 3 do begin
+ for y := 0 to 3 do begin
+ sum := 0;
+ for i := 0 to 3 do
+ sum := sum + m1[i, y] * m2[x, i];
+ result[x, y] := sum;
+ end;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Multiplizerit eine Matrix mit einem Vektor
+//@m: Matrix mit der multipliziert werden soll;
+//@v: Vektor mit dem multipliziert werden soll;
+//@result: Ergebnis der Multiplikation
+function gluMatrixMultVec(const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+var
+ i, j: Integer;
+ sum: Single;
+begin
+ for i := 0 to 3 do begin
+ sum := 0;
+ for j := 0 to 3 do
+ sum := sum + m[j,i] * v[j];
+ result[i] := sum;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Transponierte Matrix
+//@m: Matrix die Transponiert werden soll;
+//@result: Transponierte Matrix;
+function gluMatrixTranspose(const m: TgluMatrix3f): TgluMatrix3f;
+var
+ i, j: Integer;
+begin
+ for i := 0 to 2 do
+ for j := 0 to 2 do
+ result[i, j] := m[j, i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Transponierte Matrix
+//@m: Matrix die Transponiert werden soll;
+//@result: Transponierte Matrix;
+function gluMatrixTranspose(const m: TgluMatrix4f): TgluMatrix4f;
+var
+ i, j: Integer;
+begin
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ result[i, j] := m[j, i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//ermittelt die Untermatrix einer Matrix
+//@m: Matrix derren Untermatrix berechnet werden soll;
+//@s: Spalte die gelöscht werden soll;
+//@z: Zeile die gelöscht werden soll;
+//@result: Untermatrix von m
+function gluMatrixSubMatrix(const m: TgluMatrix4f; const s, z: Integer): TgluMatrix3f;
+var
+ x, y, i, j: Integer;
+begin
+ for i := 0 to 2 do
+ for j := 0 to 2 do begin
+ x := i;
+ y := j;
+ if (i >= s) then
+ inc(x);
+ if (j >= z) then
+ inc(y);
+ result[i, j] := m[x, y];
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Determinante einer Matrix
+//@m: Matrix derren Determinaten berechnet werden soll;
+//@result: Determinante von m
+function gluMatrixDeterminant(const m: TgluMatrix3f): Single;
+begin
+ result :=
+ m[0,0] * m[1,1] * m[2,2] +
+ m[1,0] * m[2,1] * m[0,2] +
+ m[2,0] * m[0,1] * m[1,2] -
+ m[2,0] * m[1,1] * m[0,2] -
+ m[1,0] * m[0,1] * m[2,2] -
+ m[0,0] * m[2,1] * m[1,2];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Determinante einer Matrix
+//@m: Matrix derren Determinaten berechnet werden soll;
+//@result: Determinante von m
+function gluMatrixDeterminant(const m: TgluMatrix4f): Single;
+var
+ i: Integer;
+begin
+ result := 0;
+ for i := 0 to 3 do
+ result := result + power(-1, i) * m[i, 0] * gluMatrixDeterminant(gluMatrixSubMatrix(m, i, 0));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Adjunkte einer Matrix
+//@m: Matrix derren Adjunkte berechnet werden soll;
+//@result: Adjunkte von m
+function gluMatrixAdjoint(const m: TgluMatrix4f): TgluMatrix4f;
+var
+ i, j: Integer;
+begin
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ result[i, j] := power(-1, i+j) * gluMatrixDeterminant(gluMatrixSubMatrix(m, i, j));
+ result := gluMatrixTranspose(result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die inverse Matrix einer Matrix
+//@m: Matrix derren Inverse berechnet werden soll;
+//@result: Inverse Matrix von m;
+function gluMatrixInvert(const m: TgluMatrix4f): TgluMatrix4f;
+var
+ d: Single;
+ i, j: Integer;
+begin
+ d := gluMatrixDeterminant(m);
+ result := gluMatrixAdjoint(m);
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ result[i,j] := result[i,j] / d;
+end;
+
+end.
+
--- /dev/null
+unit ugluQuaternion;
+
+{ Package: OpenGLCore
+ Prefix: glu - OpenGL Utils
+ Beschreibung: diese Unit enthält Quaternion-Typen und Methoden um diese zu erstellen und zu manipulieren }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, ugluVector, ugluMatrix;
+
+type
+ TgluQuaternion = type TgluVector4f; // w,x,y,z
+
+{
+ Winkel : rad, außer glRotate-Komponenten
+ Absolute Werte : Orientation
+ Relative Werte/"Drehanweisungen" : Rotation
+ To/FromVector : Position im R^4
+
+ Alle Funktionen nehmen an, dass die Quaternion nur zur Rotation verwendet wird (kein Scale),
+ mathematisch also normalisiert ist. Es findet keine Überprüfung statt.
+}
+
+ //Quaternion Konstruktoren
+ function gluQuaternion(const W, X, Y, Z: Single): TgluQuaternion;
+ function gluQuaternionNormalize(const q: TgluQuaternion): TgluQuaternion;
+ procedure gluQuaternionNormalizeInplace(var q: TgluQuaternion);
+ function gluQuaternionToVector(const q: TgluQuaternion): TgluVector3f;
+ function gluVectorToQuaternion(const v: TgluVector3f): TgluQuaternion;
+
+ //Arithmetic
+ function gluQuaternionConjugate(const q: TgluQuaternion): TgluQuaternion;
+ function gluQuaternionMultiply(const l,r: TgluQuaternion): TgluQuaternion;
+ function gluQuaternionAdd(const a,b: TgluQuaternion): TgluQuaternion;
+ function gluQuaternionSubtract(const l,r: TgluQuaternion): TgluQuaternion;
+ function gluQuaternionScale(const q: TgluQuaternion; const f: Single): TgluQuaternion;
+
+
+ //To/From RotationMatrix
+ function gluQuaternionToMatrix(const q: TgluQuaternion): TgluMatrix4f;
+ function gluMatrixToQuaternion(const m: TgluMatrix4f): TgluQuaternion;
+
+ //To/From Axis/Angle {WINKEL IN °DEG}
+ function gluQuaternionToRotation(const q: TgluQuaternion; out angle: Single): TgluVector3f;
+ function gluRotationToQuaternion(const angle: Single; const axis: TgluVector3f): TgluQuaternion;
+
+ //Transforms
+ function gluQuaternionTransformVec(const q: TgluQuaternion; const v: TgluVector3f): TgluVector3f;
+
+ function gluQuaternionLookAt(const Location, Target, UpVector: TgluVector3f): TgluQuaternion;
+ //Rotation zw. Richtungen: Wie muss a modifiziert werden um b zu bekommen?
+ function gluVectorRotationTo(const a, b: TgluVector3f): TgluQuaternion;
+
+ //Modifying Quaternions
+ function gluQuaternionHalfAngle(const q: TgluQuaternion): TgluQuaternion;
+ function gluQuaternionAngleBetween(const a, b: TgluQuaternion): double;
+ function gluQuaternionSlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+ function gluQuaternionNlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+
+ operator +(const a, b: TgluQuaternion): TgluQuaternion;
+ operator -(const l, r: TgluQuaternion): TgluQuaternion;
+ operator *(const l, r: TgluQuaternion): TgluQuaternion;
+ operator *(const q: TgluQuaternion; const s: Sigle): TgluQuaternion;
+
+const
+ quW = 0;
+ quX = 1;
+ quY = 2;
+ quZ = 3;
+ gluQuaternionIdentity: TgluQuaternion = (1,0,0,0);
+
+implementation
+
+uses
+ Math;
+
+operator +(const a, b: TgluQuaternion): TgluQuaternion;
+begin
+ result := gluQuaternionAdd(a, b);
+end;
+
+operator -(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+ result := gluQuaternionSubtract(l, r);
+end;
+
+operator *(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+ result := gluQuaternionMultiply(l, r);
+end;
+
+operator *(const q: TgluQuaternion; const s: Sigle): TgluQuaternion;
+begin
+ result := gluQuaternionScale(q, s);
+end;
+
+function gluQuaternion(const W, X, Y, Z: Single): TgluQuaternion;
+begin
+ Result:= gluVector4f(W,X,Y,Z);
+end;
+
+function gluQuaternionNormalize(const q: TgluQuaternion): TgluQuaternion;
+begin
+ Result:= q;
+ gluQuaternionNormalizeInplace(Result);
+end;
+
+procedure gluQuaternionNormalizeInplace(var q: TgluQuaternion);
+var
+ s: Double;
+begin
+ s:= sqr(q[quX])+sqr(q[quY])+sqr(q[quZ])+sqr(q[quW]);
+ // already normalized?
+ if IsZero(s - 1) then
+ exit;
+ s:= 1/sqrt(s);
+ q[quX]:= q[quX] * s;
+ q[quY]:= q[quY] * s;
+ q[quZ]:= q[quZ] * s;
+ q[quW]:= q[quW] * s;
+end;
+
+function gluQuaternionToVector(const q: TgluQuaternion): TgluVector3f;
+begin
+ Result:= gluVector3f(q[quX], q[quY], q[quZ]);
+end;
+
+function gluVectorToQuaternion(const v: TgluVector3f): TgluQuaternion;
+begin
+ Result:= gluQuaternion(0, v[0], v[1], v[2]);
+end;
+
+
+function gluQuaternionConjugate(const q: TgluQuaternion): TgluQuaternion;
+begin
+ Result[quW] := q[quW];
+ Result[quX] := -q[quX];
+ Result[quY] := -q[quY];
+ Result[quZ] := -q[quZ];
+end;
+
+function gluQuaternionMultiply(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+ Result[quW] := -l[qux] * r[qux] - l[quy] * r[quy] - l[quz] * r[quz] + l[quw] * r[quw];
+ Result[quX] := l[qux] * r[quw] + l[quy] * r[quz] - l[quz] * r[quy] + l[quw] * r[qux];
+ Result[quY] := -l[qux] * r[quz] + l[quy] * r[quw] + l[quz] * r[qux] + l[quw] * r[quy];
+ Result[quZ] := l[qux] * r[quy] - l[quy] * r[qux] + l[quz] * r[quw] + l[quw] * r[quz];
+end;
+
+function gluQuaternionAdd(const a, b: TgluQuaternion): TgluQuaternion;
+begin
+ Result[quW] := a[quW] + b[quW];
+ Result[quX] := a[quX] + b[quX];
+ Result[quY] := a[quY] + b[quY];
+ Result[quZ] := a[quZ] + b[quZ];
+end;
+
+function gluQuaternionSubtract(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+ Result[quW] := l[quW] - r[quW];
+ Result[quX] := l[quX] - r[quX];
+ Result[quY] := l[quY] - r[quY];
+ Result[quZ] := l[quZ] - r[quZ];
+end;
+
+function gluQuaternionScale(const q: TgluQuaternion; const f: Single): TgluQuaternion;
+begin
+ Result[quW] := q[quW] * f;
+ Result[quX] := q[quX] * f;
+ Result[quY] := q[quY] * f;
+ Result[quZ] := q[quZ] * f;
+end;
+
+// http://www.euclideanspace.com/maths/geometry/rotations/conversions/quaternionToMatrix/index.htm
+function gluQuaternionToMatrix(const q: TgluQuaternion): TgluMatrix4f;
+var
+ qx,qy,qz,qw: Single;
+begin
+ qw:= q[quW];
+ qx:= q[quX];
+ qy:= q[quY];
+ qz:= q[quZ];
+ Result:= gluMatrixIdentity;
+ Result[maAxisX] := gluVector4f(
+ 1 - 2*SQR(qy) - 2*SQR(qz),
+ 2*qx*qy + 2*qz*qw,
+ 2*qx*qz - 2*qy*qw,
+ 0);
+ Result[maAxisY] := gluVector4f(
+ 2*qx*qy - 2*qz*qw,
+ 1 - 2*SQR(qx) - 2*SQR(qz),
+ 2*qy*qz + 2*qx*qw,
+ 0);
+ Result[maAxisZ] := gluVector4f(
+ 2*qx*qz + 2*qy*qw,
+ 2*qy*qz - 2*qx*qw,
+ 1 - 2*SQR(qx) - 2*SQR(qy),
+ 0);
+end;
+
+// http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToQuaternion/index.htm
+function gluMatrixToQuaternion(const m: TgluMatrix4f): TgluQuaternion;
+var
+ trace, s: double;
+ q: TgluQuaternion;
+
+begin
+ trace := m[0][0] + m[1][1] + m[2][2]; // I removed + 1.0f; see discussion with Ethan
+ if( trace > 0 ) then begin// I changed M_EPSILON to 0
+ s := 0.5 / SQRT(trace+ 1.0);
+ q[quW] := 0.25 / s;
+ q[quX] := ( m[2][1] - m[1][2] ) * s;
+ q[quY] := ( m[0][2] - m[2][0] ) * s;
+ q[quZ] := ( m[1][0] - m[0][1] ) * s;
+ end else begin
+ if ( m[0][0] > m[1][1]) and (m[0][0] > m[2][2] ) then begin
+ s := 2.0 * SQRT( 1.0 + m[0][0] - m[1][1] - m[2][2]);
+ q[quW] := (m[2][1] - m[1][2] ) / s;
+ q[quX] := 0.25 * s;
+ q[quY] := (m[0][1] + m[1][0] ) / s;
+ q[quZ] := (m[0][2] + m[2][0] ) / s;
+ end else if (m[1][1] > m[2][2]) then begin
+ s := 2.0 * SQRT( 1.0 + m[1][1] - m[0][0] - m[2][2]);
+ q[quW] := (m[0][2] - m[2][0] ) / s;
+ q[quX] := (m[0][1] + m[1][0] ) / s;
+ q[quY] := 0.25 * s;
+ q[quZ] := (m[1][2] + m[2][1] ) / s;
+ end else begin
+ s := 2.0 * SQRT( 1.0 + m[2][2] - m[0][0] - m[1][1] );
+ q[quW] := (m[1][0] - m[0][1] ) / s;
+ q[quX] := (m[0][2] + m[2][0] ) / s;
+ q[quY] := (m[1][2] + m[2][1] ) / s;
+ q[quZ] := 0.25 * s;
+ end;
+ end;
+ Result:= q;
+end;
+
+// http://www.euclideanspace.com/maths/geometry/rotations/conversions/quaternionToAngle/index.htm
+function gluQuaternionToRotation(const q: TgluQuaternion; out angle: Single): TgluVector3f;
+var
+ s: double;
+begin
+ angle := radtodeg(2 * arccos(q[quW]));
+ s := sqrt(1-q[quW]*q[quW]); // assuming quaternion normalised then w is less than 1, so term always positive.
+ if (s < 0.001) then begin // test to avoid divide by zero, s is always positive due to sqrt
+ // if s close to zero then direction of axis not important
+ Result[0] := q[quX]; // if it is important that axis is normalised then replace with x=1; y=z=0;
+ Result[1] := q[quY];
+ Result[2] := q[quZ];
+ end else begin
+ Result[0] := q[quX] / s; // normalise axis
+ Result[1] := q[quY] / s;
+ Result[2] := q[quZ] / s;
+ end;
+end;
+
+function gluRotationToQuaternion(const angle: Single; const axis: TgluVector3f): TgluQuaternion;
+var
+ a: single;
+begin
+ a:= degtorad(angle) / 2;
+ Result:= gluQuaternion(
+ cos(a),
+ sin(a) * axis[0],
+ sin(a) * axis[1],
+ sin(a) * axis[2]);
+end;
+
+// http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions/transforms/index.htm
+function gluQuaternionTransformVec(const q: TgluQuaternion; const v: TgluVector3f): TgluVector3f;
+var
+ p: TgluQuaternion;
+begin
+ //Pout = q * Pin * q'
+ p:= gluQuaternionMultiply(q, gluVectorToQuaternion(v));
+ p:= gluQuaternionMultiply(p, gluQuaternionConjugate(q));
+ Result:= gluQuaternionToVector(p);
+end;
+
+// http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions/transforms/halfAngle.htm
+function gluQuaternionHalfAngle(const q: TgluQuaternion): TgluQuaternion;
+begin
+ Result:= q;
+ Result[quW]:= Result[quW] + 1;
+ gluQuaternionNormalizeInplace(Result);
+end;
+
+function gluQuaternionAngleBetween(const a, b: TgluQuaternion): double;
+var
+ cosHalfTheta: double;
+begin
+ cosHalfTheta:= a[quW] * b[quW] + a[quX] * b[quX] + a[quY] * b[quY] + a[quZ] * b[quZ];
+ Result:= arccos(cosHalfTheta) * 2;
+end;
+
+// http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions/slerp/index.htm
+function gluQuaternionSlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+var
+ qa,qb: TgluQuaternion;
+ cosHalfTheta, sinHalfTheta,
+ halfTheta,
+ ratioA, ratioB: double;
+begin
+ qa:= a;
+ qb:= b;
+ // Calculate angle between them.
+ cosHalfTheta:= a[quW] * b[quW] + a[quX] * b[quX] + a[quY] * b[quY] + a[quZ] * b[quZ];
+ if (cosHalfTheta < 0) then begin
+ qb:= gluQuaternion(
+ -b[quW],
+ -b[quX],
+ -b[quY],
+ b[quZ]
+ );
+ cosHalfTheta:= -cosHalfTheta;
+ end;
+
+ // if qa=qb or qa=-qb then theta = 0 and we can return qa
+ if abs(cosHalfTheta) >= 1.0 then begin
+ Result:= qa;
+ Exit;
+ end;
+
+ // Calculate temporary values.
+ halfTheta := arccos(cosHalfTheta);
+ sinHalfTheta := sqrt(1.0 - sqr(cosHalfTheta));
+ // if theta = 180 degrees then result is not fully defined
+ // we could rotate around any axis normal to qa or qb
+ if (abs(sinHalfTheta) < 0.001) then begin
+ Result:= gluQuaternionAdd(gluQuaternionScale(qa, 0.5), gluQuaternionScale(qb, 0.5));
+ exit
+ end;
+ ratioA := sin((1 - t) * halfTheta) / sinHalfTheta;
+ ratioB := sin(t * halfTheta) / sinHalfTheta;
+ //calculate Quaternion.
+ Result:= gluQuaternionAdd(gluQuaternionScale(qa, ratioA), gluQuaternionScale(qb, ratioB));
+end;
+
+function gluQuaternionNlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+begin
+ Result:= gluQuaternionAdd(a, gluQuaternionScale(gluQuaternionSubtract(b,a), t));
+ gluQuaternionNormalizeInplace(Result);
+end;
+
+function gluQuaternionLookAt(const Location, Target, UpVector: TgluVector3f): TgluQuaternion;
+var
+ front, up, right: TgluVector3f;
+ w4_recip: Single;
+begin
+ front:= gluVectorSubtract(Location, Target); // eigentlich falschrum. don't ask.
+ up:= UpVector;
+ gluVectorOrthoNormalize(front, up);
+ right:= gluVectorProduct(up, front);
+
+ Result[quW]:= SQRT(1 + right[0] + up[1] + front[2]) * 0.5;
+ w4_recip:= 1 / (4 * Result[quW]);
+
+ Result[quX]:= (front[1] - up[2]) * w4_recip;
+ Result[quY]:= (right[2] - front[0]) * w4_recip;
+ Result[quZ]:= (up[0] - right[1]) * w4_recip;
+end;
+
+function gluVectorRotationTo(const a, b: TgluVector3f): TgluQuaternion;
+var
+ d, qw: single;
+ ax: TgluVector3f;
+begin
+ d:=gluVectorScalar(a, b);
+ ax:= gluVectorProduct(a, b);
+ qw:= gluVectorLength(a) * gluVectorLength(b) + d;
+ if (qw < 0.0001) then begin // vectors are 180 degrees apart
+ Result:= gluQuaternion(0, -a[2],a[1],a[0]);
+ end else begin
+ Result:= gluQuaternion(qw, ax[0],ax[1],ax[2]);
+ end;
+ gluQuaternionNormalizeInplace(Result);
+end;
+
+end.
+
--- /dev/null
+unit ugluVector;
+
+{ Package: OpenGLCore
+ Prefix: glu - OpenGL Utils
+ Beschreibung: diese Unit enthält Vektor-Typen und Methoden um diese zu erstellen und zu manipulieren }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, dglOpenGL;
+
+type
+ //Vektortypen
+ TgluVector2ub = TGLVectorub2;
+ TgluVector3ub = TGLVectorub3;
+ TgluVector4ub = TGLVectorub4;
+
+ TgluVector2i = TGLVectori2;
+ TgluVector3i = TGLVectori3;
+ TgluVector4i = TGLVectori4;
+
+ TgluVector2e = array[0..1] of GLenum;
+ TgluVector3e = array[0..2] of GLenum;
+ TgluVector4e = array[0..3] of GLenum;
+
+ TgluVector2f = TGLVectorf2;
+ TgluVector3f = TGLVectorf3;
+ TgluVector4f = TGLVectorf4;
+
+ TgluVector2d = TGLVectord2;
+ TgluVector3d = TGLVectord3;
+ TgluVector4d = TGLVectord4;
+
+ TgluVector2p = TGLVectorp2;
+ TgluVector3p = TGLVectorp3;
+ TgluVector4p = TGLVectorp4;
+
+ TgluPlanef = TgluVector4f;
+
+ TgluVector3fArr8 = array[0..7] of TgluVector4f;
+ TgluRayf = packed record
+ p, v: TgluVector3f;
+ end;
+
+ TgluRecord2ub = packed record
+ case Integer of
+ 0: (x, y: gluByte);
+ 1: (s, t: gluByte);
+ 2: (u, v: gluByte);
+ 3: (vec: TgluVector2ub);
+ end;
+ TgluRecord3ub = packed record
+ case Integer of
+ 0: (x, y, z: gluByte);
+ 1: (r, g, b: gluByte);
+ 2: (u, v, w: gluByte);
+ 3: (vec: TgluVector3ub);
+ end;
+ TgluRecord4ub = packed record
+ case Integer of
+ 0: (x, y, z, w: gluByte);
+ 1: (r, g, b, a: gluByte);
+ 2: (vec: TgluVector4ub);
+ end;
+
+ TgluRecord2i = packed record
+ case Integer of
+ 0: (x, y: glInt);
+ 1: (s, t: glInt);
+ 2: (u, v: glInt);
+ 3: (vec: TgluVector2i);
+ end;
+ TgluRecord3i = packed record
+ case Integer of
+ 0: (x, y, z: glInt);
+ 1: (r, g, b: glInt);
+ 2: (u, v, w: glInt);
+ 3: (vec: TgluVector3i);
+ end;
+ TgluRecord4i = packed record
+ case Integer of
+ 0: (x, y, z, w: glInt);
+ 1: (r, g, b, a: glInt);
+ 2: (vec: TgluVector4i);
+ end;
+
+ TgluRecord2f = packed record
+ case Integer of
+ 0: (x, y: glFloat);
+ 1: (s, t: glFloat);
+ 2: (u, v: glFloat);
+ 3: (vec: TgluVector2f);
+ end;
+ TgluRecord3f = packed record
+ case Integer of
+ 0: (x, y, z: glFloat);
+ 1: (r, g, b: glFloat);
+ 2: (u, v, w: glFloat);
+ 3: (vec: TgluVector3f);
+ end;
+ TgluRecord4f = packed record
+ case Integer of
+ 0: (x, y, z, w: glFloat);
+ 1: (r, g, b, a: glFloat);
+ 2: (vec4: TgluVector4f);
+ 3: (vec3: TgluVector3f);
+ end;
+
+ TgluRecord2d = packed record
+ case Integer of
+ 0: (x, y: glDouble);
+ 1: (s, t: glDouble);
+ 2: (u, v: glDouble);
+ 3: (vec: TgluVector2d);
+ end;
+ TgluRecord3d = packed record
+ case Integer of
+ 0: (x, y, z: glDouble);
+ 1: (r, g, b: glDouble);
+ 2: (u, v, w: glDouble);
+ 3: (vec: TgluVector3d);
+ end;
+ TgluRecord4d = packed record
+ case Integer of
+ 0: (x, y, z, w: glDouble);
+ 1: (r, g, b, a: glDouble);
+ 2: (vec: TgluVector4d);
+ end;
+
+ //VectorPointer
+ PgluVector2i = ^TgluVector2i;
+ PgluVector3i = ^TgluVector3i;
+ PgluVector4i = ^TgluVector4i;
+
+ PgluVector2e = ^TgluVector2e;
+ PgluVector3e = ^TgluVector3e;
+ PgluVector4e = ^TgluVector4e;
+
+ PgluVector2ub = ^TgluVector2ub;
+ PgluVector3ub = ^TgluVector3ub;
+ PgluVector4ub = ^TgluVector4ub;
+
+ PgluVector2f = ^TgluVector2f;
+ PgluVector3f = ^TgluVector3f;
+ PgluVector4f = ^TgluVector4f;
+
+ PgluVector2d = ^TgluVector2d;
+ PgluVector3d = ^TgluVector3d;
+ PgluVector4d = ^TgluVector4d;
+
+ PgluVector2p = ^TgluVector2p;
+ PgluVector3p = ^TgluVector3p;
+ PgluVector4p = ^TgluVector4p;
+
+ TVectorColor = -$7FFFFFFF-1..$7FFFFFFF;
+
+ //Stream: Lese- und Schreibfunktionen
+ procedure gluVector2fWrite(const vec: TgluVector2f; const aStream: TStream);
+ procedure gluVector3fWrite(const vec: TgluVector3f; const aStream: TStream);
+ procedure gluVector4fWrite(const vec: TgluVector4f; const aStream: TStream);
+ function gluVector2fRead(const aStream: TStream): TgluVector2f;
+ function gluVector3fRead(const aStream: TStream): TgluVector3f;
+ function gluVector4fRead(const aStream: TStream): TgluVector4f;
+
+ //Vektor Konstruktoren
+ function gluVector4f(const X, Y, Z, W: Single): TgluVector4f;
+ function gluVector4f(const aVec: TgluVector3f; const W: Single): TgluVector4f;
+ function gluVector4d(const X, Y, Z, W: Single): TgluVector4d;
+ function gluVector3f(const X, Y, Z: Single): TgluVector3f; overload;
+ function gluVector3f(const v: TgluVector4f): TgluVector3f; overload;
+ function gluVector3f(const v: TgluVector2f; const z: Single): TgluVector3f; overload;
+ function gluVector3f(const p1, p2: TgluVector3f): TgluVector3f; overload;
+ function gluVector2f(const X, Y: Single): TgluVector2f;
+ function gluVector2f(const v3: TgluVector3f): TgluVector2f;
+ function gluVector2f(const v4: TgluVector4f): TgluVector2f;
+ function gluVector4i(const W, X, Y, Z: Integer): TgluVector4i;
+ function gluVector2i(const X, Y: Integer): TgluVector2i;
+ function gluVector2e(const X, Y: GLenum): TgluVector2e;
+ function gluVector3e(const X, Y, Z: GLenum): TgluVector3e;
+ function gluVector4e(const X, Y, Z, W: GLenum): TgluVector4e;
+
+ //Vektorfunktionen
+ function gluVectorNormalize(const v: TgluVector4f): TgluVector4f; overload;
+ function gluVectorNormalize(const v: TgluVector3f): TgluVector3f; overload;
+ function gluVectorNormalize(const v: TgluVector2f): TgluVector2f; overload;
+ function gluVectorLength(const v: TgluVector3f): Single; overload;
+ function gluVectorLength(const v: TgluVector2f): Single; overload;
+ function gluVectorProduct(const v1, v2: TgluVector3f): TgluVector3f;
+ function gluVectorScalar(const v1, v2: TgluVector4f): Single; overload;
+ function gluVectorScalar(const v1, v2: TgluVector3f): Single; overload;
+ function gluVectorScalar(const v1, v2: TgluVector2f): Single; overload;
+ function gluVectorAngle(const v1, v2: TgluVector3f): Single; overload;
+ function gluVectorAngle(const v1, v2: TgluVector2f): Single; overload;
+ function gluVectorEquals(const v1, v2: TgluVector2f): Boolean; overload;
+ function gluVectorEquals(const v1, v2: TgluVector3f): Boolean; overload;
+ function gluVectorEquals(const v1, v2: TgluVector4f): Boolean; overload;
+ function gluVectorMult(const v: TgluVector2f; const s: Single): TgluVector2f;
+ function gluVectorMult(const v: TgluVector3f; const s: Single): TgluVector3f;
+ function gluVectorMult(const v: TgluVector4f; const s: Single): TgluVector4f;
+ function gluVectorDivide(const v: TgluVector3f; const s: Single): TgluVector3f;
+ function gluVectorClamp(const v: TgluVector3f; const aMin, aMax: Single): TgluVector3f; overload;
+ function gluVectorClamp(const v: TgluVector4f; const aMin, aMax: Single): TgluVector4f; overload;
+ function gluVectorAdd(const v1, v2: TgluVector3f): TgluVector3f;
+ function gluVectorSubtract(const v1, v2: TgluVector3f): TgluVector3f;
+ procedure gluVectorOrthoNormalize(var reference, tangent: TgluVector3f);
+ function gluGetAbsCoord(const v: TgluVector3f): TgluVector3f;
+
+ //Ebnenfunktionen
+ function gluPlanef(const p1, p2, p3: TgluVector3f): TgluPlanef;
+ function gluPlanef(const n, p: TgluVector3f): TgluPlanef;
+ function gluPlaneNormalize(const p: TgluPlanef): TgluPlanef;
+ function gluPlaneCrossRay(const aPlane: TgluPlanef; const aRay: TgluRayf; out aPoint: TgluVector3f): Boolean;
+
+ //Rayfunktionen
+ function gluRayf(const p, v: TgluVector3f): TgluRayf;
+ function gluRayNormalize(const r: TgluRayf): TgluRayf;
+ function gluRayPoint(const r: TgluRayf; const lambda: Single): TgluVector3f;
+
+ //Vektor Aus- und Eingaben
+ function gluVector4fToStr(const v: TgluVector4f; const round: Integer = 3): String;
+ function gluVector3fToStr(const v: TgluVector3f; const round: Integer = 3): String;
+ function gluVector2fToStr(const v: TgluVector2f; const round: Integer = 3): String;
+ function gluTryStrToVector4f(str: String; out aVec: TgluVector4f): Boolean;
+ function gluTryStrToVector3f(str: String; out aVec: TgluVector3f): Boolean;
+ function gluTryStrToVector2f(str: String; out aVec: TgluVector2f): Boolean;
+ function gluStrToVector4f(str: String): TgluVector4f;
+ function gluStrToVector3f(str: String): TgluVector3f;
+ function gluStrToVector2f(str: String): TgluVector2f;
+ function gluVector4iToStr(const v: TgluVector4i): String;
+ function gluVector3iToStr(const v: TgluVector3i): String;
+ function gluVector2iToStr(const v: TgluVector2i): String;
+ function gluStrToVector4i(const str: String): TgluVector4i;
+ function gluStrToVector3i(const str: String): TgluVector3i;
+ function gluStrToVector2i(const str: String): TgluVector2i;
+ function gluVectorToColor(const v: TgluVector4f): TVectorColor; overload;
+ function gluVectorToColor(const v: TgluVector3f): TVectorColor; overload;
+ function gluColorToVector3f(const c: TVectorColor): TgluVector3f;
+ function gluColorToVector4f(const c: TVectorColor; const a: Single): TgluVector4f;
+ function gluVectorHSVColor(v: TgluVector3f): TgluVector3f; overload;
+ function gluVectorHSVColor(v: TgluVector4f): TgluVector4f; overload;
+
+ operator >< (const v1, v2: TgluVector3f): TgluVector3f; inline;
+
+ operator * (const v1, v2: TgluVector4f): Single; inline; overload;
+ operator * (const v1, v2: TgluVector3f): Single; inline; overload;
+ operator * (const v1, v2: TgluVector2f): Single; inline; overload;
+
+ operator * (const v: TgluVector2f; const s: Single): TgluVector2f; inline; overload;
+ operator * (const v: TgluVector3f; const s: Single): TgluVector3f; inline; overload;
+ operator * (const v: TgluVector4f; const s: Single): TgluVector4f; inline; overload;
+
+ operator * (const s: Single; const v: TgluVector2f): TgluVector2f; inline; overload;
+ operator * (const s: Single; const v: TgluVector3f): TgluVector3f; inline; overload;
+ operator * (const s: Single; const v: TgluVector4f): TgluVector4f; inline; overload;
+
+ operator / (const v: TgluVector3f; const s: Single): TgluVector3f; inline; overload;
+
+ operator = (const v1, v2: TgluVector2f): Boolean; inline; overload;
+ operator = (const v1, v2: TgluVector3f): Boolean; inline; overload;
+ operator = (const v1, v2: TgluVector4f): Boolean; inline; overload;
+
+ operator + (const v1, v2: TgluVector3f): TgluVector3f; inline;
+ operator - (const v1, v2: TgluVector3f): TgluVector3f; inline;
+
+const
+ gluVectorNull : TgluVector3f = (0,0,0);
+ gluVectorUnitX: TgluVector3f = (1,0,0);
+ gluVectorUnitY: TgluVector3f = (0,1,0);
+ gluVectorUnitZ: TgluVector3f = (0,0,1);
+
+implementation
+
+uses
+ Math;
+
+operator >< (const v1, v2: TgluVector3f): TgluVector3f;
+begin
+ result := gluVectorProduct(v1, v2);
+end;
+
+operator * (const v1, v2: TgluVector4f): Single;
+begin
+ result := gluVectorScalar(v1, v2);
+end;
+
+operator * (const v1, v2: TgluVector3f): Single;
+begin
+ result := gluVectorScalar(v1, v2);
+end;
+
+operator * (const v1, v2: TgluVector2f): Single;
+begin
+ result := gluVectorScalar(v1, v2);
+end;
+
+operator * (const v: TgluVector2f; const s: Single): TgluVector2f;
+begin
+ result := gluVectorMult(v, s);
+end;
+
+operator * (const v: TgluVector3f; const s: Single): TgluVector3f;
+begin
+ result := gluVectorMult(v, s);
+end;
+
+operator * (const v: TgluVector4f; const s: Single): TgluVector4f;
+begin
+ result := gluVectorMult(v, s);
+end;
+
+operator * (const s: Single; const v: TgluVector2f): TgluVector2f;
+begin
+ result := gluVectorMult(v, s);
+end;
+
+operator * (const s: Single; const v: TgluVector3f): TgluVector3f;
+begin
+ result := gluVectorMult(v, s);
+end;
+
+operator * (const s: Single; const v: TgluVector4f): TgluVector4f;
+begin
+ result := gluVectorMult(v, s);
+end;
+
+operator / (const v: TgluVector3f; const s: Single): TgluVector3f;
+begin
+ result := gluVectorDivide(v, s);
+end;
+
+operator = (const v1, v2: TgluVector2f): Boolean;
+begin
+ result := gluVectorEquals(v1, v2);
+end;
+
+operator = (const v1, v2: TgluVector3f): Boolean;
+begin
+ result := gluVectorEquals(v1, v2);
+end;
+
+operator = (const v1, v2: TgluVector4f): Boolean;
+begin
+ result := gluVectorEquals(v1, v2);
+end;
+
+operator + (const v1, v2: TgluVector3f): TgluVector3f;
+begin
+ result := gluVectorAdd(v1, v2);
+end;
+
+operator - (const v1, v2: TgluVector3f): TgluVector3f;
+begin
+ result := gluVectorSubtract(v1, v2);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//speichert einen Vector in einem Stream
+//@vec: Vector die gespeichert werden soll;
+//@aStream: Stream in dem gespeichert werden soll;
+procedure gluVector2fWrite(const vec: TgluVector2f; const aStream: TStream);
+begin
+ aStream.Write(vec[0], SizeOf(vec));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//speichert einen Vector in einem Stream
+//@vec: Vector die gespeichert werden soll;
+//@aStream: Stream in dem gespeichert werden soll;
+procedure gluVector3fWrite(const vec: TgluVector3f; const aStream: TStream);
+begin
+ aStream.Write(vec[0], SizeOf(vec));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//speichert einen Vector in einem Stream
+//@vec: Vector die gespeichert werden soll;
+//@aStream: Stream in dem gespeichert werden soll;
+procedure gluVector4fWrite(const vec: TgluVector4f; const aStream: TStream);
+begin
+ aStream.Write(vec[0], SizeOf(vec));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//ließt einen Vector aus einem Stream
+//@aStream: Stream aus dem gelesen werden soll;
+//@result: gelesene Werte des Vectors;
+//@throw: Exception;
+function gluVector2fRead(const aStream: TStream): TgluVector2f;
+begin
+ if aStream.Read(result{%H-}, SizeOf(result)) < SizeOf(result) then
+ raise Exception.Create('gluVector2fRead - unexpected stream size');
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//ließt einen Vector aus einem Stream
+//@aStream: Stream aus dem gelesen werden soll;
+//@result: gelesene Werte des Vectors;
+//@throw: Exception;
+function gluVector3fRead(const aStream: TStream): TgluVector3f;
+begin
+ if aStream.Read(result{%H-}, SizeOf(result)) < SizeOf(result) then
+ raise Exception.Create('gluVector3fRead - unexpected stream size');
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//ließt einen Vector aus einem Stream
+//@aStream: Stream aus dem gelesen werden soll;
+//@result: gelesene Werte des Vectors;
+//@throw: Exception;
+function gluVector4fRead(const aStream: TStream): TgluVector4f;
+begin
+ if aStream.Read(result{%H-}, SizeOf(result)) < SizeOf(result) then
+ raise Exception.Create('gluVector4fRead - unexpected stream size');
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt einen Vector
+//@W: 1. Wert im Vector;
+//@X: 2. Wert im Vector;
+//@Y: 3. Wert im Vector;
+//@Z: 4. Wert im Vector;
+function gluVector4f(const X,Y,Z,W: Single): TgluVector4f;
+begin
+ result[0] := X;
+ result[1] := Y;
+ result[2] := Z;
+ result[3] := W;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVector4f(const aVec: TgluVector3f; const W: Single): TgluVector4f;
+begin
+ PgluVector3f(@result[0])^ := aVec;
+ result[3] := W;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt einen Vector
+//@W: 1. Wert im Vector;
+//@X: 2. Wert im Vector;
+//@Y: 3. Wert im Vector;
+//@Z: 4. Wert im Vector;
+function gluVector4d(const X,Y,Z,W: Single): TgluVector4d;
+begin
+ result[0] := X;
+ result[1] := Y;
+ result[2] := Z;
+ result[3] := W;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt einen Vector
+//@X: 1. Wert im Vector;
+//@Y: 2. Wert im Vector;
+//@Z: 3. Wert im Vector;
+function gluVector3f(const X,Y,Z: Single): TgluVector3f;
+begin
+ result[0] := X;
+ result[1] := Y;
+ result[2] := Z;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt einen Vector
+//@v: 4-Komponenten Vektor aus dem der Vektor erstellt werden soll;
+function gluVector3f(const v: TgluVector4f): TgluVector3f;
+begin
+ result := PgluVector3f(@v[0])^;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVector3f(const v: TgluVector2f; const z: Single): TgluVector3f;
+begin
+ result[0] := v[0];
+ result[1] := v[1];
+ result[2] := z;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erzeugt einen Vektor aus 2 Punkten
+//@p1: Punkt 1;
+//@p2: Punkt 2;
+//@result: Vektor zwischen den Punkten
+function gluVector3f(const p1, p2: TgluVector3f): TgluVector3f;
+var
+ i: Integer;
+begin
+ for i := 0 to 2 do
+ result[i] := p2[i] - p1[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt einen Vector
+//@X: 1. Wert im Vector;
+//@Y: 2. Wert im Vector;
+function gluVector2f(const X,Y: Single): TgluVector2f;
+begin
+ result[0] := X;
+ result[1] := Y;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVector2f(const v3: TgluVector3f): TgluVector2f;
+begin
+ result[0] := v3[0];
+ result[1] := v3[1];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVector2f(const v4: TgluVector4f): TgluVector2f;
+begin
+ result[0] := v4[0];
+ result[1] := v4[1];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt einen Vector
+//@W: 1. Wert im Vector;
+//@X: 2. Wert im Vector;
+//@Y: 3. Wert im Vector;
+//@Z: 4. Wert im Vector;
+function gluVector4i(const W, X, Y, Z: Integer): TgluVector4i;
+begin
+ result[0] := W;
+ result[1] := X;
+ result[2] := Y;
+ result[3] := Z;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt einen Vector
+//@W: 1. Wert im Vector;
+//@X: 2. Wert im Vector;
+//@Y: 3. Wert im Vector;
+//@Z: 4. Wert im Vector;
+function gluVector2i(const X, Y: Integer): TgluVector2i;
+begin
+ result[0] := X;
+ result[1] := Y;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVector2e(const X, Y: GLenum): TgluVector2e;
+begin
+ result[0] := X;
+ result[1] := Y;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVector3e(const X, Y, Z: GLenum): TgluVector3e;
+begin
+ result[0] := X;
+ result[1] := Y;
+ result[2] := Z;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVector4e(const X, Y, Z, W: GLenum): TgluVector4e;
+begin
+ result[0] := X;
+ result[1] := Y;
+ result[2] := Z;
+ result[3] := W;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorNormalize(const v: TgluVector4f): TgluVector4f;
+begin
+ result := v;
+ if (result[3] <> 0) then
+ result := gluVectorMult(result, result[3]);
+ PgluVector3f(@result[0])^ := gluVectorNormalize(PgluVector3f(@result[0])^);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Normalisiert einen Vector
+//@v: Vector der normalisiert werden soll;
+//@result: normalisierter Vector;
+function gluVectorNormalize(const v: TgluVector3f): TgluVector3f;
+var len: Single;
+begin
+ len := gluVectorLength(v);
+ if (len > 0) then begin
+ result[0] := v[0]/len;
+ result[1] := v[1]/len;
+ result[2] := v[2]/len;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Normalisiert einen Vector
+//@v: Vector der normalisiert werden soll;
+//@result: normalisierter Vector;
+function gluVectorNormalize(const v: TgluVector2f): TgluVector2f;
+var len: Single;
+begin
+ len := gluVectorLength(v);
+ result[0] := v[0]/len;
+ result[1] := v[1]/len;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Länge eines Vectors
+//@v: Vector dessen Länge berechnet werden soll;
+//@result: Lange des Vectors;
+function gluVectorLength(const v: TgluVector3f): Single;
+begin
+ result := SQRT(SQR(v[0])+SQR(v[1])+SQR(v[2]));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Länge eines Vectors
+//@v: Vector dessen Länge berechnet werden soll;
+//@result: Lange des Vectors;
+function gluVectorLength(const v: TgluVector2f): Single;
+begin
+ result := SQRT(SQR(v[0])+SQR(v[1]));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Berechnet das VektorProdukt aus den Übergebenen Vektoren
+//@v1: 1. Vektor;
+//@v2: 2. Vektor;
+//@result: Vektor des Vektorprodukts aus v1 und v2;
+function gluVectorProduct(const v1, v2: TgluVector3f): TgluVector3f;
+begin
+ result[0] := v1[1]*v2[2] - v1[2]*v2[1];
+ result[1] := v1[2]*v2[0] - v1[0]*v2[2];
+ result[2] := v1[0]*v2[1] - v1[1]*v2[0];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Berechnet das Skalarprodukt der übergebenen Vektoren
+//@v1: 1. vektor;
+//@v2: 2. Vektor;
+//@result: Skalprodukt aus v1 und v2;
+function gluVectorScalar(const v1, v2: TgluVector4f): Single; overload;
+begin
+ result := v1[0]*v2[0] + v1[1]*v2[1] + v1[2]*v2[2] + v1[3]*v2[3];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Berechnet das Skalarprodukt der übergebenen Vektoren
+//@v1: 1. vektor;
+//@v2: 2. Vektor;
+//@result: Skalprodukt aus v1 und v2;
+function gluVectorScalar(const v1, v2: TgluVector3f): Single;
+begin
+ result := v1[0]*v2[0] + v1[1]*v2[1] + v1[2]*v2[2];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Berechnet das Skalarprodukt der übergebenen Vektoren
+//@v1: 1. vektor;
+//@v2: 2. Vektor;
+//@result: Skalprodukt aus v1 und v2;
+function gluVectorScalar(const v1, v2: TgluVector2f): Single;
+begin
+ result := v1[0]*v2[0] + v1[1]*v2[1];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Berechnet den Winkel zwischen den übergebenen Vectoren
+//@v1: 1. vektor;
+//@v2: 2. Vektor;
+//@result: Winkel zwischen v1 und v2;
+function gluVectorAngle(const v1, v2: TgluVector3f): Single;
+begin
+ result := ArcCos(gluVectorScalar(v1, v2)/(gluVectorLength(v1)*gluVectorLength(v2)));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Berechnet den Winkel zwischen den übergebenen Vectoren
+//@v1: 1. vektor;
+//@v2: 2. Vektor;
+//@result: Winkel zwischen v1 und v2;
+function gluVectorAngle(const v1, v2: TgluVector2f): Single;
+begin
+ result := ArcCos(gluVectorScalar(v1, v2)/(gluVectorLength(v1)*gluVectorLength(v2)));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorEquals(const v1, v2: TgluVector2f): Boolean;
+begin
+ result := (v1[0] = v2[0]) and (v1[1] = v2[1]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorEquals(const v1, v2: TgluVector3f): Boolean;
+begin
+ result := (v1[2] = v2[2]) and gluVectorEquals(PgluVector2f(@v1[0])^, PgluVector2f(@v2[0])^);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorEquals(const v1, v2: TgluVector4f): Boolean;
+begin
+ result := (v1[3] = v2[3]) and gluVectorEquals(PgluVector3f(@v1[0])^, PgluVector3f(@v2[0])^);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorMult(const v: TgluVector2f; const s: Single): TgluVector2f;
+begin
+ result[0] := v[0] * s;
+ result[1] := v[1] * s;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//multipliziert den Vektor mit einem Skalar
+//@v: Vektor der multipliziert werden soll;
+//@s: Skalar;
+//@result: Elementweise multiplizierter Vektor;
+function gluVectorMult(const v: TgluVector3f; const s: Single): TgluVector3f;
+var
+ i: Integer;
+begin
+ for i := 0 to 2 do
+ result[i] := v[i] * s;
+end;
+
+function gluVectorMult(const v: TgluVector4f; const s: Single): TgluVector4f;
+var
+ i: Integer;
+begin
+ for i := 0 to 3 do
+ result[i] := v[i] * s;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorDivide(const v: TgluVector3f; const s: Single): TgluVector3f;
+var
+ i: Integer;
+begin
+ for i := 0 to 3 do
+ result[i] := v[i] / s;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorClamp(const v: TgluVector3f; const aMin, aMax: Single): TgluVector3f;
+var i: Integer;
+begin
+ for i := 0 to High(v) do
+ result[i] := Min(Max(v[i], aMin), aMax);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluVectorClamp(const v: TgluVector4f; const aMin, aMax: Single): TgluVector4f;
+var i: Integer;
+begin
+ for i := 0 to High(v) do
+ result[i] := Min(Max(v[i], aMin), aMax);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//addiert zwei Vektoren
+//@v1: Vektor 1;
+//@v2: Vektor 2;
+//@result: elementweise Summe der beiden Vektoren;
+function gluVectorAdd(const v1, v2: TgluVector3f): TgluVector3f;
+var
+ i: Integer;
+begin
+ for i := 0 to 2 do
+ result[i] := v1[i] + v2[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//subtrahiert zwei Vektoren
+//@v1: Vektor 1;
+//@v2: Vektor 2;
+//@result: elementweise Differenz der beiden Vektoren;
+function gluVectorSubtract(const v1, v2: TgluVector3f): TgluVector3f;
+var
+ i: Integer;
+begin
+ for i := 0 to 2 do
+ result[i] := v1[i] - v2[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Verändert die Vektoren so, dass sie orthogonal und normalisiert sind, bleibt dabei in der gleichen Ebene
+//@v1: Vektor 1;
+//@v2: Vektor 2;
+procedure gluVectorOrthoNormalize(var reference, tangent: TgluVector3f);
+var
+ proj: TgluVector3f;
+begin
+ reference:= gluVectorNormalize(reference);
+
+ proj:= gluVectorMult(reference, gluVectorScalar(tangent, reference));
+ tangent:= gluVectorSubtract(tangent, proj);
+ tangent:= gluVectorNormalize(tangent);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//rechnet den übergebenen Vector in absolute (matrixunabhängige) Raumkoordinaten um
+//@v: Vector dessen absolute Koordinaten bestimmt werden sollen;
+//@result: absolute Raumkoordianten des Vectors v;
+function gluGetAbsCoord(const v: TgluVector3f): TgluVector3f;
+var
+ v4: TVector4f;
+ sum: Single;
+ i, j: Integer;
+ m: array[0..3, 0..3] of TGLFloat;
+begin
+ for i := 0 to 2 do
+ v4[i] := v[i];
+ v4[3] := 1;
+ glGetFloatv(GL_MODELVIEW_MATRIX, @m[0, 0]);
+ for i := 0 to 2 do begin
+ sum := 0;
+ for j := 0 to 3 do begin
+ sum := sum + m[j, i]*v4[j];
+ end;
+ result[i] := sum;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet eine Ebene die durch 3 Punkte bestimmt wird
+//@p1: Punkt 1;
+//@p2: Punkt 2, Punkt auf dem der Normalenvekrtor steht;
+//@p3: Punkt 3;
+//@result: Parameter der Ebene (0, 1, 2: Normalvektor; 3: Abstand);
+function gluPlanef(const p1, p2, p3: TgluVector3f): TgluPlanef;
+var
+ n, v1, v2: TgluVector3f;
+begin
+ v1 := gluVector3f(p2, p1);
+ v2 := gluVector3f(p2, p3);
+ n := gluVectorProduct(v1, v2);
+ result := gluPlanef(n, p2);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluPlanef(const n, p: TgluVector3f): TgluPlanef;
+var
+ d: Single;
+begin
+ d := gluVectorScalar(n, p);
+ PgluVector3f(@result)^ := n;
+ result[3] := -d;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//normalisiert die Parameter einer Ebene
+//@p: Parameter der Ebene;
+//@result: normalisierte Prameter der Ebene;
+function gluPlaneNormalize(const p: TgluPlanef): TgluPlanef;
+var
+ m: Single;
+ i: Integer;
+begin
+ m := Sqrt(Sqr(p[0]) + Sqr(p[1]) + Sqr(p[2]));
+ for i := 0 to 3 do
+ result[i] := p[i] / m;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluPlaneCrossRay(const aPlane: TgluPlanef; const aRay: TgluRayf; out aPoint: TgluVector3f): Boolean;
+var
+ lambda, real: Double;
+ i: Integer;
+begin
+ result := false;
+ lambda := 0;
+ real := 0;
+ for i := 0 to 2 do begin
+ lambda := lambda + aRay.v[i] * aPlane[i];
+ real := real + aRay.p[i] * aPlane[i];
+ end;
+ if (lambda = 0) then begin
+ aPoint := gluVector3f(0, 0, 0);
+ exit;
+ end;
+ lambda := (aPlane[3] - real) / lambda;
+ aPoint := gluRayPoint(aRay, -lambda);
+ result := true;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluRayf(const p, v: TgluVector3f): TgluRayf;
+begin
+ result.p := p;
+ result.v := v;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluRayNormalize(const r: TgluRayf): TgluRayf;
+begin
+ result.p := r.p;
+ result.v := gluVectorNormalize(r.v);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluRayPoint(const r: TgluRayf; const lambda: Single): TgluVector3f;
+begin
+ result := gluVectorAdd(r.p, gluVectorMult(r.v, lambda));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//schriebt die Werte des Vektors in einen String
+//@v: Vektor der in einen String umgewandelt werden soll;
+//@round: Anzahl der Stellen auf die gerundet werden soll;
+//@result: String mit den erten des Vektors;
+function gluVector4fToStr(const v: TgluVector4f; const round: Integer): String;
+var
+ f: TFormatSettings;
+begin
+ f.DecimalSeparator := '.';
+ if (round >= 0) then
+ result := Format('%.*f; %.*f; %.*f; %.*f;', [round, v[0], round, v[1], round, v[2], round, v[3]], f)
+ else
+ result := Format('%f; %f; %f; %f;', [v[0], v[1], v[2], v[3]], f);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//schriebt die Werte des Vektors in einen String
+//@v: Vektor der in einen String umgewandelt werden soll;
+//@round: Anzahl der Stellen auf die gerundet werden soll;
+//@result: String mit den erten des Vektors;
+function gluVector3fToStr(const v: TgluVector3f; const round: Integer): String;
+var
+ f: TFormatSettings;
+begin
+ f.DecimalSeparator := '.';
+ if (round >= 0) then
+ result := Format('%.*f; %.*f; %.*f;', [round, v[0], round, v[1], round, v[2]], f)
+ else
+ result := Format('%f; %f; %f;', [v[0], v[1], v[2]], f);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//schriebt die Werte des Vektors in einen String
+//@v: Vektor der in einen String umgewandelt werden soll;
+//@round: Anzahl der Stellen auf die gerundet werden soll;
+//@result: String mit den erten des Vektors;
+function gluVector2fToStr(const v: TgluVector2f; const round: Integer): String;
+var
+ f: TFormatSettings;
+begin
+ f.DecimalSeparator := '.';
+ if (round >= 0) then
+ result := Format('%.*f; %.*f;', [round, v[0], round, v[1]], f)
+ else
+ result := Format('%f; %f;', [v[0], v[1]], f);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluStrToVectorIntern(str: String; const aAbortOnFailure: Boolean; out aVec: TgluVector4f): Boolean;
+var
+ i, j, p, l: Integer;
+ s: String;
+ format: TFormatSettings;
+ v: Single;
+begin
+ result := false;
+ FillChar(aVec{%H-}, SizeOf(aVec), 0);
+ FillChar(format{%H-}, SizeOf(format), 0);
+ format.DecimalSeparator := '.';
+ if (Length(str) > 0) and (str[Length(str)] <> ';') then
+ str := str + ';';
+ j := 0;
+ i := 1;
+ p := 1;
+ l := Length(str);
+ while (i <= l) do begin
+ if str[i] = ';' then begin
+ s := Trim(copy(str, p, i-p));
+ if not TryStrToFloat(s, v, format) then begin
+ if aAbortOnFailure then
+ exit;
+ v := 0;
+ end;
+ aVec[j] := v;
+ inc(j);
+ p := i+1;
+ end;
+ inc(i);
+ end;
+ result := true;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluTryStrToVector4f(str: String; out aVec: TgluVector4f): Boolean;
+begin
+ result := gluStrToVectorIntern(str, true, aVec);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluTryStrToVector3f(str: String; out aVec: TgluVector3f): Boolean;
+var
+ v: TgluVector4f;
+begin
+ if (Length(str) > 0) and (str[Length(str)] <> ';') then
+ str := str + ';';
+ result := gluTryStrToVector4f(str+'0;', v);
+ aVec := PgluVector3f(@v[0])^;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluTryStrToVector2f(str: String; out aVec: TgluVector2f): Boolean;
+var
+ v: TgluVector4f;
+begin
+ if (Length(str) > 0) and (str[Length(str)] <> ';') then
+ str := str + ';';
+ result := gluTryStrToVector4f(str+'0;0;', v);
+ aVec := PgluVector2f(@v[0])^;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//wandelt einen String in einen Vektor um
+//@str: String der in den Vektor umgewandelt werden soll;
+//@result: Vektor mit den Datein aus dem String;
+function gluStrToVector4f(str: String): TgluVector4f;
+begin
+ gluStrToVectorIntern(str, false, result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//wandelt einen String in einen Vektor um
+//@str: String der in den Vektor umgewandelt werden soll;
+//@result: Vektor mit den Datein aus dem String;
+function gluStrToVector3f(str: String): TgluVector3f;
+var
+ v: TgluVector4f;
+begin
+ if (Length(str) > 0) and (str[Length(str)] <> ';') then
+ str := str + ';';
+ v := gluStrToVector4f(str+'0;');
+ result := PgluVector3f(@v[0])^;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//wandelt einen String in einen Vektor um
+//@str: String der in den Vektor umgewandelt werden soll;
+//@result: Vektor mit den Datein aus dem String;
+function gluStrToVector2f(str: String): TgluVector2f;
+var
+ v: TgluVector3f;
+begin
+ if (Length(str) > 0) and (str[Length(str)] <> ';') then
+ str := str + ';';
+ v := gluStrToVector3f(str+'0;');
+ result := PgluVector2f(@v[0])^;
+end;
+
+function gluVector4iToStr(const v: TgluVector4i): String;
+begin
+ Result:= Format('%d;%d;%d;%d;',[v[0],v[1],v[2],v[3]]);
+end;
+
+function gluVector3iToStr(const v: TgluVector3i): String;
+begin
+ Result:= Format('%d;%d;%d;',[v[0],v[1],v[2]]);
+end;
+
+function gluVector2iToStr(const v: TgluVector2i): String;
+begin
+ Result:= Format('%d;%d;',[v[0],v[1]]);
+end;
+
+function gluStrToVector4i(const str: String): TgluVector4i;
+var
+ i, j, p, l: Integer;
+ v: integer;
+begin
+ FillChar(result{%H-}, SizeOf(result), 0);
+ j := 0;
+ i := 1;
+ p := 1;
+ l := Length(str);
+ while (i <= l) do begin
+ if str[i] = ';' then begin
+ if not TryStrToInt(copy(str, p, i-p), v) then
+ v := 0;
+ result[j] := v;
+ inc(j);
+ p := i+1;
+ end;
+ inc(i);
+ end;
+end;
+
+function gluStrToVector3i(const str: String): TgluVector3i;
+var
+ v: TgluVector4i;
+begin
+ v := gluStrToVector4i(str+'0;');
+ result := PgluVector3i(@v[0])^;
+end;
+
+function gluStrToVector2i(const str: String): TgluVector2i;
+var
+ v: TgluVector3i;
+begin
+ v := gluStrToVector3i(str+'0;');
+ result := PgluVector2i(@v[0])^;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//wandelt einen Vektor in eine Farbe um
+//@v: Vektor der umgewandelt werden soll;
+//@result: Farbe;
+function gluVectorToColor(const v: TgluVector4f): TVectorColor; overload;
+begin
+ result := gluVectorToColor(PgluVector3f(@v[0])^);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//wandelt einen Vektor in eine Farbe um
+//@v: Vektor der umgewandelt werden soll;
+//@result: Farbe;
+function gluVectorToColor(const v: TgluVector3f): TVectorColor;
+var
+ r, g, b: Byte;
+begin
+ r := round(255*v[0]);
+ g := round(255*v[1]);
+ b := round(255*v[2]);
+ result := r + (g shl 8) + (b shl 16);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluColorToVector3f(const c: TVectorColor): TgluVector3f;
+begin
+ result[0] := ( c and $FF) / 255;
+ result[1] := ((c shr 8) and $FF) / 255;
+ result[2] := ((c shr 16) and $FF) / 255;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluColorToVector4f(const c: TVectorColor; const a: Single): TgluVector4f;
+begin
+ PgluVector3f(@result[0])^ := gluColorToVector3f(c);
+ result[3] := a;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//rechnet eine Farbe im HSV-Farbraum in den RGB-Farbraum um
+//@v: Farbe im HSV-Farbraum;
+//@result: Farbe im RGB-Farbraum;
+function gluVectorHSVColor(v: TgluVector3f): TgluVector3f;
+const
+ _H = 0;
+ _S = 1;
+ _V = 2;
+var
+ h: Integer;
+ f, p, q, t: Single;
+begin
+ v[_H] := 360*v[_H];
+//H normieren
+ while (v[_H] < 0) do
+ v[_H] := v[_H] + 360;
+ while (v[_H] > 360) do
+ v[_H] := v[_H] - 360;
+//V normieren
+ if (v[_V] < 0) then
+ v[_V] := 0;
+ if (v[_V] > 1) then
+ v[_V] := 1;
+
+ h := Floor(v[_H] / 60);
+ f := v[_H]/60 - h;
+ p := v[_V] * (1 - v[_S]);
+ q := v[_V] * (1 - v[_S] * f);
+ t := v[_V] * (1 - v[_S] * (1 - f));
+ case h of
+ 1: result := gluVector3f(q, v[_V], p);
+ 2: result := gluVector3f(p, v[_V], t);
+ 3: result := gluVector3f(p, q, v[_V]);
+ 4: result := gluVector3f(t, p, v[_V]);
+ 5: result := gluVector3f(v[_V], p, q);
+ else
+ result := gluVector3f(v[_V], t, p);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//rechnet eine Farbe im HSV-Farbraum in den RGB-Farbraum um
+//@v: Farbe im HSV-Farbraum;
+//@result: Farbe im RGB-Farbraum;
+function gluVectorHSVColor(v: TgluVector4f): TgluVector4f;
+begin
+ PgluVector3f(@result)^ := gluVectorHSVColor(PgluVector3f(@v)^);
+ result[3] := v[3];
+end;
+
+end.
+
projects / LazOpenGLCore.git / commitdiff