* Initial Commit

uglcArrayBuffer.pas

@@ -0,0 +1,105 @@
+unit uglcArrayBuffer;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Array Buffer }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  dglOpenGL, sysutils, uglcTypes;
+
+type
+  EglcArrayBuffer = class(Exception);
+  TglcArrayBuffer = class(TObject)
+  private
+    fID: GLuint;
+    fTarget: TglcBufferTarget;
+    fUsage: TglcBufferUsage;
+  protected
+    fDataCount: Integer;
+    fDataSize: Integer;
+  public
+    property ID:        gluInt           read fID;
+    property Target:    TglcBufferTarget read fTarget;
+    property Usage:     TglcBufferUsage  read fUsage;
+    property DataCount: Integer          read fDataCount;
+    property DataSize:  Integer          read fDataSize;
+
+    procedure BufferData(const aDataCount, aDataSize: Cardinal; const aUsage: TglcBufferUsage; const aData: Pointer);
+    function MapBuffer(const aAccess: TglcBufferAccess): Pointer;
+    procedure UnmapBuffer;
+    procedure Bind;
+    procedure Unbind;
+    constructor Create(const aTarget: TglcBufferTarget);
+    destructor Destroy; override;
+  end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcArrayBuffer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.BufferData(const aDataCount, aDataSize: Cardinal; const aUsage: TglcBufferUsage; const aData: Pointer);
+begin
+  glGetError(); //clear Errors
+  Bind;
+  fDataCount := aDataCount;
+  fDataSize  := aDataSize;
+  fUsage     := aUsage;
+  glBufferData(GLenum(fTarget), fDataCount * fDataSize, aData, GLenum(fUsage));
+  glcCheckAndRaiseError;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+function TglcArrayBuffer.MapBuffer(const aAccess: TglcBufferAccess): Pointer;
+begin
+  glGetError();
+  result := nil;
+  if (fDataCount * fDataSize) <= 0 then
+    exit;
+  result := glMapBuffer(GLenum(fTarget), GLenum(aAccess));
+  glcCheckAndRaiseError;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.UnmapBuffer;
+begin
+  glUnmapBuffer(GLenum(fTarget));
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.Bind;
+begin
+  glBindBuffer(GLenum(fTarget), fID);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+procedure TglcArrayBuffer.Unbind;
+begin
+  glBindBuffer(GLenum(fTarget), 0);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+constructor TglcArrayBuffer.Create(const aTarget: TglcBufferTarget);
+begin
+  if not GL_ARB_Vertex_Buffer_Object then
+    raise EglcArrayBuffer.Create('Create - VertexBuffer: not supported');
+  inherited Create;
+  glGenBuffers(1, @fID);
+  fDataCount   := 0;
+  fDataSize    := 0;
+  fTarget      := aTarget;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////[c]
+destructor TglcArrayBuffer.Destroy;
+begin
+  glDeleteBuffers(1, @fID);
+  inherited Destroy;
+end;
+
+end.
+

uglcCamera.pas

