added fpc replacement for gtkglarea

git-svn-id: trunk@6729 -

.gitattributes

@@ -80,6 +80,7 @@ components/gtk/gtkglarea/gtkopengl.lpk svneol=native#text/pascal
 components/gtk/gtkglarea/gtkopengl.pas svneol=native#text/pascal
 components/gtk/gtkglarea/nvgl.pp svneol=native#text/pascal
 components/gtk/gtkglarea/nvglx.pp svneol=native#text/pascal
+components/gtk/gtkglarea/openglgtkwidget.pas svneol=native#text/pascal
 components/gtk/gtkglarea/tgtkglareacontrol.xpm -text svneol=native#image/x-xpixmap
 components/htmllite/html32.res svneol=native#unset
 components/htmllite/htmllite.dcr -text svneol=native#application/x-director

components/gtk/gtkglarea/gtkglarea_int.pp

@@ -10,6 +10,11 @@
  *                                                                           *
  *****************************************************************************
 
+  Author: Mattias Gaertner
+  
+  Abstract:
+    FPC bindings to the gtkglarea library.
+    The library is not big and was translated completely to FPC ().
 }
 unit GTKGLArea_Int;
 
@@ -79,6 +84,7 @@ type
   TGdkGLPixmap = record end;
   PGdkGLPixmap = ^TGdkGLPixmap;
 
+  TGtkGlAreaMakeCurrentType = integer;
 
 function gdk_gl_pixmap_new(visual:PGdkVisual; pixmap:PGdkPixmap):PGdkGLPixmap;cdecl;external;
 function gdk_gl_pixmap_ref(glpixmap:PGdkGLPixmap):PGdkGLPixmap;cdecl;external;

components/gtk/gtkglarea/gtkglareacontrol.pas

@@ -22,7 +22,13 @@ interface
 uses
   Classes, SysUtils, LCLType, LCLIntf, {$IFDEF VER1_0}Linux{$ELSE}Unix{$ENDIF},
   Forms, Controls, Graphics, LMessages, InterfaceBase, WSLCLClasses, WSControls,
