paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 20:20:59 +01:00
Code Issues Packages Projects Releases Wiki Activity

started platform independent opengl control for the LCL

Browse Source 
git-svn-id: trunk@8408 -
This commit is contained in:
mattias 2006-01-01 20:43:51 +00:00
parent 51661712c0
commit adbd284641
30 changed files with 3860 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
.gitattributes vendored
View File

@ -176,6 +176,34 @@ components/mysql/registermysql.lrs svneol=native#text/pascal
components/mysql/registermysql.pas svneol=native#text/pascal
components/mysql/tmysqldatabase.xpm -text svneol=native#image/x-xpixmap
components/mysql/tmysqldataset.xpm -text svneol=native#image/x-xpixmap
components/opengl/agl.pp svneol=native#text/plain
components/opengl/example/mainunit.lfm svneol=native#text/plain
components/opengl/example/mainunit.lrs svneol=native#text/plain
components/opengl/example/mainunit.pas svneol=native#text/plain
components/opengl/example/testopenglcontext1.lpi svneol=native#text/plain
components/opengl/example/testopenglcontext1.lpr svneol=native#text/plain
components/opengl/glcarbonaglcontext.pas svneol=native#text/plain
components/opengl/glgtkglxcontext.pas svneol=native#text/plain
components/opengl/gtk2x11/gdk2x.pas svneol=native#text/plain
components/opengl/gtk2x11/gdk2x11.lpk svneol=native#text/plain
components/opengl/gtk2x11/gdk2x11.pas svneol=native#text/plain
components/opengl/gtk2x11/include/gdk2x11includes.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkdisplay-x11.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkdrawable-x11.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkinputprivate.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkpixmap-x11.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkprivate-x11.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkscreen-x11.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkwindow-x11.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gdkx.inc svneol=native#text/plain
components/opengl/gtk2x11/include/gxid_proto.inc svneol=native#text/plain
components/opengl/gtk2x11/include/mwmutil.inc svneol=native#text/plain
components/opengl/gtk2x11/include/xsettings-client.inc svneol=native#text/plain
components/opengl/gtk2x11/include/xsettings-common.inc svneol=native#text/plain
components/opengl/gtk2x11/scripts/gdkx11_h2pas.sh svneol=native#text/plain
components/opengl/lazopenglcontext.lpk svneol=native#text/plain
components/opengl/lazopenglcontext.pas svneol=native#text/plain
components/opengl/openglcontext.pas svneol=native#text/plain
components/prettyformat/pfidesource.pas svneol=native#text/plain
components/prettyformat/prettyformat.lpk svneol=native#text/plain
components/prettyformat/prettyformat.pas svneol=native#text/plain

6
components/codetools/definetemplates.pas
View File

