.TITLE	HPNUMS
	.ENABLE	LC
;NUMBER ENCODERS FOR HP PLOTTER 7221 MODEL
;CALLABLE FROM MACRO-11
;
;SBN - ENCOE SINGLE BYTE NUMBER
;	IN: R0= NUMBER
;	OUT: R1=BYTE
SBN::
	MOV	R0,R1
	BIC	#^C77,R1	;GET 6 BITS
	BIT	#40,R1		;VALID?
	BNE	1$		;YES, LEAVE IT
	BIS	#100,R1		;NO, MAKE ASCII LIKE THIS
1$:	RTS	PC
;
;MBN - MULTIBYTE SINGLE NUMBER
;IN: R0 = NUMBER
;    R1=ADDRESS TO STORE BYTE STRING IN
;OUT: BYTE STRING FILLED IN.
;	R2=COUNT OF BYTES OUT
MBN::
	CLR	R2
	BIC	#100000,R0	;ZAP HIGH BIT TO ENSURE LEGAL
	CMP	R0,#20		;1 BYTE ENOUGH?
	BHIS	1$		;NO, LOOK MORE
;DO 1 BYTE DECODE
	ADD	#96.,R0
	MOVB	R0,(R1)+	;EMIT STRING
	INC	R2
	BR	99$
1$:	CMP	R0,#2000	;2 BYTES DO?
	BHIS	2$		;IF HIS NO, SKIP
;DO 2 BYTE DECODE
	MOV	R0,R3		;COPY NUMBER
	ASH	#-6,R3		;ZOT OFF LOW BITS
	JSR	PC,ASMIT	;ASSEMBLE #
	MOV	R0,R3
	BIC	#^C77,R3
	JSR	PC,ASMIT	;ASSEMBLE THE REST
	MOV	#2,R2		;2 BYTES OUT
	BR	99$
2$:
;DO 3 BYTE DECODE
	MOV	R0,R3
	ASH	#-12.,R3		;GET 1ST PART
	JSR	PC,ASMIT
	MOV	R0,R3
	BIC	#70000,R3
	ASH	#-6,R3
	JSR	PC,ASMIT		;GET 2ND PART
	MOV	R0,R3
	BIC	#^C77,R3
	JSR	PC,ASMIT
	MOV	#3,R2		;3 CHARS OUT
99$:
; DONE
	RTS	PC
ASMIT:
	BITB	#40,R3		;R3 LEGAL ASCII NOW?
	BNE	1$		;IF SO ALL'S WELL
	BIS	#100,R3		;ELSE NOT, SO MAKE IT OK
1$:	MOVB	R3,(R1)+	;STORE THE DATA
	RTS	PC
;
;MBP
; MULTIBYTE PAIRS
;	IN:	R0=X INPUT
;		R1=Y INPUT
;		R2=ADDRESS TO STORE BYTES
; OUT:
;	ARRAY FILLED WITH BYTES
;	R3=NUMBER BYTES GENERATED
MBP::
	BIC	#140000,R0
	BIC	#140000,R1	;MAKE SURE RANGE IS OK
	MOV	R0,R3
	CMP	R1,R3
	BLT	1$
	MOV	R1,R3		
1$:			;R3 NOW IS MAX (R0,R1)
	CMP	R3,#3
	BHI	10$	;TOO BIG IF HI FOR 1 BYTE
;DO 1 BYTE FORMAT
	MOV	R0,R3
	ASL	R3
	ASL	R3	;GET X BITS
	BIS	R1,R3	;AND Y BITS
	BIS	#140,R3	;ADD ZONES
	MOVB	R3,(R2)+
	MOV	#1,R3	;SAY 1 BYTE DONE
	BR	99$
10$:	CMP	R3,#31.
	BHI	20$
