3 (defclass gl-drawing-area (drawing-area)
4 ((on-draw :initarg :on-draw :initform nil)
5 (on-init :initarg :on-init :initform nil))
6 (:metaclass gobject-class)
7 (:g-type-name . "GtkGLDrawingArea"))
9 (defun resize (widget width height)
10 (with-gl-context (widget)
11 (gl:viewport 0 0 width height)
13 ;; set projection to account for aspect
14 (gl:matrix-mode :projection)
16 (glu:perspective 90 (/ width height) 0.5 20) ; 90 degrees field of view y, clip 0.5-20 z
18 ;; set modelview to identity
19 (gl:matrix-mode :modelview)
22 (defun gl-drawing-area-configure (widget event)
23 (declare (ignore event))
24 (multiple-value-bind (width height)
25 (gdk:drawable-get-size (widget-window widget))
26 #+nil(format t "configure ~Dx~D~%" width height)
27 (when (widget-realized-p widget)
28 (resize widget width height))))
30 (defun gl-drawing-area-realize (widget)
31 #+nil(format t "realize~%")
32 (multiple-value-bind (width height)
33 (gdk:drawable-get-size (widget-window widget))
34 (resize widget width height))
35 (bwhen (init-fn (slot-value widget 'on-init))
36 (funcall init-fn widget))
39 (defun gl-drawing-area-exposed (widget event)
40 (bwhen (draw-fn (slot-value widget 'on-draw))
41 (funcall draw-fn widget event))
44 (register-object-type-implementation "GtkGLDrawingArea" gl-drawing-area "GtkDrawingArea" nil nil)
46 (defmethod initialize-instance :after ((widget gl-drawing-area) &key &allow-other-keys)
47 (connect-signal widget "realize" #'gl-drawing-area-realize)
48 (connect-signal widget "expose-event" #'gl-drawing-area-exposed)
49 (connect-signal widget "configure-event" #'gl-drawing-area-configure)
50 (connect-signal widget "parent-set" (lambda (widget event)
51 (declare (ignore event))
52 (at-init () (gl-init))
53 (unless (gtk-widget-set-gl-capability widget
58 (warn "set gl capability for ~A (with ~A) failed~%" widget *gl-config*)))))