perm filename EUCLID[GEM,BGB] blob
sn#090795 filedate 1974-03-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE EUCLID - EUCLIDEAN TRANSFORMATIONS - JULY 1972.
C00004 00003 SUBR(MKROT1,PAN,TILT,SWING)
C00006 00004 SUBR(MKFFRM,FACE) MAKE FACE FRAME.
C00008 00005 SUBR(MKQFRM,DX,DY,DZ) MAKE FRAME WITH RESPECT TO VECTOR.
C00010 00006 SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) OBJECT TRANSLATION WRT FRAME.
C00012 00007 SUBR(ROTATE,FRMOBJ,WX,WY,WZ) OBJECT ROTATION WRT FRAME.
C00015 00008 SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) DILATION-REFLECTION WRT FRAME.
C00016 00009 SUBR(NORM,FRAME) NORMALIZE A FRAME MATRIX.
C00018 00010 SUBR(ORTHO1,FRAME) ORTHOGONIZE AN ORIENTATION MATRIX.
C00021 00011 SUBR(ORTHO2,QFRAME)
C00023 00012 SUBR(DETERM,FRAME)
C00024 00013 SUBR(ANGL3V,VERT1,VERT2,VERT3) ANGLE TRI-VERTEX.
C00027 00014 SUBR(DISTAN,V1,V2) DISTANCE BETWEEN TWO VERTICES.
C00028 00015 SUBN(ROTOR)
C00030 00016 SUBR(APTRAN,OBJECT,TRAN) APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
C00032 00017 ----(APTRAN) BODY ROTATION.
C00033 00018 ----(APTRAN) FACE ROTATION.
C00035 00019 SUBR(INTRAN,TRAN) INVERT A TRANSFORMATION.
C00037 ENDMK
C⊗;
TITLE EUCLID - EUCLIDEAN TRANSFORMATIONS - JULY 1972.
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKCOPY,MKFRAME,KLNODE
EXTERN SIN,COS,SQRT,ATAN,ATAN2,ASIN,ACOS,LOG,HALFPI,PI,TWOPI
COMMENT /------------------------------------------------------------
FRAME ← TRANSLATE(REFRAM+OBJECT,DX,DY,DZ);
FRAME ← ROTATE (REFRAM+OBJECT,WX,WY,WZ);
FRAME ← SHRINK (REFRAM+OBJECT,KX,KY,KZ);
NORM(FRAME);
ORTHO1(FRAME);
DISTANCE(V1,V2);
ROTOR; V,Q.
APTRAN(CBFEV,ETRAN);
INTRAN(TRAN);
/
SUBR(MKROT1,PAN,TILT,SWING)
COMMENT .-----------------------------------------------------------.
SETQ(CP,{COS,PAN})↔ SETQ(SP,{SIN,PAN})
SETQ(CT,{COS,TILT})↔ SETQ(ST,{SIN,TILT})
SETQ(CS,{COS,SWING})↔ SETQ(SS,{SIN,SWING})
CALL(MKFRAME)
LAC SP↔FMP CT↔FMP SS↔DAC 2↔LAC CP↔FMP CS↔FSB 2↔DAC IX(1)
LAC CP↔FMP CT↔FMP SS↔DAC 2↔LAC SP↔FMP CS↔FAD 2↔DAC IY(1)
LAC ST↔FMP SS↔DAC IZ(1)
LAC SP↔FMP CT↔FMP CS↔DAC 2↔LAC CP↔FMP SS↔FAD 2↔MOVNM JX(1)
LAC CP↔FMP CT↔FMP CS↔DAC 2↔MOVN SP↔FMP SS↔FAD 2↔DAC JY(1)
LAC ST↔FMP CS↔DAC JZ(1)
LAC SP↔FMP ST↔DAC KX(1)
LAC CP↔FMP ST↔MOVNM KY(1)
LAC CT↔DAC KZ(1)↔POP3J
DECLARE{CP,CT,CS,SP,ST,SS}
ENDR MKROT1;10/30/73(BGB)--------------------------------------------
SUBR(MKFFRM,FACE) ;MAKE FACE FRAME.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E,E0,V,X,Y,Z,N}
LAC F,FACE↔PED E,F↔DAC E,E0
SETZB X,Y↔SETZB Z,N
L1: SETQ(V,{VCCW,E,F})↔SETQ(E,{ECCW,E,F})
FADR X,XWC(V)↔FADR Y,YWC(V)↔FADR Z,ZWC(V)
CAME E,E0↔AOJA N,L1↔AOS N
;CENTER OF FACE BECOMES ORIGIN.
FLOAT N,↔FDVR X,N↔FDVR Y,N↔FDVR Z,N
SETQ(F,{MKFRAME})↔DAC F,FRM#
DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F)
;FIRST TWO VECTORS.
SETQ(V,{VCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC IX(F)
LAC YWC(V)↔FSBR Y↔DAC IY(F)
LAC ZWC(V)↔FSBR Z↔DAC IZ(F)
SETQ(V,{VCCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC JX(F)
LAC YWC(V)↔FSBR Y↔DAC JY(F)
LAC ZWC(V)↔FSBR Z↔DAC JZ(F)
CALL(ORTHO2,FRM)
CALL(NORM,FRM)
CALL(ORTHO1,FRM)
LAC 1,FRM↔POP1J
ENDR MKFFRM;2/19/74(BGB)---------------------------------------------
SUBR(MKQFRM,DX,DY,DZ) ;MAKE FRAME WITH RESPECT TO VECTOR.
COMMENT .-----------------------------------------------------------.
;NORMALIZE THE COMPONENTS OF THE VECTOR.
SKIPE 1,DX↔FMPR 1,1↔DAC 1,4
SKIPE 2,DY↔FMPR 2,2↔DAC 2,5
SKIPE 3,DZ↔FMPR 3,3
FADR 1,2↔FADR 1,3
SETQ(R,{SQRT↑,1})
;ROTATION AXIS FRAME OF REFERENCE.
SETQ(TMP1,{MKFRAME})↔DAC 1,7↔SKIPN R↔POP3J
LAC 1,DX↔DAC 1,XWC(7)↔FDVR 1,R↔DAC 1,IX(7)↔DAC 1,JY(7)
LAC 2,DY↔DAC 2,YWC(7)↔FDVR 2,R↔DAC 2,IY(7)↔DAC 2,JX(7)
LAC 3,DZ↔DAC 3,ZWC(7)↔FDVR 3,R↔DAC 3,IZ(7)↔SETZM JZ(7)
MOVM 3↔CAMLE[0.999]↔MOVNM JY(7)
CALL(ORTHO2,TMP1)↔CALL(NORM,TMP1)
LAC 1,TMP1
POP3J
DECLARE{R,TMP1}
ENDR MKQFRM;3/6/74(BGB)----------------------------------------------
SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) ;OBJECT TRANSLATION WRT FRAME.
COMMENT .-----------------------------------------------------------.
CALL(MKFRAME)
LAC DX↔DAC XWC(1) ;DELTA'S OF TRANSLATION.
LAC DY↔DAC YWC(1)
LAC DZ↔DAC ZWC(1)
↑QTRAN: DAC 1,TMP1 ;SECOND ENTRY.
MOVM 2,FRMOBJ↔CDR 2,2↔DAC 2,OBJECT
HLRE 1,FRMOBJ↔SKIPGE 1↔GO[
SETZ 1,↔JUMPE 2,.+1 ;JUMP WHEN NO OBJECT.
CALL(BGET,OBJECT) ;GET BODY OF THE OBJECT.
FRAME 1,1↔GO .+1] ;GET FRAME OF THE BODY.
DAC 1,REFRAM ;FRAME OF REFERENCE.
LAC 1,TMP1↔SKIPN REFRAM↔GO L1
L0: SETQ(TMP2,{MKCOPY,REFRAM})
CALL(INTRAN,TMP2)
CALL(APTRAN,TMP2,TMP1)
CALL(APTRAN,TMP2,REFRAM)
CALL(KLNODE,TMP1)
LAC 1,TMP2↔DAC 1,TMP1 ;TMP1 ← TMP2.
L1: SKIPN OBJECT↔POP4J ;RETURN TRANSFORMATION.
CALL(APTRAN,OBJECT,TMP1)
CALL(KLNODE,TMP1)
LAC 1,OBJECT↔POP4J ;RETURN OBJECT.
DECLARE{TMP1,TMP2,REFRAM,OBJECT}
ENDR TRANSLATE;3/18/73(BGB)------------------------------------------
SUBR(ROTATE,FRMOBJ,WX,WY,WZ) ;OBJECT ROTATION WRT FRAME.
COMMENT .-----------------------------------------------------------.
;COMPONENTS OF ROTATION VECTOR.
SKIPE 1,WX↔FMPR 1,1↔DAC 1,4
SKIPE 2,WY↔FMPR 2,2↔DAC 2,5
SKIPE 3,WZ↔FMPR 3,3
FADR 1,2↔FADR 1,3↔JUMPE 1,POP1J.
SETQ(W,{SQRT↑,1})
;ROTATION AXIS FRAME OF REFERENCE.
SETQ(TMP1,{MKFRAME})↔DAC 1,7
LAC 1,WX↔FDVR 1,W↔DAC 1,IX(7)↔DAC 1,JY(7)
LAC 2,WY↔FDVR 2,W↔DAC 2,IY(7)↔DAC 2,JX(7)
LAC 3,WZ↔FDVR 3,W↔DAC 3,IZ(7)↔SETZM JZ(7)
MOVM 3↔CAMLE[0.999]↔MOVNM JY(7)
CALL(ORTHO2,TMP1)↔CALL(NORM,TMP1)
LAC 1,TMP1 ;TRANSPOSE.
LAC IY(1)↔EXCH JX(1)↔DAC IY(1)
LAC IZ(1)↔EXCH KX(1)↔DAC IZ(1)
LAC JZ(1)↔EXCH KY(1)↔DAC JZ(1)
;ROTATION ABOUT I UNIT VECTOR.
SETQ(TMP2,{MKFRAME})
CALL(COS,W)↔LAC 2,TMP2↔DAC 1,JY(2)↔DAC 1,KZ(2)
CALL(SIN,W)↔LAC 2,TMP2↔DAC 1,JZ(2)↔MOVNM 1,KY(2)
CALL(APTRAN,TMP2,TMP1)
LAC 1,TMP1
LAC IY(1)↔EXCH JX(1)↔DAC IY(1)
LAC IZ(1)↔EXCH KX(1)↔DAC IZ(1)
LAC JZ(1)↔EXCH KY(1)↔DAC JZ(1)
CALL(APTRAN,TMP1,TMP2)↔CALL(KLNODE,TMP2)
LAC 1,TMP1
GO QTRAN
DECLARE{W,TMP1,TMP2,TMP3,REFRAM,OBJECT}
ENDR ROTATE;3/18/73(BGB)---------------------------------------------
SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) ;DILATION-REFLECTION WRT FRAME.
COMMENT .-----------------------------------------------------------.
CALL(MKFRAME)
SKIPN 2,KKX↔MOVSI 2,(1.0)↔DAC 2,IX(1)
SKIPN 2,KKY↔MOVSI 2,(1.0)↔DAC 2,JY(1)
SKIPN 2,KKZ↔MOVSI 2,(1.0)↔DAC 2,KZ(1)
GO QTRAN
ENDR SHRINK;3/18/73(BGB)---------------------------------------------
SUBR(NORM,FRAME) ; NORMALIZE A FRAME MATRIX.
COMMENT .------------------------------------------------------------
ACCUMULATORS:
05 06 07 IX IY IZ
10 11 12 JX JY JZ
13 14 15 KX KY KZ.
SAVAC(15)
MOVS FRAME↔HRRI 5↔BLT 15
; R ← SQRT(A↑2+B↑2+C↑2); A←A/R; B←B/R; C←C/R;
FOR Q IN (5,10,13){
MOVM 1,Q↔CAMG 1,[1.0E-8]↔SETZB 1,Q↔FMPR 1,1
MOVM 1+Q↔CAMG 0,[1.0E-8]↔SETZB 1+Q↔FMPR↔FADR 1,0
MOVM 2+Q↔CAMG 0,[1.0E-8]↔SETZB 2+Q↔FMPR↔FADR 1,0
SKIPE 1↔CAMN 1,[1.0]↔GO .+6↔CALL(SQRT,1)
FDVR Q,1↔FDVR Q+1,1↔FDVR Q+2,1}
;PUT'EM DOWN.
LAC 1,FRAME
MOVSI 5↔HRRI IX(1)↔BLT KZ(1)
GETAC(15)↔POP1J
ENDR NORM;1/14/73----------------------------------------------------
SUBR(ORTHO1,FRAME) ; ORTHOGONIZE AN ORIENTATION MATRIX.
COMMENT .-----------------------------------------------------------.
;IT IS ASSUMED THAT THE ROW VECTORS ARE UNIT VECTORS.
X←←0 ↔ Y←←1 ↔ Z←←2 ;ADDRESS DISPLACEMENTS.
Q←←9 ↔ R←←13 ↔ A←←14 ↔ B←←15 ;ACCUMULATORS.
SAVAC(15)
SETOM FLG# ;FIRST TIME THRU FLAG.
L0: LAC R,FRAME
MOVSI Q,IX(R)↔BLT Q,KZ ;FIRST NINE ACCUMULATORS.
;DOT EACH ROW VECTOR INTO THE NEXT ROW.
FMPR IX,JX↔FMPR IY,JY↔FMPR IZ,JZ
FADR IX,IY↔FADR IX,IZ
FMPR JX,KX↔FMPR JY,KY↔FMPR JZ,KZ
FADR JX,JY↔FADR JX,JZ
FMPR KX,IX(R)↔FMPR KY,IY(R)↔FMPR KZ,IZ(R)
FADR KX,KY↔FADR KX,KZ
;TAKE ABSOLUTE VALUES AND FIND THE WORST TOTAL COSINE.
MOVMS IX↔MOVMS JX↔MOVMS KX
LAC Q,KX↔FADR KX,JX↔FADR JX,IX↔FADR Q,IX
EXCH Q,JX↔SETZM SIGN#
MOVEI 1,IX(R)↔MOVEI 2,JX(R)↔MOVEI 3,KX(R) ;GET ROW POINTERS.
CAML Q,IX↔GO .+4
EXCH 2,1↔EXCH Q,IX↔SETCMM SIGN ;GET 2 BIGGER THAN 1.
CAML KX,Q↔GO .+4
EXCH 3,2↔EXCH KX,Q↔SETCMM SIGN ;GET 3 BIGGER THAN 2.
CAMG KX,[0.00001]↔GO L1 ;GOOD ENUF FOR GOVERNMENT WORK.
;STRAIGHTEN UP THE WORST VECTOR.
LAC A,Y(1)↔FMPR A,Z(2)
LAC B,Y(2)↔FMPR B,Z(1)↔FSBR A,B↔DAC A,X(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM X(3)
LAC A,X(2)↔FMPR A,Z(1)
LAC B,X(1)↔FMPR B,Z(2)↔FSBR A,B↔DAC A,Y(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Y(3)
LAC A,X(1)↔FMPR A,Y(2)
LAC B,X(2)↔FMPR B,Y(1)↔FSBR A,B↔DAC A,Z(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Z(3)
SKIPE SIGN↔GO[MOVNS X(3)↔MOVNS Y(3)↔MOVNS Z(3)↔GO .+1]
SKIPN FLG↔GO L1↔SETZM FLG↔GO L0
L1: GETAC(15)↔POP1J
ENDR ORTHO1;1/14/73(BGB)---------------------------------------------
SUBR(ORTHO2,QFRAME)
COMMENT .-----------------------------------------------------------.
; ACCEPT I; K' ← I CROSS J; J' ← K CROSS I;
LAC 1,QFRAME
SETZM KX(1)↔SETZM KY(1)↔SETZM KZ(1)
CALL(NORM,1)
MOVS QFRAME↔HRRI 1↔BLT 9
LAC 12,4↔LAC 13,5↔LAC 14,6 ;SAVE J VECTOR.
;VECTOR-K ← VECTOR-I CROSS VECTOR-J.
LAC 2↔FMP 6↔DAC 7
LAC 5↔FMP 3↔FSB 7,
LAC 4↔FMP 3↔DAC 8
LAC 1↔FMP 6↔FSB 8,
LAC 1↔FMP 5↔DAC 9
LAC 4↔FMP 2↔FSB 9,
;VECTOR-J ← VECTOR-K CROSS VECTOR-I.
LAC 8↔FMP 3↔DAC 4
LAC 2↔FMP 9↔FSB 4,
LAC 1↔FMP 9↔DAC 5
LAC 7↔FMP 3↔FSB 5,
LAC 7↔FMP 2↔DAC 6
LAC 1↔FMP 8↔FSB 6,
LAC 15,QFRAME↔MOVSI 1
HRRI IX(15)↔BLT KZ(15)
LAC 1,QFRAME↔POP1J
ENDR ORTHO2;3/30/73(BGB)---------------------------------------------
SUBR(DETERM,FRAME)
COMMENT .-----------------------------------------------------------.
MOVS FRAME↔HRRI 1↔BLT 9
LAC 5↔FMP 9↔LAC 12,
LAC 6↔FMP 8↔FSB 12,↔FMP 1,12
LAC 6↔FMP 7↔LAC 12,
LAC 4↔FMP 9↔FSB 12,↔FMP 2,12↔FAD 1,2
LAC 4↔FMP 8↔LAC 12,
LAC 5↔FMP 7↔FSB 12,↔FMP 3,12↔FAD 1,3↔POP1J
ENDR DETERM;4/1/73(BGB)----------------------------------------------
SUBR(ANGL3V,VERT1,VERT2,VERT3) ;ANGLE TRI-VERTEX.
COMMENT .-----------------------------------------------------------.
;ANGLE V1,V2,V3 CCW; RETURNS VALUE 0 TO 2π.
V1 ←← 13
V2 ←← 14
V3 ←← 15
;DETERMINE WHETHER THE ANGLE IS MORE OR LESS THAN PI.
LAC V1,VERT1↔MOVSI XWC(V1)↔HRRI 1↔BLT 3
LAC V2,VERT2↔MOVSI XWC(V2)↔HRRI 4↔BLT 6
LAC V3,VERT3↔MOVSI XWC(V3)↔HRRI 7↔BLT 9
FSBR 1,4↔FSBR 2,5↔FSBR 3,6 ;V1' ← (V1-V2).
FSBR 7,4↔FSBR 8,5↔FSBR 9,6 ;V3' ← (V3-V2).
LAC 2↔FMP 9↔LAC 4,↔LAC 3↔FMP 8↔FSB 4, ;V2' ← (V1 X V3).
LAC 3↔FMP 7↔LAC 5,↔LAC 1↔FMP 9↔FSB 5,
LAC 1↔FMP 8↔LAC 6,↔LAC 2↔FMP 7↔FSB 6,
FADR 1,4↔FADR 2,5↔FADR 3,6 ;V1" ← (V1'+V2').
FADR 7,4↔FADR 8,5↔FADR 9,6 ;V3" ← (V3'+V2').
;DETERM NGEATIVE INDICATES CCW ORDER, 0 TO π.
;DETERM POSITIVE INDICATES CW ORDER, π T0 2π.
CALL({DETERM+3},0)
SKIPL 1↔SKIPA 1,PI↔SETZ 1,↔PUSH P,1
;COSINE LAW.
CALL(DISTANCE,V2,V1)↔PUSH P,1
CALL(DISTANCE,V2,V3)↔PUSH P,1
CALL(DISTANCE,V1,V3)
FMPR 1,1↔MOVNS 1
POP P,2↔LAC 2↔FMPR 2,2
POP P,3↔FMP 3↔FMPR 3,3
FSC 1↔FADR 1,2↔FADR 1,3
FDVR 1,0↔CALL(ACOS,1)
POP P,0↔FADR 1,0↔POP3J
ENDR ANGL3V;4/1/73(BGB)----------------------------------------------
SUBR(DISTAN,V1,V2) ;DISTANCE BETWEEN TWO VERTICES.
COMMENT .-----------------------------------------------------------.
LAC 1,V1↔LAC 2,V2
LAC XWC(1)↔FSBR XWC(2)↔FMPR↔DAC 3
LAC YWC(1)↔FSBR YWC(2)↔FMPR↔FADRM 3
LAC ZWC(1)↔FSBR ZWC(2)↔FMPR↔FADR 3
CALL(SQRT,0)↔POP2J
ENDR DISTAN;2/10/73(BGB)---------------------------------------------
SUBN(ROTOR)
COMMENT ⊗------------------------------------------------------------
; APTRAN's inner most subroutine.
; Expects arguments in V and Q. Clobbers 1,2,X,Y,Z.
;
; X ← XWC(V);
; Y ← YWC(V);
; Z ← ZWC(V);
;
; XWC(V) ← X*IX(Q) + Y*JX(Q) + Z*KX(Q) + XWC(Q);
; YWC(V) ← X*IY(Q) + Y*JY(Q) + Z*KZ(Q) + YWC(Q);
; ZWC(V) ← X*IZ(Q) + Y*JZ(Q) + Z*KZ(Q) + ZWC(Q);
⊗
ACCUMULATORS{B,F,E,V,X,Y,Z,Q}
LAC X,XWC(V)↔LAC Y,YWC(V)↔LAC Z,ZWC(V)
LAC 1,IX(Q)↔CAMN 1,[1.0]↔SKIPA 1,X↔FMPR 1,X
SKIPE 2,JX(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,KX(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,XWC(Q)↔FADR 1,2↔DAC 1,XWC(V)
LAC 1,JY(Q)↔CAMN 1,[1.0]↔SKIPA 1,Y↔FMPR 1,Y
SKIPE 2,IY(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,KY(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,YWC(Q)↔FADR 1,2↔DAC 1,YWC(V)
LAC 1,KZ(Q)↔CAMN 1,[1.0]↔SKIPA 1,Z↔FMPR 1,Z
SKIPE 2,JZ(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,IZ(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,ZWC(Q)↔FADR 1,2↔DAC 1,ZWC(V)
POP0J
ENDR ROTOR;3/18/73(BGB)-------------------------------------------
SUBR(APTRAN,OBJECT,TRAN); APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,X,Y,Z,TRN,N,OBJ,E0}
SKIPN TRN,TRAN↔POP2J
;BRANCH ON TYPE OF OBJECT.
LAC OBJ,OBJECT
MOVM 1,(OBJ)↔JUMPE 1,LROTA
TLNE 1,(1B9)↔GO LROTA ;FRAME.
ANDI 1,17
CAIN 1,$BODY↔GO BROTA ;BODY.
CAIN 1,$CAMERA↔GO CROTA ;CAMERA.
CAIN 1,$SUN↔GO CROTA ;SUN-CAMERA.
CAIN 1,$FACE↔GO FROTA ;FACE.
CAIN 1,$EDGE↔GO EROTA ;EDGE.
CAIN 1,$VERT↔GO VROTA ;VERT.
POP2J
LROTA: LAC V,OBJ↔SETZM TMP2#↔GO .+3 ;FRAME CASE.
CROTA: FRAME V,OBJ↔DAC V,TMP2# ;CAMERA CASE.
CALL(ROTOR)
PUSH P,XWC(TRN)↔PUSH P,YWC(TRN)↔PUSH P,ZWC(TRN)
SETZM XWC(TRN)↔SETZM YWC(TRN)↔SETZM ZWC(TRN)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
POP P,ZWC(TRN)↔POP P,YWC(TRN)↔POP P,XWC(TRN)
SKIPN TMP2↔POP2J
CALL(NORM,TMP2#)
CALL(ORTHO1,TMP2#)
POP2J
;----(APTRAN) BODY ROTATION.
BROTA: LAC B,OBJ
TESTZ B,BDVBIT↔GO L2 ;DON'T MOVE VERTICES.
LAC V,B ;1ST VERTEX.
L1: PVT V,V
CAMN V,OBJ↔GO L2 ;SKIP WHEN VERTEX.
CALL(ROTOR)↔GO L1 ;ROTATE VERTEX.
L2: LAC B,OBJ
TESTZ B,BDLBIT↔GO L3 ;DON'T MOVE FRAME.
FRAME V,B↔SKIPN V↔GO L3
DAC V,TMP#↔PUSH P,B
CALL(APTRAN,V,TRN) ;BODY'S FRAME.
CALL(NORM,TMP#)
CALL(ORTHO1,TMP#)
POP P,B
;PARTS OF THIS BODY.
L3: TESTZ B,BDPBIT↔POP2J ;DON'T MOVE PARTS.
SON N,B↔JUMPE N,POP2J.
L4: PUSH P,N
CALL(APTRAN,N,TRN)
POP P,N↔LAC B,OBJECT
BRO N,N↔SON 0,B
CAME 0,N↔GO L4
POP2J
;----(APTRAN) FACE ROTATION.
FROTA: LAC F,OBJ↔NCNT N,F↔MOVMS N
PED E,F↔DAC E,E0↔JUMPE E0,[ ;VERTEX FACE.
PFACE B,F↔PVT V,B↔CALL(ROTOR)↔POP2J]
PCW 0,E↔SKIPN N↔CAMN 0,E↔GO[ ;WIRE OR SHELL FACE.
SETQ(V,{VCW,E,F})↔CALL(ROTOR)↔GO .+1]
L5: SETQ(V,{VCCW,E,F})
CALL(ROTOR)↔CALL(ECCW,E,F)
CAMN 1,E↔POP2J ;END OF WIRE FACE.
LAC E,1↔CAMN E,E0↔POP2J ;END OF NORMAL FACE.
SOJN N,L5↔POP2J ;END OF SHELL FACE.
;EDGE ROTATION.
EROTA: LAC E,OBJ
PVT V,E↔CALL(ROTOR)
NVT V,E↔CALL(ROTOR)
POP2J
;VERTEX ROTATION.
VROTA: LAC V,OBJ
CALL(ROTOR)
POP2J
ENDR APTRAN;1/14/73(BGB)------------------------------------------
SUBR(INTRAN,TRAN) ;INVERT A TRANSFORMATION.
COMMENT .-----------------------------------------------------------.
Q ←← 6
LAC 2,TRAN
MOVSI XWC(2)↔HRRI XWC+Q↔BLT KZ+Q
;XWC' ← -(XWC*IX + YWC*IY + ZWC*IZ);
LAC 1,XWC+Q↔FMPR 1,IX+Q
LAC YWC+Q↔FMPR IY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR IZ+Q↔FADR 1,0
MOVNM 1,XWC(2)
;YWC' ← -(XWC*JX + YWC*JY + ZWC*JZ);
LAC 1,XWC+Q↔FMPR 1,JX+Q
LAC YWC+Q↔FMPR JY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR JZ+Q↔FADR 1,0
MOVNM 1,YWC(2)
;ZWC' ← -(XWC*KX + YWC*KY + ZWC*KZ);
LAC 1,XWC+Q↔FMPR 1,KX+Q
LAC YWC+Q↔FMPR KY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR KZ+Q↔FADR 1,0
MOVNM 1,ZWC(2)
;TRANSPOSE ROTATION MATRIX.
DAC JX+Q,IY(2)
DAC KX+Q,IZ(2)
DAC IY+Q,JX(2)
DAC KY+Q,JZ(2)
DAC IZ+Q,KX(2)
DAC JZ+Q,KY(2)
LAC 1,2
POP1J
ENDR INTRAN;3/18/73(BGB)---------------------------------------------
END
EUCLID.FAI - EOF.