;DO 2 BYTE FORMAT
	MOV	R0,R3
	ASR	R3		;4 BITS OF X
	BIS	#140,R3
	MOVB	R3,(R2)+	;EMIT P1
	MOV	R0,R3
	ASH	#5,R3		;MOVE UP X0 BIT
	BIC	#^C40,R3	;CLEAR ALL BUT THAT
	BIS	R1,R3		;ADD IN 5 BITS FROM Y
	JSR	PC,MASMIT	;SHIP IT OUT
	MOV	#2,R3		;2 BYTES DONE
	BR	99$
20$:	CMP	R3,#255.
	BHI	30$
;DO 3 BYTE FORMAT
	MOV	R0,R3
	ASH	#-4,R3		;GET 4 BITS
	BIS	#140,R3
	MOVB	R3,(R2)+	;1ST BYTE OUT
	MOV	R0,R3
	BIC	#^C17,R3	;REMOVE ALL BUT 4 BITS
	ASL	R3
	ASL	R3		;2 ASL'S = 1 ASH #2
	MOV	R1,R4
	ASH	#-6.,R4		;SHIFT DOWN Y
	BIS	R4,R3		;FILL IN 2 BITS LEFT
	JSR	PC,MASMIT	;SHIP OUT 2ND BYTE
	MOV	R1,R3
	BIC	#^C77,R3	;ISOLATE LST Y BITS
	JSR	PC,MASMIT	;SHIP THEM
	MOV	#3,R3		;3 BYTES DONE
	BR	99$
30$:	CMP	R3,#2047.
	BHI	40$
;DO 4 BYTE FORMAT
	MOV	R0,R3
	ASH	#-7,R3
	BIS	#140,R3
	MOVB	R3,(R2)+	;1ST BYTE OUT
	MOV	R0,R3
	ASR	R3
	BIC	#^C77,R3
	JSR	PC,MASMIT	;SEND OUT 2ND BYTE
	MOV	R0,R3
	ASH	#5,R3
	BIC	#^C40,R3	;LAST X BIT
	MOV	R1,R4
	ASH	#-6,R4		;REMOVE ALL BUT H.O.
	BIS	R4,R3		;NOW 6 BITS DATA
	JSR	PC,MASMIT
	MOV	R1,R3
	BIC	#^C77,R3	;GET LAST 6 BITS
	JSR	PC,MASMIT
	MOV	#4,R3
	BR	99$
40$:
;DO 5 BYTE FORMAT (RANGE GUARANTEED OK)
	MOV	R0,R3
	ASH	#-10.,R3
	BIS	#140,R3
	MOVB	R3,(R2)+	;1ST BYTE OUT
	MOV	R0,R3
	ASH	#-4,R3
	BIC	#^C77,R3
	JSR	PC,MASMIT	;2ND OUT
	MOV	R0,R3
	BIC	#^C17,R3
	ASL	R3
	ASL	R3
	MOV	R1,R4
	ASH	#-12.,R4
	BIS	R4,R3
	JSR	PC,MASMIT
	MOV	R1,R3
	ASH	#-6,R3
	BIC	#^C77,R3
	JSR	PC,MASMIT
	MOV	R1,R3
	BIC	#^C77,R3
	JSR	PC,MASMIT	;5TH CHAR OUT
	MOV	#5,R3		;5 IN ALL
99$:
	RTS	PC
MASMIT:
	BITB	#40,R3		;R3 LEGAL ASCII NOW?
	BNE	1$		;IF SO ALL'S WELL
	BIS	#100,R3		;ELSE NOT, SO MAKE IT OK
1$:	MOVB	R3,(R2)+	;STORE THE DATA
	RTS	PC
;
;
;	HIGHER LEVEL CALLING ROUTINES FOR HP PLOTTER USING PLOTA
;PACKAGE
;
;
; HPTST - LOOK AT LUN 2 (USED BY PLXY11). IF ASSIGNED TO A TERMINAL
;LINE, THEN ASSUME CONNECTED TO HP PLOTTER. RETURN C SET IF
;A TTY, C CLEAR IF TO DISK OR LP:.
GOTFG:	.WORD	0	;LUN INFO
HPTST::
	.MCALL	GLUN$S
	TST	GOTFG
	BNE	33$		;IF ALREADY DID GLUN$S THEN GO ON
	MOV	#1,GOTFG
	GLUN$S	#2,#LUNINF	;SEE WHAT LUN 2 IS ASSIGNED TO
	BCS	HTOK		;IF NOTHING, HOPE PLXY11 CAN ASSIGN LUN.
	;IF GOT LUN ALREADY GO HERE
