openglcontrol gtk2: reduced debugging output, fixed crash on destroy

git-svn-id: trunk@12479 -
2025-04-06 02:18:03 +02:00 · 2007-10-15 22:00:28 +00:00 · 2007-10-15 22:00:28 +00:00 · b2748c46db
commit b2748c46db
parent 22f37ad0a2
7 changed files with 43 additions and 47 deletions
--- a/components/opengl/example/mainunit.lfm
+++ b/components/opengl/example/mainunit.lfm
@ -1,13 +1,10 @@
 object Form1: TForm1
-  Caption = 'Form1'
-  ClientHeight = 300
-  ClientWidth = 400
-  OnCreate = FormCreate
-  PixelsPerInch = 112
+  Left = 419
+  Height = 300
+  Top = 287
+  Width = 400
  HorzScrollBar.Page = 399
  VertScrollBar.Page = 299
-  Left = 290
-  Height = 300
-  Top = 163
-  Width = 400
+  Caption = 'Form1'
+  OnCreate = FormCreate
 end
--- a/components/opengl/example/mainunit.lrs
+++ b/components/opengl/example/mainunit.lrs
@ -1,6 +1,7 @@
+{ 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
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#163#1#6'Height'#3','#1#3'Top'#3#31#1#5'Wi'
+  +'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#7
+  +'Caption'#6#5'Form1'#8'OnCreate'#7#10'FormCreate'#0#0
 ]);
--- a/components/opengl/example/mainunit.pas
+++ b/components/opengl/example/mainunit.pas
@ -20,7 +20,7 @@ unit MainUnit;
 interface

 uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
  OpenGLContext, GL, GLU;

 type
@ -31,6 +31,7 @@ type
    procedure FormCreate(Sender: TObject);
    procedure OpenGLControl1Paint(Sender: TObject);
    procedure OpenGLControl1Resize(Sender: TObject);
+    procedure OnAppIdle(Sender: TObject; var Done: Boolean);
  private
  public
    cube_rotationx: GLFloat;
@ -59,6 +60,8 @@ begin
    OnResize:=@OpenGLControl1Resize;
    AutoResizeViewport:=true;
  end;
+  
+  Application.AddOnIdleHandler(@OnAppIdle);
 end;

 procedure TForm1.OpenGLControl1Paint(Sender: TObject);
@ -136,7 +139,13 @@ procedure TForm1.OpenGLControl1Resize(Sender: TObject);
 begin
  if Sender=nil then ;
  if OpenGLControl1.Height <= 0 then exit;
+end;

+procedure TForm1.OnAppIdle(Sender: TObject; var Done: Boolean);
+begin
+  Done:=false;
+  //DebugLn(['TForm1.OnAppIdle ']);
+  OpenGLControl1.Invalidate;
 end;

 initialization
--- a/components/opengl/example/testopenglcontext1.lpi
+++ b/components/opengl/example/testopenglcontext1.lpi
@ -27,10 +27,10 @@
    </RunParams>
    <RequiredPackages Count="2">
      <Item1>
-        <PackageName Value="LazOpenGLContext"/>
+        <PackageName Value="LCL"/>
      </Item1>
      <Item2>
-        <PackageName Value="LCL"/>
+        <PackageName Value="LazOpenGLContext"/>
      </Item2>
    </RequiredPackages>
    <Units Count="2">
@ -40,7 +40,7 @@
        <UnitName Value="TestOpenGLContext1"/>
        <CursorPos X="1" Y="13"/>
        <TopLine Value="1"/>
-        <UsageCount Value="142"/>
+        <UsageCount Value="144"/>
      </Unit0>
      <Unit1>
        <Filename Value="mainunit.pas"/>
@ -48,10 +48,10 @@
        <IsPartOfProject Value="True"/>
        <ResourceFilename Value="mainunit.lrs"/>
        <UnitName Value="MainUnit"/>