@ -3410,11 +3410,13 @@ begin
+';'+Dir+'rtl'+DS+'objpas'+DS+'sysutils'
+';'+Dir+'rtl'+DS+'objpas'+DS+'classes'
+';'+Dir+'rtl'+DS+'inc'+DS
+';'+Dir+'rtl'+DS+'inc'+DS+'graph'+DS;
+';'+Dir+'rtl'+DS+'inc'+DS+'graph'+DS
+';'+Dir+'rtl'+DS+SrcOS+DS;
if (TargetOS<>'') and (TargetOS<>SrcOS) then
s:=s+';'+Dir+'rtl'+DS+TargetOS+DS;
if (SrcOS2<>'') and (SrcOS2<>SrcOS) then
s:=s+';'+Dir+'rtl'+DS+SrcOS2+DS;
s:=s
+';'+Dir+'rtl'+DS+SrcOS+DS
+';'+Dir+'rtl'+DS+TargetProcessor+DS
+';'+Dir+'rtl'+DS+TargetOS+DS+TargetProcessor+DS;
RTLDir.AddChild(TDefineTemplate.Create('Include Path',

511
components/opengl/agl.pp Normal file
View File

@ -0,0 +1,511 @@
unit agl;
{$MODE objfpc}
interface
uses GL, GLU;
{Type
PAGLContext = ^AGLContext;
PAGLDevice = ^AGLDevice;
PAGLDrawable = ^AGLDrawable;
PAGLPbuffer = ^AGLPbuffer;
PAGLPixelFormat = ^AGLPixelFormat;
PAGLRendererInfo = ^AGLRendererInfo;
PGLenum = ^GLenum;
PGLint = ^GLint;
PGLubyte = ^GLubyte;
PGLvoid = ^GLvoid;}
{$IFDEF FPC}
{$PACKRECORDS C}
{$ENDIF}
{
** AGL API version.
}
const
AGL_VERSION_2_0 = 1;
{
** Macintosh device type.
}
type
TGDHandle = ptrint;
TCGrafPtr = Pointer;
PAGLDevice = ^TAGLDevice;
TAGLDevice = TGDHandle;
{
** Macintosh drawable type.
}
PAGLDrawable = ^TAGLDrawable;
TAGLDrawable = TCGrafPtr;
{
** AGL opaque data.
}
TAGLRendererInfo = Pointer;
TAGLPixelFormat = Pointer;
TAGLContext = Pointer;
TAGLPbuffer = Pointer;
PAGLPbuffer = ^TAGLPbuffer;
{********************************************************************** }
{
** Attribute names for aglChoosePixelFormat and aglDescribePixelFormat.
}
const
AGL_NONE = 0;
{ choose from all available renderers }
AGL_ALL_RENDERERS = 1;
{ depth of the index buffer }
AGL_BUFFER_SIZE = 2;
{ level in plane stacking }
AGL_LEVEL = 3;
{ choose an RGBA format }
AGL_RGBA = 4;
{ double buffering supported }
AGL_DOUBLEBUFFER = 5;
{ stereo buffering supported }
AGL_STEREO = 6;
{ number of aux buffers }
AGL_AUX_BUFFERS = 7;
{ number of red component bits }
AGL_RED_SIZE = 8;
{ number of green component bits }
AGL_GREEN_SIZE = 9;
{ number of blue component bits }
AGL_BLUE_SIZE = 10;
{ number of alpha component bits }
AGL_ALPHA_SIZE = 11;
{ number of depth bits }
AGL_DEPTH_SIZE = 12;
{ number of stencil bits }
AGL_STENCIL_SIZE = 13;
{ number of red accum bits }
AGL_ACCUM_RED_SIZE = 14;
{ number of green accum bits }
AGL_ACCUM_GREEN_SIZE = 15;
{ number of blue accum bits }
AGL_ACCUM_BLUE_SIZE = 16;
{ number of alpha accum bits }
AGL_ACCUM_ALPHA_SIZE = 17;
{
** Extended attributes
}
{ frame buffer bits per pixel }
AGL_PIXEL_SIZE = 50;
{ never choose smaller buffers than requested }
AGL_MINIMUM_POLICY = 51;
{ choose largest buffers of type requested }
AGL_MAXIMUM_POLICY = 52;
{ choose an off-screen capable renderer }
AGL_OFFSCREEN = 53;
{ choose a full-screen capable renderer }
AGL_FULLSCREEN = 54;
{ number of multi sample buffers }
AGL_SAMPLE_BUFFERS_ARB = 55;
{ number of samples per multi sample buffer }
AGL_SAMPLES_ARB = 56;
{ independent depth and/or stencil buffers for the aux buffer }
AGL_AUX_DEPTH_STENCIL = 57;
{ color buffers store floating point pixels }
AGL_COLOR_FLOAT = 58;
{ choose multisample }
AGL_MULTISAMPLE = 59;
{ choose supersample }
AGL_SUPERSAMPLE = 60;
{ request alpha filtering }
AGL_SAMPLE_ALPHA = 61;
{
** Renderer management
}
{ request renderer by ID }
AGL_RENDERER_ID = 70;
{ choose a single renderer for all screens }
AGL_SINGLE_RENDERER = 71;
{ disable all failure recovery systems }
AGL_NO_RECOVERY = 72;
{ choose a hardware accelerated renderer }
AGL_ACCELERATED = 73;
{ choose the closest color buffer to request }
AGL_CLOSEST_POLICY = 74;
{ renderer does not need failure recovery }
AGL_ROBUST = 75;
{ back buffer contents are valid after swap }
AGL_BACKING_STORE = 76;
{ renderer is multi-processor safe }
AGL_MP_SAFE = 78;
{ can be used to render to a window }
AGL_WINDOW = 80;
{ single window can span multiple screens }
AGL_MULTISCREEN = 81;
{ virtual screen number }
AGL_VIRTUAL_SCREEN = 82;
{ renderer is opengl compliant }
AGL_COMPLIANT = 83;
{ can be used to render to a pbuffer }
AGL_PBUFFER = 90;
{ can be used to render offline to a pbuffer }
AGL_REMOTE_PBUFFER = 91;
{
** Property names for aglDescribeRenderer
}
{ #define AGL_OFFSCREEN 53 }
{ #define AGL_FULLSCREEN 54 }
{ #define AGL_RENDERER_ID 70 }
{ #define AGL_ACCELERATED 73 }
{ #define AGL_ROBUST 75 }
{ #define AGL_BACKING_STORE 76 }
{ #define AGL_MP_SAFE 78 }
{ #define AGL_WINDOW 80 }
{ #define AGL_MULTISCREEN 81 }
{ #define AGL_COMPLIANT 83 }
{ #define AGL_PBUFFER 90 }
AGL_BUFFER_MODES = 100;
AGL_MIN_LEVEL = 101;
AGL_MAX_LEVEL = 102;
AGL_COLOR_MODES = 103;
AGL_ACCUM_MODES = 104;
AGL_DEPTH_MODES = 105;
AGL_STENCIL_MODES = 106;
AGL_MAX_AUX_BUFFERS = 107;
AGL_VIDEO_MEMORY = 120;
AGL_TEXTURE_MEMORY = 121;
AGL_RENDERER_COUNT = 128;
{
** Integer parameter names
}
{ Enable or set the swap rectangle }
AGL_SWAP_RECT = 200;
{ Enable or set the buffer rectangle }
AGL_BUFFER_RECT = 202;
{ Enable or disable the swap async limit }
AGL_SWAP_LIMIT = 203;
{ Enable or disable colormap tracking }
AGL_COLORMAP_TRACKING = 210;
{ Set a colormap entry to index, r, g, b }
AGL_COLORMAP_ENTRY = 212;
{ Enable or disable all rasterization }
AGL_RASTERIZATION = 220;
{ 0 -> Don't sync, n -> Sync every n retrace }
AGL_SWAP_INTERVAL = 222;
{ Validate state for multi-screen functionality }
AGL_STATE_VALIDATION = 230;
{ Set the buffer name. Allows for multi ctx to share a buffer }
AGL_BUFFER_NAME = 231;
{ Order the current context in front of all the other contexts. }
AGL_ORDER_CONTEXT_TO_FRONT = 232;
{ aglGetInteger only - returns the ID of the drawable surface for the context }
AGL_CONTEXT_SURFACE_ID = 233;
{ aglGetInteger only - returns the display ID(s) of all displays touched by the context, up to a maximum of 32 displays }
AGL_CONTEXT_DISPLAY_ID = 234;
{ Position of OpenGL surface relative to window: 1 -> Above window, -1 -> Below Window }
AGL_SURFACE_ORDER = 235;
{ Opacity of OpenGL surface: 1 -> Surface is opaque (default), 0 -> non-opaque }
AGL_SURFACE_OPACITY = 236;
{ Enable or set the drawable clipping region }
AGL_CLIP_REGION = 254;
{ Enable the capture of only a single display for aglFullScreen, normally disabled }
AGL_FS_CAPTURE_SINGLE = 255;
{ 2 params. Width/height of surface backing size }
AGL_SURFACE_BACKING_SIZE = 304;
{ Enable or disable surface backing size override }
AGL_ENABLE_SURFACE_BACKING_SIZE = 305;
{ Flag surface to candidate for deletion }
AGL_SURFACE_VOLATILE = 306;
{
** Option names for aglConfigure.
}
{ Set the size of the pixel format cache }
AGL_FORMAT_CACHE_SIZE = 501;
{ Reset the pixel format cache }
AGL_CLEAR_FORMAT_CACHE = 502;
{ Whether to retain loaded renderers in memory }
AGL_RETAIN_RENDERERS = 503;
{ buffer_modes }
AGL_MONOSCOPIC_BIT = $00000001;
AGL_STEREOSCOPIC_BIT = $00000002;
AGL_SINGLEBUFFER_BIT = $00000004;
AGL_DOUBLEBUFFER_BIT = $00000008;
{ bit depths }
AGL_0_BIT = $00000001;
AGL_1_BIT = $00000002;
AGL_2_BIT = $00000004;
AGL_3_BIT = $00000008;
AGL_4_BIT = $00000010;
AGL_5_BIT = $00000020;
AGL_6_BIT = $00000040;
AGL_8_BIT = $00000080;
AGL_10_BIT = $00000100;
AGL_12_BIT = $00000200;
AGL_16_BIT = $00000400;
AGL_24_BIT = $00000800;
AGL_32_BIT = $00001000;
AGL_48_BIT = $00002000;
AGL_64_BIT = $00004000;
AGL_96_BIT = $00008000;
AGL_128_BIT = $00010000;
{ color modes }
{ 8 rgb bit/pixel, RGB=7:0, inverse colormap }
AGL_RGB8_BIT = $00000001;
{ 8-8 argb bit/pixel, A=7:0, RGB=7:0, inverse colormap }
AGL_RGB8_A8_BIT = $00000002;
{ 8 rgb bit/pixel, B=7:6, G=5:3, R=2:0 }
AGL_BGR233_BIT = $00000004;
{ 8-8 argb bit/pixel, A=7:0, B=7:6, G=5:3, R=2:0 }
AGL_BGR233_A8_BIT = $00000008;
{ 8 rgb bit/pixel, R=7:5, G=4:2, B=1:0 }
AGL_RGB332_BIT = $00000010;
{ 8-8 argb bit/pixel, A=7:0, R=7:5, G=4:2, B=1:0 }
AGL_RGB332_A8_BIT = $00000020;
{ 16 rgb bit/pixel, R=11:8, G=7:4, B=3:0 }
AGL_RGB444_BIT = $00000040;
{ 16 argb bit/pixel, A=15:12, R=11:8, G=7:4, B=3:0 }
AGL_ARGB4444_BIT = $00000080;
{ 8-16 argb bit/pixel, A=7:0, R=11:8, G=7:4, B=3:0 }
AGL_RGB444_A8_BIT = $00000100;
{ 16 rgb bit/pixel, R=14:10, G=9:5, B=4:0 }
AGL_RGB555_BIT = $00000200;
{ 16 argb bit/pixel, A=15, R=14:10, G=9:5, B=4:0 }
AGL_ARGB1555_BIT = $00000400;
{ 8-16 argb bit/pixel, A=7:0, R=14:10, G=9:5, B=4:0 }
AGL_RGB555_A8_BIT = $00000800;
{ 16 rgb bit/pixel, R=15:11, G=10:5, B=4:0 }
AGL_RGB565_BIT = $00001000;
{ 8-16 argb bit/pixel, A=7:0, R=15:11, G=10:5, B=4:0 }
AGL_RGB565_A8_BIT = $00002000;
{ 32 rgb bit/pixel, R=23:16, G=15:8, B=7:0 }
AGL_RGB888_BIT = $00004000;
{ 32 argb bit/pixel, A=31:24, R=23:16, G=15:8, B=7:0 }
AGL_ARGB8888_BIT = $00008000;
{ 8-32 argb bit/pixel, A=7:0, R=23:16, G=15:8, B=7:0 }
AGL_RGB888_A8_BIT = $00010000;
{ 32 rgb bit/pixel, R=29:20, G=19:10, B=9:0 }
AGL_RGB101010_BIT = $00020000;
{ 32 argb bit/pixel, A=31:30 R=29:20, G=19:10, B=9:0 }
AGL_ARGB2101010_BIT = $00040000;
{ 8-32 argb bit/pixel, A=7:0 R=29:20, G=19:10, B=9:0 }
AGL_RGB101010_A8_BIT = $00080000;
{ 48 rgb bit/pixel, R=35:24, G=23:12, B=11:0 }
AGL_RGB121212_BIT = $00100000;
{ 48 argb bit/pixel, A=47:36, R=35:24, G=23:12, B=11:0 }
AGL_ARGB12121212_BIT = $00200000;
{ 64 rgb bit/pixel, R=47:32, G=31:16, B=15:0 }
AGL_RGB161616_BIT = $00400000;
{ 64 argb bit/pixel, A=63:48, R=47:32, G=31:16, B=15:0 }
AGL_ARGB16161616_BIT = $00800000;
{ 8 bit color look up table (deprecated) }
AGL_INDEX8_BIT = $20000000;
{ 16 bit color look up table (deprecated) }
AGL_INDEX16_BIT = $40000000;
{ 64 rgb bit/pixel, half float }
AGL_RGBFLOAT64_BIT = $01000000;
{ 64 argb bit/pixel, half float }
AGL_RGBAFLOAT64_BIT = $02000000;
{ 128 rgb bit/pixel, ieee float }
AGL_RGBFLOAT128_BIT = $04000000;
{ 128 argb bit/pixel, ieee float }
AGL_RGBAFLOAT128_BIT = $08000000;
{ 256 rgb bit/pixel, ieee double }
AGL_RGBFLOAT256_BIT = $10000000;
{ 256 argb bit/pixel, ieee double }
AGL_RGBAFLOAT256_BIT = $20000000;
{
** Error return values from aglGetError.
}
{ no error }
AGL_NO_ERROR = 0;
{ invalid pixel format attribute }
AGL_BAD_ATTRIBUTE = 10000;
{ invalid renderer property }
AGL_BAD_PROPERTY = 10001;
{ invalid pixel format }
AGL_BAD_PIXELFMT = 10002;
{ invalid renderer info }
AGL_BAD_RENDINFO = 10003;
{ invalid context }
AGL_BAD_CONTEXT = 10004;
{ invalid drawable }
AGL_BAD_DRAWABLE = 10005;
{ invalid graphics device }
AGL_BAD_GDEV = 10006;
{ invalid context state }
AGL_BAD_STATE = 10007;
{ invalid numerical value }
AGL_BAD_VALUE = 10008;
{ invalid share context }
AGL_BAD_MATCH = 10009;
{ invalid enumerant }
AGL_BAD_ENUM = 10010;
{ invalid offscreen drawable }
AGL_BAD_OFFSCREEN = 10011;
{ invalid offscreen drawable }
AGL_BAD_FULLSCREEN = 10012;
{ invalid window }
AGL_BAD_WINDOW = 10013;
{ invalid pointer }
AGL_BAD_POINTER = 10014;
{ invalid code module }
AGL_BAD_MODULE = 10015;
{ memory allocation failure }
AGL_BAD_ALLOC = 10016;
{ invalid CoreGraphics connection }
AGL_BAD_CONNECTION = 10017;
{********************************************************************** }
{
** Pixel format functions
}
(* Const before type ignored *)
(* Const before type ignored *)
function aglChoosePixelFormat(gdevs:PAGLDevice; ndev:GLint; attribs:PGLint):TAGLPixelFormat;cdecl;external;
procedure aglDestroyPixelFormat(pix:TAGLPixelFormat);cdecl;external;
function aglNextPixelFormat(pix:TAGLPixelFormat):TAGLPixelFormat;cdecl;external;
function aglDescribePixelFormat(pix:TAGLPixelFormat; attrib:GLint; value:PGLint):GLboolean;cdecl;external;
function aglDevicesOfPixelFormat(pix:TAGLPixelFormat; ndevs:PGLint):PAGLDevice;cdecl;external;
{
** Renderer information functions
}
(* Const before type ignored *)
function aglQueryRendererInfo(gdevs:PAGLDevice; ndev:GLint):TAGLRendererInfo;cdecl;external;
procedure aglDestroyRendererInfo(rend:TAGLRendererInfo);cdecl;external;
function aglNextRendererInfo(rend:TAGLRendererInfo):TAGLRendererInfo;cdecl;external;
function aglDescribeRenderer(rend:TAGLRendererInfo; prop:GLint; value:PGLint):GLboolean;cdecl;external;
{
** Context functions
}
function aglCreateContext(pix:TAGLPixelFormat; share:TAGLContext):TAGLContext;cdecl;external;
function aglDestroyContext(ctx:TAGLContext):GLboolean;cdecl;external;
function aglCopyContext(src:TAGLContext; dst:TAGLContext; mask:GLuint):GLboolean;cdecl;external;
function aglUpdateContext(ctx:TAGLContext):GLboolean;cdecl;external;
{
** Current state functions
}
function aglSetCurrentContext(ctx:TAGLContext):GLboolean;cdecl;external;
function aglGetCurrentContext:TAGLContext;cdecl;external;
{
** Drawable Functions
}
function aglSetDrawable(ctx:TAGLContext; draw:TAGLDrawable):GLboolean;cdecl;external;
function aglSetOffScreen(ctx:TAGLContext; width:GLsizei; height:GLsizei; rowbytes:GLsizei; baseaddr:PGLvoid):GLboolean;cdecl;external;
function aglSetFullScreen(ctx:TAGLContext; width:GLsizei; height:GLsizei; freq:GLsizei; device:GLint):GLboolean;cdecl;external;
function aglGetDrawable(ctx:TAGLContext):TAGLDrawable;cdecl;external;
{
** Virtual screen functions
}
function aglSetVirtualScreen(ctx:TAGLContext; screen:GLint):GLboolean;cdecl;external;
function aglGetVirtualScreen(ctx:TAGLContext):GLint;cdecl;external;
{
** Obtain version numbers
}
procedure aglGetVersion(major:PGLint; minor:PGLint);cdecl;external;
{
** Global library options
}
function aglConfigure(pname:GLenum; param:GLuint):GLboolean;cdecl;external;
{
** Swap functions
}
procedure aglSwapBuffers(ctx:TAGLContext);cdecl;external;
{
** Per context options
}
function aglEnable(ctx:TAGLContext; pname:GLenum):GLboolean;cdecl;external;
function aglDisable(ctx:TAGLContext; pname:GLenum):GLboolean;cdecl;external;
function aglIsEnabled(ctx:TAGLContext; pname:GLenum):GLboolean;cdecl;external;
(* Const before type ignored *)
function aglSetInteger(ctx:TAGLContext; pname:GLenum; params:PGLint):GLboolean;cdecl;external;
function aglGetInteger(ctx:TAGLContext; pname:GLenum; params:PGLint):GLboolean;cdecl;external;
{
** Font function
}
type
_AGLStyle = 0..255;
function aglUseFont(ctx:TAGLContext; fontID:GLint; face:_AGLStyle; size:GLint; first:GLint;
count:GLint; base:GLint):GLboolean;cdecl;external;
{
** Error functions
}
function aglGetError:GLenum;cdecl;external;
(* Const before type ignored *)
function aglErrorString(code:GLenum):PGLubyte;cdecl;external;
{
** Soft reset function
}
procedure aglResetLibrary;cdecl;external;
{
** Surface texture function
}
procedure aglSurfaceTexture(context:TAGLContext; target:GLenum; internalformat:GLenum; surfacecontext:TAGLContext);cdecl;external;
{
** PBuffer functions
}
function aglCreatePBuffer(width:GLint; height:GLint; target:GLenum; internalFormat:GLenum; max_level:longint;
pbuffer:PAGLPbuffer):GLboolean;cdecl;external;
function aglDestroyPBuffer(pbuffer:TAGLPbuffer):GLboolean;cdecl;external;
function aglDescribePBuffer(pbuffer:TAGLPbuffer; width:PGLint; height:PGLint; target:PGLenum; internalFormat:PGLenum;
max_level:PGLint):GLboolean;cdecl;external;
function aglTexImagePBuffer(ctx:TAGLContext; pbuffer:TAGLPbuffer; source:GLint):GLboolean;cdecl;external;
{
** Pbuffer Drawable Functions
}
function aglSetPBuffer(ctx:TAGLContext; pbuffer:TAGLPbuffer; face:GLint; level:GLint; screen:GLint):GLboolean;cdecl;external;
function aglGetPBuffer(ctx:TAGLContext; pbuffer:PAGLPbuffer; face:PGLint; level:PGLint; screen:PGLint):GLboolean;cdecl;external;
{
** CGL functions
}
function aglGetCGLContext(ctx:TAGLContext; cgl_ctx:Ppointer):GLboolean;cdecl;external;
function aglGetCGLPixelFormat(pix:TAGLPixelFormat; cgl_pix:Ppointer):GLboolean;cdecl;external;
implementation
end.

13
components/opengl/example/mainunit.lfm Normal file
View File

@ -0,0 +1,13 @@
object Form1: TForm1
Caption = 'Form1'
ClientHeight = 300
ClientWidth = 400
OnCreate = FormCreate
PixelsPerInch = 112
HorzScrollBar.Page = 399
VertScrollBar.Page = 299
Left = 290
Height = 300
Top = 163
Width = 400
end

8
components/opengl/example/mainunit.lrs Normal file
View File

@ -0,0 +1,8 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#7'Caption'#6#5'Form1'#12'ClientHeight'#3','#1#11'Cl'
+'ientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'p'#18'H'
+'orzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#4'Left'#3'"'#1#6'H'
+'eight'#3','#1#3'Top'#3#163#0#5'Width'#3#144#1#0#0
]);

147
components/opengl/example/mainunit.pas Normal file
View File

@ -0,0 +1,147 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
}
unit MainUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
OpenGLContext, GL, GLU;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure OpenGLControl1Paint(Sender: TObject);
procedure OpenGLControl1Resize(Sender: TObject);
private
public
cube_rotationx: GLFloat;
cube_rotationy: GLFloat;
cube_rotationz: GLFloat;
OpenGLControl1: TOpenGLControl;
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
if Sender=nil then ;
OpenGLControl1:=TOpenGLControl.Create(Self);
with OpenGLControl1 do begin
Name:='OpenGLControl1';
Align:=alClient;
Parent:=Self;
OnPaint:=@OpenGLControl1Paint;
OnResize:=@OpenGLControl1Resize;
AutoResizeViewport:=true;
end;
end;
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
var
Speed: Double;
begin
if Sender=nil then ;
glClearColor(1.0, 1.0, 1.0, 1.0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glEnable(GL_DEPTH_TEST);
glViewport(0,0, width, height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluPerspective(45.0, double(width) / height, 0.1, 100.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
glTranslatef(0.0, 0.0,-6.0);
glRotatef(cube_rotationx, cube_rotationy, cube_rotationz, 0.0);
glBegin(GL_QUADS);
glColor3f(0.0,1.0,0.0); // Set The Color To Green
glVertex3f( 1.0, 1.0,-1.0); // Top Right Of The Quad (Top)
glVertex3f(-1.0, 1.0,-1.0); // Top Left Of The Quad (Top)
glVertex3f(-1.0, 1.0, 1.0); // Bottom Left Of The Quad (Top)
glVertex3f( 1.0, 1.0, 1.0); // Bottom Right Of The Quad (Top)
glEnd();
glBegin(GL_QUADS);
glColor3f(1.0,0.5,0.0); // Set The Color To Orange
glVertex3f( 1.0,-1.0, 1.0); // Top Right Of The Quad (Bottom)
glVertex3f(-1.0,-1.0, 1.0); // Top Left Of The Quad (Bottom)
glVertex3f(-1.0,-1.0,-1.0); // Bottom Left Of The Quad (Bottom)
glVertex3f( 1.0,-1.0,-1.0); // Bottom Right Of The Quad (Bottom)
glEnd();
glBegin(GL_QUADS);
glColor3f(1.0,0.0,0.0); // Set The Color To Red
glVertex3f( 1.0, 1.0, 1.0); // Top Right Of The Quad (Front)
glVertex3f(-1.0, 1.0, 1.0); // Top Left Of The Quad (Front)
glVertex3f(-1.0,-1.0, 1.0); // Bottom Left Of The Quad (Front)
glVertex3f( 1.0,-1.0, 1.0); // Bottom Right Of The Quad (Front)
glEnd();
glBegin(GL_QUADS);
glColor3f(1.0,1.0,0.0); // Set The Color To Yellow
glVertex3f( 1.0,-1.0,-1.0); // Bottom Left Of The Quad (Back)
glVertex3f(-1.0,-1.0,-1.0); // Bottom Right Of The Quad (Back)
glVertex3f(-1.0, 1.0,-1.0); // Top Right Of The Quad (Back)
glVertex3f( 1.0, 1.0,-1.0); // Top Left Of The Quad (Back)
glEnd();
glBegin(GL_QUADS);
glColor3f(0.0,0.0,1.0); // Set The Color To Blue
glVertex3f(-1.0, 1.0, 1.0); // Top Right Of The Quad (Left)
glVertex3f(-1.0, 1.0,-1.0); // Top Left Of The Quad (Left)
glVertex3f(-1.0,-1.0,-1.0); // Bottom Left Of The Quad (Left)
glVertex3f(-1.0,-1.0, 1.0); // Bottom Right Of The Quad (Left)
glEnd();
glBegin(GL_QUADS);
glColor3f(1.0,0.0,1.0); // Set The Color To Violet
glVertex3f( 1.0, 1.0,-1.0); // Top Right Of The Quad (Right)
glVertex3f( 1.0, 1.0, 1.0); // Top Left Of The Quad (Right)
glVertex3f( 1.0,-1.0, 1.0); // Bottom Left Of The Quad (Right)
glVertex3f( 1.0,-1.0,-1.0); // Bottom Right Of The Quad (Right)
glEnd();
Speed := double(OpenGLControl1.FrameDiffTimeInMSecs)/10;
cube_rotationx += 5.15 * Speed;
cube_rotationy += 5.15 * Speed;
cube_rotationz += 20.0 * Speed;
OpenGLControl1.SwapBuffers;
end;
procedure TForm1.OpenGLControl1Resize(Sender: TObject);
begin
if Sender=nil then ;
if OpenGLControl1.Height <= 0 then exit;
end;
initialization
{$I mainunit.lrs}
end.

80
components/opengl/example/testopenglcontext1.lpi Normal file
View File

@ -0,0 +1,80 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
<SaveClosedFiles Value="False"/>
<SaveOnlyProjectUnits Value="True"/>
<AlwaysBuild Value="True"/>
</Flags>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<ActiveEditorIndexAtStart Value="2"/>
</General>
<LazDoc Paths=""/>
<Units Count="2">
<Unit0>
<CursorPos X="1" Y="14"/>
<Filename Value="testopenglcontext1.lpr"/>
<IsPartOfProject Value="True"/>
<TopLine Value="1"/>
<UnitName Value="TestOpenGLContext1"/>
<UsageCount Value="134"/>
</Unit0>
<Unit1>
<CursorPos X="1" Y="126"/>
<EditorIndex Value="0"/>
<Filename Value="mainunit.pas"/>
<ComponentName Value="Form1"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<ResourceFilename Value="mainunit.lrs"/>
<TopLine Value="100"/>
<UnitName Value="MainUnit"/>
<UsageCount Value="134"/>
</Unit1>
</Units>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="gdk2x11"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="LazOpenGLContext"/>
</Item3>
</RequiredPackages>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

15
components/opengl/example/testopenglcontext1.lpr Normal file
View File

@ -0,0 +1,15 @@
program TestOpenGLContext1;
{$mode objfpc}{$H+}
uses
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, MainUnit, LazOpenGLContext, gdk2x11;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

69
components/opengl/glcarbonaglcontext.pas Normal file
View File

@ -0,0 +1,69 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
}
unit GLCarbonAGLContext;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, LCLType, gl,
FPCMacOSAll, InterfaceBase, CarbonInt,
Controls;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLCreateContext(AWinControl: TWinControl;
SharedControl: TWinControl; AttrList: PInteger): HWND;
const
DefaultOpenGLContextInitAttrList: array [0..10] of LongInt = (
GDK_GL_RGBA,
GDK_GL_RED_SIZE, 1,
GDK_GL_GREEN_SIZE, 1,
GDK_GL_BLUE_SIZE, 1,
GDK_GL_DEPTH_SIZE, 1,
GDK_GL_DOUBLEBUFFER,
GDK_GL_None
);
implementation
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
begin
end;
procedure LOpenGLSwapBuffers(Handle: HWND);
begin
end;
function LOpenGLMakeCurrent(Handle: HWND): boolean;
begin
end;
function LOpenGLCreateContext(AWinControl: TWinControl;
SharedControl: TWinControl; AttrList: PInteger): HWND;
begin
end;
end.

733
components/opengl/glgtkglxcontext.pas Normal file
View File

@ -0,0 +1,733 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
}
unit GLGtkGlxContext;
{$mode objfpc}{$H+}
{$LinkLib GL}
{$PACKRECORDS C}
interface
uses
Classes, SysUtils, LCLProc, LCLType, X, XUtil, XLib, gl, InterfaceBase,
{$IFDEF LCLGTK2}
gdk2x, glib2, gdk2, gtk2, Gtk2Int,
{$ENDIF}
{$IFDEF LCLGTK}
glib, gdk, gtk, GtkInt,
{$ENDIF}
Controls;
// gdkgl
const
// enum _GDK_GL_CONFIGS
GDK_GL_NONE = 0;
GDK_GL_USE_GL = 1;
GDK_GL_BUFFER_SIZE = 2;
GDK_GL_LEVEL = 3;
GDK_GL_RGBA = 4;
GDK_GL_DOUBLEBUFFER = 5;
GDK_GL_STEREO = 6;
GDK_GL_AUX_BUFFERS = 7;
GDK_GL_RED_SIZE = 8;
GDK_GL_GREEN_SIZE = 9;
GDK_GL_BLUE_SIZE = 10;
GDK_GL_ALPHA_SIZE = 11;
GDK_GL_DEPTH_SIZE = 12;
GDK_GL_STENCIL_SIZE = 13;
GDK_GL_ACCUM_RED_SIZE = 14;
GDK_GL_ACCUM_GREEN_SIZE = 15;
GDK_GL_ACCUM_BLUE_SIZE = 16;
GDK_GL_ACCUM_ALPHA_SIZE = 17;
// GLX_EXT_visual_info extension
GDK_GL_X_VISUAL_TYPE_EXT = $22;
GDK_GL_TRANSPARENT_TYPE_EXT = $23;
GDK_GL_TRANSPARENT_INDEX_VALUE_EXT = $24;
GDK_GL_TRANSPARENT_RED_VALUE_EXT = $25;
GDK_GL_TRANSPARENT_GREEN_VALUE_EXT = $26;
GDK_GL_TRANSPARENT_BLUE_VALUE_EXT = $27;
GDK_GL_TRANSPARENT_ALPHA_VALUE_EXT = $28;
type
TGdkGLContext = record end;
PGdkGLContext = ^TGdkGLContext;
// GLX_EXT_visual_info extension
function gdk_gl_query: boolean;
function gdk_gl_choose_visual(attrlist: Plongint): PGdkVisual;
function gdk_gl_get_config(visual: PGdkVisual; attrib: longint):longint;
function gdk_gl_context_new(visual: PGdkVisual): PGdkGLContext;
function gdk_gl_context_share_new(visual: PGdkVisual; sharelist: PGdkGLContext;
direct: Integer): PGdkGLContext;
function gdk_gl_context_attrlist_share_new(attrlist: Plongint;
sharelist: PGdkGLContext; direct: Integer): PGdkGLContext;
function gdk_gl_context_ref(context: PGdkGLContext): PGdkGLContext;
procedure gdk_gl_context_unref(context:PGdkGLContext);
function gdk_gl_make_current(drawable: PGdkDrawable;
context: PGdkGLContext): boolean;
procedure gdk_gl_swap_buffers(drawable: PGdkDrawable);
procedure gdk_gl_wait_gdk;
procedure gdk_gl_wait_gl;
{ glpixmap stuff }
type
TGdkGLPixmap = record end;
PGdkGLPixmap = ^TGdkGLPixmap;
TGLXContext = pointer;
// gtkglarea
type
TGtkGlAreaMakeCurrentType = boolean;
PGtkGLArea = ^TGtkGLArea;
TGtkGLArea = record
darea: TGtkDrawingArea;
glcontext: PGdkGLContext;
end;
PGtkGLAreaClass = ^TGtkGLAreaClass;
TGtkGLAreaClass = record
parent_class: TGtkDrawingAreaClass;
end;
function GTK_TYPE_GL_AREA: TGtkType;
function GTK_GL_AREA(obj: Pointer): PGtkGLArea;
function GTK_GL_AREA_CLASS(klass: Pointer): PGtkGLAreaClass;
function GTK_IS_GL_AREA(obj: Pointer): Boolean;
function GTK_IS_GL_AREA_CLASS(klass: Pointer): Boolean;
function gtk_gl_area_get_type: TGtkType;
function gtk_gl_area_new(attrList: Plongint): PGtkWidget;
function gtk_gl_area_share_new(attrList: Plongint; share: PGtkGLArea): PGtkWidget;
function gtk_gl_area_make_current(glarea: PGtkGLArea): boolean;
function gtk_gl_area_begingl(glarea: PGtkGLArea): boolean;
procedure gtk_gl_area_swap_buffers(gl_area: PGtkGLArea);
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLCreateContext(AWinControl: TWinControl;
SharedControl: TWinControl; AttrList: PInteger): HWND;
const
DefaultOpenGLContextInitAttrList: array [0..10] of LongInt = (
GDK_GL_RGBA,
GDK_GL_RED_SIZE, 1,
GDK_GL_GREEN_SIZE, 1,
GDK_GL_BLUE_SIZE, 1,
GDK_GL_DEPTH_SIZE, 1,
GDK_GL_DOUBLEBUFFER,
GDK_GL_None
);
implementation
var
gl_area_type: TGtkType = 0;
parent_class: Pointer = nil;
type
TGdkGLContextPrivate = record
xdisplay: PDisplay;
glxcontext: TGLXContext;
ref_count: guint;
end;
PGdkGLContextPrivate = ^TGdkGLContextPrivate;
type
//PGLXPixmap = ^GLXPixmap;
GLXPixmap = TXID;
//PGLXDrawable = ^GLXDrawable;
GLXDrawable = TXID;
{ GLX 1.0 functions. }
function glXChooseVisual(dpy:PDisplay; screen:longint; attrib_list:Plongint):PXVisualInfo;cdecl;external;
procedure glXCopyContext(dpy:PDisplay; src:TGLXContext; dst:TGLXContext; mask: cardinal);cdecl;external;
function glXCreateContext(dpy:PDisplay; vis:PXVisualInfo; share_list:TGLXContext; direct:TBool):TGLXContext;cdecl;external;
function glXCreateGLXPixmap(dpy:PDisplay; vis:PXVisualInfo; pixmap:TPixmap):GLXPixmap;cdecl;external;
procedure glXDestroyContext(dpy:PDisplay; ctx:TGLXContext);cdecl;external;
procedure glXDestroyGLXPixmap(dpy:PDisplay; pix:GLXPixmap);cdecl;external;
function glXGetConfig(dpy:PDisplay; vis:PXVisualInfo; attrib:longint; value:Plongint):longint;cdecl;external;
function glXGetCurrentContext:TGLXContext;cdecl;external;
function glXGetCurrentDrawable:GLXDrawable;cdecl;external;
function glXIsDirect(dpy:PDisplay; ctx:TGLXContext):TBool;cdecl;external;
function glXMakeCurrent(dpy:PDisplay; drawable:GLXDrawable; ctx:TGLXContext):TBool;cdecl;external;
function glXQueryExtension(dpy:PDisplay; error_base:Plongint; event_base:Plongint):TBool;cdecl;external;
function glXQueryVersion(dpy:PDisplay; major:Plongint; minor:Plongint):TBool;cdecl;external;
procedure glXSwapBuffers(dpy:PDisplay; drawable:GLXDrawable);cdecl;external;
procedure glXUseXFont(font:TFont; first:longint; count:longint; list_base:longint);cdecl;external;
procedure glXWaitGL;cdecl;external;
procedure glXWaitX;cdecl;external;
procedure g_return_if_fail(b: boolean; const Msg: string);
begin
if not b then raise Exception.Create(Msg);
end;
procedure g_return_if_fail(b: boolean);
begin
g_return_if_fail(b,'');
end;
function DefaultScreen(ADisplay: PDisplay): longint;
begin
Result:=XDefaultScreen(ADisplay);
end;
function g_new(BaseSize, Count: integer): Pointer;
begin
Result:=g_malloc(BaseSize*Count);
end;
function GetDefaultXDisplay: PDisplay;
begin
Result:=GDK_DISPLAY;
end;
{$IFDEF LCLGtk2}
function GdkVisualAsString(Visual: PGdkVisual): string;
begin
if Visual=nil then begin
Result:='nil';
end else begin
with Visual^ do begin
Result:=''
//parent_instance : TGObject;
+' TheType='+dbgs(ord(TheType))
+' depth='+dbgs(depth)
+' byte_order='+dbgs(ord(byte_order))
+' colormap_size='+dbgs(colormap_size)
+' bits_per_rgb='+dbgs(bits_per_rgb)
+' red_mask='+hexstr(red_mask,8)
+' red_shift='+dbgs(red_shift)
+' red_prec='+dbgs(red_prec)
+' green_mask='+hexstr(green_mask,8)
+' green_shift='+dbgs(green_shift)
+' green_prec='+dbgs(green_prec)
+' blue_mask='+hexstr(blue_mask,8)
+' blue_shift='+dbgs(blue_shift)
+' blue_prec='+dbgs(blue_prec)
//screen : PGdkScreen;
+'';
end;
end;
end;
function XVisualAsString(AVisual: PVisual): string;
begin
if AVisual=nil then begin
Result:='nil';
end else begin
Result:=''
+' bits_per_rgb='+dbgs(AVisual^.bits_per_rgb)
+' red_mask='+hexstr(AVisual^.red_mask,8)
+' green_mask='+hexstr(AVisual^.green_mask,8)
+' blue_mask='+hexstr(AVisual^.blue_mask,8)
+' map_entries='+dbgs(AVisual^.map_entries)
+'';
end;
end;
function XDisplayAsString(ADisplay: PDisplay): string;
begin
if ADisplay=nil then begin
Result:='nil';
end else begin
Result:=''
+'';
end;
end;
{$ENDIF}
function get_xvisualinfo(visual: PGdkVisual): PXVisualInfo;
// IMPORTANT: remember to XFree returned XVisualInfo !!!
var
vinfo_template: TXVisualInfo;
dpy: PDisplay;
nitems_return: integer;
vi: PXVisualInfo;
begin
dpy := GetDefaultXDisplay;
{$IFDEF Lclgtk2}
DebugLn('get_xvisualinfo dpy=',XDisplayAsString(dpy));
DebugLn('get_xvisualinfo visual=',GdkVisualAsString(Visual));
{$ENDIF}
// 'GLX uses VisualInfo records because they uniquely identify
// a (VisualID,screen,depth) tuple.'
FillChar(vinfo_template,SizeOf(vinfo_template),0);
vinfo_template.visual := GDK_VISUAL_XVISUAL({$IFDEF LCLGTK}
PGdkVisualPrivate(visual)
{$ELSE}
visual
{$ENDIF});
vinfo_template.visualid := XVisualIDFromVisual(vinfo_template.visual);
vinfo_template.depth := PGdkVisualPrivate(visual)^.visual.depth;
vinfo_template.screen := DefaultScreen(GetDefaultXDisplay);
{$IFDEF LCLGTK2}
DebugLn('get_xvisualinfo vinfo_template.visual=',dbgs(vinfo_template.visual));
DebugLn('get_xvisualinfo vinfo_template.visual: ',XVisualAsString(vinfo_template.visual));
DebugLn('get_xvisualinfo vinfo_template.visualid=',dbgs(vinfo_template.visualid));
DebugLn('get_xvisualinfo vinfo_template.depth=',dbgs(vinfo_template.depth),' GetDefaultXDisplay=',dbgs(GetDefaultXDisplay));
DebugLn('get_xvisualinfo vinfo_template.screen=',dbgs(vinfo_template.screen));
{$ENDIF}
vi := XGetVisualInfo(dpy, VisualIDMask or VisualDepthMask or VisualScreenMask,
@vinfo_template, @nitems_return);
DebugLn('get_xvisualinfo nitems_return=',dbgs(nitems_return));
// visualinfo needs to be unique
if (vi=nil) then raise Exception.Create('get_xvisualinfo vi=nil');
if (nitems_return<>1) then raise Exception.Create('get_xvisualinfo nitems_return='+dbgs(nitems_return));
Result:=vi;
end;
procedure gtk_gl_area_destroy(obj: PGtkObject); cdecl;
var
gl_area: PGtkGLArea;
begin
g_return_if_fail (obj <>nil,'');
g_return_if_fail (GTK_IS_GL_AREA(obj),'');
gl_area := GTK_GL_AREA(obj);
gdk_gl_context_unref(gl_area^.glcontext);
if Assigned(GTK_OBJECT_CLASS(parent_class)^.destroy) then
GTK_OBJECT_CLASS(parent_class)^.destroy(obj);
end;
procedure gtk_gl_area_class_init(klass: Pointer); cdecl;
var
object_class: PGtkObjectClass;
begin
parent_class := gtk_type_class(gtk_drawing_area_get_type());
g_return_if_fail(parent_class<>nil,'gtk_gl_area_class_init parent_class=nil');
object_class := PGtkObjectClass(klass);
g_return_if_fail(object_class<>nil,'gtk_gl_area_class_init object_class=nil');
object_class^.destroy := @gtk_gl_area_destroy;
end;
function gdk_gl_query: boolean;
begin
Result:=boolean(glXQueryExtension(GetDefaultXDisplay,nil,nil)=true);
end;
function gdk_gl_choose_visual(attrlist: Plongint): PGdkVisual;
var
dpy: PDisplay;
vi: PXVisualInfo;
visual: PGdkVisual;
begin
//writeln('gdk_gl_choose_visual A ');
if attrList=nil then begin
Result:=nil;
exit;
end;
//writeln('gdk_gl_choose_visual B ');
dpy := GetDefaultXDisplay;
vi := glXChooseVisual(dpy,DefaultScreen(dpy), attrlist);
if (vi=nil) then begin
Result:=nil;
exit;
end;
//writeln('gdk_gl_choose_visual C ');
visual := gdkx_visual_get(vi^.visualid);
XFree(vi);
Result:=visual;
end;
function gdk_gl_get_config(visual: PGdkVisual; attrib: longint): longint;
var
dpy: PDisplay;
vi: PXVisualInfo;
value: integer;
begin
Result:=-1;
if visual=nil then exit;
dpy := GetDefaultXDisplay;
vi := get_xvisualinfo(visual);
if (glXGetConfig(dpy, vi, attrib, @value) = 0) then begin
XFree(vi);
Result:=value;
end else
XFree(vi);
end;
function gdk_gl_context_new(visual: PGdkVisual): PGdkGLContext;
begin
Result:=gdk_gl_context_share_new(visual,nil,0);
end;
function gdk_gl_context_share_new(visual: PGdkVisual; sharelist: PGdkGLContext;
direct: integer): PGdkGLContext;
var
dpy: PDisplay;
vi: PXVisualInfo;
PrivateShareList: PGdkGLContextPrivate;
PrivateContext: PGdkGLContextPrivate;
glxcontext: TGLXContext;
begin
Result:=nil;
if visual=nil then exit;
vi := get_xvisualinfo(visual);
dpy := GetDefaultXDisplay;
PrivateShareList:=PGdkGLContextPrivate(sharelist);
if (sharelist<>nil) then
glxcontext := glXCreateContext(dpy, vi, PrivateShareList^.glxcontext,
direct=1)
else
glxcontext := glXCreateContext(dpy, vi, nil, direct=1);
XFree(vi);
if (glxcontext = nil) then exit;
PrivateContext := g_new(SizeOf(TGdkGLContextPrivate), 1);
PrivateContext^.xdisplay := dpy;
PrivateContext^.glxcontext := glxcontext;
PrivateContext^.ref_count := 1;
Result := PGdkGLContext(PrivateContext);
end;
function gdk_gl_context_attrlist_share_new(attrlist: Plongint;
sharelist: PGdkGLContext; direct: Integer): PGdkGLContext;
var
visual: PGdkVisual;
begin
visual := gdk_gl_choose_visual(attrlist);
if (visual<>nil) then
Result:=gdk_gl_context_share_new(visual, sharelist, direct)
else
Result:=nil;
end;
function gdk_gl_context_ref(context: PGdkGLContext): PGdkGLContext;
var
PrivateContext: PGdkGLContextPrivate;
begin
Result:=nil;
if context=nil then exit;
PrivateContext := PGdkGLContextPrivate(context);
inc(PrivateContext^.ref_count);
Result:=context;
end;
procedure gdk_gl_context_unref(context: PGdkGLContext);
var
PrivateContext: PGdkGLContextPrivate;
begin
g_return_if_fail(context<>nil,'');
PrivateContext:=PGdkGLContextPrivate(context);
if (PrivateContext^.ref_count > 1) then
dec(PrivateContext^.ref_count)
else begin
if (PrivateContext^.glxcontext = glXGetCurrentContext()) then
glXMakeCurrent(PrivateContext^.xdisplay, None, nil);
glXDestroyContext(PrivateContext^.xdisplay, PrivateContext^.glxcontext);
g_free(PrivateContext);
end;
end;
function gdk_gl_make_current(drawable: PGdkDrawable;
context: PGdkGLContext): boolean;
var
PrivateContext: PGdkGLContextPrivate;
begin
Result:=false;
if drawable=nil then exit;
if context=nil then exit;
PrivateContext := PGdkGLContextPrivate(context);
Result:=boolean(glXMakeCurrent(PrivateContext^.xdisplay,
{$IFDEF LCLGTK}
GDK_WINDOW_XWINDOW(PGdkWindowPrivate(drawable)),
{$ELSE}
GDK_WINDOW_XWINDOW(drawable),
{$ENDIF}
PrivateContext^.glxcontext)=true);
end;
procedure gdk_gl_swap_buffers(drawable: PGdkDrawable);
begin
g_return_if_fail(drawable <> nil);
glXSwapBuffers({$IFDEF LCLGTK}
GDK_WINDOW_XDISPLAY(PGdkWindowPrivate(drawable)),
GDK_WINDOW_XWINDOW(PGdkWindowPrivate(drawable))
{$ELSE}
GDK_WINDOW_XDISPLAY(drawable),
GDK_WINDOW_XWINDOW(drawable)
{$ENDIF}
);
end;
procedure gdk_gl_wait_gdk;
begin
glXWaitX;
end;
procedure gdk_gl_wait_gl;
begin
glXWaitGL;
end;
procedure gtk_gl_area_init(
{$IFDEF LCLGTK}
gl_area, theClass: Pointer
{$ELSE}
gl_area: PGTypeInstance; theClass: gpointer
{$ENDIF}
); cdecl;
begin
if theClass=nil then ;
PGtkGLArea(gl_area)^.glcontext:=nil;
{$IFDEF Gtk2}
gtk_widget_set_double_buffered(PGtkWidget(gl_area),gdkFALSE);
{$ENDIF}
end;
function GTK_TYPE_GL_AREA: TGtkType;
const
gl_area_type_name = 'GtkGLArea';
gl_area_info: TGtkTypeInfo = (
type_name: gl_area_type_name;
object_size: SizeOf(TGtkGLArea);
class_size: SizeOf(TGtkGLAreaClass);
class_init_func: @gtk_gl_area_class_init;
object_init_func: @gtk_gl_area_init;
reserved_1: nil;
reserved_2: nil;
base_class_init_func: nil;
);
begin
if (gl_area_type=0) then begin
gl_area_type:=gtk_type_unique(gtk_drawing_area_get_type(),@gl_area_info);
end;
Result:=gl_area_type;
end;
function GTK_GL_AREA(obj: Pointer): PGtkGLArea;
begin
g_return_if_fail(GTK_IS_GL_AREA(obj),'');
Result:=PGtkGLArea(obj);
end;
function GTK_GL_AREA_CLASS(klass: Pointer): PGtkGLAreaClass;
begin
g_return_if_fail(GTK_IS_GL_AREA_CLASS(klass),'');
Result:=PGtkGLAreaClass(klass);
end;
function GTK_IS_GL_AREA(obj: Pointer): Boolean;
begin
{$IFDEF LCLGTK}
Result := Assigned(obj) and GTK_IS_GL_AREA_CLASS(PGtkTypeObject(obj)^.klass);
{$ELSE}
GTK_IS_GL_AREA:=GTK_CHECK_TYPE(obj,GTK_TYPE_GL_AREA);
{$ENDIF}
end;
function GTK_IS_GL_AREA_CLASS(klass: Pointer): Boolean;
begin
{$IFDEF LCLGTK}
Result := Assigned(klass) and (PGtkTypeClass(klass)^.thetype = GTK_TYPE_GL_AREA);
{$ELSE}
GTK_IS_GL_AREA_CLASS:=GTK_CHECK_CLASS_TYPE(klass,GTK_TYPE_GL_AREA);
{$ENDIF}
end;
function gtk_gl_area_get_type: TGtkType;
begin
Result:=GTK_TYPE_GL_AREA;
end;
function gtk_gl_area_new(attrList: Plongint): PGtkWidget;
var
Count: Integer;
CopyAttrList: Plongint;
Size: Integer;
begin
Count:=0;
while (attrList[Count]<>GDK_GL_NONE) do inc(Count);
inc(Count);
Size:=SizeOf(Integer)*Count;
CopyAttrList:=nil;
GetMem(CopyAttrList,Size);
System.Move(attrList^,CopyAttrList^,Size);
Result:=gtk_gl_area_share_new(CopyAttrList,nil);
FreeMem(CopyAttrList);
end;
function gtk_gl_area_share_new(attrList: Plongint; share: PGtkGLArea
): PGtkWidget;
var
visual: PGdkVisual;
sharelist: PGdkGLContext;
glcontext: PGdkGLContext;
gl_area: PGtkGLArea;
begin
Result:=nil;
//writeln('gtk_gl_area_share_new A ');
if (share<>nil) and (not GTK_IS_GL_AREA(share)) then
exit;
{$IFNDEF win32}
//writeln('gtk_gl_area_share_new B ');
visual := gdk_gl_choose_visual(attrlist);
if (visual = nil) then exit;
{$ENDIF non win32}
//writeln('gtk_gl_area_share_new C ');
sharelist := nil;
if share<>nil then sharelist:=share^.glcontext;
glcontext := gdk_gl_context_share_new(visual, sharelist, 1);
if (glcontext = nil) then exit;
//writeln('gtk_gl_area_share_new D ');
{$IFNDEF win32}
// use colormap and visual suitable for OpenGL rendering
gtk_widget_push_colormap(gdk_colormap_new(visual,gtk_TRUE));
gtk_widget_push_visual(visual);
{$ENDIF non win32}
gl_area := gtk_type_new (gtk_gl_area_get_type);
gl_area^.glcontext := glcontext;
//writeln('gtk_gl_area_share_new E ',gl_area<>nil);
{$IFNDEF win32}
// pop back defaults
gtk_widget_pop_visual;
gtk_widget_pop_colormap;
{$ENDIF non win32}
Result:=PGtkWidget(gl_area);
end;
function gtk_gl_area_make_current(glarea: PGtkGLArea): boolean;
begin
Result:=false;
if glarea=nil then exit;
if not GTK_IS_GL_AREA(glarea) then exit;
if not GTK_WIDGET_REALIZED(PGtkWidget(glarea)) then exit;
Result:=gdk_gl_make_current(PGtkWidget(glarea)^.window, glarea^.glcontext);
end;
function gtk_gl_area_begingl(glarea: PGtkGLArea): boolean;
begin
Result:=gtk_gl_area_make_current(glarea);
end;
procedure gtk_gl_area_swap_buffers(gl_area: PGtkGLArea);
begin
g_return_if_fail(gl_area <> nil);
g_return_if_fail(GTK_IS_GL_AREA(gl_area));
g_return_if_fail(GTK_WIDGET_REALIZED(PGtkWidget(gl_area)));
gdk_gl_swap_buffers(GTK_WIDGET(gl_area)^.window);
end;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
begin
glViewport(Left,Top,Width,Height);
end;
procedure LOpenGLSwapBuffers(Handle: HWND);
begin
gtk_gl_area_swap_buffers(PGtkGLArea(Handle));
end;
function LOpenGLMakeCurrent(Handle: HWND): boolean;
var
Widget: PGtkWidget;
glarea: PGtkGLArea;
begin
if Handle=0 then
RaiseGDBException('LOpenGLSwapBuffers Handle=0');
Result:=false;
Widget:=PGtkWidget(Pointer(Handle));
glarea:=PGtkGLArea(Widget);
if not GTK_IS_GL_AREA(glarea) then
RaiseGDBException('LOpenGLSwapBuffers not a PGtkGLArea');
// make sure the widget is realized
gtk_widget_realize(Widget);
if not GTK_WIDGET_REALIZED(Widget) then exit;
// make current
Result:=gtk_gl_area_make_current(glarea);
end;
const
InitAttrList: array [1..11] of LongInt = (
GDK_GL_RGBA,
GDK_GL_RED_SIZE, 1,
GDK_GL_GREEN_SIZE, 1,
GDK_GL_BLUE_SIZE, 1,
GDK_GL_DEPTH_SIZE, 1,
GDK_GL_DOUBLEBUFFER,
GDK_GL_None
);
function LOpenGLCreateContext(AWinControl: TWinControl;
SharedControl: TWinControl; AttrList: PInteger): HWND;
var
NewWidget: PGtkWidget;
SharedArea: PGtkGLArea;
begin
if AttrList=nil then
AttrList:=@InitAttrList;
if SharedControl<>nil then begin
SharedArea:=PGtkGLArea(SharedControl.Handle);
if not GTK_IS_GL_AREA(SharedArea) then
RaiseGDBException('LOpenGLCreateContext');
NewWidget:=gtk_gl_area_share_new(AttrList,SharedArea);
end else begin
NewWidget:=gtk_gl_area_new(AttrList);
end;
Result:=HWND(NewWidget);
{$IFDEF LCLGtk}
TGTKWidgetSet(WidgetSet).FinishComponentCreate(AWinControl,NewWidget,true);
{$ELSE}
TGTK2WidgetSet(WidgetSet).FinishComponentCreate(AWinControl,NewWidget,true);
{$ENDIF}
end;
end.

83
components/opengl/gtk2x11/gdk2x.pas Normal file
View File

@ -0,0 +1,83 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
}
unit gdk2x;
{$IFDEF FPC}
{$mode objfpc}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE KYLIX}
{$ENDIF}
interface
uses
Classes, SysUtils, libc, glib2, gdk2, xlib, x, xrender;
{$ifdef FREEBSD}
{$linklib c}
{$linklib pthread}
{$endif}
{$IFNDEF KYLIX}
{$PACKRECORDS C}
{$ELSE}
{$ALIGN 4}
{$WEAKPACKAGEUNIT}
{$WARNINGS OFF}
{$ENDIF}
{$DEFINE read_forward_definitions}
type
{$I gdk2x11includes.inc}
{$UNDEF read_forward_definitions}
{$DEFINE read_interface_rest}
{$I gdk2x11includes.inc}
{$UNDEF read_interface_rest}
implementation
{$IFNDEF KYLIX}
{ There is a bug in the compiler. If an external variable is not used, it will
create code, that can't be relocated by the linker.
So, use them in this hidden dummy procedure.
}
procedure CheckUnusedVariable; [Public];
begin
//_gdk_x11_drawable_class
//_gdk_use_xshm
//_gdk_nenvent_masks
//_gdk_event_mask_table
//_gdk_selection_property
//_gdk_synchronize
//gdk_display
end;
{$ENDIF}
{*****************************************************************************
* macro functions
*
*****************************************************************************}
// call implementation parts of header files
{$DEFINE read_implementation}
{$I gdk2x11includes.inc}
{$UNDEF read_implementation}
end.

91
components/opengl/gtk2x11/gdk2x11.lpk Normal file
View File

@ -0,0 +1,91 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="gdk2x11"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<IncludeFiles Value="include/"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="14">
<Item1>
<Filename Value="gdk2x.pas"/>
<UnitName Value="gdk2x"/>
</Item1>
<Item2>
<Filename Value="include/xsettings-common.inc"/>
<Type Value="Include"/>
</Item2>
<Item3>
<Filename Value="include/gdk2x11includes.inc"/>
<Type Value="Include"/>
</Item3>
<Item4>
<Filename Value="include/gdkdisplay-x11.inc"/>
<Type Value="Include"/>
</Item4>
<Item5>
<Filename Value="include/gdkdrawable-x11.inc"/>
<Type Value="Include"/>
</Item5>
<Item6>
<Filename Value="include/gdkinputprivate.inc"/>
<Type Value="Include"/>
</Item6>
<Item7>
<Filename Value="include/gdkpixmap-x11.inc"/>
<Type Value="Include"/>
</Item7>
<Item8>
<Filename Value="include/gdkprivate-x11.inc"/>
<Type Value="Include"/>
</Item8>
<Item9>
<Filename Value="include/gdkscreen-x11.inc"/>
<Type Value="Include"/>
</Item9>
<Item10>
<Filename Value="include/gdkwindow-x11.inc"/>
<Type Value="Include"/>
</Item10>
<Item11>
<Filename Value="include/gdkx.inc"/>
<Type Value="Include"/>
</Item11>
<Item12>
<Filename Value="include/gxid_proto.inc"/>
<Type Value="Include"/>
</Item12>
<Item13>
<Filename Value="include/mwmutil.inc"/>
<Type Value="Include"/>
</Item13>
<Item14>
<Filename Value="include/xsettings-client.inc"/>
<Type Value="Include"/>
</Item14>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

20
components/opengl/gtk2x11/gdk2x11.pas Normal file
View File

@ -0,0 +1,20 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit gdk2x11;
interface
uses
gdk2x, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('gdk2x11', @Register);
end.

14
components/opengl/gtk2x11/include/gdk2x11includes.inc Normal file
View File

@ -0,0 +1,14 @@
{%MainUnit ../gdk2x.pas}
{$I xsettings-common.inc}
{$I xsettings-client.inc}
{$I gdkdisplay-x11.inc}
{$I gdkdrawable-x11.inc}
{$I gdkinputprivate.inc}
{$I gdkpixmap-x11.inc}
{$I gdkprivate-x11.inc}
{$I gdkscreen-x11.inc}
{$I gdkwindow-x11.inc}
{$I gdkx.inc}
{$I gxid_proto.inc}
{$I mwmutil.inc}

121
components/opengl/gtk2x11/include/gdkdisplay-x11.inc Normal file
View File

@ -0,0 +1,121 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
{ Keyboard related information }
{ Whether we were able to turn on detectable-autorepeat using
XkbSetDetectableAutorepeat. If FALSE, we'll fall back
to checking the next event with XPending(). }
{ Information about current pointer and keyboard grabs held by this
client. If gdk_pointer_xgrab_window or gdk_keyboard_xgrab_window
window is NULL, then the other associated fields are ignored
}
{ drag and drop information }
{ data needed for MOTIF DnD }
{ Mapping to/from virtual atoms }
{ Session Management leader window see ICCCM }
{ list of filters for client messages }
{ X ID hashtable }
{ translation queue }
{ Input device }
{ input GdkDevice list }
{ input GdkWindow list }
{ information about network port and host for gxid daemon }
type
PGdkDisplayX11 = ^TGdkDisplayX11;
TGdkDisplayX11 = record
parent_instance : TGdkDisplay;
xdisplay : PDisplay;
default_screen : PGdkScreen;
screens : ^PGdkScreen;
grab_count : gint;
xkb_event_type : gint;
use_xkb : gboolean;
have_xkb_autorepeat : gboolean;
keymap : PGdkKeymap;
keymap_serial : guint;
use_xshm : gboolean;
have_shm_pixmaps : gboolean;
have_shape : gint;
pointer_xgrab_window : PGdkWindowObject;
pointer_xgrab_serial : gulong;
pointer_xgrab_owner_events : gboolean;
keyboard_xgrab_window : PGdkWindowObject;
keyboard_xgrab_serial : gulong;
keyboard_xgrab_owner_events : gboolean;
current_dest_drag : PGdkDragContext;
motif_drag_window : TWindow;
motif_drag_gdk_window : PGdkWindow;
motif_target_lists : ^PGList;
motif_n_target_lists : gint;
atom_from_virtual : PGHashTable;
atom_to_virtual : PGHashTable;
leader_window : TWindow;
client_filters : PGList;
xid_ht : PGHashTable;
translate_queue : PGQueue;
input_devices : PGList;
input_windows : PGList;
input_ignore_core : gint;
input_gxid_host : Pgchar;
input_gxid_port : gint;
use_xft : gint;
end;
PGdkDisplayX11Class = ^TGdkDisplayX11Class;
TGdkDisplayX11Class = record
parent_class : TGdkDisplayClass;
end;
// Private function GDK_TYPE_DISPLAY_X11 : GType;
function GDK_DISPLAY_X11(obj : pointer) : PGdkDisplayX11;
function GDK_DISPLAY_X11_CLASS(klass : pointer) : PGdkDisplayX11Class;
// Private function GDK_IS_DISPLAY_X11(obj : pointer) : boolean;
// Private function GDK_IS_DISPLAY_X11_CLASS(klass : pointer) : boolean;
// Private function GDK_DISPLAY_X11_GET_CLASS(obj : pointer) : PGdkDisplayX11Class;
// Private function _gdk_display_x11_get_type:GType;cdecl;external gdklib;
// Private function _gdk_x11_display_screen_for_xrootwin(display:PGdkDisplay; xrootwin:TWindow):PGdkScreen;cdecl;external;
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{ Private
function GDK_TYPE_DISPLAY_X11 : GType;
begin
GDK_TYPE_DISPLAY_X11:=_gdk_display_x11_get_type;
end;}
function GDK_DISPLAY_X11(obj : pointer) : PGdkDisplayX11;
begin
GDK_DISPLAY_X11:=PGdkDisplayX11(obj);
//GDK_DISPLAY_X11:=PGdkDisplayX11(G_TYPE_CHECK_INSTANCE_CAST(obj,GDK_TYPE_DISPLAY_X11));
end;
function GDK_DISPLAY_X11_CLASS(klass : pointer) : PGdkDisplayX11Class;
begin
GDK_DISPLAY_X11_CLASS:=PGdkDisplayX11Class(klass);
//GDK_DISPLAY_X11_CLASS:=PGdkDisplayX11Class(G_TYPE_CHECK_CLASS_CAST(klass,GDK_TYPE_DISPLAY_X11));
end;
{ Private
function GDK_IS_DISPLAY_X11(obj : pointer) : boolean;
begin
GDK_IS_DISPLAY_X11:=G_TYPE_CHECK_INSTANCE_TYPE(obj,GDK_TYPE_DISPLAY_X11);
end;
function GDK_IS_DISPLAY_X11_CLASS(klass : pointer) : boolean;
begin
GDK_IS_DISPLAY_X11_CLASS:=G_TYPE_CHECK_CLASS_TYPE(klass,GDK_TYPE_DISPLAY_X11);
end;
function GDK_DISPLAY_X11_GET_CLASS(obj : pointer) : PGdkDisplayX11Class;
begin
GDK_DISPLAY_X11_GET_CLASS:=PGdkDisplayX11Class(G_TYPE_INSTANCE_GET_CLASS(obj,GDK_TYPE_DISPLAY_X11));
end;}
{$ENDIF read_implementation}

75
components/opengl/gtk2x11/include/gdkdrawable-x11.inc Normal file
View File

@ -0,0 +1,75 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
{ Drawable implementation for X11 }
type
PGdkDrawableImplX11 = ^TGdkDrawableImplX11;
TGdkDrawableImplX11 = record
parent_instance : TGdkDrawable;
wrapper : PGdkDrawable;
colormap : PGdkColormap;
xid : TWindow;
screen : PGdkScreen;
{$IFDEF Has_XFT}
picture : TPicture;
{$ENDIF}
end;
PGdkDrawableImplX11Class = ^TGdkDrawableImplX11Class;
TGdkDrawableImplX11Class = record
parent_class : TGdkDrawableClass;
end;
// Private function GDK_TYPE_DRAWABLE_IMPL_X11 : GType;
function GDK_DRAWABLE_IMPL_X11(obj : pointer) : PGdkDrawableImplX11;
function GDK_DRAWABLE_IMPL_X11_CLASS(klass : pointer) : PGdkDrawableImplX11Class;
// Private function GDK_IS_DRAWABLE_IMPL_X11(obj : pointer) : boolean;
// Private function GDK_IS_DRAWABLE_IMPL_X11_CLASS(klass : pointer) : boolean;
// Private function GDK_DRAWABLE_IMPL_X11_GET_CLASS(obj : pointer) : PGdkDrawableImplX11Class;
// Private function _gdk_drawable_impl_x11_get_type:GType;cdecl;external;
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{ Private
function GDK_TYPE_DRAWABLE_IMPL_X11 : GType;
begin
GDK_TYPE_DRAWABLE_IMPL_X11:=_gdk_drawable_impl_x11_get_type;
end;}
function GDK_DRAWABLE_IMPL_X11(obj : pointer) : PGdkDrawableImplX11;
begin
GDK_DRAWABLE_IMPL_X11:=PGdkDrawableImplX11(obj);
//GDK_DRAWABLE_IMPL_X11:=PGdkDrawableImplX11(G_TYPE_CHECK_INSTANCE_CAST(obj,GDK_TYPE_DRAWABLE_IMPL_X11));
end;
function GDK_DRAWABLE_IMPL_X11_CLASS(klass : pointer) : PGdkDrawableImplX11Class;
begin
GDK_DRAWABLE_IMPL_X11_CLASS:=PGdkDrawableImplX11Class(klass);
//GDK_DRAWABLE_IMPL_X11_CLASS:=PGdkDrawableImplX11Class(G_TYPE_CHECK_CLASS_CAST(klass,GDK_TYPE_DRAWABLE_IMPL_X11));
end;
{ Private
function GDK_IS_DRAWABLE_IMPL_X11(obj : pointer) : boolean;
begin
GDK_IS_DRAWABLE_IMPL_X11:=G_TYPE_CHECK_INSTANCE_TYPE(obj,GDK_TYPE_DRAWABLE_IMPL_X11);
end;
function GDK_IS_DRAWABLE_IMPL_X11_CLASS(klass : pointer) : boolean;
begin
GDK_IS_DRAWABLE_IMPL_X11_CLASS:=G_TYPE_CHECK_CLASS_TYPE(klass,GDK_TYPE_DRAWABLE_IMPL_X11);
end;
function GDK_DRAWABLE_IMPL_X11_GET_CLASS(obj : pointer) : PGdkDrawableImplX11Class;
begin
GDK_DRAWABLE_IMPL_X11_GET_CLASS:=PGdkDrawableImplX11Class(G_TYPE_INSTANCE_GET_CLASS(obj,GDK_TYPE_DRAWABLE_IMPL_X11));
end;
}
{$ENDIF read_implementation}

148
components/opengl/gtk2x11/include/gdkinputprivate.inc Normal file
View File

@ -0,0 +1,148 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_forward_definitions}
PPPGdkTimeCoord = ^PPGdkTimeCoord;
{$ENDIF read_forward_definitions}
{$IFDEF read_interface_rest}
type
{ information about a device axis }
{ reported x resolution }
{ reported x minimum/maximum values }
{ calibrated resolution (for aspect ration) - only relative values
between axes used }
{ calibrated minimum/maximum values }
PGdkAxisInfo = ^TGdkAxisInfo;
TGdkAxisInfo = record
xresolution : gint;
xmin_value : gint;
xmax_value : gint;
resolution : gint;
min_value : gint;
max_value : gint;
end;
const
GDK_INPUT_NUM_EVENTC = 6;
{$ifndef XINPUT_NONE}
{ information about the axes }
{ Information about XInput device }
{ minimum key code for device }
{ true if we need to select a different set of events, but
can't because this is the core pointer }
{ Mask of buttons (used for button grabs) }
{ true if we've claimed the device as active. (used only for XINPUT_GXI) }
{$endif}
{ !XINPUT_NONE }
type
PGdkDevicePrivate = ^TGdkDevicePrivate;
TGdkDevicePrivate = record
info : TGdkDevice;
deviceid : guint32;
display : PGdkDisplay;
axes : PGdkAxisInfo;
xdevice : Pointer; // PXDevice;
min_keycode : gint;
buttonpress_type : longint;
buttonrelease_type : longint;
keypress_type : longint;
keyrelease_type : longint;
motionnotify_type : longint;
proximityin_type : longint;
proximityout_type : longint;
changenotify_type : longint;
needs_update : gint;
button_state : gint;
claimed : gint;
end;
P_GdkDeviceClass = ^T_GdkDeviceClass;
T_GdkDeviceClass = record
parent_class : TGObjectClass;
end;
{ gdk window }
{ Extension mode (GDK_EXTENSION_EVENTS_ALL/CURSOR) }
{ position relative to root window }
{ rectangles relative to window of windows obscuring this one }
{ Is there a pointer grab for this window ? }
PGdkInputWindow = ^TGdkInputWindow;
TGdkInputWindow = record
window : PGdkWindow;
mode : TGdkExtensionMode;
root_x : gint;
root_y : gint;
obscuring : PGdkRectangle;
num_obscuring : gint;
grabbed : gint;
end;
{ Global data }
// Private function GDK_IS_CORE(d : pointer) : boolean;
{ Function declarations }
function gdk_input_window_find(window:PGdkWindow):PGdkInputWindow;cdecl;external;
procedure gdk_input_window_destroy(window:PGdkWindow);cdecl;external;
function _gdk_device_allocate_history(device:PGdkDevice; n_events:gint):PPGdkTimeCoord;cdecl;external;
procedure _gdk_init_input_core;cdecl;external;
{ The following functions are provided by each implementation
(xfree, gxi, and none)
}
function _gdk_input_enable_window(window:PGdkWindow; gdkdev:PGdkDevicePrivate):gint;cdecl;external;
function _gdk_input_disable_window(window:PGdkWindow; gdkdev:PGdkDevicePrivate):gint;cdecl;external;
function _gdk_input_window_none_event(event:PGdkEvent; xevent:PXEvent):gint;cdecl;external;
procedure _gdk_input_configure_event(xevent:PXConfigureEvent; window:PGdkWindow);cdecl;external;
procedure _gdk_input_enter_event(xevent:PXCrossingEvent; window:PGdkWindow);cdecl;external;
function _gdk_input_other_event(event:PGdkEvent; xevent:PXEvent; window:PGdkWindow):gint;cdecl;external;
function _gdk_input_grab_pointer(window:PGdkWindow; owner_events:gint; event_mask:TGdkEventMask; confine_to:PGdkWindow; time:guint32):gint;cdecl;external;
procedure _gdk_input_ungrab_pointer(display:PGdkDisplay; time:guint32);cdecl;external;
function _gdk_device_get_history(device:PGdkDevice; window:PGdkWindow; start:guint32; stop:guint32; events:PPPGdkTimeCoord;
n_events:Pgint):gboolean;cdecl;external;
{$ifndef XINPUT_NONE}
const
GDK_MAX_DEVICE_CLASSES = 13;
function gdk_input_common_init(display:PGdkDisplay; include_core:gint):gint;cdecl;external;
function gdk_input_find_device(display:PGdkDisplay; id:guint32):PGdkDevicePrivate;cdecl;external;
procedure gdk_input_get_root_relative_geometry(display:PDisplay; w:TWindow; x_ret:Plongint; y_ret:Plongint; width_ret:Plongint;
height_ret:Plongint);cdecl;external;
procedure gdk_input_common_find_events(window:PGdkWindow; gdkdev:PGdkDevicePrivate; mask:gint; classes:Pointer {PXEventClass}; num_classes:Plongint);cdecl;external;
procedure gdk_input_common_select_events(window:PGdkWindow; gdkdev:PGdkDevicePrivate);cdecl;external;
function gdk_input_common_other_event(event:PGdkEvent; xevent:PXEvent; input_window:PGdkInputWindow; gdkdev:PGdkDevicePrivate):gint;cdecl;external;
{$endif}
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{ Private
function GDK_IS_CORE(d : pointer) : boolean;
begin
GDK_IS_CORE:= (PGdkDevice(d)) = _gdk_core_pointer;
end;}
{$ENDIF read_implementation}

90
components/opengl/gtk2x11/include/gdkpixmap-x11.inc Normal file
View File

@ -0,0 +1,90 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
{ Pixmap implementation for X11 }
type
PGdkPixmapImplX11 = ^TGdkPixmapImplX11;
TGdkPixmapImplX11 = record
parent_instance : TGdkDrawableImplX11;
width : gint;
height : gint;
flag0 : word;
end;
type
PGdkPixmapImplX11Class = ^TGdkPixmapImplX11Class;
TGdkPixmapImplX11Class = record
parent_class : TGdkDrawableImplX11Class;
end;
// Private function GDK_TYPE_PIXMAP_IMPL_X11 : GType;
function GDK_PIXMAP_IMPL_X11(obj : pointer) : PGdkPixmapImplX11;
function GDK_PIXMAP_IMPL_X11_CLASS(klass : pointer) : PGdkPixmapImplX11Class;
// Private function GDK_IS_PIXMAP_IMPL_X11(obj : pointer) : boolean;
// Private function GDK_IS_PIXMAP_IMPL_X11_CLASS(klass : pointer) : boolean;
// Private function GDK_PIXMAP_IMPL_X11_GET_CLASS(obj : pointer) : PGdkPixmapImplX11Class;
const
bm_TGdkPixmapImplX11_is_foreign = $1;
bp_TGdkPixmapImplX11_is_foreign = 0;
function is_foreign(a : PGdkPixmapImplX11) : guint;
procedure set_is_foreign(a : PGdkPixmapImplX11; __is_foreign : guint);
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{ Private
function gdk_pixmap_impl_x11_get_type: GType; cdecl; external;
function GDK_TYPE_PIXMAP_IMPL_X11 : GType;
begin
GDK_TYPE_PIXMAP_IMPL_X11:=gdk_pixmap_impl_x11_get_type;
end; }
function GDK_PIXMAP_IMPL_X11(obj : pointer) : PGdkPixmapImplX11;
begin
GDK_PIXMAP_IMPL_X11:=PGdkPixmapImplX11(obj);
//GDK_PIXMAP_IMPL_X11:=PGdkPixmapImplX11(G_TYPE_CHECK_INSTANCE_CAST(obj,GDK_TYPE_PIXMAP_IMPL_X11));
end;
function GDK_PIXMAP_IMPL_X11_CLASS(klass : pointer) : PGdkPixmapImplX11Class;
begin
GDK_PIXMAP_IMPL_X11_CLASS:=PGdkPixmapImplX11Class(klass);
//GDK_PIXMAP_IMPL_X11_CLASS:=PGdkPixmapImplX11Class(G_TYPE_CHECK_CLASS_CAST(klass,GDK_TYPE_PIXMAP_IMPL_X11));
end;
{ Private
function GDK_IS_PIXMAP_IMPL_X11(obj : pointer) : boolean;
begin
GDK_IS_PIXMAP_IMPL_X11:=G_TYPE_CHECK_INSTANCE_TYPE(obj,GDK_TYPE_PIXMAP_IMPL_X11);
end;
function GDK_IS_PIXMAP_IMPL_X11_CLASS(klass : pointer) : boolean;
begin
GDK_IS_PIXMAP_IMPL_X11_CLASS:=G_TYPE_CHECK_CLASS_TYPE(klass,GDK_TYPE_PIXMAP_IMPL_X11);
end;
function GDK_PIXMAP_IMPL_X11_GET_CLASS(obj : pointer) : PGdkPixmapImplX11Class;
begin
GDK_PIXMAP_IMPL_X11_GET_CLASS:=PGdkPixmapImplX11Class(G_TYPE_INSTANCE_GET_CLASS(obj,GDK_TYPE_PIXMAP_IMPL_X11));
end; }
function is_foreign(a : PGdkPixmapImplX11) : guint;
begin
is_foreign:=(a^.flag0 and bm_TGdkPixmapImplX11_is_foreign) shr bp_TGdkPixmapImplX11_is_foreign;
end;
procedure set_is_foreign(a : PGdkPixmapImplX11; __is_foreign : guint);
begin
a^.flag0:=a^.flag0 or ((__is_foreign shl bp_TGdkPixmapImplX11_is_foreign) and bm_TGdkPixmapImplX11_is_foreign);
end;
{$ENDIF read_implementation}

243
components/opengl/gtk2x11/include/gdkprivate-x11.inc Normal file
View File

@ -0,0 +1,243 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_forward_definitions}
// remove this TXRenderColor, when it has been added to the X11 bindings of FPC
TXRenderColor = record
red: word;
green: word;
blue: word;
alpha: word;
end;
PPXRectangle = ^PXRectangle;
{$ENDIF read_forward_definitions}
{$IFDEF read_interface_rest}
type
PGdkGCX11 = ^TGdkGCX11;
TGdkGCX11 = record
parent_instance : TGdkGC;
xgc : TGC;
screen : PGdkScreen;
clip_region : PGdkRegion;
dirty_mask : guint;
fg_picture : TPicture;
fg_picture_color : TXRenderColor;
fg_pixel : gulong;
end;
PGdkGCX11Class = ^TGdkGCX11Class;
TGdkGCX11Class = record
parent_class : TGdkGCClass;
end;
PGdkCursorPrivate = ^TGdkCursorPrivate;
TGdkCursorPrivate = record
cursor : TGdkCursor;
xcursor : TCursor;
screen : PGdkScreen;
end;
PGdkVisualPrivate = ^TGdkVisualPrivate;
TGdkVisualPrivate = record
visual : TGdkVisual;
xvisual : PVisual;
screen : PGdkScreen;
end;
// Private function GDK_TYPE_GC_X11 : GType;
function GDK_GC_X11(obj : pointer) : PGdkGCX11;
function GDK_GC_X11_CLASS(klass : pointer) : PGdkGCX11Class;
// Private function GDK_IS_GC_X11(obj : pointer) : boolean;
// Private function GDK_IS_GC_X11_CLASS(klass : pointer) : boolean;
// Private function GDK_GC_X11_GET_CLASS(obj : pointer) : PGdkGCX11Class;
procedure _gdk_xid_table_insert(display:PGdkDisplay; xid:PXID; data:gpointer);cdecl;external;
procedure _gdk_xid_table_remove(display:PGdkDisplay; xid:TXID);cdecl;external;
function _gdk_send_xevent(display:PGdkDisplay; window:TWindow; propagate:gboolean; event_mask:glong; event_send:PXEvent):gint;cdecl;external;
// Private function _gdk_gc_x11_get_type:GType;cdecl;external;
{$ifdef HAVE_XFT}
function _gdk_x11_have_render(display:PGdkDisplay):gboolean;cdecl;external;
function _gdk_x11_gc_get_fg_picture(gc:PGdkGC):TPicture;cdecl;external;
{$endif HAVE_XFT}
function _gdk_x11_gc_new(drawable:PGdkDrawable; values:PGdkGCValues; values_mask:TGdkGCValuesMask):PGdkGC;cdecl;external;
function gdk_colormap_lookup(xcolormap:TColormap):PGdkColormap;cdecl;external;
function gdk_visual_lookup(xvisual:PVisual):PGdkVisual;cdecl;external;
procedure gdk_window_add_colormap_windows(window:PGdkWindow);cdecl;external;
function _gdk_x11_copy_to_image(drawable:PGdkDrawable; image:PGdkImage; src_x:gint; src_y:gint; dest_x:gint;
dest_y:gint; width:gint; height:gint):PGdkImage;cdecl;external;
function _gdk_x11_image_get_shm_pixmap(image:PGdkImage):TPixmap;cdecl;external;
{ Routines from gdkgeometry-x11.c }
procedure _gdk_window_init_position(window:PGdkWindow);cdecl;external;
procedure _gdk_window_move_resize_child(window:PGdkWindow; x:gint; y:gint; width:gint; height:gint);cdecl;external;
procedure _gdk_window_process_expose(window:PGdkWindow; serial:gulong; area:PGdkRectangle);cdecl;external;
procedure _gdk_selection_window_destroyed(window:PGdkWindow);cdecl;external;
function _gdk_selection_filter_clear_event(event:PXSelectionClearEvent):gboolean;cdecl;external;
procedure _gdk_region_get_xrectangles(region:PGdkRegion; x_offset:gint; y_offset:gint; rects:PPXRectangle; n_rects:Pgint);cdecl;external;
function _gdk_moveresize_handle_event(event:PXEvent):gboolean;cdecl;external;
function _gdk_moveresize_configure_done(display:PGdkDisplay; window:PGdkWindow):gboolean;cdecl;external;
procedure _gdk_keymap_state_changed(display:PGdkDisplay);cdecl;external;
function _gdk_x11_get_group_for_state(display:PGdkDisplay; state:TGdkModifierType):gint;cdecl;external;
//function _gdk_x11_gc_flush(gc:PGdkGC):TGC;cdecl;external;
procedure _gdk_x11_initialize_locale;cdecl;external;
procedure _gdk_xgrab_check_unmap(window:PGdkWindow; serial:gulong);cdecl;external;
procedure _gdk_xgrab_check_destroy(window:PGdkWindow);cdecl;external;
function _gdk_x11_display_is_root_window(display:PGdkDisplay; xroot_window:TWindow):gboolean;cdecl;external;
procedure _gdk_x11_events_init_screen(screen:PGdkScreen);cdecl;external;
procedure _gdk_events_init(display:PGdkDisplay);cdecl;external;
procedure _gdk_windowing_window_init(screen:PGdkScreen);cdecl;external;
procedure _gdk_visual_init(screen:PGdkScreen);cdecl;external;
procedure _gdk_dnd_init(display:PGdkDisplay);cdecl;external;
procedure _gdk_windowing_image_init(display:PGdkDisplay);cdecl;external;
procedure _gdk_input_init(display:PGdkDisplay);cdecl;external;
var
_gdk_x11_drawable_class : TGdkDrawableClass;cvar;external;
_gdk_use_xshm : gboolean;cvar;external;
(* Const before type ignored *)
_gdk_nenvent_masks : longint;cvar;external;
(* Const before type ignored *)
_gdk_event_mask_table : array of longint;cvar;external;
_gdk_selection_property : TGdkAtom;cvar;external;
_gdk_synchronize : gboolean;cvar;external;
function GDK_PIXMAP_SCREEN(pix : pointer) : PGdkScreen;
function GDK_PIXMAP_DISPLAY(pix : pointer) : PGdkDisplay;
function GDK_PIXMAP_XROOTWIN(pix : pointer) : TWindow;
function GDK_DRAWABLE_DISPLAY(win : PGdkDrawable) : PGdkDisplay;
function GDK_DRAWABLE_SCREEN(win : PGdkDrawable) : PGdkScreen;
function GDK_DRAWABLE_XROOTWIN(win : PGdkDrawable) : TWindow;
function GDK_SCREEN_DISPLAY(screen : PGdkScreen) : PGdkDisplay;
function GDK_SCREEN_XROOTWIN(screen : PGdkScreen) : TWindow;
function GDK_WINDOW_SCREEN(win : PGdkDrawable) : PGdkScreen;
function GDK_WINDOW_DISPLAY(win : PGdkDrawable) : PGdkDisplay;
function GDK_WINDOW_XROOTWIN(win : PGdkDrawable) : TWindow;
function GDK_GC_DISPLAY(gc : PGdkGC) : PGdkDisplay;
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{ Private
function GDK_TYPE_GC_X11 : GType;
begin
GDK_TYPE_GC_X11:=_gdk_gc_x11_get_type;
end;}
function GDK_GC_X11(obj : pointer) : PGdkGCX11;
begin
GDK_GC_X11:=PGdkGCX11(obj);
//GDK_GC_X11:=PGdkGCX11(G_TYPE_CHECK_INSTANCE_CAST(obj,GDK_TYPE_GC_X11));
end;
function GDK_GC_X11_CLASS(klass : pointer) : PGdkGCX11Class;
begin
GDK_GC_X11_CLASS:=PGdkGCX11Class(klass);
//GDK_GC_X11_CLASS:=PGdkGCX11Class(G_TYPE_CHECK_CLASS_CAST(klass,GDK_TYPE_GC_X11));
end;
{ Private
function GDK_IS_GC_X11(obj : pointer) : boolean;
begin
GDK_IS_GC_X11:=G_TYPE_CHECK_INSTANCE_TYPE(obj,GDK_TYPE_GC_X11);
end;
function GDK_IS_GC_X11_CLASS(klass : pointer) : boolean;
begin
GDK_IS_GC_X11_CLASS:=G_TYPE_CHECK_CLASS_TYPE(klass,GDK_TYPE_GC_X11);
end;
function GDK_GC_X11_GET_CLASS(obj : pointer) : PGdkGCX11Class;
begin
GDK_GC_X11_GET_CLASS:=PGdkGCX11Class(G_TYPE_INSTANCE_GET_CLASS(obj,GDK_TYPE_GC_X11));
end; }
function GDK_PIXMAP_SCREEN(pix : pointer) : PGdkScreen;
begin
GDK_PIXMAP_SCREEN:=(GDK_DRAWABLE_IMPL_X11((PGdkPixmapObject(pix))^.impl))^.screen;
end;
function GDK_PIXMAP_DISPLAY(pix : pointer) : PGdkDisplay;
begin
GDK_PIXMAP_DISPLAY:=(GDK_SCREEN_X11(GDK_PIXMAP_SCREEN(pix)))^.display;
end;
function GDK_PIXMAP_XROOTWIN(pix : pointer) : TWindow;
begin
GDK_PIXMAP_XROOTWIN:=(GDK_SCREEN_X11(GDK_PIXMAP_SCREEN(pix)))^.xroot_window;
end;
function GDK_DRAWABLE_DISPLAY(win : PGdkDrawable) : PGdkDisplay;
var
if_local1 : PGdkDisplay;
begin
if GDK_IS_WINDOW(win) then
if_local1:=GDK_WINDOW_DISPLAY(win)
else
if_local1:=GDK_PIXMAP_DISPLAY(win);
GDK_DRAWABLE_DISPLAY:=if_local1;
end;
function GDK_DRAWABLE_SCREEN(win : PGdkDrawable) : PGdkScreen;
var
if_local1 : PGdkScreen;
begin
if GDK_IS_WINDOW(win) then
if_local1:=GDK_WINDOW_SCREEN(win)
else
if_local1:=GDK_PIXMAP_SCREEN(win);
GDK_DRAWABLE_SCREEN:=if_local1;
end;
function GDK_DRAWABLE_XROOTWIN(win : PGdkDrawable) : TWindow;
var
if_local1 : TWindow;
begin
if GDK_IS_WINDOW(win) then
if_local1:=GDK_WINDOW_XROOTWIN(win)
else
if_local1:=GDK_PIXMAP_XROOTWIN(win);
GDK_DRAWABLE_XROOTWIN:=if_local1;
end;
function GDK_SCREEN_DISPLAY(screen : PGdkScreen) : PGdkDisplay;
begin
GDK_SCREEN_DISPLAY:=(GDK_SCREEN_X11(screen))^.display;
end;
function GDK_SCREEN_XROOTWIN(screen : PGdkScreen) : TWindow;
begin
GDK_SCREEN_XROOTWIN:=(GDK_SCREEN_X11(screen))^.xroot_window;
end;
function GDK_WINDOW_SCREEN(win : PGdkDrawable) : PGdkScreen;
begin
GDK_WINDOW_SCREEN:=(GDK_DRAWABLE_IMPL_X11((PGdkWindowObject(win))^.impl))^.screen;
end;
function GDK_WINDOW_DISPLAY(win : PGdkDrawable) : PGdkDisplay;
begin
GDK_WINDOW_DISPLAY:=(GDK_SCREEN_X11(GDK_WINDOW_SCREEN(win)))^.display;
end;
function GDK_WINDOW_XROOTWIN(win : PGdkDrawable) : TWindow;
begin
GDK_WINDOW_XROOTWIN:=(GDK_SCREEN_X11(GDK_WINDOW_SCREEN(win)))^.xroot_window;
end;
function GDK_GC_DISPLAY(gc : PGdkGC) : PGdkDisplay;
begin
GDK_GC_DISPLAY:=GDK_SCREEN_DISPLAY((GDK_GC_X11(gc))^.screen);
end;
{$ENDIF read_implementation}

95
components/opengl/gtk2x11/include/gdkscreen-x11.inc Normal file
View File

@ -0,0 +1,95 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
{ Visual Part }
{ Colormap Part }
{ X settings }
{ Xinerama }
type
PGdkScreenX11 = ^TGdkScreenX11;
TGdkScreenX11 = record
parent_instance : TGdkScreen;
display : PGdkDisplay;
xdisplay : PDisplay;
xscreen : PScreen;
screen_num : gint;
xroot_window : TWindow;
root_window : PGdkWindow;
wmspec_check_window : TWindow;
system_visual : PGdkVisualPrivate;
visuals : ^PGdkVisualPrivate;
nvisuals : gint;
available_depths : array[0..6] of gint;
navailable_depths : gint;
available_types : array[0..5] of TGdkVisualType;
navailable_types : gint;
visual_hash : PGHashTable;
default_colormap : PGdkColormap;
system_colormap : PGdkColormap;
xsettings_client : PXSettingsClient;
num_monitors : gint;
monitors : PGdkRectangle;
end;
PGdkScreenX11Class = ^TGdkScreenX11Class;
TGdkScreenX11Class = record
parent_class : TGdkScreenClass;
end;
// Private function GDK_TYPE_SCREEN_X11 : GType;
function GDK_SCREEN_X11(obj : pointer) : PGdkScreenX11;
function GDK_SCREEN_X11_CLASS(klass : pointer) : PGdkScreenX11Class;
// Private function GDK_IS_SCREEN_X11(obj : pointer) : boolean;
// Private function GDK_IS_SCREEN_X11_CLASS(klass : pointer) : boolean;
// Private function GDK_SCREEN_X11_GET_CLASS(obj : pointer) : PGdkScreenX11Class;
// Private function _gdk_screen_x11_get_type:GType;cdecl;external;
function _gdk_x11_screen_new(display:PGdkDisplay; screen_number:gint):PGdkScreen;cdecl;external;
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{ Private
function GDK_TYPE_SCREEN_X11 : GType;
begin
GDK_TYPE_SCREEN_X11:=_gdk_screen_x11_get_type;
end;}
function GDK_SCREEN_X11(obj : pointer) : PGdkScreenX11;
begin
GDK_SCREEN_X11:=PGdkScreenX11(obj);
//GDK_SCREEN_X11:=PGdkScreenX11(G_TYPE_CHECK_INSTANCE_CAST(obj,GDK_TYPE_SCREEN_X11));
end;
function GDK_SCREEN_X11_CLASS(klass : pointer) : PGdkScreenX11Class;
begin
GDK_SCREEN_X11_CLASS:=PGdkScreenX11Class(klass);
//GDK_SCREEN_X11_CLASS:=PGdkScreenX11Class(G_TYPE_CHECK_CLASS_CAST(klass,GDK_TYPE_SCREEN_X11));
end;
{ Private
function GDK_IS_SCREEN_X11(obj : pointer) : boolean;
begin
GDK_IS_SCREEN_X11:=G_TYPE_CHECK_INSTANCE_TYPE(obj,GDK_TYPE_SCREEN_X11);
end;
function GDK_IS_SCREEN_X11_CLASS(klass : pointer) : boolean;
begin
GDK_IS_SCREEN_X11_CLASS:=G_TYPE_CHECK_CLASS_TYPE(klass,GDK_TYPE_SCREEN_X11);
end;
function GDK_SCREEN_X11_GET_CLASS(obj : pointer) : PGdkScreenX11Class;
begin
GDK_SCREEN_X11_GET_CLASS:=PGdkScreenX11Class(G_TYPE_INSTANCE_GET_CLASS(obj,GDK_TYPE_SCREEN_X11));
end;}
{$ENDIF read_implementation}

177
components/opengl/gtk2x11/include/gdkwindow-x11.inc Normal file
View File

@ -0,0 +1,177 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
type
{ Offsets to add to X coordinates within window }
{ to get GDK coodinates within window }
{ Set when the window background is temporarily
unset during resizing and scaling }
{ visible rectangle of window }
PGdkXPositionInfo = ^TGdkXPositionInfo;
TGdkXPositionInfo = record
x : gint;
y : gint;
width : gint;
height : gint;
x_offset : gint;
y_offset : gint;
flag0 : word;
clip_rect : TGdkRectangle;
end;
const
bm_TGdkXPositionInfo_big = $1;
bp_TGdkXPositionInfo_big = 0;
bm_TGdkXPositionInfo_mapped = $2;
bp_TGdkXPositionInfo_mapped = 1;
bm_TGdkXPositionInfo_no_bg = $4;
bp_TGdkXPositionInfo_no_bg = 2;
function big(var a : TGdkXPositionInfo) : guint;
procedure set_big(var a : TGdkXPositionInfo; __big : guint);
function mapped(var a : TGdkXPositionInfo) : guint;
procedure set_mapped(var a : TGdkXPositionInfo; __mapped : guint);
function no_bg(var a : TGdkXPositionInfo) : guint;
procedure set_no_bg(var a : TGdkXPositionInfo; __no_bg : guint);
{ Window implementation for X11 }
type
PGdkWindowImplX11 = ^TGdkWindowImplX11;
TGdkWindowImplX11 = record
parent_instance : TGdkDrawableImplX11;
width : gint;
height : gint;
position_info : TGdkXPositionInfo;
flag0 : word;
focus_window : TWindow;
end;
type
PGdkWindowImplX11Class = ^TGdkWindowImplX11Class;
TGdkWindowImplX11Class = record
parent_class : TGdkDrawableImplX11Class;
end;
function GDK_TYPE_WINDOW_IMPL_X11 : GType;
function GDK_WINDOW_IMPL_X11(obj : pointer) : PGdkWindowImplX11;
function GDK_WINDOW_IMPL_X11_CLASS(klass : pointer) : PGdkWindowImplX11Class;
function GDK_IS_WINDOW_IMPL_X11(obj : pointer) : boolean;
function GDK_IS_WINDOW_IMPL_X11_CLASS(klass : pointer) : boolean;
function GDK_WINDOW_IMPL_X11_GET_CLASS(obj : pointer) : PGdkWindowImplX11Class;
{ Set if the window, or any descendent of it, has the focus }
{ Set if !window_has_focus, but events are being sent to the
window because the pointer is in it. (Typically, no window
manager is running. }
{ We use an extra X window for toplevel windows that we XSetInputFocus()
to in order to avoid getting keyboard events redirected to subwindows
that might not even be part of this app }
const
bm_TGdkWindowImplX11_has_focus = $1;
bp_TGdkWindowImplX11_has_focus = 0;
bm_TGdkWindowImplX11_has_pointer_focus = $2;
bp_TGdkWindowImplX11_has_pointer_focus = 1;
function has_focus(var a : TGdkWindowImplX11) : guint;
procedure set_has_focus(var a : TGdkWindowImplX11; __has_focus : guint);
function has_pointer_focus(var a : TGdkWindowImplX11) : guint;
procedure set_has_pointer_focus(var a : TGdkWindowImplX11; __has_pointer_focus : guint);
function gdk_window_impl_x11_get_type:GType;cdecl;external;
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
function big(var a : TGdkXPositionInfo) : guint;
begin
big:=(a.flag0 and bm_TGdkXPositionInfo_big) shr bp_TGdkXPositionInfo_big;
end;
procedure set_big(var a : TGdkXPositionInfo; __big : guint);
begin
a.flag0:=a.flag0 or ((__big shl bp_TGdkXPositionInfo_big) and bm_TGdkXPositionInfo_big);
end;
function mapped(var a : TGdkXPositionInfo) : guint;
begin
mapped:=(a.flag0 and bm_TGdkXPositionInfo_mapped) shr bp_TGdkXPositionInfo_mapped;
end;
procedure set_mapped(var a : TGdkXPositionInfo; __mapped : guint);
begin
a.flag0:=a.flag0 or ((__mapped shl bp_TGdkXPositionInfo_mapped) and bm_TGdkXPositionInfo_mapped);
end;
function no_bg(var a : TGdkXPositionInfo) : guint;
begin
no_bg:=(a.flag0 and bm_TGdkXPositionInfo_no_bg) shr bp_TGdkXPositionInfo_no_bg;
end;
procedure set_no_bg(var a : TGdkXPositionInfo; __no_bg : guint);
begin
a.flag0:=a.flag0 or ((__no_bg shl bp_TGdkXPositionInfo_no_bg) and bm_TGdkXPositionInfo_no_bg);
end;
function GDK_TYPE_WINDOW_IMPL_X11 : GType;
begin
GDK_TYPE_WINDOW_IMPL_X11:=gdk_window_impl_x11_get_type;
end;
function GDK_WINDOW_IMPL_X11(obj : pointer) : PGdkWindowImplX11;
begin
GDK_WINDOW_IMPL_X11:=PGdkWindowImplX11(G_TYPE_CHECK_INSTANCE_CAST(obj,GDK_TYPE_WINDOW_IMPL_X11));
end;
function GDK_WINDOW_IMPL_X11_CLASS(klass : pointer) : PGdkWindowImplX11Class;
begin
GDK_WINDOW_IMPL_X11_CLASS:=PGdkWindowImplX11Class(G_TYPE_CHECK_CLASS_CAST(klass,GDK_TYPE_WINDOW_IMPL_X11));
end;
function GDK_IS_WINDOW_IMPL_X11(obj : pointer) : boolean;
begin
GDK_IS_WINDOW_IMPL_X11:=G_TYPE_CHECK_INSTANCE_TYPE(obj,GDK_TYPE_WINDOW_IMPL_X11);
end;
function GDK_IS_WINDOW_IMPL_X11_CLASS(klass : pointer) : boolean;
begin
GDK_IS_WINDOW_IMPL_X11_CLASS:=G_TYPE_CHECK_CLASS_TYPE(klass,GDK_TYPE_WINDOW_IMPL_X11);
end;
function GDK_WINDOW_IMPL_X11_GET_CLASS(obj : pointer) : PGdkWindowImplX11Class;
begin
GDK_WINDOW_IMPL_X11_GET_CLASS:=PGdkWindowImplX11Class(G_TYPE_INSTANCE_GET_CLASS(obj,GDK_TYPE_WINDOW_IMPL_X11));
end;
function has_focus(var a : TGdkWindowImplX11) : guint;
begin
has_focus:=(a.flag0 and bm_TGdkWindowImplX11_has_focus) shr bp_TGdkWindowImplX11_has_focus;
end;
procedure set_has_focus(var a : TGdkWindowImplX11; __has_focus : guint);
begin
a.flag0:=a.flag0 or ((__has_focus shl bp_TGdkWindowImplX11_has_focus) and bm_TGdkWindowImplX11_has_focus);
end;
function has_pointer_focus(var a : TGdkWindowImplX11) : guint;
begin
has_pointer_focus:=(a.flag0 and bm_TGdkWindowImplX11_has_pointer_focus) shr bp_TGdkWindowImplX11_has_pointer_focus;
end;
procedure set_has_pointer_focus(var a : TGdkWindowImplX11; __has_pointer_focus : guint);
begin
a.flag0:=a.flag0 or ((__has_pointer_focus shl bp_TGdkWindowImplX11_has_pointer_focus) and bm_TGdkWindowImplX11_has_pointer_focus);
end;
{$ENDIF read_implementation}

284
components/opengl/gtk2x11/include/gdkx.inc Normal file
View File

@ -0,0 +1,284 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
var
gdk_display : PDisplay;cvar;external;
function gdk_x11_drawable_get_xdisplay(drawable:PGdkDrawable):PDisplay;cdecl;external;
function gdk_x11_drawable_get_xid(drawable:PGdkDrawable):TXID;cdecl;external;
function gdk_x11_image_get_xdisplay(image:PGdkImage):PDisplay;cdecl;external;
function gdk_x11_image_get_ximage(image:PGdkImage):PXImage;cdecl;external;
function gdk_x11_colormap_get_xdisplay(colormap:PGdkColormap):PDisplay;cdecl;external;
function gdk_x11_colormap_get_xcolormap(colormap:PGdkColormap):TColormap;cdecl;external;
function gdk_x11_cursor_get_xdisplay(cursor:PGdkCursor):PDisplay;cdecl;external;
function gdk_x11_cursor_get_xcursor(cursor:PGdkCursor):TCursor;cdecl;external;
function gdk_x11_display_get_xdisplay(display:PGdkDisplay):PDisplay;cdecl;external;
function gdk_x11_visual_get_xvisual(visual:PGdkVisual):PVisual;cdecl;external;
function gdk_x11_gc_get_xdisplay(gc:PGdkGC):PDisplay;cdecl;external;
function gdk_x11_gc_get_xgc(gc:PGdkGC):TGC;cdecl;external;
function gdk_x11_screen_get_xscreen(screen:PGdkScreen):PScreen;cdecl;external;
function gdk_x11_screen_get_screen_number(screen:PGdkScreen):longint;cdecl;external;
{$ifndef GDK_MULTIHEAD_SAFE}
function gdk_x11_get_default_root_xwindow:TWindow;cdecl;external;
function gdk_x11_get_default_xdisplay:PDisplay;cdecl;external;
function gdk_x11_get_default_screen:gint;cdecl;external;
{$endif}
function GDK_COLORMAP_XDISPLAY(cmap : PGdkColormap) : PDisplay;
function GDK_COLORMAP_XCOLORMAP(cmap : PGdkColormap) : TColormap;
function GDK_CURSOR_XDISPLAY(cursor : PGdkCursor) : PDisplay;
function GDK_CURSOR_XCURSOR(cursor : PGdkCursor) : TCursor;
function GDK_IMAGE_XDISPLAY(image : PGdkImage) : PDisplay;
function GDK_IMAGE_XIMAGE(image : PGdkImage) : PXImage;
{$ifndef GDK_MULTIHEAD_SAFE}
function GDK_ROOT_WINDOW : TWindow;
{$endif}
function GDK_DISPLAY_XDISPLAY(display : PGdkDisplay) : PDisplay;
function GDK_WINDOW_XDISPLAY(win : PGdkDrawable) : PDisplay;
function GDK_WINDOW_XID(win : PGdkDrawable) : TXID;
function GDK_WINDOW_XWINDOW(win : PGdkDrawable) : TXID;
function GDK_PIXMAP_XDISPLAY(win : PGdkDrawable) : PDisplay;
function GDK_PIXMAP_XID(win : PGdkDrawable) : TXID;
function GDK_DRAWABLE_XDISPLAY(win : PGdkDrawable) : PDisplay;
function GDK_DRAWABLE_XID(win : PGdkDrawable) : TXID;
function GDK_GC_XDISPLAY(gc : PGdkGC) : PDisplay;
function GDK_GC_XGC(gc : PGdkGC) : TGC;
function GDK_SCREEN_XDISPLAY(screen : PGdkScreen) : PDisplay;
function GDK_SCREEN_XSCREEN(screen : PGdkScreen) : PScreen;
function GDK_SCREEN_XNUMBER(screen : PGdkScreen) : longint;
function GDK_VISUAL_XVISUAL(visual : PGdkVisual) : PVisual;
function gdkx_visual_get_for_screen(screen:PGdkScreen; xvisualid:TVisualID):PGdkVisual;cdecl;external;
{$ifndef GDK_MULTIHEAD_SAFE}
function gdkx_visual_get(xvisualid:TVisualID):PGdkVisual;cdecl;external;
{$endif}
{ XXX: Do not use this function until it is fixed. An X Colormap
is useless unless we also have the visual. }
function gdkx_colormap_get(xcolormap:TColormap):PGdkColormap;cdecl;external;
{ Return the Gdk for a particular XID }
function gdk_xid_table_lookup_for_display(display:PGdkDisplay; xid:TXID):gpointer;cdecl;external;
function gdk_x11_get_server_time(window:PGdkWindow):guint32;cdecl;external;
{ returns TRUE if we support the given WM spec feature }
function gdk_x11_screen_supports_net_wm_hint(screen:PGdkScreen; _property:TGdkAtom):gboolean;cdecl;external;
{$ifndef GDK_MULTIHEAD_SAFE}
function gdk_xid_table_lookup(xid:TXID):gpointer;cdecl;external;
function gdk_net_wm_supports(_property:TGdkAtom):gboolean;cdecl;external;
procedure gdk_x11_grab_server;cdecl;external;
procedure gdk_x11_ungrab_server;cdecl;external;
{$endif}
function gdk_x11_lookup_xdisplay(xdisplay:PDisplay):PGdkDisplay;cdecl;external;
{ Functions to get the X Atom equivalent to the GdkAtom }
function gdk_x11_atom_to_xatom_for_display(display:PGdkDisplay; atom:TGdkAtom):TAtom;cdecl;external;
function gdk_x11_xatom_to_atom_for_display(display:PGdkDisplay; xatom:TAtom):TGdkAtom;cdecl;external;
(* Const before type ignored *)
function gdk_x11_get_xatom_by_name_for_display(display:PGdkDisplay; atom_name:Pgchar):TAtom;cdecl;external;
(* Const before type ignored *)
function gdk_x11_get_xatom_name_for_display(display:PGdkDisplay; xatom:TAtom):Pgchar;cdecl;external;
{$ifndef GDK_MULTIHEAD_SAFE}
function gdk_x11_atom_to_xatom(atom:TGdkAtom):TAtom;cdecl;external;
function gdk_x11_xatom_to_atom(xatom:TAtom):TGdkAtom;cdecl;external;
(* Const before type ignored *)
function gdk_x11_get_xatom_by_name(atom_name:Pgchar):TAtom;cdecl;external;
(* Const before type ignored *)
function gdk_x11_get_xatom_name(xatom:TAtom):Pgchar;cdecl;external;
{$endif}
{$ifdef GDK_ENABLE_DEPRECATED}
function gdk_x11_font_get_xdisplay(font:PGdkFont):PDisplay;cdecl;external;
function gdk_x11_font_get_xfont(font:PGdkFont):gpointer;cdecl;external;
(* Const before type ignored *)
function gdk_x11_font_get_name(font:PGdkFont):Pchar;cdecl;external;
function GDK_FONT_XDISPLAY(font : PGdkFont): PDisplay;
function GDK_FONT_XFONT(font : PGdkFont): gpointer;
{$ifndef GDK_MULTIHEAD_SAFE}
function gdk_font_lookup(xid : TXID) : PGdkFont;
{$endif}
function gdk_font_lookup_for_display(display:PGdkDisplay; xid:TXID) : PGdkFont;
procedure gdk_x11_display_grab(display:PGdkDisplay);cdecl;external;
procedure gdk_x11_display_ungrab(display:PGdkDisplay);cdecl;external;
{$endif GDK_ENABLE_DEPRECATED}
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
function GDK_COLORMAP_XDISPLAY(cmap : PGdkColormap) : PDisplay;
begin
GDK_COLORMAP_XDISPLAY:=gdk_x11_colormap_get_xdisplay(cmap);
end;
function GDK_COLORMAP_XCOLORMAP(cmap : PGdkColormap) : TColormap;
begin
GDK_COLORMAP_XCOLORMAP:=gdk_x11_colormap_get_xcolormap(cmap);
end;
function GDK_CURSOR_XDISPLAY(cursor : PGdkCursor) : PDisplay;
begin
GDK_CURSOR_XDISPLAY:=gdk_x11_cursor_get_xdisplay(cursor);
end;
function GDK_CURSOR_XCURSOR(cursor : PGdkCursor) : TCursor;
begin
GDK_CURSOR_XCURSOR:=gdk_x11_cursor_get_xcursor(cursor);
end;
function GDK_IMAGE_XDISPLAY(image : PGdkImage) : PDisplay;
begin
GDK_IMAGE_XDISPLAY:=gdk_x11_image_get_xdisplay(image);
end;
function GDK_IMAGE_XIMAGE(image : PGdkImage) : PXImage;
begin
GDK_IMAGE_XIMAGE:=gdk_x11_image_get_ximage(image);
end;
function GDK_DRAWABLE_XDISPLAY(win : PGdkDrawable) : PDisplay;
var
if_local1 : PDisplay;
begin
if GDK_IS_WINDOW(win) then
if_local1:=GDK_WINDOW_XDISPLAY(win)
else
if_local1:=GDK_PIXMAP_XDISPLAY(win);
GDK_DRAWABLE_XDISPLAY:=if_local1;
end;
function GDK_DRAWABLE_XID(win : PGdkDrawable) : TWindow;
var
if_local1 : TWindow;
begin
if GDK_IS_WINDOW(win) then
if_local1:=GDK_WINDOW_XID(win)
else
if_local1:=GDK_PIXMAP_XID(win);
GDK_DRAWABLE_XID:=if_local1;
end;
function GDK_GC_XDISPLAY(gc : PGdkGC) : PDisplay;
begin
GDK_GC_XDISPLAY:=GDK_SCREEN_XDISPLAY((GDK_GC_X11(gc))^.screen);
end;
function GDK_GC_XGC(gc : PGdkGC) : TGC;
begin
GDK_GC_XGC:=(GDK_GC_X11(gc))^.xgc;
end;
function GDK_SCREEN_XSCREEN(screen : PGdkScreen) : PScreen;
begin
GDK_SCREEN_XSCREEN:=(GDK_SCREEN_X11(screen))^.xscreen;
end;
function GDK_SCREEN_XNUMBER(screen : PGdkScreen) : longint;
begin
GDK_SCREEN_XNUMBER:=(GDK_SCREEN_X11(screen))^.screen_num;
end;
function GDK_VISUAL_XVISUAL(visual : PGdkVisual) : PVisual;
begin
GDK_VISUAL_XVISUAL:=(PGdkVisualPrivate(visual))^.xvisual;
end;
function GDK_GC_GET_XGC(gc : PGdkGC) : TGC;
var
if_local1 : TGC;
begin
if_local1:=(PGdkGCX11(gc))^.xgc;
if (GDK_GC_X11(gc))^.dirty_mask=gTRUE then begin
//if_local1:=_gdk_x11_gc_flush(gc)
end;
GDK_GC_GET_XGC:=if_local1;
end;
function GDK_ROOT_WINDOW : TWindow;
begin
GDK_ROOT_WINDOW:=gdk_x11_get_default_root_xwindow;
end;
function GDK_DISPLAY_XDISPLAY(display : PGdkDisplay) : PDisplay;
begin
GDK_DISPLAY_XDISPLAY:=gdk_x11_display_get_xdisplay(display);
end;
function GDK_WINDOW_XDISPLAY(win : PGdkDrawable) : PDisplay;
begin
GDK_WINDOW_XDISPLAY:=gdk_x11_drawable_get_xdisplay((PGdkWindowObject(win))^.impl);
end;
function GDK_WINDOW_XID(win : PGdkDrawable) : TXID;
begin
GDK_WINDOW_XID:=gdk_x11_drawable_get_xid(win);
end;
function GDK_WINDOW_XWINDOW(win : PGdkDrawable) : TXID;
begin
GDK_WINDOW_XWINDOW:=gdk_x11_drawable_get_xid(win);
end;
function GDK_PIXMAP_XDISPLAY(win : PGdkDrawable) : PDisplay;
begin
GDK_PIXMAP_XDISPLAY:=gdk_x11_drawable_get_xdisplay((PGdkPixmapObject(win))^.impl);
end;
function GDK_PIXMAP_XID(win : PGdkDrawable) : TXID;
begin
GDK_PIXMAP_XID:=gdk_x11_drawable_get_xid(win);
end;
function GDK_SCREEN_XDISPLAY(screen : PGdkScreen) : PDisplay;
begin
GDK_SCREEN_XDISPLAY:=gdk_x11_display_get_xdisplay(gdk_screen_get_display(screen));
end;
{$ifdef GDK_ENABLE_DEPRECATED}
function GDK_FONT_XDISPLAY(font : PGdkFont): PDisplay;
begin
GDK_FONT_XDISPLAY:=gdk_x11_font_get_xdisplay(font);
end;
function gdk_font_lookup(xid : TXID) : PGdkFont;
begin
gdk_font_lookup:=PGdkFont(gdk_xid_table_lookup(xid));
end;
function GDK_FONT_XFONT(font : PGdkFont): gpointer;
begin
GDK_FONT_XFONT:=gdk_x11_font_get_xfont(font);
end;
function gdk_font_lookup_for_display(display:PGdkDisplay; xid:TXID) : PGdkFont;
begin
gdk_font_lookup_for_display:=PGdkFont(gdk_xid_table_lookup_for_display(display,xid));
end;
{$ENDIF GDK_ENABLE_DEPRECATED}
{$ENDIF read_implementation}

52
components/opengl/gtk2x11/include/gxid_proto.inc Normal file
View File

@ -0,0 +1,52 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
const
GXID_CLAIM_DEVICE = 1;
GXID_RELEASE_DEVICE = 2;
GXID_RETURN_OK = 0;
GXID_RETURN_ERROR = -(1);
type
PGxidMessage = ^TGxidMessage;
PGxidU32 = ^TGxidU32;
TGxidU32 = dword;
PGxidI32 = ^TGxidI32;
TGxidI32 = longint;
TGxidClaimDevice = record
_type : TGxidU32;
length : TGxidU32;
device : TGxidU32;
window : TGxidU32;
exclusive : TGxidU32;
end;
TGxidReleaseDevice = record
_type : TGxidU32;
length : TGxidU32;
device : TGxidU32;
window : TGxidU32;
end;
TGxidMessageAny = record
_type : TGxidU32;
length : TGxidU32;
end;
TGxidMessage = record
case longint of
0 : ( any : TGxidMessageAny );
1 : ( claim : TGxidClaimDevice );
2 : ( release : TGxidReleaseDevice );
end;
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{$ENDIF read_implementation}

109
components/opengl/gtk2x11/include/mwmutil.inc Normal file
View File

@ -0,0 +1,109 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
type
PMotifWmHints = ^TMotifWmHints;
TMotifWmHints = record
flags : dword;
functions : dword;
decorations : dword;
input_mode : longint;
status : dword;
end;
TMwmHints = TMotifWmHints;
PMwmHints = ^TMwmHints;
const
MWM_HINTS_FUNCTIONS = 1 shl 0;
MWM_HINTS_DECORATIONS = 1 shl 1;
MWM_HINTS_INPUT_MODE = 1 shl 2;
MWM_HINTS_STATUS = 1 shl 3;
MWM_FUNC_ALL = 1 shl 0;
MWM_FUNC_RESIZE = 1 shl 1;
MWM_FUNC_MOVE = 1 shl 2;
MWM_FUNC_MINIMIZE = 1 shl 3;
MWM_FUNC_MAXIMIZE = 1 shl 4;
MWM_FUNC_CLOSE = 1 shl 5;
MWM_DECOR_ALL = 1 shl 0;
MWM_DECOR_BORDER = 1 shl 1;
MWM_DECOR_RESIZEH = 1 shl 2;
MWM_DECOR_TITLE = 1 shl 3;
MWM_DECOR_MENU = 1 shl 4;
MWM_DECOR_MINIMIZE = 1 shl 5;
MWM_DECOR_MAXIMIZE = 1 shl 6;
MWM_INPUT_MODELESS = 0;
MWM_INPUT_PRIMARY_APPLICATION_MODAL = 1;
MWM_INPUT_SYSTEM_MODAL = 2;
MWM_INPUT_FULL_APPLICATION_MODAL = 3;
MWM_INPUT_APPLICATION_MODAL = MWM_INPUT_PRIMARY_APPLICATION_MODAL;
MWM_TEAROFF_WINDOW = 1 shl 0;
{ atoms}
_XA_MOTIF_BINDINGS = '_MOTIF_BINDINGS';
_XA_MOTIF_WM_HINTS = '_MOTIF_WM_HINTS';
_XA_MOTIF_WM_MESSAGES = '_MOTIF_WM_MESSAGES';
_XA_MOTIF_WM_OFFSET = '_MOTIF_WM_OFFSET';
_XA_MOTIF_WM_MENU = '_MOTIF_WM_MENU';
_XA_MOTIF_WM_INFO = '_MOTIF_WM_INFO';
_XA_MWM_HINTS = _XA_MOTIF_WM_HINTS;
_XA_MWM_MESSAGES = _XA_MOTIF_WM_MESSAGES;
_XA_MWM_MENU = _XA_MOTIF_WM_MENU;
_XA_MWM_INFO = _XA_MOTIF_WM_INFO;
{ _MWM_INFO property }
type
PMotifWmInfo = ^TMotifWmInfo;
TMotifWmInfo = record
flags : longint;
wm_window : TWindow;
end;
PMwmInfo = ^TMwmInfo;
TMwmInfo = TMotifWmInfo;
const
MWM_INFO_STARTUP_STANDARD = 1 shl 0;
MWM_INFO_STARTUP_CUSTOM = 1 shl 1;
{ _MWM_HINTS property }
type
PPropMotifWmHints = ^TPropMotifWmHints;
TPropMotifWmHints = record
flags : dword;
functions : dword;
decorations : dword;
inputMode : longint;
status : dword;
end;
PPropMwmHints = ^TPropMwmHints;
TPropMwmHints = TPropMotifWmHints;
const
PROP_MOTIF_WM_HINTS_ELEMENTS = 5;
PROP_MWM_HINTS_ELEMENTS = PROP_MOTIF_WM_HINTS_ELEMENTS;
{ _MWM_INFO property, slight return }
type
PPropMotifWmInfo = ^TPropMotifWmInfo;
TPropMotifWmInfo = record
flags : dword;
wmWindow : dword;
end;
PPropMwmInfo = ^TPropMwmInfo;
TPropMwmInfo = TPropMotifWmInfo;
const
PROP_MOTIF_WM_INFO_ELEMENTS = 2;
PROP_MWM_INFO_ELEMENTS = PROP_MOTIF_WM_INFO_ELEMENTS;
{$ENDIF read_interface_rest}
//------------------------------------------------------------------------------
{$IFDEF read_implementation}
{$ENDIF read_implementation}

27
components/opengl/gtk2x11/include/xsettings-client.inc Normal file
View File

@ -0,0 +1,27 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
type
PXSettingsAction = ^TXSettingsAction;
TXSettingsAction = Longint;
Const
XSETTINGS_ACTION_NEW = 0;
XSETTINGS_ACTION_CHANGED = 1;
XSETTINGS_ACTION_DELETED = 2;
type
// this PXSettingsClient needs to be removed when there are xcl.h bindings for fpc
PXSettingsClient = pointer;
type
TXSettingsNotifyFunc = procedure (name:Pchar; action:TXSettingsAction; setting:PXSettingsSetting; cb_data:pointer);cdecl;
TXSettingsWatchFunc = procedure (window:TWindow; is_start:TBool; mask:longint; cb_data:pointer);cdecl;
function xsettings_client_new(display:PDisplay; screen:longint; notify:TXSettingsNotifyFunc; watch:TXSettingsWatchFunc; cb_data:pointer):PXSettingsClient;cdecl;external;
procedure xsettings_client_destroy(client:PXSettingsClient);cdecl;external;
function xsettings_client_process_event(client:PXSettingsClient; xev:PXEvent):TBool;cdecl;external;
function xsettings_client_get_setting(client:PXSettingsClient; name:Pchar; setting:PPXSettingsSetting):TXSettingsResult;cdecl;external;
{$ENDIF read_interface_rest}

111
components/opengl/gtk2x11/include/xsettings-common.inc Normal file
View File

@ -0,0 +1,111 @@
{%MainUnit ../gdk2x.pas}
{$IFDEF read_interface_rest}
{ Renames for GDK inclusion }
{const
xsettings_byte_order = _gdk_xsettings_byte_order;
xsettings_client_destroy = _gdk_xsettings_client_destroy;
xsettings_client_get_setting = _gdk_xsettings_client_get_setting;
xsettings_client_new = _gdk_xsettings_client_new;
xsettings_client_process_event = _gdk_xsettings_client_process_event;
xsettings_list_copy = _gdk_xsettings_list_copy;
xsettings_list_delete = _gdk_xsettings_list_delete;
xsettings_list_free = _gdk_xsettings_list_free;
xsettings_list_insert = _gdk_xsettings_list_insert;
xsettings_list_lookup = _gdk_xsettings_list_lookup;
xsettings_setting_copy = _gdk_xsettings_setting_copy;
xsettings_setting_equal = _gdk_xsettings_setting_equal;
xsettings_setting_free = _gdk_xsettings_setting_free;}
type
{ Types of settings possible. Enum values correspond to protocol values. }
PXSettingsType = ^TXSettingsType;
TXSettingsType = Longint;
Const
XSETTINGS_TYPE_INT = 0;
XSETTINGS_TYPE_STRING = 1;
XSETTINGS_TYPE_COLOR = 2;
type
PXSettingsResult = ^TXSettingsResult;
TXSettingsResult = Longint;
Const
XSETTINGS_SUCCESS = 0;
XSETTINGS_NO_MEM = 1;
XSETTINGS_ACCESS = 2;
XSETTINGS_FAILED = 3;
XSETTINGS_NO_ENTRY = 4;
XSETTINGS_DUPLICATE_ENTRY = 5;
type
PXSettingsBuffer = ^TXSettingsBuffer;
TXSettingsBuffer = record
byte_order : char;
len : size_t;
data : Pbyte;
pos : Pbyte;
end;
PXSettingsColor = ^TXSettingsColor;
TXSettingsColor = record
red : word;
green : word;
blue : word;
alpha : word;
end;
PXSettingsSetting = ^TXSettingsSetting;
TXSettingsSetting = record
name : Pchar;
_type : TXSettingsType;
data : record
case longint of
0 : ( v_int : longint );
1 : ( v_string : Pchar );
2 : ( v_color : TXSettingsColor );
end;
last_change_serial : dword;
end;
PPXSettingsSetting = ^PXSettingsSetting;
PXSettingsList = ^TXSettingsList;
TXSettingsList = record
setting : PXSettingsSetting;
next : PXSettingsList;
end;
PPXSettingsList = ^PXSettingsList;
function xsettings_setting_copy(setting:PXSettingsSetting):PXSettingsSetting;cdecl;external;
procedure xsettings_setting_free(setting:PXSettingsSetting);cdecl;external;
function xsettings_setting_equal(setting_a:PXSettingsSetting; setting_b:PXSettingsSetting):longint;cdecl;external;
procedure xsettings_list_free(list:PXSettingsList);cdecl;external;
function xsettings_list_copy(list:PXSettingsList):PXSettingsList;cdecl;external;
function xsettings_list_insert(list:PPXSettingsList; setting:PXSettingsSetting):TXSettingsResult;cdecl;external;
(* Const before type ignored *)
function xsettings_list_lookup(list:PXSettingsList; name:Pchar):PXSettingsSetting;cdecl;external;
(* Const before type ignored *)
function xsettings_list_delete(list:PPXSettingsList; name:Pchar):TXSettingsResult;cdecl;external;
function xsettings_byte_order:char;cdecl;external;
function XSETTINGS_PAD(n,m : longint) : longint;
{$ENDIF read_interface_rest}
{$IFDEF read_implementation}
function XSETTINGS_PAD(n,m : longint) : longint;
begin
XSETTINGS_PAD:=((n + m) - 1) and ( not (m - 1));
end;
{$ENDIF read_implementation}

48
components/opengl/gtk2x11/scripts/gdkx11_h2pas.sh Executable file
View File

@ -0,0 +1,48 @@
#!/usr/bin/env bash
#set -x
set -e
# make sure, we are in the right directory
cd ../scripts
CHeaderDir=../c_src/x11
PascalIncDir=../include
HTmpFile=temp.h
PasTmpFile=temp.inc
HFiles=$(ls $CHeaderDir/*.h)
for HFile in $HFiles; do
echo $HFile
ShortHFile=$(echo $HFile | sed -e 's#.*/##')
ShortPascalFile=$(echo $ShortHFile | sed -e 's#\.h$#.inc#')
echo $ShortPascalFile
PascalFile=$PascalIncDir/$ShortPascalFile
cat $HFile | sed \
-e 's#G_BEGIN_DECLS##g' \
-e 's#G_END_DECLS##g' \
-e 's#G_CONST_RETURN#const#g' \
> $HTmpFile
h2pas -d -e -i -p -t -o $PasTmpFile $HTmpFile
cat $PasTmpFile | sed \
-e 's#\bT\(gint\)\b#\1#g' \
-e 's#\bT\(guint\)\b#\1#g' \
-e 's#\bT\(gboolean\)\b#\1#g' \
-e 's#\bT\(glong\)\b#\1#g' \
-e 's#\bT\(gulong\)\b#\1#g' \
-e 's#\bT\(gchar\)\b#\1#g' \
-e 's#\bT\(guchar\)\b#\1#g' \
-e 's#\bT\(gshort\)\b#\1#g' \
-e 's#\bT\(gushort\)\b#\1#g' \
-e 's#\bT\(gfloat\)\b#\1#g' \
-e 's#\bT\(gdouble\)\b#\1#g' \
-e 's#\bT\(gpointer\)\b#\1#g' \
-e 's#\bT\(gconstpointer\)\b#\1#g' \
-e 's#\bT\(guint32\)\b#\1#g' \
> $PascalFile
done
# end.

53
components/opengl/lazopenglcontext.lpk Normal file
View File

@ -0,0 +1,53 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="LazOpenGLContext"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="3">
<Item1>
<Filename Value="openglcontext.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="OpenGLContext"/>
</Item1>
<Item2>
<Filename Value="glgtkglxcontext.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="GLGtkGlxContext"/>
</Item2>
<Item3>
<Filename Value="glcarbonaglcontext.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="GLCarbonAGLContext"/>
</Item3>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)/lazopengl/"/>
<CommandAfter Value="/bin/tar czf $(TestDir)/lazopengl.tgz -C $(TestDir) lazopengl"/>
</PublishOptions>
</Package>
</CONFIG>

21
components/opengl/lazopenglcontext.pas Normal file
View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit LazOpenGLContext;
interface
uses
OpenGLContext, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('OpenGLContext', @OpenGLContext.Register);
end;
initialization
RegisterPackage('LazOpenGLContext', @Register);
end.

390
components/opengl/openglcontext.pas Normal file
View File

@ -0,0 +1,390 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
Abstract:
TOpenGLControl is a LCL control with an opengl context.
It works under the following platforms:
- gtk with glx : fully
- gtk2 with glx : todo
- carbon with agl : todo
- windows with ? : todo
}
unit OpenGLContext;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, Forms, Controls, LCLType, LCLIntf,
Graphics, LMessages, WSLCLClasses, WSControls;
type
TOpenGlCtrlMakeCurrentEvent = procedure(Sender: TObject;
var Allow: boolean) of object;
{ TCustomOpenGLControl }
{ Sharing:
You can share opengl contexts. For example:
Assume OpenGLControl2 and OpenGLControl3 should share the same as
OpenGLControl1. Then set
OpenGLControl2.SharedControl:=OpenGLControl1;
OpenGLControl3.SharedControl:=OpenGLControl1;
After OpenGLControl1.SharingControlCount will be two and
OpenGLControl1.SharingControls will contain OpenGLControl2 and
OpenGLControl3.
}
TCustomOpenGLControl = class(TWinControl)
private
FAutoResizeViewport: boolean;
FCanvas: TCanvas; // only valid at designtime
FFrameDiffTime: integer;
FOnMakeCurrent: TOpenGlCtrlMakeCurrentEvent;
FOnPaint: TNotifyEvent;
FCurrentFrameTime: integer; // in msec
FLastFrameTime: integer; // in msec
FOpenGLInitAttrList: PLongInt;
FSharedOpenGLControl: TCustomOpenGLControl;
FSharingOpenGlControls: TList;
function GetSharingControls(Index: integer): TCustomOpenGLControl;
procedure SetAutoResizeViewport(const AValue: boolean);
procedure SetSharedControl(const AValue: TCustomOpenGLControl);
protected
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
procedure UpdateFrameTimeDiff;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
Procedure Paint; virtual;
procedure RealizeBounds; override;
procedure DoOnPaint; virtual;
procedure SwapBuffers; virtual;
function MakeCurrent(SaveOldToStack: boolean = false): boolean; virtual;
function RestoreOldOpenGLControl: boolean;
function SharingControlCount: integer;
property SharingControls[Index: integer]: TCustomOpenGLControl read GetSharingControls;
public
property FrameDiffTimeInMSecs: integer read FFrameDiffTime;
property OnMakeCurrent: TOpenGlCtrlMakeCurrentEvent read FOnMakeCurrent
write FOnMakeCurrent;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property SharedControl: TCustomOpenGLControl read FSharedOpenGLControl
write SetSharedControl;
property OpenGLInitAttrList: PLongInt read FOpenGLInitAttrList
write FOpenGLInitAttrList;
property AutoResizeViewport: boolean read FAutoResizeViewport
write SetAutoResizeViewport;
end;
{ TOpenGLControl }
TOpenGLControl = class(TCustomOpenGLControl)
published
property Align;
property Anchors;
property BorderSpacing;
property Enabled;
property OnClick;
property OnConstrainedResize;
property OnDblClick;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnPaint;
property OnResize;
property OnShowHint;
property PopupMenu;
property ShowHint;
property Visible;
end;
{ TWSOpenGLControl }
TWSOpenGLControl = class(TWSWinControl)
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
end;
procedure Register;
implementation
{$IFDEF LCLGTK}
{$DEFINE UseGtkGLX}
{$DEFINE OpenGLTargetDefined}
{$ENDIF}
{$IFDEF LCLGnome}
{$DEFINE UseGtkGLX}
{$DEFINE OpenGLTargetDefined}
{$ENDIF}
{$IFDEF LCLGTK2}
{$DEFINE UseGtkGLX}
{$DEFINE OpenGLTargetDefined}
{$ENDIF}
{$IFDEF LCLCarbon}
{$DEFINE UseCarbonAGL}
{$DEFINE OpenGLTargetDefined}
{$ENDIF}
{$IFNDEF OpenGLTargetDefined}
{$ERROR this target is not yet supported}
{$ENDIF}
uses
{$IFDEF UseGtkGLX}
GLGtkGlxContext;
{$ENDIF}
{$IFDEF UseCarbonAGL}
GLCarbonAGLContext;
{$ENDIF}
var
OpenGLControlStack: TList = nil;
procedure Register;
begin
RegisterComponents('OpenGL',[TOpenGLControl]);
end;
{ TCustomOpenGLControl }
function TCustomOpenGLControl.GetSharingControls(Index: integer
): TCustomOpenGLControl;
begin
Result:=TCustomOpenGLControl(FSharingOpenGlControls[Index]);
end;
procedure TCustomOpenGLControl.SetAutoResizeViewport(const AValue: boolean);
begin
if FAutoResizeViewport=AValue then exit;
FAutoResizeViewport:=AValue;
if AutoResizeViewport
and ([csLoading,csDestroying]*ComponentState=[])
and IsVisible and HandleAllocated
and MakeCurrent then
LOpenGLViewport(0,0,Width,Height);
end;
procedure TCustomOpenGLControl.SetSharedControl(
const AValue: TCustomOpenGLControl);
begin
if FSharedOpenGLControl=AValue then exit;
if AValue=Self then
Raise Exception.Create('A control can not be shared by itself.');
// unshare old
if (AValue<>nil) and (AValue.SharedControl<>nil) then
Raise Exception.Create('Target control is sharing too. A sharing control can not be shared.');
if FSharedOpenGLControl<>nil then
FSharedOpenGLControl.FSharingOpenGlControls.Remove(Self);
// share new
if (AValue<>nil) and (csDestroying in AValue.ComponentState) then
FSharedOpenGLControl:=nil
else begin
FSharedOpenGLControl:=AValue;
if (FSharedOpenGLControl<>nil) then begin
if FSharedOpenGLControl.FSharingOpenGlControls=nil then
FSharedOpenGLControl.FSharingOpenGlControls:=TList.Create;
FSharedOpenGLControl.FSharingOpenGlControls.Add(Self);
end;
end;
// recreate handle if needed
if HandleAllocated and (not (csDesigning in ComponentState)) then
ReCreateWnd(Self);
end;
procedure TCustomOpenGLControl.WMPaint(var Message: TLMPaint);
begin
Include(FControlState, csCustomPaint);
inherited WMPaint(Message);
//debugln('TCustomGTKGLAreaControl.WMPaint A ',dbgsName(Self),' ',dbgsName(FCanvas));
if (csDesigning in ComponentState) and (FCanvas<>nil) then begin
with FCanvas do begin
Brush.Color:=clLtGray;
Pen.Color:=clRed;
Rectangle(0,0,Self.Width-1,Self.Height-1);
MoveTo(0,0);
LineTo(Self.Width,Self.Height);
MoveTo(0,Self.Height);
LineTo(Self.Width,0);
end;
end else begin
Paint;
end;
Exclude(FControlState, csCustomPaint);
end;
procedure TCustomOpenGLControl.UpdateFrameTimeDiff;
begin
FCurrentFrameTime:=integer(GetTickCount);
if FLastFrameTime=0 then
FLastFrameTime:=FCurrentFrameTime;
// calculate time since last call:
FFrameDiffTime:=FCurrentFrameTime-FLastFrameTime;
// if the counter is reset restart:
if (FFrameDiffTime<0) then FFrameDiffTime:=1;
FLastFrameTime:=FCurrentFrameTime;
end;
constructor TCustomOpenGLControl.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FOpenGLInitAttrList:=@DefaultOpenGLContextInitAttrList[0];
ControlStyle:=ControlStyle-[csSetCaption];
if (csDesigning in ComponentState) then begin
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end else
FCompStyle:=csNonLCL;
SetInitialBounds(0, 0, 160, 90);
end;
destructor TCustomOpenGLControl.Destroy;
begin
if FSharingOpenGlControls<>nil then begin
while SharingControlCount>0 do
SharingControls[SharingControlCount-1].SharedControl:=nil;
FreeAndNil(FSharingOpenGlControls);
end;
SharedControl:=nil;
if OpenGLControlStack<>nil then begin
OpenGLControlStack.Remove(Self);
if OpenGLControlStack.Count=0 then
FreeAndNil(OpenGLControlStack);
end;
FCanvas.Free;
FCanvas:=nil;
inherited Destroy;
end;
procedure TCustomOpenGLControl.Paint;
begin
if IsVisible and HandleAllocated and MakeCurrent then begin
UpdateFrameTimeDiff;
if AutoResizeViewport then
LOpenGLViewport(0,0,Width,Height);
DoOnPaint;
end;
end;
procedure TCustomOpenGLControl.RealizeBounds;
begin
if IsVisible and HandleAllocated and MakeCurrent then begin
if AutoResizeViewport then
LOpenGLViewport(0,0,Width,Height);
end;
inherited RealizeBounds;
end;
procedure TCustomOpenGLControl.DoOnPaint;
begin
if Assigned(OnPaint) then OnPaint(Self);
end;
procedure TCustomOpenGLControl.SwapBuffers;
begin
LOpenGLSwapBuffers(Handle);
end;
function TCustomOpenGLControl.MakeCurrent(SaveOldToStack: boolean): boolean;
var
Allowed: Boolean;
begin
if Assigned(FOnMakeCurrent) then begin
Allowed:=true;
OnMakeCurrent(Self,Allowed);
if not Allowed then begin
Result:=False;
exit;
end;
end;
// make current
Result:=LOpenGLMakeCurrent(Handle);
if Result and SaveOldToStack then begin
// on success push on stack
if OpenGLControlStack=nil then
OpenGLControlStack:=TList.Create;
OpenGLControlStack.Add(Self);
end;
end;
function TCustomOpenGLControl.RestoreOldOpenGLControl: boolean;
var
RestoredControl: TCustomOpenGLControl;
begin
Result:=false;
// check if the current context is on stack
if (OpenGLControlStack=nil) or (OpenGLControlStack.Count=0) then exit;
// pop
OpenGLControlStack.Delete(OpenGLControlStack.Count-1);
// make old control the current control
if OpenGLControlStack.Count>0 then begin
RestoredControl:=
TCustomOpenGLControl(OpenGLControlStack[OpenGLControlStack.Count-1]);
if (not LOpenGLMakeCurrent(RestoredControl.Handle)) then
exit;
end else begin
FreeAndNil(OpenGLControlStack);
end;
Result:=true;
end;
function TCustomOpenGLControl.SharingControlCount: integer;
begin
if FSharingOpenGlControls=nil then
Result:=0
else
Result:=FSharingOpenGlControls.Count;
end;
{ TWSOpenGLControl }
function TWSOpenGLControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
OpenGlControl: TCustomOpenGLControl;
AttrList: PLongint;
begin
if csDesigning in AWinControl.ComponentState then
Result:=inherited CreateHandle(AWinControl,AParams)
else begin
OpenGlControl:=AWinControl as TCustomOpenGLControl;
if OpenGlControl.SharedControl<>nil then
AttrList:=OpenGlControl.SharedControl.OpenGLInitAttrList
else
AttrList:=OpenGlControl.OpenGLInitAttrList;
Result:=LOpenGLCreateContext(OpenGlControl,OpenGlControl.SharedControl,
AttrList);
end;
end;
initialization
RegisterWSComponent(TCustomOpenGLControl,TWSOpenGLControl);
end.