examples/vbo.lisp

   1 (require '#:asdf)
   2 (asdf:oos 'asdf:load-op '#:cl-glfw-opengl-version_1_1)
   3
   4 (defparameter *use-vbo* t)
   5
   6 (defconstant +pi+ (coerce pi 'single-float))
   7 (defconstant +2pi+ (* +pi+ 2))
   8 (defconstant +pi/2+ (/ +pi+ 2))
   9 (defconstant +pi/4+ (/ +pi+ 4))
  10 (defconstant +pi/8+ (/ +pi+ 8))
  11 (defconstant +pi/16+ (/ +pi+ 16))
  12 (defconstant +pi/32+ (/ +pi+ 32))
  13 (defconstant +pi/64+ (/ +pi+ 64))
  14 (defconstant +pi/128+ (/ +pi+ 128))
  15
  16 (defparameter *vertices-vbo* nil)
  17 (defparameter *colours-vbo* nil)
  18 (defparameter *normals-vbo* nil)
  19 (defparameter *triangle-indices-vbo* nil)
  20
  21 (defparameter *triangle-indices*  nil)
  22 (defparameter *colours-array*     nil)
  23 (defparameter *normals-array*     nil)
  24 (defparameter *vertices-array*    nil)
  25
  26
  27 (let ((segments 0)
  28       (slices 0)
  29       (step +pi/64+)) ;; change this to change the detail of the sphere
  30   (loop for phi from (- step +pi/2+) upto (- +pi/2+ step) by step
  31      for y from 0 do
  32      (incf slices)
  33      (loop for theta from 0.0 to +2pi+ by step
  34         for x from 0 do
  35         (setf segments x)
  36         (let* ((theta (+ theta (if (oddp y) (/ step 2) 0.0)))
  37                (v (list (* (cos phi) (cos theta))
  38                         (* (cos phi) (sin theta))
  39                         (sin phi)))
  40                (norm (sqrt (reduce #'+ (mapcar #'* v v))))
  41                (normal (mapcar #'(lambda (e) (/ e norm))
  42                                v)))
  43           (setf *colours-array*  (nconc *colours-array* (list (+ 0.5 (/ phi +pi+))
  44                                                               (/ theta +2pi+)
  45                                                               1.0 1.0)))
  46           (setf *normals-array*  (nconc *normals-array* normal))
  47           (setf *vertices-array* (nconc *vertices-array* v)))))
  48   (format t "~a slices~%~a segments~%" slices segments)
  49   (nconc *normals-array* (list 0.0 0.0 -1.0 0.0 0.0 1.0))
  50   (nconc *vertices-array* (list 0.0 0.0 -1.0 0.0 0.0 1.0))
  51   (nconc *colours-array* (list 0.0 0.5 1.0 1.0) (list 1.0 0.5 1.0 1.0))
  52   (setf *triangle-indices*
  53         (nconc
  54          (loop for x upto segments nconcing
  55               (list x
  56                     (- (/ (length *vertices-array*) 3) 2)
  57                     (mod (1+ x) segments)))
  58
  59          (loop for y below (1- slices) nconcing
  60               (loop for x below segments nconcing
  61                    (let ((v00 (+ x                     (* y (1+ segments))))
  62                          (v01 (+ (mod (1+ x) segments) (* y (1+ segments))))
  63                          (v10 (+ x                     (* (1+ y) (1+ segments))))
  64                          (v11 (+ (mod (1+ x) segments) (* (1+ y) (1+ segments)))))
  65                      (if (evenp y)
  66                          (list v00 v01 v10 v10 v01 v11)
  67                          (list v10 v00 v11 v00 v01 v11)))))
  68          (loop for x upto segments nconcing
  69               (list (- (/ (length *vertices-array*) 3) 1)
  70                     (+ x
  71                        (* (1- slices) (1+ segments)))
  72                     (+ (mod (1+ x) segments)
  73                        (* (1- slices) (1+ segments))))))))
  74
  75 (defparameter *triangle-indices-length* (length *triangle-indices*))
  76 (defparameter *vertices-array-length* (length *vertices-array*))
  77
  78 (defparameter *t0* 0.0d0)
  79 (defparameter *frames* 0)
  80
  81 (cffi:defcallback key-press :void ((key :int) (action :int))
  82   (when (and (= action glfw:+press+) (= key (char-code #\V)))
  83     (setf *use-vbo* (and (not *use-vbo*)
  84                          (gl-ext:extension-available-p "ARB_vertex_buffer_object"))
  85           *t0* (glfw:get-time)
  86           *frames* 0)
  87     (glfw:set-window-title (format nil "VBO: ~a~%" (if *use-vbo* "on" "off")))))
  88
  89
  90 (setf *triangle-indices* (cffi:foreign-alloc 'gl:uint :initial-contents *triangle-indices*)
  91       *colours-array*    (cffi:foreign-alloc 'gl:float :initial-contents *colours-array*)
  92       *normals-array*    (cffi:foreign-alloc 'gl:float :initial-contents *normals-array*)
  93       *vertices-array*   (cffi:foreign-alloc 'gl:float :initial-contents *vertices-array*))
  94
  95 (glfw:do-window ("A VBO Example" 0 0 0 0 0 0 16)
  96     ((gl:enable gl:+depth-test+)
  97      (gl:depth-func gl:+less+)
  98
  99      (glfw:set-key-callback (cffi:callback key-press))
 100
 101      (gl:with-setup-projection
 102        (glu:perspective 45.0d0 (/ 4.0d0 3.0d0) 0.125d0 8.0d0))
 103
 104      (when (setf *use-vbo* (and t (gl-ext:load-extension "ARB_vertex_buffer_object")))
 105        (let ((buffers (make-array 4)))
 106          (gl:gen-buffers-arb 4 buffers)
 107          (setf *vertices-vbo* (elt buffers 0)
 108                *normals-vbo* (elt buffers 1)
 109                *colours-vbo* (elt buffers 2)
 110                *triangle-indices-vbo* (elt buffers 3)))
 111        (gl:with-bind-buffer-arb (gl:+element-array-buffer-arb+ *triangle-indices-vbo*)
 112          (gl:buffer-data-arb gl:+element-array-buffer-arb+
 113                              (* *triangle-indices-length* (cffi:foreign-type-size 'gl:uint))
 114                              *triangle-indices*
 115                              gl:+static-draw-arb+))
 116
 117        (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *vertices-vbo*)
 118          (gl:buffer-data-arb gl:+array-buffer-arb+
 119                              (* *vertices-array-length* (cffi:foreign-type-size 'gl:float))
 120                              *vertices-array*
 121                              gl:+static-draw-arb+))
 122
 123        (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *normals-vbo*)
 124          (gl:buffer-data-arb gl:+array-buffer-arb+
 125                              (* *vertices-array-length* (cffi:foreign-type-size 'gl:float))
 126                              *normals-array*
 127                              gl:+static-draw-arb+))
 128
 129        (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *colours-vbo*)
 130          (gl:buffer-data-arb gl:+array-buffer-arb+
 131                              (* *vertices-array-length* 4/3 (cffi:foreign-type-size 'gl:float))
 132                              *colours-array*
 133                              gl:+dynamic-draw-arb+)))
 134      (setf *t0* (glfw:get-time)))
 135
 136   (let ((t1 (glfw:get-time)))
 137     (when (> (- t1 *t0*) 1.0)
 138       (glfw:set-window-title (format nil "~4f FPS, VBO: ~a~%" (/ *frames* (- t1 *t0*)) (if *use-vbo* "on" "off")))
 139       (setf *t0* t1
 140             *frames* 0)))
 141   (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
 142   (gl:load-identity)
 143   (gl:translate-f 0.0 0.0 -5.0)
 144   (gl:rotate-d (* 10.0d0 (glfw:get-time)) 1d0 1d0 0d0)
 145   (gl:rotate-d (* 90.0d0 (glfw:get-time)) 0d0 0d0 1d0)
 146   (gl:with-push-client-attrib (gl:+client-vertex-array-bit+)
 147     (gl:enable-client-state gl:+color-array+)
 148     (gl:enable-client-state gl:+vertex-array+)
 149     (gl:enable-client-state gl:+normal-array+)
 150     (if *use-vbo*
 151         (progn
 152           (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *colours-vbo*)
 153             (gl:color-pointer 4 gl:+float+ 0 (cffi:make-pointer 0)))
 154
 155           (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *normals-vbo*)
 156             (gl:normal-pointer gl:+float+ 0 (cffi:make-pointer 0)))
 157
 158           (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *vertices-vbo*)
 159             (gl:vertex-pointer 3 gl:+float+ 0 (cffi:make-pointer 0)))
 160
 161           (gl:with-bind-buffer-arb (gl:+element-array-buffer-arb+ *triangle-indices-vbo*)
 162             (gl:draw-elements gl:+triangles+ *triangle-indices-length* gl:+unsigned-int+ (cffi:make-pointer 0))))
 163         (progn
 164           (gl:color-pointer 4 gl:+float+ 0 *colours-array*)
 165           (gl:normal-pointer gl:+float+ 0 *normals-array*)
 166           (gl:vertex-pointer 3 gl:+float+ 0 *vertices-array*)
 167           (gl:draw-elements gl:+triangles+ *triangle-indices-length* gl:+unsigned-int+ *triangle-indices*))))
 168   (incf *frames*))