Commit 7c766d93 authored by Bergmann89's avatar Bergmann89

* refactored share context to be able to support function for gtk2/glx

* added example: sharecontext
parent 6c785c85
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);..\.."/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uMainForm
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="6">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="21"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
<IsVisibleTab Value="True"/>
<TopLine Value="96"/>
<CursorPos X="10" Y="110"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\uglcArrayBuffer.pas"/>
<UnitName Value="uglcArrayBuffer"/>
<EditorIndex Value="4"/>
<TopLine Value="38"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\uglcContext.pas"/>
<UnitName Value="uglcContext"/>
<EditorIndex Value="1"/>
<TopLine Value="84"/>
<CursorPos X="17" Y="102"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\uglcContextWGL.pas"/>
<UnitName Value="uglcContextWGL"/>
<EditorIndex Value="2"/>
<TopLine Value="360"/>
<CursorPos X="15" Y="368"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="..\..\uglcContextGtk2GLX.pas"/>
<UnitName Value="uglcContextGtk2GLX"/>
<EditorIndex Value="3"/>
<TopLine Value="31"/>
<CursorPos X="15" Y="14"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit5>
</Units>
<JumpHistory Count="19" HistoryIndex="18">
<Position1>
<Filename Value="uMainForm.pas"/>
<Caret Line="43" Column="22" TopLine="26"/>
</Position1>
<Position2>
<Filename Value="uMainForm.pas"/>
<Caret Line="26" Column="46" TopLine="8"/>
</Position2>
<Position3>
<Filename Value="uMainForm.pas"/>
<Caret Line="27" Column="46" TopLine="8"/>
</Position3>
<Position4>
<Filename Value="uMainForm.pas"/>
<Caret Line="26" Column="46" TopLine="8"/>
</Position4>
<Position5>
<Filename Value="uMainForm.pas"/>
<Caret Line="18" Column="4" TopLine="8"/>
</Position5>
<Position6>
<Filename Value="uMainForm.pas"/>
<Caret Line="114" Column="19" TopLine="101"/>
</Position6>
<Position7>
<Filename Value="uMainForm.pas"/>
<Caret Line="23" Column="7" TopLine="10"/>
</Position7>
<Position8>
<Filename Value="uMainForm.pas"/>
<Caret Line="60" Column="26" TopLine="48"/>
</Position8>
<Position9>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="322" Column="3" TopLine="319"/>
</Position9>
<Position10>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="101" Column="18" TopLine="83"/>
</Position10>
<Position11>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="281" Column="46" TopLine="89"/>
</Position11>
<Position12>
<Filename Value="..\..\uglcContext.pas"/>
<Caret Line="118" Column="19" TopLine="96"/>
</Position12>
<Position13>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="70" Column="3" TopLine="68"/>
</Position13>
<Position14>
<Filename Value="uMainForm.pas"/>
<Caret Line="60" Column="26" TopLine="48"/>
</Position14>
<Position15>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="352" Column="30" TopLine="325"/>
</Position15>
<Position16>
<Filename Value="uMainForm.pas"/>
<Caret Line="62" Column="48" TopLine="48"/>
</Position16>
<Position17>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="352" Column="30" TopLine="336"/>
</Position17>
<Position18>
<Filename Value="..\..\uglcContextWGL.pas"/>
<Caret Line="34" Column="56" TopLine="16"/>
</Position18>
<Position19>
<Filename Value="uMainForm.pas"/>
<Caret Line="147" Column="23" TopLine="105"/>
</Position19>
</JumpHistory>
</ProjectSession>
</CONFIG>
/* ShaderObject: GL_VERTEX_SHADER */
#version 330
uniform mat4 uModelViewProjMat;
layout(location = 0) in vec3 inPos;
void main(void)
{
gl_Position = vec4(inPos, 1.0);
}
/* ShaderObject: GL_FRAGMENT_SHADER */
#version 330
out vec4 outColor; // ausgegebene Farbe
void main(void)
{
outColor = vec4(1.0, 0.0, 0.0, 1.0);
}
\ No newline at end of file
object MainForm: TMainForm
Left = 465
Height = 460
Top = 217
Width = 683
Caption = 'MainForm'
ClientHeight = 460
ClientWidth = 683
OnCreate = FormCreate
OnDestroy = FormDestroy
OnResize = FormResize
LCLVersion = '1.3'
object LogLB: TListBox
Left = 0
Height = 80
Top = 380
Width = 683
Align = alBottom
ItemHeight = 0
TabOrder = 0
end
object RenderPanel1: TPanel
Left = 144
Height = 200
Top = 40
Width = 200
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 1
end
object RenderPanel2: TPanel
Left = 200
Height = 200
Top = 88
Width = 200
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 2
end
object ApplicationProperties: TApplicationProperties
OnIdle = ApplicationPropertiesIdle
left = 64
top = 24
end
end
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.
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="3">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
<IsVisibleTab Value="True"/>
<TopLine Value="20"/>
<CursorPos X="36" Y="35"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\uglcArrayBuffer.pas"/>
<UnitName Value="uglcArrayBuffer"/>
<EditorIndex Value="1"/>
<TopLine Value="38"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="uMainForm.pas"/>
<Caret Line="39" Column="29" TopLine="85"/>
</Position1>
<Position2>
<Filename Value="uMainForm.pas"/>
<Caret Line="43" Column="22" TopLine="26"/>
</Position2>
</JumpHistory>
</ProjectSession>
</CONFIG>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="3">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
<IsVisibleTab Value="True"/>
<TopLine Value="95"/>
<CursorPos X="63" Y="108"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\uglcVertexArrayObject.pas"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="20"/>
</Unit2>
</Units>
<JumpHistory HistoryIndex="-1"/>
</ProjectSession>
</CONFIG>
......@@ -82,6 +82,7 @@ type
fThreadID: TThreadID;
fEnableVsync: Boolean;
fLogEvent: TLogEvent;
fShareContext: TglcContext;
function GetEnableVSync: Boolean;
procedure SetEnableVSync(aValue: Boolean);
......@@ -96,9 +97,15 @@ type
public
property PixelFormatSettings: TglcContextPixelFormatSettings read fPixelFormatSettings;
property VersionSettings: TglcContextVersionSettings read fVersionSettings;
constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); overload; virtual;
constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); overload; virtual;
property ShareContext: TglcContext read fShareContext;
constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aShareContext: TglcContext = nil); overload; virtual;
constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aVersionSettings: TglcContextVersionSettings;
const aShareContext: TglcContext = nil); overload; virtual;
destructor Destroy; override;
property ThreadID: TThreadID read fThreadID;
......@@ -108,13 +115,13 @@ type
procedure EnableDebugOutput(const aLogEvent: TLogEvent);
procedure DisableDebugOutput;
procedure CloseContext; virtual;
procedure Activate; virtual; abstract;
procedure ReleaseShareContext; virtual;
procedure Activate; virtual;
procedure Deactivate; virtual; abstract;
function IsActive: boolean; virtual; abstract;
procedure SwapBuffers; virtual; abstract;
procedure SetSwapInterval(const aInterval: GLint); virtual; abstract;
function GetSwapInterval: GLint; virtual; abstract;
procedure Share(const aContext: TglcContext); virtual; abstract;
{$IFDEF fpc}
private class var
fMainContextThreadID: TThreadID;
......@@ -306,9 +313,10 @@ begin
Result:= GetPlatformClass.IsAnyContextActive;
end;
constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aShareContext: TglcContext);
begin
inherited Create;
fShareContext := aShareContext;
fPixelFormatSettings := aPixelFormatSettings;
FControl := aControl;
fThreadID := 0;
......@@ -317,9 +325,9 @@ begin
InitOpenGL();
end;
constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings; const aShareContext: TglcContext);
begin
Create(aControl, aPixelFormatSettings);
Create(aControl, aPixelFormatSettings, aShareContext);
fVersionSettings := aVersionSettings;
fUseVersion := true;
end;
......@@ -336,8 +344,6 @@ procedure TglcContext.BuildContext;
begin
OpenContext;
Activate;
ReadImplementationProperties;
ReadExtensions;
SetEnableVSync(fEnableVsync);
end;
......@@ -358,6 +364,17 @@ begin
fMainContextThreadID := 0;
end;
procedure TglcContext.ReleaseShareContext;
begin
fShareContext := nil;
end;
procedure TglcContext.Activate;
begin
ReadImplementationProperties;
ReadExtensions;
end;
initialization
{$IFDEF fpc}TglcContext.{$ENDIF}fMainContextThreadID := 0;
......
......@@ -29,8 +29,13 @@ type
function FindPixelFormatNoAA: Integer;
procedure OpenFromPF(PixelFormat: Integer);
public
constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); overload; override;
constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); overload; override;
constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aShareContext: TglcContext = nil); overload; override;
constructor Create(const aControl: TWinControl;
const aPixelFormatSettings: TglcContextPixelFormatSettings;
const aVersionSettings: TglcContextVersionSettings;
const aShareContext: TglcContext = nil); overload; override;
procedure CloseContext; override;
procedure Activate; override;
......@@ -39,7 +44,6 @@ type
procedure SwapBuffers; override;
procedure SetSwapInterval(const aInterval: GLint); override;
function GetSwapInterval: GLint; override;
procedure Share(const aContext: TglcContext); override;
class function ChangeDisplaySettings(const aWidth, aHeight, aBitPerPixel, aFreq: Integer;
const aFlags: TglcDisplayFlags): Boolean; override;
......@@ -266,6 +270,7 @@ end;
procedure TglcContextWGL.OpenFromPF(PixelFormat: Integer);
var
tmpRC: HGLRC;
err: DWORD;
Attribs: array of GLint;
CreateContextAttribs: TwglCreateContextAttribsARB;
begin
......@@ -337,18 +342,27 @@ begin
wglDeleteContext(tmpRC);
end else
FRC := tmpRC;
if Assigned(ShareContext) then begin
if (ShareContext.ClassName <> ClassName) then
raise Exception.Create('share context has invalid type: ' + ShareContext.ClassName);
if not wglShareLists((ShareContext as TglcContextWGL).FRC, FRC) then begin
err := GetLastError();
raise EGLError.Create('wglShareLists failed (' + IntToStr(err) + ') ' + SysErrorMessage(err));
end;
end;
end;
constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aShareContext: TglcContext);
begin
inherited Create(aControl, aPixelFormatSettings);
inherited Create(aControl, aPixelFormatSettings, aShareContext);
fHandle := aControl.Handle;
UpdatePixelFormat;
end;
constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
constructor TglcContextWGL.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings; const aShareContext: TglcContext);
begin
inherited Create(aControl, aPixelFormatSettings, aVersionSettings);
inherited Create(aControl, aPixelFormatSettings, aVersionSettings, aShareContext);
fHandle := aControl.Handle;
UpdatePixelFormat;
end;
......@@ -365,14 +379,26 @@ begin
end;
procedure TglcContextWGL.Activate;
var
err: DWORD;
begin
ActivateRenderingContext(FDC, FRC);
if (FDC = 0) or (FRC = 0) then
raise Exception.Create('invalid context. did you call build context first?');
if (not wglMakeCurrent(FDC, FRC)) then begin
err := GetLastError;
raise Exception.Create('unable to activate context: (' + IntToStr(err) + ') ' + SysErrorMessage(err));
end;
inherited Activate;