.TITLE	HPNUMERIC
	.IDENT	/10DEC/
;-----------------------------------------------------------------------
;	PROCEDURES TO GENERATE REQUIRED NUMERIC FORMS
;	=============================================
;
;	THE FOLLOWING PROCEDURES GENERATE THE NUMERIC FORM WHICH THE
;	HP 7221 PLOTTER REQUIRES IN VARIOUS CONTEXTS.  THE MNEMONIC
;	FOR THE FORM IS THE SAME AS THE ENTRY POINT.  IN ALL CASES
;	THE LINKAGE IS FORTRAN COMPATIBLE.
;
;	THE CHARACTERS ARE STORED IN THE BUFFER IN WHICH THE PLOT
;	IS BUILT AND THE COUNTER UPDATED.  THIS BUFFER IS IN THE
;	COMMON BLOCK /HPPLOT/



;-----------------------------------------------------------------------
;	SBN(N)		SINGLE BYTE NUMBER
;-----------------------------------------------------------------------
SBN::
	MOV	@2(R5),R0	; R0 := N
	MOV	#BUFFER,R4	; R4 := POINTER TO FREE BUFFER
	ADD	SIZE,R4
	BIC	#177700,R0	; CLEAR HIGH BITS
	BIT	#40,R0		; IF (BIT 5 IS CLEAR)
	BNE	1$
	BIS	#100,R0		; THEN SET BIT 6
1$:	MOVB	R0,(R4)+	; STORE BYTE IN BUFFER
	SUB	#BUFFER,R4	; UPDATE SIZE
	MOV	R4,SIZE
	RTS	PC		; RETURN

;-----------------------------------------------------------------------
;	MBN(N)		MULTIPLE BYTE NUMBER
;-----------------------------------------------------------------------
MBN::
	MOV	@2(R5),R0	; R0 := N
	MOV	#BUFFER,R4	; R4 := POINTER TO FREE BUFFER
	ADD	SIZE,R4
	BIC	#100000,R0	; CLEAR SIGN BIT (JUST IN CASE)
	BIT	#177760,R0	; IF (N<16)
	BNE	1$		; THEN BEGIN
	BIS	#140,R0		;   EVALUATE BYTE #1
	MOVB	R0,(R4)+	;   STORE BYTE #1
	BR	3$		;   CLEANUP & RETURN
1$:				; END
	BIT	#176000,R0	; IF (N<1024)
	BNE	2$		; THEN BEGIN
	MOV	R0,-(SP)	;   STACK R0
	ASH	#-6,R0		;   EVALUATE & STORE BYTE #1
	BIS	#140,R0
	MOVB	R0,(R4)+
	MOV	(SP)+,R0	;   DESTACK R0
	JSR	PC,CR0		;   EVALUATE & STORE BYTE #2
	BR	3$		;   CLEANUP & RETURN
2$:				; END
	MOV	R0,-(SP)	; STACK R0
	ASH	#-12.,R0	; EVALUATE & STORE BYTE #1
	BIS	#140,R0
	MOVB	R0,(R4)+
	MOV	(SP),R0		; COPY R0
	ASH	#-6,R0		; EVALUATE & STORE BYTE #2
	JSR	PC,CR0
	MOV	(SP)+,R0	; DESTACK R0
	JSR	PC,CR0		; EVALUATE & STORE BYTE #3
3$:
	SUB	#BUFFER,R4	; UPDATE SIZE
	MOV	R4,SIZE
	RTS	PC		; RETURN

;-----------------------------------------------------------------------
;	MBP(NX,NY)	MULTIPLE BYTE PAIR OF NUMBERS
;-----------------------------------------------------------------------
MBP::
	MOV	@2(R5),R0	; (R0,R1) := (NX,NY)
	MOV	@4(R5),R1
	MOV	#BUFFER,R4	; R4 := POINTER TO FREE BUFFER
	ADD	SIZE,R4
	BIC	#140000,R0	; ENSURE CORRECT MAGNITUDE
	BIC	#140000,R1
	BIT	#177774,R0	; IF (X<4)
	BNE	1$
	BIT	#177774,R1	; AND (Y<4)
	BNE	1$		;   THEN BEGIN
	ASH	#2,R0		;   EVALUATE & STORE BYTE #1
	BIS	R1,R0
	BIS	#140,R0
	MOVB	R0,(R4)+
	BR	5$		;   CLEANUP & RETURN
