.TITLE	PLOT46 ;4662 PLOTTER ROUTINES
	.MCALL	QIOW$S,MRKT$S,WTSE$S
	.IDENT/V03/
	.SBTTL	COMMENTS
	;
;	THIS SET OF ROUTINES IS USED TO DRIVE 
;	THE TEKTRONIX 4662 INTER ACTIVE PLOTTER
;	
;	WRITTEN BY JEFF HAMILTON
;
;	PLOTTER CALLING PARAMETERS
;
;	CALL PLOT46(IFUNCTION,IPARM1,IPARM2,IERR)
;
;	WHERE;
;	IFUNCTION = FUNCTION CODE FROM 1-14
;	IPARM1    = FUNCTION SPECIFIC INPUT
;	IPARM2    = FUNCTION SPECIFIC INPUT
;	IERR      = INTEGER ERROR RETURN,MINUS IF ERROR
;		    (IF ERROR, MAGNITUDE  CORRESPONDS TO THE FUNCTION BEING...
;		      EXERCISED AT TIME OF ERROR. NEGATIVE 16(10) INDICATES AN UNALLOWED...
;			FUNCTION WAS REQUESTED.)
;
;	PLOTTER FUNCTIONS:
;
;	1 --	PLOTTER ON   (NO PARAMETER INPUT)
;	2 --	PLOTTER OFF
;	3 --	PRINT ALPHA STRING  
;		IPARM1 --ADDRESS OF ALPHA STRING
;		IPARM2 -- LENGTH IN BYTES OF ALPHA STRING
;	4 --	GOTO VECTOR
;		IPARM1 -- X ADDRESS
;		IPARM2 -- Y ADDRESS
;	5 --	DRAW VECTOR
;		IPARM1 -- X ADDRESS
;		IPARM2 -- Y ADDRESS  (X AND Y ARE 16 BIT INTEGERS)
;	6 --	SET ALPHA SIZE
;		IPARM1 -- CHARACTER STRING WITH CHARACTER AND LINE SPACING
;		IPARM2 -- LENGTH OF IPARM1 IN BYTES
;	7 --	SET ALPHA ANGLE
;		IPARM1 -- CHARACTER STRING CONTAINING ANGLE
;		IPARM2 -- LENGTH OF CHARACTER STRING
;	8 --	SET ALPHA CHARACTER FONT
;		IPARM1 -- CHARACTER FONT  0-7 
;	9 --	RESET PLOTTER
;	10--	ALPHA RESET
;	11-- 	TURN ON PROMPT LIGHT
;	12--	TURN OFF PROMPT LIGHT
;	13--	READ PEN POSITION AND STATUS (WITH USE OF 'CALL' BUTTON)
;		IPARM1 -- RETURNS CURRENT X POSITION
;		IPARM2 -- RETURNS CURRENT Y POSITION
;		IERR   -- RETURNS 1 IF PEN UP ,2 IF PEN DOWN
;		TO OBTAIN PEN POSITION & STATUS,REQUEST THIS
;		FUNCTION FIRST. THEN PRESS THE 'CALL' BUTTON ON 
;		THE PLOTTER CONTROL PANEL.
;		(DO NOT HOLD DOWN 'CALL' BUTTON UNTIL BELL RINGS.)
;	14--	ASSIGN LOGICAL UNIT TO PLOTTER
;		IPARM1 -- LUN OF PLOTTER
;
;	15--	DECODE PEN POSITION & STATUS (WITHOUT USE OF 'CALL'...
;		   ...BUTTON) AND WAIT BEFORE RETURNING TO CALLER.
;		IPARM1 -- SENDS TIME (TICKS, IN RANGE 0 TO 32767.(10) INCLUSIVE)...
;			    TO WAIT BEFORE RETURNING TO CALLING PROGRAM.
;			  RETURNS X ADDRESS.
;		IPARM2 -- RETURNS Y ADDRESS.
;		IERR -- RETURNS 1 IF PEN UP, 2 IF PEN DOWN.
;		NOTE: A TICK IS THE TIME FOR ONE CYCLE OF LINE FREQUENCY.
;		(E.G., IF LINE FREQUENCY IS 60 CYCLES/SEC, 30 TICKS WOULD BE...
;		   A HALF SECOND.)
;	NOTE: PLOTTER BELL RINGS AT THE TIME THE POINT IS READ FROM PLOTTER.
		.PAGE
	.SBTTL EQUATES AND STORAGE
