Sordie.co.uk

{(
 )) libSassy.OpenGL
((    OpenGL library
 ))
((  Copyright © Sordie Aranka Solomon-Smith 2015
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.OpenGL;

interface

uses
  Winapi.Windows,
  Winapi.Messages,

  libSassy.Strings,
  libSassy.FileSystem,
  libSassy.Streams,
  libSassy.Windows,
  libSassy.Errors,
  libSassy.SceneGraph,
  libSassy.Geometry,
  libSassy.Bitmaps,
  libSassy.Threads,

  dglOpenGL;

type
  TOpenGLError = class(TException);

{$REGION 'TOpenGLWindow'}
  TOpenGLWindow = class(TEngineWindow)
  private
    fDeviceContext: HDC;
    fRenderContext: HGLRC;

    fMultiSampleLevel:  Integer;
    fMultiSampleFormat: GLuint;

    fActiveScene: TSceneNode;
  public
    Projection: TMatrix4;
    Camera:     TMatrix4;

    constructor Create(const AWidth, AHeight: Integer; const AFullScreen: Boolean = False);

    procedure CreateWindow;           override;
    function  DestroyWindow: Boolean; override;

    function MakeCurrent: Boolean; inline;

    procedure Present; override;

    procedure SetDisplaySize(const AWidth, AHeight: Integer; const AFullScreen: Boolean = False); override;

    function InitializeAssets: Boolean; override;

    function Cycle (const Delta: Extended): Boolean; override;
    function Render(const Delta: Extended): Boolean; override;

    property DeviceContext: HDC   read fDeviceContext;
    property RenderContext: HGLRC read fRenderContext;

    property MultiSampleLevel: Integer read fMultiSampleLevel;

    property ActiveScene: TSceneNode read fActiveScene write fActiveScene;
  end;
{$ENDREGION}

{$REGION 'TOpenGLView'}
  TOpenGLView = class abstract(TSceneNode)
  private
    fWindow: TOpenGLWindow;
    fDepth:  Single;
  public
    constructor Create(const AWindow: TOpenGLWindow);

    function Process(const Delta: Extended): Boolean; override;

    property Window: TOpenGLWindow read fWindow write fWindow;
    property Depth:  Single        read fDepth  write fDepth;
  end;
{$ENDREGION}

{$REGION 'TOpenGLView2D'}
  TOpenGLView2D = class(TOpenGLView)
  public
    class procedure View(const AWindow: TOpenGLWindow; const Depth: Single = 100);

    function Process(const Delta: Extended): Boolean; override;
  end;
{$ENDREGION}

{$REGION 'TOpenGLView3D'}
  TOpenGLView3D = class(TOpenGLView)
  private
    fFOV: Single;
  public
    class procedure View(const AWindow: TOpenGLWindow; const FOV: Single = 45; const Depth: Single = 100);

    function Process(const Delta: Extended): Boolean; override;

    property FOV: Single read fFOV write fFOV;
  end;
{$ENDREGION}

{$REGION 'TOpenGLViewIsometric'}
  TOpenGLViewIsometric = class(TOpenGLView)
  public
    class procedure View(const AWindow: TOpenGLWindow; const Depth: Single = 100);

    function Process(const Delta: Extended): Boolean; override;
  end;
{$ENDREGION}

{$REGION 'TOpenGLCamera3D'}
  TOpenGLCamera3D = class(TOpenGLView3D)
  public
    Position: TVector4;
    Target:   TVector4;

    function Process(const Delta: Extended): Boolean; override;
  end;
{$ENDREGION}

{$REGION 'TOpenGLLight'}
  TOpenGLLight = class(TSceneNode)
  private
    fID: GLuint;
  public
    Ambient:  TVector4;
    Diffuse:  TVector4;
    Specular: TVector4;
    Position: TVector4;

    constructor Create(const AID: GLuint);

    function Process(const Delta: Extended): Boolean; override;

    property ID: GLuint read fID;
  end;
{$ENDREGION}

{$REGION 'TOpenGLMaterial'}
  TOpenGLMaterial = class(TSceneNode)
  public
    Ambient:   TVector4;
    Diffuse:   TVector4;
    Specular:  TVector4;
    Shininess: TVector4;
    Emission:  TVector4;

    function Process(const Delta: Extended): Boolean; override;
  end;
{$ENDREGION}

{$REGION 'TOpenGLQuadric'}
  TOpenGLQuadric = class
  private
    fQuadric: PGLUQuadric;

    fTextured: Boolean;
    fFlat:     Boolean;
    fOutside:  Boolean;

    class var fStock: TOpenGLQuadric;

    procedure SetTextured(Value: Boolean);
    procedure SetFlat    (Value: Boolean);
    procedure SetOutside (Value: Boolean);
  public
    constructor Create;
    destructor  Destroy; override;

    class constructor Create;
    class destructor  Destroy;

    class function Stock: TOpenGLQuadric;

    property Quadric: PGLUQuadric read fQuadric;

    property Textured: Boolean read fTextured write SetTextured;
    property Flat:     Boolean read fFlat     write SetFlat;
    property Outside:  Boolean read fOutside  write SetOutside;
  end;
{$ENDREGION}

{$REGION 'TOpenGLRender'}
  TOpenGLRender = class(TSceneNode)
  private
    fID: GLuint;
  public
    constructor Create;
    destructor  Destroy; override;

    class function CreateList(From: TProcedure): GLuint;

    class procedure DrawTriangle(a, b, c: TVector4);

    procedure DoRender; virtual;

    procedure Compile;
    procedure Uncompile;

    function Process(const Delta: Extended): Boolean; override;

    property ID: GLuint read fID write fID;
  end;
{$ENDREGION}

{$REGION 'TOpenGLPlain'}
  TOpenGLPlain = class(TOpenGLRender)
  public
    class procedure Draw;

    procedure DoRender; override;
  end;
{$ENDREGION}

{$REGION 'TOpenGLCube'}
  TOpenGLCube = class(TOpenGLRender)
  private
    fFaceTextures: Boolean;
  public
    class procedure Draw(const FaceTextures: Boolean = True);

    procedure DoRender; override;

    property FaceTextures: Boolean read fFaceTextures write fFaceTextures;
  end;
{$ENDREGION}

{$REGION 'TOpenGLIcosahedron'}
  TOpenGLIcosahedron = class(TOpenGLRender)
  private
    fFlat: Boolean;
  public
    const X = 0.525731112119133606;
    const Z = 0.850650808352039932;

    const VertexData: array[0..11] of array[0..2] of Single = (
      (-X,	0,  Z),
      ( X,	0,  Z),
      (-X,	0, -Z),
      ( X,	0, -Z),
      ( 0,  Z,  X),
      ( 0,  Z, -X),
      ( 0, -Z,  X),
      ( 0, -Z, -X),
      ( Z,  X,  0),
      (-Z,  X,  0),
      ( Z, -X,  0),
      (-Z, -X,  0)
    );

    const VertexIndex: array[0..19, 0..2] of Integer = (
  		(0, 4, 1),	(0, 9, 4),
	  	(9, 5, 4),	(4, 5, 8),
		  (4, 8, 1),	(8, 10, 1),
		  (8, 3, 10),	(5, 3, 8),
		  (5, 2, 3),	(2, 7, 3),
		  (7, 10, 3),	(7, 6, 10),
		  (7, 11, 6),	(11, 0, 6),
		  (0, 1, 6),	(6, 1, 10),
		  (9, 0, 11),	(9, 11, 2),
		  (9, 2, 5),	(7, 2, 11)
    );

    const N1 = 0.356822103261948;
    const N2 = 0.934172332286835;
    const N3 = 0.577350258827209;

    const NormalData: array[0..19] of array[0..2] of Single = (
      (  0,  N1,  N2),
      (-N3,  N3,  N3),
      (-N1,  N2,   0),
      ( N1,  N2,   0),
      ( N3,  N3,  N3),
      ( N2,   0,  N1),
      ( N2,   0, -N1),
      ( N3,  N3, -N3),
      (  0,  N1, -N2),
      (  0, -N1, -N2),
      ( N3, -N3, -N3),
      ( N1, -N2,   0),
      (-N1, -N2,   0),
      (-N3, -N3,  N3),
      (  0, -N1,  N2),
      ( N3, -N3,  N3),
      (-N2,   0,  N1),
      (-N2,   0, -N1),
      (-N3,  N3, -N3),
      (-N3, -N3, -N3)
    );

    class procedure Draw(const Flat: Boolean = True);

    procedure DoRender; override;

    property Flat: Boolean read fFlat write fFlat;
  end;
{$ENDREGION}

{$REGION 'TOpenGLSphere'}
  TOpenGLSphere = class(TOpenGLRender)
  private
    fRadius:  Single;
    fSlices:  Integer;
    fStacks:  Integer;
    fQuadric: TOpenGLQuadric;
  public
    class procedure Draw(const Radius: Single = 1; const Slices: Integer = 8; const Stacks: Integer = -1; Quadric: TOpenGLQuadric = nil);

    procedure DoRender; override;

    property Radius:  Single         read fRadius  write fRadius;
    property Slices:  Integer        read fSlices  write fSlices;
    property Stacks:  Integer        read fStacks  write fStacks;
    property Quadric: TOpenGLQuadric read fQuadric write fQuadric;
  end;
{$ENDREGION}

{$REGION 'TOpenGLCylinder'}
  TOpenGLCylinder = class(TOpenGLRender)
  private
    fBaseRadius: Single;
    fTopRadius:  Single;
    fHeight:     Single;
    fSlices:     Integer;
    fStacks:     Integer;
    fQuadric:    TOpenGLQuadric;
  public
    class procedure Draw(const BaseRadius, TopRadius, Height: Single; const Slices: Integer = 8; const Stacks: Integer = 1; Quadric: TOpenGLQuadric = nil);

    procedure DoRender; override;

    property BaseRadius: Single         read fBaseRadius write fBaseRadius;
    property TopRadius:  Single         read fTopRadius  write fBaseRadius;
    property Height:     Single         read fHeight     write fHeight;
    property Slices:     Integer        read fSlices     write fSlices;
    property Stacks:     Integer        read fStacks     write fStacks;
    property Quadric:    TOpenGLQuadric read fQuadric    write fQuadric;
  end;
{$ENDREGION}

{$REGION 'TOpenGLCone'}
  TOpenGLCone = class(TOpenGLRender)
  private
    fRadius: Single;
    fHeight: Single;
    fSlices: Integer;
  public
    class procedure Draw(const Radius, Height: Single; const Slices: Integer = 6);

    procedure DoRender; override;

    property Radius: Single  read fRadius write fRadius;
    property Height: Single  read fHeight write fHeight;
    property Slices: Integer read fSlices write fSlices;
  end;
{$ENDREGION}

{$REGION 'TOpenGLShader'}
  TOpenGLShader = class
  private
    fID:         GLuint;
    fShaderType: GLenum;
  public
    constructor Create(const ASource: AnsiString; const AShaderType: GLenum);
    destructor  Destroy; override;

    property ID: GLuint read fID;

    property ShaderType: GLenum read fShaderType;
  end;
{$ENDREGION}

{$REGION 'TOpenGLShaderProgram'}
  TOpenGLShaderProgram = class(TSceneNode)
  private
    fID: GLuint;

    fVertexShader:   TOpenGLShader;
    fFragmentShader: TOpenGLShader;

    fUniformMap: array[0..13] of GLint;
  public
{$REGION 'Basic shader source'}
    const BasicVertexShader   = 'varying vec3 n,l,e;void main(){n=gl_NormalMatrix*gl_Normal;vec3 v=vec3(gl_ModelViewMatrix*gl_Vertex);l=vec3(gl_LightSource[0].position.xyz-v);e=-v;gl_Position=ftransform();gl_TexCoord[0]=gl_MultiTexCoord0;}';
    const BasicFragmentShader = 'varying vec3 n,l,e;uniform sampler2D tex0;void main(){vec4 c=texture2D(tex0,gl_TexCoord[0].xy);vec4 f=(gl_LightSource[0].ambient*gl_FrontMaterial.ambient)*c;vec3 N=normalize(n);vec3 L=normalize(l);float t=dot(N,L);if(t>0){f+=gl_LightSource[0].diffuse*'+
      'gl_FrontMaterial.diffuse*t*c;vec3 E=normalize(e);vec3 R=reflect(-L,N);float s=pow(max(dot(R,E),0),gl_FrontMaterial.shininess);f+=gl_LightSource[0].specular*gl_FrontMaterial.specular*s;}gl_FragColor=f;gl_FragColor.a=1;}';
{$ENDREGION}

    constructor Create(const AVertexSrc: AnsiString = BasicVertexShader; const AFragmentSrc: AnsiString = BasicFragmentShader);
    destructor  Destroy; override;

    class function CreateFromFiles(const AVertexFileName, AFragmentFileName: String): TOpenGLShaderProgram;

    function MapUniform(const Name: AnsiString; const UID: Integer): GLint;
    procedure Uniform(const UID:  Integer;    Value: array of GLfloat); overload;
    procedure Uniform(const Name: AnsiString; Value: array of GLfloat); overload;

    procedure Bind;   inline;
    procedure Unbind; inline;

    function Process(const Delta: Extended): Boolean; override;

    property ID: GLuint read fID;

    property VertexShader:   TOpenGLShader read fVertexShader;
    property FragmentShader: TOpenGLShader read fFragmentShader;
  end;
{$ENDREGION}

{$REGION 'TOpenGLTexture'}
  TOpenGLTexture = class(TSceneNode)
  private
    fID: GLuint;

    fWidth:  Integer;
    fHeight: Integer;

    fTexelXRatio: Single;
    fTexelYRatio: Single;

    fTexelWidth:  Integer;
    fTexelHeight: Integer;

    procedure SetTexelWidth (ATexelWidth:  Integer); inline;
    procedure SetTexelHeight(ATexelHeight: Integer); inline;
  public
    constructor Create(const AWidth, AHeight: Integer; const MinFilter: GLint = GL_NEAREST; const MagFilter: GLint = GL_NEAREST; const Depth: Boolean = False); overload;
    constructor Create(const ABitmap: TBitmap;         const MinFilter: GLint = GL_NEAREST; const MagFilter: GLint = GL_NEAREST); overload;
    constructor Create(const AFileName: String;        const MinFilter: GLint = GL_NEAREST; const MagFilter: GLint = GL_NEAREST); overload;

    destructor Destroy; override;

    procedure Bind;   inline;
    procedure Unbind; inline;

    function Process(const Delta: Extended): Boolean; override;

    procedure Draw2D(SrcX, SrcY, SrcW, SrcH, DestX, DestY, DestW, DestH: Integer; const DestZ: Integer = 0);

    property ID: GLuint read fID;

    property Width:  Integer read fWidth;
    property Height: Integer read fHeight;

    property TexelXRatio: Single read fTexelXRatio;
    property TexelYRatio: Single read fTexelYRatio;

    property TexelWidth:  Integer read fTexelWidth  write SetTexelWidth;
    property TexelHeight: Integer read fTexelHeight write SetTexelHeight;
  end;
{$ENDREGION}

{$REGION 'TOpenGLFrameBuffer'}
  TOpenGLFrameBuffer = class(TSceneNode)
  private
    fFrameBuffer: GLuint;
    fDepthBuffer: GLuint;

    fTexture: TOpenGLTexture;

    fWidth:  Integer;
    fHeight: Integer;
    fDepth:  Boolean;
  public
    constructor Create(const AWidth, AHeight: Integer; const ADepth: Boolean = False);
    destructor Destroy; override;

    procedure Resize(const AWidth, AHeight: Integer; const ADepth: Boolean = False);

    procedure CreateBuffer;
    procedure DestroyBuffer;

    procedure Present;

    procedure Bind;   inline;
    procedure Unbind; inline;

    function Process(const Delta: Extended): Boolean; override;

    property FrameBuffer: GLuint read fFrameBuffer;
    property DepthBuffer: GLuint read fDepthBuffer;

    property Texture: TOpenGLTexture read fTexture;

    property Width:  Integer read fWidth;
    property Height: Integer read fHeight;
    property Depth:  Boolean read fDepth;
  end;
{$ENDREGION}

{$REGION 'TOpenGLMatrix'}
  TOpenGLMatrix = record helper for TMatrix4
    procedure GetModelView;
    procedure GetProjection;
    procedure GetTexture;

    procedure Load;

    procedure Debug;
  end;
{$ENDREGION}

implementation

{$REGION 'TOpenGLWindow'}
constructor TOpenGLWindow.Create;
begin
  fDeviceContext := 0;
  fRenderContext := 0;

  fMultiSampleLevel  := 0;
  fMultiSampleFormat := 0;

  fActiveScene := nil;

  inherited Create(AWidth, AHeight, AFullScreen);
end;

procedure TOpenGLWindow.CreateWindow;
var
  PixelFormatDesc: PIXELFORMATDESCRIPTOR;
  PixelFormat:     GLint;

  function InitializeMultiSample: Boolean;
  var
    Formats: GLint;
    iAttrib: array[0..21] of Integer;
    fAttrib: array[0..1]  of Single;
  begin
    fAttrib[0] := 0;
    fAttrib[1] := 0;

    iAttrib[0]  := WGL_DRAW_TO_WINDOW_ARB;
    iAttrib[1]  := 1;
    iAttrib[2]  := WGL_SUPPORT_OPENGL_ARB;
    iAttrib[3]  := 1;
    iAttrib[4]  := WGL_ACCELERATION_ARB;
    iAttrib[5]  := WGL_FULL_ACCELERATION_ARB;
    iAttrib[6]  := WGL_COLOR_BITS_ARB;
    iAttrib[7]  := 24;
    iAttrib[8]  := WGL_ALPHA_BITS_ARB;
    iAttrib[9]  := 8;
    iAttrib[10] := WGL_DEPTH_BITS_ARB;
    iAttrib[11] := 16;
    iAttrib[12] := WGL_STENCIL_BITS_ARB;
    iAttrib[13] := 0;
    iAttrib[14] := WGL_DOUBLE_BUFFER_ARB;
    iAttrib[15] := 1;
    iAttrib[16] := WGL_SAMPLE_BUFFERS_ARB;
    iAttrib[17] := 1;
    iAttrib[18] := WGL_SAMPLES_ARB;
    iAttrib[19] := 8;
    iAttrib[20] := 0;
    iAttrib[21] := 0;

    fMultiSampleLevel := 8;

    repeat
      iAttrib[19] := fMultiSampleLevel;

      if wglChoosePixelFormatARB(fDeviceContext, @iAttrib[0], @fAttrib[0], 1, @fMultiSampleFormat, @Formats) then exit(True);

      fMultiSampleLevel := fMultiSampleLevel div 2;
    until fMultiSampleLevel = 1;

    fMultiSampleLevel  := 0;
    fMultiSampleFormat := 0;
    Result             := False;
  end;
begin
  if not InitOpenGL then
    TOpenGLError.RaiseException('Failed to initialize OpenGL libraries');

  FillChar(PixelFormatDesc, sizeof(PixelFormatDesc), 0);
  with PixelFormatDesc do
  begin
    nSize        := sizeof(PIXELFORMATDESCRIPTOR);
    nVersion     := 1;
    dwFlags      := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    iPixelType   := PFD_TYPE_RGBA;
    cColorBits   := 32;
    cDepthBits   := 16;
    iLayerType   := PFD_MAIN_PLANE;
  end;

  inherited;

  fDeviceContext := GetDC(Handle);
  if fDeviceContext = 0 then
  begin
    DestroyWindow;
    TOpenGLError.RaiseException('Failed to get window device context');
  end;

  if fMultiSampleFormat = 0 then
  begin
    PixelFormat := ChoosePixelFormat(fDeviceContext, @PixelFormatDesc);

    if PixelFormat = 0 then
    begin
      DestroyWindow;
      TOpenGLError.RaiseException('Failed to select pixel format');
    end;
  end
  else
    PixelFormat := fMultiSampleFormat;

  if not SetPixelFormat(fDeviceContext, PixelFormat, @PixelFormatDesc) then
  begin
    DestroyWindow;
    TOpenGLError.RaiseException('Failed to set pixel format');
  end;

  fRenderContext := wglCreateContext(fDeviceContext);
  if fRenderContext = 0 then
  begin
    DestroyWindow;
    TOpenGLError.RaiseException('Failed to create render context');
  end;

  if not MakeCurrent then
  begin
    DestroyWindow;
    TOpenGLError.RaiseException('Failed to select render context');
  end;

  ReadExtensions;
  ReadImplementationProperties;

  if fMultiSampleFormat = 0 then
    if InitializeMultiSample then
    begin
      DestroyWindow;
      CreateWindow;
    end;

  wglSwapIntervalEXT(0);

  SetDisplaySize(DisplayWidth, DisplayHeight, DisplayFullScreen);

  Show;
end;

function TOpenGLWindow.DestroyWindow;
begin
  if fDeviceContext <> 0 then
    wglMakeCurrent(fDeviceContext, 0);

  if fRenderContext <> 0 then
    wglDeleteContext(fRenderContext);

  if (Handle <> 0) and (fDeviceContext <> 0) then
    ReleaseDC(Handle, fDeviceContext);

  fDeviceContext := 0;
  fRenderContext := 0;

  Result := inherited;
end;

function TOpenGLWindow.MakeCurrent;
begin
  Result := wglMakeCurrent(fDeviceContext, fRenderContext);
end;

procedure TOpenGLWindow.Present;
begin
  Winapi.Windows.SwapBuffers(fDeviceContext);
end;

procedure TOpenGLWindow.SetDisplaySize;
begin
  inherited;

  Projection := TMatrix4.CreatePerspective(45, DisplayAspect, 1, 100);

  glViewport(0, 0, DisplayWidth, DisplayHeight);
end;

function TOpenGLWindow.InitializeAssets;
begin
  glEnable(GL_COLOR_MATERIAL);
  glShadeModel(GL_FLAT);

  glEnable(GL_DEPTH_TEST);
  glDepthFunc(GL_LESS);

  glEnable(GL_CULL_FACE);
  glCullFace(GL_BACK);

  glEnable(GL_TEXTURE_2D);

  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);

  if fMultiSampleLevel > 0 then
    glEnable(GL_MULTISAMPLE_ARB);

  glClearColor(0.4, 0.6, 1, 1);
  glClearDepth(1);

  Projection := TMatrix4.CreatePerspective(45, DisplayAspect, 1, 100);

  Camera.LoadIdentity;
  Camera.LookAt(TVector4.Create(0, 0, 10), TVector4.Create(0, 0, 0), TVector4.Create(0, 1, 0));

  Result := True;
end;

function TOpenGLWindow.Cycle;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glMatrixMode(GL_PROJECTION);
  Projection.Load;

  glMatrixMode(GL_MODELVIEW);
  Camera.Load;

  Result := inherited;
end;

function TOpenGLWindow.Render;
begin
  if fActiveScene <> nil then
    Result := fActiveScene.Process(Delta)
  else
    Result := inherited;
end;
{$ENDREGION}

{$REGION 'TOpenGLView'}
constructor TOpenGLView.Create;
begin
  inherited Create;

  fWindow := AWindow;
end;

function TOpenGLView.Process;
begin
  glViewport(0, 0, fWindow.DisplayWidth, fWindow.DisplayHeight);
  Result := True;
end;
{$ENDREGION}

{$REGION 'TOpenGLView2D'}
class procedure TOpenGLView2D.View;
begin
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glOrtho(0, AWindow.DisplayWidth, AWindow.DisplayHeight, 0, 0, Depth);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

function TOpenGLView2D.Process;
begin
  Result := inherited;

  View(fWindow, Depth);
end;
{$ENDREGION}

{$REGION 'TOpenGLView3D'}
class procedure TOpenGLView3D.View;
//var
  //M: TMatrix4;
begin
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(FOV, AWindow.DisplayAspect, 1, Depth);
  //M := TMatrix4.CreatePerspectiveFieldOfView(PI / 4, AWindow.fDisplayAspect, 100, -100);
  //glLoadMatrixf(@M.Data2D[0, 0]);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

function TOpenGLView3D.Process;
begin
  Result := inherited;

  View(fWindow, fFOV, Depth);
end;
{$ENDREGION}

{$REGION 'TOpenGLViewIsometric'}
class procedure TOpenGLViewIsometric.View;
begin
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glOrtho(-AWindow.DisplayWidth, AWindow.DisplayWidth, -AWindow.DisplayHeight, AWindow.DisplayHeight, -Depth, Depth);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  glRotatef(30, 1.0, 0.0, 0.0);
  glRotatef(-135.0, 0.0, 1.0, 0.0);
end;

function TOpenGLViewIsometric.Process;
begin
  Result := inherited;

  View(fWindow, Depth);
end;
{$ENDREGION}

{$REGION 'TOpenGLCamera3D'}
function TOpenGLCamera3D.Process;
begin
  Result := inherited;

  gluLookAt(Position.X, Position.Y, Position.Z, Target.X, Target.Y, Target.Z, 0, 1, 0);
end;
{$ENDREGION}

{$REGION 'TOpenGLLight'}
constructor TOpenGLLight.Create;
begin
  inherited Create;

  fID := AID;
end;

function TOpenGLLight.Process;
begin
  if Ambient.Used  then glLightfv(fID, GL_AMBIENT,  @Ambient.Data[0]);
  if Diffuse.Used  then glLightfv(fID, GL_DIFFUSE,  @Diffuse.Data[0]);
  if Specular.Used then glLightfv(fID, GL_SPECULAR, @Specular.Data[0]);
  if Position.Used then glLightfv(fID, GL_POSITION, @Position.Data[0]);
  Result := True;
end;
{$ENDREGION}

{$REGION 'TOpenGLMaterial'}
function TOpenGLMaterial.Process;
begin
  if Ambient.Used   then glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE,   @Ambient.Data[0]);
  if Diffuse.Used   then glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE,   @Diffuse.Data[0]);
  if Specular.Used  then glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR,  @Specular.Data[0]);
  if Shininess.Used then glMaterialf (GL_FRONT_AND_BACK, GL_SHININESS, Shininess.Data[0]);
  if Emission.Used  then glMaterialfv(GL_FRONT_AND_BACK, GL_EMISSION,  @Emission.Data[0]);
  Result := True;
