Directory of image this file is from
This file as a plain text file

	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