@@ -0,0 +1,254 @@
+unit uglcCamera;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung für OpenGL Frustum und Kamera }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  ugluVector, ugluMatrix;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TglcFrustum = class(TObject)
+  private
+    function GetWidth: Single;
+    function GetHeight: Single;
+    function GetFOVAngle: Single;
+    function GetAspectRatio: Single;
+  protected
+    fIsOrthogonal: Boolean;
+    fTop, fBottom, fLeft, fRight, fNear, fFar: Single;
+  public
+    property Top         : Single  read fTop;
+    property Bottom      : Single  read fBottom;
+    property Left        : Single  read fLeft;
+    property Right       : Single  read fRight;
+    property Near        : Single  read fNear;
+    property Far         : Single  read fFar;
+    property Width       : Single  read GetWidth;
+    property Height      : Single  read GetHeight;
+    property FOVAngle    : Single  read GetFOVAngle;
+    property AspectRatio : Single  read GetAspectRatio;
+    property IsOrthogonal: Boolean read fIsOrthogonal;
+
+    procedure Frustum(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+    procedure Perspective(const aFOVAngle, aAspectRatio, aNear, aFar: Single);
+    procedure Ortho(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+    procedure Activate;
+    procedure Render;
+
+    constructor Create;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TglcCamera = class(TglcFrustum)
+  private
+    fPosition: TgluMatrix4f;
+  public
+    property Position: TgluMatrix4f read fPosition write fPosition;
+
+    procedure Move(const aVec: TgluVector3f);
+    procedure Tilt(const aAngle: Single);
+    procedure Turn(const aAngle: Single);
+    procedure Roll(const aAngle: Single);
+    procedure Activate;
+    function GetRay(const aPos: TgluVector2f): TgluRayf;
+
+    constructor Create;
+  end;
+
+implementation
+
+uses
+  Math, dglOpenGL;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcFrustum///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetWidth: Single;
+begin
+  result := (fRight - fLeft);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetHeight: Single;
+begin
+  result := (fTop - fBottom);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetFOVAngle: Single;
+begin
+  result := arctan2(Height/2, fNear)/Pi*360;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcFrustum.GetAspectRatio: Single;
+begin
+  result := Height / Width;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Frustum(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+begin
+  fIsOrthogonal := false;
+  fTop          := aRight;
+  fBottom       := aLeft;
+  fLeft         := aBottom;
+  fRight        := aTop;
+  fNear         := aNear;
+  fFar          := aFar;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Perspective(const aFOVAngle, aAspectRatio, aNear, aFar: Single);
+begin
+  fIsOrthogonal := false;
+  fNear         := aNear;
+  fFar          := aFar;
+  fTop          := fNear * tan(aFOVAngle / 360 * Pi);
+  fBottom       := -fTop;
+  fRight        := aAspectRatio * fTop;
+  fLeft         := -fRight;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Ortho(const aLeft, aRight, aBottom, aTop, aNear, aFar: Single);
+begin
+  fIsOrthogonal := true;
+  fLeft         := aLeft;
+  fRight        := aRight;
+  fTop          := aTop;
+  fBottom       := aBottom;
+  fNear         := aNear;
+  fFar          := aFar;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Activate;
+begin
+  glMatrixMode(GL_PROJECTION);
+  glLoadIdentity;
+  if fIsOrthogonal then
+    glOrtho(fLeft, fRight, fBottom, fTop, fNear, fFar)
+  else
+    glFrustum(fLeft, fRight, fBottom, fTop, fNear, fFar);
+  glMatrixMode(GL_MODELVIEW);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcFrustum.Render;
+var
+  min, max: TgluVector2f;
+begin
+  min[0] := fLeft   / fNear * fFar;
+  min[1] := fBottom / fNear * fFar;
+  max[0] := fRight  / fNear * fFar;
+  max[1] := fTop    / fNear * fFar;
+
+  glBegin(GL_LINE_LOOP);
+    glVertex3f(fLeft, fTop, -fNear);
+    glVertex3f(fLeft, fBottom, -fNear);
+    glVertex3f(fRight, fBottom, -fNear);
+    glVertex3f(fRight, fTop, -fNear);
+  glEnd;
+
+  glBegin(GL_LINE_LOOP);
+    glVertex3f(min[0], min[0], -fFar);
+    glVertex3f(min[0], max[0], -fFar);
+    glVertex3f(max[0], max[0], -fFar);
+    glVertex3f(max[0], min[0], -fFar);
+  glEnd;
+
+  glBegin(GL_LINES);
+    glVertex3f(0, 0, 0); glVertex3f(min[0], min[0], -fFar);
+    glVertex3f(0, 0, 0); glVertex3f(min[0], max[0], -fFar);
+    glVertex3f(0, 0, 0); glVertex3f(max[0], max[0], -fFar);
+    glVertex3f(0, 0, 0); glVertex3f(max[0], min[0], -fFar);
+  glEnd;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcFrustum.Create;
+begin
+  inherited Create;
+  fTop    := 0;
+  fBottom := 0;
+  fLeft   := 0;
+  fRight  := 0;
+  fNear   := 0;
+  fFar    := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcCamera////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Move(const aVec: TgluVector3f);
+begin
+  fPosition := gluMatrixMult(gluMatrixTranslate(aVec), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Tilt(const aAngle: Single);
+begin
+  fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(1,0,0), aAngle), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Turn(const aAngle: Single);
+begin
+  fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(0,1,0), aAngle), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Roll(const aAngle: Single);
+begin
+  fPosition := gluMatrixMult(gluMatrixRotate(gluVector3f(0,0,1), aAngle), fPosition);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcCamera.Activate;
+begin
+  inherited Activate;
+  glLoadMatrixf(@fPosition[0, 0]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcCamera.GetRay(const aPos: TgluVector2f): TgluRayf;
+var
+  p: TgluVector3f;
+begin
+  if (aPos[0] < 0) then
+    p[0] := -aPos[0] * fLeft
+  else
+    p[0] := aPos[0] * fRight;
+  if (aPos[1] < 0) then
+    p[1] := -aPos[1] * fBottom
+  else
+    p[1] := aPos[1] * fTop;
+  if (fIsOrthogonal) then begin
+    p[2] := 0;
+    result.p := fPosition * p;
+    result.v := fPosition * gluVector3f(0, 0, -1);
+  end else begin
+    p[2] := -fNear;
+    result.p := gluVector3f(0, 0, 0);
+    result.v := fPosition * p;
+  end;
+  result := gluRayNormalize(result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcCamera.Create;
+begin
+  inherited Create;
+  fPosition := gluMatrixIdentity;
+end;
+
+end.
+

uglcFrameBufferObject.pas

@@ -0,0 +1,622 @@
+unit uglcFrameBufferObject;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL FrameBufferObjekte }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fgl, dglOpenGl, uglcTypes;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TglcBufferType = (btRenderBuffer, btTextureBuffer);
+  TglcBuffer = class(TObject)
+  private
+    fBufferType: TglcBufferType;
+    fWidth: Integer;
+    fHeight: Integer;
+
+    procedure SetWidth(const aValue: Integer);
+    procedure SetHeight(const aValue: Integer);
+  public
+    property Width : Integer read fWidth  write SetWidth;
+    property Height: Integer read fHeight write SetHeight;
+    property BufferType: TglcBufferType read fBufferType;
+
+    procedure SetSize(const aWidth, aHeight: Integer); virtual;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  EglcRenderBuffer = class(Exception);
+  TglcRenderBuffer = class(TglcBuffer)
+  private
+    fID: gluInt;
+    fFormat: TglcInternalFormat;
+
+    procedure UpdateRenderBufferStorage;
+    procedure SetFormat(const aValue: TglcInternalFormat);
+  public
+    property ID:     gluInt             read fID;
+    property Format: TglcInternalFormat read fFormat write SetFormat;
+
+    procedure SetSize(const aWidth, aHeight: Integer); override;
+    procedure Bind;
+    procedure Unbind;
+
+    constructor Create(const aFormat: TglcInternalFormat);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  EglcTextureBuffer = class(exception);
+  TglcTextureBuffer = class(TglcBuffer)
+  private
+    fID: GLuint;
+    fFormat: TglcFormat;
+    fInternalFormat: TglcInternalFormat;
+    fBorder: Boolean;
+
+    procedure UpdateTexImage;
+    procedure SetFormat(const aValue: TglcFormat);
+    procedure SetInternalFormat(const aValue: TglcInternalFormat);
+    procedure SetBorder(const aValue: Boolean);
+  public
+    property ID            : GLuint             read fID;
+    property Border        : Boolean            read fBorder         write SetBorder;
+    property Format        : TglcFormat         read fFormat         write SetFormat;
+    property InternalFormat: TglcInternalFormat read fInternalFormat write SetInternalFormat;
+
+    procedure SetSize(const aWidth, aHeight: Integer); override;
+    procedure Bind(const aEnableTextureUnit: Boolean = true);
+    procedure Unbind(const aDisableTextureUnit: Boolean = true);
+
+    constructor Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  EglcFrameBufferObject = class(Exception);
+  TglcFrameBufferObject = class(TObject)
+  private type
+    TglcAttachmentContainer = class(TObject)
+      Buffer: TglcBuffer;
+      Attachment: TglcAttachment;
+      OwnsObject: Boolean;
+      constructor Create(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsObject: Boolean = true);
+      destructor Destroy; override;
+    end;
+    TglcAttachmentContainerList = specialize TFPGObjectList<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.
+

uglcLight.pas

@@ -0,0 +1,424 @@
+unit uglcLight;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Licht- und Material-Objekte }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, dglOpenGL, ugluVector, uglcTypes;
+
+type
+  TglcMaterialRec = packed record
+    Ambient: TgluVector4f;
+    Diffuse: TgluVector4f;
+    Specular: TgluVector4f;
+    Emission: TgluVector4f;
+    Shininess: GLfloat;
+  end;
+  PglcMaterialRec = ^TglcMaterialRec;
+
+  TglcLightType = (ltGlobal, ltPoint, ltSpot);
+  TglcLightRec = packed record
+    Ambient: TgluVector4f;
+    Diffuse: TgluVector4f;
+    Specular: TgluVector4f;
+    Position: TgluVector4f;
+    SpotDirection: TgluVector3f;
+    SpotExponent: GLfloat;
+    SpotCutoff: GLfloat;
+    ConstantAtt: GLfloat;
+    LinearAtt: GLfloat;
+    QuadraticAtt: GLfloat;
+  end;
+  PglcLightRec = ^TglcLightRec;
+
+const
+  MAT_DEFAULT_AMBIENT:   TgluVector4f = (0.2, 0.2, 0.2, 1.0);
+  MAT_DEFAULT_DIFFUSE:   TgluVector4f = (0.8, 0.8, 0.8, 1.0);
+  MAT_DEFAULT_SPECULAR:  TgluVector4f = (0.5, 0.5, 0.5, 1.0);
+  MAT_DEFAULT_EMISSION:  TgluVector4f = (0.0, 0.0, 0.0, 1.0);
+  MAT_DEFAULT_SHININESS: GLfloat      =  50.0;
+
+  LIGHT_DEFAULT_AMBIENT:        TgluVector4f = (0.4, 0.4, 0.4, 1.0);
+  LIGHT_DEFAULT_DIFFUSE:        TgluVector4f = (0.7, 0.7, 0.7, 1.0);
+  LIGHT_DEFAULT_SPECULAR:       TgluVector4f = (0.9, 0.9, 0.9, 1.0);
+  LIGHT_DEFAULT_POSITION:       TgluVector4f = (0.0, 0.0, 1.0, 0.0);
+  LIGHT_DEFAULT_SPOT_DIRECTION: TgluVector3f = (0.0, 0.0, -1.0);
+  LIGHT_DEFAULT_SPOT_EXPONENT:  GLfloat      =   0.0;
+  LIGHT_DEFAULT_SPOT_CUTOFF:    GLfloat      = 180.0;
+  LIGHT_DEFAULT_CONSTANT_ATT:   GLfloat      =   1.0;
+  LIGHT_DEFAULT_LINEAR_ATT:     GLfloat      =   0.0;
+  LIGHT_DEFAULT_QUADRATIC_ATT:  GLfloat      =   0.0;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TglcMaterial = class(TObject)
+  private
+    fData: TglcMaterialRec;
+  public
+    property Diffuse:   TgluVector4f      read fData.Diffuse   write fData.Diffuse;
+    property Ambient:   TgluVector4f      read fData.Ambient   write fData.Ambient;
+    property Specular:  TgluVector4f      read fData.Specular  write fData.Specular;
+    property Emission:  TgluVector4f      read fData.Emission  write fData.Emission;
+    property Shininess: GLfloat           read fData.Shininess write fData.Shininess;
+    property Data:      TglcMaterialRec   read fData           write fData;
+
+    procedure Bind(const aFace: TglcFace);
+
+    class procedure Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
+    class function DefaultValues: TglcMaterialRec;
+
+    constructor Create;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  EglcLight = class(Exception);
+  TglcLight = class(TObject)
+  private
+    function GetDataPtr: PglcLightRec;
+  protected
+    fData: TglcLightRec;
+
+    procedure SetAmbient      (const aValue: TgluVector4f);   virtual;
+    procedure SetDiffuse      (const aValue: TgluVector4f);   virtual;
+    procedure SetSpecular     (const aValue: TgluVector4f);   virtual;
+    procedure SetPosition4f   (const aValue: TgluVector4f);   virtual;
+    procedure SetSpotDirection(const aValue: TgluVector3f);   virtual;
+    procedure SetSpotExponent (const aValue: GLfloat);        virtual;
+    procedure SetSpotCutoff   (const aValue: GLfloat);        virtual;
+    procedure SetConstantAtt  (const aValue: GLfloat);        virtual;
+    procedure SetLinearAtt    (const aValue: GLfloat);        virtual;
+    procedure SetQuadraticAtt (const aValue: GLfloat);        virtual;
+    procedure SetData         (const aValue: TglcLightRec);   virtual;
+
+    property Ambient:       TgluVector4f   read fData.Ambient       write SetAmbient;
+    property Diffuse:       TgluVector4f   read fData.Diffuse       write SetDiffuse;
+    property Specular:      TgluVector4f   read fData.Specular      write SetSpecular;
+    property Position4f:    TgluVector4f   read fData.Position      write SetPosition4f;
+    property SpotDirection: TgluVector3f   read fData.SpotDirection write SetSpotDirection;
+    property SpotExponent:  GLfloat        read fData.SpotExponent  write SetSpotExponent;
+    property SpotCutoff:    GLfloat        read fData.SpotCutoff    write SetSpotCutoff;
+    property ConstantAtt:   GLfloat        read fData.ConstantAtt   write SetConstantAtt;
+    property LinearAtt:     GLfloat        read fData.LinearAtt     write SetLinearAtt;
+    property QuadraticAtt:  GLfloat        read fData.QuadraticAtt  write SetQuadraticAtt;
+  public
+    property Data:    TglcLightRec read fData write SetData;
+    property DataPtr: PglcLightRec read GetDataPtr;
+
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); virtual; abstract;
+
+    class procedure Bind(const aLightID: GLenum; const aLight: TglcLightRec;
+      const aEnableLighting: Boolean; const aLightType: TglcLightType);
+    class procedure Unbind(const aLightID: GLenum; const aDisableLighting: Boolean = true);
+    class function DefaultValues: TglcLightRec; virtual;
+
+    constructor Create;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TglcLightGlobal = class(TglcLight)
+  private
+    function GetDirection: TgluVector3f;
+    procedure SetDirection(aValue: TgluVector3f);
+  public
+    property Ambient;
+    property Diffuse;
+    property Specular;
+    property Direction: TgluVector3f read GetDirection write SetDirection;
+
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TglcLightPoint = class(TglcLight)
+  private
+    fMaxSize: Single;
+    fSizeFactor: Single;
+    function GetPosition: TgluVector3f;
+    procedure SetPosition(const aValue: TgluVector3f);
+  protected
+    procedure SetMaxSize   (const aValue: Single); virtual;
+    procedure SetSizeFactor(const aValue: Single); virtual;
+  public
+    property Ambient;
+    property Diffuse;
+    property Specular;
+    property ConstantAtt;
+    property LinearAtt;
+    property QuadraticAtt;
+    property MaxSize:    Single       read fMaxSize    write SetMaxSize;
+    property SizeFactor: Single       read fSizeFactor write SetSizeFactor;
+    property Position:   TgluVector3f read GetPosition write SetPosition;
+
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
+
+    constructor Create;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TglcLightSpot = class(TglcLightPoint)
+  public
+    property SpotCutoff;
+    property SpotDirection;
+    property SpotExponent;
+
+    procedure Bind(const aLightID: GLenum; const aEnableLighting: Boolean = false); override;
+  end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcMaterial//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcMaterial.Bind(const aFace: TglcFace);
+begin
+  Bind(aFace, fData);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TglcMaterial.Bind(const aFace: TglcFace; const aMaterial: TglcMaterialRec);
+begin
+  glMaterialfv(GLenum(aFace), GL_AMBIENT,   @aMaterial.Ambient[0]);
+  glMaterialfv(GLenum(aFace), GL_DIFFUSE,   @aMaterial.Diffuse[0]);
+  glMaterialfv(GLenum(aFace), GL_EMISSION,  @aMaterial.Emission[0]);
+  glMaterialfv(GLenum(aFace), GL_SPECULAR,  @aMaterial.Specular[0]);
+  glMaterialfv(GLenum(aFace), GL_SHININESS, @aMaterial.Shininess);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TglcMaterial.DefaultValues: TglcMaterialRec;
+begin
+  result.Ambient   := MAT_DEFAULT_AMBIENT;
+  result.Diffuse   := MAT_DEFAULT_DIFFUSE;
+  result.Specular  := MAT_DEFAULT_SPECULAR;
+  result.Emission  := MAT_DEFAULT_EMISSION;
+  result.Shininess := MAT_DEFAULT_SHININESS;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcMaterial.Create;
+begin
+  inherited Create;
+  fData := DefaultValues;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLight/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcLight.GetDataPtr: PglcLightRec;
+begin
+  result := @fData;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetAmbient(const aValue: TgluVector4f);
+begin
+  fData.Ambient := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetDiffuse(const aValue: TgluVector4f);
+begin
+  fData.Diffuse := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpecular(const aValue: TgluVector4f);
+begin
+  fData.Specular := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetPosition4f(const aValue: TgluVector4f);
+begin
+  fData.Position := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetConstantAtt(const aValue: GLfloat);
+begin
+  fData.ConstantAtt := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetLinearAtt(const aValue: GLfloat);
+begin
+  fData.LinearAtt := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetQuadraticAtt(const aValue: GLfloat);
+begin
+  fData.QuadraticAtt := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpotDirection(const aValue: TgluVector3f);
+begin
+  fData.SpotDirection := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpotExponent(const aValue: GLfloat);
+begin
+  fData.SpotExponent := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetSpotCutoff(const aValue: GLfloat);
+begin
+  fData.SpotCutoff := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLight.SetData(const aValue: TglcLightRec);
+begin
+  fData := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TglcLight.Bind(const aLightID: GLenum; const aLight: TglcLightRec;
+  const aEnableLighting: Boolean; const aLightType: TglcLightType);
+begin
+  glEnable(aLightID);
+  if (aEnableLighting) then
+    glEnable(GL_LIGHTING);
+
+  if (aLightType in [ltGlobal, ltPoint, ltSpot]) then begin
+    glLightfv(aLightID, GL_AMBIENT,  @aLight.Ambient[0]);
+    glLightfv(aLightID, GL_DIFFUSE,  @aLight.Diffuse[0]);
+    glLightfv(aLightID, GL_SPECULAR, @aLight.Specular[0]);
+    glLightfv(aLightID, GL_POSITION, @aLight.Position[0]);
+  end else begin
+    glLightfv(aLightID, GL_AMBIENT,  @LIGHT_DEFAULT_AMBIENT[0]);
+    glLightfv(aLightID, GL_DIFFUSE,  @LIGHT_DEFAULT_DIFFUSE[0]);
+    glLightfv(aLightID, GL_SPECULAR, @LIGHT_DEFAULT_SPECULAR[0]);
+    glLightfv(aLightID, GL_POSITION, @LIGHT_DEFAULT_POSITION[0]);
+  end;
+
+  if (aLightType in [ltPoint, ltSpot]) then begin
+    glLightfv(aLightID, GL_CONSTANT_ATTENUATION,  @aLight.ConstantAtt);
+    glLightfv(aLightID, GL_LINEAR_ATTENUATION,    @aLight.LinearAtt);
+    glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @aLight.QuadraticAtt);
+  end else begin
+    glLightfv(aLightID, GL_CONSTANT_ATTENUATION,  @LIGHT_DEFAULT_CONSTANT_ATT);
+    glLightfv(aLightID, GL_LINEAR_ATTENUATION,    @LIGHT_DEFAULT_LINEAR_ATT);
+    glLightfv(aLightID, GL_QUADRATIC_ATTENUATION, @LIGHT_DEFAULT_QUADRATIC_ATT);
+  end;
+
+  if (aLightType in [ltSpot]) then begin
+    glLightfv(aLightID, GL_SPOT_DIRECTION, @aLight.SpotDirection[0]);
+    glLightfv(aLightID, GL_SPOT_EXPONENT,  @aLight.SpotExponent);
+    glLightfv(aLightID, GL_SPOT_CUTOFF,    @aLight.SpotCutoff);
+  end else begin
+    glLightfv(aLightID, GL_SPOT_DIRECTION, @LIGHT_DEFAULT_SPOT_DIRECTION[0]);
+    glLightfv(aLightID, GL_SPOT_EXPONENT,  @LIGHT_DEFAULT_SPOT_EXPONENT);
+    glLightfv(aLightID, GL_SPOT_CUTOFF,    @LIGHT_DEFAULT_SPOT_CUTOFF);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TglcLight.Unbind(const aLightID: GLenum; const aDisableLighting: Boolean);
+begin
+  glDisable(aLightID);
+  if aDisableLighting then
+    glDisable(GL_LIGHTING);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TglcLight.DefaultValues: TglcLightRec;
+begin
+  result.Ambient       := LIGHT_DEFAULT_AMBIENT;
+  result.Diffuse       := LIGHT_DEFAULT_DIFFUSE;
+  result.Specular      := LIGHT_DEFAULT_SPECULAR;
+  result.Position      := LIGHT_DEFAULT_POSITION;
+  result.SpotDirection := LIGHT_DEFAULT_SPOT_DIRECTION;
+  result.SpotExponent  := LIGHT_DEFAULT_SPOT_EXPONENT;
+  result.SpotCutoff    := LIGHT_DEFAULT_SPOT_CUTOFF;
+  result.ConstantAtt   := LIGHT_DEFAULT_CONSTANT_ATT;
+  result.LinearAtt     := LIGHT_DEFAULT_LINEAR_ATT;
+  result.QuadraticAtt  := LIGHT_DEFAULT_QUADRATIC_ATT;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcLight.Create;
+begin
+  inherited Create;
+  fData  := DefaultValues;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLightGlobal///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcLightGlobal.GetDirection: TgluVector3f;
+begin
+  result := gluVector3f(Position4f);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightGlobal.SetDirection(aValue: TgluVector3f);
+begin
+  Position4f := gluVector4f(aValue, 0.0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightGlobal.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
+begin
+  TglcLight.Bind(aLightID, fData, aEnableLighting, ltGlobal);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLightPoint////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TglcLightPoint.GetPosition: TgluVector3f;
+begin
+  result := gluVector3f(fData.Position);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.SetPosition(const aValue: TgluVector3f);
+begin
+  SetPosition4f(gluVector4f(aValue, 1.0));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.SetMaxSize(const aValue: Single);
+begin
+  fMaxSize := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.SetSizeFactor(const aValue: Single);
+begin
+  fSizeFactor := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightPoint.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
+begin
+  TglcLight.Bind(aLightID, fData, aEnableLighting, ltPoint);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TglcLightPoint.Create;
+begin
+  inherited Create;
+  Position    := gluVector3f(0.0, 0.0, 0.0);
+  fMaxSize    := 0;
+  fSizeFactor := 1.0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TglcLightSpot/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TglcLightSpot.Bind(const aLightID: GLenum; const aEnableLighting: Boolean);
+begin
+  TglcLight.Bind(aLightID, fData, aEnableLighting, ltSpot);
+end;
+
+end.
+

uglcShader.pas

@@ -0,0 +1,931 @@
+unit uglcShader;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL Shader Objekte }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fgl, dglOpenGL, uglcTypes, ugluMatrix;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  EglcShader = class(Exception);
+  TglcShaderProgram = class;
+  TglcShaderLogEvent = procedure(aSender: TObject; const aMsg: String) of Object;
+  TglcShaderObject = class(TObject)
+  private
+    fAtachedTo: TglcShaderProgram;
+    fShaderObj: GLHandle;
+    fShaderType: TglcShaderType;
+    fCode: String;
+    fOnLog: TglcShaderLogEvent;
+    fAttachedTo: TglcShaderProgram;
+
+    function GetInfoLog(aObj: GLHandle): String;
+    function GetCompiled: Boolean;
+    procedure Log(const aMsg: String);
+    procedure CreateShaderObj;
+    procedure AttachTo(const aProgram: TglcShaderProgram);
+  public
+    property ShaderObj : GLHandle           read fShaderObj;
+    property ShaderType: TglcShaderType     read fShaderType;
+    property Compiled:   Boolean            read GetCompiled;
+    property AtachedTo:  TglcShaderProgram  read fAtachedTo;
+    property Code:       String             read fCode  write fCode;
+    property OnLog:      TglcShaderLogEvent read fOnLog write fOnLog;
+
+    procedure Compile;
+
+    constructor Create(const aShaderType: TglcShaderType; const aLogEvent: TglcShaderLogEvent = nil);
+    destructor Destroy; override;
+  end;
+  TglcShaderObjectList = specialize TFPGObjectList<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.
+