;
	FUNC=2		;OFFSET TO FUNCTION CODE
	IP1=4		;OFFSET TO 1ST PARAMETER
	IP2=6		;OFFSET TO 2ND PARAMETER
	IERR=10		;OFFSET TO ERROR PARAMETER
	GRAPH=35	;CODE FOR GRAPHICS MODE
	ALPHA=37	;CODE FOR ALPHA MODE
	ESC=33		;ESCAPE CODE
	BELL=7		;BELL CODE 
	DEV=101		;DEVICE CODE FOR PLOTTER
	TERM=0		;COMMAND TERMINATOR
	DELIM=54	;COMMAND DELIMETER
	TERSIZ=255.	;TERMINAL BUFFER SIZE
;
;	STORAGE AREAS
COUNT:	.WORD 0		;CHARACTER COUNT OF OUTPUT BUFFER
STWRD:	.BLKW	1		;STATUS WORD BUFFER.
ROUGH:	.BLKW	4		;BUFFER FOR UNDECODED STATUS WORD.
TICKS:	.BLKW	1		;HOLDS TIME DELAY FOR F15.
ENCODE:	.BLKW	5		;STORAGE FOR ENCODED DATA FROM PLOTTER.
BUF:	.BLKW 90.	;OUTPUT BUFFER SPACE
;
				;ASK FOR PEN POSITION & STATUS.
ASKGIN:	.BYTE	0		;NULL
	.BYTE	37		;SET ALPHA MODE.
	.BYTE	7		;RING BELL.
	.BYTE	33		;ESCAPE
	.BYTE	101		;DEVICE A
	.BYTE	115		;ASCII M
				;BUFFER TO READ STATUS WORD 1.
RSTAT:	.BYTE	0		;NULL
	.BYTE	33		;ESCAPE
	.BYTE	101		;DEVICE A.
	.BYTE   117		;ASCII O (OH).
	.BYTE	61		;ASCII ONE.
	.BYTE	04		;TERMINATOR (EOT)
				;
RITEST:	.BLKW	2	;I/O STATUS FOR F13 AND F15 .
WRTRD:	.BLKW	2	;I/O STATUS BLOCK FOR REQUEST OF PLOTTER BUFFER STATUS.
IOSTAT:	.BLKW	2	;I/O STATUS BLOCK FOR QIO'S
	.IF DF BASIC
LUN:	.WORD	15.		;BASIC LUN
	.IFF
LUN:	.WORD	1		;DEFAULT FORTRAN LUN
	.IFTF
;	TABLE OF POINTERS TO THE DIFFERENT FUNCTIONS
FTBL:	.WORD	F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,F13,F14,F15
;
ERROR:	.WORD 0		;ERROR PARAMETER
	.PAGE
	.SBTTL SUBROUTINES
	;
	;TRNSLT TRANSLATE ENCODES 16 BIT BINARY X-Y COORDINATES
	; INTO A 5 BYTE ENCODED BUFFER
	;INPUT PARAMETERS
	; R0 - CONTAINS 16 BIT X
	; R1 - CONTAINS 16 BIT Y
	; R2 - POINTS TO BEGINNING OF OUTPUT BUFFER
	;
	;OUTPUTS
	;BUFFER CONTAINS ENCODED DATA
	;