1$:				; END
	BIT	#177740,R0	; IF (X<32)
	BNE	2$
	BIT	#177740,R1	; AND (Y<32)
	BNE	2$		; THEN BEGIN
	MOV	R0,-(SP)	;   STACK R0
	ASR	R0		;   EVALUATE & STORE BYTE #1
	BIS	#140,R0
	MOVB	R0,(R4)+
	MOV	(SP)+,R0	;   DESTACK R0
	ASH	#5,R0		;   EVALUATE & STORE BYTE #2
	BIS	R1,R0
	JSR	PC,CR0
	BR	5$		;   CLEANUP & RETURN
2$:				; END
	BIT	#177400,R0	; IF (X<256)
	BNE	3$
	BIT	#177400,R1	; AND (Y<256)
	BNE	3$		; THEN BEGIN
	MOV	R0,-(SP)	;   STACK R0
	ASH	#-4,R0		;   EVALUATE & STORE BYTE #1
	BIS	#140,R0
	MOVB	R0,(R4)+
	MOV	(SP)+,R0	;   DESTACK R0
	MOV	R1,-(SP)	;   STACK R1
	ASH	#2,R0		;   EVALUATE & STORE BYTE #2
	ASH	#-6,R1
	BIS	R1,R0
	JSR	PC,CR0
	MOV	(SP)+,R1	;   DESTACK R1
	JSR	PC,CR1		;   EVALUATE & STORE BYTE #3
	BR	5$		;   CLEANUP & RETURN
3$:				; END

	BIT	#174000,R0	; IF (X<2048)
	BNE	4$
	BIT	#174000,R1	; AND (Y<2048)
	BNE	4$		; THEN BEGIN
	MOV	R0,-(SP)	;   STACK R0
	ASH	#-7,R0		;   EVALUATE & STORE BYTE #1
	BIS	#140,R0
	MOVB	R0,(R4)+
	MOV	(SP),R0		;   COPY R0
	ASR	R0		;   EVALUATE & STORE BYTE #2
	JSR	PC,CR0
	MOV	(SP)+,R0	;   DESTACK R0
	MOV	R1,-(SP)	;   STACK R1
	ASH	#-6,R1		;   EVALUATE & STORE BYTE #3
	ASH	#5,R0
	BIS	R0,R1
	JSR	PC,CR1
	MOV	(SP)+,R1	;   DESTACK R1
	JSR	PC,CR1		;   EVALUATE & STORE BYTE #4
	BR	5$		;   CLEANUP & RETURN
4$:				; END
	MOV	R0,-(SP)	; STACK R0
	ASH	#-10.,R0	; EVALUATE & STORE BYTE #1
	BIS	#140,R0
	MOVB	R0,(R4)+
	MOV	(SP),R0		; COPY R0
	ASH	#-4,R0		; EVALUATE & STORE BYTE #2
	JSR	PC,CR0
	MOV	(SP)+,R0	; DESTACK R0
	MOV	R1,-(SP)	; STACK R1
	ASH	#-12.,R1	; EVALUATE & STORE BYTE #3
	ASH	#2,R0
	BIS	R1,R0
	JSR	PC,CR0
	MOV	(SP),R1		; COPY R1
	ASH	#-6,R1		; EVALUATE & STORE BYTE #4
	JSR	PC,CR1
	MOV	(SP)+,R1	; DESTACK R1
	JSR	PC,CR1		; EVALUATE & STORE BYTE #5
5$:
	SUB	#BUFFER,R4	; UPDATE SIZE
	MOV	R4,SIZE
	RTS	PC		; RETURN

;-----------------------------------------------------------------------
;	PMB(NX,NY)	PAIR OF MULTIPLE BYTE NUMBERS
;-----------------------------------------------------------------------
PMB::
	MOV	@2(R5),R0	; (R0,R1) := (NX,NY)
	MOV	@4(R5),R1
	MOV	#BUFFER,R4	; R4 := POINTER TO FREE BUFFER
	ADD	SIZE,R4
	MOV	#100,R2		; R2 := XMASK
1$:				; FOR (N = BOTH X & Y) DO BEGIN
	CMP	R0,#-16.	;   IF (-16<=N<=15)
	BLT	3$
	CMP	R0,#15.
	BGT	3$		;   THEN BEGIN
	BIC	#177740,R0	;     EVALUATE & STORE BYTE #1
	BIS	R2,R0
	MOVB	R0,(R4)+
	BR	2$		;   END
3$:	CMP	R0,#-512.	;   ELSE IF (-512.<=N<=511.)
	BLT	4$
	CMP	R0,#511.
	BGT	4$		;   THEN BEGIN
	MOV	R0,-(SP)	;     STACK R0
	ASH	#-5,R0		;     EVALUATE & STORE BYTE #1
	BIC	#177740,R0
	BIS	R2,R0
	MOVB	R0,(R4)+
	MOV	(SP)+,R0	;     DESTACK R0
	BIC	#177740,R0	;     EVALUATE & STORE BYTE #2
	BIS	R2,R0
	MOVB	R0,(R4)+
	BR	2$		;   END

