Reworked gen 3pyramid code some

This commit is contained in:
Dan Ballard 2012-06-09 17:17:31 -07:00
parent 4ed65a3376
commit f2e62f3fe8
2 changed files with 9 additions and 6 deletions

View File

@ -76,8 +76,6 @@
(accel-vec (scale-vector (scale-vector-1 (direction (force src))) (- accel)))) (accel-vec (scale-vector (scale-vector-1 (direction (force src))) (- accel))))
accel-vec)) accel-vec))
(defparameter *rear-thruster-vertices* (defparameter *rear-thruster-vertices*
(make-thruster-vertices (make-thruster-vertices

View File

@ -57,6 +57,9 @@
(defparameter *3pyramid-points* (defparameter *3pyramid-points*
'((0.0 0.5 -0.5) (-0.5 -0.5 -0.5) (0.5 -0.5 -0.5) (0.0 0.0 0.5))) '((0.0 0.5 -0.5) (-0.5 -0.5 -0.5) (0.5 -0.5 -0.5) (0.0 0.0 0.5)))
(defparameter *3pyramid-flat-points*
'((0.0 0.5 -0.5) (-0.5 -0.5 -0.5) (0.5 -0.5 -0.5) (0.0 -0.5 0.5)))
(defparameter *colors* (make-hash-table :test 'equal)) (defparameter *colors* (make-hash-table :test 'equal))
(setf (gethash "red" *colors*) '(255 0 0)) (setf (gethash "red" *colors*) '(255 0 0))
(setf (gethash "darkred" *colors*) '(139 0 0)) (setf (gethash "darkred" *colors*) '(139 0 0))
@ -89,14 +92,16 @@
;; returns a model of a 3 pyramid from points and colors ;; returns a model of a 3 pyramid from points and colors
(defun make-model-3pyramid (points &key (face-colors nil) (point-colors nil)) (defun make-model-3pyramid (points &key (face-colors nil) (point-colors nil))
(make-instance 'model (make-instance 'model
:vertices points :vertices (if (listp points) (make-2d-array 4 3 points) points)
:faces (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3))) :faces (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3)))
:colors (if face-colors face-colors point-colors) :colors (if face-colors
(if (listp face-colors) (make-2d-array 4 3 face-colors) face-colors)
(if (listp point-colors) (make-2d-array 4 3 point-colors) point-colors))
:face-colors (if face-colors :face-colors (if face-colors
(make-2d-array 4 3 '((0 0 0) (1 1 1) (2 2 2) (3 3 3))) (make-2d-array 4 3 '((0 0 0) (1 1 1) (2 2 2) (3 3 3)))
(make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3)))))) (make-2d-array 4 3 '((0 1 3) (0 2 1) (0 3 2) (1 2 3))))))
(defparameter *ship-model* (defparameter *ship-model*
(make-model-3pyramid (make-2d-array 4 3 '((0.0 -0.5 -1.5) (0.0 0.5 1.5) (-2.0 -0.5 1.5) (2.0 -0.5 1.5))) (make-model-3pyramid '((0.0 -0.5 -1.5) (0.0 0.5 1.5) (-2.0 -0.5 1.5) (2.0 -0.5 1.5))
:face-colors (make-2d-array 4 3 '((196 196 196) (196 196 196) (196 196 196) (32 32 32))))) :face-colors '((196 196 196) (196 196 196) (196 196 196) (32 32 32))))