end;
{$ENDREGION}

{$REGION 'TOpenGLQuadric'}
procedure TOpenGLQuadric.SetTextured;
begin
  fTextured := Value;

  gluQuadricTexture(fQuadric, fTextured);
end;

procedure TOpenGLQuadric.SetFlat;
begin
  fFlat := Value;

  if fFlat then
    gluQuadricNormals(fQuadric, GLU_FLAT)
  else
    gluQuadricNormals(fQuadric, GLU_SMOOTH);
end;

procedure TOpenGLQuadric.SetOutside;
begin
  fOutside := Value;

  if fOutside then
    gluQuadricOrientation(fQuadric, GLU_OUTSIDE)
  else
    gluQuadricOrientation(fQuadric, GLU_INSIDE);
end;

constructor TOpenGLQuadric.Create;
begin
  inherited;

  fQuadric := gluNewQuadric;

  Textured := True;
  Flat     := False;
  Outside  := True;
end;

destructor TOpenGLQuadric.Destroy;
begin
  gluDeleteQuadric(fQuadric);

  inherited;
end;

class constructor TOpenGLQuadric.Create;
begin
  fStock := nil;
end;

class destructor TOpenGLQuadric.Destroy;
begin
  if fStock <> nil then
    fStock.Free;

  fStock := nil;
