From 4e1207880c81b7b83f1cffc569295fef2675c7c3 Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Sun, 21 Sep 2014 17:24:29 +0200 Subject: [PATCH] * Initial Commit --- uglcArrayBuffer.pas | 105 ++++ uglcCamera.pas | 254 ++++++++++ uglcFrameBufferObject.pas | 622 +++++++++++++++++++++++ uglcLight.pas | 424 ++++++++++++++++ uglcShader.pas | 931 +++++++++++++++++++++++++++++++++++ uglcTypes.pas | 318 ++++++++++++ ugluMatrix.pas | 318 ++++++++++++ ugluQuaternion.pas | 384 +++++++++++++++ ugluVector.pas | 1193 +++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 4549 insertions(+) create mode 100644 uglcArrayBuffer.pas create mode 100644 uglcCamera.pas create mode 100644 uglcFrameBufferObject.pas create mode 100644 uglcLight.pas create mode 100644 uglcShader.pas create mode 100644 uglcTypes.pas create mode 100644 ugluMatrix.pas create mode 100644 ugluQuaternion.pas create mode 100644 ugluVector.pas diff --git a/uglcArrayBuffer.pas b/uglcArrayBuffer.pas new file mode 100644 index 0000000..e7acaa2 --- /dev/null +++ b/uglcArrayBuffer.pas @@ -0,0 +1,105 @@ +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. + diff --git a/uglcCamera.pas b/uglcCamera.pas new file mode 100644 index 0000000..93a3bf7 --- /dev/null +++ b/uglcCamera.pas @@ -0,0 +1,254 @@ +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. + diff --git a/uglcFrameBufferObject.pas b/uglcFrameBufferObject.pas new file mode 100644 index 0000000..7fcc673 --- /dev/null +++ b/uglcFrameBufferObject.pas @@ -0,0 +1,622 @@ +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; + 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. + diff --git a/uglcLight.pas b/uglcLight.pas new file mode 100644 index 0000000..6a36b43 --- /dev/null +++ b/uglcLight.pas @@ -0,0 +1,424 @@ +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. + diff --git a/uglcShader.pas b/uglcShader.pas new file mode 100644 index 0000000..bebe142 --- /dev/null +++ b/uglcShader.pas @@ -0,0 +1,931 @@ +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; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + 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. + diff --git a/uglcTypes.pas b/uglcTypes.pas new file mode 100644 index 0000000..95ffb79 --- /dev/null +++ b/uglcTypes.pas @@ -0,0 +1,318 @@ +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. + diff --git a/ugluMatrix.pas b/ugluMatrix.pas new file mode 100644 index 0000000..1394a2d --- /dev/null +++ b/ugluMatrix.pas @@ -0,0 +1,318 @@ +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. + diff --git a/ugluQuaternion.pas b/ugluQuaternion.pas new file mode 100644 index 0000000..adcb117 --- /dev/null +++ b/ugluQuaternion.pas @@ -0,0 +1,384 @@ +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. + diff --git a/ugluVector.pas b/ugluVector.pas new file mode 100644 index 0000000..23d4680 --- /dev/null +++ b/ugluVector.pas @@ -0,0 +1,1193 @@ +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. + -- 2.1.4