;	****************************************
;	* HP PLOTTER DRIVER FOR HP7221 PLOTTER *
;	****************************************

	.TITLE	GD7221
	.IDENT	/VERS20/
	.ENABLE LC

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

; 1) SET THE SYMBOL "OS" TO:
;	1 ==> RT-11
;	2 ==> TSX (NOT IMPLEMENTED)
;	3 ==> RSX11M (IMPLIES FPU)
;
	.IIF NDF OS		OS = 3

; 2) FOR RT-11 ONLY:
;	"DLICSR" IS THE ADDRESS OF THE INPUT CSR OF THE SERIAL LINE
;	TO THE HP 7220 PLOTTER
;
	.IIF NDF DLICSR		DLICSR	= 176510

; 3) FOR RSX11M ONLY:
;	"TTUNIT" IS THE TERMINAL DRIVER UNIT NUMBER THAT THE 7221
;	IS ATTACHED TO (I.E. TT5 ==> TTUNIT=5)
;
	.IIF NDF TTUNIT		TTUNIT	= 4

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



	.SBTTL	DEFINITIONS, ETC.

	.IIF EQ OS-1	.MCALL	.PRINT, .TTYIN
	.IIF EQ OS-3	.MCALL	QIOW$, ALUN$, DIR$

	.GLOBL	GDAID


	BUFSIZ	= 70.

	SEMIC	= ';
	COMMA	= ',
	LF	= 12
	CR	= 15
	ESC	= 33

	DLIBUF	= DLICSR + 2
	DLOCSR	= DLICSR + 4
	DLOBUF	= DLICSR + 6

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


	.PSECT	GD7221		;WE ARE RELOCATABLE
	.SBTTL	ENTRY POINT

GD221L::
	MOV	#1,LONG		;SHOW LONG X MODE
	BR	GD7221

GD221T::
	CLR	LONG		;SHOW NOT LONG X MODE

GD7221:	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	<GD7221 - ILLEGAL FUNCTION>

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


	;
	;INITIALIZE
	;
INIT:
	.IF EQ OS-1
	TST	@#DLIBUF	;REMOVE ANY OLD CHARACTERS
	.ENDC

	.IF EQ OS-3
	JSR	PC,GETINT	;GET "LUN" ARGUMENT AS INTEGER IN R1
	MOV	R5,-(SP)	;SAVE ARGUMENT PTR
	MOV	R1,ADPB+A.LULU	;PREPARE TO ASSIGN LUN
	MOV	R1,QDPB+Q.IOLU	;SET QIO LUN INCASE ALL GOES WELL
	DIR$	#ADPB		;ASSIGN TO TTn
	BCS	INITER		;ASSIGN FAILED, VERY BAD
	MOV	#IO.ATT,QDPB+Q.IOFN	;DO AN ATTACH OF TTn
	DIR$	#QDPB
	BCC	ALLOK
INITER:	ERROR	<GD7221 - ASSIGN/ATTACH FAILED>
ALLOK:
	.ENDC	;EQ OS-3

	JSR	PC,INITBF	;INITIALIZE THE BUFFER
	MOV	#1,BYPASS	;BYPASS HANDSHAKE FOR CONFIG.
	JSR	R5,INSERT	;ONCE ONLY PLOTTER CONFIG.
	.ASCII	<ESC>".("	;PLOTTER ON
	.ASCII	<ESC>".@;2:"	;ENABLE TRANSMISSION INSPITE OF DTR
	.ASCII	<ESC>".M:"	;SET DEF. RESPONSE MESSAGE FMT
	.ASCII	<ESC>".I100;7;71:" ;100 BYTE BUFFERS, "<BELL>" FOR PROMPT
				;AND "G" FOR BUFFER SPACE AVAIL.
PRMTC = 7
	.ASCII	<ESC>".N:"	;NO IMMEDIATE RESPONSE
	.BYTE	-1
	.EVEN
	JSR	PC,DUMP1	;SEND IT INITIALIZATION STUFF
	CLR	BYPASS		;NORMAL HANDSHAKE FROM NOW ON
	JSR	R5,INSERT
	.ASCII	"vA"		;SELECT PEN 1
	.ASCII	"~S"		;SET "GRID SIZE" OR RESOLUTION.
	.BYTE	-1
	.EVEN
	MOV	#15500.,R0	;ADDRESS ALL 7221 RESOLUTION AT DEF. LIMITS
	MOV	#10000.,R1
	JSR	PC,MBPAIR
	JSR	PC,DUMP1
	MOV	#ZERO,R4	;ALL WORKED, RETURN GOOD STATUS