33$:
	CMP	LUNINF,(PC)+	;SEE IF THE DEVICE NAME...
	.ASCII	/TT/		;...IS "TT"
	BEQ	HTNG		;IF SO TELL CALLER IT'S A TT: AND USE HP STUFF
	.IIF DF,D$BG, BR HTNG ;*** DEBUG ** GET OUTPUT TO FILE
;ELSE ASSUME PLXY IS TO BE USED.
HTOK:	CLC
	RTS	PC
HTNG:	SEC
	RTS	PC
LUNINF:	.BLKW	6	;LUN INFO AREA
;
;COLORH - SET UP DUMMY "COLORS" FROM ARG -- FORTRAN CALLABLE
COLORH::
	TST	#COLORS		;IS REAL "COLORS" GLOBAL LINKED IN?
	BNE	1$		;IF SO SET THAT TO ARG
	MOV	@2(R5),COLRDF	;ELSE SET UP COLOR DEFAULT
	RTS	PC
1$:	MOV	@2(R5),COLORS
	RTS	PC
COLRDF:	.WORD	0		;DEFAULT "COLORS" STORAGE
;
;	MEANING:
;		BITS 2-0	-	PEN NUMBER -1 (PENS 1-8)
;		BIT 3		-	IF SET, NEW COLOR OUT NOW.
; (SAME FOR COLORS OR COLRDF)
;
;COLRGT - GET CURRENT COLOR SPEC
COLRGT::
	TST	#COLORS
	BEQ	1$
	MOV	COLORS,R0	;RETURN CURRENT "COLORS" VALUE
	RTS	PC
1$:	MOV	COLRDF,R0
	RTS	PC
;HPINIT - INITIALIZE PLOTTER. GLOBAL "COLORS" MUST BE SET UP HERE
;TO SET UP COLOR.
HPINIT::
	JSR	PC,HPTST
	BCC	HTOK		;IF NOT HP PLOTTER DISREGARD
	TST	#COLORS
	BEQ	1$
	BIC	#10,COLORS	;ENSURE INIT FLAG GETS CLEARED
	MOV	COLORS,COLRDF	;SET UP COLRDF AS CORRECT ALWAYS
1$:	BIC	#10,COLRDF	;CLEAR INIT FLAG IF HERE!
	JSR	PC,COLRGT
	CLR	R5		;R5 = STRING LENGTH
	BIC	#^C7,R0		;LEAVE PEN ONLY
	MOV	#WRKSTR,R1
	INC	R0
	BIS	#100,R0
	MOVB	R0,NPEN
	MOV	#INIT,R0
	MOV	#INITL1,R2
2$:	MOVB	(R0)+,(R1)+
	INC	R5
	DEC	R2
	BGT	2$
	MOV	R5,WRKLEN
	MOV	R1,R2		;R2 = OUTPUT ADDRESS NOW
	MOVB	#'~,(R2)+
	INC	WRKLEN
	MOVB	#'S,(R2)+	;SET GRID SIZE TO (0,2048) IN (X,Y)
	MOV	#2048.,R0
	MOV	R0,R1
	JSR	PC,MBP
	ADD	R3,WRKLEN
	MOVB	#'},(R2)+
	INC	WRKLEN
	MOVB	#'~,(R2)+
	MOVB	#'P,(R2)+	;SET FONTS UP
	ADD	#2,WRKLEN
	MOV	#2,R0		;STD CHAR SET = 2
	MOV	#5,R1		;ALT CHAR SET = GRAPHICS
	JSR	PC,MBP
	ADD	R3,WRKLEN	;ADD ENCODING SIZE IN
	MOVB	#'},(R2)+
	INC	WRKLEN
