1 (defpackage :gtk-glext-demo
2 (:use :cl :gtk :gtkglext :gobject :glib)
6 (in-package :gtk-glext-demo)
10 (defun draw (widget event)
11 (declare (ignore widget event))
12 (gl:clear-color 0 0 0 0)
16 (gl:shade-model :smooth)
17 (gl:light-model :light-model-local-viewer 1)
18 (gl:color-material :front :ambient-and-diffuse)
19 (gl:enable :light0 :lighting :cull-face :depth-test)
22 (gl:rotate *theta* 1 1 0)
23 (gl:light :light0 :position '(0 1 1 0))
24 (gl:light :light0 :diffuse '(0.2 0.4 0.6 0))
25 (gl:clear :color-buffer-bit :depth-buffer-bit)
28 (glut:solid-teapot 1.5)
35 (let ((window (make-instance 'gtk-window
37 :window-position :center
41 (v-box (make-instance 'v-box))
42 (label (make-instance 'label :label "Click me!"))
43 (drawing (make-instance 'gl-drawing-area :on-expose #'draw)))
44 (box-pack-start v-box drawing)
45 (box-pack-start v-box label :expand nil)
46 (container-add window v-box)
47 (let ((source-id (gtk-main-add-timeout 100 (lambda ()
49 (mod (+ *theta* 0.5) 360))
50 (widget-queue-draw drawing)
51 (setf (label-label label)
52 (format nil "Theta = ~A" *theta*))
54 (connect-signal window "delete-event" (lambda (w e)
55 (declare (ignore w e))
56 (g-source-remove source-id)
58 (widget-show window :all t))))
66 (let ((window (make-instance 'gtk-window
67 :window-position :center
71 (area (make-instance 'gl-drawing-area :on-expose #'planet-draw :on-resize #'planet-resize)))
72 (container-add window area)
73 (pushnew :key-press-mask (gdk:gdk-window-events (widget-window window)))
74 (connect-signal window "key-press-event"
78 (let ((c (aref (gdk:event-key-string e) 0)))
80 (#\d (incf *d* 10) (widget-queue-draw area))
81 (#\D (incf *d* -10) (widget-queue-draw area))
82 (#\y (incf *y* 5) (widget-queue-draw area))
83 (#\Y (incf *y* -5) (widget-queue-draw area)))))
85 (let ((timer-id (gtk-main-add-timeout 10 (lambda ()
86 (incf *d* 1) (incf *y* 0.5)
87 (widget-queue-draw area)
89 (connect-signal window "delete-event" (lambda (w e)
90 (declare (ignore w e))
91 (g-source-remove timer-id)
93 (widget-show window))))
95 (defun planet-draw (w e)
96 (declare (ignore w e))
97 (gl:clear-color 0 0 0 0)
98 (gl:shade-model :flat)
99 (gl:clear :color-buffer)
101 (gl:with-pushed-matrix
103 (gl:translate 0 0 -2)
105 (glut:wire-sphere 1 20 16)
106 ;; draw smaller planet
107 (gl:rotate *y* 0 1 0)
109 (gl:rotate *d* 0 1 0)
110 (glut:wire-sphere 0.2 10 8))
113 (defun planet-resize (w width height)
115 (gl:viewport 0 0 width height)
116 (gl:matrix-mode :projection)
118 (glu:perspective 60 (/ width height) 1 20)
119 (gl:matrix-mode :modelview)
121 (glu:look-at 0 0 5 0 0 0 0 1 0))