Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0118/book.for
There is 1 other file named book.for in the archive. Click here to see a list.
00100	C	LIBRARY OF PICTURE BOOK'S FORTRAN LANGUAGE SUBROUTINES
00200	C
00300	C
00400	C	DEC-11-GPBAA-B-LA
00500	C
00600	C	COPYRIGHT (C) 1974
00700	C	DIGITAL EQUIPMENT CORPORATION
00800	C	MAYNARD, MASSACHUSETTS 01754
00900	
01000	C	THE INFORMATION IN THIS SOURCE LISTING IS SUBJECT TO
01100	C	CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A
01200	C	COMMITTMENT BY DIGITAL EQUIPMENT CORPORATION.
01300	C	DIGITAL EQUIPTMENT CORPORATION ASSUMES NO RESPONSIBILITY
01400	C	FOR ANY ERRORS THAT MAY APPEAR IN THIS LISTING.
01500	
01600	C	THIS SOFTWARE IS FURNISHED TO THE PURCHASER
01700	C	UNDER A LICENSE FOR USE ON A SINGLE COMPUTER 
01800	C	SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S
01900	C	COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS
02000	C	MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
02100	
02200	C	DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
02300	C	FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT 
02400	C	THAT IS NOT SUPPLIED BY DIGITAL.
02500	C		
02600	C
02700	C
02800	C
02900	C
03000	C	R. FRIEDENTHAL
03100	C
03200	C	EDIT 1, 3/7/73
03300	C
03400	C
03500	C	TO ASSEMBLE THESE SUBROUTINES UNDER A MONITOR THAT CANNOT
03600	C	ASSEMBLE THEM AS ONE FILE,
03700	C	BREAK THIS FILE UP AT  END  STATEMENTS
03800	C
03900	C
04000	C	SCALE SETS THE SCALING, GIVEN THE COORDINATES OF THE LOWER LEFT
04100	C	AND UPPER RIGHT CORNERS OF THE SCREEN
04200		SUBROUTINE SCALE(G1,G2,G3,G4)
04300		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
04400		F1=G2-G1
04500	C			SET LENGTH OF X AXIS
04600		F2=G4-G3
04700	C			AND LENGTH OF Y AXIS
04800		F3=G1
04900	C			ALSO SAVE COORDINATES OF LOWER LEFT CORNER
05000		F4=G3
05100		RETURN
05200		END
     
00100	C	VX CALCULATES A SCALED, DOT COORDINATE FROM THE GIVEN SCREEN X COORDINATE
00200		FUNCTION VX(J2)
00300		COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		VX=FLOAT(J2)*F1/1023.
00500		RETURN
00600		END
     
00100	C	VY CALCULATES A SCALED, VECTOR COORDINATE FROM THE GIVEN SCREEN Y COORDINATE
00200		FUNCTION VY(J2)
00300		COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		VY=FLOAT(J2)*F1/1023.
00500		RETURN
00600		END
     
00100	C	DX CALCULATES A SCALED, DOT COORDINATE FROM THE GIVEN SCREEN X COORDINATE
00200		FUNCTION DX(J2)
00300		COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		DX=FLOAT(J2)*F1/1023.+F3
00500		RETURN
00600		END
     
00100	C	DY CALCULATES A SCALED, DOT COORDINATE FROM THE GIVEN SCREEN Y COORDINATE
00200		FUNCTION DY(J2)
00300		COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		DY=FLOAT(J2)*F1/1023.+F3
00500		RETURN
00600		END
     
00100	C	CURSOR CONTROL THE CURSOR.  FIRST ARGUMENT -1,0,1 FOR DOWN,
00200	C	NOTHING, UP. 2ND ARGUMENT -1,0,1 FOR LEFT, NOTHING RIGHT.
00300		SUBROUTINE CURSOR(J2,J3)
00400		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00500		GOTO(3,2,1),J2+2
00600		GOTO 2
00700	C			DISPATCH UP-DOWN
00800	1	N=26
00900	C			UP
01000		GOTO 4
01100	3	N=10
01200	C			DOWN
01300	4	CALL OUTCH(N)
01400	C			OUTPUT THE COMMAND
01500	2	GOTO(8,7,6),J3+2
01600		GOTO 7
01700	6	N=24
01800	C			RIGHT
01900		GOTO 9
02000	8	N=25
02100	C			LEFT
02200	9	CALL OUTCH(N)
02300	7	RETURN
02400		END
     