TRNSLT:	MOV	R3,-(SP)	;SAVE WORK REGISTER
	MOV	R0,R3		;COPY X
	BIC	#177774,R3	;CLEAR BITS
	MOVB	R3,1(R2)	;PUT LSB'S INTO POSITION
	MOV	R0,R3		;COPY X
	ASR	R3		;SHIFT OFF LSB'S
	ASR	R3		;
	BIC	#177740,R3	;CLEAR UNNEEDED BITS
	MOVB	R3,4(R2)	;GET ISB'S
	MOV	R0,R3		;COPY X
	ASL	R3		;SET UP TO GET MSB'S
	BIC	#160377,R3		;CLEAR ALL OTHER BITS
	SWAB	R3
	MOVB	R3,3(R2)	;GET MSB'S
	;NOW GET THE Y VALUES
	MOV	R1,R3		;COPY Y
	BIC	#177774,R3	;CLEARS BITS
	ASL	R3		;SHIFT TO PROPER BIT POSITIONS
	ASL	R3
	BISB	R3,1(R2)	;OR LSB'S INTO BYTE
	MOV	R1,R3		;COPY Y
	ASR	R3		;SHIFT OF LSB'S
	ASR	R3
	BIC	#177740,R3	;CLEAR UNNEEDED BITS
	MOVB	R3,2(R2)	;GET ISB'S
	MOV	R1,R3		;COPY Y
	ASL	R3		;SET UP TO GET MSB'S
	BIC	#160377,R3	;CLEAR OTHER BITS
	SWAB	R3
	MOVB	R3,(R2)		;GET MSB'S
	;
	;PUT ON TAG BITS
	BISB	#40,(R2)
	BISB	#140,1(R2)
	BISB	#140,2(R2)
	BISB	#40,3(R2)
	BISB	#100,4(R2)
	;
	;NOW RESTORE R3
	MOV	(SP)+,R3
	RTS	PC		;RETURN TO CALLER
	.PAGE
	;
	;ROUTINE PERFORMS QIO TO THE PLOTTER
	;
	;INPUTS
	;BUF CONTAINS THE CHARACTERS TO BE PLOTTED OR A COMMAND
	;COUNT CONTAINS THE CHARACTER COUNT TO BE TRANMITTED
	;ERROR WILL BE CLEARED IF THE TRANSFER IS SUCCESFUL
	;IOSTAT CONTAINS THE I/O STATUS BLOCK
	;
PLOTIT:
	CMP	@FUNC(R5),#1	;IS THE CALL FROM FUNC. 1.
	BEQ	40$		;IF SO BY-PASS TESTING THE BUFFER SIZE.
50$:	CMP	COUNT,STWRD 	;IS THE CONSERVATIVE ESTIMATE  OF PLOTTER BUFFER SIZE...
				;   GREATER THAN THE NO. OF CHAR. TO BE WRITTER?
	BMI	30$		;YES,WRITE THE BUFFER.
	JSR	PC,DCDSTT	;NO,DECODE STATUS WORD.
	TST	WRTRD		;I/O ERROR IN DECODING?
	BMI	10$		;YES, DO NOT CLEAR ERROR CODE.
	BR	50$		;CHECK TO SEE IF THERE IS ENOUGH ROOM TO...
				;   WRITE THE BUFFER NOW.
40$:	CLR	STWRD		;INITIALIZE STATUS WORD TO ZERO.
30$:	SUB	COUNT,STWRD	;DECREASE ESTIMATE OF BUFFER SIZE BY THE NO. OF CHAR....
				;   TO BE WRITTEN.
20$:	QIOW$S	#IO.WAL,LUN,#15.,,,,<#BUF,COUNT,#0>
	TST	IOSTAT	;I/O ERROR?
	BMI	10$	;YES ,DON'T CLEAR ERROR
	CLR	ERROR	;NO, CLEAR ERROR INDICATOR
10$:	RTS	PC	;RETURN TO CALLER
	.PAGE
