;;;-*-Lisp-*-

; (c) Copyright 1976, 1983 Massachusetts Institute of Technology. 
; All Rights Reserved. Enhancements (c) Copyright 1983 Symbolics Inc.
; All Rights Reserved. 
; 
;  The data and information in the Enhancements is proprietary to, and a
; valuable trade secret of, SYMBOLICS, INC., a Delaware corporation. It is
; given in confidence by SYMBOLICS, and may not be used as the basis of
; manufacture, or be reproduced or copied, or distributed to any other
; party, in whole or in part, without the prior written consent of SYMBOLICS.



;;;transformation funtions

(declare (special logbas cosang sinang)
	 (flonum xf yf logbas
		 ($clog flonum) ($polarx flonum flonum) ($polary flonum flonum)
		 ($reflect flonum) ($ytox flonum flonum) ($xtoy flonum flonum)
		 ($ztox flonum flonum flonum) ($ztoy flonum flonum flonum)
		 ang cosang sinang
		 ($rotatex flonum flonum) ($rotatey flonum flonum))
	 (notype ($initrotate flonum)))

(setq logbas (log 10.0))

(defun $clog (xf) (//$ (cond ((= 0.0 xf) -90.0) (t (log (abs xf)))) logbas))

(defun $polarx (xf yf) (*$ yf (cos xf)))

(defun $polary (xf yf) (*$ yf (sin xf)))

(defun $reflect (xf) (-$ xf))

(defun $ytox (xf yf) yf)

(defun $xtoy (xf yf) xf)

(defun $ztoy (xf yf zf) zf)

(defun $ztox (xf yf zf) zf)

(declare (special cosang sinang))

(defun $initrotate (ang) (setq cosang (cos ang) sinang (sin ang)) nil)

($initrotate (atan 1. 0.))

(defun $rotatex (xf yf) (-$ (*$ xf cosang) (*$ yf sinang)))

(defun $rotatey (xf yf) (+$ (*$ xf sinang) (*$ yf cosang)))

(declare (special ex ey ez cosal cosbe cosga singa2 x0 z0)
	 (flonum ax ay az ex ey ez dx dy dz d cosal cosbe cosga r singa2 x0 z0)
	 (flonum ($p3dx flonum flonum flonum) ($p3dy flonum flonum flonum)
		 ($p3dxr flonum flonum flonum) ($p3dyr flonum flonum flonum)
		 ($howclose3d flonum flonum flonum)
		 ($np3dx flonum flonum) ($np3dy flonum flonum flonum)
		 ($np3dxr flonum flonum) ($np3dyr flonum flonum flonum)
		 ($howclosenp3d flonum flonum flonum)
		 ($old3dx flonum flonum) ($old3dy flonum flonum flonum)
		 ($old3dxr flonum flonum) ($old3dyr flonum flonum flonum)
		 ($howcloseold3d flonum flonum flonum)
		 ($oldnp3dx flonum flonum) ($oldnp3dy flonum flonum flonum)
		 ($oldnp3dxr flonum flonum) ($oldnp3dyr flonum flonum flonum)
		 ($howcloseoldnp3d flonum flonum flonum))
	 (notype ($initperspec flonum flonum flonum flonum flonum flonum)))

(defun $initperspec (xf yf zf xf1 yf1 zf1)
       ((lambda (ax ay az dx dy dz d r)
		(setq ax xf ay yf az zf ex xf1 ey yf1 ez zf1
		      dx (-$ xf xf1) dy (-$ yf yf1) dz (-$ zf zf1)
		      d (sqrt (+$ (*$ dx dx) (*$ dy dy) (*$ dz dz)))
		      cosal (//$ dx d) cosbe (//$ dy d) cosga (//$ dz d)
		      singa2 (-$ 1.0 (*$ cosga cosga))
		      x0 (//$ ex ey) z0 (//$ ez ey)
		      r (//$ (sqrt (-$ 1.0 (*$ cosga cosga)))))
		nil)
	0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))

(comment 
(defun $p3dx (xf yf zf)
       ((lambda (q)
		(*$ (-$ (*$ (+$ ex (*$ q (-$ xf ex)) (-$ ax)) cosbe)
			(*$ (+$ ey (*$ q (-$ yf ey)) (-$ ay)) cosal))
		    r))
	(//$ d (+$ (*$ (-$ xf ex) cosal) (*$ (-$ yf ey) cosbe) (*$ (-$ zf ez) cosga)))))

(defun $p3dy (xf yf zf)
       ((lambda (q)
		(*$ (+$ ez (*$ q (-$ zf ez)) (-$ az)) r))
	(//$ d (+$ (*$ (-$ xf ex) cosal) (*$ (-$ yf ey) cosbe) (*$ (-$ zf ez) cosga)))))
)

(defun $p3dx (xf yf zf)
       (setq xf (-$ xf ex) yf (-$ yf ey))
       (//$ (-$ (*$ xf cosbe) (*$ yf cosal))
	    (+$ (*$ xf cosal) (*$ yf cosbe) (*$ (-$ zf ez) cosga))))
(defun $p3dy (xf yf zf)
       (setq zf (-$ zf ez))
       (//$ zf (+$ (*$ (-$ xf ex) cosal) (*$ (-$ yf ey) cosbe) (*$ zf cosga))))
(defun $p3dxr (xf yf zf) (-$ ($p3dx xf yf zf)))
#-franz (putprop '$p3dyr (get '$p3dy 'subr) 'subr)
#-franz (args '$p3dyr (args '$p3dy))
#+franz (putd '$p3dr (getd '$p3d))

(defun $howclose3d (xf yf zf)
       (setq xf (-$ xf ex) yf (-$ yf ey) zf (-$ zf ez))
       (sqrt (+$ (*$ xf xf) (*$ yf yf) (*$ zf zf))))

(defun $np3dx (xf yf) (-$ (*$ cosbe xf) (*$ cosal yf)))
(defun $np3dy (xf yf zf)
       (-$ (*$ singa2 zf) (*$ cosga (+$ (*$ cosbe yf) (*$ cosal xf)))))
(defun $np3dxr (xf yf) (-$ ($np3dx xf yf)))
#-franz (putprop '$np3dyr (get '$np3dy 'subr) 'subr)
#-franz (args '$np3dyr (args '$np3dy))
#+franz (putd '$np3dyr (getd '$np3dy))

(defun $howclosenp3d (xf yf zf) (+$ (*$ xf cosal) (*$ yf cosbe) (*$ zf cosga)))

(defun $old3dx (xf yf) (//$ (-$ xf ex) (-$ yf ey)))
(defun $old3dy (xf yf zf) (//$ (-$ zf ez) cosbe (-$ yf ey)))
(defun $old3dxr (xf yf) (-$ ($old3dx xf yf)))
#-franz (putprop '$old3dyr (get '$old3dy 'subr) 'subr)
#-franz (args '$old3dyr (args '$old3dy))
#+franz (putd '$old3dyr (getd '$old3dy))

(putprop '$howcloseold3d (get '$howclose3d 'subr) 'subr)
(args '$howcloseold3d (args '$howclose3d))

(defun $oldnp3dx (xf yf) (*$ cosbe (-$ xf (*$ yf x0))))
(defun $oldnp3dy (xf yf zf) (-$ zf (*$ yf z0)))
(defun $oldnp3dxr (xf yf) (-$ ($oldnp3dx xf yf)))
#-franz (putprop '$oldnp3dyr (get '$oldnp3dy 'subr) 'subr)
#-franz (args '$oldnp3dyr (args '$oldnp3dy))
#+franz (putd '$oldnp3dyr (getd '$oldnp3dy))

(defun $howcloseoldnp3d (xf yf zf) (*$ cosbe (+$ (*$ x0 xf) yf (*$ z0 zf))))