end;

class function TOpenGLQuadric.Stock;
begin
  if fStock = nil then
    fStock := TOpenGLQuadric.Create;

  Result := fStock;
end;
{$ENDREGION}

{$REGION 'TOpenGLRender'}
constructor TOpenGLRender.Create;
begin
  inherited;

  fID := 0;
end;

destructor TOpenGLRender.Destroy;
begin
  Uncompile;

  inherited;
end;

class function TOpenGLRender.CreateList;
begin
  Result := glGenLists(1);

  glNewList(Result, GL_COMPILE);
  try
    From;
  finally
    glEndList;
  end;
end;

class procedure TOpenGLRender.DrawTriangle;
var
  u, v: TVector4;
  n:    TVector4;
  d:    Single;
begin
  u := b - c;
  v := a - b;

  n.x := u.y * v.z - u.z * v.y;
  n.y := u.z * v.x - u.x * v.z;
  n.z := u.x * v.y - u.y * v.x;

  d := sqrt(n.x * n.x + n.y * n.y + n.z * n.z);

  n := n / d;

  glNormal3fv(@n.Data[0]);

  glTexCoord2f(0, 0); glVertex3fv(@a.Data[0]);
  glTexCoord2f(1, 0); glVertex3fv(@b.Data[0]);
  glTexCoord2f(1, 1); glVertex3fv(@c.Data[0]);