;
;
DCDSTT:				;DECODE STATUS WORD.
				;ASK PLOTTER FOR STATUS WORD 1	
				;   & READ IT INTO BUFFER.
	QIOW$S	#IO.RPR!TF.BIN!TF.RNE,LUN,#15.,,#WRTRD,,<#ROUGH,#7,,#RSTAT,#6,#0>
	TST	WRTRD		;I/O ERROR?
	BMI	20$		;YES, DO NOT DECODE PLOTTER STATUS WORD.
			;R5 HAS THE ADDR. OF THE PARAMETER BLOCK PASSED
			;     IN THE 'CALL PLOT46'.
	MOV	#ROUGH,R3	;PUT ADDR OF ENCODED DATA IN R3.
	MOVB	1(R3),R4	;PUT BYTE WITH MSB IN R4.
	BIC	#177740,R4	;CLEAR UNNEEDED BITS IN BYTE WITH MSB.
	ASH	#5,R4		;SHIFT MSB LEFT 5 PLACES TO MAKE ROOM FOR ISB.
	MOVB	3(R3),R2	;PUT BYTE WITH ISB IN R2.
	BIC	#177740,R2	;CLEAR UNNEEDED BITS IN BYTE WITH ISB.
	BIS	R2,R4		;PUT ISB AFTER MSB.
	ASH	#5,R4		;SHIFT LEFT 5 PLACES TO MAKE ROOM FOR LSB.
	MOVB	5(R3),R2	;PUT BYTE  WITH LSB IN R2.
	BIC	#177740,R2	;CLEAR UNNEEDED BITS.
	BIS	R2,R4		;PUT LSB AFTER ISB.
	ASL	R4		;SHIFT LEFT 1 PLACE TO MAKE ROOM FOR...
				;   LEAST ORDER BIT OF STATUS WORD.
	MOV	6(R3),R2	;PUT BYTE WITH LEAST ORDER  BIT ...
				;   OF STATUS WORD IN R2.
	BIC	#177767,R2	;CLEAR ALL BITS BUT THE LEAST ORDER BIT OF STATUS WORD.
	ASH	#-3,R2		;POSITION LEAST ORDER BIT IN BIT ZERO.
	BIS	R2,R4		;PUT LEAST ORDER BIT IN STATUS WORD.
	BIC	#174000,R4	;MASK ALL BITS EXCEPT THE SIZE OF PLOTTER BUFFER.
	MOV 	R4,STWRD	;SAVE STATUS WORD.
20$: 	RTS	PC		;RETURN TO PLOTTIT.
	.PAGE
	;
	;
;	
	.SBTTL	FUNCTION SUBROUTINES
F1:	;PLOTTER ON FUNCTION
	MOV	#BUF,R1		;GET BUFFER ADDRESS
	MOVB	#ESC,(R1)+	;PUT IN ESCAPE CODE
	MOVB	#DEV,(R1)+	;PUT IN DEVICE CODE
	MOVB	#105,(R1)+	;PLOTTER ON COMMAND
	MOV	#3,COUNT	;SET COUNT
	MOV	#-1,ERROR	;PRESET ERROR
	JSR	PC,PLOTIT	;DO IT!
	RTS	PC		;RETURN
	.PAGE
F2:	;PLOTTER OFF COMMAND
	MOV	#BUF,R1		;GET BUFFER
	MOVB	#ESC,(R1)+	;SET STANDARD PARAMETERS
	MOVB	#DEV,(R1)+
	MOVB	#106,(R1)+	;PLOTTER OFF
	MOV	#3,COUNT
	MOV	#-2,ERROR
	JSR	PC,PLOTIT	;DO IT
	RTS	PC		;RETURN
	.PAGE
F3:	;PRINT STRING COMMAND
	;IP1 CONTAINS ADDRESS OF BUFFER TO BE PRINTED
	;IP2 CONTAINS LENGTH OF BUFFER IN BYTES
	;
	MOV	#-3,ERROR	;PRESET ERROR CODE
	MOV	IP1(R5),R1	;GET BUFFER ADDRESS
	MOV	@IP2(R5),R3	;GET COUNT
	CMP	#TERSIZ.,R3		;TOO MANY TO PRINT?
	BLT	99$		;YES GO GET OUT
	MOV	#BUF,R2		;GET INTERNAL BUFFER ADDRESS
	MOVB	#ALPHA,(R2)+	;SET ALPHA MODE PREFIX
	MOV	#1,COUNT	;COUNT IT
10$:	MOVB	(R1)+,(R2)+	;GET CHARACTER
	DEC	R3		;DONE?
	BGT	10$		;NO,GET THE NEXT ONE
	ADD	@IP2(R5),COUNT	;ADD IN CHAR. COUNT
	JSR	PC,PLOTIT	;DO IT!
99$:	RTS	PC		;RETURN
	.PAGE