-  LResources, GTKInt, GLib, Gtk, NVGL, GTKGLArea_Int;
+  LResources, GTKInt, GLib, Gtk, NVGL,
+  {$IFDEF UseGtkGlAreaLib}
+  GTKGLArea_Int
+  {$ELSE}
+  OpenGLGtkWidget
+  {$ENDIF}
+  ;
   
 type
   TGtkGlAreaMakeCurrentEvent = procedure(Sender: TObject;
@@ -50,10 +56,10 @@ type
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     Procedure Paint; virtual;
-    procedure DoOnResize; override;
+    procedure RealizeBounds; override;
     procedure DoOnPaint; virtual;
     procedure SwapBuffers; virtual;
-    function MakeCurrent: integer; virtual;
+    function MakeCurrent: boolean; virtual;
     function RestoreOldGtkGLAreaControl: boolean;
     function SharingAreasCount: integer;
     property SharingAreas[Index: integer]: TCustomGTKGLAreaControl read GetSharingAreas;
@@ -175,7 +181,7 @@ procedure TCustomGTKGLAreaControl.Paint;
 begin
   if (not (csDesigning in ComponentState))
   and Enabled and Visible and HandleAllocated
-  and (gint(True) = MakeCurrent) then begin
+  and MakeCurrent then begin
     try
       UpdateFrameTimeDiff;
       DoOnPaint;
@@ -185,19 +191,19 @@ begin
   end;
 end;
 
-procedure TCustomGTKGLAreaControl.DoOnResize;
+procedure TCustomGTKGLAreaControl.RealizeBounds;
 var
   RestoreNeeded: Boolean;
 begin
   RestoreNeeded:=false;
   if (not (csDesigning in ComponentState))
   and Enabled and Visible and HandleAllocated
-  and (gint(True) = MakeCurrent) then begin
+  and MakeCurrent then begin
     RestoreNeeded:=true;
     glViewport (0, 0, Width, Height);
   end;
   try
-    inherited DoOnResize;
+    inherited RealizeBounds;
   finally
     if RestoreNeeded then
       RestoreOldGtkGLAreaControl;
@@ -214,7 +220,7 @@ begin
   gtk_gl_area_swap_buffers(Widget);
 end;
 
-function TCustomGTKGLAreaControl.MakeCurrent: integer;
+function TCustomGTKGLAreaControl.MakeCurrent: boolean;
 var
   Allowed: Boolean;
 begin
@@ -222,15 +228,16 @@ begin
     Allowed:=true;
     OnMakeCurrent(Self,Allowed);
     if not Allowed then begin
-      Result:=gint(False);
+      Result:=False;
       exit;
     end;
   end;
   // make sure the widget is realized
   gtk_widget_realize(PGtkWidget(Widget));
   // make current
-  Result:=gtk_gl_area_make_current(Widget);
+  Result:=gtk_gl_area_make_current(Widget)
-  if Result=gint(True) then begin
+          {$IFDEF UseGtkGlAreaLib}=gint(True){$ENDIF};
+  if Result then begin
     // on success push on stack
     if GtkGLAreaControlStack=nil then
       GtkGLAreaControlStack:=TList.Create;
@@ -251,7 +258,11 @@ begin
   if GtkGLAreaControlStack.Count>0 then begin
     RestoredControl:=
       TGTKGLAreaControl(GtkGLAreaControlStack[GtkGLAreaControlStack.Count-1]);
+    {$IFDEF UseGtkGlAreaLib}
     if gtk_gl_area_make_current(RestoredControl.Widget)<>gint(true) then
+    {$ELSE}
+    if not gtk_gl_area_make_current(RestoredControl.Widget) then
+    {$ENDIF}
       exit;
   end;
   Result:=true;

components/gtk/gtkglarea/gtkopengl.lpk

@@ -4,10 +4,14 @@
     <Name Value="GTKOpenGL"/>
     <Author Value="Mattias Gaertner, Satan"/>
     <CompilerOptions>
+      <Version Value="4"/>
       <SearchPaths>
         <UnitOutputDirectory Value="lib/"/>
         <LCLWidgetType Value="gtk"/>
       </SearchPaths>
+      <CodeGeneration>
+        <Generate Value="Faster"/>
+      </CodeGeneration>
       <Other>
         <CompilerPath Value="$(CompPath)"/>
       </Other>
@@ -16,28 +20,32 @@
 Please make sure that you link to the right libgtkgl. If you accidently link to libgtkgl-2.0 then you will mix gtk1 and gtk2 libraries, which will result in strange errors, up to freezing your windowmanager."/>
     <License Value="LGPL-2"/>
     <Version Major="1"/>
-    <Files Count="5">
+    <Files Count="6">
       <Item1>
         <Filename Value="gtkglarea.lrs"/>
         <Type Value="LRS"/>
       </Item1>
       <Item2>
-        <Filename Value="gtkglarea_int.pp"/>
-        <UnitName Value="GTKGLArea_Int"/>
-      </Item2>
-      <Item3>
         <Filename Value="gtkglareacontrol.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="GTKGLAreaControl"/>
+      </Item2>
+      <Item3>
+        <Filename Value="gtkglarea_int.pp"/>
+        <UnitName Value="GTKGLArea_Int"/>
       </Item3>
       <Item4>
-        <Filename Value="nvgl.pp"/>
+        <Filename Value="openglgtkwidget.pas"/>
-        <UnitName Value="nvGL"/>
+        <UnitName Value="OpenGLGtkWidget"/>
       </Item4>
       <Item5>
+        <Filename Value="nvgl.pp"/>
+        <UnitName Value="nvGL"/>
+      </Item5>
+      <Item6>
         <Filename Value="nvglx.pp"/>
         <UnitName Value="nvGLX"/>
-      </Item5>
+      </Item6>
     </Files>
     <AutoIncrementVersionOnBuild Value="False"/>
     <Type Value="RunAndDesignTime"/>

components/gtk/gtkglarea/gtkopengl.pas

@@ -8,7 +8,8 @@ unit GTKOpenGL;
 interface
 
 uses
-  GTKGLArea_Int, GTKGLAreaControl, nvGL, nvGLX, LazarusPackageIntf; 
+  GTKGLAreaControl, GTKGLArea_Int, OpenGLGtkWidget, nvGL, nvGLX, 
+    LazarusPackageIntf; 
 
 implementation
 

components/gtk/gtkglarea/openglgtkwidget.pas

@@ -0,0 +1,531 @@
+{
+ *****************************************************************************
+ *                                                                           *
+ *  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:
+    Provides methods and types to create gtkwidget with an opengl context.
+    Works very similar to gtkglarea, but completely in FreePascal, so no libs
+    needed.
+}
+unit OpenGLGtkWidget;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses SysUtils, X, XUtil, XLib, glib, gdk, gtk, gl, nvGLX;
+
+// 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; cdecl;
+function gdk_gl_get_info: string; cdecl;
+function gdk_gl_choose_visual(attrlist: Plongint): PGdkVisual; cdecl;
+function gdk_gl_get_config(visual: PGdkVisual; attrib: longint):longint; cdecl;
+function gdk_gl_context_new(visual: PGdkVisual): PGdkGLContext; cdecl;
+function gdk_gl_context_share_new(visual: PGdkVisual; sharelist: PGdkGLContext;
+                                  direct: Integer): PGdkGLContext; cdecl;
+function gdk_gl_context_attrlist_share_new(attrlist: Plongint;
+               sharelist: PGdkGLContext; direct: Integer): PGdkGLContext; cdecl;
+function gdk_gl_context_ref(context: PGdkGLContext): PGdkGLContext; cdecl;
+procedure gdk_gl_context_unref(context:PGdkGLContext); cdecl;
+function gdk_gl_make_current(drawable: PGdkDrawable;
+                             context: PGdkGLContext): boolean; cdecl;
+procedure gdk_gl_swap_buffers(drawable: PGdkDrawable); cdecl;
+procedure gdk_gl_wait_gdk; cdecl;
+procedure gdk_gl_wait_gl; cdecl;
+
+{ glpixmap stuff  }
+
+type
+  TGdkGLPixmap = record end;
+  PGdkGLPixmap = ^TGdkGLPixmap;
+
+
+//function gdk_gl_pixmap_new(visual:PGdkVisual; pixmap:PGdkPixmap):PGdkGLPixmap; cdecl;external;
+//function gdk_gl_pixmap_ref(glpixmap:PGdkGLPixmap):PGdkGLPixmap; cdecl;external;
+//procedure gdk_gl_pixmap_unref(glpixmap:PGdkGLPixmap); cdecl;external;
+//function gdk_gl_pixmap_make_current(glpixmap:PGdkGLPixmap; context:PGdkGLContext):Integer; cdecl;external;
+
+{ fonts  }
+
+//procedure gdk_gl_use_gdk_font(font:PGdkFont; first:longint; count:longint; list_base:longint); cdecl;external;
+
+// 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; cdecl;
+function GTK_GL_AREA(obj: Pointer): PGtkGLArea; cdecl;
+function GTK_GL_AREA_CLASS(klass: Pointer): PGtkGLAreaClass; cdecl;
+function GTK_IS_GL_AREA(obj: Pointer): Boolean;
+function GTK_IS_GL_AREA_CLASS(klass: Pointer): Boolean;
+
+function gtk_gl_area_get_type: TGtkType; cdecl;
+function gtk_gl_area_new(attrList: Plongint): PGtkWidget; cdecl;
+function gtk_gl_area_share_new(attrList: Plongint; share: PGtkGLArea): PGtkWidget; cdecl;
+//function gtk_gl_area_new_vargs(share:PGtkGLArea; args:array of const):PGtkWidget; cdecl;external;
+//function gtk_gl_area_new_vargs(share:PGtkGLArea):PGtkWidget; cdecl;external;
+function gtk_gl_area_make_current(glarea: PGtkGLArea): boolean; cdecl;
+function gtk_gl_area_begingl(glarea: PGtkGLArea): boolean; cdecl;
+procedure gtk_gl_area_swap_buffers(gl_area: PGtkGLArea);
+
+
+implementation
+
+var
+  gl_area_type: TGtkType = 0;
+  parent_class: Pointer = nil;
+  SharedArea: PGtkGLArea = nil;
+
+type
+  TGdkGLContextPrivate = record
+    xdisplay: PDisplay;
+    glxcontext: TGLXContext;
+    ref_count: guint;
+  end;
+  PGdkGLContextPrivate = ^TGdkGLContextPrivate;
+
+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
+  if ADisplay=nil then ;
+  Result:=gdk_screen;
+end;
+
+function g_new(BaseSize, Count: integer): Pointer;
+begin
+  Result:=g_malloc(BaseSize*Count);
+end;
+
+function get_xvisualinfo(visual: PGdkVisualPrivate): PXVisualInfo;
+// IMPORTANT: remember to XFree returned XVisualInfo !!!
+var
+  vinfo_template: TXVisualInfo;
+  dpy: PDisplay;
+  nitems_return: integer;
+  vi: PXVisualInfo;
+begin
+  dpy := GDK_DISPLAY;
+
+  // 'GLX uses VisualInfo records because they uniquely identify
+  // a (VisualID,screen,depth) tuple.'
+  vinfo_template.visual   := GDK_VISUAL_XVISUAL(visual);
+  vinfo_template.visualid := XVisualIDFromVisual(vinfo_template.visual);
+  vinfo_template.depth    := visual^.visual.depth;
+  vinfo_template.screen   := DefaultScreen(dpy);
+  vi := XGetVisualInfo(dpy, VisualIDMask or VisualDepthMask or VisualScreenMask,
+                       @vinfo_template, @nitems_return);
+  // visualinfo needs to be unique
+  if (vi=nil) then raise Exception.Create('');
+  if (nitems_return<>1) then raise Exception.Create('');
+
+  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; cdecl;
+begin
+  Result:=boolean(glXQueryExtension(GDK_DISPLAY,nil,nil)=true);
+end;
+
+function gdk_gl_get_info: string; cdecl;
+begin
+  Result:='Vendor: '+glXGetClientString(GDK_DISPLAY, GLX_VENDOR)+LineEnding
+          +'Version: '+glXGetClientString(GDK_DISPLAY, GLX_VERSION)+LineEnding
+          +'Extensions: '+glXGetClientString(GDK_DISPLAY, GLX_EXTENSIONS)+LineEnding;
+end;
+
+function gdk_gl_choose_visual(attrlist: Plongint): PGdkVisual; cdecl;
+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 := GDK_DISPLAY;
+  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; cdecl;
+var
+  dpy: PDisplay;
+  vi: PXVisualInfo;
+  value: integer;
+begin
+  Result:=-1;
+  if visual=nil then exit;
+
+  dpy := GDK_DISPLAY;
+  
+  vi := get_xvisualinfo(PGdkVisualPrivate(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; cdecl;
+begin
+  Result:=gdk_gl_context_share_new(visual,nil,gtk_FALSE);
+end;
+
+function gdk_gl_context_share_new(visual: PGdkVisual; sharelist: PGdkGLContext;
+  direct: integer): PGdkGLContext; cdecl;
+var
+  dpy: PDisplay;
+  vi: PXVisualInfo;
+  PrivateShareList: PGdkGLContextPrivate;
+  PrivateContext: PGdkGLContextPrivate;
+  glxcontext: TGLXContext;
+begin
+  Result:=nil;
+  if visual=nil then exit;
+
+  dpy := GDK_DISPLAY;
+
+  vi := get_xvisualinfo(PGdkVisualPrivate(visual));
+
+  PrivateShareList:=PGdkGLContextPrivate(sharelist);
+  if (sharelist<>nil) then
+    glxcontext := glXCreateContext(dpy, vi, PrivateShareList^.glxcontext,
+                                   direct=gtk_True)
+  else
+    glxcontext := glXCreateContext(dpy, vi, nil, direct=gtk_True);
+
+  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; cdecl;
+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; cdecl;
+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); cdecl;
+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; cdecl;
+var
+  PrivateContext: PGdkGLContextPrivate;
+begin
+  Result:=false;
+  if  drawable=nil then exit;
+  if context=nil then exit;
+  PrivateContext := PGdkGLContextPrivate(context);
+
+  Result:=boolean(glXMakeCurrent(PrivateContext^.xdisplay,
+                         GDK_WINDOW_XWINDOW(PGdkWindowPrivate(drawable)),
+                         PrivateContext^.glxcontext)=true);
+end;
+
+procedure gdk_gl_swap_buffers(drawable: PGdkDrawable); cdecl;
+begin
+  g_return_if_fail(drawable <> nil);
+
+  glXSwapBuffers(GDK_WINDOW_XDISPLAY(PGdkWindowPrivate(drawable)),
+                 GDK_WINDOW_XWINDOW(PGdkWindowPrivate(drawable)));
+end;
+
+procedure gdk_gl_wait_gdk; cdecl;
+begin
+  glXWaitX;
+end;
+
+procedure gdk_gl_wait_gl; cdecl;
+begin
+  glXWaitGL;
+end;
+
+procedure gtk_gl_area_init(gl_area, theClass: Pointer); cdecl;
+begin
+  if theClass=nil then ;
+  PGtkGLArea(gl_area)^.glcontext:=nil;
+  //#if GTK_CHECK_VERSION (1, 3, 1)
+  //gtk_widget_set_double_buffered(PGtkWidget(gl_area),gdkFALSE);
+end;
+
+function GTK_TYPE_GL_AREA: TGtkType; cdecl;
+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; cdecl;
+begin
+  g_return_if_fail(GTK_IS_GL_AREA(obj),'');
+  Result:=PGtkGLArea(obj);
+end;
+
+function GTK_GL_AREA_CLASS(klass: Pointer): PGtkGLAreaClass; cdecl;
+begin
+  g_return_if_fail(GTK_IS_GL_AREA_CLASS(klass),'');
+  Result:=PGtkGLAreaClass(klass);
+end;
+
+function GTK_IS_GL_AREA(obj: Pointer): Boolean;
+begin
+  // GTK_IS_GL_AREA:=GTK_CHECK_TYPE(obj,GTK_TYPE_GL_AREA);
+  Result := Assigned(obj) and GTK_IS_GL_AREA_CLASS(PGtkTypeObject(obj)^.klass);
+end;
+
+function GTK_IS_GL_AREA_CLASS(klass: Pointer): Boolean;
+begin
+  // GTK_IS_GL_AREA_CLASS:=GTK_CHECK_CLASS_TYPE(klass,GTK_TYPE_GL_AREA);
+  Result := Assigned(klass) and (PGtkTypeClass(klass)^.thetype = GTK_TYPE_GL_AREA);
+end;
+
+function gtk_gl_area_get_type: TGtkType; cdecl;
+begin
+  Result:=GTK_TYPE_GL_AREA;
+end;
+
+function gtk_gl_area_new(attrList: Plongint): PGtkWidget; cdecl;
+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;
+  GetMem(CopyAttrList,Size);
+  System.Move(attrList^,CopyAttrList^,Size);
+  Result:=gtk_gl_area_share_new(CopyAttrList,SharedArea);
+  FreeMem(CopyAttrList);
+end;
+
+function gtk_gl_area_share_new(attrList: Plongint; share: PGtkGLArea
+  ): PGtkWidget; cdecl;
+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, gtk_TRUE);
+  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; cdecl;
+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; cdecl;
+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;
+
+end.
+

examples/gtkglarea/exampleform.pp

@@ -28,8 +28,8 @@ unit ExampleForm;
 interface
 
 uses
-  Classes, SysUtils, GTKGlArea, GTKGLArea_Int, Forms, LResources, Buttons,
+  Classes, SysUtils, Forms, LResources, Buttons,
-  StdCtrls, Dialogs, gtk, glib, NVGL, {$IFDEF VER1_0}Linux{$ELSE}Unix{$ENDIF},
+  StdCtrls, Dialogs, NVGL, {$IFDEF VER1_0}Linux{$ELSE}Unix{$ENDIF},
   GTKGLAreaControl;
 
 type
@@ -101,8 +101,8 @@ var AnExampleForm: TExampleForm;
     ParticleList, CubeList, BackList: GLuint;
 
 var direction: boolean;
-    hour, minutes, secs, msecs, usecs, mmsecs: word;
     timer: single;
+    LastMsecs: integer;
 
 implementation
 
@@ -628,7 +628,7 @@ begin
   glEnable(GL_DEPTH_TEST);          // enables depth testing
   glShadeModel(GL_SMOOTH);          // enables smooth color shading
   {blending}
-  glColor4f(1.0,1.0,1.0,0.5);			// Full Brightness, 50% Alpha ( NEW )
+  glColor4f(1.0,1.0,1.0,0.5);       // Full Brightness, 50% Alpha ( NEW )
   glBlendFunc(GL_SRC_ALPHA, GL_ONE);
   glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER, GL_TRUE);
   {}
