Rotating Pyramid

Source Code

j    1 REM PROGRAM 8.2                     (ROTATING PRYRAMID)
    2 REM THREE DEMENSIONAL ANIMATION WITH HIDDEN LINES ELIMINATED
    3 REM this is a prime               contender  for using two display files   a LDIR statement would put the completed pyramid to DF2 from DF1   also another two are three pyramids could be calculated the arrays could then be put into a small compiled program   if anyone does this I would like to have a copy! please.     James N Jones                    2242 Locust                     Amarillo Texas 79109
    4 REM                            from the Myers book          Microcomputer Graphics
    5 PAPER 0: INK 7: BORDER 0
    6 CLS : CLS 
    7 OVER 0
   10 DIM P(912): LET ADDR=1: DIM E(6,3)
   20 LET RHO=15: LET THETA=.5: LET PHI=.9: LET D=400
   30 LET CX=127: LET CY=87: LET S1=SIN (THETA): LET C1=COS (THETA):: LET S2=SIN (PHI): LET C2=COS (PHI)
   40 LET TN=-.1: LET TT=.1: LET CT=COS (TT): LET ST=SIN (TT): LET SO=SIN (TN): LET CO=COS (TN)
   50 LET TP=-.1: LET SP=SIN (TP): LET CP=COS (TP)
   55 REM these are the xyz               coordinates of the              vertices
   60 DATA 0,0,3
   70 DATA 1,0,0
   80 DATA -.2,1,0
   90 DATA -.2,-1,0
  100 DIM V(4,3): DIM W(4,2)
  110 FOR I=1 TO 4: READ X,Y,Z
  120 LET V(I,1)=X: LET V(I,2)=Y: LET V(I,3)=Z
  130 LET XE=-X*S1+Y*C1: LET YE=-X*C1*C2-Y*S1*C2+Z*S2: LET ZE=-X*S2*C1-Y*S2*S1-Z*C2+RHO
  140 LET W(I,1)=D*(XE/ZE)+CX: LET W(I,2)=D*(YE/ZE)+CY
  150 NEXT I
  160 DATA 1,4,2,1
  170 DATA 1,2,3,1
  180 DATA 1,3,4,1
  190 DATA 2,4,3,2
  200 DIM T(4,4)
  210 FOR I=1 TO 4
  220 FOR J=1 TO 4
  230 READ T(I,J)
  240 NEXT J: NEXT I
  250 DIM N(4,3)
  260 FOR R=1 TO 36
  270 FOR I=1 TO 6: LET E(I,3)=0: NEXT I
  280 FOR I=1 TO 4
  290 LET U1=V(T(I,2),1)-V(T(I,1),1)
  300 LET U2=V(T(I,2),2)-V(T(I,1),2)
  310 LET U3=V(T(I,2),3)-V(T(I,1),3)
  320 LET V1=V(T(I,3),1)-V(T(I,1),1)
  330 LET V2=V(T(I,3),2)-V(T(I,1),2)
  340 LET V3=V(T(I,3),3)-V(T(I,1),3)
  350 LET N(I,1)=U2*V3-V2*U3
  360 LET N(I,2)=U3*V1-V3*U1
  370 LET N(I,3)=U1*V2-V1*U2
  380 NEXT I
  390 LET XE=RHO*S2*C1: LET YE=RHO*S1*S2: LET ZE=RHO*C2
  400 LET N=1
  410 FOR I=1 TO 4
  420 LET E2=T(I,1)
  430 LET WX=XE-V(E2,1)
  440 LET WY=YE-V(E2,2)
  450 LET WZ=ZE-V(E2,3)
  460 IF N(I,1)*WX+N(I,2)*WY+N(I,3)*WZ<=0 THEN GO TO 570
  470 LET E1=T(I,1)
  480 FOR J=2 TO 4
  490 LET E2=T(I,J)
  500 FOR K=1 TO N
  510 IF E(K,1)=E2 AND E(K,2)=E1 THEN LET E(K,3)=2: GO TO 550
  520 NEXT K
  530 LET E(N,1)=E1: LET E(N,2)=E2: LET E(N,3)=1
  540 LET N=N+1
  550 LET E1=E2
  560 NEXT J
  570 NEXT I
  580 FOR I=1 TO 6
  590 IF E(I,3)=0 THEN GO TO 620
  600 LET J=E(I,1): LET K=E(I,2)
  610 LET P(ADDR)=W(J,1): LET P(ADDR+1)=W(J,2): LET P(ADDR+2)=W(K,1): LET P(ADDR+2)=W(K,1): LET P(ADDR+3)=W(K,2)
  620 LET ADDR=ADDR+4
  630 NEXT I
  640 FOR I=1 TO 4
  650 LET T1=CP*CT*V(I,1)-(ST*CP+SO*SP)*V(I,2)+(SO*ST*CP-SP*CO)*V(I,3)
  660 LET T2=ST*V(I,1)+CO*CT*V(I,2)-SO*CT*V(I,3)
  670 LET T3=SP*CT*V(I,1)+(SO*CP-CO*ST*SP)*V(I,2)+(ST*SO*SP+CO*CP)*V(I,3)
  680 LET V(I,1)=T1: LET V(I,2)=T2: LET V(I,3)=T3
  690 LET X=T1: LET Y=T2: LET Z=T3
  700 LET XE=-X*S1+Y*C1: LET YE=-X*C1*C2-Y*S1*C2+Z*S2: LET ZE=-X*S2*C1-Y*S2*S1-Z*C2+RHO
  710 LET W(I,1)=D*(XE/ZE)+CX: LET W(I,2)=D*(YE/ZE)+CY
  720 NEXT I
  730 PRINT "FRAME # - ";R: POKE 23692,255
  740 NEXT R
  750 FOR I=1 TO 48: LET P(I+864)=P(I): NEXT I
  760 BEEP 2,22: REM INPUT "READY";A$
  780 LET ADDR=1
  880 FOR I=1 TO 6
  890 IF P(ADDR)=0 THEN GO TO 910
  900 PLOT P(ADDR),P(ADDR+1): DRAW  P(ADDR+2)-P(ADDR),P(ADDR+3)-P(ADDR+1)
  910 LET ADDR=ADDR+4
  920 NEXT I
  930 LET ADDR=ADDR+24
  940 IF ADDR=865 THEN LET ADDR=1
  950 REM POKE  -16300+DP,0
  955 PAUSE 2
  970 CLS : GO TO 880
 9000 REM DO NOT CLEAR OR              YOU WILL HAVE TO CALCULATE      THE VERTICES AGAIN
 9998 SAVE "Pyramid" LINE 1