From 34355949bd5c0babb21fc11c4168c56fef78d723 Mon Sep 17 00:00:00 2001 From: Dan Ballard Date: Tue, 5 Jul 2011 23:07:55 -0700 Subject: [PATCH] spinning circling diamond --- 3bb-1.lisp | 48 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 33 insertions(+), 15 deletions(-) diff --git a/3bb-1.lisp b/3bb-1.lisp index 152dbb3..967abf9 100644 --- a/3bb-1.lisp +++ b/3bb-1.lisp @@ -14,14 +14,23 @@ arr)) (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) - (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)))) +(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) + (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)) @@ -68,10 +77,10 @@ (incf (aref result x) (* (aref v y) (aref m x y))))) result)) -(defun translate-point (v1 v2) +(defun translate-point (v1 v2 &optional (fn #'+)) (let ((result (make-array 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)) @@ -91,9 +100,9 @@ ;; (list (/ (cos (+ theta time)) hyp) (/ (sin (+ theta time)) hyp) (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 - (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)) ; (cos-a (cos angle)) @@ -133,7 +142,7 @@ (gl:clear :color-buffer-bit) ;;; draw a triangle (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))) ;; finish the frame (gl:flush) @@ -151,17 +160,25 @@ (setf *last-time* time))) (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:load-identity) - (glu:perspective 45 ;; FOV + (glu:perspective 50; 45 ;; FOV 1.0 ;; aspect ratio(/ width (max height 1)) 1/10 ;; z near 100 ;; z far ) (gl:matrix-mode :modelview) - ;(gl:load-identity) - (glu:look-at 0 0 0 ;; eye + (gl:load-identity) + (glu:look-at 0 2 7 ;; eye 0 0 0 ;; center 0 1 0 ;; up in y pos ) @@ -181,6 +198,7 @@ (sdl:window 320 240 :flags sdl:sdl-opengl) ;; 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 + (reshape) (setf cl-opengl-bindings:*gl-get-proc-address* #'sdl-cffi::sdl-gl-get-proc-address) (sdl:with-events () (:quit-event () t)