examples/vbo.lisp

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