(FILECREATED "31-AUG-82 15:09:39" {PHYLUM}<FIKES>LISP>FASTANIMATE.;1 15702
changes to: (FNS Fool)
previous date: "31-AUG-82 11:44:01" {PHYLUM}<DMRUSSELL>FASTANIMATE.;17)
(PRETTYCOMPRINT FASTANIMATECOMS)
(RPAQQ FASTANIMATECOMS ((FNS * FASTANIMATEFNS)
(VARS * FASTANIMATEVARS)
(MACROS * FASTANIMATEMACROS)
(P (FOR I FROM 0 TO 359 DO (SETA COSARRAY I (COS I)))
(FOR I FROM 0 TO 359 DO (SETA SINARRAY I (SIN I)))
(GLOBALVARS SINARRAY COSARRAY))
(PROP (T (COS X))
FCOS)))
(RPAQQ FASTANIMATEFNS (Animate DO1 DisplayObject FCOS FSIN FastRotX FastRotY FastRotZ FastRotate Fool
MAKESCRATCHBM RotateObject RotateWorld Translate
TranslateAndDisplayObject DisplayAnimateProg TranslateAndDisplayObject)
)
(DEFINEQ
(Animate
[LAMBDA (object script displayStream numFrames xTranslate yTranslate transcriptFlag)
(* dmr: "30-AUG-82 11:58")
(PROG NIL
[COND
(transcriptFlag (SETQ animateProg (LIST NIL]
[for command in script do ((SETQ deltaX (QUOTIENT (CAR command)
numFrames))
(SETQ deltaY (QUOTIENT (CADR command)
numFrames))
(SETQ deltaZ (QUOTIENT (CADDR command)
numFrames))
(SETQ xTranslate (QUOTIENT (CADDDR command)
numFrames))
(SETQ yTranslate (QUOTIENT (CAR (CDDDDR command))
numFrames))
(SETQ zTransDelta 0)
(SETQ xScaleDelta (COND
((NOT (EQUAL (CADR (CDDDDR command))
1))
(PLUS 1 (QUOTIENT (CADR (CDDDDR command))
numFrames)))
(T 1)))
(SETQ yScaleDelta (COND
((NOT (EQUAL (CADDR (CDDDDR command))
1))
(PLUS 1 (QUOTIENT (CADDR (CDDDDR command))
numFrames)))
(T 1)))
[COND
((NULL displayStream)
(SETQ displayStream
(TranslateAndDisplayObject NIL object displayStream
xTranslate yTranslate 0
transcriptFlag]
(for i from 1 to numFrames
do ((SETQ object (Translate (FastRotate object deltaX deltaY
deltaZ)
xTranslate yTranslate zTransDelta)
)
(CLEARW displayStream)
[COND
(transcriptFlag (SETQ animateProg
(TCONC animateProg
(QUOTE (CLEARW displayStream]
(TranslateAndDisplayObject NIL object displayStream
xTranslate yTranslate 0
transcriptFlag]
(RETURN displayStream])
(DO1
[LAMBDA (N X Y Z) (* edited: "31-AUG-82 00:58")
(FRPTQ N (TranslateAndDisplayObject NIL $$globalObject←(FastRotate $$globalObject X Y Z)
DS 300 300 0])
(DisplayObject
[LAMBDA (oldObject object displayStream) (* edited: "27-AUG-82 11:03")
(PROG NIL
(SETQ displayStream (DECODE/WINDOW/OR/DISPLAYSTREAM displayStream (QUOTE displayStream)
"DMR Graphics Window"))
[for line in object do ((SETQ firstPoint (CAR line))
(SETQ remainder (CDR line))
(for point in remainder do ((COND
((NOT (NULL (CADDDR firstPoint)))
(DSPXPOSITION (CAR firstPoint)
displayStream)
(DSPYPOSITION (CADR firstPoint)
displayStream)
(PRIN1 (CADDDR point)
displayStream)))
(DRAWLINE (CAR firstPoint)
(CADR firstPoint)
(CAR point)
(CADR point)
2
(QUOTE REPLACE)
displayStream)
(SETQ firstPoint point]
(RETURN displayStream])
(FCOS
[LAMBDA (X) (* edited: "30-AUG-82 22:56")
(* edited by DMR : "30-AUG-82 22:51")
(COND
((AND (SMALLP X)
(IGEQ X 0)
(ILESSP X 360))
(ELT COSARRAY X))
(T (COS X])
(FSIN
[LAMBDA (X) (* edited: "30-AUG-82 22:57")
(COND
((AND (SMALLP X)
(IGEQ X 0)
(ILESSP X 360))
(ELT SINARRAY X))
(T (SIN X])
(FastRotX
[LAMBDA (object theta) (* dmr: "30-AUG-82 12:40")
(for line in object collect (for point in line collect (LIST (CAR point)
(FPLUS (FTIMES (FCOS theta)
(CADR point))
(FTIMES (FSIN theta)
(CADDR point)))
(FDIFFERENCE (FTIMES (FCOS theta)
(CADDR point))
(FTIMES (CADR point)
(FSIN theta)))
(CADDDR point])
(FastRotY
[LAMBDA (object theta) (* dmr: "30-AUG-82 12:40")
(for line in object collect (for point in line collect (LIST (FDIFFERENCE (FTIMES (CAR point)
(FCOS theta))
(FTIMES (CADDR point)
(FSIN theta)))
(CADR point)
(FPLUS (FTIMES (CADDR point)
(FCOS theta))
(FTIMES (CAR point)
(FSIN theta)))
(CADDDR point])
(FastRotZ
[LAMBDA (object theta) (* dmr: "30-AUG-82 12:40")
(for line in object collect (for point in line collect (LIST (FPLUS (FTIMES (CAR point)
(FCOS theta))
(FTIMES (CADR point)
(FSIN theta)))
(FDIFFERENCE (FTIMES (CADR point)
(FCOS theta))
(FTIMES (CAR point)
(FSIN theta)))
(CADDR point)
(CADDDR point])
(FastRotate
[LAMBDA (object x y z) (* CSC "22-AUG-82 23:49")
(PROG NIL
(if ~(EQUAL x 0)
then object←(FastRotX object x))
(if ~(EQUAL y 0)
then object←(FastRotY object y))
(if ~(EQUAL z 0)
then object←(FastRotZ object z))
(RETURN object])
(Fool
[LAMBDA NIL (* edited: "31-AUG-82 14:59")
(PROG NIL
($$globalObject←arrow)
(DO1 1000000 1 3 5])
(MAKESCRATCHBM
[LAMBDA (W H) (* dmr: "30-AUG-82 16:12")
(PROG ((BM (BITMAPCREATE W H))
(DSP (DSPCREATE)))
(DSPDESTINATION BM DSP)
(RETURN (LIST BM DSP])
(RotateObject
[LAMBDA (object Xdegrees Ydegrees Zdegrees) (* CSC "22-AUG-82 22:05")
(PROG NIL
[SetArray RotArray (QUOTE ((1 0 0 0)
(0 1 0 0)
(0 0 1 0)
(0 0 0 1]
(COND
((NOT (EQUAL Xdegrees 0))
(Make.RotateInX.Array RotArray Xdegrees)))
[COND
((NOT (EQUAL Ydegrees 0))
(Make.RotateInY.Array yRotArray Ydegrees)
(MatMult (QUOTE RotArray)
(QUOTE yRotArray)
(QUOTE RotArray]
[COND
((NOT (EQUAL Zdegrees 0))
(Make.RotateInZ.Array zRotArray Zdegrees)
(MatMult (QUOTE RotArray)
(QUOTE yRotArray)
(QUOTE RotArray]
(RETURN (for line in object collect (for point in line
collect (PROGN NIL
(SetArray pointArray
(LIST (LIST (CAR point)
(CADR point)
(CADDR point)
1)))
(MatMult (QUOTE pointArray)
(QUOTE xRotArray)
(QUOTE newPointArray))
(LIST (GetElt newPointArray 1 1 4)
(GetElt newPointArray 1 2 4)
(GetElt newPointArray 1 3 4])
(RotateWorld
[LAMBDA (x y z) (* edited: "31-AUG-82 13:24")
(* Rotate all of the components of the BB display help
system)
(PROG NIL
(8200WireFrameModel←(FastRotate 8200WireFrameModel x y z))
(RDHWireFrame←(FastRotate RDHWireFrame x y z))
(RDHPointer←(FastRotate RDHPointer x y z))
(TopPaperTrayWireFrame←(FastRotate TopPaperTrayWireFrame x y z))
(TopPaperTrayPointer←(FastRotate TopPaperTrayPointer x y z))
(BottomPaperTrayWireFrame←(FastRotate BottomPaperTrayWireFrame x y z))
(BottomPaperTrayPointer←(FastRotate BottomPaperTrayPointer x y z])
(Translate
[LAMBDA (object xTrans yTrans zTrans) (* edited: "27-AUG-82 11:48")
(if xTrans~=0 or yTrans~=0 or zTrans~=0
then (for line in object collect (for point in line collect <(PLUS point:1 xTrans)
(PLUS point:2 yTrans)
(PLUS point:3 zTrans)
>))
else object])
(TranslateAndDisplayObject
[LAMBDA (oldObject object displayStream dx dy dz transcriptFlag)
(* edited: "30-AUG-82 21:41")
(DECLARE (LOCALVARS . T))
[COND
((NOT DSPSCRATCH)
(SETQ DSPSCRATCH (MAKESCRATCHBM (CADDR (DSPCLIPPINGREGION NIL displayStream))
(CADDDR (DSPCLIPPINGREGION NIL displayStream]
(PROG ((scalex 1.0)
(scaley 1.0)
(scalez 1.0))
(CLEAR (CAR DSPSCRATCH))
(bind (DSP ←(CADR DSPSCRATCH)) for line in object
do (SETQ firstPoint (CAR line))
(SETQ remainder (CDR line))
(for point in remainder do (COND
((CADDDR firstPoint)
(* have a label?)
(DSPXPOSITION (FPLUS dx (CAR firstPoint))
DSP)
(DSPYPOSITION (FPLUS dy (CADR firstPoint))
DSP)
(PRIN1 (CADDDR point)
DSP))
(T (DRAWLINE (IPLUS dx (FTIMES scalex (CAR firstPoint)))
(IPLUS dy (FTIMES scaley (CADR firstPoint)))
(IPLUS dx (FTIMES scalex (CAR point)))
(IPLUS dy (FTIMES scaley (CADR point)))
2
(QUOTE REPLACE)
DSP)))
[COND
(transcriptFlag (TCONC animateProg
(LIST (IPLUS dx (CAR firstPoint))
(IPLUS dy (CADR firstPoint))
(IPLUS dx (CAR point))
(IPLUS dy (CADR point))
(IPLUS dz (CADDR point))
(CADDDR point]
(SETQ firstPoint point)))
(BITBLT (CAR DSPSCRATCH)
NIL NIL displayStream)
displayStream])
(DisplayAnimateProg
[LAMBDA (object displayStream) (* dmr: "30-AUG-82 18:00")
(DECLARE (LOCALVARS . T))
[COND
((NOT DSPSCRATCH)
(SETQ DSPSCRATCH (MAKESCRATCHBM (CADDR (DSPCLIPPINGREGION NIL displayStream))
(CADDDR (DSPCLIPPINGREGION NIL displayStream]
(PROG NIL
(CLEAR (CAR DSPSCRATCH))
(bind (DSP ←(CADR DSPSCRATCH)) for line in object
do (SETQ firstPoint (CAR line))
(SETQ remainder (CDR line))
(for point in remainder do (COND
((CADDDR firstPoint)
(* have a label?)
(DSPXPOSITION (CAR firstPoint)
DSP)
(DSPYPOSITION (CADR firstPoint)
DSP)
(PRIN1 (CADDDR point)
DSP))
(T (DRAWLINE (CAR firstPoint)
(CADR firstPoint)
(CAR point)
(CADR point)
2
(QUOTE REPLACE)
DSP)))
(SETQ firstPoint point)))
(BITBLT (CAR DSPSCRATCH)
NIL NIL displayStream)
displayStream])
(TranslateAndDisplayObject
[LAMBDA (oldObject object displayStream dx dy dz transcriptFlag)
(* edited: "30-AUG-82 21:41")
(DECLARE (LOCALVARS . T))
[COND
((NOT DSPSCRATCH)
(SETQ DSPSCRATCH (MAKESCRATCHBM (CADDR (DSPCLIPPINGREGION NIL displayStream))
(CADDDR (DSPCLIPPINGREGION NIL displayStream]
(PROG ((scalex 1.0)
(scaley 1.0)
(scalez 1.0))
(CLEAR (CAR DSPSCRATCH))
(bind (DSP ←(CADR DSPSCRATCH)) for line in object
do (SETQ firstPoint (CAR line))
(SETQ remainder (CDR line))
(for point in remainder do (COND
((CADDDR firstPoint)
(* have a label?)
(DSPXPOSITION (FPLUS dx (CAR firstPoint))
DSP)
(DSPYPOSITION (FPLUS dy (CADR firstPoint))
DSP)
(PRIN1 (CADDDR point)
DSP))
(T (DRAWLINE (IPLUS dx (FTIMES scalex (CAR firstPoint)))
(IPLUS dy (FTIMES scaley (CADR firstPoint)))
(IPLUS dx (FTIMES scalex (CAR point)))
(IPLUS dy (FTIMES scaley (CADR point)))
2
(QUOTE REPLACE)
DSP)))
[COND
(transcriptFlag (TCONC animateProg
(LIST (IPLUS dx (CAR firstPoint))
(IPLUS dy (CADR firstPoint))
(IPLUS dx (CAR point))
(IPLUS dy (CADR point))
(IPLUS dz (CADDR point))
(CADDDR point]
(SETQ firstPoint point)))
(BITBLT (CAR DSPSCRATCH)
NIL NIL displayStream)
displayStream])
)
(RPAQQ FASTANIMATEVARS (test $$oldGlobalObject animationScript (COSARRAY (ARRAY 360 NIL NIL 0))
(SINARRAY (ARRAY 360 NIL NIL 0))))
(RPAQQ test (((11.15614 76.58971 63.26802 NIL)
(-185.7381 76.58971 97.98666 NIL)
(-212.329 205.1217 -52.81405 NIL)
(181.4595 205.1217 -122.2514 NIL)
(226.664 -13.38268 134.1099 NIL)
(224.4328 -28.70062 121.4563 NIL)
(232.4101 -67.26023 166.6965 NIL)
(35.51583 -67.26023 201.4151 NIL)
(27.53855 -28.70062 156.1749 NIL)
(29.76978 -13.38268 168.8285 NIL)
(11.15614 76.58971 63.26802 NIL))
((-11.15614 -76.58971 -63.26802 NIL)
(-208.0504 -76.58971 -28.54936 NIL)
(-234.6413 51.94228 -179.3501 NIL)
(159.1472 51.94228 -248.7874 NIL)
(212.329 -205.1217 52.81405 NIL)
(15.43477 -205.1217 87.5327 NIL)
(-11.15614 -76.58971 -63.26802 NIL))
((11.15614 76.58971 63.26802 NIL)
(-11.15614 -76.58971 -63.26802 NIL))
((-185.7381 76.58971 97.98666 NIL)
(-208.0504 -76.58971 -28.54936 NIL))
((-212.329 205.1217 -52.81405 NIL)
(-234.6413 51.94228 -179.3501 NIL))
((181.4595 205.1217 -122.2514 NIL)
(159.1472 51.94228 -248.7874 NIL))
((232.4101 -67.26023 166.6965 NIL)
(212.329 -205.1217 52.81405 NIL))
((35.51583 -67.26023 201.4151 NIL)
(15.43477 -205.1217 87.5327 NIL))
((11.15614 76.58971 63.26802 NIL)
(-11.15614 -76.58971 -63.26802 NIL))
((27.53855 -28.70062 156.1749 NIL)
(224.4328 -28.70062 121.4563 NIL))
((29.76978 -13.38268 168.8285 NIL)
(226.664 -13.38268 134.1099 NIL))))
(RPAQQ $$oldGlobalObject NIL)
(RPAQQ animationScript NIL)
(RPAQ COSARRAY (ARRAY 360 NIL NIL 0))
(RPAQ SINARRAY (ARRAY 360 NIL NIL 0))
(RPAQQ FASTANIMATEMACROS (FCOS FSIN))
(DECLARE: EVAL@COMPILE
(PUTPROPS FCOS MACRO [(X)
(COND
((AND (SMALLP X)
(IGEQ X 0)
(ILESSP X 360))
(ELT COSARRAY X))
(T (COS X])
(PUTPROPS FSIN MACRO [(X)
(COND
((AND (SMALLP X)
(IGEQ X 0)
(ILESSP X 360))
(ELT SINARRAY X))
(T (SIN X])
)
(FOR I FROM 0 TO 359 DO (SETA COSARRAY I (COS I)))
(FOR I FROM 0 TO 359 DO (SETA SINARRAY I (SIN I)))
(GLOBALVARS SINARRAY COSARRAY)
(DECLARE: DONTCOPY
(FILEMAP (NIL (780 13379 (Animate 790 . 2605) (DO1 2607 . 2831) (DisplayObject 2833 . 3731) (FCOS 3733
. 4047) (FSIN 4049 . 4260) (FastRotX 4262 . 4767) (FastRotY 4769 . 5273) (FastRotZ 5275 . 5778) (
FastRotate 5780 . 6164) (Fool 6166 . 6352) (MAKESCRATCHBM 6354 . 6589) (RotateObject 6591 . 7767) (
RotateWorld 7769 . 8550) (Translate 8552 . 8943) (TranslateAndDisplayObject 8945 . 10597) (
DisplayAnimateProg 10599 . 11723) (TranslateAndDisplayObject 11725 . 13377)))))
STOP