IEXIT:	MOV	(SP)+,R5	;RESTORE ARGUMENT POINTER
	MOV	(R5)+,R3	;MOVE FLOATING POINT BACK
	MOV	(R4)+,(R3)+	;FIRST WORD
	MOV	(R4),(R3)	;2ND WORD
	RTS	PC

ZERO:	.FLT2	0.0


	;
	;BGNPLT
	;
BGNPLT:
	.IF EQ OS-3
	;RSX
	DIR$	#QDPB5

	.IFF
	;RT11 AND TSX
	.PRINT	#NEWPAG
1$:	.TTYIN			;WAIT FOR CRLF
	CMPB	R0,#LF
	BNE	1$

	.IFTF
	;RT, TSX, AND RSX
	JSR	PC,INITBF	;INIT PLOTTER BUFFER
	JSR	R5,INSERT
	.ASCII	"vA"		;SELECT PEN 1
	.BYTE	-1
	.EVEN
	RTS	PC		;DONE

NEWPAG:	.ASCII	"Place fresh sheet of paper on HP plotter.   Hit return"
	MSGLEN	= .-NEWPAG
	.BYTE	200
	.EVEN

	.IFT
	;RSX
QDPB5:	QIOW$	IO.RPR,5,1,50.,IOSB,,<INBUF,1,0,NEWPAG,MSGLEN,'$>
	.ENDC	;EQ OS-3
	.SBTTL	MOVE AND DRAW

MOVE:	JSR	R5,INSERT	;DO A MOVE
	.BYTE	'p,-1
	.EVEN
	BR	MDCOMN

DRAW:	TSTB	DOINGV		;SEE IF MOVE/DRAW SEQUENCE GOING
	BNE	MDCOMN		;YES, ALL IS OK
	JSR	R5,INSERT	;DO A DRAW
	.BYTE	'q,-1
	.EVEN

MDCOMN:	JSR	PC,MAKINT	;MAKE X,Y INTO INTEGERS
	JSR	PC,MBPAIR	;CONVERT R0,R1 TO MBP AND PLACE IN BUFFER
	MOVB	#1,DOINGV	;SHOW VECTOR SEQUENCE GOING
	JSR	PC,TDUMP	;MAKE SURE ENOUGH ROOM FOR NEXT TIME
	RTS	PC
	.SBTTL	MBP CONVERSION
MBPAIR:
	;CONVERT X,Y IN R0,R1 INTO 5 BYTE MBP FORMAT FOR 7221
	;THE 5 BYTE FORMAT CAN MOST EASILY BE DONE BY PLACING THE 14 Y BITS
	;IMMEDIATELY FOLLOWING THE 14 X BITS, THEN SHIFTING THEM OUT TOGETHER.
	;BEST USE OF THE PDP 11 CAN BE MADE BY SHIFTING THE BITS FROM R0-R1
	;INTO THE HIGH BYTE OF R0.   THUS, WE FIRST SHIFT X RIGHT INTO Y
	;DROPPING THE TWO UNUSED Y BITS (14 AND 15).
	MOV	BUFIN,R5	;R5 ==> BUFFER
	ASR	R0		;SHIFT X RIGHT TO PACK IT UP AGAINST Y
	BCC	1$		;IF BIT 0 WAS SET WE MUST SET BIT 14 IN R1
	BIS	#40000,R1
1$:	ASR	R0		;ANOTHER SHIFT TO DO THE FINAL PACKING
	BCC	2$		;IF BIT 1 WAS SET WE MUST SET BIT 15 IN R1
	BIS	#100000,R1
2$:
	;AT THIS POINT, R0-R1 CONTAINS THE 28 BIT X,Y COORD. PACKED INTO THE
	;28 LSB OF R0-R1.   WE NOW POP THE BITS OUT AS NEEDED.
	MOV	R0,R2		;HIGH BYTE OF R0 HAS FIRST 4 BITS WE NEED
	SWAB	R2		;PLACE X BITS 13-10 INTO R2 BITS 3-0
	BIC	#177760,R2	;MAKE SURE ONLY X BITS 13-10 IN 3-0
	BIS	#140,R2		;SET FLAG BITS
	MOVB	R2,(R5)+	;INSERT FIRST MBP BYTE
	MOV	R0,R2		;GET NEXT 6 BITS (X 9-4)
	ASR	R2		;PUT X4 INTO 1
	ASR	R2		;PUT X4 INTO 0
	JSR	PC,CBIT		;GET GOOD 6 BITS AND SET "COMPLEMENT" BIT
	MOV	#3,R4		;LOOP 3 TIMES
	MOV	#4,R2		;SHIFT UP 4 BITS CAUSE TWO ARE ALREADY IN R0