;	INC	WRKLEN
;NOW THE ENTIRE STRING WE WANT IS ENCODED. CALL A FORTRAN
;ROUTINE CALLED "HPDMP" TO OUTPUT TO LUN 2. NOTE NO CARRIAGE
;CONTROL SHOULD BE USED.
	JSR	PC,HPOPEN	;OPEN LUN 2 (NO ARGS)
	MOV	#WRKARG,R5	;POINT AT ARG LIST.
; CALL HPDMP(ADDRESS, NBYTES)
	JSR	PC,HPDMP
	RTS	PC		;RETURN TO CALLER
SFL:
	MOVB	#33,(R2)+
	MOVB	#'.,(R2)+
	ADD	#2,WRKLEN
	RTS	PC
;
;
;HPTXT - DRAW STRING.
; INPUTS:
;	R0 = # CHARS / GRID SIZE OF CHARS
;	R1=  ADDRESS OF CHARS
;	R2,R3 = X,Y OF CHARS
; (ALSO WILL REINIT IF A NEW COLOR IS SPECIFIED)
HPTXT::
	JSR	PC,HPTST
	BCC	HTOK
	JSR	R5,RSAV
	JSR	PC,COLRGT	;GET COLOR INFO
	BIT	#10,R0		;NEW COLOR?
	BEQ	1$		;IF EQ NO
	JSR	PC,COLINT	;IF NE YES SO REINIT
1$:	JSR	R5,RRES
	JSR	R5,RSAV		;GET BACK OUR REGISTERS
;TEXT SIZE IS 7 * SPACING GIVEN. HEIGHT IS 9 * SPACING.
	MOV	#WRKSTR,R2
	CLR	WRKLEN		;INIT STRING POINTERS
;	JSR	PC,SFL		;EMIT PREFIX
	MOV	@SP,R3
	SWAB	R3		;LOW IS SIZE NOW
	BIC	#^C377,R3	;ZAP HI BYTE
	BNE	34$		;0 IMPLIES DEFAULT 4
	MOV	#4,R3
34$:
	MOV	R3,R1
	ASL	R1
	MUL	#7,R3		;GET TEXT SIZE
	ADD	R3,R1		;R1 = LINE HEIGHT
	MOVB	#'~,(R2)+
	MOVB	#'%,(R2)+	;EMIT TEXT SIZE CMD
	ADD	#2,WRKLEN
	MOV	R3,R0		;SET FOR MBP
	JSR	PC,MBP		;EMIT <SPACE,LINE> PAIR
	ADD	R3,WRKLEN
	MOVB	#'},(R2)+	;TERMINATOR
	INC	WRKLEN
;	JSR	PC,SFL		;EMIT PREFIX
	MOVB	#'p,(R2)+
	INC	WRKLEN		;SET UP A MOVE COMMAND
	MOV	4(SP),R0	;GET X COORD
	MOV	6(SP),R1	;AND Y COORD
	JSR	PC,MBP		;ENCODE
	ADD	R3,WRKLEN	;SAVE SIZE
	MOVB	#'},(R2)+	;TERMINATOR
	INC	WRKLEN
;	JSR	PC,SFL		;PREFIX
	MOVB	#'~,(R2)+	;THEN LABEL MODE
	MOVB	#'',(R2)+	;CODE...
	ADD	#2,WRKLEN
	MOV	2(SP),R1	;ADDRESS OF USER STRING
	MOV	@SP,R0		;USER SIZE/TXTSIZE
	BIC	#^C377,R0	;1 BYTE ONLY PLEASE
	CMP	R0,#80.		;80 CHARS MAX
	BLOS	6$
	MOV	#80.,R0		;CLAMP SIZE MAX
6$:	MOVB	(R1)+,(R2)+	;COPY STRING
	INC	WRKLEN
	DEC	R0		;COUNT DOWN LENGTH TO DO
	BGT	6$
	MOVB	#3,(R2)+	;STASH ETX TO STOP LABE MODE
	INC	WRKLEN
	MOV	#WRKARG,R5
	JSR	PC,HPDMP	;DUMP IT OUT TO LUN 2
	JSR	R5,RRES
	RTS	PC