end;

procedure TOpenGLRender.DoRender;
begin
  {}
end;

procedure TOpenGLRender.Compile;
begin
  Uncompile;

  fID := CreateList(DoRender);
end;

procedure TOpenGLRender.Uncompile;
begin
  if fID = 0 then exit;

  glDeleteLists(fID, 1);
  fID := 0;
end;

function TOpenGLRender.Process;
begin
  Result := True;

  if fID <> 0 then
    glCallList(fID)
  else
    DoRender;
end;
{$ENDREGION}

{$REGION 'TOpenGLPlain'}
class procedure TOpenGLPlain.Draw;
begin
  glBegin(GL_QUADS);

  glNormal3f(0, 1, 0);

  glTexCoord2f(0, 0); glVertex3f(-1, 0, -1);
  glTexCoord2f(0, 1); glVertex3f(-1, 0,  1);
  glTexCoord2f(1, 1); glVertex3f( 1, 0,  1);
  glTexCoord2f(1, 0); glVertex3f( 1, 0, -1);

  glEnd;
end;

procedure TOpenGLPlain.DoRender;
begin
  Draw;
end;
{$ENDREGION}

{$REGION 'TOpenGLCube'}
class procedure TOpenGLCube.Draw;
{$REGION 'Face texture coords'}
const
  T = 1 / 6;

  FT: array[Boolean] of array[0..5] of array[0..3] of array[0..1] of Single = (
    (
      ((0, 0), (1, 0), (1, 1), (0, 1)),
      ((1, 0), (1, 1), (0, 1), (0, 0)),
      ((0, 1), (0, 0), (1, 0), (1, 1)),
      ((1, 1), (0, 1), (0, 0), (1, 0)),
      ((1, 0), (1, 1), (0, 1), (0, 0)),
      ((0, 0), (1, 0), (1, 1), (0, 1))
    ),
    (
      ((T * 0, 0), (T * 0 + T, 0), (T * 0 + T, 1), (T * 0, 1)),
      ((T * 1, 0), (T * 1 + T, 0), (T * 1 + T, 1), (T * 1, 1)),
      ((T * 2, 0), (T * 2 + T, 0), (T * 2 + T, 1), (T * 2, 1)),
      ((T * 3, 0), (T * 3 + T, 0), (T * 3 + T, 1), (T * 3, 1)),
      ((T * 4, 0), (T * 4 + T, 0), (T * 4 + T, 1), (T * 4, 1)),
      ((T * 5, 0), (T * 5 + T, 0), (T * 5 + T, 1), (T * 5, 1))
    )
  );
{$ENDREGION}
begin
  glBegin(GL_QUADS);

  glNormal3f(0, 0, 1);

  glTexCoord2f(FT[FaceTextures][0][3][0], FT[FaceTextures][0][3][1]); glVertex3f(-1, -1,  1);
  glTexCoord2f(FT[FaceTextures][0][2][0], FT[FaceTextures][0][2][1]); glVertex3f( 1, -1,  1);
  glTexCoord2f(FT[FaceTextures][0][1][0], FT[FaceTextures][0][1][1]); glVertex3f( 1,  1,  1);
  glTexCoord2f(FT[FaceTextures][0][0][0], FT[FaceTextures][0][0][1]); glVertex3f(-1,  1,  1);

  glNormal3f(1, 0, 0);
  glTexCoord2f(FT[FaceTextures][1][3][0], FT[FaceTextures][1][3][1]); glVertex3f( 1, -1,  1);
  glTexCoord2f(FT[FaceTextures][1][2][0], FT[FaceTextures][1][2][1]); glVertex3f( 1, -1, -1);
  glTexCoord2f(FT[FaceTextures][1][1][0], FT[FaceTextures][1][1][1]); glVertex3f( 1,  1, -1);
  glTexCoord2f(FT[FaceTextures][1][0][0], FT[FaceTextures][1][0][1]); glVertex3f( 1,  1,  1);

  glNormal3f(0, 0, -1);
  glTexCoord2f(FT[FaceTextures][2][3][0], FT[FaceTextures][2][3][1]); glVertex3f( 1, -1, -1);
  glTexCoord2f(FT[FaceTextures][2][2][0], FT[FaceTextures][2][2][1]); glVertex3f(-1, -1, -1);
  glTexCoord2f(FT[FaceTextures][2][1][0], FT[FaceTextures][2][1][1]); glVertex3f(-1,  1, -1);
  glTexCoord2f(FT[FaceTextures][2][0][0], FT[FaceTextures][2][0][1]); glVertex3f( 1,  1, -1);

  glNormal3f(-1, 0, 0);
  glTexCoord2f(FT[FaceTextures][3][3][0], FT[FaceTextures][3][3][1]); glVertex3f(-1, -1, -1);
  glTexCoord2f(FT[FaceTextures][3][2][0], FT[FaceTextures][3][2][1]); glVertex3f(-1, -1,  1);
  glTexCoord2f(FT[FaceTextures][3][1][0], FT[FaceTextures][3][1][1]); glVertex3f(-1,  1,  1);
  glTexCoord2f(FT[FaceTextures][3][0][0], FT[FaceTextures][3][0][1]); glVertex3f(-1,  1, -1);

  glNormal3f(0, 1, 0);
  glTexCoord2f(FT[FaceTextures][4][3][0], FT[FaceTextures][4][3][1]); glVertex3f( 1,  1, -1);
  glTexCoord2f(FT[FaceTextures][4][2][0], FT[FaceTextures][4][2][1]); glVertex3f(-1,  1, -1);
  glTexCoord2f(FT[FaceTextures][4][1][0], FT[FaceTextures][4][1][1]); glVertex3f(-1,  1,  1);
  glTexCoord2f(FT[FaceTextures][4][0][0], FT[FaceTextures][4][0][1]); glVertex3f( 1,  1,  1);

  glNormal3f(0, -1, 0);
  glTexCoord2f(FT[FaceTextures][5][3][0], FT[FaceTextures][5][3][1]); glVertex3f(-1, -1, -1);
  glTexCoord2f(FT[FaceTextures][5][2][0], FT[FaceTextures][5][2][1]); glVertex3f( 1, -1, -1);
  glTexCoord2f(FT[FaceTextures][5][1][0], FT[FaceTextures][5][1][1]); glVertex3f( 1, -1,  1);
  glTexCoord2f(FT[FaceTextures][5][0][0], FT[FaceTextures][5][0][1]); glVertex3f(-1, -1,  1);

  glEnd;
