From b2748c46db1178843f21800337b4dd56e0c79a3a Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 15 Oct 2007 22:00:28 +0000 Subject: [PATCH] openglcontrol gtk2: reduced debugging output, fixed crash on destroy git-svn-id: trunk@12479 - --- components/opengl/example/mainunit.lfm | 15 +++---- components/opengl/example/mainunit.lrs | 9 +++-- components/opengl/example/mainunit.pas | 11 ++++- .../opengl/example/testopenglcontext1.lpi | 12 +++--- components/opengl/glgtkglxcontext.pas | 40 +++++++------------ examples/openglcontrol/openglcontrol_demo.lpi | 2 +- lcl/include/customcheckbox.inc | 1 + 7 files changed, 43 insertions(+), 47 deletions(-) diff --git a/components/opengl/example/mainunit.lfm b/components/opengl/example/mainunit.lfm index decd50e0ca..33b0e3adc7 100644 --- 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 diff --git a/components/opengl/example/mainunit.lrs b/components/opengl/example/mainunit.lrs index 39447d03de..ceaca1cab8 100644 --- 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 ]); diff --git a/components/opengl/example/mainunit.pas b/components/opengl/example/mainunit.pas index 75196d3d13..a72ff490a7 100644 --- 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 diff --git a/components/opengl/example/testopenglcontext1.lpi b/components/opengl/example/testopenglcontext1.lpi index 2117f8166d..2a85a74c27 100644 --- a/components/opengl/example/testopenglcontext1.lpi +++ b/components/opengl/example/testopenglcontext1.lpi @@ -27,10 +27,10 @@ - + - + @@ -40,7 +40,7 @@ - + @@ -48,10 +48,10 @@ - - + + - + diff --git a/components/opengl/glgtkglxcontext.pas b/components/opengl/glgtkglxcontext.pas index 42036cf6c1..4a9fe59227 100644 --- 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); diff --git a/examples/openglcontrol/openglcontrol_demo.lpi b/examples/openglcontrol/openglcontrol_demo.lpi index e09c726cbf..c227f512d0 100644 --- a/examples/openglcontrol/openglcontrol_demo.lpi +++ b/examples/openglcontrol/openglcontrol_demo.lpi @@ -2,7 +2,7 @@ - + diff --git a/lcl/include/customcheckbox.inc b/lcl/include/customcheckbox.inc index 2754cf586c..46612ff04e 100644 --- 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;