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) &optional (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
  24         (glu:perspective 30 (/ (width w) (height w)) .01 100)
  25         (glu:look-at 20 30 10
  26                  0 0 0
  27                  0 0 1)))
  28   (matrix-mode :modelview)
  29   (load-identity))
  30
  31 (defmethod reshape ((w fenster) x y)
  32   (setf (width w) x
  33         (height w) y)
  34   (set-view w))
  35
  36 (defmethod display-window :before ((w fenster))
  37   (set-view w))
  38
  39 (defmethod display ((w fenster))
  40   (clear :color-buffer-bit :depth-buffer-bit)
  41   (load-identity)
  42
  43   (funcall (draw-func w))
  44
  45   (swap-buffers)
  46   (sleep (/ 60))
  47   (post-redisplay))
  48
  49 (defmethod passive-motion ((w fenster) x y)
  50   (setf (aref (cursor-position w) 0) x
  51         (aref (cursor-position w) 1) (- (height w) y)))
  52
  53 (defmethod keyboard ((w fenster) key x y)
  54   (case key
  55     (#\Esc (destroy-current-window))))
  56
  57 (defmacro with-gui (&body body)
  58   `(display-window
  59     (make-instance 'gui:fenster
  60                    :mode '(:double :rgb :depth)
  61                    :draw-func #'(lambda ()
  62                                   ,@body))))
  63
  64