dan
/
cl-opengl-tests
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

spinning circling diamond

This commit is contained in:
Dan Ballard 2011-07-05 23:07:55 -07:00
parent 30663610d4
commit 34355949bd
1 changed files with 33 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
3bb-1.lisp
View File

@ -14,14 +14,23 @@
arr)) arr))
(defparameter *n* (make-array 3 :initial-contents '(0 0 1))) (defparameter *n* (make-array 3 :initial-contents '(0 0 1)))
(defparameter *v* (make-2d-array 12 3 '((0.0 1 0) (0.5 0 0.5) (-0.5 0 0.5) (defparameter *v* (make-2d-array 24 3 '(
(0.0 1 0) (0.5 0 -0.5) (-0.5 0 -0.5) (0.0 1 0) (-0.5 0 0.5) (0.5 0 0.5)
(0.0 1 0) (0.5 0 0.5) (0.5 0 -0.5) (0.0 1 0) (0.5 0 -0.5) (-0.5 0 -0.5)
(0.0 1 0) (-0.5 0 0.5) (-0.5 0 -0.5) (0.0 1 0) (0.5 0 0.5) (0.5 0 -0.5)
))) (0.0 1 0) (-0.5 0 -0.5) (-0.5 0 0.5)
(defparameter *faces* (make-2d-array 2 3 '((0 1 2) (3 4 5) (6 7 8) (9 10 11))))
(0.0 -1 0) (-0.5 0 0.5) (0.5 0 0.5)
(0.0 -1 0) (0.5 0 -0.5) (-0.5 0 -0.5)
(0.0 -1 0) (0.5 0 0.5) (0.5 0 -0.5)
(0.0 -1 0) (-0.5 0 -0.5) (-0.5 0 0.5)
(defparameter *position* (make-array 3 :initial-contents '(0 0 1))) )))
(defparameter *faces* (make-2d-array 8 3 '((0 1 2) (3 4 5) (6 7 8) (9 10 11)
(13 12 14) (16 15 17) (19 18 20) (22 21 23))))
(defparameter *position* (make-array 3 :initial-contents
'(0 0 -3)))
(defparameter *start-time* (wall-time)) (defparameter *start-time* (wall-time))
@ -68,10 +77,10 @@
(incf (aref result x) (* (aref v y) (aref m x y))))) (incf (aref result x) (* (aref v y) (aref m x y)))))
result)) result))
(defun translate-point (v1 v2) (defun translate-point (v1 v2 &optional (fn #'+))
(let ((result (make-array 3))) (let ((result (make-array 3)))
(dotimes (i 3) (dotimes (i 3)
(setf (aref result i) (+ (aref v1 i) (aref v2 i)))) (setf (aref result i) (funcall fn (aref v1 i) (aref v2 i))))
result)) result))
@ -91,9 +100,9 @@
;; (list (/ (cos (+ theta time)) hyp) (/ (sin (+ theta time)) hyp) (third v)))) ;; (list (/ (cos (+ theta time)) hyp) (/ (sin (+ theta time)) hyp) (third v))))
; (list (+ (first v) (/ (sin time) 2)) (+ (second v) (/ (cos time) 2)) (third v))) ; (list (+ (first v) (/ (sin time) 2)) (+ (second v) (/ (cos time) 2)) (third v)))
(defun rotate-triangle (tri time) (defun rotate-triangle (tri m)
(make-array (length tri) :initial-contents (make-array (length tri) :initial-contents
(loop for v across tri collecting (rotate* (make-rotation-matrix 0 time 0) v)))) (loop for v across tri collecting (rotate* m v))))
; (let* ((angle (/ time 1000)) ; (let* ((angle (/ time 1000))
; (cos-a (cos angle)) ; (cos-a (cos angle))
@ -133,7 +142,7 @@
(gl:clear :color-buffer-bit) (gl:clear :color-buffer-bit)
;;; draw a triangle ;;; draw a triangle
(loop for face-list across *faces* do (loop for face-list across *faces* do
(let ((rt (translate-triangle (rotate-triangle (get-vertecies face-list) time) *position*))) (let ((rt (translate-triangle (rotate-triangle (get-vertecies face-list) (make-rotation-matrix 0 (* 2 time) 0)) (rotate* (make-rotation-matrix 0 time 0) *position*))))
(draw-triangle rt time))) (draw-triangle rt time)))
;; finish the frame ;; finish the frame
(gl:flush) (gl:flush)
@ -151,17 +160,25 @@
(setf *last-time* time))) (setf *last-time* time)))
(defun reshape () (defun reshape ()
(gl:shade-model :smooth)
(gl:clear-color 0 0 0 0)
(gl:clear-depth 1)
; (gl:enable :depth-test)
; (gl:depth-func :lequal)
(gl:enable :cull-face)
(gl:hint :perspective-correction-hint :nicest)
(gl:matrix-mode :projection) (gl:matrix-mode :projection)
(gl:load-identity) (gl:load-identity)
(glu:perspective 45 ;; FOV (glu:perspective 50; 45 ;; FOV
1.0 ;; aspect ratio(/ width (max height 1)) 1.0 ;; aspect ratio(/ width (max height 1))
1/10 ;; z near 1/10 ;; z near
100 ;; z far 100 ;; z far
) )
(gl:matrix-mode :modelview) (gl:matrix-mode :modelview)
;(gl:load-identity) (gl:load-identity)
(glu:look-at 0 0 0 ;; eye (glu:look-at 0 2 7 ;; eye
0 0 0 ;; center 0 0 0 ;; center
0 1 0 ;; up in y pos 0 1 0 ;; up in y pos
) )
@ -181,6 +198,7 @@
(sdl:window 320 240 :flags sdl:sdl-opengl) (sdl:window 320 240 :flags sdl:sdl-opengl)
;; cl-opengl needs platform specific support to be able to load GL ;; cl-opengl needs platform specific support to be able to load GL
;; extensions, so we need to tell it how to do so in lispbuilder-sdl ;; extensions, so we need to tell it how to do so in lispbuilder-sdl
(reshape)
(setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address) (setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address)
(sdl:with-events () (sdl:with-events ()
(:quit-event () t) (:quit-event () t)