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.0)
  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      (gl:enable gl:+light0+)
  99      (gl:enable gl:+lighting+)
 100
 101      (gl:light-fv gl:+light0+ gl:+position+ #(1.0 1.0 1.0 0.0))
 102      (gl:color-material gl:+front+ gl:+ambient-and-diffuse+)
 103      (gl:enable gl:+color-material+)
 104
 105      (glfw:set-key-callback (cffi:callback key-press))
 106
 107      (gl:with-setup-projection
 108        (glu:perspective 45 4/3 0.125 8))
 109
 110      (when (setf *use-vbo* (and t (gl-ext:load-extension "ARB_vertex_buffer_object")))
 111        (let ((buffers (make-array 4)))
 112          (gl:gen-buffers-arb 4 buffers)
 113          (setf *vertices-vbo* (elt buffers 0)
 114                *normals-vbo* (elt buffers 1)
 115                *colours-vbo* (elt buffers 2)
 116                *triangle-indices-vbo* (elt buffers 3)))
 117        (format t "Loading in ~d bytes of indices~%" (* *triangle-indices-length* (cffi:foreign-type-size 'gl:uint)) )
 118        (gl:with-bind-buffer-arb (gl:+element-array-buffer-arb+ *triangle-indices-vbo*)
 119          (gl:buffer-data-arb gl:+element-array-buffer-arb+
 120                              (* *triangle-indices-length* (cffi:foreign-type-size 'gl:uint))
 121                              *triangle-indices*
 122                              gl:+static-draw-arb+))
 123
 124        (format t "Loading in ~d bytes of vertices~%" (* *vertices-array-length* (cffi:foreign-type-size 'gl:float)) )
 125        (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *vertices-vbo*)
 126          (gl:buffer-data-arb gl:+array-buffer-arb+
 127                              (* *vertices-array-length* (cffi:foreign-type-size 'gl:float))
 128                              *vertices-array*
 129                              gl:+static-draw-arb+))
 130
 131        (format t "Loading in ~d bytes of normals~%" (* *vertices-array-length* (cffi:foreign-type-size 'gl:float)) )
 132        (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *normals-vbo*)
 133          (gl:buffer-data-arb gl:+array-buffer-arb+
 134                              (* *vertices-array-length* (cffi:foreign-type-size 'gl:float))
 135                              *normals-array*
 136                              gl:+static-draw-arb+))
 137
 138        (format t "Loading in ~d bytes of colours~%" (* *vertices-array-length* 4/3 (cffi:foreign-type-size 'gl:float)) )
 139        (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *colours-vbo*)
 140          (gl:buffer-data-arb gl:+array-buffer-arb+
 141                              (* *vertices-array-length* 4/3 (cffi:foreign-type-size 'gl:float))
 142                              *colours-array*
 143                              gl:+static-draw-arb+)))
 144      (setf *t0* (glfw:get-time)))
 145
 146   (let ((t1 (glfw:get-time)))
 147     (when (> (- t1 *t0*) 1)
 148       (glfw:set-window-title (format nil "~4f FPS, VBO: ~a~%" (/ *frames* (- t1 *t0*)) (if *use-vbo* "on" "off")))
 149       (setf *t0* t1
 150             *frames* 0)))
 151   (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
 152   (gl:load-identity)
 153   (gl:translate-f 0 0 -5)
 154   (gl:rotate-d (* 10 (glfw:get-time)) 1 1 0)
 155   (gl:rotate-d (* 90 (glfw:get-time)) 0 0 1)
 156   (gl:with-push-client-attrib (gl:+client-vertex-array-bit+)
 157     (gl:enable-client-state gl:+color-array+)
 158     (gl:enable-client-state gl:+vertex-array+)
 159     (gl:enable-client-state gl:+normal-array+)
 160     (if *use-vbo*
 161         (progn
 162           (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *colours-vbo*)
 163             (gl:color-pointer 4 gl:+float+ 0 (cffi:make-pointer 0)))
 164
 165           (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *normals-vbo*)
 166             (gl:normal-pointer gl:+float+ 0 (cffi:make-pointer 0)))
 167
 168           (gl:with-bind-buffer-arb (gl:+array-buffer-arb+ *vertices-vbo*)
 169             (gl:vertex-pointer 3 gl:+float+ 0 (cffi:make-pointer 0)))
 170
 171           (gl:with-bind-buffer-arb (gl:+element-array-buffer-arb+ *triangle-indices-vbo*)
 172             (gl:draw-elements gl:+triangles+ *triangle-indices-length* gl:+unsigned-int+ (cffi:make-pointer 0))))
 173         (progn
 174           (gl:color-pointer 4 gl:+float+ 0 *colours-array*)
 175           (gl:normal-pointer gl:+float+ 0 *normals-array*)
 176           (gl:vertex-pointer 3 gl:+float+ 0 *vertices-array*)
 177           (gl:draw-elements gl:+triangles+ *triangle-indices-length* gl:+unsigned-int+ *triangle-indices*))))
 178   (incf *frames*))