drawing.lisp

   1 (in-package :lambdamundo)
   2
   3 ;; gl init and de-init
   4
   5 (defun begin-gl ()
   6   (gl:enable gl:+depth-test+)
   7   (gl:depth-func gl:+less+)
   8   (gl:disable gl:+cull-face+)
   9   (gl:disable gl:+lighting+))
  10
  11 (defun end-gl ())
  12
  13 ;; drawing --------------------
  14
  15
  16 (defparameter *draw-fns* (make-hash-table :test 'equalp)
  17   "An table of functions called in order to render the scene")
  18
  19 (defparameter *draw-array* (make-array 0 :adjustable t :fill-pointer 0)
  20   "An array that indexes *draw-fns* to establish draw order" )
  21
  22 (defun reset-draw-fns ()
  23   "Reset all drawing functions."
  24   (setf *draw-fns* (make-hash-table :test 'equalp))
  25   (setf *draw-array* (make-array 0 :adjustable t :fill-pointer 0)))
  26
  27 (defun extend-draw-array (name priority)
  28   "If the name is in the array, adjust priority, else add it to the array"
  29   (assert (not (null (gethash name *draw-fns*))) (name) "~S is not a drawable")
  30   (let
  31       ((draw-priority-pos
  32         (position-if #'(lambda (x) (equal (car x) name)) *draw-array*)))
  33     (if draw-priority-pos
  34         (setf (aref *draw-array* draw-priority-pos) (cons name priority))
  35         (vector-push-extend (cons name priority) *draw-array*))))
  36
  37 (defmacro make-draw-function (name priority &body forms)
  38   "Macro to wrap a draw function body and add it to the arrays"
  39   `(progn
  40      (setf (gethash ,name *draw-fns*)
  41            (compile nil '(lambda () ,@forms)))
  42      (extend-draw-array ,name ,priority)
  43      (setf *draw-array*
  44            (sort *draw-array* #'(lambda (a b)
  45                                   (< (cdr a) (cdr b)))))))
  46
  47 (defun remove-draw-function (name)
  48   (remhash name *draw-fns*))
  49
  50 (defun draw-world ()
  51   (gl:clear (logior  gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
  52   (iterate
  53     (for entry in-vector *draw-array*)
  54     (let ((draw-fn
  55            (gethash (car entry) *draw-fns*)))
  56       (when draw-fn (funcall draw-fn)))))
  57
  58
  59 (make-draw-function
  60  "testcube" 1
  61  (let ((vertices
  62         (list
  63          '(1.0 1.0 1.0)
  64          '(1.0 1.0 0.0)
  65          '(1.0 -1.0 1.0)
  66          '(1.0 -1.0 0.0)
  67          '(-1.0 1.0 1.0)
  68          '(-1.0 1.0 0.0)
  69          '(-1.0 -1.0 1.0)
  70          '(-1.0 -1.0 0.0)))
  71        (polys
  72         (list
  73          '(2 1 3 4)
  74          '(5 6 7 8)
  75          '(1 2 6 5)
  76          '(4 3 7 8)
  77          '(3 1 5 7)
  78          '(2 4 8 6))))
  79    (with-camera *camera*
  80      (gl:with-begin gl:+quads+
  81        (gl:color-3f 0.0 1.0 0.0)
  82        (iterate
  83         (for poly in polys)
  84         (iterate
  85          (for vertex in poly)
  86          (apply #'gl:vertex-3f (nth (1- vertex) vertices))))))))
  87
  88 ;; (make-draw-function
  89 ;;     "triangle" 1
  90 ;;   (gl:with-begin gl:+triangles+
  91 ;;     (gl:color-3f 1.0 0.0 0.0) (gl:vertex-3f  1.0  0.0 -5.0)
  92 ;;     (gl:color-3f 0.0 1.0 0.0) (gl:vertex-3f -1.0  1.0 -5.0)
  93 ;;     (gl:color-3f 0.0 0.0 0.0) (gl:vertex-3f -1.0 -1.0 -5.0)))
  94
  95 ;; there will be a draw function per class of object