;	*****************************************************
;	* HP PLOTTER DRIVER FOR HPIB PLOTTERS SPEAKING HPGL *
;	*****************************************************

	.IF NDF	DEV
	.TITLE	GD7470
	.IFF
	.IIF EQ DEV-7220	.TITLE	GD7220
	.IIF EQ DEV-7225	.TITLE	GD7225
	.IIF EQ DEV-7470	.TITLE	GD7470
	.IIF EQ DEV-9872.	.TITLE	GD9872
	.ENDC	;NDF DEV


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;; CONFIGURATION ;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; 1) "SLOTNM" IS THE IBUP.MAC SLOT NUMBER OF THE PLOTTER.   THATS RIGHT,
;	THIS DRIVER USES THE NATIONAL INSTRUMENTS SUBROUTINE 'IBUP'.
;	RSX AND TSX USERS WILL NEED TO USE IBUP WITH THE NAT. INST. SUPPLIED
;	DEVICE DRIVER.
	.IIF NDF SLOTNM	SLOTNM	= 2

; 2) SET THE SYMBOL "DEV" TO:
;	7220	==> HP 7220 PLOTTER
;	7225	==> HP 7225 PLOTTER
;	7470	==> HP 7470 PLOTTER
;	9872.	==> HP 9872 PLOTTER (NOTE DECIMAL POINT!)
	.IIF NDF DEV	DEV = 7470

; 3) SET THE SYMBOL "PAGADV" TO:
;	0 ==> NO PAPER FEEDER
;	1 ==> PAPER FEEDER
	.IIF NDF PAGADV	PAGADV	= 0

; 4) SET THE SYMBOL "OS" TO:
;	1 ==> RT11
;	2 ==> TSX
;	3 ==> RSX11M
	.IIF NDF OS	OS = 1

;END OF CONFIGURATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



	.SBTTL	DEFINATIONS, ECT.

	.IF EQ OS-3
	.MCALL	QIOW$, DIR$
	.IFF
	.MCALL	.PRINT, .TTYIN
	.ENDC

	.GLOBL	GDAID
	.GLOBL	IBUP


	BUFSIZ	= 128.

	SEMIC	= ';
	COMMA	= ',
	LF	= 12

;ERROR MACRO DEFINATION
	.MACRO	ERROR	TEXT
	JSR	R0,ERROR1
	.ASCIZ	@TEXT@
	.EVEN
	.ENDM	ERROR


	.PSECT	GDHPIB		;WE ARE RELOCATABLE
	.SBTTL	ENTRY POINT

.IIF EQ DEV-7220	GD220L::
.IIF EQ DEV-7225	GD225L::
.IIF EQ DEV-7470	GD470L::
.IIF EQ DEV-9872.	GD872L::
	MOV	#1,LONG		;SHOW LONG X MODE
	BR	GDHPIB

.IIF EQ DEV-7220	GD220T::
.IIF EQ DEV-7225	GD225T::
.IIF EQ DEV-7470	GD470T::
.IIF EQ DEV-9872.	GD872T::
	CLR	LONG		;SHOW NOT LONG X MODE

GDHPIB:	TST	(R5)+		;SKIP ARG COUNT
	MOV	@(R5)+,R0	;GET FUNCTION TO PERFORM
	BLE	1$		;ITS A BADDY
	ASL	R0		;MAKE WORD OFFSET
	ADD	#DSPTBL-2,R0	;R0 ==> ADDRESS OF PROCESSING ROUTINE
	CMP	R0,#TBLEND	;SEE IF UNSUPPORTED FUNCTION
	BGE	1$		;YES
	JMP	@(R0)+		;NO, DISPATCH TO ROUTINE
1$:	ERROR	<GDHPIB - ILLEGAL FUNCTION>

DSPTBL:	.WORD	INIT, BGNPLT, MOVE, DRAW, ENDPLT, RLSDEV
	.WORD	GETCHR, SELCOL
TBLEND:
	.SBTTL	INIT AND BGNPLT


	;
	;INITIALIZE
	;
INIT:
	JSR	PC,DOINIT	;INITIALIZE THE BUFFER AND PLOTTER
	MOV	#ZERO,R4	;ALL WORKED, RETURN GOOD STATUS
IEXIT:	MOV	2(R5),R3	;MOVE FLOATING POINT ERROR INDICATOR BACK
	MOV	(R4)+,(R3)+	;FIRST WORD
	MOV	(R4),(R3)	;2ND WORD
	RTS	PC

