#| -*- Mode:LISP; Base:10.; Package:(VISTA-LIBRARY :use (LISP)); Syntax: Common-lisp; Readtable: CL; -*- |# ;;; Copyright (C) Lisp Machine, Inc. 1984, 1985, 1986 ;;; See filename "Copyright" for ;;; licensing and release information. (in-package 'vista-library :use '(lisp)) ;;;; Transformations for use by the Black&White device. ;;; 4x4 Matrix Transformations ;;; 01/06/86 MPG Written ;;; 02/12/86 EFH Rewrote polarview and view ;;; 04/17/86 EFH,PW Fixed polarview ;;; 04/17/86 PW Borrowed sind and cosd ;;; 04/18/86 EFH Changed get-sin,cos to sind,cosd; exported sind,cosd ;;; 04/23/86 EFH rewrote COMPUTE-VIEW ;;; 07/03/86 EFH common lisp sin only takes one arg ;;; There are older versions of this code ;;; plus some other stuff in 4TRANSFORMS.LISP (export '(COSD SIND)) #-lambda (defmacro short-float (n) `(coerce ,n 'short-float)) ;;; Borrowed from DJ:L.SYS2;NUMER.LISP (defun cosd (ang) "Cosine of an angle measured in degrees. Small flonum arg gets small flonum value." (sin (+ (* ang 0.0174532926) 1.570796326))) (defun sind (ang) "Sine of an angle measured in degrees. Small flonum arg gets small flonum value." (sin (* ang 0.0174532926))) ;(defmacro get-sin (angle) ; #+lispm `(zl:sind ,angle) ; #-lispm `(sin (* ,angle #,(short-float (/ (* 2 pi) 360.0))))) ;(defmacro get-cos (angle) ; #+lispm `(zl:cosd ,angle) ; #-lispm `(cos (* ,angle #,(short-float (/ (* 2 pi) 360.0))))) ;(defconstant *CONVERSION-FACTOR* (small-float (// (// hacks:2pi 4) 900))) ;from radians to tenths of degrees ;(defvar *COS-ARRAY* (make-array 3600. :element-type 'short-float) ; "Elements are cosd of angles in tenths of degrees") ;(defvar *SIN-ARRAY* (make-array 3600. :element-type 'short-float) ; "Elements are sind of angles in tenths of degrees") ; ;(defun INIT-COS-AND-SIN-ARRAYS () ; (do ((angle 0 (+ angle .1)) ; (array-slot 0 (1+ array-slot))) ; ((= array-slot 3600)) ; (setf (aref *cos-array* array-slot) (short-float (cosd angle))) ; (setf (aref *sin-array* array-slot) (short-float (sind angle))))) ;(init-cos-and-sin-arrays) ; ;(defmacro get-sin (angle) ; (aref *sin-array* (mod (round (* 10.0s0 ,angle)) 3600.))) ; ;(defmacro get-cos (angle) ; (aref *cos-array* (mod (round (* 10.0s0 ,angle)) 3600.))) ;;; Here's an example of the macro MATRIX-TRANSFORM ;;; The result of MATRIX-TRANSFORM is stored in ;;; MATRIX ;;; ;;; ;;;(MATRIX-TRANSFORM 1 0 0 0 ;;; 0 cos sin 0 ;;; 0 -sin cos 0 ;;; 0 0 0 1 ;;; MATRIX) ;;; (defun COMPUTE-TRANSLATION (x y z matrix) (matrix-transform 1 0 0 0 0 1 0 0 0 0 1 0 x y z 1 matrix)) (defun COMPUTE-SCALE (sx sy sz matrix) (matrix-transform sx 0 0 0 0 sy 0 0 0 0 sz 0 0 0 0 1 matrix)) (defun COMPUTE-X-ROTATION (angle matrix) (let* ((sin (sind angle)) (cos (cosd angle)) (-sin (- sin))) (matrix-transform 1 0 0 0 0 cos sin 0 0 -sin cos 0 0 0 0 1 matrix))) (defun COMPUTE-Y-ROTATION (angle matrix) (let* ((sin (sind angle)) (cos (cosd angle)) (-sin (- sin))) (matrix-transform cos 0 -sin 0 0 1 0 0 sin 0 cos 0 0 0 0 1 matrix))) (defun COMPUTE-Z-ROTATION (angle matrix) (let* ((sin (sind angle) ) (cos (cosd angle)) (-sin (- sin))) (matrix-transform cos sin 0 0 -sin cos 0 0 0 0 1 0 0 0 0 1 matrix))) ;;; The following four functions load projection transformation ;;; values into the current matrix. (defun COMPUTE-PERSPECTIVE (field-of-view-angle aspect-ratio near far matrix) (let* ((angle (/ field-of-view-angle 2)) (cotan (short-float (/ (cosd angle) (sind angle)))) (distance (short-float (- far near)))) (fill-transform matrix (/ cotan aspect-ratio) 0 0 0 0 cotan 0 0 0 0 (- (/ (+ far near) distance)) -1 0 0 (- (/ (* 2 far near) distance)) 0))) (defun COMPUTE-FRUSTUM (left right bottom top near far matrix) (let ((width (short-float (- right left))) (height (short-float (- top bottom))) (nearx2 (* near 2.0s0)) (distance (short-float (- far near)))) (fill-transform matrix (/ nearx2 width) 0 0 0 0 (/ nearx2 height) 0 0 (/ (+ right left) width) (/ (+ top bottom) height) (- (/ (+ far near) distance)) -1 0 0 (- (/ (* nearx2 far) distance)) 0))) (defun COMPUTE-ORTHO (left right bottom top near far matrix) (let ((width (short-float (- right left))) (height (short-float (- top bottom))) (distance (short-float (- far near)))) (fill-transform matrix (/ 2 width) 0 0 0 0 (/ 2 height) 0 0 0 0 (- (/ 2 distance)) 0 (- (/ (short-float (+ right left)) width)) (- (/ (short-float (+ top bottom)) height)) (- (/ (short-float (+ far near)) distance)) 1))) (defun COMPUTE-ORTHO2 (left right bottom top matrix) (let ((width (short-float (- right left))) (height (short-float (- top bottom)))) (fill-transform matrix (/ 2 width) 0 0 0 0 (/ 2 height) 0 0 0 0 -1 0 ;why invert z? (- (/ (+ right left) width)) (- (/ (+ top bottom) height)) 0 1))) ;;; These two functions perform viewing transformations ;;; on the current matrix. ;;; Polar-view is (* (Rotz (-azimuth)) ;;; (Rotx (-inclination)) ;;; (Rotz (- twist)) ;;; (Trans 0 0 (- dist))) ;;; (defun COMPUTE-POLAR-VIEW (distance azimuth inclination twist matrix) (let* ((-dist (- distance)) (cos.-azim (cosd azimuth)) (sin.azim (sind azimuth)) (sin.-azim (- sin.azim)) (cos.-inc (cosd inclination)) (sin.inc (sind inclination)) (sin.-inc (- sin.inc)) (cos.-twist (cosd twist)) (sin.twist (sind twist)) (sin.-twist (- sin.twist)) (cos.-azim*cos.-inc (* cos.-azim cos.-inc)) (sin.-azim*cos.-inc (* sin.-azim cos.-inc))) (matrix-transform (+ (* cos.-azim cos.-twist) (* sin.-azim*cos.-inc sin.twist)) (+ (* cos.-azim sin.-twist) (* sin.-azim*cos.-inc cos.-twist)) (* sin.-azim sin.-inc) 0 (+ (* sin.azim cos.-twist) (* cos.-azim*cos.-inc sin.twist)) (+ (* sin.azim sin.-twist) (* cos.-azim*cos.-inc cos.-twist)) (* cos.-azim sin.-inc) 0 (* sin.inc sin.twist) (* sin.inc cos.-twist) cos.-inc 0 0 0 -dist 1 matrix))) ;;; View is (* (trans (- vx) (- vy) (- vz)) ;;; (roty theta) ;;; (rotx phi) ;;; (rotz twist)) ;;; ;;; Where (sin theta) = (/ (- vx px) ;;; (sqrt (+ (^ (- px vx) 2) ;;; (^ (- pz vz) 2)))) ;;; ;;; (cos theta) = (/ (- vz pz) ;;; (sqrt (+ (^ (- px vx) 2) ;;; (^ (- pz vz) 2)))) ;;; ;;; (sin phi) = (/ (- vy py) ;;; (sqrt (+ (^ (- px vx) 2) ;;; (^ (- py vy) 2) ;;; (^ (- pz vz) 2)))) ;;; ;;; (cos phi) = (/ (sqrt (+ (^ (- px vx) 2) ;;; (^ (- pz vz) 2))) ;;; (sqrt (+ (^ (- px vx) 2) ;;; (^ (- py vy) 2) ;;; (^ (- pz vz) 2)))) ;;; (defun COMPUTE-VIEW (vx vy vz px py pz twist matrix) (let* ((-vx (- vx)) (-vy (- vy)) (-vz (- vz)) (-dx (- vx px)) (-dy (- vy py)) (-dz (- vz pz)) (dx2 (* -dx -dx)) (dy2 (* -dy -dy)) (dz2 (* -dz -dz)) (dx2+dz2 (+ dx2 dz2)) (dx2+dy2+dz2 (+ dx2+dz2 dy2)) (sqrt-dx2+dz2 (sqrt dx2+dz2)) (sqrt-dx2+dy2+dz2 (sqrt dx2+dy2+dz2)) (sin.theta (/ -dx sqrt-dx2+dz2)) (-sin.theta (- sin.theta)) (cos.theta (/ -dz sqrt-dx2+dz2)) (sin.phi (/ -dy sqrt-dx2+dy2+dz2)) (-sin.phi (- sin.phi)) (cos.phi (/ sqrt-dx2+dz2 sqrt-dx2+dy2+dz2)) (cos.-twist (cosd twist)) (-sin.-twist (sind twist)) (sin.-twist (- -sin.-twist)) (-sin.theta*cos.phi (* -sin.theta cos.phi)) (cos.theta*cos.phi (* cos.theta cos.phi)) (cos.phi*-sin.-twist (* cos.phi -sin.-twist)) (cos.phi*cos.-twist (* cos.phi cos.-twist)) (-sin.phi*-sin.-twist (* -sin.phi -sin.-twist)) (-sin.phi*cos.-twist (* -sin.phi cos.-twist)) (cos.theta*cos.-twist+-sin.theta*-sin.phi*-sin.-twist (+ (* cos.theta cos.-twist) (* -sin.theta -sin.phi*-sin.-twist))) (cos.theta*sin.-twist+-sin.theta*-sin.phi*cos.-twist (+ (* cos.theta sin.-twist) (* -sin.theta -sin.phi*cos.-twist))) (sin.theta*cos.-twist+cos.theta*-sin.phi*-sin.-twist (+ (* sin.theta cos.-twist) (* cos.theta -sin.phi*-sin.-twist))) (sin.theta*sin.-twist+cos.theta*-sin.phi*cos.-twist (+ (* sin.theta sin.-twist) (* cos.theta -sin.phi*cos.-twist)))) (matrix-transform cos.theta*cos.-twist+-sin.theta*-sin.phi*-sin.-twist cos.theta*sin.-twist+-sin.theta*-sin.phi*cos.-twist -sin.theta*cos.phi 0 cos.phi*-sin.-twist cos.phi*cos.-twist sin.phi 0 sin.theta*cos.-twist+cos.theta*-sin.phi*-sin.-twist sin.theta*sin.-twist+cos.theta*-sin.phi*cos.-twist cos.theta*cos.phi 0 (+ (* -vx cos.theta*cos.-twist+-sin.theta*-sin.phi*-sin.-twist) (* -vy cos.phi*-sin.-twist) (* -vz sin.theta*cos.-twist+cos.theta*-sin.phi*-sin.-twist)) (+ (* -vx cos.theta*sin.-twist+-sin.theta*-sin.phi*cos.-twist) (* -vy cos.phi*cos.-twist) (* -vz sin.theta*sin.-twist+cos.theta*-sin.phi*cos.-twist)) (+ (* -vx -sin.theta*cos.phi) (* -vy sin.phi) (* -vz cos.theta*cos.phi)) 1 matrix))) ;;; this is the old one ; (sin.phi*sin.-twist (* sin.phi sin.-twist)) ; (sin.phi*cos.-twist (* sin.phi cos.-twist))) ; (matrix-transform ; (+ (* cos.theta cos.-twist) (* sin.theta sin.phi*sin.-twist)) ; (* cos.phi sin.-twist) ; (+ (* -sin.theta cos.-twist) (* cos.theta sin.phi*sin.-twist)) ; 0 ; (+ (* cos.theta -sin.-twist) (* sin.theta sin.phi*cos.-twist)) ; (* cos.phi cos.-twist) ; (+ (* -sin.theta -sin.-twist) (* cos.theta sin.phi*cos.-twist)) ; 0 ; (* sin.theta cos.phi) ; -sin.phi ; (* cos.theta cos.phi) ; 0 ; (- vx) ; (- vy) ; (- vz) ; 1 ; matrix)))