LOOP:	JSR	PC,UPSHFT	;SHIFT LEFT AND MOVE R0 TO R2
	JSR	PC,CBIT
	MOV	#6,R2		;6 BITS NEXT TIME
	DEC	R4		;LOOP ALL THREE TIMES
	BNE	LOOP
	MOV	R5,BUFIN	;RESTORE BUFFER POINTER
	RTS	PC		;ALL DONE

CBIT:	BIC	#177700,R2	;ONLY BITS 5-0.
	BIT	#40,R2		;SEE IF BIT 5 SET
	BNE	1$		;YES, THEN ALL IS OK
	BIS	#100,R2		;NOPE, SET BIT 6
1$:	MOVB	R2,(R5)+	;INSERT BYTE OF MBP
	RTS	PC

UPSHFT:	ASL	R1		;SHIFT LEFT 16 LSB
	ROL	R0		;COMPLETE SHIFT ON MSB
	DEC	R2		;COUNT SHIFTS DOWN
	BNE	UPSHFT
	MOV	R0,R2		;RETURN MSB IN R2 FOR CALLER CONVIENCE.
	RTS	PC
	.SBTTL	ENDPLT AND RLSDEV

ENDPLT:	JSR	PC,DUMP
	RTS	PC

RLSDEV:	JSR	PC,DUMP		;FORCE LAST BUFFER OUT
	JSR	R5,INSERT
	.ASCII	"v@}"		;RETURN PEN TO HOLDER
	.ASCII	<ESC>".)"	;PLOTTER OFF
	.BYTE	-1
	.EVEN
	JSR	PC,DUMP
	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$

	YFULLS = 10000.
	NPENS	= 4.
CHRTBL:	.FLT2	7221.5, 25.001, 38.001
RESLN:
XGUPCM:	.FLT2	400.0		;REAL RESOLUTION
YGUPCM:	.FLT2	400.0
	.FLT2	4.0		;4 COLORS
	.FLT2	24.0		;SHARE+HCOPY+STROKE
;	.FLT2	15.0		;ASSUME PEN IS 15/40 MILLIMETERS WIDE

CWORDS	= <.-CHRTBL>/2

LNGTBL:	.FLT2	7221.0, 38.001, 25.001
LNGWDS	= <.-LNGTBL>/2
	.SBTTL	SELECT COLOR (PEN)

SELCOL:
	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" PENS ON PLOTTER
	BHI	COLERR		;TOO BIG

	.IF NE NPENS-1
	BIS	#100,R1		;COMPLEMENT BIT MUST BE ON!!!
	MOVB	R1,PENNUM	;PLACE IN COMMAND
	JSR	R5,INSERT	;PUT PEN COMMAND IN BUFFER
	.ASCII	"v"
PENNUM:	.BYTE	100
	.BYTE	-1		;END OF INSERT
	.EVEN
	JSR	PC,TDUMP	;MAKE SURE ROOM FOR MORE
	CLRB	DOINGV		;ENDED VECTOR SEQUENCE

	.IFTF
	RTS	PC		;ALL DONE

	.IFT
COLERR:	ERROR	<GD7221 - 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


GETINT:	MOV	(R5)+,R4	;POINT TO FLOATING VALUE

	.IF EQ OS-3
	;RSX11M
	SETF
	SETI
F0=%0
	LDF	(R4)+,F0	;GET FLOATING PT. NUMBER
	STCFI	F0,R1		;MAKE INTEGER INTO R1
	RTS	PC		;DONE

	.IFF
	;RT-11
	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
	.ENDC	;EQ OS-3


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

	.IFF
	;RSX11M
	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 AN ERROR YET
	JSR	PC,$ERRLG	;PRINT THE ERROR MESSAGE
	CMP	(SP)+,(SP)+	;CLEAN THE STACK
	TRAP	+341		;GIVE NON-FTN ERROR
	.ENDC	;NE OS-3
	.SBTTL	BUFFER UTILITIES

INITBF:	MOV	#BUFFER,BUFIN	;RESTORE POINTER
	CLRB	DOINGV		;NO VECTOR SEQUENCE GOING
	RTS	PC		;AND RETURN

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

INSERT:	MOV	R1,-(SP)	;SAVE R1
	MOV	BUFIN,R1	;R1 ==> BUFFER
2$:	MOVB	(R5)+,(R1)+	;MOVE INSERT DATA INTO BUFFER
	BPL	2$		;COPY 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:	CMP	BUFIN,#BUFFER	;SEE IF ANY CHARACTERS TO SEND
	BEQ	DXIT		;NOPE, JUST EXIT