4$:				;   ELSE BEGIN
	MOV	R0,-(SP)	;     STACK R0
	ASH	#-10.,R0	;     EVALUATE & STORE BYTE #1
	BIC	#177740,R0
	BIS	R2,R0
	MOVB	R0,(R4)+
	MOV	(SP),R0		;     COPY R0
	ASH	#-5,R0		;     EVALUATE & STORE BYTE #2
	BIC	#177740,R0
	BIS	R2,R0
	MOVB	R0,(R4)+
	MOV	(SP)+,R0	;     DESTACK R0
	BIC	#177740,R0	;     EVALUATE & STORE BYTE #3
	BIS	R2,R0
	MOVB	R0,(R4)+
;				;   END
2$:				;   [HANDLE LOOP & XY SWAPPING]
	BIT	#40,R2
	BNE	5$
	MOV	#40,R2		;   [R2 := YMASK]
	MOV	R1,R0
	CLR	R1
	BR	1$
5$:				; END
	SUB	#BUFFER,R4	; UPDATE SIZE
	MOV	R4,SIZE
	RTS	PC		; RETURN

;-----------------------------------------------------------------------
;	MBA(ANGLE)	MULTIPLE BYTE ANGLE
;-----------------------------------------------------------------------
MBA::
	MOV	#BUFFER,R4	; R4 := POINTER TO FREE BUFFER
	ADD	SIZE,R4
	LDF	@2(R5),R3	; F3 := ANGLE
	MULF	#^F91.022222,R3	; F3 := F3 * (2**15/180)
	STCFI	R3,-(SP)	; R0 := 15 BIT ANGLE
	MOV	(SP),R0		; AND R0 IS ON STACK
	ASH	#-11.,R0	; EVALUATE & STORE BYTE #1
	BIS	#140,R0
	MOVB	R0,(R4)+
	MOV	(SP),R0		; COPY R0
	BIT	#3777,R0	; IF (MORE RESOLUTION NEEDED)
	BEQ	1$		; THEN BEGIN
	ASH	#-5,R0		;   EVALUATE & STORE BYTE #2
	JSR	PC,CR0
	MOV	(SP),R0		;   COPY R0
	BIT	#37,R0		;   IF (MORE RESOLUTION NEEDED)
	BEQ	1$
	ASL	R0		;   THEN EVALUATE & STORE BYTE #3
	JSR	PC,CR0
1$:				; END
	MOV	(SP)+,R0	; DESTACK R0 (INTERNAL)
	SUB	#BUFFER,R4	; UPDATE SIZE
	MOV	R4,SIZE
	RTS	PC		; RETURN

;-----------------------------------------------------------------------
;	LOCAL PROCEDURES TO COMPLEMENT BIT 6 IF REQUIRED
;-----------------------------------------------------------------------
CR0:
	BIC	#177700,R0	; CLEAR HIGH BITS
	BIT	#40,R0		; IF (BIT 5 IS CLEAR)
	BNE	1$
	BIS	#100,R0		; THEN SET BIT 6
1$:	MOVB	R0,(R4)+	; STORE BYTE IN BUFFER
	RTS	PC		; RETURN
CR1:
	BIC	#177700,R1	; CLEAR HIGH BITS
	BIT	#40,R1		; IF (BIT 5 IS CLEAR)
	BNE	1$
	BIS	#100,R1		; THEN SET BIT 6
1$:	MOVB	R1,(R4)+	; STORE BYTE IN BUFFER
	RTS	PC		; RETURN

;-----------------------------------------------------------------------
;	ASC(STRING)	INSERT ASCII DATA IN BUFFER
;-----------------------------------------------------------------------
ASC::
	MOV	2(R5),R0	; R0 := POINTER TO STRING
	MOV	#BUFFER,R4	; R4 := POINTER TO FREE BUFFER
	ADD	SIZE,R4
1$:
	CMPB	(R0),#100	; WHILE (CHARACTER IS NOT "@")
	BEQ	2$		; DO BEGIN
	MOVB	(R0)+,(R4)+	;   MOVE CHARACTER INTO BUFFER
	BR	1$
2$:				; END
	SUB	#BUFFER,R4	; UPDATE SIZE
	MOV	R4,SIZE
	RTS	PC		; RETURN

;-----------------------------------------------------------------------
;	COMMON /HPPLOT/ NSIZE, ZBUF
;-----------------------------------------------------------------------
	.PSECT	HPPLOT,RW,D,GBL,REL,OVR
SIZE:	.BLKW	1			; SIZE OF USED BUFFER
BUFFER:	.BLKB	500			; BUFFER STORAGE

	.END