end;

procedure TOpenGLCube.DoRender;
begin
  Draw;
end;
{$ENDREGION}

{$REGION 'TOpenGLIcosahedron'}
class procedure TOpenGLIcosahedron.Draw;
var
  i, j: Integer;
begin
  for i := 0 to 19 do
  begin
    glBegin(GL_POLYGON);

    if Flat then glNormal3fv(@NormalData[i][0]);

    for j := 2 downto 0 do
    begin
      case j of
        0: glTexCoord2f(0, 0);
        1: glTexCoord2f(0, 1);
        2: glTexCoord2f(1, 1);
      end;

      if not Flat then glNormal3fv(@VertexData[VertexIndex[i, j]]);

      glVertex3fv(@VertexData[VertexIndex[i, j]]);
    end;
    glEnd;
  end;
end;

procedure TOpenGLIcosahedron.DoRender;
begin
  Draw(fFlat);
end;
{$ENDREGION}

{$REGION 'TOpenGLSphere'}
class procedure TOpenGLSphere.Draw;
var
  s: Integer;
begin
  if Quadric = nil then Quadric := TOpenGLQuadric.Stock;
  if Stacks = -1 then s := Slices else s := Stacks;
  gluSphere(Quadric.Quadric, Radius, Slices, s);
end;

procedure TOpenGLSphere.DoRender;
begin
  Draw(fRadius, fSlices, fStacks, fQuadric);
