examples/vbo.lisp

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