@@ -745,8 +745,11 @@ begin
   
 end;
 
+var
+  CurTime: TDateTime;
+  MSecs: integer;
 begin
-  if (gint(True) = gtk_gl_area_make_current(GTKGLAreaControl1.Widget)) then
+  if GTKGLAreaControl1.MakeCurrent then
   begin
     if not AreaInitialized then begin
       myInit;
@@ -760,10 +763,12 @@ begin
       AreaInitialized:=true;
     end;
 
-    GetTime(hour, minutes, secs, msecs, usecs);
+    CurTime:=Now;
-    timer:=msecs-mmsecs;
+    MSecs:=round(CurTime*86400*1000) mod 1000;
+    if MSecs<0 then MSecs:=1000+MSecs;
+    timer:=msecs-LastMsecs;
     if timer<0 then timer:=1000+timer;
-    mmsecs:=msecs;
+    LastMsecs:=MSecs;
     
     ParticleEngine.MoveParticles;
     
@@ -820,14 +825,14 @@ begin
     //glFlush;
     //glFinish;
     // Swap backbuffer to front
-    gtk_gl_area_swap_buffers(PGtkGLArea(GTKGLAreaControl1.Widget));
+    GTKGLAreaControl1.SwapBuffers;
   end;
 end;
 
 procedure TExampleForm.GTKGLAreaControl1Resize(Sender: TObject);
 begin
   if (AreaInitialized)