end;
{$ENDREGION}

{$REGION 'TOpenGLCylinder'}
class procedure TOpenGLCylinder.Draw;
begin
  if Quadric = nil then Quadric := TOpenGLQuadric.Stock;

  gluCylinder(Quadric.Quadric, BaseRadius, TopRadius, Height, Slices, Stacks);
end;

procedure TOpenGLCylinder.DoRender;
begin
  Draw(fBaseRadius, fTopRadius, fHeight, fSlices, fStacks, fQuadric);
end;
{$ENDREGION}

{$REGION 'TOpenGLCone'}
class procedure TOpenGLCone.Draw;
var
  i:          Integer;
  p1, p2, p3: TVector4;
  Theta:      Single;
begin
  Theta := (PI * 2) / Slices;

  p3.SetValue(0, Height, 0);

  for i := 0 to Slices - 1 do
  begin
    p1.SetValue(sin(Theta *  i)      * Radius, 0, cos(Theta *  i)      * Radius);
    p2.SetValue(sin(Theta * (i + 1)) * Radius, 0, cos(Theta * (i + 1)) * Radius);

    DrawTriangle(p1, p2, p3);
  end;
end;

procedure TOpenGLCone.DoRender;
begin
  Draw(fRadius, fHeight, fSlices);
end;
{$ENDREGION}

{$REGION 'TOpenGLShader'}
constructor TOpenGLShader.Create;
var
  SrcPtr:   PAnsiChar;
  SrcLen:   GLint;

  Compiled: GLint;

  LogStr:   AnsiString;
  LogLen:   GLint;
