OpenGLCore/examples/vertexarrayobject/uMainForm.pas

unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  uglcContext, uglcShader, uglcArrayBuffer, uglcTypes, uglcBitmap, uglcVertexArrayObject;

type
  TMainForm = class(TForm)
    ApplicationProperties: TApplicationProperties;
    LogLB: TListBox;
    RenderPanel: TPanel;
    procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RenderPanelResize(Sender: TObject);
  private
    fContext: TglcContext;
    fShader: TglcShaderProgram;
    fVAO: TglcVertexArrayObject;
    fTexture: TglcBitmap2D;
    procedure Log(aSender: TObject; const aMsg: String);
    procedure Render;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  dglOpenGL, ugluVector;

const
  SHADER_FILE  = 'shader.glsl';
  TEXTURE_FILE = 'data\texture.png';

  LAYOUT_LOCATION_POS = 0;
  LAYOUT_LOCATION_TEX = 1;

  UNIFORM_NAME_TEXTURE = 'uTexture';

type
  TVertex = packed record
    pos: TgluVector3f;
    tex: TgluVector2f;
  end;
  PVertex = ^TVertex;

procedure CheckGlError;
var
  err: GLenum;
begin
  err := glGetError();
  if (err <> 0) then begin
    ShowMessage('ERROR: 0x' + IntToHex(err, 16));
    halt;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  pf: TglcContextPixelFormatSettings;
  p: PVertex;
  texData: TglcBitmapData;
  vbo: TglcArrayBuffer;
begin
  pf := TglcContext.MakePF();
  fContext := TglcContext.GetPlatformClass.Create(RenderPanel, pf);
  fContext.BuildContext;

  Log(self, glGetString(GL_VERSION));

  fShader := TglcShaderProgram.Create(@Log);
  fShader.LoadFromFile(ExtractFilePath(Application.ExeName) + SHADER_FILE);
  fShader.Compile;
  fShader.Uniform1i(UNIFORM_NAME_TEXTURE, 0);

  vbo := TglcArrayBuffer.Create(TglcBufferTarget.btArrayBuffer);
  vbo.BufferData(4, sizeof(TVertex), TglcBufferUsage.buStaticDraw, nil);
  p := vbo.MapBuffer(TglcBufferAccess.baWriteOnly);
  try
    p^.pos := gluVector3f(-0.5, -0.5, 0);
    p^.tex := gluVector2f( 0.0,  1.0);
    inc(p);

    p^.pos := gluVector3f( 0.5, -0.5, 0);
    p^.tex := gluVector2f( 1.0,  1.0);
    inc(p);

    p^.pos := gluVector3f( 0.5,  0.5, 0);
    p^.tex := gluVector2f( 1.0,  0.0);
    inc(p);

    p^.pos := gluVector3f(-0.5,  0.5, 0);
    p^.tex := gluVector2f( 0.0,  0.0);
    inc(p);
  finally
    vbo.UnmapBuffer;
  end;

  fVAO := TglcVertexArrayObject.Create;
  fVAO.BindArrayBuffer(vbo, true);
  fVAO.VertexAttribPointer(LAYOUT_LOCATION_POS, 3, GL_FLOAT, False, SizeOf(TVertex), GLint(@PVertex(nil)^.pos));
  fVAO.VertexAttribPointer(LAYOUT_LOCATION_TEX, 2, GL_FLOAT, False, SizeOf(TVertex), GLint(@PVertex(nil)^.tex));

  fTexture := TglcBitmap2D.Create;
  texData := TglcBitmapData.Create;
  try
    texData.LoadFromFile(ExtractFilePath(Application.ExeName) + TEXTURE_FILE);
    fTexture.UploadData(texData);
  finally
    FreeAndNil(texData);
  end;
end;

procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
begin
  Render;
  Done := false;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(fTexture);
  FreeAndNil(fVAO);
  FreeAndNil(fShader);
  FreeAndNil(fContext);
end;

procedure TMainForm.RenderPanelResize(Sender: TObject);
begin
  if Assigned(fContext) then begin
    glViewport(0, 0, RenderPanel.ClientWidth, RenderPanel.ClientHeight);
  end;
end;

procedure TMainForm.Log(aSender: TObject; const aMsg: String);
begin
  LogLB.Items.Add(aMsg);
end;

procedure TMainForm.Render;
begin
  CheckGlError;

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  fTexture.Bind;
  fShader.Enable;
  fVAO.Bind;

  glDrawArrays(GL_QUADS, 0, 4);

  fVAO.Unbind;
  fShader.Disable;
  fTexture.Unbind;

  fContext.SwapBuffers;
end;

end.