commit 4e1207880c81b7b83f1cffc569295fef2675c7c3 Author: Bergmann89 Date: Sun Sep 21 17:24:29 2014 +0200 * Initial Commit 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. +