-  and (gint(True) = gtk_gl_area_make_current(GTKGLAreaControl1.widget)) then
+  and GTKGLAreaControl1.MakeCurrent then
     glViewport (0, 0, GTKGLAreaControl1.Width, GTKGLAreaControl1.Height);
 end;
 

examples/gtkglarea/gtkglarea_demo.lpi

@@ -1,14 +1,16 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="3"/>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
     <General>
-      <ProjectType Value="Program"/>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
       </Flags>
       <MainUnit Value="0"/>
-      <ActiveEditorIndexAtStart Value="1"/>
+      <ActiveEditorIndexAtStart Value="4"/>
       <IconPath Value="./"/>
       <TargetFileExt Value=""/>
       <Title Value="gtkglarea_demo"/>
@@ -22,17 +24,17 @@
         <Loaded Value="True"/>
         <TopLine Value="1"/>
         <UnitName Value="GTKGLArea_Demo"/>
-        <UsageCount Value="22"/>
+        <UsageCount Value="28"/>
       </Unit0>
       <Unit1>
-        <CursorPos X="19" Y="620"/>
+        <CursorPos X="34" Y="828"/>
-        <EditorIndex Value="1"/>
+        <EditorIndex Value="4"/>
         <Filename Value="exampleform.pp"/>
         <IsPartOfProject Value="True"/>
         <Loaded Value="True"/>
-        <TopLine Value="599"/>
+        <TopLine Value="801"/>
         <UnitName Value="ExampleForm"/>
-        <UsageCount Value="22"/>
+        <UsageCount Value="28"/>
       </Unit1>
     </Units>
     <PublishOptions>
@@ -55,7 +57,7 @@
     </RequiredPackages>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="2"/>
+    <Version Value="4"/>
     <SearchPaths>
       <LCLWidgetType Value="gtk"/>
       <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/gtk/"/>