F4:	;GOTO VECTOR FUNCTION
	;IP1 HAS X VALUE
	;IP2 HAS Y VALUE
	MOV	@IP1(R5),R0	;GET X
	MOV	@IP2(R5),R1	;GET Y
	MOV	#BUF,R2		;POINT TO BUFFER
	MOVB	#GRAPH,(R2)+	;SET GRAPH MODE
	MOV	#6,COUNT	;PRESET COUNT
	JSR	PC,TRNSLT	;ENCODE X-Y INTO BUFFER
	MOV	#-4,ERROR	;SET ERROR
	JSR	PC,PLOTIT	;GO OUTPUT IT
	RTS	PC
	.PAGE
F5:	;DRAW TO VECTOR FUNCTION
	;IP1 HAS X VALUE
	;IP2 HAS Y VALUE
	MOV	@IP1(R5),R0	;GET X
	MOV	@IP2(R5),R1	;GET Y
	MOV	#BUF,R2		;POINT TO BUFFER
	MOV	#5,COUNT	;PRESET COUNT
	JSR	PC,TRNSLT	;ENCODE X-Y
	MOV	#-5,ERROR	;SET ERROR
	JSR	PC,PLOTIT	;DO IT!
	RTS	PC
	.PAGE
F6:	;SET ALPHA SIZE
	;IP1 POINTS TO STRING BUFFER
	;IP2 CONTAINS LENGTH OF BUFFER
	MOV	#BUF,R1		;GET BUF ADDR
	MOVB	#ESC,(R1)+	;SET STANDARD PARAMETERS
	MOVB	#DEV,(R1)+
	MOVB	#'I,(R1)+	;SET ALPHA
	MOV	IP1(R5),R0	;GET STRING ADDR
	MOV	@IP2(R5),R2	;GET COUNT
10$:	MOVB	(R0)+,(R1)+	;TRANSFER THE BUFFER
	DEC	R2		;DONE?
	BGT	10$		;NO ;LOOP AGAIN
	MOV	@IP2(R5),COUNT	;GET CHAR COUNT
	MOVB	#TERM,(R1)+	;PUT IN TERMINATOR
	ADD	#4,COUNT	;ADD HEADER COUNT
	MOV	#-6,ERROR	;SET ERROR
	JSR	PC,PLOTIT	;DO IT!
	RTS	PC		;RETURN
	.PAGE
F7:	;SET ALPHA ANGLE
	;IP1 HAS STRING OF ANGLE ROTATION
	;IP2 HAS LENGTH OF STRING
	MOV	#BUF,R1		;GET ADDR
	MOVB	#ESC,(R1)+	;SET STANDARD PARAM.
	MOVB	#DEV,(R1)+
	MOVB	#'J,(R1)+	;ALPHA ANGLE
	MOV	IP1(R5),R0	;GET STRING ADDR
	MOV	@IP2(R5),R2	;GET COUNT
10$:	MOVB	(R0)+,(R1)+	;TRANSFER INTO BUFFER
	DEC	R2		;DONE?
	BGT	10$		;NO ;LOOP AGAIN
	MOV	@IP2(R5),COUNT	;GET COUNT
	MOVB	#TERM,(R1)+	;GET TERMINATOR
	ADD	#4,COUNT	;ADD IN HEADER COUNT
	MOV	#-7,ERROR	;SET ERROR
	JSR	PC,PLOTIT
	RTS	PC
	.PAGE
F8:	;SET ALPHA FONT
	;IP1 CONTAINS CHARACTER FONT
	MOV	#BUF,R1		;GET BUF ADDR
	MOVB	#ESC,(R1)+	;SET STAND.PARAM.
	MOVB	#DEV,(R1)+
	MOVB	#'T,(R1)+	;SET FONT
	MOVB	@IP1(R5),(R1)+	;GET FONT
	MOV	#4,COUNT
	MOV	#-8.,ERROR	;SET ERROR
	JSR	PC,PLOTIT
	RTS	PC
	.PAGE
F9:	;RESET PLOTTER
	MOV	#BUF,R1		;GET BUF ADDR
	MOVB	#ESC,(R1)+	;SET STD PARAM.
	MOVB	#DEV,(R1)+
	MOVB	#'N,(R1)+	;RESET COMMAND
	MOV	#3,COUNT
	MOV	#-9.,ERROR	;SET ERROR
	JSR	PC,PLOTIT
	RTS	PC
	.PAGE