uglcTypes.pas

@@ -0,0 +1,318 @@
+unit uglcTypes;
+
+{ Package:      OpenGLCore
+  Prefix:       glc - OpenGL Core
+  Beschreibung: diese Unit definiert Enum-Typen die OpenGL Konstanten wrappen und stellt zusätzlich
+                Funktions-Wrapper zur verfügung die diese Enum-Typen als Parameter entgegen nehmen }
+
+{$mode objfpc}{$H+}
+{$MACRO ON}
+{$SCOPEDENUMS ON}
+
+interface
+
+uses
+  dglOpenGL, sysutils;
+
+type
+  TglcFace = (
+    faFront = GL_FRONT,
+    faBack  = GL_BACK,
+    faBoth  = GL_FRONT_AND_BACK);
+
+  TglcPolygonMode = (
+    pmPoint = GL_POINT,
+    pmLine  = GL_LINE,
+    pmFill  = GL_FILL);
+
+  TglcDepthFunc = (
+    dfNever         = GL_NEVER,
+    dfLess          = GL_LESS,
+    dfEqual         = GL_EQUAL,
+    dfLessEqual     = GL_LEQUAL,
+    dfGreater       = GL_GREATER,
+    dfNotEqual      = GL_NOTEQUAL,
+    dfGreaterEqual  = GL_GEQUAL,
+    dfAlways        = GL_ALWAYS);
+
+  TglcClearBuffer = (
+    cbDepthBuffer   = GL_DEPTH_BUFFER_BIT,
+    cbAccumBuffer   = GL_ACCUM_BUFFER_BIT,
+    cbStencilBuffer = GL_STENCIL_BUFFER_BIT,
+    cbColorBuffer   = GL_COLOR_BUFFER_BIT);
+
+  TglcTextureMinFilter = (
+    mfNearest              = GL_NEAREST,
+    mfLinear               = GL_LINEAR,
+    mfNearestMipmapNearest = GL_NEAREST_MIPMAP_NEAREST,
+    mfLinearMipmapNearest  = GL_LINEAR_MIPMAP_NEAREST,
+    mfNearestMipmapLinear  = GL_NEAREST_MIPMAP_LINEAR,
+    mfLinearMipmapLinear   = GL_LINEAR_MIPMAP_LINEAR);
+
+  TglcTextureMagFilter = (
+    mfNearest = GL_NEAREST,
+    mfLinear  = GL_LINEAR);
+
+  TglcTextureWrap = (
+    twClamp          = GL_CLAMP,
+    twRepeat         = GL_REPEAT,
+    twClampToBorder  = GL_CLAMP_TO_BORDER,
+    twClampToEdge    = GL_CLAMP_TO_EDGE,
+    twMirroredRepeat = GL_MIRRORED_REPEAT);
+
+  TglcBlendFactor = (
+    bfZero               = GL_ZERO,
+    bfOne                = GL_ONE,
+    bfSrcColor           = GL_SRC_COLOR,
+    bfOneMinusSrcColor   = GL_ONE_MINUS_SRC_COLOR,
+    bfSrcAlpha           = GL_SRC_ALPHA,
+    bfOneMinusSrcAlpha   = GL_ONE_MINUS_SRC_ALPHA,
+    bfDstAlpha           = GL_DST_ALPHA,
+    bfOneMinusDstAlpha   = GL_ONE_MINUS_DST_ALPHA,
+    bfDstColor           = GL_DST_COLOR,
+    bfOneMinusDstColor   = GL_ONE_MINUS_DST_COLOR,
+    bfSrcAlphaSaturate   = GL_SRC_ALPHA_SATURATE,
+    bgConstColor         = GL_CONSTANT_COLOR,
+    bfOneMinusConstColor = GL_ONE_MINUS_CONSTANT_COLOR,
+    bfConstAlpha         = GL_CONSTANT_ALPHA,
+    bfOneMinusConstAlpha = GL_ONE_MINUS_CONSTANT_ALPHA);
+
+  TglcBlendMode = (
+    bmNone,
+    bmAlphaBlend,
+    bmAdditiveAlphaBlend,
+    bmAdditiveBlend);
+
+  TglcFormat = (
+    fmUnknown           = 0,
+    fmColorIndex        = GL_COLOR_INDEX,
+    fmDepthComponent    = GL_DEPTH_COMPONENT,
+    fmRed               = GL_RED,
+    fmGreen             = GL_GREEN,
+    fmBlue              = GL_BLUE,
+    fmAlpha             = GL_ALPHA,
+    fmRGB               = GL_RGB,
+    fmRGBA              = GL_RGBA,
+    fmLuminance         = GL_LUMINANCE,
+    fmLuminanceAlpha    = GL_LUMINANCE_ALPHA,
+    fmBGR               = GL_BGR,
+    fmBGRA              = GL_BGRA,
+    fmDepthStencil      = GL_DEPTH_STENCIL);
+
+  TglcInternalFormat = (
+    ifUnknown                   = 0,
+    ifDepthComponent            = GL_DEPTH_COMPONENT,
+    ifAlpha                     = GL_ALPHA,
+    ifRGB                       = GL_RGB,
+    ifRGBA                      = GL_RGBA,
+    ifLuminance                 = GL_LUMINANCE,
+    ifLuminanceAlpha            = GL_LUMINANCE_ALPHA,
+    ifR3G3B2                    = GL_R3_G3_B2,
+    ifAlpha4                    = GL_ALPHA4,
+    ifAlpha8                    = GL_ALPHA8,
+    ifAlpha12                   = GL_ALPHA12,
+    ifAlpha16                   = GL_ALPHA16,
+    ifLuminance4                = GL_LUMINANCE4,
+    ifLuminance8                = GL_LUMINANCE8,
+    ifLuminance12               = GL_LUMINANCE12,
+    ifLuminance16               = GL_LUMINANCE16,
+    ifLuminance4Alpha4          = GL_LUMINANCE4_ALPHA4,
+    ifLuminance6Alpha2          = GL_LUMINANCE6_ALPHA2,
+    ifLuminance8Alpha8          = GL_LUMINANCE8_ALPHA8,
+    ifLuminance12Alpha4         = GL_LUMINANCE12_ALPHA4,
+    ifLuminance12Alpha12        = GL_LUMINANCE12_ALPHA12,
+    ifLuminance16Alpha16        = GL_LUMINANCE16_ALPHA16,
+    ifIntensity                 = GL_INTENSITY,
+    ifIntensity4                = GL_INTENSITY4,
+    ifIntensity8                = GL_INTENSITY8,
+    ifIntensity12               = GL_INTENSITY12,
+    ifIntensity16               = GL_INTENSITY16,
+    ifRGB4                      = GL_RGB4,
+    ifRGB5                      = GL_RGB5,
+    ifRGB8                      = GL_RGB8,
+    ifRGB10                     = GL_RGB10,
+    ifRGB12                     = GL_RGB12,
+    ifRGB16                     = GL_RGB16,
+    ifRGBA2                     = GL_RGBA2,
+    ifRGBA4                     = GL_RGBA4,
+    ifRGB5A1                    = GL_RGB5_A1,
+    ifRGBA8                     = GL_RGBA8,
+    ifRGB10A2                   = GL_RGB10_A2,
+    ifRGBA12                    = GL_RGBA12,
+    ifRGBA16                    = GL_RGBA16,
+    ifDepthComponent16          = GL_DEPTH_COMPONENT16,
+    ifDepthComponent24          = GL_DEPTH_COMPONENT24,
+    ifDepthComponent32          = GL_DEPTH_COMPONENT32,
+    ifCompressedAlpha           = GL_COMPRESSED_ALPHA,
+    ifCompressedLuminance       = GL_COMPRESSED_LUMINANCE,
+    ifCompressedLuminanceAlpha  = GL_COMPRESSED_LUMINANCE_ALPHA,
+    ifCompressedIntensity       = GL_COMPRESSED_INTENSITY,
+    ifCompressedRGB             = GL_COMPRESSED_RGB,
+    ifCompressedRGBA            = GL_COMPRESSED_RGBA,
+    ifRGBA32f                   = GL_RGBA32F,
+    ifRGB32f                    = GL_RGB32F,
+    ifRGBA16F                   = GL_RGBA16F,
+    ifRGB16F                    = GL_RGB16F,
+    ifDepth24Stencil8           = GL_DEPTH24_STENCIL8,
+    ifSRGB                      = GL_SRGB,
+    ifSRGB8                     = GL_SRGB8,
+    ifSRGBA                     = GL_SRGB_ALPHA,
+    ifSRGBA8                    = GL_SRGB8_ALPHA8,
+    ifSLuminanceAlpha           = GL_SLUMINANCE_ALPHA,
+    ifSLuminance8Alpha8         = GL_SLUMINANCE8_ALPHA8,
+    ifSLuminance                = GL_SLUMINANCE,
+    ifSLuminance8               = GL_SLUMINANCE8,
+    ifDepth32fStencil8          = GL_DEPTH32F_STENCIL8,
+    ifStencil1                  = GL_STENCIL_INDEX1,
+    ifStencil4                  = GL_STENCIL_INDEX4,
+    ifStencil8                  = GL_STENCIL_INDEX8,
+    ifStencil16                 = GL_STENCIL_INDEX16);
+
+  TglcAttachment = (
+    atDepthStencil = GL_DEPTH_STENCIL_ATTACHMENT,
+    atColor0       = GL_COLOR_ATTACHMENT0,
+    atColor1       = GL_COLOR_ATTACHMENT1,
+    atColor2       = GL_COLOR_ATTACHMENT2,
+    atColor3       = GL_COLOR_ATTACHMENT3,
+    atColor4       = GL_COLOR_ATTACHMENT4,
+    atColor5       = GL_COLOR_ATTACHMENT5,
+    atColor6       = GL_COLOR_ATTACHMENT6,
+    atColor7       = GL_COLOR_ATTACHMENT7,
+    atColor8       = GL_COLOR_ATTACHMENT8,
+    atColor9       = GL_COLOR_ATTACHMENT9,
+    atColor10      = GL_COLOR_ATTACHMENT10,
+    atColor11      = GL_COLOR_ATTACHMENT11,
+    atColor12      = GL_COLOR_ATTACHMENT12,
+    atColor13      = GL_COLOR_ATTACHMENT13,
+    atColor14      = GL_COLOR_ATTACHMENT14,
+    atColor15      = GL_COLOR_ATTACHMENT15,
+    atDepth        = GL_DEPTH_ATTACHMENT,
+    atStencil      = GL_STENCIL_ATTACHMENT);
+
+  TglcShaderType = (
+    stFragment        = GL_FRAGMENT_SHADER,
+    stVertex          = GL_VERTEX_SHADER,
+    stGeometry        = GL_GEOMETRY_SHADER,
+    stTessEvaluation  = GL_TESS_EVALUATION_SHADER,
+    stTessControl     = GL_TESS_CONTROL_SHADER);
+
+  TglcBufferTarget = (
+    btArrayBuffer        = GL_ARRAY_BUFFER,
+    btElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER);
+
+  TglcBufferUsage = (
+    buStreamDraw  = GL_STREAM_DRAW,
+    buStreamRead  = GL_STREAM_READ,
+    buStreamCopy  = GL_STREAM_COPY,
+    buStaticDraw  = GL_STATIC_DRAW,
+    buStaticRead  = GL_STATIC_READ,
+    buStaticCopy  = GL_STATIC_COPY,
+    buDynamicDraw = GL_DYNAMIC_DRAW,
+    buDynamicRead = GL_DYNAMIC_READ,
+    buDynamicCopy = GL_DYNAMIC_COPY);
+
+  TglcBufferAccess = (
+    baReadOnly  = GL_READ_ONLY,
+    baWriteOnly = GL_WRITE_ONLY,
+    baReadWrite = GL_READ_WRITE);
+
+  EOpenGL = class(Exception)
+  private
+    fErrorCode: GLenum;
+  public
+    property ErrorCode: GLenum read fErrorCode;
+    constructor Create(const aErrorCode: GLenum);
+    constructor Create(const aMsg: String; const aErrorCode: GLenum);
+  end;
+
+procedure glcRenderFace(const aValue: TglcFace); inline;
+procedure glcPolygonMode(const aFace: TglcFace; const aValue: TglcPolygonMode); inline;
+procedure glcDepthFunc(const aValue: TglcDepthFunc); inline;
+procedure glcBlendFunc(const aSource, aDest: TglcBlendFactor); inline; overload;
+procedure glcBlendFunc(const aMode: TglcBlendMode); inline; overload;
+procedure glcCheckAndRaiseError;
+
+implementation
+
+type
+  TglcBlendModeValue = packed record
+    src, dst: TglcBlendFactor;
+  end;
+
+const
+  BLEND_MODE_VALUES: array[TglcBlendMode] of TglcBlendModeValue = (
+    (src: TglcBlendFactor.bfOne;         dst: TglcBlendFactor.bfZero),                        //bmNone
+    (src: TglcBlendFactor.bfSrcAlpha;    dst: TglcBlendFactor.bfOneMinusSrcAlpha),            //bmAlphaBlend
+    (src: TglcBlendFactor.bfSrcAlpha;    dst: TglcBlendFactor.bfOne),                         //bmAdditiveAlphaBlend
+    (src: TglcBlendFactor.bfOne;         dst: TglcBlendFactor.bfOne));                        //bmAdditiveBlend
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcRenderFace(const aValue: TglcFace);
+begin
+  case aValue of
+    TglcFace.faBoth: begin
+      glDisable(GL_CULL_FACE);
+    end;
+    TglcFace.faFront: begin
+      glEnable(GL_CULL_FACE);
+      glCullFace(GL_BACK);
+    end;
+    TglcFace.faBack: begin
+      glEnable(GL_CULL_FACE);
+      glCullFace(GL_FRONT);
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcPolygonMode(const aFace: TglcFace; const aValue: TglcPolygonMode);
+begin
+  glPolygonMode(GLenum(aFace), GLenum(aValue));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcDepthFunc(const aValue: TglcDepthFunc);
+begin
+  glDepthFunc(GLenum(aValue));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcBlendFunc(const aSource, aDest: TglcBlendFactor);
+begin
+  glBlendFunc(GLenum(aSource), GLenum(aDest));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcBlendFunc(const aMode: TglcBlendMode); overload;
+begin
+  glBlendFunc(GLenum(BLEND_MODE_VALUES[aMode].src), GLenum(BLEND_MODE_VALUES[aMode].dst));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure glcCheckAndRaiseError;
+var
+  e: GLenum;
+begin
+  e := glGetError();
+  if (e <> GL_NO_ERROR) then
+    raise EOpenGL.Create(e);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//EOpenGL///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EOpenGL.Create(const aErrorCode: GLenum);
+begin
+  fErrorCode := aErrorCode;
+  inherited Create(gluErrorString(fErrorCode));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EOpenGL.Create(const aMsg: String; const aErrorCode: GLenum);
+begin
+  fErrorCode := aErrorCode;
+  inherited Create(aMsg + ': ' + gluErrorString(fErrorCode))
+end;
+
+end.
+

