COMMON NTAB,IPT DIMENSION NTAB (500,3) GOTO 10 C INIT TABLE 8 IPT=0 CALL FDIS (0,0,0) GOTO 10 C ERASE SCREEN 5 CALL ERASE C GET COORDS AND CHAR 10 CALL JOY(IX,IY,K) C D(288) DARK VECTOR, O(992) OMIT, I(608) INITIALIZE C L(800) LIGHT VECTOR, P(1056) POINT, E(352) ERASE, C W(1504) WRITE TABLE, T(1312) TAPE, G(480) CHAIN TO GFIC C Y(1632) POLYGON, X(1568) EXIT, C(224) CHAIN TO CHARACTER C F(416) CHAIN TO MODIFY IF (K-288) 14,40,14 14 IF (K-992) 15,500,15 15 IF (K-608) 20,8,20 20 IF(K-800) 25,50,25 25 IF(K-1568)30,1201,30 30 IF (K-1056) 35,60,35 35 IF (K-352) 37,5,37 37 IF (K-1504) 38,150,38 38 IF (K-1312) 39,1000,39 39 IF (K-480) 22,2000,22 22 IF (K-1632) 1204,1700,1204 1204 IF (K-928) 1200,1205,1200 1200 IF (K-864) 1202,1900,1202 1202 IF (K-224) 210,1138,210 210 IF (K-416) 10,220,10 C SET I FOR DARK VECTOR 40 I=0 GOTO 100 C I=LIGHT VECTOR,CALL FDIS FOR LAST POINT 50 I=1 CALL FDIS(0,NTAB(IPT,2),NTAB(IPT,3)) GOTO 100 C I=POINT 60 I=-1 C DRAW VECTOR, PUT POINT IN TABLE 100 CALL FDIS(I,IX,IY) IPT=IPT+1 NTAB(IPT,1)=I NTAB(IPT,2)=IX NTAB(IPT,3)=IY GOTO 10 C WRITE ROUTINE-GO HOME, CALL FDIS WITH EACH POINT 150 CALL FDIS(0,0,0) DO 200 N=1,IPT 200 CALL FDIS(NTAB(N,1),NTAB(N,2),NTAB(N,3)) GOTO 10 C OMIT ROUTINE-GET NO OF POINTS TO OMIT 500 CALL ALPHA READ (1,501) M 501 FORMAT ('#',1I3) IF (IPT-M) 520,520,510 510 IPT=IPT-M CALL ERASE GOTO 150 520 CALL ERASE GOTO 8 1000 CALL CHAIN ('TAPE') 2000 CALL CHAIN ('GFIC') 1201 CALL EXIT 1138 CALL CHAIN ('CHAR') 220 CALL CHAIN ('MODIFY') C WRITE IPT 1205 CALL ALPHA WRITE (1,1206) IPT 1206 FORMAT (I3) GOTO 10 1700 CALL ALPHA C POLYGON ROUTINE 1710 READ (1,1711) R,X 1711 FORMAT ('RADIUS 'F3.0' # OF SIDES 'F3.0) CALL JOY(IX,IY,K) X4=2.*3.1415926 X3=0. X2=X4/X IPT=IPT+1 NTAB(IPT,1)=-1 NTAB(IPT,2)=IFIX(R)+IX NTAB(IPT,3)=IY CALL FDIS(-1,NTAB(IPT,2),NTAB(IPT,3)) 1754 IPT=IPT+1 IF (IPT-500) 1757,1757,1758 1757 NTAB(IPT,1)=1 NTAB(IPT,2)=IFIX(R*COS(X3))+IX NTAB(IPT,3)=IFIX(R*SIN(X3))+IY X3=X3+X2 IF (X3-X4) 1756,1756,10 1756 CALL FDIS (1,NTAB(IPT,2),NTAB(IPT,3)) GOTO 1754 1758 CALL ALPHA WRITE (1,1759) 1759 FORMAT ('MATRIX FILLED') GOTO 10 C MOVING SUBROUTINE 1900 CALL ALPHA READ (1,1901) K 1901 FORMAT ('DESTROY OLD? Y=1, N=2 'I1) GOTO (1903,1902),K 1902 NPT=IPT NTAB(IPT+1,1)=-1 GOTO 1906 1903 NPT=0 1906 CALL JOY(IX,IY,K) NX=IX NZ=IY CALL JOY(IX,IY,K) NX=IX-NX NZ=IY-NZ DO 1904 N=1,IPT NTAB(NPT+N,1)=NTAB(N,1) NTAB(NPT+N,2)=NTAB(N,2)+NX 1904 NTAB(NPT+N,3)=NTAB(N,3)+NZ IPT=IPT+NPT CALL ALPHA WRITE (1,1905) IPT 1905 FORMAT (I3) GOTO 10 END