ZERO:	.FLT2	0.0


	;
	;BGNPLT
	;
BGNPLT:
	.IF NE PAGADV
	JSR	R5,INSERT	;SEND PAGE ADVANCE COMMAND
	.ASCII	"PG;"
	.BYTE	-1
	.EVEN
	JSR	PC,DUMP1	;SEND COMMAND NOW

	.IFF
	.IF EQ OS-3
	DIR$	#QDPB5
	.IFF
	.PRINT	#NEWPAG
1$:	.TTYIN			;WAIT FOR CRLF
	CMPB	R0,#12
	BNE	1$
	.ENDC	;EQ OS-3

	.IFTF
	JSR	PC,DOINIT	;INIT PLOTTER
	RTS	PC		;DONE

	.ENABLE LC
	.IFF
NEWPAG:	.ASCII	"Place fresh sheet of paper on HP plotter.   Hit return"
	MSGLEN	= .-NEWPAG
	.BYTE	200
	.EVEN
	.IF EQ OS-3
QDPB5:	QIOW$	IO.RPR,5,1,50.,IOSB,,<INBUF,1,0,NEWPAG,MSGLEN,'$>
IOSB:	.BLKW	2
INBUF:	.BLKW	1
	.ENDC	;EQ OS-3
	.ENDC	;NE PAGADV
	.SBTTL	MOVE AND DRAW

MOVE:	JSR	PC,PENUP	;RAISE PEN FOR MOVE
MDCOMN:	JSR	PC,TDUMP	;MAKE SURE ENOUGH ROOM IN BUFFER
	JSR	PC,MAKINT
	MOV	BUFIN,R5	;R5 ==> BUFFER
	TSTB	DOINGV		;VECTOR STRING IN PROGRESS?
	BNE	1$		;YES
	MOVB	#'P,(R5)+	;NO, INSERT "PA"
	MOVB	#'A,(R5)+
	ADD	#2,BUFCNT	;TWO BYTES ADDED
	MOVB	#-1,DOINGV	;SHOW DOING A VECTOR
	BR	2$
1$:	MOVB	#COMMA,(R5)+	;SEPERATE LAST (X,Y) FROM THIS (X,Y) WITH COMMA
	INC	BUFCNT
2$:	MOV	R1,R4		;SAVE Y VALUE
	JSR	PC,MAKASC	;CONVERT R0 (X) TO ASCII AND INSERT INTO BUFFER
	MOVB	#COMMA,(R5)+	;INSERT COMMA TO SEPERATE X AND Y
	INC	BUFCNT
	MOV	R4,R0		;PREPARE TO DO Y
	JSR	PC,MAKASC	;CONVERT Y TO ASCII AND INSERT
	MOV	R5,BUFIN	;RESTORE BUFFER POINTER
	RTS	PC		;ALL DONE

DRAW:	JSR	PC,PENDN	;LOWER PEN FOR DRAW
	BR	MDCOMN

MAKASC:	CLR	R2		;ZERO NUMBER OF DIGITS COUNTER
	MOV	R0,R1		;PREPARE FOR INTEGER DIVIDE
1$:	CLR	R0		;ZERO HIGH PART
	DIV	#10.,R0		;GET NEXT DIGIT
	ADD	#'0,R1		;MAKE REMAINDER ASCII
	MOVB	R1,-(SP)	;SAVE DIGIT ON STACK (THIS WILL REVERSE ORDER)
	INC	R2		;COUNT DIGITS
	MOV	R0,R1		;MOVE QUOTIENT FOR NEXT DIVIDE
	BNE	1$		;ALL DONE IF ZERO
	ADD	R2,BUFCNT	;WE WILL NOW INSERT THE DIGITS, SO ADD THEM IT
2$:	MOVB	(SP)+,(R5)+	;INSERT DIGITS
	SOB	R2,2$		;ALL DIGITS
	RTS	PC
	.SBTTL	ENDPLT AND RLSDEV

ENDPLT:
RLSDEV:
	JSR	PC,PENUP	;RAISE PEN
	JSR	PC,DUMP		;FORCE LAST BUFFER OUT
	RTS	PC
	.SBTTL	GETCHR - GET CHARACTERISTICS