ugluMatrix.pas

@@ -0,0 +1,318 @@
+unit ugluMatrix;
+
+{ Package:      OpenGLCore
+  Prefix:       glu - OpenGL Utils
+  Beschreibung: diese Unit enthält Matrix-Typen und Methoden um diese zu erstellen und zu manipulieren }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, ugluVector;
+
+type
+  //Matrixtypen
+  TgluMatrix2ub = array[0..1] of TgluVector2ub;
+  TgluMatrix2i  = array[0..1] of TgluVector2i;
+  TgluMatrix2f  = array[0..1] of TgluVector2f;
+  TgluMatrix2d  = array[0..1] of TgluVector2d;
+
+  TgluMatrix3ub = array[0..2] of TgluVector3ub;
+  TgluMatrix3i  = array[0..2] of TgluVector3i;
+  TgluMatrix3f  = array[0..2] of TgluVector3f;
+  TgluMatrix3d  = array[0..2] of TgluVector3d;
+
+  TgluMatrix4ub = array[0..3] of TgluVector4ub;
+  TgluMatrix4i  = array[0..3] of TgluVector4i;
+  TgluMatrix4f  = array[0..3] of TgluVector4f;
+  TgluMatrix4d  = array[0..3] of TgluVector4d;
+
+  //MatrixPointer
+  PgluMatrix2ub = ^TgluMatrix2ub;
+  PgluMatrix2i  = ^TgluMatrix2i;
+  PgluMatrix2f  = ^TgluMatrix2f;
+  PgluMatrix2d  = ^TgluMatrix2d;
+
+  PgluMatrix3ub = ^TgluMatrix3ub;
+  PgluMatrix3i  = ^TgluMatrix3i;
+  PgluMatrix3f  = ^TgluMatrix3f;
+  PgluMatrix3d  = ^TgluMatrix3d;
+
+  PgluMatrix4ub = ^TgluMatrix4ub;
+  PgluMatrix4i  = ^TgluMatrix4i;
+  PgluMatrix4f  = ^TgluMatrix4f;
+  PgluMatrix4d  = ^TgluMatrix4d;
+
+  //Konstructoren
+  function gluMatrix4d(const m: TgluMatrix4f): TgluMatrix4d;
+
+  //Matrixfunktionen
+  function gluMatrixTranslate(const v: TgluVector3f): TgluMatrix4f;
+  function gluMatrixScale(const v: TgluVector3f): TgluMatrix4f; overload;
+  function gluMatrixScale(const s: Single): TgluMatrix4f; overload;
+  function gluMatrixRotate(axis: TgluVector3f; const angle: Single): TgluMatrix4f;
+  function gluMatrixMult(const m1, m2: TgluMatrix4f): TgluMatrix4f;
+  function gluMatrixMultVec(const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+  function gluMatrixTranspose(const m: TgluMatrix3f): TgluMatrix3f; overload;
+  function gluMatrixTranspose(const m: TgluMatrix4f): TgluMatrix4f; overload;
+  function gluMatrixSubMatrix(const m:TgluMatrix4f; const s, z: Integer): TgluMatrix3f;
+  function gluMatrixDeterminant(const m: TgluMatrix3f): Single; overload;
+  function gluMatrixDeterminant(const m: TgluMatrix4f): Single; overload;
+  function gluMatrixAdjoint(const m: TgluMatrix4f): TgluMatrix4f;
+  function gluMatrixInvert(const m: TgluMatrix4f): TgluMatrix4f;
+
+  operator * (const m1, m2: TgluMatrix4f): TgluMatrix4f;
+  operator * (const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+  operator * (const m: TgluMatrix4f; const v: TgluVector3f): TgluVector3f;
+
+const
+  maAxisX = 0;
+  maAxisY = 1;
+  maAxisZ = 2;
+  maPos   = 3;
+  gluMatrixIdentity: TgluMatrix4f = ((1,0,0,0),(0,1,0,0),(0,0,1,0),(0,0,0,1));
+
+implementation
+
+uses
+  Math;
+
+operator * (const m1, m2: TgluMatrix4f): TgluMatrix4f;
+begin
+  result := gluMatrixMult(m1, m2);
+end;
+
+operator * (const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+begin
+  result := gluMatrixMultVec(m, v);
+end;
+
+operator * (const m: TgluMatrix4f; const v: TgluVector3f): TgluVector3f;
+begin
+  result := gluVector3f(gluMatrixMultVec(m, gluVEctor4f(v, 1.0)));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluMatrix4d(const m: TgluMatrix4f): TgluMatrix4d;
+var
+  i, j: Integer;
+begin
+  for i := 0 to 3 do
+    for j := 0 to 3 do
+      result[i, j] := m[i, j];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt eine Translationsmatrix
+//@v: Vektor der Translationsmatrix;
+function gluMatrixTranslate(const v: TgluVector3f): TgluMatrix4f;
+var
+  i: Integer;
+begin
+  result := gluMatrixIdentity;
+  for i := 0 to 2 do
+    result[3, i] := v[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt eine Skalierungsmatrix
+//@v: Vektor der Skalierungsmatrix;
+function gluMatrixScale(const v: TgluVector3f): TgluMatrix4f;
+var
+  i: Integer;
+begin
+  result := gluMatrixIdentity;
+  for i := 0 to 2 do
+    result[i, i] := v[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function gluMatrixScale(const s: Single): TgluMatrix4f;
+var
+  i: Integer;
+begin
+  result := gluMatrixIdentity;
+  for i := 0 to 2 do
+    result[i, i] := s;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//erstellt eine Rotationsmatrix;
+//@axis: Achse um die gedreht werden soll;
+//@angle: Winkel mit dem gedreht werden soll;
+function gluMatrixRotate(axis: TgluVector3f; const angle: Single): TgluMatrix4f;
+var
+  X, Y, Z, a, s, c: Single;
+begin
+  axis := gluVectorNormalize(axis);
+  X := axis[0];
+  Y := axis[1];
+  Z := axis[2];
+  a := angle/180*Pi;
+  s := sin(a);
+  c := cos(a);
+  result := gluMatrixIdentity;
+  result[maAxisX] := gluVector4f(
+    SQR(X) + (1-SQR(X))*c,
+    X*Y*(1-c) + Z*s,
+    X*Z*(1-c) - Y*s,
+    0);
+  result[maAxisY] := gluVector4f(
+    X*Y*(1-c) - Z*s,
+    SQR(Y) + (1-SQR(Y))*c,
+    Y*Z*(1-c) + X*s,
+    0);
+  result[maAxisZ] := gluVector4f(
+    X*Z*(1-c) + Y*s,
+    Y*Z*(1-c) - X*s,
+    SQR(Z) + (1-SQR(Z))*c,
+    0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Mutlipliziert Matrix1 mit Matrix2
+//@Matrix1: 1. Multiplikator;
+//@Matrix2: 2. Multiplikator;
+//@result: Matrix1 * Matrix2
+function gluMatrixMult(const m1, m2: TgluMatrix4f): TgluMatrix4f;
+var
+  x, y, i: Integer;
+  sum: Single;
+begin
+  for x := 0 to 3 do begin
+    for y := 0 to 3 do begin
+      sum := 0;
+      for i := 0 to 3 do
+        sum := sum + m1[i, y] * m2[x, i];
+      result[x, y] := sum;
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Multiplizerit eine Matrix mit einem Vektor
+//@m: Matrix mit der multipliziert werden soll;
+//@v: Vektor mit dem multipliziert werden soll;
+//@result: Ergebnis der Multiplikation
+function gluMatrixMultVec(const m: TgluMatrix4f; const v: TgluVector4f): TgluVector4f;
+var
+  i, j: Integer;
+  sum: Single;
+begin
+  for i := 0 to 3 do begin
+    sum := 0;
+    for j := 0 to 3 do
+      sum := sum + m[j,i] * v[j];
+    result[i] := sum;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Transponierte Matrix
+//@m: Matrix die Transponiert werden soll;
+//@result: Transponierte Matrix;
+function gluMatrixTranspose(const m: TgluMatrix3f): TgluMatrix3f;
+var
+  i, j: Integer;
+begin
+  for i := 0 to 2 do
+    for j := 0 to 2 do
+      result[i, j] := m[j, i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Transponierte Matrix
+//@m: Matrix die Transponiert werden soll;
+//@result: Transponierte Matrix;
+function gluMatrixTranspose(const m: TgluMatrix4f): TgluMatrix4f;
+var
+  i, j: Integer;
+begin
+  for i := 0 to 3 do
+    for j := 0 to 3 do
+      result[i, j] := m[j, i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//ermittelt die Untermatrix einer Matrix
+//@m: Matrix derren Untermatrix berechnet werden soll;
+//@s: Spalte die gelöscht werden soll;
+//@z: Zeile die gelöscht werden soll;
+//@result: Untermatrix von m
+function gluMatrixSubMatrix(const m: TgluMatrix4f; const s, z: Integer): TgluMatrix3f;
+var
+  x, y, i, j: Integer;
+begin
+  for i := 0 to 2 do
+    for j := 0 to 2 do begin
+      x := i;
+      y := j;
+      if (i >= s) then
+        inc(x);
+      if (j >= z) then
+        inc(y);
+      result[i, j] := m[x, y];
+    end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Determinante einer Matrix
+//@m: Matrix derren Determinaten berechnet werden soll;
+//@result: Determinante von m
+function gluMatrixDeterminant(const m: TgluMatrix3f): Single;
+begin
+  result :=
+    m[0,0] * m[1,1] * m[2,2] +
+    m[1,0] * m[2,1] * m[0,2] +
+    m[2,0] * m[0,1] * m[1,2] -
+    m[2,0] * m[1,1] * m[0,2] -
+    m[1,0] * m[0,1] * m[2,2] -
+    m[0,0] * m[2,1] * m[1,2];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Determinante einer Matrix
+//@m: Matrix derren Determinaten berechnet werden soll;
+//@result: Determinante von m
+function gluMatrixDeterminant(const m: TgluMatrix4f): Single;
+var
+  i: Integer;
+begin
+  result := 0;
+  for i := 0 to 3 do
+    result := result + power(-1, i) * m[i, 0] * gluMatrixDeterminant(gluMatrixSubMatrix(m, i, 0));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die Adjunkte einer Matrix
+//@m: Matrix derren Adjunkte berechnet werden soll;
+//@result: Adjunkte von m
+function gluMatrixAdjoint(const m: TgluMatrix4f): TgluMatrix4f;
+var
+  i, j: Integer;
+begin
+  for i := 0 to 3 do
+    for j := 0 to 3 do
+      result[i, j] := power(-1, i+j) * gluMatrixDeterminant(gluMatrixSubMatrix(m, i, j));
+  result := gluMatrixTranspose(result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//berechnet die inverse Matrix einer Matrix
+//@m: Matrix derren Inverse berechnet werden soll;
+//@result: Inverse Matrix von m;
+function gluMatrixInvert(const m: TgluMatrix4f): TgluMatrix4f;
+var
+  d: Single;
+  i, j: Integer;
+begin
+  d := gluMatrixDeterminant(m);
+  result := gluMatrixAdjoint(m);
+  for i := 0 to 3 do
+    for j := 0 to 3 do
+      result[i,j] := result[i,j] / d;
+end;
+
+end.
+

ugluQuaternion.pas

@@ -0,0 +1,384 @@
+unit ugluQuaternion;
+
+{ Package:      OpenGLCore
+  Prefix:       glu - OpenGL Utils
+  Beschreibung: diese Unit enthält Quaternion-Typen und Methoden um diese zu erstellen und zu manipulieren }
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, ugluVector, ugluMatrix;
+
+type
+  TgluQuaternion = type TgluVector4f; // w,x,y,z
+
+{
+   Winkel                           : rad, außer glRotate-Komponenten
+   Absolute Werte                   : Orientation
+   Relative Werte/"Drehanweisungen" : Rotation
+   To/FromVector                    : Position im R^4
+
+   Alle Funktionen nehmen an, dass die Quaternion nur zur Rotation verwendet wird (kein Scale),
+   mathematisch also normalisiert ist. Es findet keine Überprüfung statt.
+}
+
+  //Quaternion Konstruktoren
+  function gluQuaternion(const W, X, Y, Z: Single): TgluQuaternion;
+  function gluQuaternionNormalize(const q: TgluQuaternion): TgluQuaternion;
+  procedure gluQuaternionNormalizeInplace(var q: TgluQuaternion);
+  function gluQuaternionToVector(const q: TgluQuaternion): TgluVector3f;
+  function gluVectorToQuaternion(const v: TgluVector3f): TgluQuaternion;
+
+  //Arithmetic
+  function gluQuaternionConjugate(const q: TgluQuaternion): TgluQuaternion;
+  function gluQuaternionMultiply(const l,r: TgluQuaternion): TgluQuaternion;
+  function gluQuaternionAdd(const a,b: TgluQuaternion): TgluQuaternion;
+  function gluQuaternionSubtract(const l,r: TgluQuaternion): TgluQuaternion;
+  function gluQuaternionScale(const q: TgluQuaternion; const f: Single): TgluQuaternion;
+
+
+  //To/From RotationMatrix
+  function gluQuaternionToMatrix(const q: TgluQuaternion): TgluMatrix4f;
+  function gluMatrixToQuaternion(const m: TgluMatrix4f): TgluQuaternion;
+
+  //To/From Axis/Angle {WINKEL IN °DEG}
+  function gluQuaternionToRotation(const q: TgluQuaternion; out angle: Single): TgluVector3f;
+  function gluRotationToQuaternion(const angle: Single; const axis: TgluVector3f): TgluQuaternion;
+
+  //Transforms
+  function gluQuaternionTransformVec(const q: TgluQuaternion; const v: TgluVector3f): TgluVector3f;
+
+  function gluQuaternionLookAt(const Location, Target, UpVector: TgluVector3f): TgluQuaternion;
+  //Rotation zw. Richtungen: Wie muss a modifiziert werden um b zu bekommen?
+  function gluVectorRotationTo(const a, b: TgluVector3f): TgluQuaternion;
+
+  //Modifying Quaternions
+  function gluQuaternionHalfAngle(const q: TgluQuaternion): TgluQuaternion;
+  function gluQuaternionAngleBetween(const a, b: TgluQuaternion): double;
+  function gluQuaternionSlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+  function gluQuaternionNlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+
+  operator +(const a, b: TgluQuaternion): TgluQuaternion;
+  operator -(const l, r: TgluQuaternion): TgluQuaternion;
+  operator *(const l, r: TgluQuaternion): TgluQuaternion;
+  operator *(const q: TgluQuaternion; const s: Sigle): TgluQuaternion;
+
+const
+  quW = 0;
+  quX = 1;
+  quY = 2;
+  quZ = 3;
+  gluQuaternionIdentity: TgluQuaternion = (1,0,0,0);
+
+implementation
+
+uses
+  Math;
+
+operator +(const a, b: TgluQuaternion): TgluQuaternion;
+begin
+  result := gluQuaternionAdd(a, b);
+end;
+
+operator -(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+  result := gluQuaternionSubtract(l, r);
+end;
+
+operator *(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+  result := gluQuaternionMultiply(l, r);
+end;
+
+operator *(const q: TgluQuaternion; const s: Sigle): TgluQuaternion;
+begin
+  result := gluQuaternionScale(q, s);
+end;
+
+function gluQuaternion(const W, X, Y, Z: Single): TgluQuaternion;
+begin
+  Result:= gluVector4f(W,X,Y,Z);
+end;
+
+function gluQuaternionNormalize(const q: TgluQuaternion): TgluQuaternion;
+begin
+  Result:= q;
+  gluQuaternionNormalizeInplace(Result);
+end;
+
+procedure gluQuaternionNormalizeInplace(var q: TgluQuaternion);
+var
+  s: Double;
+begin
+  s:= sqr(q[quX])+sqr(q[quY])+sqr(q[quZ])+sqr(q[quW]);
+  // already normalized?
+  if IsZero(s - 1) then
+    exit;
+  s:= 1/sqrt(s);
+  q[quX]:= q[quX] * s;
+  q[quY]:= q[quY] * s;
+  q[quZ]:= q[quZ] * s;
+  q[quW]:= q[quW] * s;
+end;
+
+function gluQuaternionToVector(const q: TgluQuaternion): TgluVector3f;
+begin
+  Result:= gluVector3f(q[quX], q[quY], q[quZ]);
+end;
+
+function gluVectorToQuaternion(const v: TgluVector3f): TgluQuaternion;
+begin
+  Result:= gluQuaternion(0, v[0], v[1], v[2]);
+end;
+
+
+function gluQuaternionConjugate(const q: TgluQuaternion): TgluQuaternion;
+begin
+  Result[quW] := q[quW];
+  Result[quX] := -q[quX];
+  Result[quY] := -q[quY];
+  Result[quZ] := -q[quZ];
+end;
+
+function gluQuaternionMultiply(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+  Result[quW] := -l[qux] * r[qux] - l[quy] * r[quy] - l[quz] * r[quz] + l[quw] * r[quw];
+  Result[quX] :=  l[qux] * r[quw] + l[quy] * r[quz] - l[quz] * r[quy] + l[quw] * r[qux];
+  Result[quY] := -l[qux] * r[quz] + l[quy] * r[quw] + l[quz] * r[qux] + l[quw] * r[quy];
+  Result[quZ] :=  l[qux] * r[quy] - l[quy] * r[qux] + l[quz] * r[quw] + l[quw] * r[quz];
+end;
+
+function gluQuaternionAdd(const a, b: TgluQuaternion): TgluQuaternion;
+begin
+  Result[quW] := a[quW] + b[quW];
+  Result[quX] := a[quX] + b[quX];
+  Result[quY] := a[quY] + b[quY];
+  Result[quZ] := a[quZ] + b[quZ];
+end;
+
+function gluQuaternionSubtract(const l, r: TgluQuaternion): TgluQuaternion;
+begin
+  Result[quW] := l[quW] - r[quW];
+  Result[quX] := l[quX] - r[quX];
+  Result[quY] := l[quY] - r[quY];
+  Result[quZ] := l[quZ] - r[quZ];
+end;
+
+function gluQuaternionScale(const q: TgluQuaternion; const f: Single): TgluQuaternion;
+begin
+  Result[quW] := q[quW] * f;
+  Result[quX] := q[quX] * f;
+  Result[quY] := q[quY] * f;
+  Result[quZ] := q[quZ] * f;
+end;
+
+// http://www.euclideanspace.com/maths/geometry/rotations/conversions/quaternionToMatrix/index.htm
+function gluQuaternionToMatrix(const q: TgluQuaternion): TgluMatrix4f;
+var
+  qx,qy,qz,qw: Single;
+begin
+  qw:= q[quW];
+  qx:= q[quX];
+  qy:= q[quY];
+  qz:= q[quZ];
+  Result:= gluMatrixIdentity;
+  Result[maAxisX] := gluVector4f(
+    1 - 2*SQR(qy) - 2*SQR(qz),
+    2*qx*qy + 2*qz*qw,
+    2*qx*qz - 2*qy*qw,
+    0);
+  Result[maAxisY] := gluVector4f(
+    2*qx*qy - 2*qz*qw,
+    1 - 2*SQR(qx) - 2*SQR(qz),
+    2*qy*qz + 2*qx*qw,
+    0);
+  Result[maAxisZ] := gluVector4f(
+    2*qx*qz + 2*qy*qw,
+    2*qy*qz - 2*qx*qw,
+   	1 - 2*SQR(qx) - 2*SQR(qy),
+    0);
+end;
+
+// http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToQuaternion/index.htm
+function gluMatrixToQuaternion(const m: TgluMatrix4f): TgluQuaternion;
+var
+  trace, s: double;
+  q: TgluQuaternion;
+
+begin
+  trace := m[0][0] + m[1][1] + m[2][2]; // I removed + 1.0f; see discussion with Ethan
+  if( trace > 0 ) then begin// I changed M_EPSILON to 0
+    s := 0.5 / SQRT(trace+ 1.0);
+    q[quW] := 0.25 / s;
+    q[quX] := ( m[2][1] - m[1][2] ) * s;
+    q[quY] := ( m[0][2] - m[2][0] ) * s;
+    q[quZ] := ( m[1][0] - m[0][1] ) * s;
+  end else begin
+    if ( m[0][0] > m[1][1]) and (m[0][0] > m[2][2] ) then begin
+      s := 2.0 * SQRT( 1.0 + m[0][0] - m[1][1] - m[2][2]);
+      q[quW] := (m[2][1] - m[1][2] ) / s;
+      q[quX] := 0.25 * s;
+      q[quY] := (m[0][1] + m[1][0] ) / s;
+      q[quZ] := (m[0][2] + m[2][0] ) / s;
+    end else if (m[1][1] > m[2][2]) then begin
+      s := 2.0 * SQRT( 1.0 + m[1][1] - m[0][0] - m[2][2]);
+      q[quW] := (m[0][2] - m[2][0] ) / s;
+      q[quX] := (m[0][1] + m[1][0] ) / s;
+      q[quY] := 0.25 * s;
+      q[quZ] := (m[1][2] + m[2][1] ) / s;
+    end else begin
+      s := 2.0 * SQRT( 1.0 + m[2][2] - m[0][0] - m[1][1] );
+      q[quW] := (m[1][0] - m[0][1] ) / s;
+      q[quX] := (m[0][2] + m[2][0] ) / s;
+      q[quY] := (m[1][2] + m[2][1] ) / s;
+      q[quZ] := 0.25 * s;
+    end;
+  end;
+  Result:= q;
+end;
+
+// http://www.euclideanspace.com/maths/geometry/rotations/conversions/quaternionToAngle/index.htm
+function gluQuaternionToRotation(const q: TgluQuaternion; out angle: Single): TgluVector3f;
+var
+  s: double;
+begin
+  angle := radtodeg(2 * arccos(q[quW]));
+  s := sqrt(1-q[quW]*q[quW]); // assuming quaternion normalised then w is less than 1, so term always positive.
+  if (s < 0.001) then begin // test to avoid divide by zero, s is always positive due to sqrt
+    // if s close to zero then direction of axis not important
+    Result[0] := q[quX]; // if it is important that axis is normalised then replace with x=1; y=z=0;
+    Result[1] := q[quY];
+    Result[2] := q[quZ];
+  end else begin
+    Result[0] := q[quX] / s; // normalise axis
+    Result[1] := q[quY] / s;
+    Result[2] := q[quZ] / s;
+  end;
+end;
+
+function gluRotationToQuaternion(const angle: Single; const axis: TgluVector3f): TgluQuaternion;
+var
+  a: single;
+begin
+  a:= degtorad(angle) / 2;
+  Result:= gluQuaternion(
+    cos(a),
+    sin(a) * axis[0],
+    sin(a) * axis[1],
+    sin(a) * axis[2]);
+end;
+
+// http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions/transforms/index.htm
+function gluQuaternionTransformVec(const q: TgluQuaternion; const v: TgluVector3f): TgluVector3f;
+var
+  p: TgluQuaternion;
+begin
+  //Pout = q * Pin * q'
+  p:= gluQuaternionMultiply(q, gluVectorToQuaternion(v));
+  p:= gluQuaternionMultiply(p, gluQuaternionConjugate(q));
+  Result:= gluQuaternionToVector(p);
+end;
+
+// http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions/transforms/halfAngle.htm
+function gluQuaternionHalfAngle(const q: TgluQuaternion): TgluQuaternion;
+begin
+  Result:= q;
+  Result[quW]:= Result[quW] + 1;
+  gluQuaternionNormalizeInplace(Result);
+end;
+
+function gluQuaternionAngleBetween(const a, b: TgluQuaternion): double;
+var
+  cosHalfTheta: double;
+begin
+  cosHalfTheta:= a[quW] * b[quW] + a[quX] * b[quX] + a[quY] * b[quY] + a[quZ] * b[quZ];
+  Result:= arccos(cosHalfTheta) * 2;
+end;
+
+// http://www.euclideanspace.com/maths/algebra/realNormedAlgebra/quaternions/slerp/index.htm
+function gluQuaternionSlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+var
+  qa,qb: TgluQuaternion;
+  cosHalfTheta, sinHalfTheta,
+    halfTheta,
+    ratioA, ratioB: double;
+begin
+  qa:= a;
+  qb:= b;
+	// Calculate angle between them.
+  cosHalfTheta:= a[quW] * b[quW] + a[quX] * b[quX] + a[quY] * b[quY] + a[quZ] * b[quZ];
+  if (cosHalfTheta < 0) then begin
+    qb:= gluQuaternion(
+      -b[quW],
+      -b[quX],
+      -b[quY],
+       b[quZ]
+    );
+    cosHalfTheta:= -cosHalfTheta;
+  end;
+
+  // if qa=qb or qa=-qb then theta = 0 and we can return qa
+	if abs(cosHalfTheta) >= 1.0 then begin
+		Result:= qa;
+    Exit;
+	end;
+
+	// Calculate temporary values.
+	halfTheta := arccos(cosHalfTheta);
+	sinHalfTheta := sqrt(1.0 - sqr(cosHalfTheta));
+	// if theta = 180 degrees then result is not fully defined
+	// we could rotate around any axis normal to qa or qb
+	if (abs(sinHalfTheta) < 0.001) then begin
+    Result:= gluQuaternionAdd(gluQuaternionScale(qa, 0.5), gluQuaternionScale(qb, 0.5));
+    exit
+  end;
+	ratioA := sin((1 - t) * halfTheta) / sinHalfTheta;
+	ratioB := sin(t * halfTheta) / sinHalfTheta;
+	//calculate Quaternion.
+  Result:= gluQuaternionAdd(gluQuaternionScale(qa, ratioA), gluQuaternionScale(qb, ratioB));
+end;
+
+function gluQuaternionNlerpOrientation(const a, b: TgluQuaternion; const t: single): TgluQuaternion;
+begin
+  Result:= gluQuaternionAdd(a, gluQuaternionScale(gluQuaternionSubtract(b,a), t));
+  gluQuaternionNormalizeInplace(Result);
+end;
+
+function gluQuaternionLookAt(const Location, Target, UpVector: TgluVector3f): TgluQuaternion;
+var
+  front, up, right: TgluVector3f;
+  w4_recip: Single;
+begin
+  front:= gluVectorSubtract(Location, Target); // eigentlich falschrum. don't ask.
+  up:= UpVector;
+  gluVectorOrthoNormalize(front, up);
+  right:= gluVectorProduct(up, front);
+
+  Result[quW]:= SQRT(1 + right[0] + up[1] + front[2]) * 0.5;
+  w4_recip:= 1 / (4 * Result[quW]);
+
+  Result[quX]:= (front[1] - up[2]) * w4_recip;
+	Result[quY]:= (right[2] - front[0]) * w4_recip;
+	Result[quZ]:= (up[0] - right[1]) * w4_recip;
+end;
+
+function gluVectorRotationTo(const a, b: TgluVector3f): TgluQuaternion;
+var
+  d, qw: single;
+  ax: TgluVector3f;
+begin
+  d:=gluVectorScalar(a, b);
+  ax:= gluVectorProduct(a, b);
+  qw:= gluVectorLength(a) * gluVectorLength(b) + d;
+	if (qw < 0.0001) then begin // vectors are 180 degrees apart
+    Result:= gluQuaternion(0, -a[2],a[1],a[0]);
+  end else begin
+    Result:= gluQuaternion(qw, ax[0],ax[1],ax[2]);
+  end;
+  gluQuaternionNormalizeInplace(Result);
+end;
+
+end.
+