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.