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
)
7 (defparameter *use-vbo
* t
)
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))
19 (defparameter *vertices-vbo
* nil
)
20 (defparameter *colours-vbo
* nil
)
21 (defparameter *normals-vbo
* nil
)
22 (defparameter *triangle-indices-vbo
* nil
)
24 (defparameter *triangle-indices
* nil
)
25 (defparameter *colours-array
* nil
)
26 (defparameter *normals-array
* nil
)
27 (defparameter *vertices-array
* nil
)
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
36 (loop for theta from
0.0 to
+2pi
+ by step
39 (let* ((theta (+ theta
(if (oddp y
) (/ step
2) 0.0)))
40 (v (list (* (cos phi
) (cos theta
))
41 (* (cos phi
) (sin theta
))
43 (norm (sqrt (reduce #'+ (mapcar #'* v v
))))
44 (normal (mapcar #'(lambda (e) (/ e norm
))
46 (setf *colours-array
* (nconc *colours-array
* (list (+ 0.5 (/ phi
+pi
+))
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
*
57 (loop for x upto segments nconcing
59 (- (/ (length *vertices-array
*) 3) 2)
60 (mod (1+ x
) segments
)))
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
)))))
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)
74 (* (1- slices
) (1+ segments
)))
75 (+ (mod (1+ x
) segments
)
76 (* (1- slices
) (1+ segments
))))))))
78 (defparameter *triangle-indices-length
* (length *triangle-indices
*))
79 (defparameter *vertices-array-length
* (length *vertices-array
*))
81 (defparameter *t0
* 0.0)
82 (defparameter *frames
* 0)
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"))
90 (glfw:set-window-title
(format nil
"VBO: ~a~%" (if *use-vbo
* "on" "off")))))
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
*))
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
+)
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
+)
108 (glfw:set-key-callback
(cffi:callback key-press
))
110 (gl:with-setup-projection
111 (glu:perspective
45 4/3 0.125 8))
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
))
125 gl
:+static-draw-arb
+))
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
))
132 gl
:+static-draw-arb
+))
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
))
139 gl
:+static-draw-arb
+))
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
))
146 gl
:+static-draw-arb
+)))
147 (setf *t0
* (glfw:get-time
)))
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")))
154 (gl:clear
(logior gl
:+color-buffer-bit
+ gl
:+depth-buffer-bit
+))
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
+)
165 (gl:with-bind-buffer-arb
(gl:+array-buffer-arb
+ *colours-vbo
*)
166 (gl:color-pointer
4 gl
:+float
+ 0 (cffi:make-pointer
0)))
168 (gl:with-bind-buffer-arb
(gl:+array-buffer-arb
+ *normals-vbo
*)
169 (gl:normal-pointer gl
:+float
+ 0 (cffi:make-pointer
0)))
171 (gl:with-bind-buffer-arb
(gl:+array-buffer-arb
+ *vertices-vbo
*)
172 (gl:vertex-pointer
3 gl
:+float
+ 0 (cffi:make-pointer
0)))
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))))
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
*))))