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
)
6 (defparameter *use-vbo
* t
)
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))
18 (defparameter *vertices-vbo
* nil
)
19 (defparameter *colours-vbo
* nil
)
20 (defparameter *normals-vbo
* nil
)
21 (defparameter *triangle-indices-vbo
* nil
)
23 (defparameter *triangle-indices
* nil
)
24 (defparameter *colours-array
* nil
)
25 (defparameter *normals-array
* nil
)
26 (defparameter *vertices-array
* nil
)
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
35 (loop for theta from
0.0 to
+2pi
+ by step
38 (let* ((theta (+ theta
(if (oddp y
) (/ step
2) 0.0)))
39 (v (list (* (cos phi
) (cos theta
))
40 (* (cos phi
) (sin theta
))
42 (norm (sqrt (reduce #'+ (mapcar #'* v v
))))
43 (normal (mapcar #'(lambda (e) (/ e norm
))
45 (setf *colours-array
* (nconc *colours-array
* (list (+ 0.5 (/ phi
+pi
+))
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
*
56 (loop for x upto segments nconcing
58 (- (/ (length *vertices-array
*) 3) 2)
59 (mod (1+ x
) segments
)))
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
)))))
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)
73 (* (1- slices
) (1+ segments
)))
74 (+ (mod (1+ x
) segments
)
75 (* (1- slices
) (1+ segments
))))))))
77 (defparameter *triangle-indices-length
* (length *triangle-indices
*))
78 (defparameter *vertices-array-length
* (length *vertices-array
*))
80 (defparameter *t0
* 0.0)
81 (defparameter *frames
* 0)
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"))
89 (glfw:set-window-title
(format nil
"VBO: ~a~%" (if *use-vbo
* "on" "off")))))
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
*))
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
+)
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
+)
107 (glfw:set-key-callback
(cffi:callback key-press
))
109 (gl:with-setup-projection
110 (glu:perspective
45 4/3 0.125 8))
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
))
124 gl
:+static-draw-arb
+))
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
))
131 gl
:+static-draw-arb
+))
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
))
138 gl
:+static-draw-arb
+))
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
))
145 gl
:+static-draw-arb
+)))
146 (setf *t0
* (glfw:get-time
)))
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")))
153 (gl:clear
(logior gl
:+color-buffer-bit
+ gl
:+depth-buffer-bit
+))
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
+)
164 (gl:with-bind-buffer-arb
(gl:+array-buffer-arb
+ *colours-vbo
*)
165 (gl:color-pointer
4 gl
:+float
+ 0 (cffi:make-pointer
0)))
167 (gl:with-bind-buffer-arb
(gl:+array-buffer-arb
+ *normals-vbo
*)
168 (gl:normal-pointer gl
:+float
+ 0 (cffi:make-pointer
0)))
170 (gl:with-bind-buffer-arb
(gl:+array-buffer-arb
+ *vertices-vbo
*)
171 (gl:vertex-pointer
3 gl
:+float
+ 0 (cffi:make-pointer
0)))
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))))
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
*))))