gtk-glext: cleanup

[cl-gtk2.git] / gtk-glext / gtkglext-drawing-area.lisp

diff --git a/gtk-glext/gtkglext-drawing-area.lisp b/gtk-glext/gtkglext-drawing-area.lisp
index e0c73f3..768991b 100644 (file)
--- 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))