[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