00100	C	ARC	DRAWS A ARC	OF DIAMETER D, WITH SIDES SIDES, OF AN
00200	C	ARC	THETA, AN AN ANGLE PHEE, WITH Y DIAMETER ELIP
00300	C	OF X DIAMETER
00400	
00500		SUBROUTINE ARC(D,IS,TH,PH,ELIP)
00600		INTEGER SIDES
00700		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00800		DI=D
00900		SIDES=IS
01000		THETA=TH
01100		PHE=PH
01200		ELIP=ELIP
01300		DI=DI/2.
01400		IF(SIDES.EQ.0)RETURN
01500		IF(THETA.EQ.0.)RETURN
01600	C			RETURN OF A NON-CIRCLE
01700		SECT=THETA/FLOAT(SIDES)
01800	C	CALCULATE ANGLE INCREMENT
01900		X0=DI*COS(PHE)
02000	C	LOCATES CENTER
02100		Y0=DI*SIN(PHE)
02200		X1=0
02300		Y1=0
02400		ANGL=-3.1415926-SECT
02500	C	SET ANGLE TO FIRST POINT ON FIGURE
02600		DO 155 IS=1,IABS(SIDES)
02700	C	CALCULATE COORDS WITH CENTER AT 0,0
02800		X=DI*COS(ANGL)
02900		Y=DI*SIN(ANGL)*ELIP*F1/F2
03000	C	ROTATE THE FIGURE AND SHIFT ITS CENTER
03100		R1=SQRT(X**2+Y**2)
03200		PHI=ATAN2(Y,X)
03300		X2=R1*COS(PHE+PHI)+X0
03400		Y2=R1*SIN(PHE+PHI)+Y0
03500		XI=X2-X1
03600		YJ=Y2-Y1
03700	C1151	IF(PUNCT.NE.'&')GOTO 151
03800	C	CALL RMOVE(I,J)
03900	C	GOTO 152
04000	C151	CALL RVECT(I,J,INV)
04100	C			THE ABOVE MIGHT MOVE THE SCREEN BY
04200	C	CHANGING THE LENGTH OF PICTURE 0, LINE 0
04300	151	CALL JOT(XI,YJ)
04400	C			DRAW THE CIRCLE IN THE CURRENT FIGURE
04500	152	X1=X2
04600		Y1=Y2
04700		ANGL=ANGL-SECT
04800	C	GO IN CLOCKWISE DIRETION FOR SECT POSITIVE
04900	155	CONTINUE
05000		RETURN
05100		END
     
00100	
00200	C	LAYOUT LAYS OUT THE BOOK ACCORDING TO ITS ARGUMENT LIST
00300	C	THE ARGUMENTS HAVE THE FOLLOWING MEANINGS:
00400	C	(SCROLL,CHARS,PICTURES,SIZE,FIGURES,SIZE,TABLES,SIZE,GRAPHS,SIZE,GREEK)
00500		FUNCTION LAYOUT(J2,J3,J4,J5,J6,J7,J8,J9,J10,J11,J12)
00600		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00700		I1=79
00800	C			ID LETTER O
00900		I2=J2
01000		I3=J3/2
01100		I4=J4
01200		I5=J5
01300		I6=J6
01400		I7=J7
01500		I8=J8
01600		I9=J9
01700		I10=J10
01800		I11=J11
01900		I12=J12
02000		CALL ARGOUT(12)
02100		CALL INNUM(LAYOUT)
02200		RETURN
02300		END
     