GETCHR:	MOV	(R5)+,R4	;R4 ==> OUTPUT ARRAY
	TST	LONG		;SEE IF LONG X AXIS
	BNE	2$		;YES, RETURN THOSE PARMS
	MOV	#CHRTBL,R0	;R0 ==> OUR CHARACTERISTICS
	MOV	#CWORDS,R1	;R1 = NUMBER OF WORDS TO MOVE
1$:	MOV	(R0)+,(R4)+	;MOVE CHARACTERISTICS
	SOB	R1,1$
	RTS	PC
2$:	MOV	#LNGTBL,R0	;RETURN LONG SIZES
	MOV	#LNGWDS,R1
3$:	MOV	(R0)+,(R4)+
	SOB	R1,3$
	MOV	#RESLN,R0	;RETURN COMMON STUFF
	MOV	#CWORDS-<RESLN-CHRTBL/2>,R1
	BR	1$

CWORDS	= 2*8.
LNGWDS	= 2*3
CHRTBL:
	.IF EQ DEV-7220
	.FLT2	7220.5, 25.0, 38.0
RESLN:
XGUPCM:	.FLT2	400.0
YGUPCM:	.FLT2	400.0
	.FLT2	8.0	;8 PENS
	.FLT2	24.0	;SHARE+HARDCOPY+STROKE
	.FLT2	15.0	;ASSUME PEN IS 15/40 MILLIMETERS WIDE
LNGTBL:	.FLT2	7220.0, 38.0, 25.0
	YFULLS	= 10000.
	NPENS	= 8.
	.ENDC

	.IF EQ DEV-7225
	.FLT2	7225.5, 18.0, 25.0
RESLN:	.FLT2	312.5, 312.5
	.FLT2	1.0		;1 PEN
	.FLT2	24.0		;SHARE+HCOPY+STROKE
	.FLT2	15.0	;ASSUME PEN IS 15/40 MILLIMETERS WIDE
XGUPCM:
YGUPCM:	.FLT2	400.0		;SCALING RESOLUTION
LNGTBL:	.FLT2	7225.0, 25.0, 18.0
	YFULLS	= 7200.
	NPENS	= 1.
	.ENDC

	.IF EQ DEV-7470
	.FLT2	7470.5, 18.0, 25.0
RESLN:
XGUPCM:	.FLT2	400.0
YGUPCM:	.FLT2	400.0
	.FLT2	2.0		;2 PENS
	.FLT2	24.0		;SHARE+HARDCOPY+STROKE
	.FLT2	15.0	;ASSUME PEN IS 15/40 MILLIMETERS WIDE
LNGTBL:	.FLT2	7470.0, 25.0, 18.0
	YFULLS	= 7200.
	NPENS	= 2.
	.ENDC

	.IF EQ DEV-9872.
	.FLT2	9872.5, 25.0, 38.0
RESLN:
XGUPCM:	.FLT2	400.0
YGUPCM:	.FLT2	400.0
	.FLT2	8.0		;8 PENS
	.FLT2	24.0		;SHARE+HARDCOPY+STROKE
	.FLT2	15.0	;ASSUME PEN IS 15/40 MILLIMETERS WIDE
LNGTBL:	.FLT2	9872.0, 38.0, 25.0
	YFULLS	= 10000.
	NPENS	= 8.
	.ENDC
	.SBTTL	SELECT COLOR (PEN)

SELCOL:
	JSR	PC,PENUP	;BRING PEN UP FOR PEN CHANGE
	JSR	PC,TDUMP	;MAKE SURE WE HAVE ROOM IN THE BUFFER
	JSR	PC,GETINT	;GET THE COLOR NUMBER INTO R1
	TST	R1		;MAKE SURE NOT ZERO (NO BKGD COLOR)
	BEQ	COLERR		;OOPS
	CMP	R1,#NPENS	;"NPENS" ON PLOTTER
	BHI	COLERR		;TOO BIG
	.IF NE NPENS-1
	ADD	#'0,R1		;MAKE ASCII "1" THRU "8"
	MOVB	R1,PENNUM	;PLACE IN COMMAND
	JSR	R5,INSERT	;PUT PEN COMMAND IN BUFFER
	.ASCII	"PU;SP"		;SOME PLOTTERS NEED THE PEN-UP
PENNUM:	.BYTE	'1
	.ASCII	";"		;END OF COMMAND
	.BYTE	-1		;END OF INSERT
	.EVEN
	CLRB	DOINGV		;NO MORE VECTOR SEQUENCE
	.IFTF
	RTS	PC		;ALL DONE

	.IFT
