[gamelib-cvs] coords.lisp
Ingvar Mattsson
imattsson at common-lisp.net
Tue Oct 10 06:19:35 UTC 2006
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)
More information about the Gamelib-cvs
mailing list