|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156 |
- unit uMainForm;
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
- uglcContext, uglcShader, uglcArrayBuffer, uglcTypes, uglcBitmap;
-
- 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;
- fVBO: TglcArrayBuffer;
- 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 TMainForm.FormCreate(Sender: TObject);
- var
- pf: TglcContextPixelFormatSettings;
- p: PVertex;
- texData: TglcBitmapData;
- begin
- pf := TglcContext.MakePF();
- fContext := TglcContext.GetPlatformClass.Create(RenderPanel, pf);
- fContext.BuildContext;
-
- fShader := TglcShaderProgram.Create(@Log);
- fShader.LoadFromFile(ExtractFilePath(Application.ExeName) + SHADER_FILE);
- fShader.Compile;
- fShader.Uniform1i(UNIFORM_NAME_TEXTURE, 0);
-
- fVBO := TglcArrayBuffer.Create(TglcBufferTarget.btArrayBuffer);
- fVBO.BufferData(4, sizeof(TVertex), TglcBufferUsage.buStaticDraw, nil);
- p := fVBO.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
- fVBO.UnmapBuffer;
- end;
-
- 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(fVBO);
- 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
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- fVBO.Bind;
- fTexture.Bind;
- fShader.Enable;
-
- glEnableVertexAttribArray(LAYOUT_LOCATION_POS);
- glVertexAttribPointer(LAYOUT_LOCATION_POS, 3, GL_FLOAT, False, SizeOf(TVertex), @PVertex(nil)^.pos);
-
- glEnableVertexAttribArray(LAYOUT_LOCATION_TEX);
- glVertexAttribPointer(LAYOUT_LOCATION_TEX, 2, GL_FLOAT, False, SizeOf(TVertex), @PVertex(nil)^.tex);
-
- glDrawArrays(GL_QUADS, 0, fVBO.DataCount);
-
- glDisableVertexAttribArray(LAYOUT_LOCATION_POS);
- glDisableVertexAttribArray(LAYOUT_LOCATION_TEX);
-
- fShader.Disable;
- fTexture.Unbind;
- fVBO.Unbind;
-
- fContext.SwapBuffers;
- end;
-
- end.
-
|