F10:	;ALPHA RESET
	MOV	#BUF,R1		;GET BUF ADDR
	MOVB	#ESC,(R1)+	;SET STD PAR.
	MOVB	#DEV,(R1)+
	MOVB	#'V,(R1)+	;ALPHA RESET
	MOV	#3,COUNT
	MOV	#-10.,ERROR
	JSR	PC,PLOTIT
	RTS	PC
	.PAGE
F11:	;TURN ON PROMPT LIGHT
	MOV	#BUF,R1		;GET BUF ADDR
	MOVB	#ESC,(R1)+	;SET STD PAR
	MOVB	#DEV,(R1)+
	MOVB	#'K,(R1)+	;TURN ON
	MOV	#3,COUNT
	MOV	#-11.,ERROR
	JSR	PC,PLOTIT
	RTS	PC
	;
	;
F12:	;TURN OFF PROMPT LIGHT
	MOV	#BUF,R1		;GET BUFFER ADDR
	MOVB	#ESC,(R1)+
	MOVB	#DEV,(R1)+
	MOVB	#'L,(R1)+	;TURN OFF LIGHT
	MOV	#3,COUNT
	MOV	#-12.,ERROR
	JSR	PC,PLOTIT
	RTS	PC
	.PAGE
F13:	;DECODE THE 16-BIT BINARY X-Y COORDINANTS
			;& PEN STATUS.
			;ERROR CONTAINS THE PEN STATUS (UP=1,DOWN=2)
			;R5 HAS THE ADDR. OF THE PARAMETERS PASSED
			;     IN THE 'CALL PLOT46'.
	MOV	#-13.,ERROR	;PRESET ERROR CODE.
				;READ DATA FROM PLOTTER INTO 'ENCODE' BUFFER.
	QIOW$S #IO.RNE,LUN,#16.,,#RITEST,,<#ENCODE,#7>
	TST 	RITEST		;I/O ERROR?
	BMI	ENDIT		;YES,ABORT FUNCTION & DON'T CLEAR ERROR CODE.
BYPASS:				;DECODE X.
	MOV	#ENCODE,R3	;PUT ADDR. OF ENCODED COORDINANTS INTO R3.
	MOV	(R3),R4		;PUT BYTE WITH MSB IN R4.
	BIC	#177740,R4	;CLEAR UNNEEDED BITS/
	ROL	R4		;MOVE MSB TO MAKE ROOM FOR ISB.
	ROL	R4
	ROL	R4
	ROL	R4
	ROL	R4
	MOVB	2(R3),R2	;PUT BYTE WITH ISB IN R2.
	BIC	#177740,R2	;CLEAR UNNEEDED BITS IN BYTE WITH ISB.
	BIS	R2,R4		;PUT ISB AFTER MSB.
	ROL	R4		;MAKE ROOM FOR LSB.
	ROL	R4
	MOVB	4(R3),R2	;PUT BYTE WITH LSB IN R2.
	BIC	#177747,R2	;CLEAR UNNEEDED BITS IN BYTE WITH LSB.
	ROR	R2		;MOVE LSB TO RIGHT 2 BITS.
	ROR	R2
	ROR	R2
	BIS	R2,R4		;PUT LSB AFTER ISB.
	MOV	R4,@IP1(R5)	;FIX X INTO OUTPUT PARAMETER.
				;DECODE Y.
	MOVB	1(R3),R4	;PUT BYTE WITH MSB IN R4.
	BIC	#177740,R4	;CLEAR UNNEEDED BITS IN BYTE WITH MSB.
	ROL	R4		;MOVE MSB TO MAKE ROOM FOR ISB.
	ROL	R4
	ROL	R4
	ROL	R4
	ROL	R4
	MOVB	3(R3),R2	;PUT BYTE WITH ISB IN R2.
	BIC	#177740,R2	;CLEAR UNNEEDED BITS IN BYTE WITH ISB.
	BIS	R2,R4		;PUT ISB AFTER MSB.
	ROL	R4		;MAKE ROOM FOR LSB.
	ROL	R4
	MOVB	5(R3),R2	;PUT BYTE  WITH LSB IN R2.
	BIC	#177747,R2	;CLEAR UNNEEDED BITS IN BYTE WITH LSB.
	ROR	R2		;PUT LSB INTO RIGHT 2 BITS.
	ROR	R2
	ROR	R2
	BIS	R2,R4		;PUT LSB AFTER ISB.
	MOV	R4,@IP2(R5)	;FIX Y INTO OUTPUT PARAMETER.
				;DECODE PEN STATUS.
	MOVB	6(R3),R4	;PUT BYTE WITH PEN STATUS INTO R4.
	BIC	#177773,R4	;CLEAR UNNEEDED BITS IN BYTE WITH
				;     PEN STATUS.
	ROR	R4		;PUT PEN STATUS INTO THE RIGHT
				;     BIT.
	ROR	R4
	INC	R4		;CODE PEN STATUS FOR OUTPUT.
	MOV	R4,ERROR	;FIX PEN STATUS INTO THE OUTPUT
				;     PARAMETER.
