Update of /project/gamelib/cvsroot/source In directory clnet:/tmp/cvs-serv16563
Modified Files: coords.lisp packages-3d.lisp shapes.lisp Log Message: Added 3D camera (with movement and turning).
Index: packages-3d.lisp =================================================================== RCS file: /project/gamelib/cvsroot/source/packages-3d.lisp,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** packages-3d.lisp 5 Sep 2006 06:04:32 -0000 1.4 --- packages-3d.lisp 10 Oct 2006 06:19:33 -0000 1.5 *************** *** 5,9 **** #:*score-table* #:+screen-side+ #:box #:camera #:camera-to-screen #:collide-p #:collide-action #:coord #:draw-all-shapes #:draw-grid ! #:draw-shape #:defvolume #:flat #:get-centre #:move #:octaeder #:score-from-object #:shape #:tetraeder #:tetragon --- 5,9 ---- #:*score-table* #:+screen-side+ #:box #:camera #:camera-to-screen #:collide-p #:collide-action #:coord #:draw-all-shapes #:draw-grid ! #:draw-shape #:defvolume #:flat #:full-move #:3d-camera #:get-centre #:move #:octaeder #:score-from-object #:shape #:tetraeder #:tetragon
Index: shapes.lisp =================================================================== RCS file: /project/gamelib/cvsroot/source/shapes.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** shapes.lisp 29 Sep 2006 06:30:38 -0000 1.6 --- shapes.lisp 10 Oct 2006 06:19:33 -0000 1.7 *************** *** 11,15 **** (defgeneric get-centre (shape &optional camera )) (defgeneric move (object &optional distance)) ! (defgeneric turn (object angle))
(defvar *skip-zapping-cam-state* nil) --- 11,16 ---- (defgeneric get-centre (shape &optional camera )) (defgeneric move (object &optional distance)) ! (defgeneric full-move (object displacement)) ! (defgeneric turn (object angle &optional axis))
(defvar *skip-zapping-cam-state* nil) *************** *** 50,60 **** (incf (y cam) (y move-to)) (incf (z cam) (z move-to))))) -
! (defmethod turn ((cam camera) angle) (let ((tmp (angle cam))) (declare (double-float tmp angle)) (setf (angle cam) (mod (+ angle tmp) (* pi 2.0d0)))))
(defmethod get-centre ((shape sphere) &optional camera) (update-cam-vertexes shape) --- 51,89 ---- (incf (y cam) (y move-to)) (incf (z cam) (z move-to)))))
! (defmethod full-move ((cam 3d-camera) displacement) ! (let ((move-to (vector (the-x displacement) ! (the-y displacement) ! (the-z displacement)))) ! (let ((move-to (base-transform move-to (transform cam) move-to))) ! (incf (x cam) (x move-to)) ! (incf (y cam) (y move-to)) ! (incf (z cam) (z move-to))))) ! ! (defmethod turn ((cam camera) angle &optional axis) ! (declare (ignore axis)) (let ((tmp (angle cam))) (declare (double-float tmp angle)) (setf (angle cam) (mod (+ angle tmp) (* pi 2.0d0)))))
+ (defmethod turn ((cam 3d-camera) angle &optional (axis :z)) + (multiple-value-bind (xbase ybase zbase) + (let ((angle-2 (+ angle (* 2.0d0 pi)))) + (case axis + (:z (values (vector (cos angle) (sin angle) 0.0d0) + (vector (cos angle-2) (sin angle-2) 0.0d0) + (vector 0.0d0 0.0d0 1.0d0))) + (:y (values (vector (cos angle-2) (sin angle-2) 0.0d0) + (vector 0.0d0 0.0d0 1.0d0) + (vector (cos angle) (sin angle) 0.0d0))) + (:x (values (vector 0.0d0 0.0d0 1.0d0) + (vector (cos angle) (sin angle) 0.0d0) + (vector (cos angle-2) (sin angle-2) 0.0d0))))) + (let ((invert (invert-transform (transform cam)))) + (let ((xb2 (base-transform xbase invert xbase)) + (yb2 (base-transform xbase invert ybase)) + (zb2 (base-transform xbase invert zbase))) + (setf (transform cam (build-transform (list xbase ybase zbase)))))))) + (defmethod get-centre ((shape sphere) &optional camera) (update-cam-vertexes shape)
Index: coords.lisp =================================================================== RCS file: /project/gamelib/cvsroot/source/coords.lisp,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** coords.lisp 29 Sep 2006 06:30:38 -0000 1.4 --- coords.lisp 10 Oct 2006 06:19:33 -0000 1.5 *************** *** 25,32 **** (defmethod x ((ar array)) (aref ar 0)) - (defmethod y ((ar array)) (aref ar 1)) - (defmethod z ((ar array)) (aref ar 2)) --- 25,30 ---- *************** *** 35,42 **** (defmethod (setf x) (new (ar array)) (setf (aref ar 0) new)) - (defmethod (setf y) (new (ar array)) (setf (aref ar 1) new)) - (defmethod (setf z) (new (ar array)) (setf (aref ar 2) new)) --- 33,38 ---- *************** *** 97,102 **** (setf ybase (base-transform (vector 0.0d0 1.0d0 0.0d0) transform ybase)) (setf zbase (base-transform (vector 0.0d0 0.0d0 1.0d0) transform zbase)) ! (build-transform (list xbase ybase zbase)))) !
(defmethod world-to-camera (w c &optional result) --- 93,97 ---- (setf ybase (base-transform (vector 0.0d0 1.0d0 0.0d0) transform ybase)) (setf zbase (base-transform (vector 0.0d0 0.0d0 1.0d0) transform zbase)) ! (build-transform (list xbase ybase zbase))))
(defmethod world-to-camera (w c &optional result)