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

C PROGRAM DRAW
C DRAW IS PRIMARILY CONCERNED WITH LINEAR IMAGES.THAT IS TO SAY,IT
C USES THE CROSSHAIRS TO DRAW STRAIGHT LINES,AND CAN ALSO CREATE
C CLOSED POLYGONS OF N-SIDES AND WITH A SPECIFIC RADIUS.THIS IMPLIES
C THE ABILITY TO INSCRIBE AND CIRCUMSCRIBE VERY SIMPLY,BY SPECIFYING
C THE CORRECT RADIUS AND THE SAME CENTER AS FOR THE ORIGINAL POLYGON.
C DRAW ALSO HAS ALL THE HOUSEKEEPING FUNCTIONS.
C	D	DRAWS DARK VECTOR
C	E	ERASES SCREEN
C	F	CHAINS TO MODIFY.SV
C	G	CHAINS TO GFIC.SV
C	I	INITIALIZES TABLE
C	L	DRAWS LIGHT VECTOR
C	N	WRITES NUMMBER OF POINTS USED IN TABLE
C	O	OMITS POINTS FROM TABLE (#)
C	P	DRAWS POINT
C	T	CHAINS TO TAPE.SV
C	W	WRITES ALL POINTS
C	X	EXITS FROM PROGRAM
C	Y	DRAWS POLYGON (RADIUS,NUMBER OF SIDES)
C FORTRAN II
C SR : ERASE.FT / JOY.FT / FDIS.FT / ALPHA.FT
C CH : TAPE.SV / MODIFY.SV / GFIC.SV
C BEARBEITUNG VON DECUS #8-773
	COMMON NTAB,IPT
	DIMENSION NTAB (500,3)
	GOTO 3
C INIT TABLE
1	IPT=0
	CALL FDIS (0,0,0)
	GOTO 3
C ERASE SCREEN
2	CALL ERASE
C GET COORDINATES AND CHARACTERS
3	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 F(416) CHAIN TO MODIFY
	IF (K-288) 4,17,4
4	IF (K-992) 5,23,5
5	IF (K-608) 6,1,6
6	IF (K-800) 7,18,7
7	IF (K-1568)8,28,8
8	IF (K-1056) 9,19,9
9	IF (K-352) 10,2,10
10	IF (K-1504) 11,21,11
11	IF (K-1312) 12,26,12
12	IF (K-480) 13,27,13
13	IF (K-1632) 14,31,14
14	IF (K-928) 15,30,15
15	IF (K-864) 16,38,16
16	IF (K-416) 3,29,3
C SET I FOR DARK VECTOR
17	I=0
	GOTO 20
C I=LIGHT VECTOR,CALL FDIS FOR LAST POINT
18	I=1
	CALL FDIS(0,NTAB(IPT,2),NTAB(IPT,3))
	GOTO 20
C I=POINT
19	I=-1
C DRAW VECTOR, PUT POINT IN TABLE
20	CALL FDIS(I,IX,IY)
	IPT=IPT+1
	NTAB(IPT,1)=I
	NTAB(IPT,2)=IX
	NTAB(IPT,3)=IY
	GOTO 3
C WRITE ROUTINE-GO HOME, CALL FDIS WITH EACH POINT
21	CALL FDIS(0,0,0)
	DO 22 N=1,IPT
22	CALL FDIS(NTAB(N,1),NTAB(N,2),NTAB(N,3))
	GOTO 3
C OMIT ROUTINE-GET NO OF POINTS TO OMIT
23	CALL ALPHA
	READ (1,100) M
100	FORMAT ('#',1I3)
	IF (IPT-M) 25,25,24
24	IPT=IPT-M
	CALL ERASE
	GOTO 21
25	CALL ERASE
	GOTO 1
26	CALL CHAIN ('TAPE')
27	CALL CHAIN ('GFIC')
29	CALL CHAIN ('MODIFY')
28	CALL EXIT
C WRITE IPT
30	CALL ALPHA
	WRITE (1,101) IPT
101	FORMAT (I3)
	GOTO 3
31	CALL ALPHA
C POLYGON ROUTINE
	READ (1,103) R,X
103	FORMAT ('RADIUS 'F3.0' # OF SIDES 'F3.0)
	CALL JOY(IX,IY,K)
	X4=6.2831853
	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))
34	IPT=IPT+1
	IF (IPT-500) 35,35,37
35	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) 36,36,3
36	CALL FDIS (1,NTAB(IPT,2),NTAB(IPT,3))
	GOTO 34
37	CALL ALPHA
	WRITE (1,104)
104	FORMAT ('MATRIX FILLED')
	GOTO 3
C MOVING SUBROUTINE
38	CALL ALPHA
	READ (1,105) K
105	FORMAT ('DESTROY OLD? Y=1, N=2 'I1)
	GOTO (40,39),K
39	NPT=IPT
	NTAB(IPT+1,1)=-1
	GOTO 41
40	NPT=0
41	CALL JOY(IX,IY,K)
	NX=IX
	NZ=IY
	CALL JOY(IX,IY,K)
	NX=IX-NX
	NZ=IY-NZ
	DO 42 N=1,IPT
	NTAB(NPT+N,1)=NTAB(N,1)
	NTAB(NPT+N,2)=NTAB(N,2)+NX
42	NTAB(NPT+N,3)=NTAB(N,3)+NZ
	IPT=IPT+NPT
	CALL ALPHA
	WRITE (1,106) IPT
106	FORMAT (I3)
	GOTO 3
	END