From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Sat, 29 Aug 2009 05:32:20 +0000 (+0400)
Subject: gtk-glext: cleanup
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=34d0739652d8d0919b99d822796d75ca21208e1c;p=cl-gtk2.git

gtk-glext: cleanup
---

diff --git a/gtk-glext/demo.lisp b/gtk-glext/demo.lisp
index 2a9e893..16fee42 100644
--- a/gtk-glext/demo.lisp
+++ b/gtk-glext/demo.lisp
@@ -40,7 +40,7 @@
 				 :default-height 240))
           (v-box (make-instance 'v-box))
           (label (make-instance 'label :label "Click me!"))
-	  (drawing (make-instance 'gl-drawing-area :on-draw #'draw)))
+	  (drawing (make-instance 'gl-drawing-area :on-expose #'draw)))
       (box-pack-start v-box drawing)
       (box-pack-start v-box label :expand nil)
       (container-add window v-box)
diff --git a/gtk-glext/gtkglext-drawing-area.lisp b/gtk-glext/gtkglext-drawing-area.lisp
index e0c73f3..768991b 100644
--- a/gtk-glext/gtkglext-drawing-area.lisp
+++ b/gtk-glext/gtkglext-drawing-area.lisp
@@ -1,23 +1,27 @@
 (in-package :gtkglext)
 
 (defclass gl-drawing-area (drawing-area)
-  ((on-draw :initarg :on-draw :initform nil)
-   (on-init :initarg :on-init :initform nil))
+  ((on-expose :initarg :on-expose :initform nil :accessor gl-drawing-area-on-expose)
+   (on-init :initarg :on-init :initform nil :accessor gl-drawing-area-on-init)
+   (on-resize :initarg :on-resize :initform nil :accessor gl-drawing-area-on-resize))
   (:metaclass gobject-class)
   (:g-type-name . "GtkGLDrawingArea"))
 
 (defun resize (widget width height)
   (with-gl-context (widget)
-    (gl:viewport 0 0 width height)
+    (if (gl-drawing-area-on-resize widget)
+        (funcall (gl-drawing-area-on-resize widget) widget width height))
+        (progn
+          (gl:viewport 0 0 width height)
 
-    ;; set projection to account for aspect
-    (gl:matrix-mode :projection)
-    (gl:load-identity)
-    (glu:perspective 90 (/ width height) 0.5 20) ; 90 degrees field of view y, clip 0.5-20 z
+          ;; set projection to account for aspect
+          (gl:matrix-mode :projection)
+          (gl:load-identity)
+          (glu:perspective 90 (/ width height) 0.5 20) ; 90 degrees field of view y, clip 0.5-20 z
 
-    ;; set modelview to identity
-    (gl:matrix-mode :modelview)
-    (gl:load-identity)))
+          ;; set modelview to identity
+          (gl:matrix-mode :modelview)
+          (gl:load-identity))))
 
 (defun gl-drawing-area-configure (widget event)
   (declare (ignore event))
@@ -29,30 +33,32 @@
 
 (defun gl-drawing-area-realize (widget)
   #+nil(format t "realize~%")
+  (bwhen (init-fn (gl-drawing-area-on-init widget))
+    (funcall init-fn widget))
   (multiple-value-bind (width height)
       (gdk:drawable-get-size (widget-window widget))
     (resize widget width height))
-  (bwhen (init-fn (slot-value widget 'on-init))
-	 (funcall init-fn widget))
   nil)
 
 (defun gl-drawing-area-exposed (widget event)
-  (bwhen (draw-fn (slot-value widget 'on-draw))
-    (funcall draw-fn widget event))
+  (bwhen (draw-fn (gl-drawing-area-on-expose widget))
+    (with-gl-context (widget)
+      (funcall draw-fn widget event)))
   nil)
 
+(defun gl-drawing-area-parent-set (widget event)
+  (declare (ignore event))
+  (unless (gtk-widget-set-gl-capability widget
+                                        *gl-config*
+                                        nil
+                                        nil
+                                        :rgba-type)
+    (warn "set gl capability for ~A (with ~A) failed~%" widget *gl-config*)))
+
 (register-object-type-implementation "GtkGLDrawingArea" gl-drawing-area "GtkDrawingArea" nil nil)
 
 (defmethod initialize-instance :after ((widget gl-drawing-area) &key &allow-other-keys)
   (connect-signal widget "realize" #'gl-drawing-area-realize)
   (connect-signal widget "expose-event" #'gl-drawing-area-exposed)
   (connect-signal widget "configure-event" #'gl-drawing-area-configure)
-  (connect-signal widget "parent-set" (lambda (widget event)
-					(declare (ignore event))
-					(at-init () (gl-init))
-					(unless (gtk-widget-set-gl-capability widget
-                                                                              *gl-config*
-                                                                              nil
-                                                                              nil
-                                                                              :rgba-type)
-                                          (warn "set gl capability for ~A (with ~A) failed~%" widget *gl-config*)))))
+  (connect-signal widget "parent-set" #'gl-drawing-area-parent-set))
diff --git a/gtk-glext/gtkglext.package.lisp b/gtk-glext/gtkglext.package.lisp
index e26db7c..5eadf2e 100644
--- a/gtk-glext/gtkglext.package.lisp
+++ b/gtk-glext/gtkglext.package.lisp
@@ -1,7 +1,9 @@
 (defpackage :gtkglext
   (:use :cl :cffi :gobject :gtk :gdk :glib :iter)
   (:export #:with-gl-context #:with-matrix-mode
-	   #:gl-drawing-area))
+	   #:gl-drawing-area
+           #:gl-drawing-area-on-expose
+           #:gl-drawing-area-on-init))
 
 (in-package :gtkglext)