-        <CursorPos X="16" Y="26"/>
-        <TopLine Value="11"/>
+        <CursorPos X="19" Y="51"/>
+        <TopLine Value="37"/>
        <EditorIndex Value="0"/>
-        <UsageCount Value="142"/>
+        <UsageCount Value="144"/>
        <Loaded Value="True"/>
      </Unit1>
    </Units>
--- a/components/opengl/glgtkglxcontext.pas
+++ b/components/opengl/glgtkglxcontext.pas
@ -149,7 +149,7 @@ type
  TGdkGLContextPrivate = record
    xdisplay: PDisplay;
    glxcontext: TGLXContext;
-    ref_count: guint;
+    ref_count: gint;
  end;
  PGdkGLContextPrivate = ^TGdkGLContextPrivate;

@ -272,7 +272,6 @@ begin
  dpy := GetDefaultXDisplay;
  {$IFDEF Lclgtk2}
  DebugLn('get_xvisualinfo dpy=',XDisplayAsString(dpy));
-  
  DebugLn('get_xvisualinfo visual=',GdkVisualAsString(Visual));
  RaiseGDBException('not implemented for gtk2');
  {$ENDIF}
@ -347,13 +346,11 @@ begin
  RaiseGDBException('');
  {$ENDIF}

-  //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
@ -361,7 +358,6 @@ begin
    exit;
  end;

-  //writeln('gdk_gl_choose_visual C ');
  visual := gdkx_visual_get(vi^.visualid);
  XFree(vi);
  Result:=visual;
@ -406,9 +402,7 @@ begin
  dpy := GetDefaultXDisplay;

  {$IFDEF lclgtk2}
-  DebugLn(['gdk_gl_context_share_new AAA1']);
  vi:=glXChooseVisual(dpy, DefaultScreen(dpy), @attrList[0]);
-  DebugLn(['gdk_gl_context_share_new AAA2']);
  {$ELSE}
  if visual=nil then exit;
  vi := get_xvisualinfo(visual);
@ -420,7 +414,6 @@ begin
                                   direct=1)
  else
    glxcontext := glXCreateContext(dpy, vi, nil, direct=1);
-  DebugLn(['gdk_gl_context_share_new AAA3']);

  XFree(vi);
  if (glxcontext = nil) then exit;
@ -458,6 +451,7 @@ begin
  if context=nil then exit;
  PrivateContext := PGdkGLContextPrivate(context);
  inc(PrivateContext^.ref_count);
+  //DebugLn(['gdk_gl_context_ref ref_count=',PrivateContext^.ref_count]);
  Result:=context;
 end;

@ -469,13 +463,15 @@ begin

  PrivateContext:=PGdkGLContextPrivate(context);

-  if (PrivateContext^.ref_count > 1) then
-    dec(PrivateContext^.ref_count)
-  else begin
+  dec(PrivateContext^.ref_count);
+  if (PrivateContext^.ref_count = 0) then begin
+    //DebugLn(['gdk_gl_context_unref START ref_count=',PrivateContext^.ref_count]);
    if (PrivateContext^.glxcontext = glXGetCurrentContext()) then
      glXMakeCurrent(PrivateContext^.xdisplay, None, nil);
    glXDestroyContext(PrivateContext^.xdisplay, PrivateContext^.glxcontext);
+    PrivateContext^.glxcontext:=nil;
    g_free(PrivateContext);
+    //DebugLn(['gdk_gl_context_unref END']);
  end;
 end;

@ -531,13 +527,13 @@ procedure gtk_gl_area_init(
  ); cdecl;
 begin
  if theClass=nil then ;
-  DebugLn(['gtk_gl_area_init START']);
+  //DebugLn(['gtk_gl_area_init START']);
  PGtkGLArea(gl_area)^.glcontext:=nil;
  {$IFDEF LclGtk2}
  gtk_widget_set_double_buffered(PGtkWidget(gl_area),gdkFALSE);
  GTK_WIDGET_UNSET_FLAGS(PGtkWidget(gl_area),GTK_NO_WINDOW);
  {$ENDIF}
