diff --git a/examples/sharecontext/project1.lpi b/examples/sharecontext/project1.lpi
new file mode 100644
index 0000000..7e49921
--- /dev/null
+++ b/examples/sharecontext/project1.lpi
@@ -0,0 +1,82 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/sharecontext/project1.lpr b/examples/sharecontext/project1.lpr
new file mode 100644
index 0000000..5ca8fd0
--- /dev/null
+++ b/examples/sharecontext/project1.lpr
@@ -0,0 +1,21 @@
+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.
+
diff --git a/examples/sharecontext/project1.lps b/examples/sharecontext/project1.lps
new file mode 100644
index 0000000..a915a42
--- /dev/null
+++ b/examples/sharecontext/project1.lps
@@ -0,0 +1,142 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/sharecontext/project1.res b/examples/sharecontext/project1.res
new file mode 100644
index 0000000..e66ecf8
Binary files /dev/null and b/examples/sharecontext/project1.res differ
diff --git a/examples/sharecontext/shader.glsl b/examples/sharecontext/shader.glsl
new file mode 100644
index 0000000..5993f08
--- /dev/null
+++ b/examples/sharecontext/shader.glsl
@@ -0,0 +1,19 @@
+/* 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
diff --git a/examples/sharecontext/uMainForm.lfm b/examples/sharecontext/uMainForm.lfm
new file mode 100644
index 0000000..f4ef0ff
--- /dev/null
+++ b/examples/sharecontext/uMainForm.lfm
@@ -0,0 +1,45 @@
+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
diff --git a/examples/sharecontext/uMainForm.pas b/examples/sharecontext/uMainForm.pas
new file mode 100644
index 0000000..517766a
--- /dev/null
+++ b/examples/sharecontext/uMainForm.pas
@@ -0,0 +1,155 @@
+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.
+
diff --git a/examples/simple/project1.lps b/examples/simple/project1.lps
new file mode 100644
index 0000000..60e7a41
--- /dev/null
+++ b/examples/simple/project1.lps
@@ -0,0 +1,46 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/simple/project1.res b/examples/simple/project1.res
new file mode 100644
index 0000000..e66ecf8
Binary files /dev/null and b/examples/simple/project1.res differ
diff --git a/examples/vertexarrayobject/project1.lps b/examples/vertexarrayobject/project1.lps
new file mode 100644
index 0000000..ce44512
--- /dev/null
+++ b/examples/vertexarrayobject/project1.lps
@@ -0,0 +1,34 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/vertexarrayobject/project1.res b/examples/vertexarrayobject/project1.res
new file mode 100644
index 0000000..e66ecf8
Binary files /dev/null and b/examples/vertexarrayobject/project1.res differ
diff --git a/uglcContext.pas b/uglcContext.pas
index 73f419a..605a92d 100644
--- a/uglcContext.pas
+++ b/uglcContext.pas
@@ -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;
diff --git a/uglcContextWGL.pas b/uglcContextWGL.pas
index 58b35de..0b4cf82 100644
--- a/uglcContextWGL.pas
+++ b/uglcContextWGL.pas
@@ -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;
end;
procedure TglcContextWGL.Deactivate;
+var
+ err: DWORD;
begin
- if wglGetCurrentContext()=FRC then
- DeactivateRenderingContext;
+ if (wglGetCurrentContext()=FRC) and not wglMakeCurrent(0, 0) then begin
+ err := GetLastError;
+ raise Exception.Create('unable to deactivate context: (' + IntToStr(err) + ') ' + SysErrorMessage(err));
+ end;
end;
function TglcContextWGL.IsActive: boolean;
@@ -397,12 +423,6 @@ begin
result := wglGetSwapIntervalEXT();
end;
-procedure TglcContextWGL.Share(const aContext: TglcContext);
-begin
- if not wglShareLists(FRC, (aContext as TglcContextWGL).FRC) then
- raise EGLError.Create('wglShareLists failed: ' + IntToStr(GetLastError()));
-end;
-
class function TglcContextWGL.ChangeDisplaySettings(const aWidth, aHeight,
aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean;
var