PDP-10 Archive: 43,50434/book.f4 from decuslib10-06

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50434/book.f4

There are no other files named book.f4 in the archive.

C	LIBRARY OF PICTURE BOOK'S FORTRAN LANGUAGE SUBROUTINES
C
C
C	DEC-11-GPBAA-B-LA
C
C	COPYRIGHT (C) 1974
C	DIGITAL EQUIPMENT CORPORATION
C	MAYNARD, MASSACHUSETTS 01754

C	THE INFORMATION IN THIS SOURCE LISTING IS SUBJECT TO
C	CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A
C	COMMITTMENT BY DIGITAL EQUIPMENT CORPORATION.
C	DIGITAL EQUIPTMENT CORPORATION ASSUMES NO RESPONSIBILITY
C	FOR ANY ERRORS THAT MAY APPEAR IN THIS LISTING.

C	THIS SOFTWARE IS FURNISHED TO THE PURCHASER
C	UNDER A LICENSE FOR USE ON A SINGLE COMPUTER 
C	SYSTEM AND CAN BE COPIED (WITH INCLUSION OF DIGITAL'S
C	COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS
C	MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.

C	DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
C	FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT 
C	THAT IS NOT SUPPLIED BY DIGITAL.
C		
C
C
C
C
C	R. FRIEDENTHAL
C
C	EDIT 1, 3/7/73
C
C
C	TO ASSEMBLE THESE SUBROUTINES UNDER A MONITOR THAT CANNOT
C	ASSEMBLE THEM AS ONE FILE,
C	BREAK THIS FILE UP AT  END  STATEMENTS
C
C

C	SCALE SETS THE SCALING, GIVEN THE COORDINATES OF THE LOWER LEFT
C	AND UPPER RIGHT CORNERS OF THE SCREEN
	SUBROUTINE SCALE(G1,G2,G3,G4)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	F1=G2-G1
C			SET LENGTH OF X AXIS
	F2=G4-G3
C			AND LENGTH OF Y AXIS
	F3=G1
C			ALSO SAVE COORDINATES OF LOWER LEFT CORNER
	F4=G3
	RETURN
	END

C	VX CALCULATES A SCALED, DOT COORDINATE FROM THE GIVEN SCREEN X COORDINATE
	FUNCTION VX(J2)
	COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	VX=FLOAT(J2)*F1/1023.
	RETURN
	END

C	VY CALCULATES A SCALED, VECTOR COORDINATE FROM THE GIVEN SCREEN Y COORDINATE
	FUNCTION VY(J2)
	COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	VY=FLOAT(J2)*F1/1023.
	RETURN
	END

C	DX CALCULATES A SCALED, DOT COORDINATE FROM THE GIVEN SCREEN X COORDINATE
	FUNCTION DX(J2)
	COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	DX=FLOAT(J2)*F1/1023.+F3
	RETURN
	END

C	DY CALCULATES A SCALED, DOT COORDINATE FROM THE GIVEN SCREEN Y COORDINATE
	FUNCTION DY(J2)
	COMMON/BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	DY=FLOAT(J2)*F1/1023.+F3
	RETURN
	END

C	CURSOR CONTROL THE CURSOR.  FIRST ARGUMENT -1,0,1 FOR DOWN,
C	NOTHING, UP. 2ND ARGUMENT -1,0,1 FOR LEFT, NOTHING RIGHT.
	SUBROUTINE CURSOR(J2,J3)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	GOTO(3,2,1),J2+2
	GOTO 2
C			DISPATCH UP-DOWN
1	N=26
C			UP
	GOTO 4
3	N=10
C			DOWN
4	CALL OUTCH(N)
C			OUTPUT THE COMMAND
2	GOTO(8,7,6),J3+2
	GOTO 7
6	N=24
C			RIGHT
	GOTO 9
8	N=25
C			LEFT
9	CALL OUTCH(N)
7	RETURN
	END

C	ARC	DRAWS A ARC	OF DIAMETER D, WITH SIDES SIDES, OF AN
C	ARC	THETA, AN AN ANGLE PHEE, WITH Y DIAMETER ELIP
C	OF X DIAMETER

	SUBROUTINE ARC(D,IS,TH,PH,ELIP)
	INTEGER SIDES
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	DI=D
	SIDES=IS
	THETA=TH
	PHE=PH
	ELIP=ELIP
	DI=DI/2.
	IF(SIDES.EQ.0)RETURN
	IF(THETA.EQ.0.)RETURN
C			RETURN OF A NON-CIRCLE
	SECT=THETA/FLOAT(SIDES)
C	CALCULATE ANGLE INCREMENT
	X0=DI*COS(PHE)
C	LOCATES CENTER
	Y0=DI*SIN(PHE)
	X1=0
	Y1=0
	ANGL=-3.1415926-SECT
C	SET ANGLE TO FIRST POINT ON FIGURE
	DO 155 IS=1,IABS(SIDES)
C	CALCULATE COORDS WITH CENTER AT 0,0
	X=DI*COS(ANGL)
	Y=DI*SIN(ANGL)*ELIP*F1/F2
C	ROTATE THE FIGURE AND SHIFT ITS CENTER
	R1=SQRT(X**2+Y**2)
	PHI=ATAN2(Y,X)
	X2=R1*COS(PHE+PHI)+X0
	Y2=R1*SIN(PHE+PHI)+Y0
	XI=X2-X1
	YJ=Y2-Y1
C1151	IF(PUNCT.NE.'&')GOTO 151
C	CALL RMOVE(I,J)
C	GOTO 152
C151	CALL RVECT(I,J,INV)
C			THE ABOVE MIGHT MOVE THE SCREEN BY
C	CHANGING THE LENGTH OF PICTURE 0, LINE 0
151	CALL JOT(XI,YJ)
C			DRAW THE CIRCLE IN THE CURRENT FIGURE
152	X1=X2
	Y1=Y2
	ANGL=ANGL-SECT
C	GO IN CLOCKWISE DIRETION FOR SECT POSITIVE
155	CONTINUE
	RETURN
	END

C	LAYOUT LAYS OUT THE BOOK ACCORDING TO ITS ARGUMENT LIST
C	THE ARGUMENTS HAVE THE FOLLOWING MEANINGS:
C	(SCROLL,CHARS,PICTURES,SIZE,FIGURES,SIZE,TABLES,SIZE,GRAPHS,SIZE,GREEK)
	FUNCTION LAYOUT(J2,J3,J4,J5,J6,J7,J8,J9,J10,J11,J12)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=79
C			ID LETTER O
	I2=J2
	I3=J3/2
	I4=J4
	I5=J5
	I6=J6
	I7=J7
	I8=J8
	I9=J9
	I10=J10
	I11=J11
	I12=J12
	CALL ARGOUT(12)
	CALL INNUM(LAYOUT)
	RETURN
	END

C	OPENP OPENS A PICTURE
	SUBROUTINE OPENP(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=80
C			ID LETTER P
	I2=J2
	CALL ARGOUT(2)
	RETURN
	END

C	OPENF OPENS A FIGURE
	SUBROUTINE OPENF(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=70
C			ID LETTER F
	I2=J2
	CALL ARGOUT(2)
	RETURN
	END

C	OPENG OPENS A GRAPH
	SUBROUTINE OPENG(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=71
C			ID LETTER G
	I2=J2
	CALL ARGOUT(2)
	RETURN
	END

C	OPENT OPENS A TABLE
	SUBROUTINE OPENT(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=84
C			ID LETTER T
	I2=J2
	CALL ARGOUT(2)
	RETURN
	END

C	MARKP OPENS A LINE IN THE OPEN PICTURE
	SUBROUTINE MARKP(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=76
C			ID LETTER L
	I2=J2
	CALL ARGOUT(2)
	MP=J2
C			RESET THE PICTURE MARKER
	RETURN
	END
C	MARKF OPENS AN INCH IN THE OPEN FIGURE
	SUBROUTINE MARKF(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=73
C			ID LETTER I
	I2=J2
	CALL ARGOUT(2)
	MF=J2
C			RESET THE FIGURE MARKER
	RETURN
	END
C	MARKG OPENS AN INCH IN THE OPEN GRAPH
	SUBROUTINE MARKG(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MMP,MF,MG,MT
	I1=65
C			ID LETTER A
	I2=J2
	CALL ARGOUT(2)
	MG=J2
C			RESET THE GRAPH MARKER
	RETURN
	END

C	MARKT OPENS AN INCH IN THE OPEN TABLE
	SUBROUTINE MARKT(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=75
C			ID LETTER K
	I2=J2
	CALL ARGOUT(2)
	MT=J2*2
C			RESET THE CHARACTER MARKER (2*TABLE MARKER)
	RETURN
	END

C	ERASEP ERASES THE OPEN PICTURE STARTING AT THE OPEN LINE
	SUBROUTINE ERASEP
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=69
C			ID LETTER E
	I2=80
C			ID LETTER P
	CALL ARGOUT(2)
	RETURN
	END

C	ERASEF ERASES THE OPEN FIGURE STARTING AT THE OPEN INCH
	SUBROUTINE ERASEF
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=69
C			ID LETTER E
	I2=70
C			ID LETTER F
	CALL ARGOUT(2)
	RETURN
	END

C	ERASEG ERASES THE OPEN GRAPH STARTING AT THE OPEN INCH
	SUBROUTINE ERASEG
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=69
C			ID LETTER E
	I2=71
C			ID LETTER G
	CALL ARGOUT(2)
	RETURN
	END

C	ERASET ERASES THE OPEN TABLE STARTING AT THE OPEN INCH
	SUBROUTINE ERASET
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=69
C			ID LETTER E
	I2=84
C			ID LETTER T
	CALL ARGOUT(2)
	RETURN
	END

C	BITS SPECIFIES THE MODE OF THE NEXT DATUM TO ENTER A PICTURE
C	ITS ARGUMENTS HAVE THE FOLLOWING SIGNIFICANCE
C	(BLINK[0-1],INTENSITY[0-7],TYPE[0-3],LIGHT SENSITIVITY[0-1])
C	0 IS LOWEST INTENSITY, 7 HIGHEST
C	LINE TYPES ARE SOLID, LONGDASH, SHORTDASH, DOTDASH IN THAT ORDER
	SUBROUTINE BITS(J2,J3,J4,J5)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=66
C			ID LETTER B
	I2=J2
	I3=J3
	I4=J4
	I5=J5
	CALL ARGOUT(5)
	RETURN
	END

C	PICTURE EXECUTES A SUBPAGE CALL TO A PICTURE
	SUBROUTINE PICTUR(J3,J4)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=67
C			ID LETTER C
	I2=80
C			ID LETTER P
	I3=J3
	I4=J4
	CALL ARGOUT(4)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	VECFIG CALLS A FIGURE AS A SERIES OF SHORT VECTORS
	SUBROUTINE VECFIG(J3,J4)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=67
C			ID LETTER C
	I2=86
C			ID LETTER V
	I3=J3
	I4=J4
	CALL ARGOUT(4)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	DOTFIG CALLS A FIGURE AS A SERIES OF RELATIVE POINTS
	SUBROUTINE DOTFIG(J3,J4)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=67
C			ID LETTER C
	I2=68
C			ID LETTER D
	I3=J3
	I4=J4
	CALL ARGOUT(4)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	XGRAPH CALLS A GRAPH AS A SERIES OF Y VALUES ALONG AN X AXIS
	SUBROUTINE XGRAPH(J3,J4)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=67
C			ID LETTER C
	I2=88
C			ID LETTER X
	I3=J3
	I4=J4
	CALL ARGOUT(4)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	YGRAPH CALLS A GRAPH AS SERIES OF X VALUES ALONG THE Y AXIS
	SUBROUTINE YGRAPH(J3,J4)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=67
C			ID LETTER C
	I2=89
C			ID LETTER Y
	I3=J3
	I4=J4
	CALL ARGOUT(4)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	TABLE CALLS A TABLE
	SUBROUTINE TABLE(J3,J4)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=67
C			ID LETTER C
	I2=84
C			ID LETTER T
	I3=J3
	I4=J4
	CALL ARGOUT(4)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	VECTOR DRAWS A VECTOR
	SUBROUTINE VECTOR(G1,G2)
	COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=86
C			ID LETTER V
	I2=IFIX(1023.*G1/F1)
	I3=IFIX(1023.*G2/F2)
	CALL NUMOUT(3)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	MOVE DRAWS AN INVIBLE VECTOR IN A PICTURE
	SUBROUTINE MOVE(G1,G2)
	COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=77
C			ID LETTER M
	I2=IFIX(1023.*G1/F1)
	I3=IFIX(1023.*G2/F2)
	CALL NUMOUT(3)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	DOT DRAWS AN ABSOLUTE POINT IN A PICTURE
	SUBROUTINE DOT(G1,G2)
	COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=68
C			ID LETTER D
	I2=IFIX(1023.*(G1-F3)/F1)
	I3=IFIX(1023.*(G2-F4)/F2)
	CALL NUMOUT(3)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	SET DRAWS AN INVIBLE ABSOLUTE POINT IN A PICTURE
	SUBROUTINE SET(G1,G2)
	COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=83
C			ID LETTER S
	I2=IFIX(1023.*(G1-F3)/F1)
	I3=IFIX(1023.*(G2-F4)/F2)
	CALL NUMOUT(3)
	MP=MP+1
C			POP PICTURE MARKER
	RETURN
	END

C	JOT ADDS DATA TO FIGURES
	SUBROUTINE JOT(G1,G2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=74
C			SET ID LETTER, J
	I2=IFIX(1023.*G1/F1)
	I3=IFIX(1023.*G2/F2)
	CALL ARGOUT(3)
C			AND OUTPUT ARGUMENTS AS SINGLE BYTES
	MF=MF+1
C			POP FIGURE MARKER
	RETURN
	END

C	NOJOT ADDS INVISIBLE DATA TO FIGURES
	SUBROUTINE NOJOT(G1,G2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=78
C			SET ID LETTER, J
	I2=IFIX(1023.*G1/F1)
	I3=IFIX(1023.*G2/F2)
	CALL ARGOUT(3)
C			AND OUTPUT ARGUMENTS AS SINGLE BYTES
	MF=MF+1
C			POP FIGURE MARKER
	RETURN
	END

C	PLOT PLOTS A POINT IN A GRAPH
	SUBROUTINE PLOT(J2)
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	I1=90
C			I1 HOLDS ID LETTER, Z
C			I2 HOLDS DATA
	I2=J2
	CALL NUMOUT(2)
C			SEND OUT THE INFORMATION
	IF(J2.GE.0)MG=MG+1
C			POP GRAPH MARKER ON NON-NEGATIVE ARGUMENT
	RETURN
	END

C	TEXT WILL OUTPUT WITHIN QUOTES THE FIRST N CHARACTERS IN THE
C	ARGUMENT ARRAY

	SUBROUTINE TEXT(N,IARRAY)
	DIMENSION IARRAY(1)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	COMMON /MARKS/MP,MF,MG,MT
	CALL OUTCH(4)
C			CONTROL D
	CALL OUTCH(81)
C			Q
	CALL OUTCH(N)
C			NUMBER OF CHARS TO FOLLOW
	WRITE(5,1)(IARRAY(I),I=1,N)
C			OUTPUT THE CHARACTERS
1	FORMAT('+',100A1)
	MT=MT+N
C			POP CHARACTER MARKER BY NUMBER OF CHARACTERS
	RETURN
	END

C	LINEX RETURNS THE X COORDINATE OF THE PICTURE AND LINE SPECIFIED
	FUNCTION LINEX(J2,J3)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=88
C			X
	I2=J2
	I3=J3
	CALL ARGOUT(3)
	CALL INNUM(LINEX)
C			READ THE COORDINATE
	RETURN
	END

C	LINEY RETURNS THE Y COORDINATE OF THE PICTURE AND LINE SPECIFIED
	FUNCTION LINEY(J2,J3)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=89
C			Y
	I2=J2
	I3=J3
	CALL ARGOUT(3)
	CALL INNUM(LINEY)
C			READ THE COORDINATE
	RETURN
	END

C	HIT RETURNS THE PICTURE AND LINE LAST HIT BY THE LIGHT PEN
	SUBROUTINE HIT(J2,J3)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	CALL OUTCH(4)
	CALL OUTCH(72)
C			H
	CALL INNUM(J2)
	CALL INNUM(J3)
	RETURN
	END

C	UNHIT WAITS FOR THE NEXT LIGHT PEN HIT, THEN
C	RETURNS THE PICTURE AND LINE HIT
	SUBROUTINE UNHIT(J2,J3)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	CALL OUTCH(4)
	CALL OUTCH(85)
C			U
	CALL INNUM(J2)
	CALL INNUM(J3)
	RETURN
	END

C	IOTA STARTS THE CLOCK FOR ARG>0, READS THE CLOCK
C	AS A POSITIVE VALUE, MOD 4096 FOR ARG=0, OR STOPS
C	THE CLOCK FOR ARG<0
	FUNCTION IOTA(J2)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=64
C			ID LETTER @
	I2=J2
	CALL ARGOUT(2)
C			OUTPUT THE ARGUMENTS
	IF(J2.EQ.0)CALL INNUM(IOTA)
C			ON 0 ARG, READ THE CLOCK
	RETURN
	END

C	WAIT WAITS FOR ITS OWN EXECUTION BEFORE RETURNING TO CALLER
	SUBROUTINE WAIT
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	CALL OUTCH(4)
	CALL OUTCH(87)
C			W
	CALL INNUM(J2)
C			GET THE DUMMY RETURN
	RETURN
	END

C	THEEND RESET THE BOOK TO 32 LINES OF TEXT AND ALL PICTURES, 100 LINES LONG
	SUBROUTINE THEEND
	COMMON /BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	I1=82
C			ID LETTER R
	CALL ARGOUT(1)
	RETURN
	END

C	BELL RINGS THE GT40'S BELL
	SUBROUTINE BELL
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	CALL OUTCH(7)
	STOP
	END

C	NUMOUT HANDLES THE OUTPUT FOR ROUTINES THAT OUT@PUT VALUES
C	IN EXCESS OF 128, I.E. VALUE THAT REQUIRE 2 BYTES
C	IT OUTPUTS CONTROL G, FOLLOWED BY THE ID CHARACTER FOLLOWED
C	BY THE VALUES.
C	ITS ARGUMENT SPECIFIES THE TOTAL NUMBER OF DATUM TO OUTPUT BESIDES
C	THE CONTROL G
	SUBROUTINE NUMOUT(N)
	DIMENSION IARGS(3)
	COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	EQUIVALENCE (IARGS(1),I1)
	CALL OUTCH(4)
C			OUTPUT CONTROL G
	CALL OUTCH(I1)
C			OUTPUT ID CHARACTER
	DO 1 I=2,N
	CALL OUTNUM(IARGS(I))
C			OUTPUT NUMERIC	ARGUMENTS, 2 BYTES EACH
1	CONTINUE
	RETURN
	END

C	ARGOUT OUTPUTS A STRING OF GRAPHIC	DATA .
C	THE STRING STARTS WITH A CONTROL D (4)
C	THE ARGUMENTS FROM THE COMMON ARGUMENT LIST
C	THEIR NUMBER SPECIFIED IN ARGOUT'S ARGUMENT
C	FOLLOW THIS CONTROL CHARACTER
C	THE CALLING ROUTINE SETS UP THE COMMON ARGUMENTS
C	JUST AS PICTURE BOOK NEEDS TO RECEIVE THEM
	SUBROUTINE ARGOUT(N)
	DIMENSION IARGS(10)
	COMMON /BOOK/ I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	EQUIVALENCE (IARGS(1),I1)
	CALL OUTCH(4)
C			OUTPUT CONTROL D
	DO 1 I=1,N
	CALL OUTCH(IARGS(I))
C			NOW OUTPUT ARGUMENTS
1	CONTINUE
	RETURN
	END

C	INNUM READS AN OCTAL NUMBER CONSISTING OF A MAXIMUM OF 4
C	DIGITS SOMETIMES PRECEDED BY A MINUS SIGN AND FOLLOWED BY A CRLF
	SUBROUTINE INNUM(K)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	DATA MINUS/45/,LINEF/10/
	NUM=0
	ISIGN=1
1	CALL INCH(I)
	IF(I.EQ.MINUS)ISIGN=-1
	IF(I.GE.48.AND.I.LT.56)NUM=NUM*8+I-48
C			ADD ON AN OCTAL NUMBER
	IF(I.NE.LINEF)GOTO 1
C			KEEP READING TILL LINE FEED
	K=NUM*ISIGN
	RETURN
	END

C	OUTNUM OUTPUTS THE VALUE IN ITS ARGUMENT AS A HIGH AND LOW BYTE,
C	FIRST CONVERTING TO A 14 BIT NUMBER

	FUNCTION OUTNUM(IVAL)
	COMMON/BOOK/I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,F1,F2,F3,F4
	IVAL=IVAL-(IVAL/8192)*8192
C			MAKE MODULO 8192
	IF(IVAL.LT.0)IVAL=16384+IVAL
C			THEN MAKE A NEGATIVE IVAL >8192
	IHI=IVAL/128
C				GET THE HI BYTE
	ILO=IVAL-IHI*128
C				AND THE LOW
	CALL OUTCH(IHI)
C				AND OUTPUT THEM
	CALL OUTCH(ILO)
	OUTNUM=0
	RETURN
	END