00100	C	OPENP OPENS A PICTURE
00200		SUBROUTINE OPENP(J2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=80
00500	C			ID LETTER P
00600		I2=J2
00700		CALL ARGOUT(2)
00800		RETURN
00900		END
     
00100	C	OPENF OPENS A FIGURE
00200		SUBROUTINE OPENF(J2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=70
00500	C			ID LETTER F
00600		I2=J2
00700		CALL ARGOUT(2)
00800		RETURN
00900		END
     
00100	C	OPENG OPENS A GRAPH
00200		SUBROUTINE OPENG(J2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=71
00500	C			ID LETTER G
00600		I2=J2
00700		CALL ARGOUT(2)
00800		RETURN
00900		END
     
00100	C	OPENT OPENS A TABLE
00200		SUBROUTINE OPENT(J2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=84
00500	C			ID LETTER T
00600		I2=J2
00700		CALL ARGOUT(2)
00800		RETURN
00900		END
     
00100	C	MARKP OPENS A LINE IN THE OPEN PICTURE
00200		SUBROUTINE MARKP(J2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=76
00600	C			ID LETTER L
00700		I2=J2
00800		CALL ARGOUT(2)
00900		MP=J2
01000	C			RESET THE PICTURE MARKER
01100		RETURN
01200		END
01300	C	MARKF OPENS AN INCH IN THE OPEN FIGURE
01400		SUBROUTINE MARKF(J2)
01500		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
01600		COMMON /MARKS/MP,MF,MG,MT
01700		I1=73
01800	C			ID LETTER I
01900		I2=J2
02000		CALL ARGOUT(2)
02100		MF=J2
02200	C			RESET THE FIGURE MARKER
02300		RETURN
02400		END
02500	C	MARKG OPENS AN INCH IN THE OPEN GRAPH
02600		SUBROUTINE MARKG(J2)
02700		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
02800		COMMON /MARKS/MMP,MF,MG,MT
02900		I1=65
03000	C			ID LETTER A
03100		I2=J2
03200		CALL ARGOUT(2)
03300		MG=J2
03400	C			RESET THE GRAPH MARKER
03500		RETURN
03600		END
     
00100	C	MARKT OPENS AN INCH IN THE OPEN TABLE
00200		SUBROUTINE MARKT(J2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=75
00600	C			ID LETTER K
00700		I2=J2
00800		CALL ARGOUT(2)
00900		MT=J2*2
01000	C			RESET THE CHARACTER MARKER (2*TABLE MARKER)
01100		RETURN
01200		END
     
00100	C	ERASEP ERASES THE OPEN PICTURE STARTING AT THE OPEN LINE
00200		SUBROUTINE ERASEP
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=69
00500	C			ID LETTER E
00600		I2=80
00700	C			ID LETTER P
00800		CALL ARGOUT(2)
00900		RETURN
01000		END
     
00100	C	ERASEF ERASES THE OPEN FIGURE STARTING AT THE OPEN INCH
00200		SUBROUTINE ERASEF
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=69
00500	C			ID LETTER E
00600		I2=70
00700	C			ID LETTER F
00800		CALL ARGOUT(2)
00900		RETURN
01000		END
     
00100	C	ERASEG ERASES THE OPEN GRAPH STARTING AT THE OPEN INCH
00200		SUBROUTINE ERASEG
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=69
00500	C			ID LETTER E
00600		I2=71
00700	C			ID LETTER G
00800		CALL ARGOUT(2)
00900		RETURN
01000		END
     
00100	C	ERASET ERASES THE OPEN TABLE STARTING AT THE OPEN INCH
00200		SUBROUTINE ERASET
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=69
00500	C			ID LETTER E
00600		I2=84
00700	C			ID LETTER T
00800		CALL ARGOUT(2)
00900		RETURN
01000		END
     
00100	C	BITS SPECIFIES THE MODE OF THE NEXT DATUM TO ENTER A PICTURE
00200	C	ITS ARGUMENTS HAVE THE FOLLOWING SIGNIFICANCE
00300	C	(BLINK[0-1],INTENSITY[0-7],TYPE[0-3],LIGHT SENSITIVITY[0-1])
00400	C	0 IS LOWEST INTENSITY, 7 HIGHEST
00500	C	LINE TYPES ARE SOLID, LONGDASH, SHORTDASH, DOTDASH IN THAT ORDER
00600		SUBROUTINE BITS(J2,J3,J4,J5)
00700		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00800		I1=66
00900	C			ID LETTER B
01000		I2=J2
01100		I3=J3
01200		I4=J4
01300		I5=J5
01400		CALL ARGOUT(5)
01500		RETURN
01600		END
     
00100	C	PICTURE EXECUTES A SUBPAGE CALL TO A PICTURE
00200		SUBROUTINE PICTUR(J3,J4)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=67
00600	C			ID LETTER C
00700		I2=80
00800	C			ID LETTER P
00900		I3=J3
01000		I4=J4
01100		CALL ARGOUT(4)
01200		MP=MP+1
01300	C			POP PICTURE MARKER
01400		RETURN
01500		END
     
00100	C	VECFIG CALLS A FIGURE AS A SERIES OF SHORT VECTORS
00200		SUBROUTINE VECFIG(J3,J4)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=67
00600	C			ID LETTER C
00700		I2=86
00800	C			ID LETTER V
00900		I3=J3
01000		I4=J4
01100		CALL ARGOUT(4)
01200		MP=MP+1
01300	C			POP PICTURE MARKER
01400		RETURN
01500		END
     
00100	C	DOTFIG CALLS A FIGURE AS A SERIES OF RELATIVE POINTS
00200		SUBROUTINE DOTFIG(J3,J4)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=67
00600	C			ID LETTER C
00700		I2=68
00800	C			ID LETTER D
00900		I3=J3
01000		I4=J4
01100		CALL ARGOUT(4)
01200		MP=MP+1
01300	C			POP PICTURE MARKER
01400		RETURN
01500		END
     
00100	C	XGRAPH CALLS A GRAPH AS A SERIES OF Y VALUES ALONG AN X AXIS
00200		SUBROUTINE XGRAPH(J3,J4)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=67
00600	C			ID LETTER C
00700		I2=88
00800	C			ID LETTER X
00900		I3=J3
01000		I4=J4
01100		CALL ARGOUT(4)
01200		MP=MP+1
01300	C			POP PICTURE MARKER
01400		RETURN
01500		END
     
00100	C	YGRAPH CALLS A GRAPH AS SERIES OF X VALUES ALONG THE Y AXIS
00200		SUBROUTINE YGRAPH(J3,J4)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=67
00600	C			ID LETTER C
00700		I2=89
00800	C			ID LETTER Y
00900		I3=J3
01000		I4=J4
01100		CALL ARGOUT(4)
01200		MP=MP+1
01300	C			POP PICTURE MARKER
01400		RETURN
01500		END
     
00100	C	TABLE CALLS A TABLE
00200		SUBROUTINE TABLE(J3,J4)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=67
00600	C			ID LETTER C
00700		I2=84
00800	C			ID LETTER T
00900		I3=J3
01000		I4=J4
01100		CALL ARGOUT(4)
01200		MP=MP+1
01300	C			POP PICTURE MARKER
01400		RETURN
01500		END
     
00100	C	VECTOR DRAWS A VECTOR
00200		SUBROUTINE VECTOR(G1,G2)
00300		COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=86
00600	C			ID LETTER V
00700		I2=IFIX(1023.*G1/F1)
00800		I3=IFIX(1023.*G2/F2)
00900		CALL NUMOUT(3)
01000		MP=MP+1
01100	C			POP PICTURE MARKER
01200		RETURN
01300		END
     
00100	C	MOVE DRAWS AN INVIBLE VECTOR IN A PICTURE
00200		SUBROUTINE MOVE(G1,G2)
00300		COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=77
00600	C			ID LETTER M
00700		I2=IFIX(1023.*G1/F1)
00800		I3=IFIX(1023.*G2/F2)
00900		CALL NUMOUT(3)
01000		MP=MP+1
01100	C			POP PICTURE MARKER
01200		RETURN
01300		END
     
00100	C	DOT DRAWS AN ABSOLUTE POINT IN A PICTURE
00200		SUBROUTINE DOT(G1,G2)
00300		COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=68
00600	C			ID LETTER D
00700		I2=IFIX(1023.*(G1-F3)/F1)
00800		I3=IFIX(1023.*(G2-F4)/F2)
00900		CALL NUMOUT(3)
01000		MP=MP+1
01100	C			POP PICTURE MARKER
01200		RETURN
01300		END
     
00100	C	SET DRAWS AN INVIBLE ABSOLUTE POINT IN A PICTURE
00200		SUBROUTINE SET(G1,G2)
00300		COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=83
00600	C			ID LETTER S
00700		I2=IFIX(1023.*(G1-F3)/F1)
00800		I3=IFIX(1023.*(G2-F4)/F2)
00900		CALL NUMOUT(3)
01000		MP=MP+1
01100	C			POP PICTURE MARKER
01200		RETURN
01300		END
     
00100	C	JOT ADDS DATA TO FIGURES
00200		SUBROUTINE JOT(G1,G2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=74
00600	C			SET ID LETTER, J
00700		I2=IFIX(1023.*G1/F1)
00800		I3=IFIX(1023.*G2/F2)
00900		CALL ARGOUT(3)
01000	C			AND OUTPUT ARGUMENTS AS SINGLE BYTES
01100		MF=MF+1
01200	C			POP FIGURE MARKER
01300		RETURN
01400		END
     
00100	C	NOJOT ADDS INVISIBLE DATA TO FIGURES
00200		SUBROUTINE NOJOT(G1,G2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=78
00600	C			SET ID LETTER, J
00700		I2=IFIX(1023.*G1/F1)
00800		I3=IFIX(1023.*G2/F2)
00900		CALL ARGOUT(3)
01000	C			AND OUTPUT ARGUMENTS AS SINGLE BYTES
01100		MF=MF+1
01200	C			POP FIGURE MARKER
01300		RETURN
01400		END
     
00100	C	PLOT PLOTS A POINT IN A GRAPH
00200		SUBROUTINE PLOT(J2)
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		COMMON /MARKS/MP,MF,MG,MT
00500		I1=90
00600	C			I1 HOLDS ID LETTER, Z
00700	C			I2 HOLDS DATA
00800		I2=J2
00900		CALL NUMOUT(2)
01000	C			SEND OUT THE INFORMATION
01100		IF(J2.GE.0)MG=MG+1
01200	C			POP GRAPH MARKER ON NON-NEGATIVE ARGUMENT
01300		RETURN
01400		END
     
00100	C	TEXT WILL OUTPUT WITHIN QUOTES THE FIRST N CHARACTERS IN THE
00200	C	ARGUMENT ARRAY
00300	
00400		SUBROUTINE TEXT(N,IARRAY)
00500		DIMENSION IARRAY(1)
00600		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00700		COMMON /MARKS/MP,MF,MG,MT
00800		CALL OUTCH(4)
00900	C			CONTROL D
01000		CALL OUTCH(81)
01100	C			Q
01200		CALL OUTCH(N)
01300	C			NUMBER OF CHARS TO FOLLOW
01400		WRITE(5,1)(IARRAY(I),I=1,N)
01500	C			OUTPUT THE CHARACTERS
01600	1	FORMAT('+',100A1)
01700		MT=MT+N
01800	C			POP CHARACTER MARKER BY NUMBER OF CHARACTERS
01900		RETURN
02000		END
     
00100	C	LINEX RETURNS THE X COORDINATE OF THE PICTURE AND LINE SPECIFIED
00200		FUNCTION LINEX(J2,J3)
00300		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=88
00500	C			X
00600		I2=J2
00700		I3=J3
00800		CALL ARGOUT(3)
00900		CALL INNUM(LINEX)
01000	C			READ THE COORDINATE
01100		RETURN
01200		END
     
00100	C	LINEY RETURNS THE Y COORDINATE OF THE PICTURE AND LINE SPECIFIED
00200		FUNCTION LINEY(J2,J3)
00300		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=89
00500	C			Y
00600		I2=J2
00700		I3=J3
00800		CALL ARGOUT(3)
00900		CALL INNUM(LINEY)
01000	C			READ THE COORDINATE
01100		RETURN
01200		END
     
00100	C	HIT RETURNS THE PICTURE AND LINE LAST HIT BY THE LIGHT PEN
00200		SUBROUTINE HIT(J2,J3)
00300		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		CALL OUTCH(4)
00500		CALL OUTCH(72)
00600	C			H
00700		CALL INNUM(J2)
00800		CALL INNUM(J3)
00900		RETURN
01000		END
     
00100	C	UNHIT WAITS FOR THE NEXT LIGHT PEN HIT, THEN
00200	C	RETURNS THE PICTURE AND LINE HIT
00300		SUBROUTINE UNHIT(J2,J3)
00400		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00500		CALL OUTCH(4)
00600		CALL OUTCH(85)
00700	C			U
00800		CALL INNUM(J2)
00900		CALL INNUM(J3)
01000		RETURN
01100		END
     
00100	C	IOTA STARTS THE CLOCK FOR ARG>0, READS THE CLOCK
00200	C	AS A POSITIVE VALUE, MOD 4096 FOR ARG=0, OR STOPS
00300	C	THE CLOCK FOR ARG<0
00400		FUNCTION IOTA(J2)
00500		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00600		I1=64
00700	C			ID LETTER @
00800		I2=J2
00900		CALL ARGOUT(2)
01000	C			OUTPUT THE ARGUMENTS
01100		IF(J2.EQ.0)CALL INNUM(IOTA)
01200	C			ON 0 ARG, READ THE CLOCK
01300		RETURN
01400		END
     
00100	C	WAIT WAITS FOR ITS OWN EXECUTION BEFORE RETURNING TO CALLER
00200		SUBROUTINE WAIT
00300		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		CALL OUTCH(4)
00500		CALL OUTCH(87)
00600	C			W
00700		CALL INNUM(J2)
00800	C			GET THE DUMMY RETURN
00900		RETURN
01000		END
     
00100	C	THEEND RESET THE BOOK TO 32 LINES OF TEXT AND ALL PICTURES, 100 LINES LONG
00200		SUBROUTINE THEEND
00300		COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		I1=82
00500	C			ID LETTER R
00600		CALL ARGOUT(1)
00700		RETURN
00800		END
     
00100	C	BELL RINGS THE GT40'S BELL
00200		SUBROUTINE BELL
00300		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00400		CALL OUTCH(7)
00500		STOP
00600		END
     
00100	C	NUMOUT HANDLES THE OUTPUT FOR ROUTINES THAT OUT@PUT VALUES
00200	C	IN EXCESS OF 128, I.E. VALUE THAT REQUIRE 2 BYTES
00300	C	IT OUTPUTS CONTROL G, FOLLOWED BY THE ID CHARACTER FOLLOWED
00400	C	BY THE VALUES.
00500	C	ITS ARGUMENT SPECIFIES THE TOTAL NUMBER OF DATUM TO OUTPUT BESIDES
00600	C	THE CONTROL G
00700		SUBROUTINE NUMOUT(N)
00800		DIMENSION IARGS(3)
00900		COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
01000		EQUIVALENCE (IARGS(1),I1)
01100		CALL OUTCH(4)
01200	C			OUTPUT CONTROL G
01300		CALL OUTCH(I1)
01400	C			OUTPUT ID CHARACTER
01500		DO 1 I=2,N
01600		CALL OUTNUM(IARGS(I))
01700	C			OUTPUT NUMERIC	ARGUMENTS, 2 BYTES EACH
01800	1	CONTINUE
01900		RETURN
02000		END
     
00100	C	ARGOUT OUTPUTS A STRING OF GRAPHIC	DATA .
00200	C	THE STRING STARTS WITH A CONTROL D (4)
00300	C	THE ARGUMENTS FROM THE COMMON ARGUMENT LIST
00400	C	THEIR NUMBER SPECIFIED IN ARGOUT'S ARGUMENT
00500	C	FOLLOW THIS CONTROL CHARACTER
00600	C	THE CALLING ROUTINE SETS UP THE COMMON ARGUMENTS
00700	C	JUST AS PICTURE BOOK NEEDS TO RECEIVE THEM
00800		SUBROUTINE ARGOUT(N)
00900		DIMENSION IARGS(10)
01000		COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
01100		EQUIVALENCE (IARGS(1),I1)
01200		CALL OUTCH(4)
01300	C			OUTPUT CONTROL D
01400		DO 1 I=1,N
01500		CALL OUTCH(IARGS(I))
01600	C			NOW OUTPUT ARGUMENTS
01700	1	CONTINUE
01800		RETURN
01900		END
     
00100	C	INNUM READS AN OCTAL NUMBER CONSISTING OF A MAXIMUM OF 4
00200	C	DIGITS SOMETIMES PRECEDED BY A MINUS SIGN AND FOLLOWED BY A CRLF
00300		SUBROUTINE INNUM(K)
00400		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00500		DATA MINUS/45/,LINEF/10/
00600		NUM=0
00700		ISIGN=1
00800	1	CALL INCH(I)
00900		IF(I.EQ.MINUS)ISIGN=-1
01000		IF(I.GE.48.AND.I.LT.56)NUM=NUM*8+I-48
01100	C			ADD ON AN OCTAL NUMBER
01200		IF(I.NE.LINEF)GOTO 1
01300	C			KEEP READING TILL LINE FEED
01400		K=NUM*ISIGN
01500		RETURN
01600		END
     
00100	C	OUTNUM OUTPUTS THE VALUE IN ITS ARGUMENT AS A HIGH AND LOW BYTE,
00200	C	FIRST CONVERTING TO A 14 BIT NUMBER
00300	
00400		FUNCTION OUTNUM(IVAL)
00500		COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
00600		IVAL=IVAL-(IVAL/8192)*8192
00700	C			MAKE MODULO 8192
00800		IF(IVAL.LT.0)IVAL=16384+IVAL
00900	C			THEN MAKE A NEGATIVE IVAL >8192
01000		IHI=IVAL/128
01100	C				GET THE HI BYTE
01200		ILO=IVAL-IHI*128
01300	C				AND THE LOW
01400		CALL OUTCH(IHI)
01500	C				AND OUTPUT THEM
01600		CALL OUTCH(ILO)
01700		OUTNUM=0
01800		RETURN
01900		END