begin
  inherited Create;

  fShaderType := AShaderType;
  fID := glCreateShader(AShaderType);

  SrcPtr := PAnsiChar(ASource);
  SrcLen := Length(ASource);

  glShaderSource(fID, 1, @SrcPtr, @SrcLen);
  glCompileShader(fID);

  glGetShaderiv(fID, GL_COMPILE_STATUS, @Compiled);

  if Compiled <> GL_TRUE then
  begin
    glGetShaderiv(fID, GL_INFO_LOG_LENGTH, @LogLen);
    SetLength(LogStr, LogLen);

    glGetShaderInfoLog(fID, LogLen, LogLen, PAnsiChar(LogStr));

    TOpenGLError.RaiseException('Failed to compile shader:'#13#10 + String(LogStr));
  end;
end;

destructor TOpenGLShader.Destroy;
begin
  glDeleteShader(fID);

  inherited;
end;
{$ENDREGION}

{$REGION 'TOpenGLShaderProgram'}
constructor TOpenGLShaderProgram.Create;
begin
  inherited Create;

  fID := glCreateProgram;

  fVertexShader   := TOpenGLShader.Create(AVertexSrc,   GL_VERTEX_SHADER);
  fFragmentShader := TOpenGLShader.Create(AFragmentSrc, GL_FRAGMENT_SHADER);

  glAttachShader(fID, fVertexShader.ID);
  glAttachShader(fID, fFragmentShader.ID);

  glLinkProgram(fID);
end;

destructor TOpenGLShaderProgram.Destroy;
begin
  fVertexShader.Free;
  fFragmentShader.Free;

  glDeleteProgram(fID);

  inherited;
end;

class function TOpenGLShaderProgram.CreateFromFiles;
  function LoadString(FileName: String): AnsiString;
  var
    s: String;
  begin
    s.Load(FileStream(FileName));

    Result := AnsiString(s);
  end;
var
  VertexSrc:   AnsiString;
  FragmentSrc: AnsiString;
begin
  VertexSrc   := LoadString(AVertexFileName);
  FragmentSrc := LoadString(AFragmentFileName);

  Result := TOpenGLShaderProgram.Create(VertexSrc, FragmentSrc);
end;

function TOpenGLShaderProgram.MapUniform;
begin
  if (UID < 0) or (UID > high(fUniformMap)) then TOpenGLError.RaiseException('Invalid uniform ID');

  Result := glGetUniformLocation(fID, PAnsiChar(Name));
  if Result = 0 then TOpenGLError.RaiseException('Unknown uniform name "' + String(Name) + '"');

  fUniformMap[UID] := Result;
end;

procedure TOpenGLShaderProgram.Uniform(const UID: Integer; Value: array of GLfloat);
begin
  case Length(Value) of
    1: glUniform1f(fUniformMap[UID], Value[0]);
    2: glUniform2f(fUniformMap[UID], Value[0], Value[1]);
    3: glUniform3f(fUniformMap[UID], Value[0], Value[1], Value[2]);
    4: glUniform4f(fUniformMap[UID], Value[0], Value[1], Value[2], Value[3]);
  else
    TOpenGLError.RaiseException('Invalid uniform data size');
  end;
end;

procedure TOpenGLShaderProgram.Uniform(const Name: AnsiString; Value: array of GLfloat);
var
  fLocation: GLint;
begin
  fLocation := glGetUniformLocation(fID, PAnsiChar(Name));
  if fLocation = 0 then TOpenGLError.RaiseException('Unknown uniform name "' + String(Name) + '"');

  case Length(Value) of
    1: glUniform1f(fLocation, Value[0]);
    2: glUniform2f(fLocation, Value[0], Value[1]);
    3: glUniform3f(fLocation, Value[0], Value[1], Value[2]);
    4: glUniform4f(fLocation, Value[0], Value[1], Value[2], Value[3]);
  else
    TOpenGLError.RaiseException('Invalid uniform data size');
  end;
end;

procedure TOpenGLShaderProgram.Bind;
begin
  glUseProgram(fID);
end;

procedure TOpenGLShaderProgram.Unbind;
begin
  glUseProgram(0);
end;

function TOpenGLShaderProgram.Process;
begin
  Result := True;
  Bind;
end;
{$ENDREGION}

{$REGION 'TOpenGLTexture'}
procedure TOpenGLTexture.SetTexelWidth;
begin
  fTexelWidth := ATexelWidth;
  fTexelXRatio := fTexelWidth / fWidth;
end;

procedure TOpenGLTexture.SetTexelHeight;
begin
  fTexelHeight := ATexelHeight;
  fTexelYRatio := fTexelHeight / fHeight;
end;

constructor TOpenGLTexture.Create(const AWidth, AHeight: Integer; const MinFilter: GLint = GL_NEAREST; const MagFilter: GLint = GL_NEAREST; const Depth: Boolean = False);
begin
  inherited Create;

  fWidth  := AWidth;
  fHeight := AHeight;

  glGenTextures(1, @fID);

  Bind;

  if Depth then
    glTexImage2D(GL_TEXTURE_2D, 0, GL_DEPTH_COMPONENT32, fWidth, fHeight, 0, GL_DEPTH_COMPONENT, GL_FLOAT, nil)
  else
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA8, fWidth, fHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, MinFilter);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, MagFilter);

  TexelWidth  := 1;
  TexelHeight := 1;

  Unbind;
end;

constructor TOpenGLTexture.Create(const ABitmap: TBitmap; const MinFilter: GLint = GL_NEAREST; const MagFilter: GLint = GL_NEAREST);
begin
  inherited Create;

  fWidth  := ABitmap.Width;
  fHeight := ABitmap.Height;

  glGenTextures(1, @fID);

  Bind;

  if ((MinFilter >= GL_NEAREST_MIPMAP_NEAREST) and (MinFilter <= GL_LINEAR_MIPMAP_LINEAR))
  or ((MagFilter >= GL_NEAREST_MIPMAP_NEAREST) and (MagFilter <= GL_LINEAR_MIPMAP_LINEAR)) then
    gluBuild2DMipmaps(GL_TEXTURE_2D, 3, fWidth, fHeight, GL_RGBA, GL_UNSIGNED_BYTE, ABitmap.BitmapData.Scan0)
  else
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, fWidth, fHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, ABitmap.BitmapData.Scan0);

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, MinFilter);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, MagFilter);

  TexelWidth  := 1;
  TexelHeight := 1;

  Unbind;