COLERR:	ERROR	<GDHPIB - ILLEGAL COLOR>
	.ENDC	;NE NPENS-1
	.SBTTL	MAKINT SUBROUTINE

MAKINT:	MOV	(R5)+,XADD	;PASS X ARG ON
	MOV	(R5)+,YADD	;PASS Y ARG ON
	MOV	#SCLR5,R5	;PREPARE TO CALL A FTN CALC. ROUTINE
	JSR	PC,GDAID
	TST	LONG		;SEE IF LONG MODE
	BEQ	1$		;YES, GO CHANGE COORD.
	MOV	NEWX,R0		;GET NEWX INTO R0
	MOV	NEWY,R1		;GET NEWY INTO R1
	RTS	PC
1$:	MOV	NEWY,R0		;PLOTTER X = Y(TALL)
	MOV	#YFULLS,R1	;PLOTTER Y = Y(FULL-SCALE) - X(TALL)
	SUB	NEWX,R1
	RTS	PC

SCLR5:	.WORD	6
XADD:	.WORD	0
YADD:	.WORD	0
	.WORD	XGUPCM
	.WORD	YGUPCM
IXADD:	.WORD	NEWX
IYADD:	.WORD	NEWY


ERROR1:
	.IF NE OS-3
	.PRINT
	TRAP	300+63.		;GIVE ERROR MESSAGE

	.IFF
	CLR	-(SP)		;2ND WORD OF MESSAGE BLOCK
	MOV	R0,-(SP)	;1ST WORD (ADDRESS OF MESSAGE)
	MOV	SP,R0		;R0 ==> MESSAGE BLOCK
	CLR	R1		;SIGNAL NOT FATAL ERROR YET
	JSR	PC,$ERRLG	;PRINT THE MESSAGE
	CMP	(SP)+,(SP)+	;CLEAN UP THE STACK
	TRAP	+341		;DIE WITH TRACE-BACK
	.ENDC	;NE OS-3


GETINT:	MOV	(R5)+,R4	;POINT TO FLOATING VALUE
	MOV	(R4)+,R0	;GET HIGH PART
	MOV	(R4)+,R1	;GET LOW PART
	MOV	R0,R3		;COPY EXPONENT
	MOV	R0,-(SP)	;SAVE SIGN ALSO
	BIC	#177600,R0	;GET MANTISSA (ALMOST)
	BIS	#200,R0		;RESTORE HIDDEN BIT TO MANTISSA
	ASL	R3		;ALIGN EXPON. IN HIGH BYTE
	SWAB	R3		;PUT IN LOW BYTE
	BIC	#177400,R3	;GET ONLY EXPON.
	SUB	#200,R3		;TAKE OUT EXCESS 200 FROM EXPON.
	BLE	2$		;IF <0 THEN NUMBER <1
	SUB	#24.,R3		;COMPUTE RIGHT SHIFT COUNT
	CMP	R3,#8.		;SEE IF > 2**32 -1
	BGE	2$		;IF THAT BIG, USE ZERO
	ASHC	R3,R0		;SHIFT RIGHT PROPER NUMBER OF BITS
	TST	(SP)+		;SEE IF MINUS
	BPL	1$
	COM	R0		;NEG. D.P. INTEGER
	NEG	R1
	ADC	R0		;PROPAGATE CARRY
1$:	RTS	PC		;AND DONE
2$:	CLR	R0		;SET RESULT TO ZERO
	CLR	R1
	RTS	PC
	.SBTTL	INITIALIZE THE PLOTTER

DOINIT:	JSR	PC,INITBF	;INITIALIZE THE PLOTTER OUTPUT BUFFER
	JSR	R5,INSERT	;INIT. THE 7225
	.ASCII	"PU;DF;SC"
	.IIF EQ DEV-7220	.ASCII	"0,15200,0,10000"
	.IIF EQ DEV-7225	.ASCII	"0,10000,0,7200"
	.IIF EQ DEV-7470	.ASCII	"0,10000,0,7200"
	.IIF EQ DEV-9872.	.ASCII	"0,15200,0,10000"
	.IIF NE NPENS-1		.ASCII	";SP1"
	.ASCII	";"
	.BYTE	-1		;END MARKER
	.EVEN
	JSR	PC,DUMP1	;SEND NOW
	CLRB	PENPOS		;SHOW PEN UP DUE TO SELECT PEN
	RTS	PC
	.SBTTL	PEN UP/DOWN SUBROUTINES