ENDIT:	RTS	PC		;RETURN.
	;
	;
	.PAGE
F14:	;ASSIGN LUN TO PLOTTER
	;THIS FUNCTION ALWAYS RETURNS AN ERROR IN BASIC
	.IFT
	MOV	#-14.,ERROR	;BASIC ASSEMBLY
	RTS	PC
	.IFF	
	;IP1 REPLACES VALUE IN LUN
	;IP1 IS IMPLICITLY THE EVENT FLAG
	MOV	@IP1(R5),LUN	;SET LUN
	RTS	PC
	.PAGE
F15:	;DECODE THE 16-BIT BINARY X-Y COORDINANTS AND THEN WAIT ...
	;   THE INDICATED NO. OF  TICKS BEFOR RETURNING TO THE CALLING PROGRAM.
	;IP1 INITIALLY HAS ADDR. OF THE NO. OF TICKS TO WAIT.
	;
	MOV	#-15.,ERROR	;PRESET ERROR CODE.
	MOV	@IP1(R5),TICKS	;GET TIME MAGNITUDE.
	TST	TICKS		;IS TICKS NEGATIVE?
	BMI	10$		;YES,ABORT FUNCTION.
	CMP	#32767.,TICKS	;IS MAGNITUDE WITHIN RANGE?
	BLE	10$		;NO, ABORT FUNCTION.
				;ASK FOR COORDINANTS.
	QIOW$S	#IO.RPR!TF.BIN!TF.RNE,LUN,#15.,,#RITEST,,<#ENCODE,#7,,#ASKGIN,#6,#0>
	TST	RITEST		;I/O ERROR?
	BMI	10$		;YES, ABORT FUNCTION.
	JSR	PC,BYPASS	;DECODE X-Y COORDINATES & PEN STATUS USING PART OF F13.
	MRKT$S	#15.,TICKS,#1	;MARK TIME FOR THE NO. OF TICKS.
	WTSE$S	#15.		;WAIT TILL TIME HAS ELAPSED.
10$:	RTS	PC		;RETURN TO CALLER.
	.ENDC
	.PAGE
	.SBTTL	DISPATCH ROUTINE PLOT46
PLOT46::
	JSR	PC,$SAVAL	;SAVE R0-R5
	CLR	ERROR		;CLEAR ERROR PARAMETER
	MOV	@FUNC(R5),R0	;GET FUNCTION CODE
	BEQ	99$		;LT ZERO,AN ERROR
	CMP	#15.,R0		;GT 15?
	BLT	99$		;YES GO SET ERROR
	DEC	R0		;CONVERT TO INDEX
	ASL	R0
	JSR	PC,@FTBL(R0)	;GO PERFORM FUNCTION
	MOV	ERROR,@IERR(R5)	;SET ERROR RETURN
	BR	100$		;LEAVE
99$:	MOV	#-16.,ERROR	;SET PARAMETER ERROR
	MOV	ERROR,@IERR(R5)
100$:	RTS	PC
	.END