examples/vertexarrayobject/uMainForm.pas

   1 unit uMainForm;
   2
   3 {$mode objfpc}{$H+}
   4
   5 interface
   6
   7 uses
   8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
   9   uglcContext, uglcShader, uglcArrayBuffer, uglcTypes, uglcBitmap, uglcVertexArrayObject;
  10
  11 type
  12   TMainForm = class(TForm)
  13     ApplicationProperties: TApplicationProperties;
  14     LogLB: TListBox;
  15     RenderPanel: TPanel;
  16     procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
  17     procedure FormCreate(Sender: TObject);
  18     procedure FormDestroy(Sender: TObject);
  19     procedure RenderPanelResize(Sender: TObject);
  20   private
  21     fContext: TglcContext;
  22     fShader: TglcShaderProgram;
  23     fVAO: TglcVertexArrayObject;
  24     fTexture: TglcBitmap2D;
  25     procedure Log(aSender: TObject; const aMsg: String);
  26     procedure Render;
  27   public
  28     { public declarations }
  29   end;
  30
  31 var
  32   MainForm: TMainForm;
  33
  34 implementation
  35
  36 {$R *.lfm}
  37
  38 uses
  39   dglOpenGL, ugluVector;
  40
  41 const
  42   SHADER_FILE  = 'shader.glsl';
  43   TEXTURE_FILE = 'data\texture.png';
  44
  45   LAYOUT_LOCATION_POS = 0;
  46   LAYOUT_LOCATION_TEX = 1;
  47
  48   UNIFORM_NAME_TEXTURE = 'uTexture';
  49
  50 type
  51   TVertex = packed record
  52     pos: TgluVector3f;
  53     tex: TgluVector2f;
  54   end;
  55   PVertex = ^TVertex;
  56
  57 procedure CheckGlError;
  58 var
  59   err: GLenum;
  60 begin
  61   err := glGetError();
  62   if (err <> 0) then begin
  63     ShowMessage('ERROR: 0x' + IntToHex(err, 16));
  64     halt;
  65   end;
  66 end;
  67
  68 procedure TMainForm.FormCreate(Sender: TObject);
  69 var
  70   pf: TglcContextPixelFormatSettings;
  71   p: PVertex;
  72   texData: TglcBitmapData;
  73   vbo: TglcArrayBuffer;
  74 begin
  75   pf := TglcContext.MakePF();
  76   fContext := TglcContext.GetPlatformClass.Create(RenderPanel, pf);
  77   fContext.BuildContext;
  78
  79   Log(self, glGetString(GL_VERSION));
  80
  81   fShader := TglcShaderProgram.Create(@Log);
  82   fShader.LoadFromFile(ExtractFilePath(Application.ExeName) + SHADER_FILE);
  83   fShader.Compile;
  84   fShader.Uniform1i(UNIFORM_NAME_TEXTURE, 0);
  85
  86   vbo := TglcArrayBuffer.Create(TglcBufferTarget.btArrayBuffer);
  87   vbo.BufferData(4, sizeof(TVertex), TglcBufferUsage.buStaticDraw, nil);
  88   p := vbo.MapBuffer(TglcBufferAccess.baWriteOnly);
  89   try
  90     p^.pos := gluVector3f(-0.5, -0.5, 0);
  91     p^.tex := gluVector2f( 0.0,  1.0);
  92     inc(p);
  93
  94     p^.pos := gluVector3f( 0.5, -0.5, 0);
  95     p^.tex := gluVector2f( 1.0,  1.0);
  96     inc(p);
  97
  98     p^.pos := gluVector3f( 0.5,  0.5, 0);
  99     p^.tex := gluVector2f( 1.0,  0.0);
 100     inc(p);
 101
 102     p^.pos := gluVector3f(-0.5,  0.5, 0);
 103     p^.tex := gluVector2f( 0.0,  0.0);
 104     inc(p);
 105   finally
 106     vbo.UnmapBuffer;
 107   end;
 108
 109   fVAO := TglcVertexArrayObject.Create;
 110   fVAO.BindArrayBuffer(vbo, true);
 111   fVAO.VertexAttribPointer(LAYOUT_LOCATION_POS, 3, GL_FLOAT, False, SizeOf(TVertex), GLint(@PVertex(nil)^.pos));
 112   fVAO.VertexAttribPointer(LAYOUT_LOCATION_TEX, 2, GL_FLOAT, False, SizeOf(TVertex), GLint(@PVertex(nil)^.tex));
 113
 114   fTexture := TglcBitmap2D.Create;
 115   texData := TglcBitmapData.Create;
 116   try
 117     texData.LoadFromFile(ExtractFilePath(Application.ExeName) + TEXTURE_FILE);
 118     fTexture.UploadData(texData);
 119   finally
 120     FreeAndNil(texData);
 121   end;
 122 end;
 123
 124 procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
 125 begin
 126   Render;
 127   Done := false;
 128 end;
 129
 130 procedure TMainForm.FormDestroy(Sender: TObject);
 131 begin
 132   FreeAndNil(fTexture);
 133   FreeAndNil(fVAO);
 134   FreeAndNil(fShader);
 135   FreeAndNil(fContext);
 136 end;
 137
 138 procedure TMainForm.RenderPanelResize(Sender: TObject);
 139 begin
 140   if Assigned(fContext) then begin
 141     glViewport(0, 0, RenderPanel.ClientWidth, RenderPanel.ClientHeight);
 142   end;
 143 end;
 144
 145 procedure TMainForm.Log(aSender: TObject; const aMsg: String);
 146 begin
 147   LogLB.Items.Add(aMsg);
 148 end;
 149
 150 procedure TMainForm.Render;
 151 begin
 152   CheckGlError;
 153
 154   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 155
 156   fTexture.Bind;
 157   fShader.Enable;
 158   fVAO.Bind;
 159
 160   glDrawArrays(GL_QUADS, 0, 4);
 161
 162   fVAO.Unbind;
 163   fShader.Disable;
 164   fTexture.Unbind;
 165
 166   fContext.SwapBuffers;
 167 end;
 168
 169 end.
 170