gui/gui.lisp

   1 (in-package :gui)
   2
   3 (defclass fenster (window)
   4   ((cursor-position :accessor cursor-position
   5                     :initform (make-array 2 :element-type 'fixnum)
   6                     :type (simple-array fixnum (2)))
   7    (draw-func :accessor draw-func
   8               :initarg :draw-func
   9               :initform #'(lambda ()
  10                             (with-primitive :lines
  11                               (color 1 0 0) (vertex 0 0 0) (vertex 1 0 0)
  12                               (color 0 1 0) (vertex 0 0 0) (vertex 0 1 0)
  13                               (color 0 0 1) (vertex 0 0 0) (vertex 0 0 1)))
  14               :type function)))
  15
  16 (defmethod set-view ((w fenster) &key (2d nil))
  17       (load-identity)
  18       (viewport 0 0 (width w) (height w))
  19       (matrix-mode :projection)
  20       (load-identity)
  21       (if 2d
  22           (ortho 0 (width w) (height w) 0 -1 1)
  23           (progn (glu:perspective 40 (/ (width w) (height w)) 3 100)
  24                  (glu:look-at 20 30 -5
  25                               0 0 0
  26                               0 0 1)))
  27       (matrix-mode :modelview)
  28       (load-identity))
  29
  30 (defmethod display ((w fenster))
  31   (clear :color-buffer-bit :depth-buffer-bit)
  32   (load-identity)
  33
  34   (funcall (draw-func w))
  35
  36   (swap-buffers)
  37   (sleep (/ 10))
  38   (post-redisplay))
  39
  40 (defmethod reshape ((w fenster) x y)
  41   (setf (width w) x
  42         (height w) y)
  43   (set-view w))
  44
  45 (defmethod display-window :before ((w fenster))
  46   (set-view w))
  47
  48 (defmethod passive-motion ((w fenster) x y)
  49   (setf (aref (cursor-position w) 0) x
  50         (aref (cursor-position w) 1) (- (height w) y)))
  51
  52 (defmethod keyboard ((w fenster) key x y)
  53   (case key
  54     (#\Esc (destroy-current-window))))
  55
  56 (defmacro with-gui (&body body)
  57   `(display-window
  58     (make-instance 'gui:fenster
  59                    :mode '(:double :rgb :depth)
  60                    :draw-func #'(lambda ()
  61                                   ,@body))))
  62
  63