unit uMainForm; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, uglcContext, uglcShader, uglcArrayBuffer, uglcTypes; type TMainForm = class(TForm) ApplicationProperties: TApplicationProperties; LogLB: TListBox; RenderPanel2: TPanel; RenderPanel1: TPanel; procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormResize(Sender: TObject); private fContext1: TglcContext; fContext2: TglcContext; fShader: TglcShaderProgram; fVBO: TglcArrayBuffer; 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'; LAYOUT_LOCATION_POS = 0; procedure TMainForm.FormCreate(Sender: TObject); type TVertex = packed record pos: TgluVector3f; end; PVertex = ^TVertex; var pf: TglcContextPixelFormatSettings; p: PVertex; begin pf := TglcContext.MakePF(); fContext1 := TglcContext.GetPlatformClass.Create(RenderPanel1, pf); fContext1.BuildContext; fContext2 := TglcContext.GetPlatformClass.Create(RenderPanel2, pf, fContext1); fContext2.BuildContext; fContext1.Activate; fShader := TglcShaderProgram.Create(@Log); fShader.LoadFromFile(ExtractFilePath(Application.ExeName) + SHADER_FILE); fShader.Compile; 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); inc(p); p^.pos := gluVector3f( 0.5, -0.5, 0); inc(p); p^.pos := gluVector3f( 0.5, 0.5, 0); inc(p); p^.pos := gluVector3f(-0.5, 0.5, 0); inc(p); finally fVBO.UnmapBuffer; 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(fContext2); FreeAndNil(fContext1); end; procedure TMainForm.FormResize(Sender: TObject); procedure DoResize(const l, r, w, h: Integer; const aPanel: TPanel; const aContext: TglcContext); begin aPanel.SetBounds(l, r, w, h); if Assigned(aContext) then begin aContext.Activate; glViewport(0, 0, w, h); end; end; var w, h: Integer; begin w := (ClientWidth - 24) div 2; h := LogLB.Top - 16; DoResize( 8, 8, w, h, RenderPanel1, fContext1); DoResize(w + 16, 8, w, h, RenderPanel2, fContext2); end; procedure TMainForm.Log(aSender: TObject; const aMsg: String); begin LogLB.Items.Add(aMsg); end; procedure TMainForm.Render; procedure DoRender; begin glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); fVBO.Bind; fShader.Enable; glEnableVertexAttribArray(LAYOUT_LOCATION_POS); glVertexAttribPointer(LAYOUT_LOCATION_POS, 3, GL_FLOAT, False, 0, nil); glDrawArrays(GL_QUADS, 0, fVBO.DataCount); glDisableVertexAttribArray(LAYOUT_LOCATION_POS); fShader.Disable; fVBO.Unbind; end; begin fContext1.Activate; glClearColor(0.1, 0.2, 0.1, 0); DoRender; fContext1.SwapBuffers; fContext2.Activate; glClearColor(0.1, 0.1, 0.2, 0); DoRender; fContext2.SwapBuffers; end; end.