end;

constructor TOpenGLTexture.Create(const AFileName: String; const MinFilter: GLint = GL_NEAREST; const MagFilter: GLint = GL_NEAREST);
var
  B: TBitmap;
begin
  B := TBitmap.Create;

  try
    if not B.LoadFromFile(AFileName) then TOpenGLError.RaiseException('Failed to load bitmap ' + AFileName);

    B.SwapRB;

    Create(B, MinFilter, MagFilter);
  finally
    B.Free;
  end;
end;

destructor TOpenGLTexture.Destroy;
begin
  if fID <> 0 then
    glDeleteTextures(1, @fID);

  inherited;
end;

procedure TOpenGLTexture.Bind;
begin
  glBindTexture(GL_TEXTURE_2D, fID);
end;

procedure TOpenGLTexture.Unbind;
begin
  glBindTexture(GL_TEXTURE_2D, 0);
end;

function TOpenGLTexture.Process;
begin
  Result := True;
  glEnable(GL_TEXTURE_2D);
  Bind;
end;

procedure TOpenGLTexture.Draw2D;
var
  tx1, tx2: Single;
  ty1, ty2: Single;
begin
  tx1 := SrcX * fTexelXRatio; tx2 := (SrcX + SrcW) * fTexelXRatio;
  ty1 := SrcY * fTexelYRatio; ty2 := (SrcY + SrcH) * fTexelYRatio;

  glTexCoord2f(tx1, ty1); glVertex3i(DestX,         DestY,         DestZ);
  glTexCoord2f(tx2, ty1); glVertex3i(DestX + DestW, DestY,         DestZ);
  glTexCoord2f(tx2, ty2); glVertex3i(DestX + DestW, DestY + DestH, DestZ);
  glTexCoord2f(tx1, ty2); glVertex3i(DestX,         DestY + DestH, DestZ);
end;
{$ENDREGION}

{$REGION 'TOpenGLFrameBuffer'}
constructor TOpenGLFrameBuffer.Create;
begin
  inherited Create;

  fFrameBuffer := 0;
  fDepthBuffer := 0;

  fTexture := nil;

  Resize(AWidth, AHeight, ADepth);
end;

destructor TOpenGLFrameBuffer.Destroy;
begin
  DestroyBuffer;

  inherited;
end;

procedure TOpenGLFrameBuffer.Resize;
begin
  DestroyBuffer;

  fWidth  := AWidth;
  fHeight := AHeight;
  fDepth  := ADepth;

  CreateBuffer;
end;

procedure TOpenGLFrameBuffer.CreateBuffer;
begin
  fTexture := TOpenGLTexture.Create(fWidth, fHeight, GL_NEAREST, GL_NEAREST, fDepth);
  fTexture.Bind;

  glGenFramebuffers(1, @fFrameBuffer);
  glBindFramebuffer(GL_FRAMEBUFFER, fFrameBuffer);

  if fDepth then
  begin
  	glDrawBuffer(GL_NONE);
	  glReadBuffer(GL_NONE);

    glFramebufferTexture2D(GL_FRAMEBUFFER, GL_DEPTH_ATTACHMENT, GL_TEXTURE_2D, fTexture.fID, 0);
  end
  else
  begin
    glFramebufferTexture2D(GL_FRAMEBUFFER, GL_COLOR_ATTACHMENT0, GL_TEXTURE_2D, fTexture.fID, 0);

    glGenRenderbuffers(1, @fDepthBuffer);
    glBindRenderbuffer(GL_RENDERBUFFER, fDepthBuffer);

    glRenderbufferStorage(GL_RENDERBUFFER, GL_DEPTH_COMPONENT24, fWidth, fHeight);

    glFramebufferRenderbuffer(GL_FRAMEBUFFER, GL_DEPTH_ATTACHMENT, GL_RENDERBUFFER, fDepthBuffer);
  end;

  if glCheckFramebufferStatus(GL_FRAMEBUFFER) <> GL_FRAMEBUFFER_COMPLETE then
    TOpenGLError.RaiseException('Failed to create frame buffer');

  Unbind;
end;

procedure TOpenGLFrameBuffer.DestroyBuffer;
begin
  if fFrameBuffer <> 0 then
    glDeleteFramebuffers(1, @fFrameBuffer);

  if fDepthBuffer <> 0 then
    glDeleteRenderbuffers(1, @fDepthBuffer);

  if fTexture <> nil then
    fTexture.Free;

  fFrameBuffer := 0;
  fDepthBuffer := 0;

  fTexture := nil;
end;

procedure TOpenGLFrameBuffer.Present;
begin
  Unbind;

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;

  glOrtho(0, fWidth, 0, fHeight, -1, 1);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  fTexture.Bind;

  glDisable(GL_DEPTH_TEST);

  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2i(0,      0);
    glTexCoord2f(1, 0); glVertex2i(fWidth, 0);
    glTexCoord2f(1, 1); glVertex2i(fWidth, fHeight);
    glTexCoord2f(0, 1); glVertex2i(0,      fHeight);
  glEnd;
end;

procedure TOpenGLFrameBuffer.Bind;
begin
  glBindFramebuffer(GL_FRAMEBUFFER, fFrameBuffer);
  glViewport(0, 0, fWidth, fHeight);
end;

procedure TOpenGLFrameBuffer.Unbind;
begin
  glBindFramebuffer(GL_FRAMEBUFFER, 0);
end;

function TOpenGLFrameBuffer.Process;
begin
  Result := True;
  Bind;
end;
{$ENDREGION}

{$REGION 'TOpenGLMatrix'}
procedure TOpenGLMatrix.GetModelView;
begin
  glGetFloatv(GL_MODELVIEW_MATRIX, @Data2D[0, 0]);
end;

procedure TOpenGLMatrix.GetProjection;
begin
  glGetFloatv(GL_PROJECTION_MATRIX, @Data2D[0, 0]);
end;

procedure TOpenGLMatrix.GetTexture;
begin
  glGetFloatv(GL_TEXTURE_MATRIX, @Data2D[0, 0]);
end;

procedure TOpenGLMatrix.Load;
begin
  glLoadMatrixf(@Data2D[0, 0]);
end;

procedure TOpenGLMatrix.Debug;
var
  x, y: Integer;
begin
  for x := 0 to 3 do
  begin
    for y := 0 to 3 do
      Write(String.Float(Data2D[x, y], 4) + ', ');

    Writeln;
  end;
end;
{$ENDREGION}

end.