DUMP1:	MOV	R0,-(SP)	;SAVE R0
	MOV	R1,-(SP)	;SAVE R1
	MOV	BUFIN,R1	;R1 ==> LAST CHARACTER+1
	MOVB	#'},(R1)+	;INSERT "NOP" AS TERMINATOR
	MOV	R1,BUFIN	;SET GOOD BUFFER POINTER
	JSR	PC,TRNSMT	;SEND TO PLOTTER
	JSR	PC,INITBF	;AND INITIALIZE BUFFER FOR NEXT TIME
	MOV	(SP)+,R1
	MOV	(SP)+,R0
DXIT:	RTS	PC		;AND DONE
	.SBTTL	RT-11 SERIAL TRANSMISSION SUBROUTINE

	.IF EQ OS-1
TRNSMT:	TST	BYPASS		;SEE IF HANDSHAKE NEEDED
	BNE	5$		;NOPE, SEND WITH-OUT HANDSHAKE
	TSTB	@#DLIBUF	;CLEAR OUT ANY OLD JUNK
	MOVB	#'?,R0		;SEND "?" TO SEE IF ROOM
	JSR	PC,SEND1C
1$:	TSTB	@#DLICSR	;WAIT FOR RESPONSE
	BPL	1$

5$:	MOV	#BUFFER,R1	;R1 ==> BUFFER
6$:	MOVB	(R1)+,R0	;SEND THIS CHARACTER
	JSR	PC,SEND1C
	CMP	R1,BUFIN	;SEE IF ALL DONE
	BNE	6$		;NOPE, GO DO NEXT
	MOVB	#CR,R0		;TERMINATE WITH RETURN
	JSR	PC,SEND1C
	RTS	PC		;DONE

SEND1C:	TSTB	@#DLOCSR	;WAIT FOR XMITTER READY
	BPL	SEND1C
	MOVB	R0,@#DLOBUF	;SEND CHARACTER
	RTS	PC
	.ENDC
	.SBTTL	RSX11M SERIAL TRANMISSION SUBROUTINE

	.IF EQ OS-3		;RSX11M
TRNSMT:	TST	BYPASS		;SEE IF WE NEED TO HANDSHAKE
	BNE	1$		;NOPE
	MOV	#IO.RPR!TF.RNE,QDPB+Q.IOFN	;ASK IF SPACE AVAIL.
	MOV	#QDPB+Q.IOPL,R0	;R0 ==> QIO PARAMETERS
	MOV	#INBUF,(R0)+	;INPUT BUFFER IS "INBUF"
	MOV	#1,(R0)+	;ONE CHARACTER TO READ IN
	CLR	(R0)+		;ZERO TIME-OUT
	MOV	#REQMSG,(R0)+	;PROMPT WITH "?" TO GET "G" WHEN SPACE
				;IS AVAILABLE
	MOV	#REQSIZ,(R0)+	;SIZE OF PROMPT
	CLR	(R0)+		;PROMPTING VFC IS NONE
	DIR$	#QDPB		;DO THE READ-AFTER-PROMPT
	BCS	WRTERR		;OOPS
	CMPB	IOSB,#IS.SUC	;MAKE SURE ALL IS OK
	BNE	WRTERR
	CMPB	INBUF,#'G	;MAKE SURE WE GOT RESPONSE STRING
	BEQ	1$		;YES
	HALT

1$:	MOV	BUFIN,R1	;LOCATION OF LAST CHAR +1
	SUB	#BUFFER,R1	;BYTE COUNT TO WRITE TO PLOTTER
	MOV	#QDPB+Q.IOPL,R0	;R0 ==> QIO PARAMETERS
	MOV	#BUFFER,(R0)+	;SET BUFFER ADDRESS
	MOV	R1,(R0)+	;SET BUFFER SIZE
	CLR	(R0)		;NO VFC
	MOV	#IO.WLB,QDPB+Q.IOFN ;PLAIN OLD WRITE
	DIR$	#QDPB
	BCS	WRTERR
	CMPB	IOSB,#IS.SUC	;MAKE SURE ALL IS OK
	BNE	WRTERR
	RTS	PC

WRTERR:	ERROR	<GDHPPL - ERROR ON QIO TO PLOTTER>

QDPB:	QIOW$	IO.WLB,0,1,50.,IOSB,,<BUFFER,0>

REQMSG:	.BYTE	PRMTC
	REQSIZ	= .-REQMSG
	.EVEN

INBUF:	.BLKB	1
	.EVEN

IOSB:	.BLKW	2

ADPB:	ALUN$	0,TT,TTUNIT
	.ENDC
	.SBTTL	VARIABLES AND BUFFER

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

BYPASS:	.WORD	0

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

	.END