File GFIC.FT (FORTRAN source file)

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

	COMMON NTAB,IPT
	DIMENSION NTAB(500,3)
	GOTO 1420
1408	IPT=0
1420	N3=1
	N5=1
	Q4=1.
	J2=70
	GOTO 1410
1405	CALL ERASE
1410	CALL FDIS(0,0,767)
	CALL ALPHA
	CALL READD(K)
C	G-GRAPH,I-INIT,B-BILEVEL,S-SIZE,R-ROTATE,X-EXIT,W-WRITE,
C	E-ERASE,,T-TAPE,D-DRAW,C-CHARACTER,F-MODIFY
	IF (K-480) 1425,1500,1425
1425	IF (K-608) 1430,1408,1430
1430	IF (K-160) 1435,1600,1435
1435	IF (K-1248) 1440,1700,1440
1440	IF (K-1184) 1445,1800,1445
1445	IF (K-288) 1450,1250,1450
1450	IF (K-1568) 1460,2020,1460
1460	IF (K-1504) 1470,2000,1470
1470	IF (K-352) 1480,1405,1480
1480	IF (K-1312) 1000,1200,1000
1000	IF (K-224) 1490,1001,1490
1490	IF (K-416) 1410,1491,1410
1491	CALL CHAIN('MODIFY')
1200	CALL CHAIN('TAPE')
1250	CALL CHAIN('DRAW')
1001	CALL CHAIN ('CHAR')
C	WRITING ROUTINE
2000	N5=2
	GOTO (2005,1720,1819),N3
2005	CALL FDIS(0,NTAB(1,2),NTAB(1,3))
	DO 2010 N=1,IPT
2010 	CALL FDIS (NTAB(N,1),NTAB(N,2),NTAB(N,3))
	N3=1
	N5=1
	GOTO 1410
2020	CALL EXIT
C	GRAPHING ROUTINE
1500	CALL ALPHA
	READ (1,1550)A1,A2,A3,A4,A5,A6,A7
1550	FORMAT('ENTER COEF"S IN ORDER-(1X**2+3Z**4+5)**6*7',7('  ',F4.2))
	READ (1,1501) D,R,OX,OZ
1501	FORMAT('ENTER D,R,OX,OZ F4.2 ',4('  'F4.2))
1605	Z=-OZ
	DO 1532 I2=1,767,J2
	IPT=0
	DO 1531 I=0,1023,30
	X=-OX+FLOAT(I)*D/1023.
	Y=(A1*X**A2+A3*Z**A4+A5)**A6*A7
	IF(Y)1502,1502,1503
1502	Y=1.
1503	IF(Y-767.) 1505,1505,1504
1504	Y=767.
1505	IPT=IPT+1
	IF (IPT-500) 1506,1506,1507
1506	NTAB(IPT,1)=1
	NTAB(IPT,2)=I
	NTAB(IPT,3)=IFIX(Y)
	GOTO 1531
1507	WRITE (1,1592)
1592	FORMAT ('MATRIX FILLED')
	GOTO 1537
1531	CONTINUE
1537	CALL ERASE
	GOTO (1513,1720,1819),N3
1513	CALL FDIS(0,NTAB(1,2),NTAB(1,3))
	DO 1512	N=1,IPT
1512	CALL FDIS (NTAB(N,1),NTAB(N,2),NTAB(N,3))
	Z=-OZ+FLOAT (I2)*R/767.
1532	CONTINUE
	N3=1
	GOTO 1410
C	BILEVEL FUNCTION
1600	CALL ALPHA
	J2=767
	Q4=-1.
	WRITE(1,1610)
1610	FORMAT('ENTER Z-LEVEL FOR OZ')
	GOTO 1500
C	SCALING ROUTINE
1700	CALL ALPHA
	READ (1,1701) S
1701	FORMAT ('EXPANSION FACTOR ',F4.2)
	N3=2
	GOTO 1410
1720	DO 1730	N=1,IPT
	T=(FLOAT(NTAB(N,2))-512.)*S+512.
	R=(FLOAT(NTAB(N,3))-384.)*S+384.
	NTAB(N,2)=IFIX(T)
	NTAB(N,3)=IFIX(R)
1730	CONTINUE
	GOTO (1513,2005),N5
C	ROTATE FUNCTION
1800	CALL ALPHA
	READ (1,1801) NT2
1801	FORMAT ('DIRECTION ',A1)
C	W=CLOCKWISE,C=C-CLOCKWISE
	IF (NT2-1504) 1802,1810,1802
1802 	IF (NT2-224) 1410,1809,1410
C	CLOCKWISE ROTATION
1810	Q3=-1.
	GOTO 1811
1809	Q3=1.
1811	READ (1,1812) T
1812	FORMAT ('DEGREES F3.0 ',F3.0)
	Q2=T*3.1415925/180.*Q3
	Q3=COS(Q2)
	Q2=SIN(Q2)
	N3=3
	GOTO 1410
1819	DO 1820 N=1,IPT
	Q=Q3*FLOAT(NTAB(N,2)-512)+Q2*FLOAT(NTAB(N,3)-383)
	Q4=-Q2*FLOAT(NTAB(N,2)-512)+Q3*FLOAT(NTAB(N,3)-383)
	NTAB(N,2)=IFIX(Q)+512
1820	NTAB(N,3)=IFIX(Q4)+383
	GOTO (1513,2005),N5
	END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search