;
;
;HPOFF - TURN OFF PLOTTER
HPOFF::
	JSR	PC,HPTST
	BCC	HOFX
	MOV	#WRKSTR,R2
	CLR	WRKLEN
	MOVB	#'v,(R2)+	;PUT BACK PEN
	MOVB	#'@,(R2)+
	ADD	#2,WRKLEN	;ACCOUNT FOR CHARACTERS USED
	JSR	PC,SFL		;SET OUT GRAPHICS PREFIX
	MOVB	#'),(R2)+	;TURN OFF PLOTTER
	INC	WRKLEN
	MOV	#WRKARG,R5
	JSR	PC,HPDMP	;EMIT IT
;ALLOW NORMAL EXIT TO CLOSE LUN 2.
HOFX:
	RTS	PC
;
;
;HPLINE - DRAW LINE FROM (R0,R1) TO (R2,R3)
;
HPLINE::
	JSR	PC,HPTST
	BCC	HOFX
	JSR	R5,RSAV
	JSR	PC,COLRGT	;GET COLOR INFO
	BIT	#10,R0		;NEW COLOR?
	BEQ	1$		;IF EQ NO
	JSR	PC,COLINT	;IF NE YES SO REINIT
1$:	JSR	R5,RRES
	JSR	R5,RSAV		;GET BACK OUR REGISTERS
	MOV	#WRKSTR,R2
	CLR	WRKLEN		;INITIALIZE OUTPUT STRING
	MOVB	#'p,(R2)+
	INC	WRKLEN		;SET "MOVE" PREFIX
	JSR	PC,MBP		;SET OUT INITIAL X,Y COORDS
	MOV	4(SP),R0	;THEN NEXT X
	MOV	6(SP),R1	;AND Y
	ADD	R3,WRKLEN
	JSR	PC,MBP
	ADD	R3,WRKLEN	;THEN FINISH 2ND COORDS (DRAWS LINE)
	MOVB	#'},(R2)+	;TERMINATOR
	INC	WRKLEN
	MOV	#WRKARG,R5
	JSR	PC,HPDMP	;THEN SEND IT TO THE PLOTTER
	JSR	R5,RRES
	RTS	PC
;INITIALIZING FIXED TEXT.
INIT:	.ASCII	<33>/.(v/
	.BYTE	100	;PUT BACK OLD PEN
	.ASCII	<33>/.M:/
	.ASCII	<33>/.I;;17:/
	.ASCII	<33>/.N;19:/
	.ASCII	/v/
NPEN:	.BYTE	0
;	.ASCII	/~W/
INITL1=.-INIT
	.EVEN
COLINT:	;INTERNAL ENTRY TO INIT COLORS
	MOV	#WRKSTR,R2
	CLR	WRKLEN
	MOV	#WRKARG,R5
	MOVB	#'v,(R2)+	;REPLACE OLD PEN
	MOVB	#'@,(R2)+
	TST	#COLORS
	BEQ	1$
	BIC	#10,COLORS	;ENSURE INIT FLAG GETS CLEARED
	MOV	COLORS,COLRDF	;SET UP COLRDF AS CORRECT ALWAYS
1$:	BIC	#10,COLRDF	;CLEAR INIT FLAG IF HERE!
	JSR	PC,COLRGT
	MOVB	#'v,(R2)+	;SET NEW PEN HERE
	BIC	#^C7,R0
	BIS	#100,R0		;MAKE PROPER PACKING
	MOVB	R0,(R2)+
	MOV	#4,WRKLEN	;THEN SHIP IT
	JSR	PC,HPDMP
	RTS	PC
;
WRKARG:	.WORD	2,WRKSTR,WRKLEN	;FORTRAN ARGLIST FOR LUN 2 OUT
WRKSTR:	.BLKW	100		;WORK STRING AREA
WRKLEN:	.WORD	0		;LENGTH AREA
	.END