-  DebugLn(['gtk_gl_area_init END']);
+  //DebugLn(['gtk_gl_area_init END']);
 end;

 function GTK_TYPE_GL_AREA: TGtkType;
@ -621,12 +617,10 @@ var
  gl_area: PGtkGLArea;
 begin
  Result:=nil;
-  DebugLn(['gtk_gl_area_share_new START']);
-  //writeln('gtk_gl_area_share_new A ');
+  //DebugLn(['gtk_gl_area_share_new START']);
  if (share<>nil) and (not GTK_IS_GL_AREA(share)) then
    exit;
  {$IFNDEF MSWindows}
-  //writeln('gtk_gl_area_share_new B ');
  {$IFDEF lclgtk2}
  visual := nil;
  {$ELSE}
@ -635,14 +629,10 @@ begin
  {$ENDIF}
  {$ENDIF non MSWindows}

-  //writeln('gtk_gl_area_share_new C ');
-  DebugLn(['gtk_gl_area_share_new BBB1']);
  sharelist := nil;
  if share<>nil then sharelist:=share^.glcontext;
  glcontext := gdk_gl_context_share_new(visual, sharelist, 1, attrlist);
  if (glcontext = nil) then exit;
-  DebugLn(['gtk_gl_area_share_new BBB2']);
-  //writeln('gtk_gl_area_share_new D ');

  {$IFNDEF MSWindows}
  if visual<>nil then begin
@ -654,8 +644,6 @@ begin

  gl_area := gtk_type_new (gtk_gl_area_get_type);
  gl_area^.glcontext := glcontext;
-  //writeln('gtk_gl_area_share_new E ',gl_area<>nil);
-  DebugLn(['gtk_gl_area_share_new BBB3']);

  {$IFNDEF MSWindows}
  if visual<>nil then begin
@ -674,9 +662,9 @@ begin
  if not GTK_IS_GL_AREA(glarea) then exit;
  if not GTK_WIDGET_REALIZED(PGtkWidget(glarea)) then exit;

-  DebugLn(['gtk_gl_area_make_current START']);
+  //DebugLn(['gtk_gl_area_make_current START']);
  Result:=gdk_gl_make_current(PGtkWidget(glarea)^.window, glarea^.glcontext);
-  DebugLn(['gtk_gl_area_make_current END']);
+  //DebugLn(['gtk_gl_area_make_current END']);
 end;

 function gtk_gl_area_begingl(glarea: PGtkGLArea): boolean;
@ -737,14 +725,14 @@ begin
  AttrList:=CreateOpenGLContextAttrList(DoubleBuffered,RGBA);
  try
    if SharedControl<>nil then begin
-      SharedArea:=PGtkGLArea(SharedControl.Handle);
+      SharedArea:=PGtkGLArea(PtrUInt(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);
+    Result:=HWND(Pointer(NewWidget));
    PGtkobject(NewWidget)^.flags:=PGtkobject(NewWidget)^.flags or GTK_CAN_FOCUS;
    {$IFDEF LCLGtk}
    TGTKWidgetSet(WidgetSet).FinishComponentCreate(AWinControl,NewWidget);
--- a/examples/openglcontrol/openglcontrol_demo.lpi
+++ b/examples/openglcontrol/openglcontrol_demo.lpi
@ -2,7 +2,7 @@
 <CONFIG>
  <ProjectOptions>
    <PathDelim Value="/"/>
-    <Version Value="5"/>
+    <Version Value="6"/>
    <General>
      <Flags>
        <MainUnitHasCreateFormStatements Value="False"/>
--- a/lcl/include/customcheckbox.inc
+++ b/lcl/include/customcheckbox.inc
@ -62,6 +62,7 @@ begin
  FState:=NewState;
  //debugln('TCustomCheckBox.DoChange CHANGED ',dbgsname(Self),' ',dbgs(ord(FState)));
  inherited Click; // emulate delphi OnClick behaviour
+  inherited CLick;
 end;

 procedure TCustomCheckBox.Click;