PENUP:	TSTB	PENPOS		;SEE IF UP
	BEQ	PENXIT		;YES, JUST EXIT
	CLRB	PENPOS		;SHOW THAT IT WILL BE UP
	JSR	R5,INSERT	;SEND A PEN UP
	.ASCII	"PU;"
	.BYTE	-1
	.EVEN
PENXIT:	RTS	PC		;DONE

PENDN:	TSTB	PENPOS		;SEE IF DOWN ALREADY
	BNE	PENXIT		;YES, JUST EXIT
	MOVB	#1,PENPOS	;SHOW WILL BE DOWN
	JSR	R5,INSERT	;SEND A PEN DOWN
	.ASCII	"PD;"
	.BYTE	-1
	.EVEN
	RTS	PC
	.SBTTL	BUFFER UTILITIES

TDUMP:	CMP	BUFCNT,#BUFSIZ-16. ;SEE IF FULL ENOUGH TO DUMP
	BLO	1$		;NOPE
	JSR	PC,DUMP1	;YES, DUMP BUFFER NOW
1$:	RTS	PC		;AND DONE

INSERT:	JSR	PC,TDUMP
	MOV	R1,-(SP)	;SAVE R1
	MOV	BUFIN,R1	;R1 ==> BUFFER
	TSTB	DOINGV		;SEE IF VECTOR CHAIN GOING
	BEQ	2$		;NOPE, JUST INSERT
	MOVB	#SEMIC,(R1)+	;YES, TERMINATE IT WITH SEMICOLON
	CLRB	DOINGV		;SHOW WE STOP THE VECTOR SEQUENCE
1$:	INC	BUFCNT
2$:	MOVB	(R5)+,(R1)+	;MOVE INSERT DATA INTO BUFFER
	BPL	1$		;COUNT IT TILL DONE
	DEC	R1		;BACK UP POINTER
	MOV	R1,BUFIN	;RESTORE POINTER
	MOV	(SP)+,R1	;RESTORE R1
	INC	R5		;ROUND R5 TO WORD
	BIC	#1,R5
	RTS	R5

DUMP:	TST	BUFCNT		;SEE IF ANY CHARACTERS TO SEND
	BEQ	DXIT		;NOPE, JUST EXIT
DUMP1:	MOV	R0,-(SP)	;SAVE R0 THRU R5
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	MOV	BUFIN,R1	;R1 ==> LAST CHARACTER+1
	CMPB	-1(R1),#SEMIC	;SEE IF PROPERLY TERMINATED
	BEQ	1$		;YES, GO SEND BUFFER
	MOVB	#SEMIC,(R1)+	;NO, ADD TERMINATING SEMICOLON
	INC	BUFCNT		;COUNT THIS CHARACTER
1$:
	MOV	#CALLGP,R5	;CALL FORTRAN FUNCTION IBUP
	JSR	PC,IBUP		;DO GPIB I/O WITH A LITTLE HELP FROM OUR FRIENDS
	TST	R0		;SEE IF EVERYTHING IS OK
	BMI	OUTERR		;NOPE, GIVE ERROR MESSAGE AND QUIT
	JSR	PC,INITBF	;AND INITIALIZE BUFFER FOR NEXT TIME
	MOV	(SP)+,R5	;RESTORE R5 THRU R0
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
DXIT:	RTS	PC		;AND DONE

CALLGP:	.WORD	4,FUNCTN,IDEV,BUFFER,BUFCNT
FUNCTN:	.WORD	0
IDEV:	.WORD	SLOTNM

OUTERR:
	ERROR	<GD7225 - WRITE ERROR>

INITBF:	CLR	BUFCNT		;NO CHARS THERE YET
	MOV	#BUFFER,BUFIN	;RESTORE POINTER
	CLRB	DOINGV		;NO VECTOR SEQUENCE GOING
	RTS	PC		;AND RETURN
	.SBTTL	VARIABLES AND BUFFER

NEWX:	.WORD	0
NEWY:	.WORD	0
LONG:	.WORD	0
PENPOS:	.BYTE	0
DOINGV:	.BYTE	0
	.EVEN

BUFIN:	.WORD	BUFFER
BUFCNT:	.WORD	0
BUFFER:	.BLKB	BUFSIZ
	.EVEN

	.END