@@ -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. | |||||
@@ -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. | |||||
@@ -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<TglcAttachmentContainer>; | |||||
private | |||||
fID: GLuint; | |||||
fOwnsObjects: Boolean; | |||||
fWidth: Integer; | |||||
fHeight: Integer; | |||||
fBuffers: TglcAttachmentContainerList; | |||||
function GetBuffer(const aIndex: Integer): TglcBuffer; | |||||
procedure SetBuffer(const aIndex: Integer; const aValue: TglcBuffer); | |||||
function GetAttachment(const aIndex: Integer): TglcAttachment; | |||||
procedure SetAttachment(const aIndex: Integer; const aValue: TglcAttachment); | |||||
function GetBufferCount: Integer; | |||||
procedure Attach(const aIndex: Integer); | |||||
procedure Detach(const aIndex: Integer); | |||||
procedure SetWidth(const aValue: Integer); | |||||
procedure SetHeight(const aValue: Integer); | |||||
procedure CheckFrameBufferStatus; | |||||
procedure UpdateAndCheckFBO; | |||||
public | |||||
property ID : GLuint read fID; | |||||
property Count : Integer read GetBufferCount; | |||||
property OwnsObjects: Boolean read fOwnsObjects; | |||||
property Width : Integer read fWidth write SetWidth; | |||||
property Height : Integer read fHeight write SetHeight; | |||||
property Attachments[const aIndex: Integer]: TglcAttachment read GetAttachment write SetAttachment; | |||||
property Buffers [const aIndex: Integer]: TglcBuffer read GetBuffer write SetBuffer; | |||||
procedure AddBuffer(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean = true); | |||||
procedure DelBuffer(const aIndex: Integer); | |||||
function RemBuffer(const aBuffer: TglcBuffer): Integer; | |||||
function IndexOfBuffer(const aBuffer: TglcBuffer): Integer; | |||||
procedure SetSize(const aWidth, aHeight: Integer); | |||||
function CheckAttachment(const aAttachment: TglcAttachment): Boolean; | |||||
procedure Bind(const aSetViewport: Boolean = true); | |||||
procedure Unbind(const aResetViewport: Boolean = true); | |||||
constructor Create(const aOwnBuffers: Boolean = true); | |||||
destructor Destroy; override; | |||||
end; | |||||
implementation | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//TglcBuffer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcBuffer.SetWidth(const aValue: Integer); | |||||
begin | |||||
SetSize(aValue, fHeight); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcBuffer.SetHeight(const aValue: Integer); | |||||
begin | |||||
SetSize(fWidth, aValue); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcBuffer.SetSize(const aWidth, aHeight: Integer); | |||||
begin | |||||
fWidth := aWidth; | |||||
fHeight := aHeight; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//TglcRenderBuffer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcRenderBuffer.UpdateRenderBufferStorage; | |||||
begin | |||||
glGetError; //clear Erroros | |||||
Bind; | |||||
glRenderbufferStorage(GL_RENDERBUFFER, GLenum(fFormat), fWidth, fHeight); | |||||
Unbind; | |||||
glcCheckAndRaiseError; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcRenderBuffer.SetFormat(const aValue: TglcInternalFormat); | |||||
begin | |||||
fFormat := aValue; | |||||
UpdateRenderBufferStorage; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcRenderBuffer.SetSize(const aWidth, aHeight: Integer); | |||||
begin | |||||
if (aWidth <= 0) or (aHeight <= 0) then | |||||
raise EglcRenderBuffer.Create('invalid width or height'); | |||||
if (aWidth <> fWidth) or (aHeight <> fHeight) then begin | |||||
inherited SetSize(aWidth, aHeight); | |||||
UpdateRenderBufferStorage; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcRenderBuffer.Bind; | |||||
begin | |||||
glBindRenderbuffer(GL_RENDERBUFFER, fID); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcRenderBuffer.Unbind; | |||||
begin | |||||
glBindRenderbuffer(GL_RENDERBUFFER, 0); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
constructor TglcRenderBuffer.Create(const aFormat: TglcInternalFormat); | |||||
begin | |||||
inherited Create; | |||||
fBufferType := btRenderBuffer; | |||||
glGenRenderbuffers(1, @fID); | |||||
fFormat := aFormat; | |||||
SetSize(64, 64); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
destructor TglcRenderBuffer.Destroy; | |||||
begin | |||||
glDeleteRenderbuffers(1, @fID); | |||||
inherited Destroy; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//TglcTextureBuffer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcTextureBuffer.UpdateTexImage; | |||||
begin | |||||
glGetError; //clear errors | |||||
Bind(false); | |||||
glTexImage2D(GL_TEXTURE_2D, 0, GLenum(fInternalFormat), fWidth, fHeight, GLint(Byte(fBorder) and Byte(1)), GLenum(fFormat), GL_UNSIGNED_BYTE, nil); | |||||
Unbind(false); | |||||
glcCheckAndRaiseError; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcTextureBuffer.SetFormat(const aValue: TglcFormat); | |||||
begin | |||||
if (fFormat <> aValue) then begin | |||||
fFormat := aValue; | |||||
UpdateTexImage; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcTextureBuffer.SetInternalFormat(const aValue: TglcInternalFormat); | |||||
begin | |||||
if (fInternalFormat <> aValue) then begin | |||||
fInternalFormat := aValue; | |||||
UpdateTexImage; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcTextureBuffer.SetBorder(const aValue: Boolean); | |||||
begin | |||||
if (fBorder <> aValue) then begin | |||||
fBorder := aValue; | |||||
UpdateTexImage; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcTextureBuffer.SetSize(const aWidth, aHeight: Integer); | |||||
begin | |||||
if (aWidth <= 0) or (aHeight <= 0) then | |||||
raise EglcTextureBuffer.Create('invalid width or height'); | |||||
if (aWidth <> fWidth) or (aHeight <> fHeight) then begin | |||||
inherited SetSize(aWidth, aHeight); | |||||
UpdateTexImage; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcTextureBuffer.Bind(const aEnableTextureUnit: Boolean = true); | |||||
begin | |||||
if aEnableTextureUnit then | |||||
glEnable(GL_TEXTURE_2D); | |||||
glBindTexture(GL_TEXTURE_2D, fID); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcTextureBuffer.Unbind(const aDisableTextureUnit: Boolean = true); | |||||
begin | |||||
if aDisableTextureUnit then | |||||
glDisable(GL_TEXTURE_2D); | |||||
glBindTexture(GL_TEXTURE_2D, 0); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
constructor TglcTextureBuffer.Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat); | |||||
begin | |||||
inherited Create; | |||||
fBufferType := btTextureBuffer; | |||||
glGenTextures(1, @fID); | |||||
Bind(false); | |||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); | |||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); | |||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); | |||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); | |||||
Unbind(false); | |||||
fFormat := aFormat; | |||||
fInternalFormat := aInternalFormat; | |||||
SetSize(64, 64); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
destructor TglcTextureBuffer.Destroy; | |||||
begin | |||||
glDeleteTextures(1, @fID); | |||||
inherited Destroy; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//TglcAttachment//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
constructor TglcFrameBufferObject.TglcAttachmentContainer.Create(const aBuffer: TglcBuffer; | |||||
const aAttachment: TglcAttachment; const aOwnsObject: Boolean); | |||||
begin | |||||
inherited Create; | |||||
Buffer := aBuffer; | |||||
Attachment := aAttachment; | |||||
OwnsObject := aOwnsObject; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
destructor TglcFrameBufferObject.TglcAttachmentContainer.Destroy; | |||||
begin | |||||
if OwnsObject then | |||||
Buffer.Free; | |||||
inherited Destroy; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//TglcFrameBufferObject///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcFrameBufferObject.GetBuffer(const aIndex: Integer): TglcBuffer; | |||||
begin | |||||
if (aIndex >= 0) and (aIndex < fBuffers.Count) then | |||||
result := fBuffers[aIndex].Buffer | |||||
else | |||||
raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcFrameBufferObject.SetBuffer(const aIndex: Integer; const aValue: TglcBuffer); | |||||
begin | |||||
if (aIndex < 0) or (aIndex >= fBuffers.Count) then | |||||
raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); | |||||
if not Assigned(aValue) then | |||||
raise EglcFrameBufferObject.Create('invalid buffer'); | |||||
Detach(aIndex); | |||||
fBuffers[aIndex].Buffer := aValue; | |||||
Attach(aIndex); | |||||
UpdateAndCheckFBO; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcFrameBufferObject.GetAttachment(const aIndex: Integer): TglcAttachment; | |||||
begin | |||||
if (aIndex >= 0) and (aIndex < fBuffers.Count) then | |||||
result := fBuffers[aIndex].Attachment | |||||
else | |||||
raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcFrameBufferObject.SetAttachment(const aIndex: Integer; const aValue: TglcAttachment); | |||||
begin | |||||
if (aIndex < 0) or (aIndex >= fBuffers.Count) then | |||||
raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); | |||||
if not CheckAttachment(aValue) then | |||||
raise EglcFrameBufferObject.Create('Attachment already assigned'); | |||||
Detach(aIndex); | |||||
fBuffers[aIndex].Attachment := aValue; | |||||
Attach(aIndex); | |||||
UpdateAndCheckFBO; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcFrameBufferObject.Attach(const aIndex: Integer); | |||||
var | |||||
a: TglcAttachment; | |||||
b: TglcBuffer; | |||||
begin | |||||
a := Attachments[aIndex]; | |||||
b := Buffers[aIndex]; | |||||
Bind(false); | |||||
if (b.BufferType = btRenderBuffer) then | |||||
glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, (b as TglcRenderBuffer).ID) | |||||
else | |||||
glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, (b as TglcTextureBuffer).ID, 0); | |||||
Unbind(false); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcFrameBufferObject.Detach(const aIndex: Integer); | |||||
var | |||||
a: TglcAttachment; | |||||
b: TglcBuffer; | |||||
begin | |||||
a := Attachments[aIndex]; | |||||
b := Buffers[aIndex]; | |||||
Bind(false); | |||||
if (b.BufferType = btRenderBuffer) then | |||||
glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, 0) | |||||
else | |||||
glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, 0, 0); | |||||
Unbind(false); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//legt die neue Breite fest | |||||
//@Value: Breite; | |||||
procedure TglcFrameBufferObject.SetWidth(const aValue: Integer); | |||||
begin | |||||
SetSize(aValue, fHeight); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//legt die neue Höhe fest | |||||
//@Value: neue Höhe; | |||||
procedure TglcFrameBufferObject.SetHeight(const aValue: Integer); | |||||
begin | |||||
SetSize(fWidth, aValue); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcFrameBufferObject.CheckFrameBufferStatus; | |||||
begin | |||||
case glCheckFramebufferStatus(GL_FRAMEBUFFER) of | |||||
GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT: | |||||
raise EglcFrameBufferObject.Create('Incomplete attachment'); | |||||
GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT: | |||||
raise EglcFrameBufferObject.Create('Missing attachment'); | |||||
GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT: | |||||
raise EglcFrameBufferObject.Create('Incomplete dimensions'); | |||||
GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT: | |||||
raise EglcFrameBufferObject.Create('Incomplete formats'); | |||||
GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER: | |||||
raise EglcFrameBufferObject.Create('Incomplete draw buffer'); | |||||
GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER: | |||||
raise EglcFrameBufferObject.Create('Incomplete read buffer'); | |||||
GL_FRAMEBUFFER_UNSUPPORTED: | |||||
raise EglcFrameBufferObject.Create('Framebufferobjects unsupported'); | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//prüft das FrameBufferObjekt auf Fehler | |||||
procedure TglcFrameBufferObject.UpdateAndCheckFBO; | |||||
function IsColorAttachment(const a: TglcAttachment): Boolean; | |||||
begin | |||||
result := (GLenum(a) >= GL_COLOR_ATTACHMENT0) and (GLenum(a) <= GL_COLOR_ATTACHMENT15); | |||||
end; | |||||
var | |||||
buff: array of GLenum; | |||||
b: GLboolean; | |||||
i: Integer; | |||||
begin | |||||
if (fBuffers.Count = 0) then | |||||
exit; | |||||
Bind(false); | |||||
//find ColorBuffers | |||||
SetLength(buff, 0); | |||||
for i := 0 to fBuffers.Count-1 do | |||||
if IsColorAttachment(fBuffers[i].Attachment) then begin | |||||
SetLength(buff, Length(buff) + 1); | |||||
buff[High(buff)] := GLenum(fBuffers[i].Attachment); | |||||
end; | |||||
//set Read and Draw Buffer | |||||
if (Length(buff) = 0) then begin | |||||
glReadBuffer(GL_NONE); | |||||
glDrawBuffer(GL_NONE); | |||||
end else begin | |||||
glDrawBuffers(Length(buff), @buff[0]); | |||||
glGetBooleanv(GL_DOUBLEBUFFER, @b); | |||||
if b then | |||||
glReadBuffer(GL_BACK) | |||||
else | |||||
glReadBuffer(GL_FRONT); | |||||
end; | |||||
Unbind(false); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcFrameBufferObject.GetBufferCount: Integer; | |||||
begin | |||||
result := fBuffers.Count; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcFrameBufferObject.AddBuffer(const aBuffer: TglcBuffer; | |||||
const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean); | |||||
begin | |||||
if not Assigned(aBuffer) then | |||||
raise EglcFrameBufferObject.Create('invalid buffer'); | |||||
if not CheckAttachment(aAttachment) then | |||||
raise EglcFrameBufferObject.Create('attachment already assigned'); | |||||
fBuffers.Add(TglcAttachmentContainer.Create(aBuffer, aAttachment, fOwnsObjects and aOwnsBuffer)); | |||||
if OwnsObjects then | |||||
aBuffer.SetSize(fWidth, fHeight); | |||||
Attach(fBuffers.Count-1); | |||||
UpdateAndCheckFBO; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcFrameBufferObject.DelBuffer(const aIndex: Integer); | |||||
begin | |||||
if (aIndex >= 0) and (aIndex < fBuffers.Count) then begin | |||||
Detach(aIndex); | |||||
fBuffers.Delete(aIndex); | |||||
UpdateAndCheckFBO; | |||||
end else | |||||
raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcFrameBufferObject.RemBuffer(const aBuffer: TglcBuffer): Integer; | |||||
begin | |||||
result := IndexOfBuffer(aBuffer); | |||||
if (result >= 0) then | |||||
DelBuffer(result); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcFrameBufferObject.IndexOfBuffer(const aBuffer: TglcBuffer): Integer; | |||||
var | |||||
i: Integer; | |||||
begin | |||||
for i := 0 to fBuffers.Count-1 do | |||||
if (fBuffers[i].Buffer = aBuffer) then begin | |||||
result := i; | |||||
exit; | |||||
end; | |||||
result := -1; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//legt die Größe neu fest | |||||
//@Width: neue Breite; | |||||
//@Height: neue Höhe; | |||||
procedure TglcFrameBufferObject.SetSize(const aWidth, aHeight: Integer); | |||||
var | |||||
c: TglcAttachmentContainer; | |||||
begin | |||||
if (aWidth <= 0) or (aHeight <= 0) then | |||||
raise EglcFrameBufferObject.Create('invalid width or height'); | |||||
fWidth := aWidth; | |||||
fHeight := aHeight; | |||||
if OwnsObjects then | |||||
for c in fBuffers do | |||||
if c.OwnsObject then | |||||
c.Buffer.SetSize(fWidth, fHeight); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcFrameBufferObject.CheckAttachment(const aAttachment: TglcAttachment): Boolean; | |||||
var | |||||
i: Integer; | |||||
begin | |||||
result := false; | |||||
for i := 0 to fBuffers.Count-1 do | |||||
if (fBuffers[i].Attachment = aAttachment) then | |||||
exit; | |||||
result := true; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//Bindet das FrameBufferObjekt | |||||
procedure TglcFrameBufferObject.Bind(const aSetViewport: Boolean = true); | |||||
begin | |||||
glBindFramebuffer(GL_FRAMEBUFFER, fID); | |||||
if aSetViewport then begin | |||||
glPushAttrib(GL_VIEWPORT_BIT); | |||||
glViewPort(0, 0, fWidth, fHeight); | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//Entbindet das FrameBufferObjekt | |||||
procedure TglcFrameBufferObject.Unbind(const aResetViewport: Boolean = true); | |||||
begin | |||||
if aResetViewport then | |||||
glPopAttrib; | |||||
glBindFramebuffer(GL_FRAMEBUFFER, 0); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//erzeugt das Objekt | |||||
constructor TglcFrameBufferObject.Create(const aOwnBuffers: Boolean = true); | |||||
begin | |||||
inherited Create; | |||||
glGenFramebuffers(1, @fID); | |||||
fWidth := 64; | |||||
fHeight := 64; | |||||
fOwnsObjects := aOwnBuffers; | |||||
fBuffers := TglcAttachmentContainerList.Create(true); //containers are always owned by this object! | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//gibt das Objekt frei | |||||
destructor TglcFrameBufferObject.Destroy; | |||||
begin | |||||
fBuffers.Free; | |||||
glDeleteFramebuffers(1, @fID); | |||||
inherited Destroy; | |||||
end; | |||||
end. | |||||
@@ -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. | |||||
@@ -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<TglcShaderObject>; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
TglcShaderProgram = class(TglcShaderObjectList) | |||||
private | |||||
fProgramObj: GLHandle; | |||||
fOnLog: TglcShaderLogEvent; | |||||
fFilename: String; | |||||
fGeometryInputType: GLint; | |||||
fGeometryOutputType: GLint; | |||||
fGeometryVerticesOut: GLint; | |||||
function GetUniformLocation(const aName: String; out aPos: glInt): Boolean; | |||||
function GetInfoLog(Obj: GLHandle): String; | |||||
function GetCompiled: Boolean; | |||||
function GetLinked: Boolean; | |||||
procedure CreateProgramObj; | |||||
procedure Log(const msg: String); | |||||
procedure AttachShaderObj(const aShaderObj: TglcShaderObject); | |||||
public | |||||
property ProgramObj: glHandle read fProgramObj; | |||||
property Filename: String read fFilename; | |||||
property Compiled: Boolean read GetCompiled; | |||||
property Linked: Boolean read GetLinked; | |||||
property OnLog: TglcShaderLogEvent read fOnLog write fOnLog; | |||||
property GeometryInputType: GLint read fGeometryInputType write fGeometryInputType; | |||||
property GeometryOutputType: GLint read fGeometryOutputType write fGeometryOutputType; | |||||
property GeometryVerticesOut: GLint read fGeometryVerticesOut write fGeometryVerticesOut; | |||||
procedure Compile; | |||||
procedure Enable; | |||||
procedure Disable; | |||||
procedure Add(aShaderObj: TglcShaderObject); | |||||
procedure Delete(aID: Integer; aFreeOwnedObj: Boolean = True); | |||||
procedure Clear; | |||||
function Uniform1f(const aName: String; aP1: GLFloat): Boolean; | |||||
function Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean; | |||||
function Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean; | |||||
function Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean; | |||||
function Uniform1i(const aName: String; aP1: GLint): Boolean; | |||||
function Uniform2i(const aName: String; aP1, aP2: GLint): Boolean; | |||||
function Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean; | |||||
function Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean; | |||||
function Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
function Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
function Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
function Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
function Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
function Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
function Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
function Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
function UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean; | |||||
function UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean; | |||||
function UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean; | |||||
function GetUniformfv(const aName: String; aP: PGLfloat): Boolean; | |||||
function GetUniformfi(const aName: String; aP: PGLint): Boolean; | |||||
function HasUniform(const aName: String): Boolean; | |||||
procedure LoadFromFile(const aFilename: String); | |||||
procedure LoadFromStream(const aStream: TStream); | |||||
procedure SaveToFile(const aFilename: String); | |||||
procedure SaveToStream(const aStream: TStream); | |||||
constructor Create(aLogEvent: TglcShaderLogEvent = nil); | |||||
destructor Destroy; override; | |||||
end; | |||||
implementation | |||||
uses | |||||
RegExpr; | |||||
const | |||||
ERROR_STR_VAR_NAME: String = 'can''t find the variable ''%s'' in the program'; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//glShaderObject//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//ließt das Log eines OpenGL-Objekts aus | |||||
//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll; | |||||
//@result: Log des Objekts; | |||||
function TglcShaderObject.GetInfoLog(aObj: GLHandle): String; | |||||
var | |||||
Msg: PChar; | |||||
bLen, sLen: GLint; | |||||
begin | |||||
bLen := 0; | |||||
glGetShaderiv(aObj, GL_INFO_LOG_LENGTH, @bLen); | |||||
if bLen > 1 then begin | |||||
GetMem(Msg, bLen * SizeOf(Char)); | |||||
glGetShaderInfoLog(aObj, bLen, sLen{%H-}, Msg); | |||||
result := PChar(Msg); | |||||
Dispose(Msg); | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//ließt aus, ob der Shader ohne Fehler kompiliert wurde | |||||
//@result: TRUE wenn ohne Fehler kompiliert, sonst FALSE; | |||||
function TglcShaderObject.GetCompiled: Boolean; | |||||
var | |||||
value: glInt; | |||||
begin | |||||
glGetShaderiv(fShaderObj, GL_COMPILE_STATUS, @value); | |||||
result := (value = GL_TRUE); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//ruft das Log-Event auf, wenn es gesetzt ist | |||||
//@msg: Nachricht die geloggt werden soll; | |||||
procedure TglcShaderObject.Log(const aMsg: String); | |||||
begin | |||||
if Assigned(fOnLog) then begin | |||||
fOnLog(self, aMsg); | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcShaderObject.CreateShaderObj; | |||||
begin | |||||
if (fShaderObj <> 0) then | |||||
exit; | |||||
fShaderObj := glCreateShader(GLenum(fShaderType)); | |||||
if fShaderObj = 0 then | |||||
raise EglcShader.Create('can''t create ShaderObject'); | |||||
Log('shader object created: #'+IntToHex(fShaderObj, 4)); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcShaderObject.AttachTo(const aProgram: TglcShaderProgram); | |||||
begin | |||||
if (aProgram <> fAtachedTo) then begin | |||||
CreateShaderObj; | |||||
glAttachShader(aProgram.ProgramObj, fShaderObj); | |||||
fAttachedTo := aProgram; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//kompiliert das Shader-Objekt | |||||
procedure TglcShaderObject.Compile; | |||||
var | |||||
len, i: GLint; | |||||
List: TStringList; | |||||
c: PAnsiChar; | |||||
begin | |||||
CreateShaderObj; | |||||
len := Length(fCode); | |||||
if len > 0 then begin | |||||
c := PAnsiChar(fCode); | |||||
glShaderSource(fShaderObj, 1, @c, @len); | |||||
glCompileShader(fShaderObj); | |||||
List := TStringList.Create; | |||||
List.Text := GetInfoLog(fShaderObj); | |||||
for i := 0 to List.Count-1 do | |||||
Log(List[i]); | |||||
List.Free; | |||||
end else Log('error while compiling: no bound shader code'); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//erzeugt das Objekt | |||||
//@ShaderType: Typ des Shader-Objekts; | |||||
//@LogEvent: Event zum loggen von Fehlern und Ereignissen; | |||||
//@raise: EglcShader wenn der Shadertyp unbekannt oder ungültig ist; | |||||
constructor TglcShaderObject.Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent); | |||||
begin | |||||
inherited Create; | |||||
fCode := ''; | |||||
fOnLog := aLogEvent; | |||||
fShaderType := aShaderType; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//gibt das Objekt frei | |||||
destructor TglcShaderObject.Destroy; | |||||
begin | |||||
if (fShaderObj <> 0) then | |||||
glDeleteShader(fShaderObj); | |||||
inherited Destroy; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//glShaderProgram/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRIVATE//PRI// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcShaderProgram.GetUniformLocation(const aName: String; out aPos: glInt): Boolean; | |||||
begin | |||||
aPos := glGetUniformLocation(fProgramObj, PChar(aName)); | |||||
result := (aPos <> -1); | |||||
if not result then | |||||
Log(StringReplace(ERROR_STR_VAR_NAME, '%s', aName, [rfIgnoreCase, rfReplaceAll])); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//ließt das Log eines OpenGL-Objekts aus | |||||
//@Obj: Handle des Objekts, dessen Log ausgelesen werden soll; | |||||
//@result: Log des Objekts; | |||||
function TglcShaderProgram.GetInfoLog(Obj: GLHandle): String; | |||||
var | |||||
Msg: PChar; | |||||
bLen, sLen: GLint; | |||||
begin | |||||
bLen := 0; | |||||
glGetProgramiv(Obj, GL_INFO_LOG_LENGTH, @bLen); | |||||
if bLen > 1 then begin | |||||
GetMem(Msg, bLen * SizeOf(Char)); | |||||
glGetProgramInfoLog(Obj, bLen, sLen{%H-}, Msg); | |||||
result := PChar(Msg); | |||||
Dispose(Msg); | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//prüft ob alle Shader ohne Fehler compiliert wurden | |||||
//@result: TRUE wenn alle erfolgreich compiliert, sonst FALSE; | |||||
function TglcShaderProgram.GetCompiled: Boolean; | |||||
var | |||||
i: Integer; | |||||
begin | |||||
result := (Count > 0); | |||||
for i := 0 to Count-1 do | |||||
result := result and Items[i].Compiled; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//prüft ob das Programm ohne Fehler gelinkt wurde | |||||
//@result: TRUE wenn linken erfolgreich, sonst FASLE; | |||||
function TglcShaderProgram.GetLinked: Boolean; | |||||
var | |||||
value: glInt; | |||||
begin | |||||
glGetProgramiv(fProgramObj, GL_LINK_STATUS, @value); | |||||
result := (value = GL_TRUE); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcShaderProgram.CreateProgramObj; | |||||
begin | |||||
if (fProgramObj = 0) then begin | |||||
if GL_LibHandle = nil then | |||||
raise EglcShader.Create('TglShaderProgram.Create - OpenGL not initialized'); | |||||
if (wglGetCurrentContext() = 0) or (wglGetCurrentDC() = 0) then | |||||
raise EglcShader.Create('TglShaderProgram.Create - no valid render context'); | |||||
fProgramObj := glCreateProgram(); | |||||
Log('shader program created: #'+IntToHex(fProgramObj, 4)); | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//ruft das Log-Event auf, wenn es gesetzt ist | |||||
//@msg: Nachricht die geloggt werden soll; | |||||
procedure TglcShaderProgram.Log(const msg: String); | |||||
begin | |||||
if Assigned(fOnLog) then begin | |||||
fOnLog(self, msg); | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcShaderProgram.AttachShaderObj(const aShaderObj: TglcShaderObject); | |||||
begin | |||||
CreateProgramObj; | |||||
aShaderObj.AttachTo(self); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBLIC//PUBL// | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//Kompiliert den Shader-Code | |||||
procedure TglcShaderProgram.Compile; | |||||
var | |||||
i: Integer; | |||||
l: TStringList; | |||||
begin | |||||
CreateProgramObj; | |||||
for i := 0 to Count-1 do begin | |||||
AttachShaderObj(Items[i]); | |||||
Items[i].Compile; | |||||
end; | |||||
glLinkProgram(fProgramObj); | |||||
l := TStringList.Create; | |||||
l.Text := GetInfoLog(fProgramObj); | |||||
for i := 0 to l.Count-1 do | |||||
Log(l[i]); | |||||
l.Free; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//aktiviert den Shader | |||||
procedure TglcShaderProgram.Enable; | |||||
begin | |||||
glUseProgram(fProgramObj); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//deaktiviert den Shader | |||||
procedure TglcShaderProgram.Disable; | |||||
begin | |||||
glUseProgram(0); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//fügt der Liste einen Shader hinzu | |||||
//@ShaderObj: Objekt, das hinzugefügt werden soll; | |||||
procedure TglcShaderProgram.Add(aShaderObj: TglcShaderObject); | |||||
begin | |||||
inherited Add(aShaderObj); | |||||
if (fProgramObj <> 0) then | |||||
AttachShaderObj(aShaderObj); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//löscht ein ShaderObjekt aus der Liste | |||||
//@ID: Index des Objekts, das gelöscht werden soll; | |||||
//@FreeOwnedObj: wenn TRUE wird das gelöschte Objekt freigegeben; | |||||
procedure TglcShaderProgram.Delete(aID: Integer; aFreeOwnedObj: Boolean); | |||||
var | |||||
b: Boolean; | |||||
begin | |||||
if (aID >= 0) and (aID < Count) and (fProgramObj <> 0) then begin | |||||
glDetachShader(fProgramObj, Items[aID].fShaderObj); | |||||
Items[aID].fAttachedTo := nil; | |||||
end; | |||||
b := FreeObjects; | |||||
FreeObjects := aFreeOwnedObj; | |||||
inherited Delete(aID); | |||||
FreeObjects := b; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
procedure TglcShaderProgram.Clear; | |||||
begin | |||||
while (Count > 0) do | |||||
Delete(0); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 1-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform1f(const aName: String; aP1: GLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform1f(pos, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 2-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@p2: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform2f(const aName: String; aP1, aP2: GLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform2f(pos, aP1, aP2); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 3-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@p2: Wert der Variable, der gesetzt werden soll; | |||||
//@p3: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform3f(const aName: String; aP1, aP2, aP3: GLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform3f(pos, aP1, aP2, aP3); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 4-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@p2: Wert der Variable, der gesetzt werden soll; | |||||
//@p3: Wert der Variable, der gesetzt werden soll; | |||||
//@p4: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform4f(const aName: String; aP1, aP2, aP3, aP4: GLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform4f(pos, aP1, aP2, aP3, aP4); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 1-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform1i(const aName: String; aP1: GLint): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform1i(pos, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 2-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform2i(const aName: String; aP1, aP2: GLint): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform2i(pos, aP1, aP2); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 3-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@p2: Wert der Variable, der gesetzt werden soll; | |||||
//@p3: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform3i(const aName: String; aP1, aP2, aP3: GLint): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform3i(pos, aP1, aP2, aP3); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen 4-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@p2: Wert der Variable, der gesetzt werden soll; | |||||
//@p3: Wert der Variable, der gesetzt werden soll; | |||||
//@p4: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform4i(const aName: String; aP1, aP2, aP3, aP4: GLint): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform4i(pos, aP1, aP2, aP3, aP4); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 1-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform1fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform1fv(pos, aCount, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 2-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform2fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform2fv(pos, aCount, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 3-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform3fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform3fv(pos, aCount, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 4-Komponenten Float-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform4fv(const aName: String; aCount: GLint; aP1: PGLFloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform4fv(pos, aCount, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 1-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform1iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform1iv(pos, aCount, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 2-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform2iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform2iv(pos, aCount, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 3-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform3iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform3iv(pos, aCount, aP1); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt einen oder mehrere 4-Komponenten Integer-Vektoren an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@count: Anzahl an Parametern auf die p1 zeigt; | |||||
//@p1: Zeiger auf den ersten Wert der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.Uniform4iv(const aName: String; aCount: GLint; aP1: PGLInt): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniform4iv(pos, aCount, aP1) ; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt eine oder mehrere 2x2-Matrizen an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert; | |||||
//@Count: Anzahl der zu übergebenden Elemente; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.UniformMatrix2fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix2f): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniformMatrix2fv(pos, aCount, aTranspose, PGLfloat(aP1)); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt eine oder mehrere 3x3-Matrizen an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert; | |||||
//@Count: Anzahl der zu übergebenden Elemente; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.UniformMatrix3fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix3f): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniformMatrix3fv(pos, aCount, aTranspose, PGLfloat(aP1)); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//übergibt eine oder mehrere 4x4-Matrizen an den Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gesetzt werden soll; | |||||
//@Transpose: wenn TRUe wird die matrix vor der Übergabe transponiert; | |||||
//@Count: Anzahl der zu übergebenden Elemente; | |||||
//@p1: Wert der Variable, der gesetzt werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.UniformMatrix4fv(const aName: String; aTranspose: Boolean; aCount: GLint; aP1: PgluMatrix4f): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glUniformMatrix4fv(pos, aCount, aTranspose, PGLfloat(aP1)); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//holt den Wert einer Float-Uniform-Variable aus dem Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gelesen werden soll; | |||||
//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.GetUniformfv(const aName: String; aP: PGLfloat): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glGetUniformfv(fProgramObj, pos, aP); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//holt den Wert einer Integer-Uniform-Variable aus dem Shader | |||||
//!!!Der Shader muss dazu aktiviert sein!!! | |||||
//@Name: Name der Variablen die gelesen werden soll; | |||||
//@p: Zeiger auf die Variable, in die der gelesene Wert geschrieben werden soll; | |||||
//@result: TRUE wenn erfolgreich, sonst FALSE (Variablenname konnte nicht aufgelöst werden); | |||||
function TglcShaderProgram.GetUniformfi(const aName: String; aP: PGLint): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
if result then | |||||
glGetUniformiv(fProgramObj, pos, aP); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
function TglcShaderProgram.HasUniform(const aName: String): Boolean; | |||||
var | |||||
pos: GLint; | |||||
begin | |||||
result := GetUniformLocation(aName, pos); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//läd den Shader aus einer Datei | |||||
//@Filename: Datei aus der gelesen werden soll; | |||||
//@raise: EglcShader, wenn Datei nicht vorhanden ist; | |||||
procedure TglcShaderProgram.LoadFromFile(const aFilename: String); | |||||
var | |||||
Stream: TFileStream; | |||||
begin | |||||
if FileExists(aFilename) then begin | |||||
Stream := TFileStream.Create(aFilename, fmOpenRead); | |||||
try | |||||
LoadFromStream(Stream); | |||||
fFilename := aFilename; | |||||
finally | |||||
Stream.Free; | |||||
end; | |||||
end else raise EglcShader.Create('TglShaderProgram.LoadFromFile - file not found: '+Filename); | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//läd den Shader aus einem Stream | |||||
//@Stream: Stream aus dem gelesen werden soll; | |||||
//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde; | |||||
procedure TglcShaderProgram.LoadFromStream(const aStream: TStream); | |||||
function GetShaderType(const aStr: String): TglcShaderType; | |||||
begin | |||||
if (aStr = 'GL_VERTEX_SHADER') then | |||||
result := TglcShaderType.stVertex | |||||
else if (aStr = 'GL_FRAGMENT_SHADER') then | |||||
result := TglcShaderType.stFragment | |||||
else if (aStr = 'GL_GEOMETRY_SHADER') then | |||||
result := TglcShaderType.stGeometry | |||||
else if (aStr = 'GL_TESS_CONTROL_SHADER') then | |||||
result := TglcShaderType.stTessControl | |||||
else if (aStr = 'GL_TESS_EVALUATION_SHADER') then | |||||
result := TglcShaderType.stTessEvaluation | |||||
else | |||||
raise Exception.Create('invalid shader type: ' + aStr); | |||||
end; | |||||
var | |||||
sl: TStringList; | |||||
s: String; | |||||
rx: TRegExpr; | |||||
LastMatchPos: PtrInt; | |||||
st: TglcShaderType; | |||||
o: TglcShaderObject; | |||||
procedure AddObj(const aPos: Integer); | |||||
begin | |||||
if (LastMatchPos > 0) then begin | |||||
o := TglcShaderObject.Create(st, fOnLog); | |||||
o.Code := Trim(Copy(s, LastMatchPos, aPos - LastMatchPos)); | |||||
Add(o); | |||||
end; | |||||
end; | |||||
begin | |||||
if not Assigned(aStream) then | |||||
raise EglcShader.Create('TglShaderProgram.SaveToStream - stream is nil'); | |||||
Clear; | |||||
sl := TStringList.Create; | |||||
rx := TRegExpr.Create; | |||||
try | |||||
sl.LoadFromStream(aStream); | |||||
s := sl.Text; | |||||
LastMatchPos := 0; | |||||
rx.Expression := '/\*\s*ShaderObject\s*:\s*(GL_[A-Z_]+)\s*\*/\s*$?'; | |||||
rx.InputString := s; | |||||
while rx.Exec(LastMatchPos+1) do begin | |||||
AddObj(rx.MatchPos[0]); | |||||
LastMatchPos := rx.MatchPos[0] + rx.MatchLen[0]; | |||||
st := GetShaderType(rx.Match[1]); | |||||
end; | |||||
AddObj(Length(s)); | |||||
finally | |||||
rx.Free; | |||||
sl.Free; | |||||
end; | |||||
{ | |||||
if Assigned(aStream) then begin | |||||
Clear; | |||||
fFilename := ''; | |||||
reader := TutlStreamReader.Create(aStream); | |||||
try | |||||
if reader.ReadAnsiString <> GLSL_FILE_HEADER then | |||||
raise EglcShader.Create('TglShaderProgram.SaveToStream - incompatible file'); | |||||
v := reader.ReadInteger; | |||||
if v >= 100 then begin //version 1.00 | |||||
c := reader.ReadInteger; | |||||
for i := 0 to c-1 do begin | |||||
Add(TglcShaderObject.Create(Cardinal(reader.ReadInteger), fOnLog)); | |||||
Last.fCode := reader.ReadAnsiString; | |||||
end; | |||||
end; | |||||
finally | |||||
reader.Free; | |||||
end; | |||||
end else | |||||
} | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//speichert den Shader in einer Datei | |||||
//@Filename: Datei in die geschrieben werden soll; | |||||
procedure TglcShaderProgram.SaveToFile(const aFilename: String); | |||||
var | |||||
Stream: TFileStream; | |||||
begin | |||||
Stream := TFileStream.Create(aFilename, fmCreate); | |||||
try | |||||
SaveToStream(Stream); | |||||
fFilename := aFilename; | |||||
finally | |||||
Stream.Free; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//speichert den Shader in einen Stream | |||||
//@Stream: Stream in den geschrieben werden soll; | |||||
//@raise: EglcShader wenn kein Stream-Objekt übergeben wurde; | |||||
//@raise: EglcShader wenn ungültige Datei; | |||||
procedure TglcShaderProgram.SaveToStream(const aStream: TStream); | |||||
var | |||||
i: Integer; | |||||
sl: TStringList; | |||||
sObj: TglcShaderObject; | |||||
function GetShaderTypeStr(const aShaderType: TglcShaderType): String; | |||||
begin | |||||
case aShaderType of | |||||
TglcShaderType.stVertex: result := 'GL_VERTEX_SHADER'; | |||||
TglcShaderType.stFragment: result := 'GL_FRAGMENT_SHADER'; | |||||
TglcShaderType.stGeometry: result := 'GL_GEOMETRY_SHADER'; | |||||
TglcShaderType.stTessControl: result := 'GL_TESS_CONTROL_SHADER'; | |||||
TglcShaderType.stTessEvaluation: result := 'GL_TESS_EVALUATION_SHADER'; | |||||
else | |||||
result := 'UNKNOWN'; | |||||
end; | |||||
end; | |||||
begin | |||||
if not Assigned(aStream) then | |||||
raise EglcShader.Create('TglShaderProgram.LoadFromStream - stream is nil'); | |||||
fFilename := ''; | |||||
sl := TStringList.Create; | |||||
try | |||||
for i := 0 to Count-1 do begin | |||||
sObj := Items[i]; | |||||
sl.Add('/* ShaderObject: ' + GetShaderTypeStr(sObj.ShaderType) + ' */'); | |||||
sl.Add(sObj.Code); | |||||
end; | |||||
sl.SaveToStream(aStream); | |||||
finally | |||||
sl.Free; | |||||
end; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//erzeugt das Objekt | |||||
//@LogEvent: Event zum loggen von Fehlern und Ereignissen; | |||||
//@raise: EglcShader wenn OpenGL nicht initialisiert werden konnte; | |||||
//@raise: | |||||
constructor TglcShaderProgram.Create(aLogEvent: TglcShaderLogEvent); | |||||
begin | |||||
inherited Create; | |||||
fOnLog := aLogEvent; | |||||
fFilename := ''; | |||||
fProgramObj := 0; | |||||
end; | |||||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||||
//gibt das Objekt frei | |||||
destructor TglcShaderProgram.Destroy; | |||||
begin | |||||
if (fProgramObj <> 0) then | |||||
glDeleteProgram(fProgramObj); | |||||
inherited Destroy; | |||||
end; | |||||
end. | |||||
@@ -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. | |||||
@@ -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. | |||||
@@ -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. | |||||