gtk-glext/demo.lisp

   1 (defpackage :gtk-glext-demo
   2   (:use :cl :gtk :gtkglext :gobject :glib)
   3   (:export :run
   4            #:planet))
   5
   6 (in-package :gtk-glext-demo)
   7
   8 (defvar *theta* 30)
   9
  10 (defun draw (widget event)
  11   (declare (ignore widget event))
  12   (gl:clear-color 0 0 0 0)
  13   (gl:cull-face :back)
  14   (gl:depth-func :less)
  15   (gl:disable :dither)
  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)
  20   (gl:load-identity)
  21   (gl:translate 0 0 -5)
  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)
  26   (gl:color 1 1 1)
  27   (gl:front-face :cw)
  28   (glut:solid-teapot 1.5)
  29   (gl:front-face :ccw)
  30   (gl:flush))
  31
  32 (defun run ()
  33   (with-main-loop
  34     (setf *theta* 30)
  35     (let ((window (make-instance 'gtk-window
  36                                  :type :toplevel
  37                                  :window-position :center
  38                                  :title "Hello world!"
  39                                  :default-width 320
  40                                  :default-height 240))
  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 ()
  48                                                   (setf *theta*
  49                                                         (mod (+ *theta* 0.5) 360))
  50                                                   (widget-queue-draw drawing)
  51                                                   (setf (label-label label)
  52                                                         (format nil "Theta = ~A" *theta*))
  53                                                   t))))
  54         (connect-signal window "delete-event" (lambda (w e)
  55                                                 (declare (ignore w e))
  56                                                 (g-source-remove source-id)
  57                                                 nil)))
  58       (widget-show window :all t))))
  59
  60 (defvar *d* 0)
  61 (defvar *y* 0)
  62
  63 (defun planet ()
  64   (with-main-loop
  65     (setf *d* 0 *y* 0)
  66     (let ((window (make-instance 'gtk-window
  67                                  :window-position :center
  68                                  :title "Planets"
  69                                  :default-width 500
  70                                  :default-height 500))
  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"
  75                       (lambda (w e)
  76                         (declare (ignore w))
  77                         (ignore-errors
  78                           (let ((c (aref (gdk:event-key-string e) 0)))
  79                             (case c
  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)))))
  84                         nil))
  85       (let ((timer-id (gtk-main-add-timeout 10 (lambda ()
  86                                                   (incf *d* 1) (incf *y* 0.5)
  87                                                   (widget-queue-draw area)
  88                                                   t))))
  89         (connect-signal window "delete-event" (lambda (w e)
  90                                                 (declare (ignore w e))
  91                                                 (g-source-remove timer-id)
  92                                                 nil)))
  93       (widget-show window))))
  94
  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)
 100   (gl:color 1 1 1)
 101   (gl:with-pushed-matrix
 102     ;; draw sun
 103     (gl:translate 0 0 -2)
 104     (gl:rotate 30 1 1 0)
 105     (glut:wire-sphere 1 20 16)
 106     ;; draw smaller planet
 107     (gl:rotate *y* 0 1 0)
 108     (gl:translate 2 0 0)
 109     (gl:rotate *d* 0 1 0)
 110     (glut:wire-sphere 0.2 10 8))
 111   (gl:flush))
 112
 113 (defun planet-resize (w width height)
 114   (declare (ignore w))
 115   (gl:viewport 0 0 width height)
 116   (gl:matrix-mode :projection)
 117   (gl:load-identity)
 118   (glu:perspective 60 (/ width height) 1 20)
 119   (gl:matrix-mode :modelview)
 120   (gl:load-identity)
 121   (glu:look-at 0 0 5 0 0 0 0 1 0))