.TITLE PUTSTR
	.IDENT /020283/ 
;
;   File: [22,310]PUTSTR.MAC     Last edit: 17-JUL-1989 10:59:08 
;
;   History:    
;
; j.m.b. 020282
; j.m.b. 022182 fix buffer overrun problem. Max instring now 80. bytes.
;               this is checked, and clamped to 80.
;		Add erase to EOL function.
; j.m.b. 022582 Allow zero length input string.
; J.M.B. 040382 Remove explicit P2UDAT PSECT deifinition.
; J.M.B. 020283 Sign extend byte error codes.	
;
; NOTE: This version does NOT use the TTDRV cursor positioning features!
; NOTE: 040382 this only works reliably if 1)terminal buffer set to
;	       >=110.  and 2) terminal set to NOWRAP.
;
;       17-Jul-89.  Philip Hannay.  Some clean up.  Changed QIO flag to
;          24 (reserved for P3UTIL), and P2UDAT to Data PSECT.
;
.REM |

PROCEDURE PUTSTR(Lin,Col:Integer;Attributes:CRT_Attribute_set;
     Base:Address; Count:Integer; Save:Boolean; VAR IOSB:Integer);external;

{*USER*

Pascal-2 procedure to display Count characters beginning at Base on
a CRT at line Lin, column Col, with display attributes Attributes.
If Save is true, the cursor and CRT context are preserved across
the field write. If false, the context is established by the PUTSTR
parameters, and the cursor remains following the last character written.
Maximum input string length is 80. bytes.
Minimum input string length is 0. bytes. If Count=0, the cursor positioning,
attribute setting, and save characteristics will be set up, but of course
no text from Base^ will be output.

If lin is negative, the entire screen will be erased prior to writing
the field, which will appear at abs(lin). Column must be 00-132.
lin must be 00-24. (or -24 for auto erase).

If col is negative, an erase to end-of-line sequence will be generated
following the string output (but before a possible cursor restore).
Abs(col) will be used to position the cursor.

If lin is zero, col is ignored, and no cursor positioning is done.
Note that save may still be used, and will preserve CRT attrubutes
across the QIO, leaving the cursor at the first byte of the string.

The I/O is done on LUN 5, and efn 24, which is reserved for P3UTIL
routines, is used.

}

|

;
; Assemble with PASMAC.MAC as prefix file.
;
	.MCALL QIOW$,DIR$
	.ENABL LC


;
; Most of the needed DPB offsets are system-defined. Notably absent
; are QIO parameter block offsets. So here they are...
;
;
QIOPL=12.	;SAME AS SYSTEM SYMBOL Q.IOPL
QIOBUF=QIOPL	;BUFFER ADDX
QIOSIZ=QIOPL+2	;BUFFER SIZE
QIOTMO=QIOPL+4	;TIME-OUT VALUE (SEC)
QIOVFC=QIOPL+4	;FORMS CHAR (ON SEND)
QIOTBL=QIOPL+6	;SPECIAL-TERMINATOR TABLE ADDX
QIOPRB=QIOPL+6	;PROMPT ADDX
QIOPRL=QIOPL+8.	;PROMPT SIZE
QIOPVF=QIOPL+10	;PROMPT VFC
;
;


	.PSECT P2UDAT,D
IOSB:	.BLKW 2
BUFF:	.BLKB 120.		;OUTPUT BUFFER FOR QIO
	;
ESC=^O33			;ESCAPE CHARACTER
SCUR:	.BYTE ESC,'7		;CURSOR SAVE SEQUENCE
RCUR:	.BYTE ESC,'8		;CURSOR RESTORE SEQUENCE
	.EVEN
QIODPB:	QIOW$ IO.WLB,5,24.,,IOSB,,<BUFF,0,0>
;
;DEFINE THE RUN-TIME ADDRESS OF BUFFER LENGTH AND VFC QIO PARAMETERS
;COLU=<QIODPB+QIOVFC>
;LINE=<QIODPB+QIOVFC+1>
BLEN=<QIODPB+QIOSIZ>


	.PSECT

	PROC PUTSTR
	PARAM LIN, INTEGER
	PARAM COL, INTEGER
	PARAM ATTS, SCALAR	; ITS REALLY A SET, KIDDIES!
	PARAM BASE, POINTER
	PARAM COUNT, INTEGER
	PARAM SAV, BOOLEAN
	PARAM ISB, ADDRESS
	SAVE <R0, R1, R2 >
	BEGIN
	MOV #BUFF,R0		;R0->OUTPUT BUFFER
	;
	;CHECK FOR CURSOR SAVE/RESTORE REQUEST
	;
SAVT:	TSTB SAV(SP)		;SAVE/RESTORE SEQUENCE?
	BEQ 1$			;BR IF NOT
	MOVB SCUR,(R0)+		;SAVE CURSOR SEQUENCE TO BUFFER
	MOVB SCUR+1,(R0)+
