.TITLE PACK
.IDENT /V01A/
.ENABL LC
;
;Calling sequence:   CALL PACK2(IX,IY,IPEN,SEQ,NBYTES)
;
;Fortran-called subroutine to convert X,Y coordinates in terminal
;units and pen up/down according to 'IPEN' into a sequence of plot
;instruction bytes for the TEXTRONIX 4662 flatbed plotter to be
;placed in 'SEQ'. The number of instruction bytes will be placed in
;'NBYTES'.
;
;Note: Entry at PACK1 will result in plot byte output for the
;TEKTRONIX 4006-1 graphics VDU.
;
;'SEQ' is in any Fortran type. All other arguments are INTEGER*2.
;
;No argument checking
;
;Programmer: P. Austin             Date: December 1982
;
.GLOBL PACK1,PACK2
;
PACK1:	CLR R4			;set plotter type to 4006-1
	BR UNPCK
;
PACK2:	MOV #1,R4		;set plotter type to 4662
;
;unpack arguments
;
UNPCK:	TST(R5)+		;point at argument list
	MOV @(R5)+,R0		;get IX value
	TST R4			;4006-1 plotter?
	BNE STIX		;no!
	ASH #2,R0		;shift IX left 2 bits
STIX:	MOV R0,IX		;store IX value
;
	MOV @(R5)+,R0		;get IY value
	TST R4			;4006-1 plotter?
	BNE STIY		;no!
	ASH #2,R0		;shift IY left 2 bits
STIY:	MOV R0,IY		;store IY value
;
	MOV @(R5)+,R3		;pen condition
	MOV (R5)+,R0		;instruction buffer
	MOV R0,R2		;start address
;
;test pen condition to see if DARK VECTOR
;
	TST R3			;pen up?
	BNE CONVRT		;no!
	MOVB #35,(R0)+		;send 'GS' to SEQ
;
;convert coordinates to HIY,XLOY,LOY,HIX,LOX
;
;HIY: 001 then bits 11-7
;
CONVRT:	MOV IY,R1		;get IY value
	ASH #-7,R1		;shift right 7 bits
	BIC #177700,R1		;clear bits 6-15
	BIS #40,R1		;set bit 5
	MOVB R1,NEWHIY		;store new HIY value
;
;XLOY: 011 then bits 1-0 og IY, bits 1-0 of IX
;
	MOV IY,R1		;get IY value
	BIC #177774,R1		;clear bits 3-15
	MOV IX,R3		;get IX value
	BIC #177774,R3		;clear bits 3-15
	ASH #2,R1		;shift left 2 bits
	BIS R3,R1		;set IY bits using IX mask
	BIS #140,R1		;set bits 5-6
	MOVB R1,NEWXLY		;store new XLOY value
;
;LOY: 011 then bits 6-2
;
	MOV IY,R1		;get IY value
	ASH #-2,R1		;shift right 2 bits
	BIC #177600,R1		;clear bits 7-15
	BIS #140,R1		;set bits 5-6
	MOVB R1,NEWLOY		;store new LOY value
;
;HIX: 001 then bits 11-7
;
	MOV IX,R1		;get IX value
	ASH #-7,R1		;shift right 7 bits
	BIC #177700,R1		;clear bits 6-15
	BIS #40,R1		;set bit 5
	MOVB R1,NEWHIX		;store new HIX value
;
;LOX: 010 then bits 6-2
;
	MOV IX,R1		;get IX value
	ASH #-2,R1		;shift right 2 bits
	BIC #177740,R1		;clear bits 5-15
	BIS #100,R1		;set bit 6
	MOVB R1,NEWLOX		;store new LOX value
;
;new bytes constructed
;
	TST R4			;4006-1?
	BNE MINADD		;no!
;
;send full address to 4006-1
;
	MOVB NEWHIY,(R0)+	;save new address values in SEQ
	MOVB NEWLOY,(R0)+
	MOVB NEWHIX,(R0)+
	MOVB NEWLOX,(R0)+
	BR STNBYT
;
;send minimum bytes to 4662 flatbed
;
MINADD:	CMPB NEWHIY,OLDHIY	;HIY values the same?
	BEQ CHKXLY		;yes!
	MOVB NEWHIY,(R0)+	;send HIY value to SEQ
	MOVB NEWHIY,OLDHIY	;store as old value
;
CHKXLY:	CMPB NEWXLY,OLDXLY	;XLOY values the same?
	BNE PCKXLY		;no!
;
	CMPB NEWLOY,OLDLOY	;LOY values the same?
	BNE PCKLOY		;no!
;
	CMPB NEWHIX,OLDHIX	;HIX values the same?
	BEQ PCKLOX		;yes!
;
	MOVB NEWLOY,(R0)+	;send LOY value to SEQ
	MOVB NEWLOY,OLDLOY	;store as old value
	BR PCKHIX
;
PCKXLY:	MOVB NEWXLY,(R0)+	;send XLOY value to SEQ
	MOVB NEWXLY,OLDXLY	;store as old value
;
PCKLOY:	MOVB NEWLOY,(R0)+	;send LOY value to SEQ
	MOVB NEWLOY,OLDLOY	;store as old value
;
	CMPB NEWHIX,OLDHIX	;HIX values the same?
	BEQ PCKLOX		;yes!
;
PCKHIX:	MOVB NEWHIX,(R0)+	;send HIX value to SEQ
	MOVB NEWHIX,OLDHIX	;store as old value
;
PCKLOX:	MOVB NEWLOX,(R0)+	;send LOX value to SEQ
	MOVB NEWLOX,OLDLOX	;store as old value
;
;compute the number of bytes packed in SEQ
;
STNBYT:	SUB R2,R0		;stop address - start address
	MOV R0,@(R5)+		;send byte count to NBYTES
;
;end of subroutine - return
;
	RTS PC
;
;data storage area
;
IX:	.BLKW 1			;X coordinate value
IY:	.BLKW 1			;Y coordinate value
;
NEWHIY:	.BLKB 1			;new HIY value
NEWXLY:	.BLKB 1			;new XLOY value
NEWLOY:	.BLKB 1			;new LOY value
NEWHIX:	.BLKB 1			;new HIX value
NEWLOX:	.BLKB 1			;new LOX value
;
OLDHIY:	.BYTE 377		;old HIY value
OLDLOY:	.BYTE 377		;old LOY value
OLDXLY:	.BYTE 377		;old XLOY value
OLDHIX: .BYTE 377		;old HIX value
OLDLOX: .BYTE 377		;old LOX value
;
.END