1$:
	;
	;CHECK FOR ERASE SCREEN REQUEST, AND CURSOR POSITION REQUEST
	;
	MOV LIN(SP),R1		;LINE PARAMETER
	BEQ ATCK		;BR IF NO CURSOR POSITIONING REQD
	BGT CURP		;NO ERASE REQUEST
	NEG R1			;ERASE REQUESTED, RESTORE LINE PARAM TO >0
	MOVB #ESC,(R0)+		;STUFF ERASE SEQUENCE TO BUFFER
	MOVB #'[, (R0)+
	MOVB #'2,(R0)+
	MOVB #'J,(R0)+
CURP:	MOVB #ESC,(R0)+		;SET UP CURSOR POSITION SEQUENCE
	MOVB #'[,(R0)+
	CLR R2			;SET UP TO CONVERT LINE TO ASCII
				;R1=LINE IN BINARY >0
	CALL $CBDMG		;CONVERT TO 1-5 ASCII. (WE DON'T CHECK RANGE!)
	MOVB #';,(R0)+		;CONTINUE CURSOR SEQUENCT
	MOV COL(SP),R1		;R1=COLUMN PARAMETER
	BPL 1$			; MAKE IT ABSOLUTE
	NEG R1
1$:	CLR R2			;SET UP TO CONVERT IT TO ASCII
	CALL $CBDMG		;CONVERT TO ASCII IN OUTPUT BUFF
	MOVB #'H,(R0)+		;COMPLETE CURSOR POSITION SEQUENCE
	;CHECK FOR ATTRIBUTES...
ATCK:	MOVB ATTS(SP),R1	;R1=BIT SET OF CRT ATTRIBUTES
	BIT #^O37,R1		;NULL ATTRIBUTES?
	BEQ NOATT		;BR IF NONE
	;
	;NOW SET UP THE ATTRIBUTE SEQUENCE
	;
	MOVB #ESC,(R0)+
	MOVB #'[,(R0)+
	;
	;CHECK EACH ATTRIBUTE, AND STUFF IT'S CHARACTER
	;
	BIT #1,R1		;STANDARD?
	BEQ 2$			;BR IF NOT
	MOVB #0,(R0)+
	MOVB #';, (R0)+
2$:	BIT #2,R1		;BOLD?
	BEQ 3$			;BR IF NOT
	MOVB #'1,(R0)+
	MOVB #';,(R0)+
3$:	BIT #4,R1		;UNDERLINE?
	BEQ 4$			;BR IF NOT
	MOVB #'4,(R0)+
	MOVB #';,(R0)+
4$:	BIT #^O10,R1		;BLINK?
	BEQ 5$			;BR IF NOT
	MOVB #'5,(R0)+
	MOVB #';,(R0)+
5$:	BIT #^O20,R1		;REVERSE?
	BEQ 6$			;BR IF NOT
	MOVB #'7,(R0)+
	MOVB #';,(R0)+
6$:	MOVB #'m,-1(R0)		;OVERWRITE LAST ";" WITH LOWER "M"
NOATT:	MOV BASE(SP),R1		;R1->INPUT BUFFER
	MOV COUNT(SP),R2	;R2=STRING LENGTH
	BEQ 6$			;SKIP COPY IF ZERO LENGTH SPECIFIED
	CMP #80.,R2		;CHECK MAX STRING LENGTH
	BHIS 2$			; BR IF LENGTH OK
	MOV #80., R2		; ONLY USE FIRST 80 OF HIS LONG BUFFER
2$:	MOVB (R1)+,(R0)+	;COPY STRING TO OUTPUT BUFFER
	SOB R2,2$
6$:	TST COL(SP)		;CHECK FOR ERASE TO EOL
	BPL 1$			;BR IF NO EREOL
	MOVB #ESC,(R0)+		;GENERATE EREOL COMMAND IN-LINE
	MOVB #'[, (R0)+
	MOVB #'K, (R0)+
1$:	TSTB SAV(SP)		;SAVE/RESTORE SEQUENCE?
	BEQ 3$			;BR IF NOT
	MOVB RCUR,(R0)+		;RESTORE SEQUENCE TO BUFFER
	MOVB RCUR+1,(R0)+	;BYTE AT A TIME SINCE COUNT MIGHT BE ODD
3$:	SUB #BUFF,R0		;R0=LENGTH OF OUTPUT BUFFER
	MOV R0,BLEN
	DIR$ #QIODPB		;DO IT
	BCC 4$			;BRANCH IF NO DIRECTIVE ERROR
	MOV $DSW,@ISB(SP)	;RETURN $DSW AS ERROR
	BR 5$
4$:	TSTB IOSB		; ERROR?                                        ;JMB001
	BPL 16$			; BR - NOPE                                     ;JMB001
	MOVB #-1, IOSB+1	; SIGN EXTEND ERROR CODE                        ;JMB001
16$:	MOV IOSB,@ISB(SP)	;RETURN IO STATUS                               ;JMB001
5$:                                                                             ;**-1
	ENDPR
	.END